diff --git a/ClosureTypes.h b/ClosureTypes.h --- a/ClosureTypes.h +++ b/ClosureTypes.h @@ -89,4 +89,5 @@ #define SMALL_MUT_ARR_PTRS_FROZEN_CLEAN 62 #define COMPACT_NFDATA 63 #define CONTINUATION 64 -#define N_CLOSURE_TYPES 65 +#define ANN_FRAME 65 +#define N_CLOSURE_TYPES 66 diff --git a/CodeGen.Platform.h b/CodeGen.Platform.h --- a/CodeGen.Platform.h +++ b/CodeGen.Platform.h @@ -2,7 +2,7 @@ import GHC.Cmm.Expr #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \ || defined(MACHREGS_powerpc) || defined(MACHREGS_aarch64) \ - || defined(MACHREGS_riscv64)) + || defined(MACHREGS_riscv64) || defined(MACHREGS_loongarch64)) import GHC.Utils.Panic.Plain #endif import GHC.Platform.Reg @@ -1032,11 +1032,15 @@ -- ip0 -- used for spill offset computations freeReg 16 = False -#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) +-- Note [Aarch64 Register x18 at Darwin and Windows] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- x18 is reserved by the platform on Darwin/iOS, and can not be used -- More about ARM64 ABI that Apple platforms support: -- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms -- https://github.com/Siguza/ios-resources/blob/master/bits/arm64.md +-- It is a reserved at Windows as well. Acts like TEB register in user mode at Windows. +-- https://learn.microsoft.com/en-us/cpp/build/arm64-windows-abi-conventions +#if defined(darwin_HOST_OS) || defined(ios_HOST_OS) || defined(mingw32_HOST_OS) freeReg 18 = False #endif @@ -1138,6 +1142,104 @@ -- made-up inter-procedural (ip) register -- See Note [The made-up RISCV64 TMP (IP) register] freeReg 31 = False + +# if defined(REG_Base) +freeReg REG_Base = False +# endif +# if defined(REG_Sp) +freeReg REG_Sp = False +# endif +# if defined(REG_SpLim) +freeReg REG_SpLim = False +# endif +# if defined(REG_Hp) +freeReg REG_Hp = False +# endif +# if defined(REG_HpLim) +freeReg REG_HpLim = False +# endif + +# if defined(REG_R1) +freeReg REG_R1 = False +# endif +# if defined(REG_R2) +freeReg REG_R2 = False +# endif +# if defined(REG_R3) +freeReg REG_R3 = False +# endif +# if defined(REG_R4) +freeReg REG_R4 = False +# endif +# if defined(REG_R5) +freeReg REG_R5 = False +# endif +# if defined(REG_R6) +freeReg REG_R6 = False +# endif +# if defined(REG_R7) +freeReg REG_R7 = False +# endif +# if defined(REG_R8) +freeReg REG_R8 = False +# endif + +# if defined(REG_F1) +freeReg REG_F1 = False +# endif +# if defined(REG_F2) +freeReg REG_F2 = False +# endif +# if defined(REG_F3) +freeReg REG_F3 = False +# endif +# if defined(REG_F4) +freeReg REG_F4 = False +# endif +# if defined(REG_F5) +freeReg REG_F5 = False +# endif +# if defined(REG_F6) +freeReg REG_F6 = False +# endif + +# if defined(REG_D1) +freeReg REG_D1 = False +# endif +# if defined(REG_D2) +freeReg REG_D2 = False +# endif +# if defined(REG_D3) +freeReg REG_D3 = False +# endif +# if defined(REG_D4) +freeReg REG_D4 = False +# endif +# if defined(REG_D5) +freeReg REG_D5 = False +# endif +# if defined(REG_D6) +freeReg REG_D6 = False +# endif + +freeReg _ = True + +#elif defined(MACHREGS_loongarch64) + +-- zero register +freeReg 0 = False +-- linker regster +freeReg 1 = False +-- thread register +freeReg 2 = False +-- stack pointer +freeReg 3 = False +-- made-up inter-procedural (ip) register for spilling offset computations +freeReg 20 = False +-- reserved +freeReg 21 = False +-- frame pointer +freeReg 22 = False # if defined(REG_Base) freeReg REG_Base = False diff --git a/GHC.hs b/GHC.hs --- a/GHC.hs +++ b/GHC.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TupleSections, NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE LambdaCase #-} -- ----------------------------------------------------------------------------- -- @@ -37,7 +38,9 @@ setSessionDynFlags, setUnitDynFlags, getProgramDynFlags, setProgramDynFlags, + setProgramHUG, setProgramHUG_, getInteractiveDynFlags, setInteractiveDynFlags, + normaliseInteractiveDynFlags, initialiseInteractiveDynFlags, interpretPackageEnv, -- * Logging @@ -54,6 +57,7 @@ addTarget, removeTarget, guessTarget, + guessTargetId, -- * Loading\/compiling the program depanal, depanalE, @@ -82,6 +86,7 @@ getModuleGraph, isLoaded, isLoadedModule, + isLoadedHomeModule, topSortModuleGraph, -- * Inspecting modules @@ -99,33 +104,37 @@ findGlobalAnns, mkNamePprCtxForModule, ModIface, - ModIface_( - mi_module, - mi_sig_of, - mi_hsc_src, - mi_src_hash, - mi_hi_bytes, - mi_deps, - mi_usages, - mi_exports, - mi_used_th, - mi_fixities, - mi_warns, - mi_anns, - mi_insts, - mi_fam_insts, - mi_rules, - mi_decls, - mi_extra_decls, - mi_top_env, - mi_hpc, - mi_trust, - mi_trust_pkg, - mi_complete_matches, - mi_docs, - mi_final_exts, - mi_ext_fields - ), + ModIface_( mi_mod_info + , mi_module + , mi_sig_of + , mi_hsc_src + , mi_iface_hash + , mi_deps + , mi_public + , mi_exports + , mi_fixities + , mi_warns + , mi_anns + , mi_decls + , mi_defaults + , mi_simplified_core + , mi_top_env + , mi_insts + , mi_fam_insts + , mi_rules + , mi_trust + , mi_trust_pkg + , mi_complete_matches + , mi_docs + , mi_abi_hashes + , mi_ext_fields + , mi_hi_bytes + , mi_self_recomp_info + , mi_fix_fn + , mi_decl_warn_fn + , mi_export_warn_fn + , mi_hash_fn + ), pattern ModIface, SafeHaskellMode(..), @@ -150,6 +159,7 @@ getBindings, getInsts, getNamePprCtx, findModule, lookupModule, findQualifiedModule, lookupQualifiedModule, + lookupLoadedHomeModuleByModuleName, lookupAllQualifiedModuleNames, renamePkgQualM, renameRawPkgQualM, isModuleTrusted, moduleTrustReqs, getNamesInScope, @@ -191,7 +201,7 @@ getResumeContext, GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType, modInfoModBreaks, - ModBreaks(..), BreakIndex, + ModBreaks(..), BreakTickIndex, BreakpointId(..), InternalBreakpointId(..), GHC.Runtime.Eval.back, GHC.Runtime.Eval.forward, @@ -336,6 +346,7 @@ import GHC.Driver.Errors.Types import GHC.Driver.CmdLine import GHC.Driver.Session +import GHC.Driver.Session.Inspect import GHC.Driver.Backend import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) @@ -368,7 +379,7 @@ import GHC.Data.StringBuffer import GHC.Data.FastString import qualified GHC.LanguageExtensions as LangExt -import GHC.Rename.Names (renamePkgQual, renameRawPkgQual, gresFromAvails) +import GHC.Rename.Names (renamePkgQual, renameRawPkgQual) import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) import GHC.Tc.Types @@ -415,15 +426,11 @@ import GHC.Types.Basic import GHC.Types.TyThing import GHC.Types.Name.Env -import GHC.Types.Name.Ppr import GHC.Types.TypeEnv -import GHC.Types.Breakpoint import GHC.Types.PkgQual -import GHC.Types.Unique.FM import GHC.Unit -import GHC.Unit.Env -import GHC.Unit.External +import GHC.Unit.Env as UnitEnv import GHC.Unit.Finder import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModGuts @@ -431,6 +438,7 @@ import GHC.Unit.Module.ModSummary import GHC.Unit.Module.Graph import GHC.Unit.Home.ModInfo +import qualified GHC.Unit.Home.Graph as HUG import GHC.Settings import Control.Applicative ((<|>)) @@ -438,6 +446,7 @@ import Control.Monad import Control.Monad.Catch as MC import Data.Foldable +import Data.Function ((&)) import Data.IORef import Data.List (isPrefixOf) import Data.Typeable ( Typeable ) @@ -454,6 +463,7 @@ import System.FilePath import System.IO.Error ( isDoesNotExistError ) + -- %************************************************************************ -- %* * -- Initialisation: exception handlers @@ -482,6 +492,8 @@ liftIO $ throwIO UserInterrupt Just StackOverflow -> fm "stack overflow: use +RTS -K to increase it" + Just HeapOverflow -> + fm "heap overflow: use +RTS -M to increase maximum heap size" _ -> case fromException exception of Just (ex :: ExitCode) -> liftIO $ throwIO ex _ -> @@ -664,7 +676,7 @@ , homeUnitEnv_home_unit = Just home_unit } - let unit_env = ue_updateHomeUnitEnv upd uid (hsc_unit_env hsc_env) + let unit_env = UnitEnv.ue_updateHomeUnitEnv upd uid (hsc_unit_env hsc_env) let dflags = updated_dflags @@ -682,7 +694,7 @@ let !unit_env1 = if homeUnitId_ dflags /= uid then - ue_renameUnitId + UnitEnv.renameUnitId uid (homeUnitId_ dflags) unit_env0 @@ -700,9 +712,9 @@ setTopSessionDynFlags dflags = do hsc_env <- getSession logger <- getLogger - lookup_cache <- liftIO $ newMVar emptyUFM + lookup_cache <- liftIO $ mkInterpSymbolCache - -- Interpreter + -- see Note [Target code interpreter] interp <- if -- Wasm dynamic linker | ArchWasm32 <- platformArch $ targetPlatform dflags @@ -722,10 +734,17 @@ { wasmInterpDyLD = dyld, wasmInterpLibDir = libdir, wasmInterpOpts = getOpts dflags opt_i, + wasmInterpBrowser = gopt Opt_GhciBrowser dflags, + wasmInterpBrowserHost = ghciBrowserHost dflags, + wasmInterpBrowserPort = ghciBrowserPort dflags, + wasmInterpBrowserRedirectWasiConsole = gopt Opt_GhciBrowserRedirectWasiConsole dflags, + wasmInterpBrowserPuppeteerLaunchOpts = ghciBrowserPuppeteerLaunchOpts dflags, + wasmInterpBrowserPlaywrightBrowserType = ghciBrowserPlaywrightBrowserType dflags, + wasmInterpBrowserPlaywrightLaunchOpts = ghciBrowserPlaywrightLaunchOpts dflags, wasmInterpTargetPlatform = targetPlatform dflags, wasmInterpProfiled = profiled, wasmInterpHsSoSuffix = way_tag ++ dynLibSuffix (ghcNameVersion dflags), - wasmInterpUnitState = ue_units $ hsc_unit_env hsc_env + wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env } pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache @@ -819,7 +838,7 @@ let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv dflags = homeUnitEnv_dflags homeUnitEnv old_hpt = homeUnitEnv_hpt homeUnitEnv - home_units = unitEnv_keys (ue_home_unit_graph old_unit_env) + home_units = HUG.allUnits (ue_home_unit_graph old_unit_env) (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units @@ -832,12 +851,13 @@ , homeUnitEnv_home_unit = Just home_unit } - let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup (ue_currentUnit old_unit_env) home_unit_graph + let dflags1 = homeUnitEnv_dflags $ HUG.unitEnv_lookup (ue_currentUnit old_unit_env) home_unit_graph let unit_env = UnitEnv { ue_platform = targetPlatform dflags1 , ue_namever = ghcNameVersion dflags1 , ue_home_unit_graph = home_unit_graph , ue_current_unit = ue_currentUnit old_unit_env + , ue_module_graph = ue_module_graph old_unit_env , ue_eps = ue_eps old_unit_env } modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env } @@ -846,7 +866,115 @@ when invalidate_needed $ invalidateModSummaryCache return changed +-- | Sets the program 'HomeUnitGraph'. +-- +-- Sets the given 'HomeUnitGraph' as the 'HomeUnitGraph' of the current +-- session. If the package flags change, we reinitialise the 'UnitState' +-- of all 'HomeUnitEnv's in the current session. +-- +-- This function unconditionally invalidates the module graph cache. +-- +-- Precondition: the given 'HomeUnitGraph' must have the same keys as the 'HomeUnitGraph' +-- of the current session. I.e., assuming the new 'HomeUnitGraph' is called +-- 'new_hug', then: +-- +-- @ +-- do +-- hug <- hsc_HUG \<$\> getSession +-- pure $ unitEnv_keys new_hug == unitEnv_keys hug +-- @ +-- +-- If this precondition is violated, the function will crash. +-- +-- Conceptually, similar to 'setProgramDynFlags', but performs the same check +-- for all 'HomeUnitEnv's. +setProgramHUG :: GhcMonad m => HomeUnitGraph -> m Bool +setProgramHUG = + setProgramHUG_ True +-- | Same as 'setProgramHUG', but gives you control over whether you want to +-- invalidate the module graph cache. +setProgramHUG_ :: GhcMonad m => Bool -> HomeUnitGraph -> m Bool +setProgramHUG_ invalidate_needed new_hug0 = do + logger <- getLogger + + hug0 <- hsc_HUG <$> getSession + (changed, new_hug1) <- checkNewHugDynFlags logger hug0 new_hug0 + + if changed + then do + unit_env0 <- hsc_unit_env <$> getSession + home_unit_graph <- HUG.unitEnv_traverseWithKey + (updateHomeUnit logger unit_env0 new_hug1) + (ue_home_unit_graph unit_env0) + + let dflags1 = homeUnitEnv_dflags $ HUG.unitEnv_lookup (ue_currentUnit unit_env0) home_unit_graph + let unit_env = UnitEnv + { ue_platform = targetPlatform dflags1 + , ue_namever = ghcNameVersion dflags1 + , ue_home_unit_graph = home_unit_graph + , ue_current_unit = ue_currentUnit unit_env0 + , ue_eps = ue_eps unit_env0 + , ue_module_graph = ue_module_graph unit_env0 + } + modifySession $ \h -> + -- hscSetFlags takes care of updating the logger as well. + hscSetFlags dflags1 h{ hsc_unit_env = unit_env } + else do + modifySession (\env -> + env + -- Set the new 'HomeUnitGraph'. + & hscUpdateHUG (const new_hug1) + -- hscSetActiveUnitId makes sure that the 'hsc_dflags' + -- are up-to-date. + & hscSetActiveUnitId (hscActiveUnitId env) + -- Make sure the logger is also updated. + & hscUpdateLoggerFlags) + + when invalidate_needed $ invalidateModSummaryCache + pure changed + where + checkNewHugDynFlags :: GhcMonad m => Logger -> HomeUnitGraph -> HomeUnitGraph -> m (Bool, HomeUnitGraph) + checkNewHugDynFlags logger old_hug new_hug = do + -- Traverse the new HUG and check its 'DynFlags'. + -- The old 'HUG' is used to check whether package flags have changed. + hugWithCheck <- HUG.unitEnv_traverseWithKey + (\unitId homeUnit -> do + let newFlags = homeUnitEnv_dflags homeUnit + oldFlags = homeUnitEnv_dflags (HUG.unitEnv_lookup unitId old_hug) + checkedFlags <- checkNewDynFlags logger newFlags + pure + ( packageFlagsChanged oldFlags checkedFlags + , homeUnit { homeUnitEnv_dflags = checkedFlags } + ) + ) + new_hug + let + -- Did any of the package flags change? + changed = or $ fmap fst hugWithCheck + hug = fmap snd hugWithCheck + pure (changed, hug) + + updateHomeUnit :: GhcMonad m => Logger -> UnitEnv -> HomeUnitGraph -> (UnitId -> HomeUnitEnv -> m HomeUnitEnv) + updateHomeUnit logger unit_env updates = \uid homeUnitEnv -> do + let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv + dflags = case HUG.unitEnv_lookup_maybe uid updates of + Nothing -> homeUnitEnv_dflags homeUnitEnv + Just env -> homeUnitEnv_dflags env + old_hpt = homeUnitEnv_hpt homeUnitEnv + home_units = HUG.allUnits (ue_home_unit_graph unit_env) + + (dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags cached_unit_dbs home_units + + updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants + pure HomeUnitEnv + { homeUnitEnv_units = unit_state + , homeUnitEnv_unit_dbs = Just dbs + , homeUnitEnv_dflags = updated_dflags + , homeUnitEnv_hpt = old_hpt + , homeUnitEnv_home_unit = Just home_unit + } + -- When changing the DynFlags, we want the changes to apply to future -- loads, but without completely discarding the program. But the -- DynFlags are cached in each ModSummary in the hsc_mod_graph, so @@ -868,7 +996,7 @@ -- invalidateModSummaryCache :: GhcMonad m => m () invalidateModSummaryCache = - modifySession $ \h -> h { hsc_mod_graph = mapMG inval (hsc_mod_graph h) } + modifySession $ \hsc_env -> setModuleGraph (mapMG inval (hsc_mod_graph hsc_env)) hsc_env where inval ms = ms { ms_hs_hash = fingerprint0 } @@ -885,24 +1013,8 @@ setInteractiveDynFlags :: GhcMonad m => DynFlags -> m () setInteractiveDynFlags dflags = do logger <- getLogger - dflags' <- checkNewDynFlags logger dflags - dflags'' <- checkNewInteractiveDynFlags logger dflags' - modifySessionM $ \hsc_env0 -> do - let ic0 = hsc_IC hsc_env0 - - -- Initialise (load) plugins in the interactive environment with the new - -- DynFlags - plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $ - hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags'' }} - - -- Update both plugins cache and DynFlags in the interactive context. - return $ hsc_env0 - { hsc_IC = ic0 - { ic_plugins = hsc_plugins plugin_env - , ic_dflags = hsc_dflags plugin_env - } - } - + icdflags <- normaliseInteractiveDynFlags logger dflags + modifySessionM (initialiseInteractiveDynFlags icdflags) -- | Get the 'DynFlags' used to evaluate interactive expressions. getInteractiveDynFlags :: GhcMonad m => m DynFlags @@ -916,7 +1028,7 @@ -> [Located String] -> m (DynFlags, [Located String], Messages DriverMessage) parseDynamicFlags logger dflags cmdline = do - (dflags1, leftovers, warns) <- parseDynamicFlagsCmdLine dflags cmdline + (dflags1, leftovers, warns) <- parseDynamicFlagsCmdLine logger dflags cmdline -- flags that have just been read are used by the logger when loading package -- env (this is checked by T16318) let logger1 = setLogFlags logger (initLogFlags dflags1) @@ -1007,17 +1119,49 @@ ----------------------------------------------------------------------------- +-- | Normalise the 'DynFlags' for us in an interactive context. +-- +-- Makes sure unsupported Flags and other incosistencies are reported and removed. +normaliseInteractiveDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags +normaliseInteractiveDynFlags logger dflags = do + dflags' <- checkNewDynFlags logger dflags + checkNewInteractiveDynFlags logger dflags' + +-- | Given a set of normalised 'DynFlags' (see 'normaliseInteractiveDynFlags') +-- for the interactive context, initialize the 'InteractiveContext'. +-- +-- Initialized plugins and sets the 'DynFlags' as the 'ic_dflags' of the +-- 'InteractiveContext'. +initialiseInteractiveDynFlags :: GhcMonad m => DynFlags -> HscEnv -> m HscEnv +initialiseInteractiveDynFlags dflags hsc_env0 = do + let ic0 = hsc_IC hsc_env0 + + -- Initialise (load) plugins in the interactive environment with the new + -- DynFlags + plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $ + hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags }} + + -- Update both plugins cache and DynFlags in the interactive context. + return $ hsc_env0 + { hsc_IC = ic0 + { ic_plugins = hsc_plugins plugin_env + , ic_dflags = hsc_dflags plugin_env + } + } + -- | Checks the set of new DynFlags for possibly erroneous option -- combinations when invoking 'setSessionDynFlags' and friends, and if -- found, returns a fixed copy (if possible). checkNewDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags checkNewDynFlags logger dflags = do -- See Note [DynFlags consistency] - let (dflags', warnings) = makeDynFlagsConsistent dflags + let (dflags', warnings, infoverb) = makeDynFlagsConsistent dflags let diag_opts = initDiagOpts dflags print_config = initPrintConfig dflags liftIO $ printOrThrowDiagnostics logger print_config diag_opts $ fmap GhcDriverMessage $ warnsToMessages diag_opts warnings + when (logVerbAtLeast logger 3) $ + mapM_ (\(L _loc m) -> liftIO $ logInfo logger m) infoverb return dflags' checkNewInteractiveDynFlags :: MonadIO m => Logger -> DynFlags -> m DynFlags @@ -1067,7 +1211,7 @@ where filter targets = [ t | t@Target { targetId = id } <- targets, id /= target_id ] --- | Attempts to guess what Target a string refers to. This function +-- | Attempts to guess what 'Target' a string refers to. This function -- implements the @--make@/GHCi command-line syntax for filenames: -- -- - if the string looks like a Haskell source filename, then interpret it @@ -1076,27 +1220,52 @@ -- - if adding a .hs or .lhs suffix yields the name of an existing file, -- then use that -- --- - otherwise interpret the string as a module name +-- - If it looks like a module name, interpret it as such -- +-- - otherwise, this function throws a 'GhcException'. guessTarget :: GhcMonad m => String -> Maybe UnitId -> Maybe Phase -> m Target guessTarget str mUnitId (Just phase) = do tuid <- unitIdOrHomeUnit mUnitId return (Target (TargetFile str (Just phase)) True tuid Nothing) -guessTarget str mUnitId Nothing +guessTarget str mUnitId Nothing = do + targetId <- guessTargetId str + toTarget targetId + where + obj_allowed + | '*':_ <- str = False + | otherwise = True + toTarget tid = do + tuid <- unitIdOrHomeUnit mUnitId + pure $ Target tid obj_allowed tuid Nothing + +-- | Attempts to guess what 'TargetId' a string refers to. This function +-- implements the @--make@/GHCi command-line syntax for filenames: +-- +-- - if the string looks like a Haskell source filename, then interpret it +-- as such +-- +-- - if adding a .hs or .lhs suffix yields the name of an existing file, +-- then use that +-- +-- - If it looks like a module name, interpret it as such +-- +-- - otherwise, this function throws a 'GhcException'. +guessTargetId :: GhcMonad m => String -> m TargetId +guessTargetId str | isHaskellSrcFilename file - = target (TargetFile file Nothing) + = pure (TargetFile file Nothing) | otherwise = do exists <- liftIO $ doesFileExist hs_file if exists - then target (TargetFile hs_file Nothing) + then pure (TargetFile hs_file Nothing) else do exists <- liftIO $ doesFileExist lhs_file if exists - then target (TargetFile lhs_file Nothing) + then pure (TargetFile lhs_file Nothing) else do if looksLikeModuleName file - then target (TargetModule (mkModuleName file)) + then pure (TargetModule (mkModuleName file)) else do dflags <- getDynFlags liftIO $ throwGhcExceptionIO @@ -1104,16 +1273,12 @@ text "target" <+> quotes (text file) <+> text "is not a module name or a source file")) where - (file,obj_allowed) - | '*':rest <- str = (rest, False) - | otherwise = (str, True) - - hs_file = file <.> "hs" - lhs_file = file <.> "lhs" + file + | '*':rest <- str = rest + | otherwise = str - target tid = do - tuid <- unitIdOrHomeUnit mUnitId - pure $ Target tid obj_allowed tuid Nothing + hs_file = file <.> "hs" + lhs_file = file <.> "lhs" -- | Unwrap 'UnitId' or retrieve the 'UnitId' -- of the current 'HomeUnit'. @@ -1234,11 +1399,11 @@ -- -- This function ignores boot modules and requires that there is only one -- non-boot module with the given name. -getModSummary :: GhcMonad m => ModuleName -> m ModSummary +getModSummary :: GhcMonad m => Module -> m ModSummary getModSummary mod = do mg <- liftM hsc_mod_graph getSession let mods_by_name = [ ms | ms <- mgModSummaries mg - , ms_mod_name ms == mod + , ms_mod ms == mod , isBootSummary ms == NotBoot ] case mods_by_name of [] -> do dflags <- getDynFlags @@ -1269,7 +1434,9 @@ liftIO $ do let ms = modSummary pmod let lcl_dflags = ms_hspp_opts ms -- take into account pragmas (OPTIONS_GHC, etc.) - let lcl_hsc_env = hscSetFlags lcl_dflags hsc_env + let lcl_hsc_env = + hscSetFlags lcl_dflags $ + hscSetActiveUnitId (toUnitId $ moduleUnit $ ms_mod ms) hsc_env let lcl_logger = hsc_logger lcl_hsc_env (tc_gbl_env, rn_info) <- hscTypecheckRename lcl_hsc_env ms $ HsParsedModule { hpm_module = parsedSource pmod, @@ -1290,7 +1457,7 @@ minf_instances = fixSafeInstances safe $ instEnvElts $ md_insts details, minf_iface = Nothing, minf_safe = safe, - minf_modBreaks = emptyModBreaks + minf_modBreaks = Nothing }} -- | Desugar a typechecked module. @@ -1401,155 +1568,6 @@ cm_safe = safe_mode } --- %************************************************************************ --- %* * --- Inspecting the session --- %* * --- %************************************************************************ - --- | Get the module dependency graph. -getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary -getModuleGraph = liftM hsc_mod_graph getSession - --- | Return @True@ \<==> module is loaded. -isLoaded :: GhcMonad m => ModuleName -> m Bool -isLoaded m = withSession $ \hsc_env -> - return $! isJust (lookupHpt (hsc_HPT hsc_env) m) - -isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool -isLoadedModule uid m = withSession $ \hsc_env -> - return $! isJust (lookupHug (hsc_HUG hsc_env) uid m) - --- | Return the bindings for the current interactive session. -getBindings :: GhcMonad m => m [TyThing] -getBindings = withSession $ \hsc_env -> - return $ icInScopeTTs $ hsc_IC hsc_env - --- | Return the instances for the current interactive session. -getInsts :: GhcMonad m => m ([ClsInst], [FamInst]) -getInsts = withSession $ \hsc_env -> - let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env) - in return (instEnvElts inst_env, fam_env) - -getNamePprCtx :: GhcMonad m => m NamePprCtx -getNamePprCtx = withSession $ \hsc_env -> do - return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env) - --- | Container for information about a 'Module'. -data ModuleInfo = ModuleInfo { - minf_type_env :: TypeEnv, - minf_exports :: [AvailInfo], - minf_instances :: [ClsInst], - minf_iface :: Maybe ModIface, - minf_safe :: SafeHaskellMode, - minf_modBreaks :: ModBreaks - } - -- We don't want HomeModInfo here, because a ModuleInfo applies - -- to package modules too. - - --- | Request information about a loaded 'Module' -getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X -getModuleInfo mdl = withSession $ \hsc_env -> do - if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env - then liftIO $ getHomeModuleInfo hsc_env mdl - else liftIO $ getPackageModuleInfo hsc_env mdl - -getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) -getPackageModuleInfo hsc_env mdl - = do eps <- hscEPS hsc_env - iface <- hscGetModuleInterface hsc_env mdl - let - avails = mi_exports iface - pte = eps_PTE eps - tys = [ ty | name <- concatMap availNames avails, - Just ty <- [lookupTypeEnv pte name] ] - - return (Just (ModuleInfo { - minf_type_env = mkTypeEnv tys, - minf_exports = avails, - minf_instances = error "getModuleInfo: instances for package module unimplemented", - minf_iface = Just iface, - minf_safe = getSafeMode $ mi_trust iface, - minf_modBreaks = emptyModBreaks - })) - -availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv -availsToGlobalRdrEnv hsc_env mod avails - = forceGlobalRdrEnv rdr_env - -- See Note [Forcing GREInfo] in GHC.Types.GREInfo. - where - rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails) - -- We're building a GlobalRdrEnv as if the user imported - -- all the specified modules into the global interactive module - imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} - decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, - is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual, - is_dloc = srcLocSpan interactiveSrcLoc } - -getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) -getHomeModuleInfo hsc_env mdl = - case lookupHugByModule mdl (hsc_HUG hsc_env) of - Nothing -> return Nothing - Just hmi -> do - let details = hm_details hmi - iface = hm_iface hmi - return (Just (ModuleInfo { - minf_type_env = md_types details, - minf_exports = md_exports details, - -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo. - minf_instances = instEnvElts $ md_insts details, - minf_iface = Just iface, - minf_safe = getSafeMode $ mi_trust iface - ,minf_modBreaks = getModBreaks hmi - })) - --- | The list of top-level entities defined in a module -modInfoTyThings :: ModuleInfo -> [TyThing] -modInfoTyThings minf = typeEnvElts (minf_type_env minf) - -modInfoExports :: ModuleInfo -> [Name] -modInfoExports minf = concatMap availNames $! minf_exports minf - -modInfoExportsWithSelectors :: ModuleInfo -> [Name] -modInfoExportsWithSelectors minf = concatMap availNames $! minf_exports minf - --- | Returns the instances defined by the specified module. --- Warning: currently unimplemented for package modules. -modInfoInstances :: ModuleInfo -> [ClsInst] -modInfoInstances = minf_instances - -modInfoIsExportedName :: ModuleInfo -> Name -> Bool -modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf)) - -mkNamePprCtxForModule :: - GhcMonad m => - Module -> - ModuleInfo -> - m NamePprCtx -mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do - let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf)) - ptc = initPromotionTickContext (hsc_dflags hsc_env) - return name_ppr_ctx - -modInfoLookupName :: GhcMonad m => - ModuleInfo -> Name - -> m (Maybe TyThing) -- XXX: returns a Maybe X -modInfoLookupName minf name = withSession $ \hsc_env -> do - case lookupTypeEnv (minf_type_env minf) name of - Just tyThing -> return (Just tyThing) - Nothing -> liftIO (lookupType hsc_env name) - -modInfoIface :: ModuleInfo -> Maybe ModIface -modInfoIface = minf_iface - --- | Retrieve module safe haskell mode -modInfoSafe :: ModuleInfo -> SafeHaskellMode -modInfoSafe = minf_safe - -modInfoModBreaks :: ModuleInfo -> ModBreaks -modInfoModBreaks = minf_modBreaks - isDictonaryId :: Id -> Bool isDictonaryId id = isDictTy (idType id) @@ -1763,7 +1781,7 @@ modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $ text "module is not loaded:" <+> quotes (ppr (moduleName m)) <+> - parens (text (expectJust "modNotLoadedError" (ml_hs_file loc))) + parens (text (expectJust (ml_hs_file loc))) renamePkgQualM :: GhcMonad m => ModuleName -> Maybe FastString -> m PkgQual renamePkgQualM mn p = withSession $ \hsc_env -> pure (renamePkgQual (hsc_unit_env hsc_env) mn p) @@ -1800,12 +1818,56 @@ lookupQualifiedModule pkgqual mod_name = findQualifiedModule pkgqual mod_name lookupLoadedHomeModule :: GhcMonad m => UnitId -> ModuleName -> m (Maybe Module) -lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> do - liftIO $ trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModule" <+> ppr mod_name <+> ppr uid) - case lookupHug (hsc_HUG hsc_env) uid mod_name of +lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env -> liftIO $ do + trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModule" <+> ppr mod_name <+> ppr uid) + HUG.lookupHug (hsc_HUG hsc_env) uid mod_name >>= \case Just mod_info -> return (Just (mi_module (hm_iface mod_info))) _not_a_home_module -> return Nothing +-- | Lookup the given 'ModuleName' in the 'HomeUnitGraph'. +-- +-- Returns 'Nothing' if no 'Module' has the given 'ModuleName'. +-- Otherwise, returns all 'Module's that have the given 'ModuleName'. +-- +-- A 'ModuleName' is generally not enough to uniquely identify a 'Module', since +-- there can be multiple units exposing the same 'ModuleName' in the case of +-- multiple home units. +-- Thus, this function may return more than one possible 'Module'. +-- We leave it up to the caller to decide how to handle the ambiguity. +-- For example, GHCi may prompt the user to clarify which 'Module' is the correct one. +-- +lookupLoadedHomeModuleByModuleName :: GhcMonad m => ModuleName -> m (Maybe [Module]) +lookupLoadedHomeModuleByModuleName mod_name = withSession $ \hsc_env -> liftIO $ do + trace_if (hsc_logger hsc_env) (text "lookupLoadedHomeModuleByModuleName" <+> ppr mod_name) + HUG.lookupAllHug (hsc_HUG hsc_env) mod_name >>= \case + [] -> return Nothing + mod_infos -> return (Just (mi_module . hm_iface <$> mod_infos)) + +-- | Given a 'ModuleName' and 'PkgQual', lookup all 'Module's that may fit the criteria. +-- +-- Identically to 'lookupLoadedHomeModuleByModuleName', there may be more than one +-- 'Module' in the 'HomeUnitGraph' that has the given 'ModuleName'. +-- +-- The result is guaranteed to be non-empty, if no 'Module' can be found, +-- this function throws an error. +lookupAllQualifiedModuleNames :: GhcMonad m => PkgQual -> ModuleName -> m [Module] +lookupAllQualifiedModuleNames NoPkgQual mod_name = withSession $ \hsc_env -> do + home <- lookupLoadedHomeModuleByModuleName mod_name + case home of + Just m -> return m + Nothing -> liftIO $ do + let fc = hsc_FC hsc_env + let units = hsc_units hsc_env + let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags + res <- findExposedPackageModule fc fopts units mod_name NoPkgQual + case res of + Found _ m -> return [m] + err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err +lookupAllQualifiedModuleNames pkgqual mod_name = do + m <- findQualifiedModule pkgqual mod_name + pure [m] + -- | Check that a module is safe to import (according to Safe Haskell). -- -- We return True to indicate the import is safe and False otherwise @@ -1836,14 +1898,17 @@ getGHCiMonad = fmap (ic_monad . hsc_IC) getSession getHistorySpan :: GhcMonad m => History -> m SrcSpan -getHistorySpan h = withSession $ \hsc_env -> - return $ GHC.Runtime.Eval.getHistorySpan hsc_env h +getHistorySpan h = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.getHistorySpan (hsc_HUG hsc_env) h obtainTermFromVal :: GhcMonad m => Int -> Bool -> Type -> a -> m Term obtainTermFromVal bound force ty a = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.obtainTermFromVal hsc_env bound force ty a -obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term +obtainTermFromId :: GhcMonad m + => Int -- ^ How many times to recurse for subterms + -> Bool -- ^ Whether to force the expression + -> Id + -> m Term obtainTermFromId bound force id = withSession $ \hsc_env -> liftIO $ GHC.Runtime.Eval.obtainTermFromId hsc_env bound force id diff --git a/GHC/Builtin/Names.hs b/GHC/Builtin/Names.hs --- a/GHC/Builtin/Names.hs +++ b/GHC/Builtin/Names.hs @@ -54,14 +54,13 @@ 1. When parsing source code, the RdrName-decorated AST has some RdrNames which are Exact. These are wired-in RdrNames where we could directly tell from the parsed syntax what Name to - use. For example, when we parse a [] in a type we can just insert - an Exact RdrName Name with the listTyConKey. + use. For example, when we parse a [] in a type and ListTuplePuns + are enabled, we can just insert (Exact listTyConName :: RdrName). - Currently, I believe this is just an optimisation: it would be - equally valid to just output Orig RdrNames that correctly record - the module etc we expect the final Name to come from. However, - were we to eliminate isBuiltInOcc_maybe it would become essential - (see point 3). + This is just an optimisation: it would be equally valid to output + Orig RdrNames that correctly record the module (and package) that + we expect the final Name to come from. The name would be looked up + in the OrigNameCache (see point 3). 2. The knownKeyNames (which consist of the basicKnownKeyNames from the module, and those names reachable via the wired-in stuff from @@ -78,9 +77,10 @@ 3. For "infinite families" of known-key names (i.e. tuples and sums), we have to be extra careful. Because there are an infinite number of these things, we cannot add them to the list of known-key names - used to initialise the OrigNameCache. Instead, we have to - rely on never having to look them up in that cache. See - Note [Infinite families of known-key names] for details. + used to initialise the OrigNameCache. Instead, lookupOrigNameCache pretends + that these names are in the cache by using isInfiniteFamilyOrigName_maybe + before the actual lookup. + See Note [Infinite families of known-key names] for details. Note [Infinite families of known-key names] @@ -98,26 +98,15 @@ b) The known infinite families of names are specially serialised by GHC.Iface.Binary.putName, with that special treatment detected when we read - back to ensure that we get back to the correct uniques. See Note [Symbol - table representation of names] in GHC.Iface.Binary and Note [How tuples - work] in GHC.Builtin.Types. - -Most of the infinite families cannot occur in source code, so mechanisms (a) and (b) -suffice to ensure that they always have the right Unique. In particular, -implicit param TyCon names, constraint tuples and Any TyCons cannot be mentioned -by the user. For those things that *can* appear in source programs, - - c) GHC.Iface.Env.lookupOrigNameCache uses isBuiltInOcc_maybe to map built-in syntax - directly onto the corresponding name, rather than trying to find it in the - original-name cache. + back to ensure that we get back to the correct uniques. + See Note [Symbol table representation of names] in GHC.Iface.Binary and + Note [How tuples work] in GHC.Builtin.Types. + c) GHC.Iface.Env.lookupOrigNameCache uses isInfiniteFamilyOrigName_maybe to + map tuples and sums onto their exact names, rather than trying to find them + in the original-name cache. See also Note [Built-in syntax and the OrigNameCache] -Note that one-tuples are an exception to the rule, as they do get assigned -known keys. See -Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) -in GHC.Builtin.Types. - -} {-# LANGUAGE CPP #-} @@ -522,6 +511,8 @@ , unsafeEqualityTyConName , unsafeReflDataConName , unsafeCoercePrimName + + , unsafeUnpackJSStringUtf8ShShName ] genericTyConNames :: [Name] @@ -557,24 +548,23 @@ gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_INTERNAL_DATA_DATA, gHC_MAGIC, gHC_MAGIC_DICT, gHC_CLASSES, gHC_PRIMOPWRAPPERS :: Module -gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values -gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic") -gHC_TYPES = mkPrimModule (fsLit "GHC.Types") -gHC_MAGIC = mkPrimModule (fsLit "GHC.Magic") -gHC_MAGIC_DICT = mkPrimModule (fsLit "GHC.Magic.Dict") -gHC_CSTRING = mkPrimModule (fsLit "GHC.CString") -gHC_CLASSES = mkPrimModule (fsLit "GHC.Classes") -gHC_PRIMOPWRAPPERS = mkPrimModule (fsLit "GHC.PrimopWrappers") - -gHC_INTERNAL_TUPLE = mkPrimModule (fsLit "GHC.Tuple") +gHC_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.Prim") -- Primitive types and values +gHC_PRIM_PANIC = mkGhcInternalModule (fsLit "GHC.Internal.Prim.Panic") +gHC_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Types") +gHC_MAGIC = mkGhcInternalModule (fsLit "GHC.Internal.Magic") +gHC_MAGIC_DICT = mkGhcInternalModule (fsLit "GHC.Internal.Magic.Dict") +gHC_CSTRING = mkGhcInternalModule (fsLit "GHC.Internal.CString") +gHC_CLASSES = mkGhcInternalModule (fsLit "GHC.Internal.Classes") +gHC_PRIMOPWRAPPERS = mkGhcInternalModule (fsLit "GHC.Internal.PrimopWrappers") +gHC_INTERNAL_TUPLE = mkGhcInternalModule (fsLit "GHC.Internal.Tuple") gHC_INTERNAL_CONTROL_MONAD_ZIP :: Module gHC_INTERNAL_CONTROL_MONAD_ZIP = mkGhcInternalModule (fsLit "GHC.Internal.Control.Monad.Zip") gHC_INTERNAL_NUM_INTEGER, gHC_INTERNAL_NUM_NATURAL, gHC_INTERNAL_NUM_BIGNAT :: Module -gHC_INTERNAL_NUM_INTEGER = mkBignumModule (fsLit "GHC.Num.Integer") -gHC_INTERNAL_NUM_NATURAL = mkBignumModule (fsLit "GHC.Num.Natural") -gHC_INTERNAL_NUM_BIGNAT = mkBignumModule (fsLit "GHC.Num.BigNat") +gHC_INTERNAL_NUM_INTEGER = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Integer") +gHC_INTERNAL_NUM_NATURAL = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.Natural") +gHC_INTERNAL_NUM_BIGNAT = mkGhcInternalModule (fsLit "GHC.Internal.Bignum.BigNat") gHC_INTERNAL_BASE, gHC_INTERNAL_ENUM, gHC_INTERNAL_GHCI, gHC_INTERNAL_GHCI_HELPERS, gHC_CSTRING, gHC_INTERNAL_DATA_STRING, @@ -590,7 +580,8 @@ gHC_INTERNAL_ARROW, gHC_INTERNAL_DESUGAR, gHC_INTERNAL_RANDOM, gHC_INTERNAL_EXTS, gHC_INTERNAL_IS_LIST, gHC_INTERNAL_CONTROL_EXCEPTION_BASE, gHC_INTERNAL_TYPEERROR, gHC_INTERNAL_TYPELITS, gHC_INTERNAL_TYPELITS_INTERNAL, gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPENATS_INTERNAL, - gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR :: Module + gHC_INTERNAL_DATA_COERCE, gHC_INTERNAL_DEBUG_TRACE, gHC_INTERNAL_UNSAFE_COERCE, gHC_INTERNAL_FOREIGN_C_CONSTPTR, + gHC_INTERNAL_JS_PRIM, gHC_INTERNAL_WASM_PRIM_TYPES :: Module gHC_INTERNAL_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Base") gHC_INTERNAL_ENUM = mkGhcInternalModule (fsLit "GHC.Internal.Enum") gHC_INTERNAL_GHCI = mkGhcInternalModule (fsLit "GHC.Internal.GHCi") @@ -633,7 +624,7 @@ gHC_INTERNAL_EXTS = mkGhcInternalModule (fsLit "GHC.Internal.Exts") gHC_INTERNAL_IS_LIST = mkGhcInternalModule (fsLit "GHC.Internal.IsList") gHC_INTERNAL_CONTROL_EXCEPTION_BASE = mkGhcInternalModule (fsLit "GHC.Internal.Control.Exception.Base") -gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context") +gHC_INTERNAL_EXCEPTION_CONTEXT = mkGhcInternalModule (fsLit "GHC.Internal.Exception.Context") gHC_INTERNAL_GENERICS = mkGhcInternalModule (fsLit "GHC.Internal.Generics") gHC_INTERNAL_TYPEERROR = mkGhcInternalModule (fsLit "GHC.Internal.TypeError") gHC_INTERNAL_TYPELITS = mkGhcInternalModule (fsLit "GHC.Internal.TypeLits") @@ -644,6 +635,8 @@ gHC_INTERNAL_DEBUG_TRACE = mkGhcInternalModule (fsLit "GHC.Internal.Debug.Trace") gHC_INTERNAL_UNSAFE_COERCE = mkGhcInternalModule (fsLit "GHC.Internal.Unsafe.Coerce") gHC_INTERNAL_FOREIGN_C_CONSTPTR = mkGhcInternalModule (fsLit "GHC.Internal.Foreign.C.ConstPtr") +gHC_INTERNAL_JS_PRIM = mkGhcInternalModule (fsLit "GHC.Internal.JS.Prim") +gHC_INTERNAL_WASM_PRIM_TYPES = mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types") gHC_INTERNAL_SRCLOC :: Module gHC_INTERNAL_SRCLOC = mkGhcInternalModule (fsLit "GHC.Internal.SrcLoc") @@ -678,12 +671,6 @@ pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") mAIN_NAME = mkModuleNameFS (fsLit "Main") -mkPrimModule :: FastString -> Module -mkPrimModule m = mkModule primUnit (mkModuleNameFS m) - -mkBignumModule :: FastString -> Module -mkBignumModule m = mkModule bignumUnit (mkModuleNameFS m) - mkGhcInternalModule :: FastString -> Module mkGhcInternalModule m = mkGhcInternalModule_ (mkModuleNameFS m) @@ -1676,8 +1663,11 @@ tcQual gHC_INTERNAL_FOREIGN_C_CONSTPTR (fsLit "ConstPtr") constPtrTyConKey jsvalTyConName :: Name -jsvalTyConName = tcQual (mkGhcInternalModule (fsLit "GHC.Internal.Wasm.Prim.Types")) (fsLit "JSVal") jsvalTyConKey +jsvalTyConName = tcQual gHC_INTERNAL_WASM_PRIM_TYPES (fsLit "JSVal") jsvalTyConKey +unsafeUnpackJSStringUtf8ShShName :: Name +unsafeUnpackJSStringUtf8ShShName = varQual gHC_INTERNAL_JS_PRIM (fsLit "unsafeUnpackJSStringUtf8##") unsafeUnpackJSStringUtf8ShShKey + {- ************************************************************************ * * @@ -1822,7 +1812,7 @@ weakPrimTyConKey, mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey, orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey, realWorldTyConKey, stablePtrPrimTyConKey, - stablePtrTyConKey, eqTyConKey, heqTyConKey, ioPortPrimTyConKey, + stablePtrTyConKey, eqTyConKey, heqTyConKey, smallArrayPrimTyConKey, smallMutableArrayPrimTyConKey, stringTyConKey, ccArrowTyConKey, ctArrowTyConKey, tcArrowTyConKey :: Unique @@ -1859,7 +1849,7 @@ mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 31 orderingTyConKey = mkPreludeTyConUnique 32 mVarPrimTyConKey = mkPreludeTyConUnique 33 -ioPortPrimTyConKey = mkPreludeTyConUnique 34 +-- ioPortPrimTyConKey (34) was killed ratioTyConKey = mkPreludeTyConUnique 35 rationalTyConKey = mkPreludeTyConUnique 36 realWorldTyConKey = mkPreludeTyConUnique 37 @@ -2082,6 +2072,7 @@ , typeNatLogTyFamNameKey , typeConsSymbolTyFamNameKey, typeUnconsSymbolTyFamNameKey , typeCharToNatTyFamNameKey, typeNatToCharTyFamNameKey + , exceptionContextTyConKey, unsafeUnpackJSStringUtf8ShShKey :: Unique typeSymbolKindConNameKey = mkPreludeTyConUnique 400 typeCharKindConNameKey = mkPreludeTyConUnique 401 @@ -2104,8 +2095,9 @@ jsvalTyConKey = mkPreludeTyConUnique 418 -exceptionContextTyConKey :: Unique exceptionContextTyConKey = mkPreludeTyConUnique 420 + +unsafeUnpackJSStringUtf8ShShKey = mkPreludeMiscIdUnique 805 {- ************************************************************************ diff --git a/GHC/Builtin/Names/TH.hs b/GHC/Builtin/Names/TH.hs --- a/GHC/Builtin/Names/TH.hs +++ b/GHC/Builtin/Names/TH.hs @@ -75,7 +75,9 @@ funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName, classDName, instanceWithOverlapDName, standaloneDerivWithStrategyDName, sigDName, kiSigDName, forImpDName, - pragInlDName, pragOpaqueDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName, + pragInlDName, pragOpaqueDName, + pragSpecDName, pragSpecInlDName, pragSpecEDName, pragSpecInlEDName, + pragSpecInstDName, pragRuleDName, pragCompleteDName, pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName, defaultSigDName, defaultDName, dataFamilyDName, openTypeFamilyDName, closedTypeFamilyDName, @@ -177,7 +179,7 @@ modNameTyConName, -- Quasiquoting - quoteDecName, quoteTypeName, quoteExpName, quotePatName] + quasiQuoterTyConName, quoteDecName, quoteTypeName, quoteExpName, quotePatName] thSyn, thLib, qqLib, liftLib :: Module thSyn = mkTHModule (fsLit "GHC.Internal.TH.Syntax") @@ -214,7 +216,7 @@ fieldPatTyConName, expTyConName, decTyConName, typeTyConName, matchTyConName, clauseTyConName, funDepTyConName, predTyConName, codeTyConName, injAnnTyConName, overlapTyConName, decsTyConName, - modNameTyConName :: Name + modNameTyConName, quasiQuoterTyConName :: Name qTyConName = thTc (fsLit "Q") qTyConKey nameTyConName = thTc (fsLit "Name") nameTyConKey fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey @@ -232,6 +234,7 @@ injAnnTyConName = thTc (fsLit "InjectivityAnn") injAnnTyConKey overlapTyConName = thTc (fsLit "Overlap") overlapTyConKey modNameTyConName = thTc (fsLit "ModName") modNameTyConKey +quasiQuoterTyConName = mk_known_key_name tcName qqLib (fsLit "QuasiQuoter") quasiQuoterTyConKey returnQName, bindQName, sequenceQName, newNameName, liftName, mkNameName, mkNameG_vName, mkNameG_fldName, mkNameG_dName, mkNameG_tcName, @@ -386,7 +389,8 @@ -- data Dec = ... funDName, valDName, dataDName, newtypeDName, typeDataDName, tySynDName, classDName, instanceWithOverlapDName, sigDName, kiSigDName, forImpDName, pragInlDName, - pragSpecDName, pragSpecInlDName, pragSpecInstDName, pragRuleDName, + pragSpecDName, pragSpecInlDName, pragSpecEDName, pragSpecInlEDName, + pragSpecInstDName, pragRuleDName, pragAnnDName, pragSCCFunDName, pragSCCFunNamedDName, standaloneDerivWithStrategyDName, defaultSigDName, defaultDName, dataInstDName, newtypeInstDName, tySynInstDName, dataFamilyDName, @@ -411,6 +415,8 @@ pragOpaqueDName = libFun (fsLit "pragOpaqueD") pragOpaqueDIdKey pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey +pragSpecEDName = libFun (fsLit "pragSpecED") pragSpecEDIdKey +pragSpecInlEDName = libFun (fsLit "pragSpecInlED") pragSpecInlEDIdKey pragSpecInstDName = libFun (fsLit "pragSpecInstD") pragSpecInstDIdKey pragRuleDName = libFun (fsLit "pragRuleD") pragRuleDIdKey pragCompleteDName = libFun (fsLit "pragCompleteD") pragCompleteDIdKey @@ -712,7 +718,7 @@ predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey, roleTyConKey, codeTyConKey, injAnnTyConKey, kindTyConKey, overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey, - modNameTyConKey :: Unique + modNameTyConKey, quasiQuoterTyConKey :: Unique expTyConKey = mkPreludeTyConUnique 200 matchTyConKey = mkPreludeTyConUnique 201 clauseTyConKey = mkPreludeTyConUnique 202 @@ -748,6 +754,7 @@ codeTyConKey = mkPreludeTyConUnique 238 modNameTyConKey = mkPreludeTyConUnique 239 tyVarBndrVisTyConKey = mkPreludeTyConUnique 240 +quasiQuoterTyConKey = mkPreludeTyConUnique 241 {- ********************************************************************* * * @@ -962,7 +969,8 @@ infixLWithSpecDIdKey, infixRWithSpecDIdKey, infixNWithSpecDIdKey, roleAnnotDIdKey, patSynDIdKey, patSynSigDIdKey, pragCompleteDIdKey, implicitParamBindDIdKey, kiSigDIdKey, defaultDIdKey, pragOpaqueDIdKey, - typeDataDIdKey, pragSCCFunDKey, pragSCCFunNamedDKey :: Unique + typeDataDIdKey, pragSCCFunDKey, pragSCCFunNamedDKey, + pragSpecEDIdKey, pragSpecInlEDIdKey :: Unique funDIdKey = mkPreludeMiscIdUnique 320 valDIdKey = mkPreludeMiscIdUnique 321 dataDIdKey = mkPreludeMiscIdUnique 322 @@ -1001,6 +1009,8 @@ typeDataDIdKey = mkPreludeMiscIdUnique 355 pragSCCFunDKey = mkPreludeMiscIdUnique 356 pragSCCFunNamedDKey = mkPreludeMiscIdUnique 357 +pragSpecEDIdKey = mkPreludeMiscIdUnique 358 +pragSpecInlEDIdKey = mkPreludeMiscIdUnique 359 -- type Cxt = ... cxtIdKey :: Unique diff --git a/GHC/Builtin/PrimOps/Ids.hs b/GHC/Builtin/PrimOps/Ids.hs --- a/GHC/Builtin/PrimOps/Ids.hs +++ b/GHC/Builtin/PrimOps/Ids.hs @@ -16,6 +16,7 @@ import {-# SOURCE #-} GHC.Core.Opt.ConstantFold (primOpRules) import GHC.Core.TyCo.Rep ( scaledThing ) import GHC.Core.Type +import GHC.Core.Predicate( tyCoVarsOfTypeWellScoped ) import GHC.Core.FVs (mkRuleInfo) import GHC.Builtin.PrimOps @@ -98,7 +99,7 @@ | tv `elem` [ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar , levity1TyVar, levity2TyVar ] = listToMaybe $ - mapMaybe (\ (i,arg) -> Argument i <$> positiveKindPos_maybe tv arg) + mapMaybe (\ (i,arg) -> mkArgPos i <$> positiveKindPos_maybe tv arg) (zip [1..] arg_tys) | otherwise = Nothing @@ -123,7 +124,7 @@ ) where recur (pos, scaled_ty) - = Argument pos <$> positiveKindPos_maybe tv (scaledThing scaled_ty) + = mkArgPos pos <$> positiveKindPos_maybe tv (scaledThing scaled_ty) -- (assumes we don't have any function types nested inside other types) -- | Does this type variable appear in a kind in a positive position in the @@ -144,7 +145,7 @@ ) where recur (pos, scaled_ty) - = Argument pos <$> negativeKindPos_maybe tv (scaledThing scaled_ty) + = mkArgPos pos <$> negativeKindPos_maybe tv (scaledThing scaled_ty) -- (assumes we don't have any function types nested inside other types) finish ty | tv `elemVarSet` tyCoVarsOfType (typeKind ty) diff --git a/GHC/Builtin/Types.hs b/GHC/Builtin/Types.hs --- a/GHC/Builtin/Types.hs +++ b/GHC/Builtin/Types.hs @@ -20,8 +20,9 @@ mkWiredInIdName, -- used in GHC.Types.Id.Make -- * All wired in things - wiredInTyCons, isBuiltInOcc_maybe, isTupleTyOcc_maybe, isSumTyOcc_maybe, - isPunOcc_maybe, + wiredInTyCons, isBuiltInOcc, isBuiltInOcc_maybe, + isTupleTyOrigName_maybe, isSumTyOrigName_maybe, + isInfiniteFamilyOrigName_maybe, -- * Bool boolTy, boolTyCon, boolTyCon_RDR, boolTyConName, @@ -82,12 +83,12 @@ pairTyCon, mkPromotedPairTy, isPromotedPairType, unboxedUnitTy, unboxedUnitTyCon, unboxedUnitDataCon, + unboxedSoloTyCon, unboxedSoloTyConName, unboxedSoloDataConName, unboxedTupleKind, unboxedSumKind, - filterCTuple, mkConstraintTupleTy, + mkConstraintTupleTy, -- ** Constraint tuples cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, - cTupleTyConNameArity_maybe, cTupleDataCon, cTupleDataConName, cTupleDataConNames, cTupleSelId, cTupleSelIdName, @@ -99,6 +100,7 @@ -- * Sums mkSumTy, sumTyCon, sumDataCon, + unboxedSumTyConName, unboxedSumDataConName, -- * Kinds typeSymbolKindCon, typeSymbolKind, @@ -206,6 +208,7 @@ import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE ) import GHC.Unit.Module ( Module ) +import Data.Maybe import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -214,13 +217,14 @@ import GHC.Utils.Misc import GHC.Utils.Panic -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Short as SBS +import qualified Data.ByteString.Short.Internal as SBS (unsafeIndex) import Data.Foldable -import Data.List ( elemIndex, intersperse ) +import Data.List ( intersperse ) import Numeric ( showInt ) -import Data.Char (ord, isDigit) +import Data.Word (Word8) import Control.Applicative ((<|>)) alpha_tyvar :: [TyVar] @@ -278,38 +282,22 @@ -} --- This list is used only to define GHC.Builtin.Utils.wiredInThings. That in turn +-- This list is used only to define GHC.Builtin.Utils.knownKeyNames. That in turn -- is used to initialise the name environment carried around by the renamer. -- This means that if we look up the name of a TyCon (or its implicit binders) -- that occurs in this list that name will be assigned the wired-in key we -- define here. -- -- Because of their infinite nature, this list excludes --- * tuples, including boxed, unboxed and constraint tuples ---- (mkTupleTyCon, unitTyCon, pairTyCon) --- * unboxed sums (sumTyCon) +-- * Tuples of all sorts (boxed, unboxed, constraint) (mkTupleTyCon) +-- * Unboxed sums (sumTyCon) -- See Note [Infinite families of known-key names] in GHC.Builtin.Names -- -- See also Note [Known-key names] wiredInTyCons :: [TyCon] wiredInTyCons = map (dataConTyCon . snd) boxingDataCons - ++ [ -- Units are not treated like other tuples, because they - -- are defined in GHC.Base, and there's only a few of them. We - -- put them in wiredInTyCons so that they will pre-populate - -- the name cache, so the parser in isBuiltInOcc_maybe doesn't - -- need to look out for them. - unitTyCon - , unboxedUnitTyCon - - -- Solo (i.e., the boxed 1-tuple) is also not treated - -- like other tuples (i.e. we /do/ include it here), - -- since it does not use special syntax like other tuples - -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names - -- have known keys) in GHC.Builtin.Types. - , soloTyCon - - , anyTyCon + ++ [ anyTyCon , zonkAnyTyCon , boolTyCon , charTyCon @@ -332,6 +320,7 @@ , constraintKindTyCon , liftedTypeKindTyCon , unliftedTypeKindTyCon + , unrestrictedFunTyCon , multiplicityTyCon , naturalTyCon , integerTyCon @@ -521,6 +510,17 @@ See examples in ghc-prim:GHC.Types +(Any8) Warning about unused bindings of type `Any` and `ZonkAny` are suppressed, + following the same rationale of supressing warning about the unit type. + + For example, consider (#25895): + + do { forever (return ()); blah } + + where forever :: forall a b. IO a -> IO b + Nothing constrains `b`, so it will be instantiates with `Any` or `ZonkAny`. + But we certainly don't want to complain about a discarded do-binding. + The Any tycon used to be quite magic, but we have since been able to implement it merely with an empty kind polymorphic type family. See #10886 for a bit of history. @@ -709,10 +709,12 @@ -- See Note [Constructor tag allocation] and #14657 data_con = mkDataCon dc_name declared_infix prom_info (map (const no_bang) arg_tys) + (map (const HsLazy) arg_tys) + (map (const NotMarkedStrict) arg_tys) [] -- No labelled fields tyvars ex_tyvars conc_tyvars - (mkTyVarBinders SpecifiedSpec user_tyvars) + (mkTyVarBinders Specified user_tyvars) [] -- No equality spec theta arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)) @@ -723,7 +725,7 @@ (mkDataConWorkId wrk_name data_con) NoDataConRep -- Wired-in types are too simple to need wrappers - no_bang = mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict + no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict wrk_name = mkDataConWorkerName data_con wrk_key @@ -806,10 +808,8 @@ E.g. tupleTyCon has a Boxity argument * When looking up an OccName in the original-name cache - (GHC.Iface.Env.lookupOrigNameCache), we spot the tuple OccName to make sure - we get the right wired-in name. This guy can't tell the difference - between BoxedTuple and ConstraintTuple (same OccName!), so tuples - are not serialised into interface files using OccNames at all. + (GHC.Types.Name.Cache.lookupOrigNameCache), we spot the tuple OccName to make + sure we get the right wired-in name. * Serialization to interface files works via the usual mechanism for known-key things: instead of serializing the OccName we just serialize the key. During @@ -849,181 +849,467 @@ There is nothing special about one-tuples in Core; in particular, they have no custom pretty-printing, just using `Solo`. -Note that there is *not* a unary constraint tuple, unlike for other forms of -tuples. See [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType for more -details. - See also Note [Flattening one-tuples] in GHC.Core.Make and Note [Don't flatten tuples from HsSyn] in GHC.Core.Make. ------ --- Wrinkle: Make boxed one-tuple names have known keys ------ +Note [isBuiltInOcc_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~ +`isBuiltInOcc_maybe` matches and resolves names that are occurrences of built-in +syntax, i.e. unqualified names that can be unambiguously resolved even without +knowing what's currently in scope (such names also can't be imported, exported, +or redefined in another module). +More on that in Note [Built-in syntax and the OrigNameCache] in GHC.Types.Name.Cache. -We make boxed one-tuple names have known keys so that `data Solo a = MkSolo a`, -defined in GHC.Tuple, will be used when one-tuples are spliced in through -Template Haskell. This program (from #18097) crucially relies on this: +In GHC, there are two use cases for `isBuiltInOcc_maybe`: - case $( tupE [ [| "ok" |] ] ) of MkSolo x -> putStrLn x +1. Making TH's `mkName` work with built-in syntax, + e.g. $(conT (mkName "[]")) is the same as [] -Unless Solo has a known key, the type of `$( tupE [ [| "ok" |] ] )` (an -ExplicitTuple of length 1) will not match the type of Solo (an ordinary -data constructor used in a pattern). Making Solo known-key allows GHC to make -this connection. +2. Detecting bulit-in syntax in `infix` declarations, + e.g. users can't write `infixl 6 :` (#15233) -Unlike Solo, every other tuple is /not/ known-key -(see Note [Infinite families of known-key names] in GHC.Builtin.Names). The -main reason for this exception is that other tuples are written with special -syntax, and as a result, they are renamed using a special `isBuiltInOcc_maybe` -function (see Note [Built-in syntax and the OrigNameCache] in GHC.Types.Name.Cache). -In contrast, Solo is just an ordinary data type with no special syntax, so it -doesn't really make sense to handle it in `isBuiltInOcc_maybe`. Making Solo -known-key is the next-best way to teach the internals of the compiler about it. +The parser takes a shortcut and produces Exact RdrNames directly, +so it doesn't need to match on an OccName with isBuiltInOcc_maybe. + +And here are the properties of `isBuiltInOcc_maybe`: + +* The set of names recognized by `isBuiltInOcc_maybe` is essentialy the + same as the set of names that the parser resolves to Exact RdrNames, + e.g. "[]", "(,)", or "->". + + We could leave it at that, but we also recognize unboxed sum syntax + "(#|#)" even though the parser can't handle it. This makes TH's `mkName` + more permissive than the parser. + +* The namespace of the input OccName is treated as a hint, not a + requirement. For example, + + mkOccName dataName ":" maps to consDataConName + mkOccName tcClsName ":" /also/ maps to consDataConName + + The rationale behind this is that with DataKind or RequiredTypeArguments + we may get an OccName with the wrong namespace and need to fallback to the + other one. + +* There is a `listTuplePuns :: Bool` parameter to account for the + ListTuplePuns extension. It has /no/ effect on whether the predicate + matches (i.e. if the result is Just or Nothing), but it can influence + which name is returned (TyCon name or DataCon name). For example, + + isBuiltInOcc_maybe False (mkOccName dataName "[]") == Just nilDataConName + isBuiltInOcc_maybe False (mkOccName tcClsName "[]") == Just nilDataConName + isBuiltInOcc_maybe True (mkOccName dataName "[]") == Just nilDataConName + isBuiltInOcc_maybe True (mkOccName tcClsName "[]") == Just listTyConName + +* There is no `Module` parameter because we are matching unqualified + occurrences of built-in names. It is illegal to qualify built-in syntax, + e.g. GHC.Types.(,) is a parse error. + +* The /input/ to `isBuiltInOcc_maybe` needs to be built-in syntax for the + predicate to match, but the /output/ is not necessarily built-in syntax. + For example, + + 1) input: mkTcOcc "[]" -- built-in syntax + output: Just listTyConName -- user syntax (GHC.Types.List) + + 2) input: mkDataOcc "[]" -- built-in syntax + output: Just nilDataConName -- built-in syntax [] + + 3) input: mkTcOcc "List" -- user syntax + output: Nothing -- no match + + 4) input: mkTcOcc "(,)" -- built-in syntax + output: Just (tupleTyConName BoxedTuple 2) -- user syntax (GHC.Types.Tuple2) + + 5) input: mkTcOcc "(#|#)" -- built-in syntax + output: Just (unboxedSumTyConName 2) -- user syntax (GHC.Types.Sum2#) + + Therefore, `GHC.Types.Name.isBuiltInSyntax` may or may not hold for the name + returned by `isBuiltInOcc_maybe`. -} --- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names --- with BuiltInSyntax. However, this should only be necessary while resolving --- names produced by Template Haskell splices since we take care to encode --- built-in syntax names specially in interface files. See --- Note [Symbol table representation of names] in GHC.Iface.Binary. +-- | Match on built-in syntax as it occurs at use sites. +-- See Note [isBuiltInOcc_maybe] +isBuiltInOcc_maybe :: Bool -> OccName -> Maybe Name +isBuiltInOcc_maybe listTuplePuns occ + | fs == "->" = Just unrestrictedFunTyConName + | fs == "[]" = Just (pun listTyConName nilDataConName) + | fs == ":" = Just consDataConName + | Just n <- (is_boxed_tup_syntax fs) = Just (tup_name Boxed n) + | Just n <- (is_unboxed_tup_syntax fs) = Just (tup_name Unboxed n) + | Just n <- (is_unboxed_sum_type_syntax fs) = Just (unboxedSumTyConName n) + | Just (k, n) <- (is_unboxed_sum_data_syntax fs) = Just (unboxedSumDataConName k n) + | otherwise = Nothing + where + fs = occNameFS occ + ns = occNameSpace occ + + pun :: Name -> Name -> Name + pun p n + | listTuplePuns, isTcClsNameSpace ns = p + | otherwise = n + + tup_name :: Boxity -> Arity -> Name + tup_name boxity arity + = pun (tyConName (tupleTyCon boxity arity)) + (dataConName (tupleDataCon boxity arity)) + +-- | Check if the OccName is an occurrence of built-in syntax. -- --- Moreover, there is no need to include names of things that the user can't --- write (e.g. type representation bindings like $tc(,,,)). -isBuiltInOcc_maybe :: OccName -> Maybe Name -isBuiltInOcc_maybe occ = - case name of - "[]" -> Just $ choose_ns listTyConName nilDataConName - ":" -> Just consDataConName +-- This is a variant of `isBuiltInOcc_maybe` that returns a `Bool`. +-- See Note [isBuiltInOcc_maybe] +-- +-- `isBuiltInOcc` holds for: +-- * function arrow `->` +-- * list syntax `[]`, `:` +-- * boxed tuple syntax `()`, `(,)`, `(,,)`, `(,,,)`, ... +-- * unboxed tuple syntax `(##)`, `(#,#)`, `(#,,#)`, ... +-- * unboxed sum type syntax `(#|#)`, `(#||#)`, `(#|||#)`, ... +-- * unboxed sum data syntax `(#_|#)`, `(#|_#)`, `(#_||#), ... +isBuiltInOcc :: OccName -> Bool +isBuiltInOcc = isJust . isBuiltInOcc_maybe listTuplePuns + where + listTuplePuns = False + -- True/False here is inconsequential because ListTuplePuns doesn't affect + -- whether isBuiltInOcc_maybe matches. See Note [isBuiltInOcc_maybe] - -- function tycon - "->" -> Just unrestrictedFunTyConName +-- Match on original names of infinite families (tuples and sums). +-- See Note [Infinite families of known-key names] in GHC.Builtin.Names +isInfiniteFamilyOrigName_maybe :: Module -> OccName -> Maybe Name +isInfiniteFamilyOrigName_maybe mod occ = - -- tuple data/tycon - -- We deliberately exclude Solo (the boxed 1-tuple). - -- See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) - "()" -> Just $ tup_name Boxed 0 - _ | Just rest <- "(" `BS.stripPrefix` name - , (commas, rest') <- BS.span (==',') rest - , ")" <- rest' - -> Just $ tup_name Boxed (1+BS.length commas) + -- Tuples, boxed and unboxed + isTupleTyOrigName_maybe mod occ + <|> isTupleDataOrigName_maybe mod occ - -- unboxed tuple data/tycon - "(##)" -> Just $ tup_name Unboxed 0 - "(# #)" -> Just $ tup_name Unboxed 1 - _ | Just rest <- "(#" `BS.stripPrefix` name - , (commas, rest') <- BS.span (==',') rest - , "#)" <- rest' - -> Just $ tup_name Unboxed (1+BS.length commas) + -- Constraint tuples + <|> isCTupleOrigName_maybe mod occ - -- unboxed sum tycon - _ | Just rest <- "(#" `BS.stripPrefix` name - , (nb_pipes, rest') <- span_pipes rest - , "#)" <- rest' - -> Just $ tyConName $ sumTyCon (1+nb_pipes) + -- Unboxed sums + <|> isSumTyOrigName_maybe mod occ + <|> isSumDataOrigName_maybe mod occ - -- unboxed sum datacon - _ | Just rest <- "(#" `BS.stripPrefix` name - , (nb_pipes1, rest') <- span_pipes rest - , Just rest'' <- "_" `BS.stripPrefix` rest' - , (nb_pipes2, rest''') <- span_pipes rest'' - , "#)" <- rest''' - -> let arity = nb_pipes1 + nb_pipes2 + 1 - alt = nb_pipes1 + 1 - in Just $ dataConName $ sumDataCon alt arity +-- Check if the string has form "()", "(,)", "(,,)", etc, +-- and return the corresponding tuple arity. +is_boxed_tup_syntax :: FastString -> Maybe Arity +is_boxed_tup_syntax fs + | fs == "()" = Just 0 + | n >= 2 + , SBS.unsafeIndex sbs 0 == 40 -- ord '(' + , SBS.unsafeIndex sbs (n-1) == 41 -- ord ')' + , sbs_all sbs 1 (n-1) 44 -- ord ',' + = Just (n-1) + where + n = SBS.length sbs -- O(1) + sbs = fastStringToShortByteString fs -- O(1) field access +is_boxed_tup_syntax _ = Nothing - _ -> Nothing +-- Check if the string has form "(##)", "(# #)", (#,#)", "(#,,#)", etc, +-- and return the corresponding tuple arity. +is_unboxed_tup_syntax :: FastString -> Maybe Arity +is_unboxed_tup_syntax fs + | fs == "(##)" = Just 0 + | fs == "(# #)" = Just 1 + | sbs_unboxed sbs + , sbs_all sbs 2 (n-2) 44 -- ord ',' + = Just (n-3) where - name = bytesFS $ occNameFS occ + n = SBS.length sbs -- O(1) + sbs = fastStringToShortByteString fs -- O(1) field access +is_unboxed_tup_syntax _ = Nothing - span_pipes :: BS.ByteString -> (Int, BS.ByteString) - span_pipes = go 0 - where - go nb_pipes bs = case BS.uncons bs of - Just ('|',rest) -> go (nb_pipes + 1) rest - Just (' ',rest) -> go nb_pipes rest - _ -> (nb_pipes, bs) +-- Check if the string has form "(#|#)", "(#||#)", (#|||#)", etc, +-- and return the corresponding sum arity. +is_unboxed_sum_type_syntax :: FastString -> Maybe Arity +is_unboxed_sum_type_syntax fs + | sbs_unboxed sbs + , Just k <- sbs_pipes sbs 2 (n-2) + , k > 0 + = Just (k+1) + where + n = SBS.length sbs -- O(1) + sbs = fastStringToShortByteString fs -- O(1) field access +is_unboxed_sum_type_syntax _ = Nothing - choose_ns :: Name -> Name -> Name - choose_ns tc dc - | isTcClsNameSpace ns = tc - | isDataConNameSpace ns = dc - | otherwise = pprPanic "tup_name" (ppr occ <+> parens (pprNameSpace ns)) - where ns = occNameSpace occ +-- Check if the string has form "(#_|#)", "(#_||#)", (#|_|#)", etc, +-- and return the corresponding sum tag and sum arity. +is_unboxed_sum_data_syntax :: FastString -> Maybe (ConTag, Arity) +is_unboxed_sum_data_syntax fs + | sbs_unboxed sbs + , Just u <- SBS.elemIndex 95 sbs -- ord '_' + , Just k1 <- sbs_pipes sbs 2 u -- pipes to the left of '_' + , Just k2 <- sbs_pipes sbs (u+1) (n-2) -- pipes to the right of '_' + = Just (k1+1, k1+k2+1) + where + n = SBS.length sbs -- O(1) + sbs = fastStringToShortByteString fs -- O(1) field access +is_unboxed_sum_data_syntax _ = Nothing - tup_name boxity arity - = choose_ns (getName (tupleTyCon boxity arity)) - (getName (tupleDataCon boxity arity)) +-- (sbs_all sbs i n x) checks if all bytes in the slice [i..n) are equal to x. +sbs_all :: SBS.ShortByteString -> Int -> Int -> Word8 -> Bool +sbs_all !sbs !i !n !x + | i < n = SBS.unsafeIndex sbs i == x && sbs_all sbs (i+1) n x + | otherwise = True -isTupleTyOcc_maybe :: Module -> OccName -> Maybe Name -isTupleTyOcc_maybe mod occ - | mod == gHC_INTERNAL_TUPLE || mod == gHC_TYPES - = match_occ +-- (sbs_pipes sbs i n) checks if all bytes in the slice [i..n) are equal to '|' +-- or ' ', and returns the number of encountered '|'. +sbs_pipes :: SBS.ShortByteString -> Int -> Int -> Maybe Int +sbs_pipes !sbs = go 0 where - match_occ + go :: Int -> Int -> Int -> Maybe Int + go !k !i !n + | i < n = + if | SBS.unsafeIndex sbs i == 124 -> go (k+1) (i+1) n -- ord '|' + | SBS.unsafeIndex sbs i == 32 -> go k (i+1) n -- ord ' ' + | otherwise -> Nothing + | otherwise = Just k + +-- (sbs_unboxed sbs) checks if the string starts with "(#" and ends with "#)". +sbs_unboxed :: SBS.ShortByteString -> Bool +sbs_unboxed !sbs = + n >= 4 && SBS.unsafeIndex sbs 0 == 40 -- ord '(' + && SBS.unsafeIndex sbs 1 == 35 -- ord '#' + && SBS.unsafeIndex sbs (n-2) == 35 -- ord '#' + && SBS.unsafeIndex sbs (n-1) == 41 -- ord ')' + where + n = SBS.length sbs -- O(1) + +-- (sbs_Sum sbs) checks if the string has form "SumN#" or "SumNM#", +-- where "N" or "NM" is a decimal numeral in the [2..mAX_SUM_SIZE] range. +sbs_Sum :: SBS.ShortByteString -> Maybe Arity +sbs_Sum !sbs + | n >= 3 && SBS.unsafeIndex sbs 0 == 83 -- ord 'S' + && SBS.unsafeIndex sbs 1 == 117 -- ord 'u' + && SBS.unsafeIndex sbs 2 == 109 -- ord 'm' + , Just (Unboxed, arity) <- sbs_arity_boxity sbs 3 + , arity >= 2, arity <= mAX_SUM_SIZE + = Just arity + | otherwise = Nothing + where + n = SBS.length sbs -- O(1) + +-- (sbs_Tuple sbs) checks if the string has form "TupleN", "TupleNM", "TupleN#" or "TupleNM#", +-- where "N" or "NM" is a decimal numeral in the [2..mAX_TUPLE_SIZE] range. +sbs_Tuple :: SBS.ShortByteString -> Maybe (Boxity, Arity) +sbs_Tuple !sbs + | n >= 5 && SBS.unsafeIndex sbs 0 == 84 -- ord 'T' + && SBS.unsafeIndex sbs 1 == 117 -- ord 'u' + && SBS.unsafeIndex sbs 2 == 112 -- ord 'p' + && SBS.unsafeIndex sbs 3 == 108 -- ord 'l' + && SBS.unsafeIndex sbs 4 == 101 -- ord 'e' + , Just r@(_, arity) <- sbs_arity_boxity sbs 5 + , arity >= 2, arity <= mAX_TUPLE_SIZE + = Just r + | otherwise = Nothing + where + n = SBS.length sbs -- O(1) + +-- (sbs_CTuple sbs) checks if the string has form "CTupleN" or "CTupleNM", +-- where "N" or "NM" is a decimal numeral in the [2..mAX_CTUPLE_SIZE] range. +sbs_CTuple :: SBS.ShortByteString -> Maybe Arity +sbs_CTuple !sbs + | n >= 6 && SBS.unsafeIndex sbs 0 == 67 -- ord 'C' + && SBS.unsafeIndex sbs 1 == 84 -- ord 'T' + && SBS.unsafeIndex sbs 2 == 117 -- ord 'u' + && SBS.unsafeIndex sbs 3 == 112 -- ord 'p' + && SBS.unsafeIndex sbs 4 == 108 -- ord 'l' + && SBS.unsafeIndex sbs 5 == 101 -- ord 'e' + , Just (Boxed, arity) <- sbs_arity_boxity sbs 6 + , arity >= 2, arity <= mAX_CTUPLE_SIZE + = Just arity + | otherwise = Nothing + where + n = SBS.length sbs -- O(1) + +-- (sbs_arity_boxity sbs i) parses bytes from position `i` to the end, +-- matching single- and double-digit decimals numerals (i.e. from 0 to 99) +-- possibly followed by '#'. See Note [Small Ints parsing] +sbs_arity_boxity :: SBS.ShortByteString -> Int -> Maybe (Boxity, Arity) +sbs_arity_boxity !sbs !i = + case n - i of -- bytes to parse + 1 -> parse1 (SBS.unsafeIndex sbs i) + 2 -> parse2 (SBS.unsafeIndex sbs i) (SBS.unsafeIndex sbs (i+1)) + 3 -> parse3 (SBS.unsafeIndex sbs i) (SBS.unsafeIndex sbs (i+1)) (SBS.unsafeIndex sbs (i+2)) + _ -> Nothing + where + n = SBS.length sbs -- O(1) + + is_digit :: Word8 -> Bool + is_digit x = x >= 48 && x <= 57 -- between (ord '0') and (ord '9') + + from_digit :: Word8 -> Int + from_digit x = fromIntegral (x - 48) + + -- single-digit number + parse1 :: Word8 -> Maybe (Boxity, Arity) + parse1 x1 | is_digit x1 = Just (Boxed, from_digit x1) + parse1 _ = Nothing + + -- double-digit number, or a single-digit number followed by '#' + parse2 :: Word8 -> Word8 -> Maybe (Boxity, Arity) + parse2 x1 35 -- ord '#' + | is_digit x1 = Just (Unboxed, from_digit x1) + parse2 x1 x2 + | is_digit x1, is_digit x2 + = Just (Boxed, from_digit x1 * 10 + from_digit x2) + parse2 _ _ = Nothing + + -- double-digit number followed by '#' + parse3 :: Word8 -> Word8 -> Word8 -> Maybe (Boxity, Arity) + parse3 x1 x2 35 -- ord '#' + | is_digit x1, is_digit x2 + = Just (Unboxed, from_digit x1 * 10 + from_digit x2) + parse3 _ _ _ = Nothing + +-- Identify original names of boxed and unboxed tuple type constructors. +-- Examples: +-- 0b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Unit") = Just +-- 1b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Solo") = Just +-- 2b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Tuple2") = Just +-- 0u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Unit#") = Just +-- 1u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Solo#") = Just +-- 2u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Tuple2#") = Just +-- ... +-- 64b) isTupleTyOrigName_maybe GHC.Tuple (mkTcOcc "Tuple64") = Just +-- 64u) isTupleTyOrigName_maybe GHC.Types (mkTcOcc "Tuple64#") = Just +-- +-- Non-examples: "()", "(##)", "(,)", "(#,#)", "(,,)", "(#,,#)", etc. +-- As far as tuple /types/ are concerned, these are not the original names +-- but rather punned names under ListTuplePuns. +-- +-- Also non-examples: "Tuple0", "Tuple0#", "Tuple1", and "Tuple1#". +-- These are merely type synonyms for "Unit", "Unit#", "Solo", and "Solo#". +isTupleTyOrigName_maybe :: Module -> OccName -> Maybe Name +isTupleTyOrigName_maybe mod occ + | mod == gHC_INTERNAL_TUPLE = match_occ_boxed + | mod == gHC_TYPES = match_occ_unboxed + where + fs = occNameFS occ + ns = occNameSpace occ + sbs = fastStringToShortByteString fs -- O(1) field access + + match_occ_boxed | occ == occName unitTyConName = Just unitTyConName | occ == occName soloTyConName = Just soloTyConName + | isTcClsNameSpace ns, Just (boxity@Boxed, n) <- sbs_Tuple sbs, n >= 2 + = Just (tyConName (tupleTyCon boxity n)) + | otherwise = Nothing + + match_occ_unboxed | occ == occName unboxedUnitTyConName = Just unboxedUnitTyConName | occ == occName unboxedSoloTyConName = Just unboxedSoloTyConName - | otherwise = isTupleNTyOcc_maybe occ -isTupleTyOcc_maybe _ _ = Nothing + | isTcClsNameSpace ns, Just (boxity@Unboxed, n) <- sbs_Tuple sbs, n >= 2 + = Just (tyConName (tupleTyCon boxity n)) + | otherwise = Nothing -isCTupleOcc_maybe :: Module -> OccName -> Maybe Name -isCTupleOcc_maybe mod occ +isTupleTyOrigName_maybe _ _ = Nothing + +-- Identify original names of boxed and unboxed tuple data constructors. +-- Examples: +-- 0b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "()") = Just +-- 1b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "MkSolo") = Just +-- 2b) isTupleDataOrigName_maybe GHC.Tuple (mkDataOcc "(,)") = Just +-- ... +-- 0u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "(##)") = Just +-- 1u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "MkSolo#") = Just +-- 2u) isTupleDataOrigName_maybe GHC.Types (mkDataOcc "(#,#)") = Just +-- ... +-- +-- Non-examples: Tuple or Tuple#, as this is the name format of tuple /type/ constructors. +isTupleDataOrigName_maybe :: Module -> OccName -> Maybe Name +isTupleDataOrigName_maybe mod occ + | mod == gHC_INTERNAL_TUPLE = match_occ_boxed + | mod == gHC_TYPES = match_occ_unboxed + where + match_occ_boxed + | occ == occName soloDataConName = Just soloDataConName + | isDataConNameSpace ns, Just n <- (is_boxed_tup_syntax fs) + = Just (tupleDataConName Boxed n) + | otherwise = Nothing + match_occ_unboxed + | occ == occName unboxedSoloDataConName = Just unboxedSoloDataConName + | isDataConNameSpace ns, Just n <- (is_unboxed_tup_syntax fs) + = Just (tupleDataConName Unboxed n) + | otherwise = Nothing + fs = occNameFS occ + ns = occNameSpace occ +isTupleDataOrigName_maybe _ _ = Nothing + +-- Identify original names of constraint tuples. +-- Examples: +-- 0) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CUnit") = Just +-- 1) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CSolo") = Just +-- 2) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CTuple2") = Just +-- ... +-- 64) isCTupleOrigName_maybe GHC.Classes (mkClsOcc "CTuple64") = Just +-- +-- Non-examples: "()", "(,)", "(,,)", etc. +-- As far as constraint tuples are concerned, these are not the original names +-- but rather punned names under ListTuplePuns. +-- +-- Also non-examples: "CTuple0" and "CTuple1". +-- These are merely type synonyms for "CUnit" and "CSolo". +isCTupleOrigName_maybe :: Module -> OccName -> Maybe Name +isCTupleOrigName_maybe mod occ | mod == gHC_CLASSES = match_occ where + fs = occNameFS occ + sbs = fastStringToShortByteString fs -- O(1) field access match_occ - | occ == occName (cTupleTyConName 0) = Just (cTupleTyConName 0) - | occ == occName (cTupleTyConName 1) = Just (cTupleTyConName 1) - | 'C':'T':'u':'p':'l':'e' : rest <- occNameString occ - , Just (BoxedTuple, num) <- arity_and_boxity rest - , num >= 2 && num <= 64 - = Just $ cTupleTyConName num - | otherwise = Nothing - -isCTupleOcc_maybe _ _ = Nothing + | occ == occName (cTupleTyConName 0) = Just (cTupleTyConName 0) -- CUnit + | occ == occName (cTupleTyConName 1) = Just (cTupleTyConName 1) -- CSolo --- | This is only for Tuple, not for Unit or Solo -isTupleNTyOcc_maybe :: OccName -> Maybe Name -isTupleNTyOcc_maybe occ = - case occNameString occ of - 'T':'u':'p':'l':'e':str | Just (sort, n) <- arity_and_boxity str, n > 1 - -> Just (tupleTyConName sort n) - _ -> Nothing + | Just num <- sbs_CTuple sbs, num >= 2 + = Just $ cTupleTyConName num -isSumTyOcc_maybe :: Module -> OccName -> Maybe Name -isSumTyOcc_maybe mod occ | mod == gHC_TYPES = - isSumNTyOcc_maybe occ -isSumTyOcc_maybe _ _ = Nothing + | otherwise = Nothing -isSumNTyOcc_maybe :: OccName -> Maybe Name -isSumNTyOcc_maybe occ = - case occNameString occ of - 'S':'u':'m':str | Just (UnboxedTuple, n) <- arity_and_boxity str, n > 1 - -> Just (tyConName (sumTyCon n)) - _ -> Nothing +isCTupleOrigName_maybe _ _ = Nothing --- | See Note [Small Ints parsing] +-- Identify original names of unboxed sum type constructors. +-- Examples: +-- 2) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum2#") = Just +-- 3) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum3#") = Just +-- 4) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum4#") = Just +-- ... +-- 64) isSumTyOrigName_maybe GHC.Types (mkTcOcc "Sum64#") = Just -- --- Analyze a string as the suffix of an OccName of a tuple or sum tycon to --- determine its arity and boxity (based on the presence of a @#@). -arity_and_boxity :: String -> Maybe (TupleSort, Int) -arity_and_boxity s = case s of - c1 : t1 | isDigit c1 -> case t1 of - [] -> Just (BoxedTuple, digit_to_int c1) - ['#'] -> Just (UnboxedTuple, digit_to_int c1) - c2 : t2 | isDigit c2 -> - let ar = digit_to_int c1 * 10 + digit_to_int c2 - in case t2 of - [] -> Just (BoxedTuple, ar) - ['#'] -> Just (UnboxedTuple, ar) - _ -> Nothing - _ -> Nothing - _ -> Nothing +-- Non-examples: "(#|#)", "(#||#)", "(#|||#)", etc. These are not valid syntax. +-- Also non-examples: "Sum0#", "Sum1#". These do not exist. +isSumTyOrigName_maybe :: Module -> OccName -> Maybe Name +isSumTyOrigName_maybe mod occ + | mod == gHC_TYPES + , isTcClsNameSpace ns + , Just n <- sbs_Sum sbs + , n >= 2 + = Just (tyConName (sumTyCon n)) where - digit_to_int :: Char -> Int - digit_to_int c = ord c - ord '0' + fs = occNameFS occ + ns = occNameSpace occ + sbs = fastStringToShortByteString fs -- O(1) field access +isSumTyOrigName_maybe _ _ = Nothing +-- Identify original names of unboxed sum data constructors. +-- "(#_|#)", "(#_||#)", (#|_|#)" +-- +-- Examples: +-- 1/2) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#_|#)") = Just +-- 1/3) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#_||#)") = Just +-- 2/3) isSumTyOrigName_maybe GHC.Types (mkDataOcc "(#|_|#)") = Just +-- ... +-- +-- Non-examples: Sum#, as this is the name format of unboxed sum /type/ constructors. +isSumDataOrigName_maybe :: Module -> OccName -> Maybe Name +isSumDataOrigName_maybe mod occ + | mod == gHC_TYPES + , isDataConNameSpace ns + , Just (k,n) <- (is_unboxed_sum_data_syntax fs) + = Just (unboxedSumDataConName k n) + where fs = occNameFS occ + ns = occNameSpace occ +isSumDataOrigName_maybe _ _ = Nothing + {- Note [Small Ints parsing] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1034,26 +1320,6 @@ `readMaybe @Int` on my machine. -} --- When resolving names produced by Template Haskell (see thOrigRdrName --- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not --- an Orig name. --- --- This matters for pretty-printing under ListTuplePuns. If we don't do it, --- then -ddump-splices will print ''[] as ''GHC.Types.List. --- --- Test case: th/T13776 --- -isPunOcc_maybe :: Module -> OccName -> Maybe Name -isPunOcc_maybe mod occ - | mod == gHC_TYPES, occ == occName listTyConName - = Just listTyConName - | mod == gHC_TYPES, occ == occName unboxedSoloDataConName - = Just unboxedSoloDataConName - | otherwise - = isTupleTyOcc_maybe mod occ <|> - isCTupleOcc_maybe mod occ <|> - isSumTyOcc_maybe mod occ - mkTupleOcc :: NameSpace -> Boxity -> Arity -> (OccName, BuiltInSyntax) mkTupleOcc ns b ar = (mkOccName ns str, built_in) where (str, built_in) = mkTupleStr' ns b ar @@ -1112,16 +1378,6 @@ = assertPpr (isExternalName n) (ppr n) $ getUnique n `memberUniqueSet` cTupleTyConKeys --- | If the given name is that of a constraint tuple, return its arity. -cTupleTyConNameArity_maybe :: Name -> Maybe Arity -cTupleTyConNameArity_maybe n - | not (isCTupleTyConName n) = Nothing - | otherwise = fmap adjustArity (n `elemIndex` cTupleTyConNames) - where - -- Since `cTupleTyConNames` jumps straight from the `0` to the `2` - -- case, we have to adjust accordingly our calculated arity. - adjustArity a = if a > 0 then a + 1 else a - cTupleDataCon :: Arity -> DataCon cTupleDataCon i | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially @@ -1202,14 +1458,6 @@ -- tuple and the inner array is indexed by the superclass position. cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] - -- Although GHC does not make use of unary constraint tuples - -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), - -- this array creates one anyway. This is primarily motivated by the fact - -- that (1) the indices of an Array must be contiguous, and (2) we would like - -- the index of a constraint tuple in this Array to correspond to its Arity. - -- We could envision skipping over the unary constraint tuple and having index - -- 1 correspond to a 2-constraint tuple (and so on), but that's more - -- complicated than it's worth. -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type @@ -1400,6 +1648,9 @@ | otherwise = fst (unboxedSumArr ! arity) +unboxedSumTyConName :: Arity -> Name +unboxedSumTyConName arity = tyConName (sumTyCon arity) + -- | Data constructor for i-th alternative of a n-ary unboxed sum. sumDataCon :: ConTag -- Alternative -> Arity -- Arity @@ -1423,6 +1674,9 @@ | otherwise = snd (unboxedSumArr ! arity) ! (alt - 1) +unboxedSumDataConName :: ConTag -> Arity -> Name +unboxedSumDataConName alt arity = dataConName (sumDataCon alt arity) + -- | Cached type and data constructors for sums. The outer array is -- indexed by the arity of the sum and the inner array is indexed by -- the alternative. @@ -1511,6 +1765,9 @@ binders = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k]) roles = [Nominal, Nominal, Nominal] rhs = mkDataTyConRhs [datacon] + -- rhs: a DataTyCon, not a UnaryClassTyCon! Yes it has one + -- field, but it has unboxed type (a ~# b), + -- so the class must provide the box. tvs@[k,a,b] = binderVars binders sc_pred = mkTyConApp eqPrimTyCon (mkTyVarTys [k,k,a,b]) @@ -2633,13 +2890,6 @@ naturalNBDataCon :: DataCon naturalNBDataCon = pcDataCon naturalNBDataConName [] [byteArrayPrimTy] naturalTyCon - --- | Replaces constraint tuple names with corresponding boxed ones. -filterCTuple :: RdrName -> RdrName -filterCTuple (Exact n) - | Just arity <- cTupleTyConNameArity_maybe n - = Exact $ tupleTyConName BoxedTuple arity -filterCTuple rdr = rdr {- ************************************************************************ diff --git a/GHC/Builtin/Types/Prim.hs b/GHC/Builtin/Types/Prim.hs --- a/GHC/Builtin/Types/Prim.hs +++ b/GHC/Builtin/Types/Prim.hs @@ -77,7 +77,6 @@ mutVarPrimTyCon, mkMutVarPrimTy, mVarPrimTyCon, mkMVarPrimTy, - ioPortPrimTyCon, mkIOPortPrimTy, tVarPrimTyCon, mkTVarPrimTy, stablePtrPrimTyCon, mkStablePtrPrimTy, stableNamePrimTyCon, mkStableNamePrimTy, @@ -278,7 +277,6 @@ , mutableByteArrayPrimTyCon , smallMutableArrayPrimTyCon , mVarPrimTyCon - , ioPortPrimTyCon , tVarPrimTyCon , mutVarPrimTyCon , realWorldTyCon @@ -310,7 +308,7 @@ arrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, - ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, + tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName, @@ -342,7 +340,6 @@ mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon -ioPortPrimTyConName = mkPrimTc (fsLit "IOPort#") ioPortPrimTyConKey ioPortPrimTyCon mVarPrimTyConName = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon stablePtrPrimTyConName = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon @@ -1017,7 +1014,7 @@ -------------------------- This is The Type Of Equality in GHC. It classifies nominal coercions. This type is used in the solver for recording equality constraints. -It responds "yes" to Type.isEqPrimPred and classifies as an EqPred in +It responds "yes" to Type.isEqPred and classifies as an EqPred in Type.classifyPredType. All wanted constraints of this type are built with coercion holes. @@ -1279,20 +1276,6 @@ mkMutVarPrimTy :: Type -> Type -> Type mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [getLevity elt, s, elt] - -{- -************************************************************************ -* * -\subsection[TysPrim-io-port-var]{The synchronizing I/O Port type} -* * -************************************************************************ --} - -ioPortPrimTyCon :: TyCon -ioPortPrimTyCon = pcPrimTyCon_LevPolyLastArg ioPortPrimTyConName [Nominal, Representational] unliftedRepTy - -mkIOPortPrimTy :: Type -> Type -> Type -mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [getLevity elt, s, elt] {- ************************************************************************ diff --git a/GHC/Builtin/Uniques.hs b/GHC/Builtin/Uniques.hs --- a/GHC/Builtin/Uniques.hs +++ b/GHC/Builtin/Uniques.hs @@ -26,6 +26,7 @@ , mkCTupleTyConUnique , mkCTupleDataConUnique , mkCTupleSelIdUnique + , isCTupleTyConUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -122,6 +123,7 @@ -- alternative mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc) +-- | Inverse of 'mkSumTyConUnique' isSumTyConUnique :: Unique -> Maybe Arity isSumTyConUnique u = case (tag, n .&. 0xfc) of @@ -234,6 +236,17 @@ | otherwise = mkUniqueInt 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos) +-- | Inverse of 'mkCTupleTyConUnique' +isCTupleTyConUnique :: Unique -> Maybe Arity +isCTupleTyConUnique u = + case (tag, i) of + ('k', 0) -> Just arity + _ -> Nothing + where + (tag, n) = unpkUnique u + (arity', i) = quotRem n 2 + arity = word64ToInt arity' + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -282,7 +295,7 @@ mkTupleTyConUnique Boxed a = mkUniqueInt '4' (2*a) mkTupleTyConUnique Unboxed a = mkUniqueInt '5' (2*a) --- | This function is an inverse of `mkTupleTyConUnique` +-- | Inverse of 'mkTupleTyConUnique' isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity) isTupleTyConUnique u = case (tag, i) of @@ -294,7 +307,7 @@ (arity', i) = quotRem n 2 arity = word64ToInt arity' --- | This function is an inverse of `mkTupleTyDataUnique` that also matches the worker and promoted tycon. +-- | Inverse of 'mkTupleTyDataUnique' that also matches the worker and promoted tycon. isTupleDataConLikeUnique :: Unique -> Maybe (Boxity, Arity) isTupleDataConLikeUnique u = case tag of diff --git a/GHC/Builtin/primops.txt.pp b/GHC/Builtin/primops.txt.pp --- a/GHC/Builtin/primops.txt.pp +++ b/GHC/Builtin/primops.txt.pp @@ -1132,10 +1132,18 @@ primop DoubleMinOp "minDouble#" GenPrimOp Double# -> Double# -> Double# + {Return the minimum of the arguments. + When the arguments are numerically equal (e.g. @0.0##@ and @-0.0##@) + or one of the arguments is not-a-number (NaN), + it is unspecified which one is returned.} with commutable = True primop DoubleMaxOp "maxDouble#" GenPrimOp Double# -> Double# -> Double# + {Return the maximum of the arguments. + When the arguments are numerically equal (e.g. @0.0##@ and @-0.0##@) + or one of the arguments is not-a-number (NaN), + it is unspecified which one is returned.} with commutable = True primop DoubleAddOp "+##" GenPrimOp @@ -1306,10 +1314,18 @@ primop FloatMinOp "minFloat#" GenPrimOp Float# -> Float# -> Float# + {Return the minimum of the arguments. + When the arguments are numerically equal (e.g. @0.0#@ and @-0.0#@) + or one of the arguments is not-a-number (NaN), + it is unspecified which one is returned.} with commutable = True primop FloatMaxOp "maxFloat#" GenPrimOp Float# -> Float# -> Float# + {Return the maximum of the arguments. + When the arguments are numerically equal (e.g. @0.0#@ and @-0.0#@) + or one of the arguments is not-a-number (NaN), + it is unspecified which one is returned.} with commutable = True primop FloatAddOp "plusFloat#" GenPrimOp @@ -3223,43 +3239,6 @@ ------------------------------------------------------------------------ -section "Synchronized I/O Ports" - {Operations on 'IOPort#'s. } ------------------------------------------------------------------------- - -primtype IOPort# s a - { A shared I/O port is almost the same as an 'MVar#'. - The main difference is that IOPort has no deadlock detection or - deadlock breaking code that forcibly releases the lock. } - -primop NewIOPortOp "newIOPort#" GenPrimOp - State# s -> (# State# s, IOPort# s a_levpoly #) - {Create new 'IOPort#'; initially empty.} - with - out_of_line = True - effect = ReadWriteEffect - -primop ReadIOPortOp "readIOPort#" GenPrimOp - IOPort# s a_levpoly -> State# s -> (# State# s, a_levpoly #) - {If 'IOPort#' is empty, block until it becomes full. - Then remove and return its contents, and set it empty. - Throws an 'IOPortException' if another thread is already - waiting to read this 'IOPort#'.} - with - out_of_line = True - effect = ReadWriteEffect - -primop WriteIOPortOp "writeIOPort#" GenPrimOp - IOPort# s a_levpoly -> a_levpoly -> State# s -> (# State# s, Int# #) - {If 'IOPort#' is full, immediately return with integer 0, - throwing an 'IOPortException'. - Otherwise, store value arg as 'IOPort#''s new contents, - and return with integer 1. } - with - out_of_line = True - effect = ReadWriteEffect - ------------------------------------------------------------------------- section "Delay/wait operations" ------------------------------------------------------------------------ @@ -3703,7 +3682,6 @@ -- sameMutVar# :: MutVar# s a -> MutVar# s a -> Int# -- sameTVar# :: TVar# s a -> TVar# s a -> Int# -- sameMVar# :: MVar# s a -> MVar# s a -> Int# --- sameIOPort# :: IOPort# s a -> IOPort# s a -> Int# -- eqStableName# :: StableName# a -> StableName# b -> Int# -- -- These operations are all specialisations of unsafePtrEquality#. @@ -3949,6 +3927,16 @@ out_of_line = True ------------------------------------------------------------------------ +section "Annotating call stacks" +------------------------------------------------------------------------ + +primop AnnotateStackOp "annotateStack#" GenPrimOp + b -> (State# s -> (# State# s, a_reppoly #)) -> State# s -> (# State# s, a_reppoly #) + { Pushes an annotation frame to the stack which can be reported by backtraces. } + with + out_of_line = True + +------------------------------------------------------------------------ section "Info Table Origin" ------------------------------------------------------------------------ primop WhereFromOp "whereFrom#" GenPrimOp @@ -4055,6 +4043,15 @@ effect = ReadWriteEffect out_of_line = True +primop SetOtherThreadAllocationCounter "setOtherThreadAllocationCounter#" GenPrimOp + Int64# -> ThreadId# -> State# RealWorld -> State# RealWorld + { Sets the allocation counter for the another thread to the given value. + This doesn't take allocations into the current nursery chunk into account. + Therefore it is only accurate if the other thread is not currently running. } + with + effect = ReadWriteEffect + out_of_line = True + primtype StackSnapshot# { Haskell representation of a @StgStack*@ that was created (cloned) with a function in "GHC.Stack.CloneStack". Please check the @@ -4146,12 +4143,13 @@ primop VecUnpackOp "unpack#" GenPrimOp VECTOR -> VECTUPLE - { Unpack the elements of a vector into an unboxed tuple. #} + { Unpack the elements of a vector into an unboxed tuple. } with vector = ALL_VECTOR_TYPES primop VecInsertOp "insert#" GenPrimOp VECTOR -> SCALAR -> Int# -> VECTOR - { Insert a scalar at the given position in a vector. } + { Insert a scalar at the given position in a vector. + The position must be a compile-time constant. } with effect = CanFail vector = ALL_VECTOR_TYPES @@ -4180,14 +4178,20 @@ primop VecQuotOp "quot#" GenPrimOp VECTOR -> VECTOR -> VECTOR - { Rounds towards zero element-wise. } + { Rounds towards zero element-wise. + + Note: Most CPU ISAs do not contain any SIMD integer division instructions. + Do not expect high performance. } with effect = CanFail vector = INT_VECTOR_TYPES div_like = True primop VecRemOp "rem#" GenPrimOp VECTOR -> VECTOR -> VECTOR - { Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. } + { Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x@. + + Note: Most CPU ISAs do not contain any SIMD integer division instructions. + Do not expect high performance. } with effect = CanFail vector = INT_VECTOR_TYPES div_like = True @@ -4200,40 +4204,43 @@ primop VecIndexByteArrayOp "indexArray#" GenPrimOp ByteArray# -> Int# -> VECTOR - { Read a vector from specified index of immutable array. } + { Read a vector from the specified index of an immutable array. + The index is counted in units of SIMD vectors (not scalar elements). } with effect = CanFail vector = ALL_VECTOR_TYPES primop VecReadByteArrayOp "readArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) - { Read a vector from specified index of mutable array. } + { Read a vector from the specified index of a mutable array. + The index is counted in units of SIMD vectors (not scalar elements). } with effect = ReadWriteEffect can_fail_warning = YesWarnCanFail vector = ALL_VECTOR_TYPES primop VecWriteByteArrayOp "writeArray#" GenPrimOp MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s - { Write a vector to specified index of mutable array. } + { Write a vector to the specified index of a mutable array. + The index is counted in units of SIMD vectors (not scalar elements). } with effect = ReadWriteEffect can_fail_warning = YesWarnCanFail vector = ALL_VECTOR_TYPES primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR - { Reads vector; offset in bytes. } + { Reads vector; offset in units of SIMD vectors (not scalar elements). } with effect = CanFail vector = ALL_VECTOR_TYPES primop VecReadOffAddrOp "readOffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, VECTOR #) - { Reads vector; offset in bytes. } + { Reads vector; offset in units of SIMD vectors (not scalar elements). } with effect = ReadWriteEffect can_fail_warning = YesWarnCanFail vector = ALL_VECTOR_TYPES primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR -> State# s -> State# s - { Write vector; offset in bytes. } + { Write vector; offset in units of SIMD vectors (not scalar elements). } with effect = ReadWriteEffect can_fail_warning = YesWarnCanFail vector = ALL_VECTOR_TYPES @@ -4303,7 +4310,7 @@ primop VecShuffleOp "shuffle#" GenPrimOp VECTOR -> VECTOR -> INTVECTUPLE -> VECTOR {Shuffle elements of the concatenation of the input two vectors - into the result vector.} + into the result vector. The indices must be compile-time constants.} with vector = ALL_VECTOR_TYPES primop VecMinOp "min#" GenPrimOp diff --git a/GHC/ByteCode/Asm.hs b/GHC/ByteCode/Asm.hs --- a/GHC/ByteCode/Asm.hs +++ b/GHC/ByteCode/Asm.hs @@ -1,27 +1,33 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} -- +-- -- (c) The University of Glasgow 2002-2006 -- -- | Bytecode assembler and linker module GHC.ByteCode.Asm ( - assembleBCOs, assembleOneBCO, + assembleBCOs, bcoFreeNames, SizedSeq, sizeSS, ssElts, iNTERP_STACK_CHECK_THRESH, - mkNativeCallInfoLit + mkNativeCallInfoLit, + + -- * For testing + assembleBCO ) where -import GHC.Prelude +import GHC.Prelude hiding ( any ) + import GHC.ByteCode.Instr import GHC.ByteCode.InfoTable import GHC.ByteCode.Types -import GHCi.RemoteTypes -import GHC.Runtime.Interpreter import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord ) import GHC.Types.Name @@ -29,13 +35,15 @@ import GHC.Types.Literal import GHC.Types.Unique.DSet import GHC.Types.SptEntry +import GHC.Types.Unique.FM +import GHC.Unit.Types import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.TyCon -import GHC.Data.FlatBag import GHC.Data.SizedSeq +import GHC.Data.SmallArray import GHC.StgToCmm.Layout ( ArgRep(..) ) import GHC.Cmm.Expr @@ -43,22 +51,29 @@ import GHC.Cmm.CallConv ( allArgRegsCover ) import GHC.Platform import GHC.Platform.Profile +import Language.Haskell.Syntax.Module.Name import Control.Monad -import Control.Monad.Trans.Class -import Control.Monad.Trans.State.Strict +import qualified Control.Monad.Trans.State.Strict as MTL import qualified Data.Array.Unboxed as Array -import Data.Array.Base ( UArray(..) ) +import qualified Data.Array.IO as Array +import Data.Array.Base ( UArray(..), numElements, unsafeFreeze ) +#if ! defined(DEBUG) +import Data.Array.Base ( unsafeWrite ) +#endif + import Foreign hiding (shiftL, shiftR) -import Data.Char ( ord ) -import Data.List ( genericLength ) -import Data.Map.Strict (Map) +import Data.ByteString (ByteString) +import Data.Char (ord) import Data.Maybe (fromMaybe) -import qualified Data.Map.Strict as Map import GHC.Float (castFloatToWord32, castDoubleToWord64) +import qualified Data.List as List ( any ) +import GHC.Exts + + -- ----------------------------------------------------------------------------- -- Unlinked BCOs @@ -90,24 +105,21 @@ -- Top level assembler fn. assembleBCOs - :: Interp - -> Profile + :: Profile -> FlatBag (ProtoBCO Name) -> [TyCon] - -> AddrEnv - -> Maybe ModBreaks + -> [(Name, ByteString)] + -> Maybe InternalModBreaks -> [SptEntry] -> IO CompiledByteCode -assembleBCOs interp profile proto_bcos tycons top_strs modbreaks spt_entries = do +assembleBCOs profile proto_bcos tycons top_strs modbreaks spt_entries = do -- TODO: the profile should be bundled with the interpreter: the rts ways are -- fixed for an interpreter - itblenv <- mkITbls interp profile tycons + let itbls = mkITbls profile tycons bcos <- mapM (assembleBCO (profilePlatform profile)) proto_bcos - bcos' <- mallocStrings interp bcos return CompiledByteCode - { bc_bcos = bcos' - , bc_itbls = itblenv - , bc_ffis = concatMap protoBCOFFIs proto_bcos + { bc_bcos = bcos + , bc_itbls = itbls , bc_strs = top_strs , bc_breaks = modbreaks , bc_spt_entries = spt_entries @@ -123,60 +135,66 @@ -- memory for them, and bake the resulting addresses into the instruction stream -- in the form of BCONPtrWord arguments. -- --- Since we do this when assembling, we only allocate the memory when we compile --- the module, not each time we relink it. However, we do want to take care to --- malloc the memory all in one go, since that is more efficient with --- -fexternal-interpreter, especially when compiling in parallel. +-- We used to allocate remote buffers for BCONPtrStr ByteStrings when +-- assembling, but this gets in the way of bytecode serialization: we +-- want the ability to serialize and reload assembled bytecode, so +-- it's better to preserve BCONPtrStr as-is, and only perform the +-- actual allocation at link-time. -- -- Note that, as with top-level string literal bindings, this memory is never -- freed, so it just leaks if the BCO is unloaded. See Note [Generating code for -- top-level string literal bindings] in GHC.StgToByteCode for some discussion -- about why. -- -mallocStrings :: Interp -> FlatBag UnlinkedBCO -> IO (FlatBag UnlinkedBCO) -mallocStrings interp ulbcos = do - let bytestrings = reverse (execState (mapM_ collect ulbcos) []) - ptrs <- interpCmd interp (MallocStrings bytestrings) - return (evalState (mapM splice ulbcos) ptrs) - where - splice bco@UnlinkedBCO{..} = do - lits <- mapM spliceLit unlinkedBCOLits - ptrs <- mapM splicePtr unlinkedBCOPtrs - return bco { unlinkedBCOLits = lits, unlinkedBCOPtrs = ptrs } - spliceLit (BCONPtrStr _) = do - rptrs <- get - case rptrs of - (RemotePtr p : rest) -> do - put rest - return (BCONPtrWord (fromIntegral p)) - _ -> panic "mallocStrings:spliceLit" - spliceLit other = return other +data RunAsmReader = RunAsmReader { isn_array :: {-# UNPACK #-} !(Array.IOUArray Int Word16) + , ptr_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCOPtr) + , lit_array :: {-# UNPACK #-} !(SmallMutableArrayIO BCONPtr ) + } - splicePtr (BCOPtrBCO bco) = BCOPtrBCO <$> splice bco - splicePtr other = return other +data RunAsmResult = RunAsmResult { final_isn_array :: !(Array.UArray Int Word16) + , final_ptr_array :: !(SmallArray BCOPtr) + , final_lit_array :: !(SmallArray BCONPtr) } - collect UnlinkedBCO{..} = do - mapM_ collectLit unlinkedBCOLits - mapM_ collectPtr unlinkedBCOPtrs +-- How many words we have written so far. +data AsmState = AsmState { nisn :: !Int, nptr :: !Int, nlit :: !Int } - collectLit (BCONPtrStr bs) = do - strs <- get - put (bs:strs) - collectLit _ = return () - collectPtr (BCOPtrBCO bco) = collect bco - collectPtr _ = return () +{-# NOINLINE inspectInstrs #-} +-- | Perform analysis of the bytecode to determine +-- 1. How many instructions we will produce +-- 2. If we are going to need long jumps. +-- 3. The offsets that labels refer to +inspectInstrs :: Platform -> Bool -> Word -> [BCInstr] -> InspectState +inspectInstrs platform long_jump e instrs = + inspectAsm long_jump e (mapM_ (assembleInspectAsm platform) instrs) +{-# NOINLINE runInstrs #-} +-- | Assemble the bytecode from the instructions. +runInstrs :: Platform -> Bool -> InspectState -> [BCInstr] -> IO RunAsmResult +runInstrs platform long_jumps is_state instrs = do + -- Produce arrays of exactly the right size, corresponding to the result of inspectInstrs. + isn_array <- Array.newArray_ (0, (fromIntegral $ instrCount is_state) - 1) + ptr_array <- newSmallArrayIO (fromIntegral $ ptrCount is_state) undefined + lit_array <- newSmallArrayIO (fromIntegral $ litCount is_state) undefined + let env :: LocalLabel -> Word + env lbl = fromMaybe + (pprPanic "assembleBCO.findLabel" (ppr lbl)) + (lookupUFM (lblEnv is_state) lbl) + let initial_state = AsmState 0 0 0 + let initial_reader = RunAsmReader{..} + runAsm long_jumps env initial_reader initial_state (mapM_ (\i -> assembleRunAsm platform i) instrs) + final_isn_array <- unsafeFreeze isn_array + final_ptr_array <- unsafeFreezeSmallArrayIO ptr_array + final_lit_array <- unsafeFreezeSmallArrayIO lit_array + return $ RunAsmResult {..} -assembleOneBCO :: Interp -> Profile -> ProtoBCO Name -> IO UnlinkedBCO -assembleOneBCO interp profile pbco = do - -- TODO: the profile should be bundled with the interpreter: the rts ways are - -- fixed for an interpreter - ubco <- assembleBCO (profilePlatform profile) pbco - UnitFlatBag ubco' <- mallocStrings interp (UnitFlatBag ubco) - return ubco' +assembleRunAsm :: Platform -> BCInstr -> RunAsm () +assembleRunAsm p i = assembleI @RunAsm p i +assembleInspectAsm :: Platform -> BCInstr -> InspectAsm () +assembleInspectAsm p i = assembleI @InspectAsm p i + assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO assembleBCO platform (ProtoBCO { protoBCOName = nm @@ -185,9 +203,7 @@ , protoBCOBitmapSize = bsize , protoBCOArity = arity }) = do -- pass 1: collect up the offsets of the local labels. - let asm = mapM_ (assembleI platform) instrs - - initial_offset = 0 + let initial_offset = 0 -- Jump instructions are variable-sized, there are long and short variants -- depending on the magnitude of the offset. However, we can't tell what @@ -197,30 +213,31 @@ -- and if the final size is indeed small enough for short jumps, we are -- done. Otherwise, we repeat the calculation, and we force all jumps in -- this BCO to be long. - (n_insns0, lbl_map0) = inspectAsm platform False initial_offset asm - ((n_insns, lbl_map), long_jumps) - | isLargeW (fromIntegral $ Map.size lbl_map0) - || isLargeW n_insns0 - = (inspectAsm platform True initial_offset asm, True) - | otherwise = ((n_insns0, lbl_map0), False) + is0 = inspectInstrs platform False initial_offset instrs + (is1, long_jumps) + | isLargeInspectState is0 + = (inspectInstrs platform True initial_offset instrs, True) + | otherwise = (is0, False) - env :: LocalLabel -> Word - env lbl = fromMaybe - (pprPanic "assembleBCO.findLabel" (ppr lbl)) - (Map.lookup lbl lbl_map) -- pass 2: run assembler and generate instructions, literals and pointers - let initial_state = (emptySS, emptySS, emptySS) - (final_insns, final_lits, final_ptrs) <- flip execStateT initial_state $ runAsm platform long_jumps env asm + RunAsmResult{..} <- runInstrs platform long_jumps is1 instrs -- precomputed size should be equal to final size - massertPpr (n_insns == sizeSS final_insns) + massertPpr (fromIntegral (instrCount is1) == numElements final_isn_array + && fromIntegral (ptrCount is1) == sizeofSmallArray final_ptr_array + && fromIntegral (litCount is1) == sizeofSmallArray final_lit_array) (text "bytecode instruction count mismatch") - let asm_insns = ssElts final_insns - !insns_arr = mkBCOByteArray $ Array.listArray (0 :: Int, fromIntegral n_insns - 1) asm_insns + let !insns_arr = mkBCOByteArray $ final_isn_array !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap - ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSizedSeq final_lits) (fromSizedSeq final_ptrs) + ul_bco = UnlinkedBCO { unlinkedBCOName = nm + , unlinkedBCOArity = arity + , unlinkedBCOInstrs = insns_arr + , unlinkedBCOBitmap = bitmap_arr + , unlinkedBCOLits = fromSmallArray final_lit_array + , unlinkedBCOPtrs = fromSmallArray final_ptr_array + } -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive -- objects, since they might get run too early. Disable this until @@ -229,6 +246,7 @@ return ul_bco +-- | Construct a word-array containing an @StgLargeBitmap@. mkBitmapArray :: Word -> [StgWord] -> UArray Int Word -- Here the return type must be an array of Words, not StgWords, -- because the underlying ByteArray# will end up as a component @@ -237,10 +255,6 @@ = Array.listArray (0, length bitmap) $ fromIntegral bsize : map (fromInteger . fromStgWord) bitmap --- instrs nonptrs ptrs -type AsmState = (SizedSeq Word16, - SizedSeq BCONPtr, - SizedSeq BCOPtr) data Operand = Op Word @@ -260,40 +274,10 @@ PW8 | w <= 4294967295 -> Op (fromIntegral w) _ -> pprPanic "GHC.ByteCode.Asm.truncHalfWord" (ppr w) -data Assembler a - = AllocPtr (IO BCOPtr) (Word -> Assembler a) - | AllocLit [BCONPtr] (Word -> Assembler a) - | AllocLabel LocalLabel (Assembler a) - | Emit Word16 [Operand] (Assembler a) - | NullAsm a - deriving (Functor) -instance Applicative Assembler where - pure = NullAsm - (<*>) = ap - -instance Monad Assembler where - NullAsm x >>= f = f x - AllocPtr p k >>= f = AllocPtr p (k >=> f) - AllocLit l k >>= f = AllocLit l (k >=> f) - AllocLabel lbl k >>= f = AllocLabel lbl (k >>= f) - Emit w ops k >>= f = Emit w ops (k >>= f) - -ioptr :: IO BCOPtr -> Assembler Word -ioptr p = AllocPtr p return - -ptr :: BCOPtr -> Assembler Word +ptr :: MonadAssembler m => BCOPtr -> m Word ptr = ioptr . return -lit :: [BCONPtr] -> Assembler Word -lit l = AllocLit l return - -label :: LocalLabel -> Assembler () -label w = AllocLabel w (return ()) - -emit :: Word16 -> [Operand] -> Assembler () -emit w ops = Emit w ops (return ()) - type LabelEnv = LocalLabel -> Word largeOp :: Bool -> Operand -> Bool @@ -303,39 +287,143 @@ IOp i -> isLargeI i LabelOp _ -> long_jumps -runAsm :: Platform -> Bool -> LabelEnv -> Assembler a -> StateT AsmState IO a -runAsm platform long_jumps e = go +newtype RunAsm a = RunAsm' { runRunAsm :: Bool + -> LabelEnv + -> RunAsmReader + -> AsmState + -> IO (AsmState, a) } + +pattern RunAsm :: (Bool -> LabelEnv -> RunAsmReader -> AsmState -> IO (AsmState, a)) + -> RunAsm a +pattern RunAsm m <- RunAsm' m where - go (NullAsm x) = return x - go (AllocPtr p_io k) = do - p <- lift p_io - w <- state $ \(st_i0,st_l0,st_p0) -> - let st_p1 = addToSS st_p0 p - in (sizeSS st_p0, (st_i0,st_l0,st_p1)) - go $ k w - go (AllocLit lits k) = do - w <- state $ \(st_i0,st_l0,st_p0) -> - let st_l1 = addListToSS st_l0 lits - in (sizeSS st_l0, (st_i0,st_l1,st_p0)) - go $ k w - go (AllocLabel _ k) = go k - go (Emit w ops k) = do - let largeArgs = any (largeOp long_jumps) ops - opcode - | largeArgs = largeArgInstr w - | otherwise = w - words = concatMap expand ops - expand (SmallOp w) = [w] - expand (LabelOp w) = expand (Op (e w)) - expand (Op w) = if largeArgs then largeArg platform (fromIntegral w) else [fromIntegral w] - expand (IOp i) = if largeArgs then largeArg platform (fromIntegral i) else [fromIntegral i] - state $ \(st_i0,st_l0,st_p0) -> - let st_i1 = addListToSS st_i0 (opcode : words) - in ((), (st_i1,st_l0,st_p0)) - go k + RunAsm m = RunAsm' (oneShot $ \a -> oneShot $ \b -> oneShot $ \c -> oneShot $ \d -> m a b c d) +{-# COMPLETE RunAsm #-} -type LabelEnvMap = Map LocalLabel Word +instance Functor RunAsm where + fmap f (RunAsm x) = RunAsm (\a b c !s -> fmap (fmap f) (x a b c s)) +instance Applicative RunAsm where + pure x = RunAsm $ \_ _ _ !s -> pure (s, x) + (RunAsm f) <*> (RunAsm x) = RunAsm $ \a b c !s -> do + (!s', f') <- f a b c s + (!s'', x') <- x a b c s' + return (s'', f' x') + {-# INLINE (<*>) #-} + + +instance Monad RunAsm where + return = pure + (RunAsm m) >>= f = RunAsm $ \a b c !s -> m a b c s >>= \(s', r) -> runRunAsm (f r) a b c s' + {-# INLINE (>>=) #-} + +runAsm :: Bool -> LabelEnv -> RunAsmReader -> AsmState -> RunAsm a -> IO a +runAsm long_jumps e r s (RunAsm'{runRunAsm}) = fmap snd $ runRunAsm long_jumps e r s + +expand :: PlatformWordSize -> Bool -> Operand -> RunAsm () +expand word_size largeArgs o = do + e <- askEnv + case o of + (SmallOp w) -> writeIsn w + (LabelOp w) -> let !r = e w in handleLargeArg r + (Op w) -> handleLargeArg w + (IOp i) -> handleLargeArg i + + where + handleLargeArg :: Integral a => a -> RunAsm () + handleLargeArg w = + if largeArgs + then largeArg word_size (fromIntegral w) + else writeIsn (fromIntegral w) + +lift :: IO a -> RunAsm a +lift io = RunAsm $ \_ _ _ s -> io >>= \a -> pure (s, a) + +askLongJumps :: RunAsm Bool +askLongJumps = RunAsm $ \a _ _ s -> pure (s, a) + +askEnv :: RunAsm LabelEnv +askEnv = RunAsm $ \_ b _ s -> pure (s, b) + +writePtr :: BCOPtr -> RunAsm Word +writePtr w + = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do + writeSmallArrayIO ptr_array (nptr asm) w + let !n' = nptr asm + 1 + let !asm' = asm { nptr = n' } + return (asm', fromIntegral (nptr asm)) + +writeLit :: BCONPtr -> RunAsm Word +writeLit w = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do + writeSmallArrayIO lit_array (nlit asm) w + let !n' = nlit asm + 1 + let !asm' = asm { nlit = n' } + return (asm', fromIntegral (nlit asm)) + +writeLits :: OneOrTwo BCONPtr -> RunAsm Word +writeLits (OnlyOne l) = writeLit l +writeLits (OnlyTwo l1 l2) = writeLit l1 <* writeLit l2 + +writeIsn :: Word16 -> RunAsm () +writeIsn w = RunAsm $ \_ _ (RunAsmReader{..}) asm -> do +#if defined(DEBUG) + Array.writeArray isn_array (nisn asm) w +#else + unsafeWrite isn_array (nisn asm) w +#endif + let !n' = nisn asm + 1 + let !asm' = asm { nisn = n' } + return (asm', ()) + +{-# INLINE any #-} +-- Any is unrolled manually so that the call in `emit` can be eliminated without +-- relying on SpecConstr (which does not work across modules). +any :: (a -> Bool) -> [a] -> Bool +any _ [] = False +any f [x] = f x +any f [x,y] = f x || f y +any f [x,y,z] = f x || f y || f z +any f [x1,x2,x3,x4] = f x1 || f x2 || f x3 || f x4 +any f [x1,x2,x3,x4, x5] = f x1 || f x2 || f x3 || f x4 || f x5 +any f [x1,x2,x3,x4,x5,x6] = f x1 || f x2 || f x3 || f x4 || f x5 || f x6 +any f xs = List.any f xs + +{-# INLINE mapM6_ #-} +mapM6_ :: Monad m => (a -> m b) -> [a] -> m () +mapM6_ _ [] = return () +mapM6_ f [x] = () <$ f x +mapM6_ f [x,y] = () <$ f x <* f y +mapM6_ f [x,y,z] = () <$ f x <* f y <* f z +mapM6_ f [a1,a2,a3,a4] = () <$ f a1 <* f a2 <* f a3 <* f a4 +mapM6_ f [a1,a2,a3,a4,a5] = () <$ f a1 <* f a2 <* f a3 <* f a4 <* f a5 +mapM6_ f [a1,a2,a3,a4,a5,a6] = () <$ f a1 <* f a2 <* f a3 <* f a4 <* f a5 <* f a6 +mapM6_ f xs = mapM_ f xs + +instance MonadAssembler RunAsm where + ioptr p_io = do + p <- lift p_io + writePtr p + lit lits = writeLits lits + + label _ = return () + + emit pwordsize w ops = do + long_jumps <- askLongJumps + -- See the definition of `any` above + let largeArgs = any (largeOp long_jumps) ops + let opcode + | largeArgs = largeArgInstr w + | otherwise = w + writeIsn opcode + mapM6_ (expand pwordsize largeArgs) ops + + {-# INLINE emit #-} + {-# INLINE label #-} + {-# INLINE lit #-} + {-# INLINE ioptr #-} + +type LabelEnvMap = UniqFM LocalLabel Word + data InspectState = InspectState { instrCount :: !Word , ptrCount :: !Word @@ -343,74 +431,173 @@ , lblEnv :: LabelEnvMap } -inspectAsm :: Platform -> Bool -> Word -> Assembler a -> (Word, LabelEnvMap) -inspectAsm platform long_jumps initial_offset - = go (InspectState initial_offset 0 0 Map.empty) +instance Outputable InspectState where + ppr (InspectState i p l m) = text "InspectState" <+> ppr [ppr i, ppr p, ppr l, ppr (sizeUFM m)] + +isLargeInspectState :: InspectState -> Bool +isLargeInspectState InspectState{..} = + isLargeW (fromIntegral $ sizeUFM lblEnv) + || isLargeW instrCount + +newtype InspectEnv = InspectEnv { _inspectLongJumps :: Bool + } + +newtype InspectAsm a = InspectAsm' { runInspectAsm :: InspectEnv -> InspectState -> (# InspectState, a #) } + +pattern InspectAsm :: (InspectEnv -> InspectState -> (# InspectState, a #)) + -> InspectAsm a +pattern InspectAsm m <- InspectAsm' m where - go s (NullAsm _) = (instrCount s, lblEnv s) - go s (AllocPtr _ k) = go (s { ptrCount = n + 1 }) (k n) - where n = ptrCount s - go s (AllocLit ls k) = go (s { litCount = n + genericLength ls }) (k n) - where n = litCount s - go s (AllocLabel lbl k) = go s' k - where s' = s { lblEnv = Map.insert lbl (instrCount s) (lblEnv s) } - go s (Emit _ ops k) = go s' k - where - s' = s { instrCount = instrCount s + size } - size = sum (map count ops) + 1 + InspectAsm m = InspectAsm' (oneShot $ \a -> oneShot $ \b -> m a b) +{-# COMPLETE InspectAsm #-} + +instance Functor InspectAsm where + fmap f (InspectAsm k) = InspectAsm $ \a b -> case k a b of + (# b', c #) -> (# b', f c #) + +instance Applicative InspectAsm where + pure x = InspectAsm $ \_ s -> (# s, x #) + (InspectAsm f) <*> (InspectAsm x) = InspectAsm $ \a b -> case f a b of + (# s', f' #) -> + case x a s' of + (# s'', x' #) -> (# s'', f' x' #) + +instance Monad InspectAsm where + return = pure + (InspectAsm m) >>= f = InspectAsm $ \ a b -> case m a b of + (# s', a' #) -> runInspectAsm (f a') a s' + +get_ :: InspectAsm InspectState +get_ = InspectAsm $ \_ b -> (# b, b #) + +put_ :: InspectState -> InspectAsm () +put_ !s = InspectAsm $ \_ _ -> (# s, () #) + +modify_ :: (InspectState -> InspectState) -> InspectAsm () +modify_ f = InspectAsm $ \_ s -> let !s' = f s in (# s', () #) + +ask_ :: InspectAsm InspectEnv +ask_ = InspectAsm $ \a b -> (# b, a #) + +inspectAsm :: Bool -> Word -> InspectAsm () -> InspectState +inspectAsm long_jumps initial_offset (InspectAsm s) = + case s (InspectEnv long_jumps) (InspectState initial_offset 0 0 emptyUFM) of + (# res, () #) -> res +{-# INLINE inspectAsm #-} + + + +instance MonadAssembler InspectAsm where + ioptr _ = do + s <- get_ + let n = ptrCount s + put_ (s { ptrCount = n + 1 }) + return n + + lit ls = do + s <- get_ + let n = litCount s + put_ (s { litCount = n + oneTwoLength ls }) + return n + + label lbl = modify_ (\s -> let !count = instrCount s in let !env' = addToUFM (lblEnv s) lbl count in s { lblEnv = env' }) + + emit pwordsize _ ops = do + InspectEnv long_jumps <- ask_ + -- Size is written in this way as `mapM6_` is also used by RunAsm, and guaranteed + -- to unroll for arguments up to size 6. + let size = (MTL.execState (mapM6_ (\x -> MTL.modify (count' x +)) ops) 0) + 1 largeOps = any (largeOp long_jumps) ops - count (SmallOp _) = 1 - count (LabelOp _) = count (Op 0) - count (Op _) = if largeOps then largeArg16s platform else 1 - count (IOp _) = if largeOps then largeArg16s platform else 1 + bigSize = largeArg16s pwordsize + count' = if largeOps then countLarge bigSize else countSmall bigSize + s <- get_ + put_ (s { instrCount = instrCount s + size }) + + {-# INLINE emit #-} + {-# INLINE label #-} + {-# INLINE lit #-} + {-# INLINE ioptr #-} + +count :: Word -> Bool -> Operand -> Word +count _ _ (SmallOp _) = 1 +count big largeOps (LabelOp _) = if largeOps then big else 1 +count big largeOps (Op _) = if largeOps then big else 1 +count big largeOps (IOp _) = if largeOps then big else 1 +{-# INLINE count #-} + +countSmall, countLarge :: Word -> Operand -> Word +countLarge big x = count big True x +countSmall big x = count big False x + + -- Bring in all the bci_ bytecode constants. #include "Bytecodes.h" largeArgInstr :: Word16 -> Word16 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci -largeArg :: Platform -> Word64 -> [Word16] -largeArg platform w = case platformWordSize platform of - PW8 -> [fromIntegral (w `shiftR` 48), - fromIntegral (w `shiftR` 32), - fromIntegral (w `shiftR` 16), - fromIntegral w] +{-# INLINE largeArg #-} +largeArg :: PlatformWordSize -> Word64 -> RunAsm () +largeArg wsize w = case wsize of + PW8 -> do writeIsn (fromIntegral (w `shiftR` 48)) + writeIsn (fromIntegral (w `shiftR` 32)) + writeIsn (fromIntegral (w `shiftR` 16)) + writeIsn (fromIntegral w) PW4 -> assertPpr (w < fromIntegral (maxBound :: Word32)) - (text "largeArg too big:" <+> ppr w) $ - [fromIntegral (w `shiftR` 16), - fromIntegral w] + (text "largeArg too big:" <+> ppr w) $ do + writeIsn (fromIntegral (w `shiftR` 16)) + writeIsn (fromIntegral w) -largeArg16s :: Platform -> Word -largeArg16s platform = case platformWordSize platform of +largeArg16s :: PlatformWordSize -> Word +largeArg16s pwordsize = case pwordsize of PW8 -> 4 PW4 -> 2 -assembleI :: Platform +data OneOrTwo a = OnlyOne a | OnlyTwo a a deriving (Functor) + +oneTwoLength :: OneOrTwo a -> Word +oneTwoLength (OnlyOne {}) = 1 +oneTwoLength (OnlyTwo {}) = 2 + +class Monad m => MonadAssembler m where + ioptr :: IO BCOPtr -> m Word + lit :: OneOrTwo BCONPtr -> m Word + label :: LocalLabel -> m () + emit :: PlatformWordSize -> Word16 -> [Operand] -> m () + +lit1 :: MonadAssembler m => BCONPtr -> m Word +lit1 p = lit (OnlyOne p) + +{-# SPECIALISE assembleI :: Platform -> BCInstr -> InspectAsm () #-} +{-# SPECIALISE assembleI :: Platform -> BCInstr -> RunAsm () #-} + +assembleI :: forall m . MonadAssembler m + => Platform -> BCInstr - -> Assembler () + -> m () assembleI platform i = case i of - STKCHECK n -> emit bci_STKCHECK [Op n] - PUSH_L o1 -> emit bci_PUSH_L [wOp o1] - PUSH_LL o1 o2 -> emit bci_PUSH_LL [wOp o1, wOp o2] - PUSH_LLL o1 o2 o3 -> emit bci_PUSH_LLL [wOp o1, wOp o2, wOp o3] - PUSH8 o1 -> emit bci_PUSH8 [bOp o1] - PUSH16 o1 -> emit bci_PUSH16 [bOp o1] - PUSH32 o1 -> emit bci_PUSH32 [bOp o1] - PUSH8_W o1 -> emit bci_PUSH8_W [bOp o1] - PUSH16_W o1 -> emit bci_PUSH16_W [bOp o1] - PUSH32_W o1 -> emit bci_PUSH32_W [bOp o1] + STKCHECK n -> emit_ bci_STKCHECK [Op n] + PUSH_L o1 -> emit_ bci_PUSH_L [wOp o1] + PUSH_LL o1 o2 -> emit_ bci_PUSH_LL [wOp o1, wOp o2] + PUSH_LLL o1 o2 o3 -> emit_ bci_PUSH_LLL [wOp o1, wOp o2, wOp o3] + PUSH8 o1 -> emit_ bci_PUSH8 [bOp o1] + PUSH16 o1 -> emit_ bci_PUSH16 [bOp o1] + PUSH32 o1 -> emit_ bci_PUSH32 [bOp o1] + PUSH8_W o1 -> emit_ bci_PUSH8_W [bOp o1] + PUSH16_W o1 -> emit_ bci_PUSH16_W [bOp o1] + PUSH32_W o1 -> emit_ bci_PUSH32_W [bOp o1] PUSH_G nm -> do p <- ptr (BCOPtrName nm) - emit bci_PUSH_G [Op p] + emit_ bci_PUSH_G [Op p] PUSH_PRIMOP op -> do p <- ptr (BCOPtrPrimOp op) - emit bci_PUSH_G [Op p] + emit_ bci_PUSH_G [Op p] PUSH_BCO proto -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) - emit bci_PUSH_G [Op p] + emit_ bci_PUSH_G [Op p] PUSH_ALTS proto pk -> do let ul_bco = assembleBCO platform proto p <- ioptr (liftM BCOPtrBCO ul_bco) - emit (push_alts pk) [Op p] + emit_ (push_alts pk) [Op p] PUSH_ALTS_TUPLE proto call_info tuple_proto -> do let ul_bco = assembleBCO platform proto ul_tuple_bco = assembleBCO platform @@ -419,280 +606,274 @@ p_tup <- ioptr (liftM BCOPtrBCO ul_tuple_bco) info <- word (fromIntegral $ mkNativeCallInfoSig platform call_info) - emit bci_PUSH_ALTS_T + emit_ bci_PUSH_ALTS_T [Op p, Op info, Op p_tup] - PUSH_PAD8 -> emit bci_PUSH_PAD8 [] - PUSH_PAD16 -> emit bci_PUSH_PAD16 [] - PUSH_PAD32 -> emit bci_PUSH_PAD32 [] + PUSH_PAD8 -> emit_ bci_PUSH_PAD8 [] + PUSH_PAD16 -> emit_ bci_PUSH_PAD16 [] + PUSH_PAD32 -> emit_ bci_PUSH_PAD32 [] PUSH_UBX8 lit -> do np <- literal lit - emit bci_PUSH_UBX8 [Op np] + emit_ bci_PUSH_UBX8 [Op np] PUSH_UBX16 lit -> do np <- literal lit - emit bci_PUSH_UBX16 [Op np] + emit_ bci_PUSH_UBX16 [Op np] PUSH_UBX32 lit -> do np <- literal lit - emit bci_PUSH_UBX32 [Op np] + emit_ bci_PUSH_UBX32 [Op np] PUSH_UBX lit nws -> do np <- literal lit - emit bci_PUSH_UBX [Op np, wOp nws] - + emit_ bci_PUSH_UBX [Op np, wOp nws] -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode - PUSH_ADDR nm -> do np <- lit [BCONPtrAddr nm] - emit bci_PUSH_UBX [Op np, SmallOp 1] + PUSH_ADDR nm -> do np <- lit1 (BCONPtrAddr nm) + emit_ bci_PUSH_UBX [Op np, SmallOp 1] - PUSH_APPLY_N -> emit bci_PUSH_APPLY_N [] - PUSH_APPLY_V -> emit bci_PUSH_APPLY_V [] - PUSH_APPLY_F -> emit bci_PUSH_APPLY_F [] - PUSH_APPLY_D -> emit bci_PUSH_APPLY_D [] - PUSH_APPLY_L -> emit bci_PUSH_APPLY_L [] - PUSH_APPLY_P -> emit bci_PUSH_APPLY_P [] - PUSH_APPLY_PP -> emit bci_PUSH_APPLY_PP [] - PUSH_APPLY_PPP -> emit bci_PUSH_APPLY_PPP [] - PUSH_APPLY_PPPP -> emit bci_PUSH_APPLY_PPPP [] - PUSH_APPLY_PPPPP -> emit bci_PUSH_APPLY_PPPPP [] - PUSH_APPLY_PPPPPP -> emit bci_PUSH_APPLY_PPPPPP [] + PUSH_APPLY_N -> emit_ bci_PUSH_APPLY_N [] + PUSH_APPLY_V -> emit_ bci_PUSH_APPLY_V [] + PUSH_APPLY_F -> emit_ bci_PUSH_APPLY_F [] + PUSH_APPLY_D -> emit_ bci_PUSH_APPLY_D [] + PUSH_APPLY_L -> emit_ bci_PUSH_APPLY_L [] + PUSH_APPLY_P -> emit_ bci_PUSH_APPLY_P [] + PUSH_APPLY_PP -> emit_ bci_PUSH_APPLY_PP [] + PUSH_APPLY_PPP -> emit_ bci_PUSH_APPLY_PPP [] + PUSH_APPLY_PPPP -> emit_ bci_PUSH_APPLY_PPPP [] + PUSH_APPLY_PPPPP -> emit_ bci_PUSH_APPLY_PPPPP [] + PUSH_APPLY_PPPPPP -> emit_ bci_PUSH_APPLY_PPPPPP [] - SLIDE n by -> emit bci_SLIDE [wOp n, wOp by] - ALLOC_AP n -> emit bci_ALLOC_AP [truncHalfWord platform n] - ALLOC_AP_NOUPD n -> emit bci_ALLOC_AP_NOUPD [truncHalfWord platform n] - ALLOC_PAP arity n -> emit bci_ALLOC_PAP [truncHalfWord platform arity, truncHalfWord platform n] - MKAP off sz -> emit bci_MKAP [wOp off, truncHalfWord platform sz] - MKPAP off sz -> emit bci_MKPAP [wOp off, truncHalfWord platform sz] - UNPACK n -> emit bci_UNPACK [wOp n] - PACK dcon sz -> do itbl_no <- lit [BCONPtrItbl (getName dcon)] - emit bci_PACK [Op itbl_no, wOp sz] + SLIDE n by -> emit_ bci_SLIDE [wOp n, wOp by] + ALLOC_AP n -> emit_ bci_ALLOC_AP [truncHalfWord platform n] + ALLOC_AP_NOUPD n -> emit_ bci_ALLOC_AP_NOUPD [truncHalfWord platform n] + ALLOC_PAP arity n -> emit_ bci_ALLOC_PAP [truncHalfWord platform arity, truncHalfWord platform n] + MKAP off sz -> emit_ bci_MKAP [wOp off, truncHalfWord platform sz] + MKPAP off sz -> emit_ bci_MKPAP [wOp off, truncHalfWord platform sz] + UNPACK n -> emit_ bci_UNPACK [wOp n] + PACK dcon sz -> do itbl_no <- lit1 (BCONPtrItbl (getName dcon)) + emit_ bci_PACK [Op itbl_no, wOp sz] LABEL lbl -> label lbl TESTLT_I i l -> do np <- int i - emit bci_TESTLT_I [Op np, LabelOp l] + emit_ bci_TESTLT_I [Op np, LabelOp l] TESTEQ_I i l -> do np <- int i - emit bci_TESTEQ_I [Op np, LabelOp l] + emit_ bci_TESTEQ_I [Op np, LabelOp l] TESTLT_W w l -> do np <- word w - emit bci_TESTLT_W [Op np, LabelOp l] + emit_ bci_TESTLT_W [Op np, LabelOp l] TESTEQ_W w l -> do np <- word w - emit bci_TESTEQ_W [Op np, LabelOp l] + emit_ bci_TESTEQ_W [Op np, LabelOp l] TESTLT_I64 i l -> do np <- word64 (fromIntegral i) - emit bci_TESTLT_I64 [Op np, LabelOp l] + emit_ bci_TESTLT_I64 [Op np, LabelOp l] TESTEQ_I64 i l -> do np <- word64 (fromIntegral i) - emit bci_TESTEQ_I64 [Op np, LabelOp l] + emit_ bci_TESTEQ_I64 [Op np, LabelOp l] TESTLT_I32 i l -> do np <- word (fromIntegral i) - emit bci_TESTLT_I32 [Op np, LabelOp l] + emit_ bci_TESTLT_I32 [Op np, LabelOp l] TESTEQ_I32 i l -> do np <- word (fromIntegral i) - emit bci_TESTEQ_I32 [Op np, LabelOp l] + emit_ bci_TESTEQ_I32 [Op np, LabelOp l] TESTLT_I16 i l -> do np <- word (fromIntegral i) - emit bci_TESTLT_I16 [Op np, LabelOp l] + emit_ bci_TESTLT_I16 [Op np, LabelOp l] TESTEQ_I16 i l -> do np <- word (fromIntegral i) - emit bci_TESTEQ_I16 [Op np, LabelOp l] + emit_ bci_TESTEQ_I16 [Op np, LabelOp l] TESTLT_I8 i l -> do np <- word (fromIntegral i) - emit bci_TESTLT_I8 [Op np, LabelOp l] + emit_ bci_TESTLT_I8 [Op np, LabelOp l] TESTEQ_I8 i l -> do np <- word (fromIntegral i) - emit bci_TESTEQ_I8 [Op np, LabelOp l] + emit_ bci_TESTEQ_I8 [Op np, LabelOp l] TESTLT_W64 w l -> do np <- word64 w - emit bci_TESTLT_W64 [Op np, LabelOp l] + emit_ bci_TESTLT_W64 [Op np, LabelOp l] TESTEQ_W64 w l -> do np <- word64 w - emit bci_TESTEQ_W64 [Op np, LabelOp l] + emit_ bci_TESTEQ_W64 [Op np, LabelOp l] TESTLT_W32 w l -> do np <- word (fromIntegral w) - emit bci_TESTLT_W32 [Op np, LabelOp l] + emit_ bci_TESTLT_W32 [Op np, LabelOp l] TESTEQ_W32 w l -> do np <- word (fromIntegral w) - emit bci_TESTEQ_W32 [Op np, LabelOp l] + emit_ bci_TESTEQ_W32 [Op np, LabelOp l] TESTLT_W16 w l -> do np <- word (fromIntegral w) - emit bci_TESTLT_W16 [Op np, LabelOp l] + emit_ bci_TESTLT_W16 [Op np, LabelOp l] TESTEQ_W16 w l -> do np <- word (fromIntegral w) - emit bci_TESTEQ_W16 [Op np, LabelOp l] + emit_ bci_TESTEQ_W16 [Op np, LabelOp l] TESTLT_W8 w l -> do np <- word (fromIntegral w) - emit bci_TESTLT_W8 [Op np, LabelOp l] + emit_ bci_TESTLT_W8 [Op np, LabelOp l] TESTEQ_W8 w l -> do np <- word (fromIntegral w) - emit bci_TESTEQ_W8 [Op np, LabelOp l] + emit_ bci_TESTEQ_W8 [Op np, LabelOp l] TESTLT_F f l -> do np <- float f - emit bci_TESTLT_F [Op np, LabelOp l] + emit_ bci_TESTLT_F [Op np, LabelOp l] TESTEQ_F f l -> do np <- float f - emit bci_TESTEQ_F [Op np, LabelOp l] + emit_ bci_TESTEQ_F [Op np, LabelOp l] TESTLT_D d l -> do np <- double d - emit bci_TESTLT_D [Op np, LabelOp l] + emit_ bci_TESTLT_D [Op np, LabelOp l] TESTEQ_D d l -> do np <- double d - emit bci_TESTEQ_D [Op np, LabelOp l] - TESTLT_P i l -> emit bci_TESTLT_P [SmallOp i, LabelOp l] - TESTEQ_P i l -> emit bci_TESTEQ_P [SmallOp i, LabelOp l] - CASEFAIL -> emit bci_CASEFAIL [] - SWIZZLE stkoff n -> emit bci_SWIZZLE [wOp stkoff, IOp n] - JMP l -> emit bci_JMP [LabelOp l] - ENTER -> emit bci_ENTER [] - RETURN rep -> emit (return_non_tuple rep) [] - RETURN_TUPLE -> emit bci_RETURN_T [] - CCALL off m_addr i -> do np <- addr m_addr - emit bci_CCALL [wOp off, Op np, SmallOp i] - PRIMCALL -> emit bci_PRIMCALL [] + emit_ bci_TESTEQ_D [Op np, LabelOp l] + TESTLT_P i l -> emit_ bci_TESTLT_P [SmallOp i, LabelOp l] + TESTEQ_P i l -> emit_ bci_TESTEQ_P [SmallOp i, LabelOp l] + CASEFAIL -> emit_ bci_CASEFAIL [] + SWIZZLE stkoff n -> emit_ bci_SWIZZLE [wOp stkoff, IOp n] + JMP l -> emit_ bci_JMP [LabelOp l] + ENTER -> emit_ bci_ENTER [] + RETURN rep -> emit_ (return_non_tuple rep) [] + RETURN_TUPLE -> emit_ bci_RETURN_T [] + CCALL off ffi i -> do np <- lit1 $ BCONPtrFFIInfo ffi + emit_ bci_CCALL [wOp off, Op np, SmallOp i] + PRIMCALL -> emit_ bci_PRIMCALL [] OP_ADD w -> case w of - W64 -> emit bci_OP_ADD_64 [] - W32 -> emit bci_OP_ADD_32 [] - W16 -> emit bci_OP_ADD_16 [] - W8 -> emit bci_OP_ADD_08 [] + W64 -> emit_ bci_OP_ADD_64 [] + W32 -> emit_ bci_OP_ADD_32 [] + W16 -> emit_ bci_OP_ADD_16 [] + W8 -> emit_ bci_OP_ADD_08 [] _ -> unsupported_width OP_SUB w -> case w of - W64 -> emit bci_OP_SUB_64 [] - W32 -> emit bci_OP_SUB_32 [] - W16 -> emit bci_OP_SUB_16 [] - W8 -> emit bci_OP_SUB_08 [] + W64 -> emit_ bci_OP_SUB_64 [] + W32 -> emit_ bci_OP_SUB_32 [] + W16 -> emit_ bci_OP_SUB_16 [] + W8 -> emit_ bci_OP_SUB_08 [] _ -> unsupported_width OP_AND w -> case w of - W64 -> emit bci_OP_AND_64 [] - W32 -> emit bci_OP_AND_32 [] - W16 -> emit bci_OP_AND_16 [] - W8 -> emit bci_OP_AND_08 [] + W64 -> emit_ bci_OP_AND_64 [] + W32 -> emit_ bci_OP_AND_32 [] + W16 -> emit_ bci_OP_AND_16 [] + W8 -> emit_ bci_OP_AND_08 [] _ -> unsupported_width OP_XOR w -> case w of - W64 -> emit bci_OP_XOR_64 [] - W32 -> emit bci_OP_XOR_32 [] - W16 -> emit bci_OP_XOR_16 [] - W8 -> emit bci_OP_XOR_08 [] + W64 -> emit_ bci_OP_XOR_64 [] + W32 -> emit_ bci_OP_XOR_32 [] + W16 -> emit_ bci_OP_XOR_16 [] + W8 -> emit_ bci_OP_XOR_08 [] _ -> unsupported_width OP_OR w -> case w of - W64 -> emit bci_OP_OR_64 [] - W32 -> emit bci_OP_OR_32 [] - W16 -> emit bci_OP_OR_16 [] - W8 -> emit bci_OP_OR_08 [] + W64 -> emit_ bci_OP_OR_64 [] + W32 -> emit_ bci_OP_OR_32 [] + W16 -> emit_ bci_OP_OR_16 [] + W8 -> emit_ bci_OP_OR_08 [] _ -> unsupported_width OP_NOT w -> case w of - W64 -> emit bci_OP_NOT_64 [] - W32 -> emit bci_OP_NOT_32 [] - W16 -> emit bci_OP_NOT_16 [] - W8 -> emit bci_OP_NOT_08 [] + W64 -> emit_ bci_OP_NOT_64 [] + W32 -> emit_ bci_OP_NOT_32 [] + W16 -> emit_ bci_OP_NOT_16 [] + W8 -> emit_ bci_OP_NOT_08 [] _ -> unsupported_width OP_NEG w -> case w of - W64 -> emit bci_OP_NEG_64 [] - W32 -> emit bci_OP_NEG_32 [] - W16 -> emit bci_OP_NEG_16 [] - W8 -> emit bci_OP_NEG_08 [] + W64 -> emit_ bci_OP_NEG_64 [] + W32 -> emit_ bci_OP_NEG_32 [] + W16 -> emit_ bci_OP_NEG_16 [] + W8 -> emit_ bci_OP_NEG_08 [] _ -> unsupported_width OP_MUL w -> case w of - W64 -> emit bci_OP_MUL_64 [] - W32 -> emit bci_OP_MUL_32 [] - W16 -> emit bci_OP_MUL_16 [] - W8 -> emit bci_OP_MUL_08 [] + W64 -> emit_ bci_OP_MUL_64 [] + W32 -> emit_ bci_OP_MUL_32 [] + W16 -> emit_ bci_OP_MUL_16 [] + W8 -> emit_ bci_OP_MUL_08 [] _ -> unsupported_width OP_SHL w -> case w of - W64 -> emit bci_OP_SHL_64 [] - W32 -> emit bci_OP_SHL_32 [] - W16 -> emit bci_OP_SHL_16 [] - W8 -> emit bci_OP_SHL_08 [] + W64 -> emit_ bci_OP_SHL_64 [] + W32 -> emit_ bci_OP_SHL_32 [] + W16 -> emit_ bci_OP_SHL_16 [] + W8 -> emit_ bci_OP_SHL_08 [] _ -> unsupported_width OP_ASR w -> case w of - W64 -> emit bci_OP_ASR_64 [] - W32 -> emit bci_OP_ASR_32 [] - W16 -> emit bci_OP_ASR_16 [] - W8 -> emit bci_OP_ASR_08 [] + W64 -> emit_ bci_OP_ASR_64 [] + W32 -> emit_ bci_OP_ASR_32 [] + W16 -> emit_ bci_OP_ASR_16 [] + W8 -> emit_ bci_OP_ASR_08 [] _ -> unsupported_width OP_LSR w -> case w of - W64 -> emit bci_OP_LSR_64 [] - W32 -> emit bci_OP_LSR_32 [] - W16 -> emit bci_OP_LSR_16 [] - W8 -> emit bci_OP_LSR_08 [] + W64 -> emit_ bci_OP_LSR_64 [] + W32 -> emit_ bci_OP_LSR_32 [] + W16 -> emit_ bci_OP_LSR_16 [] + W8 -> emit_ bci_OP_LSR_08 [] _ -> unsupported_width OP_NEQ w -> case w of - W64 -> emit bci_OP_NEQ_64 [] - W32 -> emit bci_OP_NEQ_32 [] - W16 -> emit bci_OP_NEQ_16 [] - W8 -> emit bci_OP_NEQ_08 [] + W64 -> emit_ bci_OP_NEQ_64 [] + W32 -> emit_ bci_OP_NEQ_32 [] + W16 -> emit_ bci_OP_NEQ_16 [] + W8 -> emit_ bci_OP_NEQ_08 [] _ -> unsupported_width OP_EQ w -> case w of - W64 -> emit bci_OP_EQ_64 [] - W32 -> emit bci_OP_EQ_32 [] - W16 -> emit bci_OP_EQ_16 [] - W8 -> emit bci_OP_EQ_08 [] + W64 -> emit_ bci_OP_EQ_64 [] + W32 -> emit_ bci_OP_EQ_32 [] + W16 -> emit_ bci_OP_EQ_16 [] + W8 -> emit_ bci_OP_EQ_08 [] _ -> unsupported_width OP_U_LT w -> case w of - W64 -> emit bci_OP_U_LT_64 [] - W32 -> emit bci_OP_U_LT_32 [] - W16 -> emit bci_OP_U_LT_16 [] - W8 -> emit bci_OP_U_LT_08 [] + W64 -> emit_ bci_OP_U_LT_64 [] + W32 -> emit_ bci_OP_U_LT_32 [] + W16 -> emit_ bci_OP_U_LT_16 [] + W8 -> emit_ bci_OP_U_LT_08 [] _ -> unsupported_width OP_S_LT w -> case w of - W64 -> emit bci_OP_S_LT_64 [] - W32 -> emit bci_OP_S_LT_32 [] - W16 -> emit bci_OP_S_LT_16 [] - W8 -> emit bci_OP_S_LT_08 [] + W64 -> emit_ bci_OP_S_LT_64 [] + W32 -> emit_ bci_OP_S_LT_32 [] + W16 -> emit_ bci_OP_S_LT_16 [] + W8 -> emit_ bci_OP_S_LT_08 [] _ -> unsupported_width OP_U_GE w -> case w of - W64 -> emit bci_OP_U_GE_64 [] - W32 -> emit bci_OP_U_GE_32 [] - W16 -> emit bci_OP_U_GE_16 [] - W8 -> emit bci_OP_U_GE_08 [] + W64 -> emit_ bci_OP_U_GE_64 [] + W32 -> emit_ bci_OP_U_GE_32 [] + W16 -> emit_ bci_OP_U_GE_16 [] + W8 -> emit_ bci_OP_U_GE_08 [] _ -> unsupported_width OP_S_GE w -> case w of - W64 -> emit bci_OP_S_GE_64 [] - W32 -> emit bci_OP_S_GE_32 [] - W16 -> emit bci_OP_S_GE_16 [] - W8 -> emit bci_OP_S_GE_08 [] + W64 -> emit_ bci_OP_S_GE_64 [] + W32 -> emit_ bci_OP_S_GE_32 [] + W16 -> emit_ bci_OP_S_GE_16 [] + W8 -> emit_ bci_OP_S_GE_08 [] _ -> unsupported_width OP_U_GT w -> case w of - W64 -> emit bci_OP_U_GT_64 [] - W32 -> emit bci_OP_U_GT_32 [] - W16 -> emit bci_OP_U_GT_16 [] - W8 -> emit bci_OP_U_GT_08 [] + W64 -> emit_ bci_OP_U_GT_64 [] + W32 -> emit_ bci_OP_U_GT_32 [] + W16 -> emit_ bci_OP_U_GT_16 [] + W8 -> emit_ bci_OP_U_GT_08 [] _ -> unsupported_width OP_S_GT w -> case w of - W64 -> emit bci_OP_S_GT_64 [] - W32 -> emit bci_OP_S_GT_32 [] - W16 -> emit bci_OP_S_GT_16 [] - W8 -> emit bci_OP_S_GT_08 [] + W64 -> emit_ bci_OP_S_GT_64 [] + W32 -> emit_ bci_OP_S_GT_32 [] + W16 -> emit_ bci_OP_S_GT_16 [] + W8 -> emit_ bci_OP_S_GT_08 [] _ -> unsupported_width OP_U_LE w -> case w of - W64 -> emit bci_OP_U_LE_64 [] - W32 -> emit bci_OP_U_LE_32 [] - W16 -> emit bci_OP_U_LE_16 [] - W8 -> emit bci_OP_U_LE_08 [] + W64 -> emit_ bci_OP_U_LE_64 [] + W32 -> emit_ bci_OP_U_LE_32 [] + W16 -> emit_ bci_OP_U_LE_16 [] + W8 -> emit_ bci_OP_U_LE_08 [] _ -> unsupported_width OP_S_LE w -> case w of - W64 -> emit bci_OP_S_LE_64 [] - W32 -> emit bci_OP_S_LE_32 [] - W16 -> emit bci_OP_S_LE_16 [] - W8 -> emit bci_OP_S_LE_08 [] + W64 -> emit_ bci_OP_S_LE_64 [] + W32 -> emit_ bci_OP_S_LE_32 [] + W16 -> emit_ bci_OP_S_LE_16 [] + W8 -> emit_ bci_OP_S_LE_08 [] _ -> unsupported_width OP_INDEX_ADDR w -> case w of - W64 -> emit bci_OP_INDEX_ADDR_64 [] - W32 -> emit bci_OP_INDEX_ADDR_32 [] - W16 -> emit bci_OP_INDEX_ADDR_16 [] - W8 -> emit bci_OP_INDEX_ADDR_08 [] + W64 -> emit_ bci_OP_INDEX_ADDR_64 [] + W32 -> emit_ bci_OP_INDEX_ADDR_32 [] + W16 -> emit_ bci_OP_INDEX_ADDR_16 [] + W8 -> emit_ bci_OP_INDEX_ADDR_08 [] _ -> unsupported_width - BRK_FUN arr tick_mod tickx info_mod infox cc -> - do p1 <- ptr (BCOPtrBreakArray arr) - tick_addr <- addr tick_mod - info_addr <- addr info_mod - np <- addr cc - let -- cast that checks that round-tripping through - -- Word32 doesn't change the value - toW32 x = let r = fromIntegral x :: Word32 - in if fromIntegral r == x - then r - else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x) - tick32 = toW32 tickx - tick_hi = fromIntegral (tick32 `shiftR` 16) - tick_lo = fromIntegral (tick32 .&. 0xffff) - info32 = toW32 infox - info_hi = fromIntegral (info32 `shiftR` 16) - info_lo = fromIntegral (info32 .&. 0xffff) - emit bci_BRK_FUN [ Op p1 - , Op tick_addr, Op info_addr - , SmallOp tick_hi, SmallOp tick_lo - , SmallOp info_hi, SmallOp info_lo - , Op np - ] + BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do + p1 <- ptr $ BCOPtrBreakArray info_mod + let -- cast that checks that round-tripping through Word32 doesn't change the value + infoW32 = let r = fromIntegral infox :: Word32 + in if fromIntegral r == infox + then r + else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr infox) + ix_hi = fromIntegral (infoW32 `shiftR` 16) + ix_lo = fromIntegral (infoW32 .&. 0xffff) + info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod + info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod + np <- lit1 $ BCONPtrCostCentre ibi + emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr + , SmallOp ix_hi, SmallOp ix_lo, Op np ] #if MIN_VERSION_rts(1,0,3) - BCO_NAME name -> do np <- lit [BCONPtrStr name] - emit bci_BCO_NAME [Op np] + BCO_NAME name -> do np <- lit1 (BCONPtrStr name) + emit_ bci_BCO_NAME [Op np] #endif + + where unsupported_width = panic "GHC.ByteCode.Asm: Unsupported Width" + emit_ = emit word_size + literal :: Literal -> m Word literal (LitLabel fs _) = litlabel fs literal LitNullAddr = word 0 literal (LitFloat r) = float (fromRational r) literal (LitDouble r) = double (fromRational r) literal (LitChar c) = int (ord c) - literal (LitString bs) = lit [BCONPtrStr bs] + literal (LitString bs) = lit1 (BCONPtrStr bs) -- LitString requires a zero-terminator when emitted literal (LitNumber nt i) = case nt of LitNumInt -> word (fromIntegral i) @@ -712,10 +893,10 @@ -- analysis messed up. literal (LitRubbish {}) = word 0 - litlabel fs = lit [BCONPtrLbl fs] - addr (RemotePtr a) = words [fromIntegral a] - words ws = lit (map BCONPtrWord ws) - word w = words [w] + litlabel fs = lit1 (BCONPtrLbl fs) + words ws = lit (fmap BCONPtrWord ws) + word w = words (OnlyOne w) + word2 w1 w2 = words (OnlyTwo w1 w2) word_size = platformWordSize platform word_size_bits = platformWordSizeInBits platform @@ -726,36 +907,36 @@ -- Note that we only support host endianness == target endianness for now, -- even with the external interpreter. This would need to be fixed to -- support host endianness /= target endianness - int :: Int -> Assembler Word + int :: Int -> m Word int i = word (fromIntegral i) - float :: Float -> Assembler Word + float :: Float -> m Word float f = word32 (castFloatToWord32 f) - double :: Double -> Assembler Word + double :: Double -> m Word double d = word64 (castDoubleToWord64 d) - word64 :: Word64 -> Assembler Word + word64 :: Word64 -> m Word word64 ww = case word_size of PW4 -> let !wl = fromIntegral ww !wh = fromIntegral (ww `unsafeShiftR` 32) in case platformByteOrder platform of - LittleEndian -> words [wl,wh] - BigEndian -> words [wh,wl] + LittleEndian -> word2 wl wh + BigEndian -> word2 wh wl PW8 -> word (fromIntegral ww) - word8 :: Word8 -> Assembler Word + word8 :: Word8 -> m Word word8 x = case platformByteOrder platform of LittleEndian -> word (fromIntegral x) BigEndian -> word (fromIntegral x `unsafeShiftL` (word_size_bits - 8)) - word16 :: Word16 -> Assembler Word + word16 :: Word16 -> m Word word16 x = case platformByteOrder platform of LittleEndian -> word (fromIntegral x) BigEndian -> word (fromIntegral x `unsafeShiftL` (word_size_bits - 16)) - word32 :: Word32 -> Assembler Word + word32 :: Word32 -> m Word word32 x = case platformByteOrder platform of LittleEndian -> word (fromIntegral x) BigEndian -> case word_size of diff --git a/GHC/ByteCode/Breakpoints.hs b/GHC/ByteCode/Breakpoints.hs new file mode 100644 --- /dev/null +++ b/GHC/ByteCode/Breakpoints.hs @@ -0,0 +1,299 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DerivingStrategies #-} + +-- | Breakpoint information constructed during ByteCode generation. +-- +-- Specifically, code-generation breakpoints are referred to as "internal +-- breakpoints", the internal breakpoint data for a module is stored in +-- 'InternalModBreaks', and is uniquely identified at runtime by an +-- 'InternalBreakpointId'. +-- +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] +module GHC.ByteCode.Breakpoints + ( -- * Internal Mod Breaks + InternalModBreaks(..), CgBreakInfo(..) + , mkInternalModBreaks, imodBreaks_module + + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex + , InternalBreakLoc(..) + + -- * Operations + + -- ** Internal-level operations + , getInternalBreak + + -- ** Source-level information operations + , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS + , getBreakSourceId, getBreakSourceMod + + -- * Utils + , seqInternalModBreaks + + ) + where + +import GHC.Prelude +import GHC.Types.SrcLoc +import GHC.Types.Name.Occurrence +import Control.DeepSeq +import Data.IntMap.Strict (IntMap) +import qualified Data.IntMap.Strict as IM + +import GHC.HsToCore.Breakpoints +import GHC.Iface.Syntax + +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import Data.Array + +{- +Note [ModBreaks vs InternalModBreaks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'ModBreaks' and 'BreakpointId's must not to be confused with +'InternalModBreaks' and 'InternalBreakId's. + +'ModBreaks' is constructed once during HsToCore from the information attached +to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks' +can be queried using 'BreakpointId's, which uniquely identifies a breakpoint +within the list of breakpoint information for a given module's 'ModBreaks'. + +'InternalModBreaks' are constructed during bytecode generation and are indexed +by a 'InternalBreakpointId'. They contain all the information relevant to a +breakpoint for code generation that can be accessed during runtime execution +(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's +are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN' +instruction receives 'InternalBreakpointId' as an argument. + +We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used +to get source-level information about a breakpoint via the corresponding 'ModBreaks'. + +Notably, 'InternalModBreaks' can contain entries for so-called internal +breakpoints, which do not necessarily have a source-level location attached to +it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to +introduce breakpoints during code generation for features such as stepping-out. + +Note [Breakpoint identifiers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before optimization a breakpoint is identified uniquely with a tick module +and a tick index. See 'BreakpointId'. A tick module contains an array, indexed +with the tick indexes, which indicates breakpoint status. + +When we generate ByteCode, we collect information for every breakpoint at +their *occurrence sites* (see CgBreakInfo) and these info +are stored in the ModIface of the occurrence module. Because of inlining, we +can't reuse the tick index to uniquely identify an occurrence; because of +cross-module inlining, we can't assume that the occurrence module is the same +as the tick module (#24712). + +So every breakpoint occurrence gets assigned a module-unique *info index* and +we store it alongside the occurrence module (*info module*) in the +'InternalBreakpointId' datatype. This is the index that we use at runtime to +identify a breakpoint. + +When the internal breakpoint has a matching tick-level breakpoint we can fetch +the related tick-level information by first looking up a mapping +@'InternalBreakpointId' -> 'BreakpointId'@ in @'CgBreakInfo'@. +-} + +-------------------------------------------------------------------------------- +-- * Internal breakpoint identifiers +-------------------------------------------------------------------------------- + +-- | Internal breakpoint info index +type BreakInfoIndex = Int + +-- | Internal breakpoint identifier +-- +-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation. +-- See Note [Breakpoint identifiers] +data InternalBreakpointId = InternalBreakpointId + { ibi_info_mod :: !Module -- ^ Breakpoint info module + , ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint info index + } + deriving (Eq, Ord) + +-------------------------------------------------------------------------------- +-- * Internal Mod Breaks +-------------------------------------------------------------------------------- + +-- | Internal mod breaks store the runtime-relevant information of breakpoints. +-- +-- Importantly, it maps 'InternalBreakpointId's to 'CgBreakInfo'. +-- +-- 'InternalModBreaks' are constructed during bytecode generation and stored in +-- 'CompiledByteCode' afterwards. +data InternalModBreaks = InternalModBreaks + { imodBreaks_breakInfo :: !(IntMap CgBreakInfo) + -- ^ Access code-gen time information about a breakpoint, indexed by + -- 'InternalBreakpointId'. + + , imodBreaks_modBreaks :: !ModBreaks + -- ^ Store the ModBreaks for this module + -- + -- Recall Note [Breakpoint identifiers]: for some module A, an + -- *occurrence* of a breakpoint in A may have been inlined from some + -- breakpoint *defined* in module B. + -- + -- This 'ModBreaks' contains information regarding all the breakpoints + -- defined in the module this 'InternalModBreaks' corresponds to. It + -- /does not/ necessarily have information regarding all the breakpoint + -- occurrences registered in 'imodBreaks_breakInfo'. Some of those + -- occurrences may refer breakpoints inlined from other modules. + } + +-- | Construct an 'InternalModBreaks'. +-- +-- INVARIANT: The given 'ModBreaks' correspond to the same module as this +-- 'InternalModBreaks' module (the first argument) and its breakpoint infos +-- (the @IntMap CgBreakInfo@ argument) +mkInternalModBreaks :: Module -> IntMap CgBreakInfo -> ModBreaks -> InternalModBreaks +mkInternalModBreaks mod im mbs = + assertPpr (mod == modBreaks_module mbs) + (text "Constructing InternalModBreaks with the ModBreaks of a different module!") $ + InternalModBreaks im mbs + +-- | Get the module to which these 'InternalModBreaks' correspond +imodBreaks_module :: InternalModBreaks -> Module +imodBreaks_module = modBreaks_module . imodBreaks_modBreaks + +-- | Information about a breakpoint that we know at code-generation time +-- In order to be used, this needs to be hydrated relative to the current HscEnv by +-- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for +-- preventing space leaks (see #22530) +data CgBreakInfo + = CgBreakInfo + { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint + , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] + , cgb_resty :: !IfaceType + , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId) + -- ^ This field records the original breakpoint tick identifier for this + -- internal breakpoint info. It is used to convert a breakpoint + -- *occurrence* index ('InternalBreakpointId') into a *definition* index + -- ('BreakpointId'). + -- + -- The modules of breakpoint occurrence and breakpoint definition are not + -- necessarily the same: See Note [Breakpoint identifiers]. + -- + -- If there is no original tick identifier (that is, the breakpoint was + -- created during code generation), we re-use the BreakpointId of something else. + -- It would also be reasonable to have an @Either something BreakpointId@ + -- for @cgb_tick_id@, but currently we can always re-use a source-level BreakpointId. + -- In the case of step-out, see Note [Debugger: Stepout internal break locs] + } +-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval + +-- | Breakpoints created during code generation don't have a source-level tick +-- location. Instead, we re-use an existing one. +newtype InternalBreakLoc = InternalBreakLoc { internalBreakLoc :: BreakpointId } + deriving newtype (Eq, NFData, Outputable) + +-- | Get an internal breakpoint info by 'InternalBreakpointId' +getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo +getInternalBreak (InternalBreakpointId mod ix) imbs = + assert_modules_match mod (imodBreaks_module imbs) $ + imodBreaks_breakInfo imbs IM.! ix + +-- | Assert that the module in the 'InternalBreakpointId' and in +-- 'InternalModBreaks' match. +assert_modules_match :: Module -> Module -> a -> a +assert_modules_match ibi_mod imbs_mod = + assertPpr (ibi_mod == imbs_mod) + (text "Tried to query the InternalModBreaks of module" <+> ppr imbs_mod + <+> text "with an InternalBreakpointId for module" <+> ppr ibi_mod) + +-------------------------------------------------------------------------------- +-- Tick-level Breakpoint information +-------------------------------------------------------------------------------- + +-- | Get the source module and tick index for this breakpoint +-- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId') +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId +getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs = + assert_modules_match ibi_mod (imodBreaks_module imbs) $ + let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix + in either internalBreakLoc id (cgb_tick_id cgb) + +-- | Get the source module for this breakpoint (where the breakpoint is defined) +getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module +getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs = + assert_modules_match ibi_mod (imodBreaks_module imbs) $ + let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix + in either (bi_tick_mod . internalBreakLoc) bi_tick_mod (cgb_tick_id cgb) + +-- | Get the source span for this breakpoint +getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan +getBreakLoc = getBreakXXX modBreaks_locs + +-- | Get the vars for this breakpoint +getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName] +getBreakVars = getBreakXXX modBreaks_vars + +-- | Get the decls for this breakpoint +getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String] +getBreakDecls = getBreakXXX modBreaks_decls + +-- | Get the decls for this breakpoint +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO ((String, String)) +getBreakCCS = getBreakXXX modBreaks_ccs + +-- | Internal utility to access a ModBreaks field at a particular breakpoint index +-- +-- Recall Note [Breakpoint identifiers]: the internal breakpoint module (the +-- *occurrence* module) doesn't necessarily match the module where the +-- tick breakpoint was defined with the relevant 'ModBreaks'. +-- +-- When the tick module is the same as the internal module, we use the stored +-- 'ModBreaks'. When the tick module is different, we need to look up the +-- 'ModBreaks' in the HUG for that other module. +-- +-- When there is no tick module (the breakpoint was generated at codegen), use +-- the function on internal mod breaks. +-- +-- To avoid cyclic dependencies, we instead receive a function that looks up +-- the 'ModBreaks' given a 'Module' +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a +getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs = + assert_modules_match ibi_mod (imodBreaks_module imbs) $ do + let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix + case either internalBreakLoc id (cgb_tick_id cgb) of + BreakpointId{bi_tick_mod, bi_tick_index} + | bi_tick_mod == ibi_mod + -> do + let these_mbs = imodBreaks_modBreaks imbs + return $ view these_mbs ! bi_tick_index + | otherwise + -> do + other_mbs <- lookupModule bi_tick_mod + return $ view other_mbs ! bi_tick_index + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +-- | Fully force an 'InternalModBreaks' value +seqInternalModBreaks :: InternalModBreaks -> () +seqInternalModBreaks InternalModBreaks{..} = + rnf (fmap seqCgBreakInfo imodBreaks_breakInfo) + where + seqCgBreakInfo :: CgBreakInfo -> () + seqCgBreakInfo CgBreakInfo{..} = + rnf cgb_tyvars `seq` + rnf cgb_vars `seq` + rnf cgb_resty `seq` + rnf cgb_tick_id + +instance Outputable InternalBreakpointId where + ppr InternalBreakpointId{..} = + text "InternalBreakpointId" <+> ppr ibi_info_mod <+> ppr ibi_info_index + +instance NFData InternalBreakpointId where + rnf InternalBreakpointId{..} = + rnf ibi_info_mod `seq` rnf ibi_info_index + +instance Outputable CgBreakInfo where + ppr info = text "CgBreakInfo" <+> + parens (ppr (cgb_vars info) <+> + ppr (cgb_resty info) <+> + ppr (cgb_tick_id info)) diff --git a/GHC/ByteCode/InfoTable.hs b/GHC/ByteCode/InfoTable.hs --- a/GHC/ByteCode/InfoTable.hs +++ b/GHC/ByteCode/InfoTable.hs @@ -13,15 +13,13 @@ import GHC.Platform import GHC.Platform.Profile -import GHC.ByteCode.Types -import GHC.Runtime.Interpreter +import GHCi.Message import GHC.Types.Name ( Name, getName ) -import GHC.Types.Name.Env import GHC.Types.RepType import GHC.Core.DataCon ( DataCon, dataConRepArgTys, dataConIdentity ) -import GHC.Core.TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons ) +import GHC.Core.TyCon ( TyCon, tyConFamilySize, isBoxedDataTyCon, tyConDataCons ) import GHC.Core.Multiplicity ( scaledThing ) import GHC.StgToCmm.Layout ( mkVirtConstrSizes ) @@ -35,33 +33,38 @@ -} -- Make info tables for the data decls in this module -mkITbls :: Interp -> Profile -> [TyCon] -> IO ItblEnv -mkITbls interp profile tcs = - foldr plusNameEnv emptyNameEnv <$> - mapM mkITbl (filter isDataTyCon tcs) +mkITbls :: Profile -> [TyCon] -> [(Name, ConInfoTable)] +mkITbls profile tcs = concatMap mkITbl (filter isBoxedDataTyCon tcs) where - mkITbl :: TyCon -> IO ItblEnv + mkITbl :: TyCon -> [(Name, ConInfoTable)] mkITbl tc | dcs `lengthIs` n -- paranoia; this is an assertion. - = make_constr_itbls interp profile dcs + = make_constr_itbls profile dcs where dcs = tyConDataCons tc n = tyConFamilySize tc mkITbl _ = panic "mkITbl" -mkItblEnv :: [(Name,ItblPtr)] -> ItblEnv -mkItblEnv pairs = mkNameEnv [(n, (n,p)) | (n,p) <- pairs] - -- Assumes constructors are numbered from zero, not one -make_constr_itbls :: Interp -> Profile -> [DataCon] -> IO ItblEnv -make_constr_itbls interp profile cons = +make_constr_itbls :: Profile -> [DataCon] -> [(Name, ConInfoTable)] +make_constr_itbls profile cons = -- TODO: the profile should be bundled with the interpreter: the rts ways are -- fixed for an interpreter - mkItblEnv <$> mapM (uncurry mk_itbl) (zip cons [0..]) - where - mk_itbl :: DataCon -> Int -> IO (Name,ItblPtr) - mk_itbl dcon conNo = do - let rep_args = [ prim_rep + map (uncurry mk_itbl) (zip cons [0..]) + where + mk_itbl :: DataCon -> Int -> (Name, ConInfoTable) + mk_itbl dcon conNo = + ( getName dcon, + ConInfoTable + tables_next_to_code + ptrs' + nptrs_really + conNo + (tagForCon platform dcon) + descr + ) + where + rep_args = [ prim_rep | arg <- dataConRepArgTys dcon , prim_rep <- typePrimRep (scaledThing arg) ] @@ -79,7 +82,3 @@ platform = profilePlatform profile constants = platformConstants platform tables_next_to_code = platformTablesNextToCode platform - - r <- interpCmd interp (MkConInfoTable tables_next_to_code ptrs' nptrs_really - conNo (tagForCon platform dcon) descr) - return (getName dcon, ItblPtr r) diff --git a/GHC/ByteCode/Instr.hs b/GHC/ByteCode/Instr.hs --- a/GHC/ByteCode/Instr.hs +++ b/GHC/ByteCode/Instr.hs @@ -15,12 +15,11 @@ import GHC.ByteCode.Types import GHC.Cmm.Type (Width) -import GHCi.RemoteTypes -import GHCi.FFI (C_ffi_cif) import GHC.StgToCmm.Layout ( ArgRep(..) ) import GHC.Utils.Outputable import GHC.Types.Name import GHC.Types.Literal +import GHC.Types.Unique import GHC.Core.DataCon import GHC.Builtin.PrimOps import GHC.Runtime.Heap.Layout ( StgWord ) @@ -32,11 +31,8 @@ import Data.ByteString (ByteString) #endif -import GHC.Stack.CCS (CostCentre) import GHC.Stg.Syntax -import GHCi.BreakArray (BreakArray) -import Language.Haskell.Syntax.Module.Name (ModuleName) -- ---------------------------------------------------------------------------- -- Bytecode instructions @@ -50,15 +46,17 @@ protoBCOBitmapSize :: Word, protoBCOArity :: Int, -- what the BCO came from, for debugging only - protoBCOExpr :: Either [CgStgAlt] CgStgRhs, - -- malloc'd pointers - protoBCOFFIs :: [FFIInfo] + protoBCOExpr :: Either [CgStgAlt] CgStgRhs } -- | A local block label (e.g. identifying a case alternative). newtype LocalLabel = LocalLabel { getLocalLabel :: Word32 } deriving (Eq, Ord) +-- Just so we can easily juse UniqFM. +instance Uniquable LocalLabel where + getUnique (LocalLabel w) = mkUniqueGrimily $ fromIntegral w + instance Outputable LocalLabel where ppr (LocalLabel lbl) = text "lbl:" <> ppr lbl @@ -191,7 +189,12 @@ -- The Word16 value is a constructor number and therefore -- stored in the insn stream rather than as an offset into -- the literal pool. + + -- | Test whether the tag of a closure pointer is less than the given value. + -- If not, jump to the given label. | TESTLT_P !Word16 LocalLabel + -- | Test whether the tag of a closure pointer is equal to the given value. + -- If not, jump to the given label. | TESTEQ_P !Word16 LocalLabel | CASEFAIL @@ -199,7 +202,7 @@ -- For doing calls to C (via glue code generated by libffi) | CCALL !WordOff -- stack frame size - (RemotePtr C_ffi_cif) -- addr of the glue code + !FFIInfo -- libffi ffi_cif function prototype !Word16 -- flags. -- -- 0x1: call is interruptible @@ -255,12 +258,7 @@ -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode -- Breakpoints - | BRK_FUN (ForeignRef BreakArray) - (RemotePtr ModuleName) -- breakpoint tick module - !Word16 -- breakpoint tick index - (RemotePtr ModuleName) -- breakpoint info module - !Word16 -- breakpoint info index - (RemotePtr CostCentre) + | BRK_FUN !InternalBreakpointId #if MIN_VERSION_rts(1,0,3) -- | A "meta"-instruction for recording the name of a BCO for debugging purposes. @@ -287,10 +285,9 @@ , protoBCOBitmap = bitmap , protoBCOBitmapSize = bsize , protoBCOArity = arity - , protoBCOExpr = origin - , protoBCOFFIs = ffis }) + , protoBCOExpr = origin }) = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity - <+> text (show ffis) <> colon) + <> colon) $$ nest 3 (case origin of Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';')) @@ -414,9 +411,9 @@ ppr (TESTEQ_P i lab) = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab ppr CASEFAIL = text "CASEFAIL" ppr (JMP lab) = text "JMP" <+> ppr lab - ppr (CCALL off marshal_addr flags) = text "CCALL " <+> ppr off + ppr (CCALL off ffi flags) = text "CCALL " <+> ppr off <+> text "marshal code at" - <+> text (show marshal_addr) + <+> text (show ffi) <+> (case flags of 0x1 -> text "(interruptible)" 0x2 -> text "(unsafe)" @@ -453,10 +450,9 @@ ppr ENTER = text "ENTER" ppr (RETURN pk) = text "RETURN " <+> ppr pk ppr (RETURN_TUPLE) = text "RETURN_TUPLE" - ppr (BRK_FUN _ _tick_mod tickx _info_mod infox _) + ppr (BRK_FUN (InternalBreakpointId info_mod infox)) = text "BRK_FUN" <+> text "" - <+> text "" <+> ppr tickx - <+> text "" <+> ppr infox + <+> ppr info_mod <+> ppr infox <+> text "" #if MIN_VERSION_rts(1,0,3) ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm) diff --git a/GHC/ByteCode/Linker.hs b/GHC/ByteCode/Linker.hs --- a/GHC/ByteCode/Linker.hs +++ b/GHC/ByteCode/Linker.hs @@ -1,6 +1,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} -- -- (c) The University of Glasgow 2002-2006 @@ -11,7 +14,6 @@ ( linkBCO , lookupStaticPtr , lookupIE - , nameToCLabel , linkFail ) where @@ -25,11 +27,12 @@ import GHC.Builtin.PrimOps import GHC.Builtin.PrimOps.Ids -import GHC.Builtin.Names +import GHC.Unit.Module.Env import GHC.Unit.Types import GHC.Data.FastString +import GHC.Data.Maybe import GHC.Data.SizedSeq import GHC.Linker.Types @@ -42,8 +45,6 @@ import qualified GHC.Types.Id as Id import GHC.Types.Unique.DFM -import Language.Haskell.Syntax.Module.Name - -- Standard libraries import Data.Array.Unboxed import Foreign.Ptr @@ -57,24 +58,27 @@ :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp pkgs_loaded le bco_ix +linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0) + (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le lb bco_ix) (elemsFlatBag ptrs0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits - return (ResolvedBCO isLittleEndian arity - insns - bitmap - (mkBCOByteArray lits') - (addListToSS emptySS ptrs)) + return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian + , resolvedBCOArity = arity + , resolvedBCOInstrs = insns + , resolvedBCOBitmap = bitmap + , resolvedBCOLits = mkBCOByteArray lits' + , resolvedBCOPtrs = addListToSS emptySS ptrs + } -lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> LinkedBreaks -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le lb ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -85,36 +89,49 @@ BCONPtrAddr nm -> do Ptr a# <- lookupAddr interp pkgs_loaded (addr_env le) nm return (W# (int2Word# (addr2Int# a#))) - BCONPtrStr _ -> - -- should be eliminated during assembleBCOs - panic "lookupLiteral: BCONPtrStr" + BCONPtrStr bs -> do + RemotePtr p <- fmap head $ interpCmd interp $ MallocStrings [bs] + pure $ fromIntegral p + BCONPtrFS fs -> do + RemotePtr p <- fmap head $ interpCmd interp $ MallocStrings [bytesFS fs] + pure $ fromIntegral p + BCONPtrFFIInfo (FFIInfo {..}) -> do + RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet + pure $ fromIntegral p + BCONPtrCostCentre InternalBreakpointId{..} + | interpreterProfiled interp -> do + case expectJust (lookupModuleEnv (ccs_env lb) ibi_info_mod) ! ibi_info_index of + RemotePtr p -> pure $ fromIntegral p + | otherwise -> + case toRemotePtr nullPtr of + RemotePtr p -> pure $ fromIntegral p lookupStaticPtr :: Interp -> FastString -> IO (Ptr ()) lookupStaticPtr interp addr_of_label_string = do - m <- lookupSymbol interp addr_of_label_string + m <- lookupSymbol interp (IFaststringSymbol addr_of_label_string) case m of Just ptr -> return ptr Nothing -> linkFail "GHC.ByteCode.Linker: can't find label" - (unpackFS addr_of_label_string) + (ppr addr_of_label_string) lookupIE :: Interp -> PkgsLoaded -> ItblEnv -> Name -> IO (Ptr ()) lookupIE interp pkgs_loaded ie con_nm = case lookupNameEnv ie con_nm of Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a)) Nothing -> do -- try looking up in the object files. - let sym_to_find1 = nameToCLabel con_nm "con_info" - m <- lookupHsSymbol interp pkgs_loaded con_nm "con_info" + let sym_to_find1 = IConInfoSymbol con_nm + m <- lookupHsSymbol interp pkgs_loaded sym_to_find1 case m of Just addr -> return addr Nothing -> do -- perhaps a nullary constructor? - let sym_to_find2 = nameToCLabel con_nm "static_info" - n <- lookupHsSymbol interp pkgs_loaded con_nm "static_info" + let sym_to_find2 = IStaticInfoSymbol con_nm + n <- lookupHsSymbol interp pkgs_loaded sym_to_find2 case n of Just addr -> return addr Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE" - (unpackFS sym_to_find1 ++ " or " ++ - unpackFS sym_to_find2) + (ppr sym_to_find1 <> " or " <> + ppr sym_to_find2) -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode lookupAddr :: Interp -> PkgsLoaded -> AddrEnv -> Name -> IO (Ptr ()) @@ -122,30 +139,31 @@ case lookupNameEnv ae addr_nm of Just (_, AddrPtr ptr) -> return (fromRemotePtr ptr) Nothing -> do -- try looking up in the object files. - let sym_to_find = nameToCLabel addr_nm "bytes" + let sym_to_find = IBytesSymbol addr_nm -- see Note [Bytes label] in GHC.Cmm.CLabel - m <- lookupHsSymbol interp pkgs_loaded addr_nm "bytes" + m <- lookupHsSymbol interp pkgs_loaded sym_to_find case m of Just ptr -> return ptr Nothing -> linkFail "GHC.ByteCode.Linker.lookupAddr" - (unpackFS sym_to_find) + (ppr sym_to_find) lookupPrimOp :: Interp -> PkgsLoaded -> PrimOp -> IO (RemotePtr ()) lookupPrimOp interp pkgs_loaded primop = do let sym_to_find = primopToCLabel primop "closure" - m <- lookupHsSymbol interp pkgs_loaded (Id.idName $ primOpId primop) "closure" + m <- lookupHsSymbol interp pkgs_loaded (IClosureSymbol (Id.idName $ primOpId primop)) case m of Just p -> return (toRemotePtr p) - Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find + Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" (text sym_to_find) resolvePtr :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -156,30 +174,30 @@ | otherwise -> assertPpr (isExternalName nm) (ppr nm) $ do - let sym_to_find = nameToCLabel nm "closure" - m <- lookupHsSymbol interp pkgs_loaded nm "closure" + let sym_to_find = IClosureSymbol nm + m <- lookupHsSymbol interp pkgs_loaded sym_to_find case m of Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p)) - Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find) + Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (ppr sym_to_find) BCOPtrPrimOp op -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le lb bco_ix bco - BCOPtrBreakArray breakarray - -> withForeignRef breakarray $ \ba -> return (ResolvedBCOPtrBreakArray ba) + BCOPtrBreakArray tick_mod -> + withForeignRef (expectJust (lookupModuleEnv (breakarray_env lb) tick_mod)) $ + \ba -> pure $ ResolvedBCOPtrBreakArray ba -- | Look up the address of a Haskell symbol in the currently -- loaded units. -- -- See Note [Looking up symbols in the relevant objects]. -lookupHsSymbol :: Interp -> PkgsLoaded -> Name -> String -> IO (Maybe (Ptr ())) -lookupHsSymbol interp pkgs_loaded nm sym_suffix = do - massertPpr (isExternalName nm) (ppr nm) - let sym_to_find = nameToCLabel nm sym_suffix - pkg_id = moduleUnitId $ nameModule nm +lookupHsSymbol :: Interp -> PkgsLoaded -> InterpSymbol (Suffix s) -> IO (Maybe (Ptr ())) +lookupHsSymbol interp pkgs_loaded sym_to_find = do + massertPpr (isExternalName (interpSymbolName sym_to_find)) (ppr sym_to_find) + let pkg_id = moduleUnitId $ nameModule (interpSymbolName sym_to_find) loaded_dlls = maybe [] loaded_pkg_hs_dlls $ lookupUDFM pkgs_loaded pkg_id go (dll:dlls) = do @@ -193,12 +211,12 @@ go loaded_dlls -linkFail :: String -> String -> IO a +linkFail :: String -> SDoc -> IO a linkFail who what = throwGhcExceptionIO (ProgramError $ unlines [ "",who , "During interactive linking, GHCi couldn't find the following symbol:" - , ' ' : ' ' : what + , ' ' : ' ' : showSDocUnsafe what , "This may be due to you not asking GHCi to load extra object files," , "archives or DLLs needed by your current session. Restart GHCi, specifying" , "the missing library using the -L/path/to/object/dir and -lmissinglibname" @@ -209,31 +227,14 @@ ]) -nameToCLabel :: Name -> String -> FastString -nameToCLabel n suffix = mkFastString label - where - encodeZ = zString . zEncodeFS - (Module pkgKey modName) = assert (isExternalName n) $ case nameModule n of - -- Primops are exported from GHC.Prim, their HValues live in GHC.PrimopWrappers - -- See Note [Primop wrappers] in GHC.Builtin.PrimOps. - mod | mod == gHC_PRIM -> gHC_PRIMOPWRAPPERS - mod -> mod - packagePart = encodeZ (unitFS pkgKey) - modulePart = encodeZ (moduleNameFS modName) - occPart = encodeZ $ occNameMangledFS (nameOccName n) - label = concat - [ if pkgKey == mainUnit then "" else packagePart ++ "_" - , modulePart - , '_':occPart - , '_':suffix - ] + -- See Note [Primop wrappers] in GHC.Builtin.PrimOps primopToCLabel :: PrimOp -> String -> String primopToCLabel primop suffix = concat - [ "ghczmprim_GHCziPrimopWrappers_" + [ "ghczminternal_GHCziInternalziPrimopWrappers_" , zString (zEncodeFS (occNameFS (primOpOcc primop))) , '_':suffix ] diff --git a/GHC/ByteCode/Types.hs b/GHC/ByteCode/Types.hs --- a/GHC/ByteCode/Types.hs +++ b/GHC/ByteCode/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} @@ -18,10 +19,15 @@ , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) , ItblEnv, ItblPtr(..) , AddrEnv, AddrPtr(..) - , CgBreakInfo(..) - , ModBreaks (..), BreakIndex, emptyModBreaks - , CCostCentre - , FlatBag, sizeFlatBag, fromSizedSeq, elemsFlatBag + , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag + + -- * Mod Breaks + , ModBreaks (..), BreakpointId(..), BreakTickIndex + + -- * Internal Mod Breaks + , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks + -- ** Internal breakpoint identifier + , InternalBreakpointId(..), BreakInfoIndex ) where import GHC.Prelude @@ -33,23 +39,19 @@ import GHC.Utils.Outputable import GHC.Builtin.PrimOps import GHC.Types.SptEntry -import GHC.Types.SrcLoc -import GHCi.BreakArray +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints +import GHCi.Message import GHCi.RemoteTypes import GHCi.FFI import Control.DeepSeq import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray ) import Foreign -import Data.Array import Data.ByteString (ByteString) -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import qualified GHC.Exts.Heap as Heap -import GHC.Stack.CCS import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) -import GHC.Iface.Syntax -import Language.Haskell.Syntax.Module.Name (ModuleName) +import GHC.Unit.Module -- ----------------------------------------------------------------------------- -- Compiled Byte Code @@ -58,27 +60,29 @@ { bc_bcos :: FlatBag UnlinkedBCO -- ^ Bunch of interpretable bindings - , bc_itbls :: ItblEnv + , bc_itbls :: [(Name, ConInfoTable)] -- ^ Mapping from DataCons to their info tables - , bc_ffis :: [FFIInfo] - -- ^ ffi blocks we allocated - - , bc_strs :: AddrEnv + , bc_strs :: [(Name, ByteString)] -- ^ top-level strings (heap allocated) - , bc_breaks :: Maybe ModBreaks - -- ^ breakpoint info (Nothing if breakpoints are disabled) + , bc_breaks :: Maybe InternalModBreaks + -- ^ All breakpoint information (no information if breakpoints are disabled). + -- + -- This information is used when loading a bytecode object: we will + -- construct the arrays to be used at runtime to trigger breakpoints at load time + -- from it (in 'allocateBreakArrays' and 'allocateCCS' in 'GHC.ByteCode.Loader'). , bc_spt_entries :: ![SptEntry] -- ^ Static pointer table entries which should be loaded along with the -- BCOs. See Note [Grand plan for static forms] in -- "GHC.Iface.Tidy.StaticPtrTable". } - -- ToDo: we're not tracking strings that we malloc'd -newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif) - deriving (Show, NFData) +-- | A libffi ffi_cif function prototype. +data FFIInfo = FFIInfo { ffiInfoArgs :: ![FFIType], ffiInfoRet :: !FFIType } + deriving (Show) + instance Outputable CompiledByteCode where ppr CompiledByteCode{..} = ppr $ elemsFlatBag bc_bcos @@ -87,10 +91,11 @@ seqCompiledByteCode :: CompiledByteCode -> () seqCompiledByteCode CompiledByteCode{..} = rnf bc_bcos `seq` - seqEltsNameEnv rnf bc_itbls `seq` - rnf bc_ffis `seq` - seqEltsNameEnv rnf bc_strs `seq` - rnf (fmap seqModBreaks bc_breaks) + rnf bc_itbls `seq` + rnf bc_strs `seq` + case bc_breaks of + Nothing -> () + Just ibks -> seqInternalModBreaks ibks newtype ByteOff = ByteOff Int deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) @@ -166,6 +171,80 @@ newtype AddrPtr = AddrPtr (RemotePtr ()) deriving (NFData) +{- +-------------------------------------------------------------------------------- +-- * Byte Code Objects (BCOs) +-------------------------------------------------------------------------------- + +Note [Case continuation BCOs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A stack with a BCO stack frame at the top looks like: + + (an StgBCO) + | ... | +---> +---------[1]--+ + +------------------+ | | info_tbl_ptr | ------+ + | OTHER FRAME | | +--------------+ | + +------------------+ | | StgArrBytes* | <--- the byte code + | ... | | +--------------+ | + +------------------+ | | ... | | + | fvs1 | | | + +------------------+ | | + | ... | | (StgInfoTable) | + +------------------+ | +----------+ <---+ + | args1 | | | ... | + +------------------+ | +----------+ + | some StgBCO* | -----+ | type=BCO | + +------------------+ +----------+ + Sp | stg_apply_interp | -----+ | ... | + +------------------+ | + | + | (StgInfoTable) + +----> +--------------+ + | ... | + +--------------+ + | type=RET_BCO | + +--------------+ + | ... | + + +In the case of bytecode objects found on the heap (e.g. thunks and functions), +the bytecode may refer to free variables recorded in the BCO closure itself. +By contrast, in /case continuation/ BCOs the code may additionally refer to free +variables in their stack frame. These are references by way of statically known +stack offsets (tracked using `BCEnv` in `StgToByteCode`). + +For instance, consider the function: + + f x y = case y of ... -> g x + +Here the RHS of the alternative refers to `x`, which will be recorded in the +continuation stack frame of the `case`. + +Even less obvious is that case continuation BCOs may also refer to free +variables in *parent* stack frames. For instance, + + f x y = case y of + ... -> case g x of + ... -> x + +Here, the RHS of the first alternative still refers to the `x` in the stack +frame of the `case`. Additionally, the RHS of the second alternative also +refers to `x` but it must traverse to its case's *parent* stack frame to find `x`. + +However, in /case continuation/ BCOs, the code may additionally refer to free +variables that are outside of that BCO's stack frame -- some free variables of a +case continuation BCO may only be found in the stack frame of a parent BCO. + +Yet, references to these out-of-frame variables are also done in terms of stack +offsets. Thus, they rely on the position of /another frame/ to be fixed. (See +Note [PUSH_L underflow] for more information about references to previous +frames and nested BCOs) + +This makes case continuation BCOs special: unlike normal BCOs, case cont BCO +frames cannot be moved on the stack independently from their parent BCOs. +-} + data UnlinkedBCO = UnlinkedBCO { unlinkedBCOName :: !Name, @@ -185,8 +264,8 @@ = BCOPtrName !Name | BCOPtrPrimOp !PrimOp | BCOPtrBCO !UnlinkedBCO - | BCOPtrBreakArray (ForeignRef BreakArray) - -- ^ a pointer to a breakpoint's module's BreakArray in GHCi's memory + | BCOPtrBreakArray !Module + -- ^ Converted to the actual 'BreakArray' remote pointer at link-time instance NFData BCOPtr where rnf (BCOPtrBCO bco) = rnf bco @@ -199,100 +278,22 @@ -- | A reference to a top-level string literal; see -- Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode. | BCONPtrAddr !Name - -- | Only used internally in the assembler in an intermediate representation; - -- should never appear in a fully-assembled UnlinkedBCO. + -- | A top-level string literal. -- Also see Note [Allocating string literals] in GHC.ByteCode.Asm. | BCONPtrStr !ByteString + -- | Same as 'BCONPtrStr' but with benefits of 'FastString' interning logic. + | BCONPtrFS !FastString + -- | A libffi ffi_cif function prototype. + | BCONPtrFFIInfo !FFIInfo + -- | A 'CostCentre' remote pointer array's respective 'BreakpointId' + | BCONPtrCostCentre !InternalBreakpointId instance NFData BCONPtr where rnf x = x `seq` () --- | Information about a breakpoint that we know at code-generation time --- In order to be used, this needs to be hydrated relative to the current HscEnv by --- 'hydrateCgBreakInfo'. Everything here can be fully forced and that's critical for --- preventing space leaks (see #22530) -data CgBreakInfo - = CgBreakInfo - { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint - , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] - , cgb_resty :: !IfaceType - } --- See Note [Syncing breakpoint info] in GHC.Runtime.Eval - -seqCgBreakInfo :: CgBreakInfo -> () -seqCgBreakInfo CgBreakInfo{..} = - rnf cgb_tyvars `seq` - rnf cgb_vars `seq` - rnf cgb_resty - instance Outputable UnlinkedBCO where ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs) = sep [text "BCO", ppr nm, text "with", ppr (sizeFlatBag lits), text "lits", ppr (sizeFlatBag ptrs), text "ptrs" ] -instance Outputable CgBreakInfo where - ppr info = text "CgBreakInfo" <+> - parens (ppr (cgb_vars info) <+> - ppr (cgb_resty info)) - --- ----------------------------------------------------------------------------- --- Breakpoints - --- | Breakpoint index -type BreakIndex = Int - --- | C CostCentre type -data CCostCentre - --- | All the information about the breakpoints for a module -data ModBreaks - = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakIndex SrcSpan) - -- ^ An array giving the source span of each breakpoint. - , modBreaks_vars :: !(Array BreakIndex [OccName]) - -- ^ An array giving the names of the free variables at each breakpoint. - , modBreaks_decls :: !(Array BreakIndex [String]) - -- ^ An array giving the names of the declarations enclosing each breakpoint. - -- See Note [Field modBreaks_decls] - , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre)) - -- ^ Array pointing to cost centre for each breakpoint - , modBreaks_breakInfo :: IntMap CgBreakInfo - -- ^ info about each breakpoint from the bytecode generator - , modBreaks_module :: RemotePtr ModuleName - } - -seqModBreaks :: ModBreaks -> () -seqModBreaks ModBreaks{..} = - rnf modBreaks_flags `seq` - rnf modBreaks_locs `seq` - rnf modBreaks_vars `seq` - rnf modBreaks_decls `seq` - rnf modBreaks_ccs `seq` - rnf (fmap seqCgBreakInfo modBreaks_breakInfo) `seq` - rnf modBreaks_module - --- | Construct an empty ModBreaks -emptyModBreaks :: ModBreaks -emptyModBreaks = ModBreaks - { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised" - -- ToDo: can we avoid this? - , modBreaks_locs = array (0,-1) [] - , modBreaks_vars = array (0,-1) [] - , modBreaks_decls = array (0,-1) [] - , modBreaks_ccs = array (0,-1) [] - , modBreaks_breakInfo = IntMap.empty - , modBreaks_module = toRemotePtr nullPtr - } - -{- -Note [Field modBreaks_decls] -~~~~~~~~~~~~~~~~~~~~~~ -A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: -The breakpoint is in the function called "baz" that is declared in a `let` -or `where` clause of a declaration called "bar", which itself is declared -in a `let` or `where` clause of the top-level function called "foo". --} diff --git a/GHC/Cmm.hs b/GHC/Cmm.hs --- a/GHC/Cmm.hs +++ b/GHC/Cmm.hs @@ -288,8 +288,8 @@ deriving (Eq) -- | Should a data in this section be considered constant at runtime -sectionProtection :: SectionType -> SectionProtection -sectionProtection t = case t of +sectionProtection :: Section -> SectionProtection +sectionProtection (Section t _) = case t of Text -> ReadOnlySection ReadOnlyData -> ReadOnlySection RelocatableReadOnlyData -> WriteProtectedSection diff --git a/GHC/Cmm/CLabel.hs b/GHC/Cmm/CLabel.hs --- a/GHC/Cmm/CLabel.hs +++ b/GHC/Cmm/CLabel.hs @@ -1729,6 +1729,9 @@ | platformArch platform == ArchRISCV64 = ppLbl + | platformArch platform == ArchLoongArch64 + = ppLbl + | platformArch platform == ArchX86_64 = case dllInfo of CodeStub -> ppLbl <> text "@plt" diff --git a/GHC/Cmm/CallConv.hs b/GHC/Cmm/CallConv.hs --- a/GHC/Cmm/CallConv.hs +++ b/GHC/Cmm/CallConv.hs diff --git a/GHC/Cmm/Dataflow/Label.hs b/GHC/Cmm/Dataflow/Label.hs --- a/GHC/Cmm/Dataflow/Label.hs +++ b/GHC/Cmm/Dataflow/Label.hs @@ -63,10 +63,12 @@ , mapToList , mapFromList , mapFromListWith + , mapMapMaybe ) where import GHC.Prelude +import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Types.Unique (Uniquable(..), mkUniqueGrimily) @@ -82,7 +84,6 @@ import GHC.Data.TrieMap import Data.Word (Word64) -import Data.List (foldl1') ----------------------------------------------------------------------------- @@ -139,8 +140,7 @@ {-# INLINE setUnions #-} setUnions :: [LabelSet] -> LabelSet -setUnions [] = setEmpty -setUnions sets = foldl1' setUnion sets +setUnions = foldl1WithDefault' setEmpty setUnion setDifference :: LabelSet -> LabelSet -> LabelSet setDifference (LS x) (LS y) = LS (S.difference x y) @@ -219,8 +219,7 @@ {-# INLINE mapUnions #-} mapUnions :: [LabelMap a] -> LabelMap a -mapUnions [] = mapEmpty -mapUnions maps = foldl1' mapUnion maps +mapUnions = foldl1WithDefault' mapEmpty mapUnion mapUnionWithKey :: (Label -> v -> v -> v) -> LabelMap v -> LabelMap v -> LabelMap v mapUnionWithKey f (LM x) (LM y) = LM (M.unionWithKey (f . mkHooplLabel) x y) @@ -282,6 +281,9 @@ mapFromListWith :: (v -> v -> v) -> [(Label, v)] -> LabelMap v mapFromListWith f assocs = LM (M.fromListWith f [(lblToUnique k, v) | (k, v) <- assocs]) +mapMapMaybe :: (a -> Maybe b) -> LabelMap a -> LabelMap b +mapMapMaybe f (LM m) = LM (M.mapMaybe f m) + ----------------------------------------------------------------------------- -- Instances @@ -300,7 +302,8 @@ lookupTM k m = mapLookup k m alterTM k f m = mapAlter f k m foldTM k m z = mapFoldr k z m - filterTM f m = mapFilter f m + filterTM f = mapFilter f + mapMaybeTM f = mapMapMaybe f ----------------------------------------------------------------------------- -- FactBase diff --git a/GHC/Cmm/DebugBlock.hs b/GHC/Cmm/DebugBlock.hs --- a/GHC/Cmm/DebugBlock.hs +++ b/GHC/Cmm/DebugBlock.hs @@ -6,9 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE LambdaCase #-} - - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE EmptyCase #-} ----------------------------------------------------------------------------- -- @@ -41,22 +39,27 @@ import GHC.Cmm import GHC.Cmm.Reg ( pprGlobalReg, pprGlobalRegUse ) import GHC.Cmm.Utils -import GHC.Data.FastString ( nilFS, mkFastString ) +import GHC.Data.FastString ( LexicalFastString, nilFS, mkFastString ) import GHC.Unit.Module import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SrcLoc import GHC.Types.Tickish -import GHC.Utils.Misc ( partitionWith, seqList ) +import GHC.Utils.Misc ( seqList ) import GHC.Cmm.Dataflow.Block import GHC.Cmm.Dataflow.Graph import GHC.Cmm.Dataflow.Label import Data.Maybe -import Data.List ( minimumBy, nubBy ) +import Data.List ( nubBy ) +import Data.List.NonEmpty ( NonEmpty (..), nonEmpty ) +import qualified Data.List.NonEmpty as NE import Data.Ord ( comparing ) import qualified Data.Map as Map +import Data.Foldable ( toList ) +import Data.Either ( partitionEithers ) +import Data.Void -- | Debug information about a block of code. Ticks scope over nested -- blocks. @@ -94,23 +97,32 @@ -- | Intermediate data structure holding debug-relevant context information -- about a block. -type BlockContext = (CmmBlock, RawCmmDecl) +type BlockContext = (CmmBlock, RawCmmDeclNoStatics) +-- Same as `RawCmmDecl`, but statically (in GHC) excludes the possibility of statics (in the CMM +-- code). (The first argument is `Void` rather than `RawCmmStatics`. +type RawCmmDeclNoStatics + = GenCmmDecl + Void + (LabelMap RawCmmStatics) + CmmGraph + -- | Extract debug data from a group of procedures. We will prefer -- source notes that come from the given module (presumably the module -- that we are currently compiling). -cmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock] +cmmDebugGen :: ModLocation -> [RawCmmDecl] -> [DebugBlock] cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes where - blockCtxs :: Map.Map CmmTickScope [BlockContext] + blockCtxs :: Map.Map CmmTickScope (NonEmpty BlockContext) blockCtxs = blockContexts decls -- Analyse tick scope structure: Each one is either a top-level -- tick scope, or the child of another. (topScopes, childScopes) - = partitionWith (\a -> findP a a) $ Map.keys blockCtxs + = partitionEithers $ map (\(k, a) -> findP (k, a) k) $ Map.toList blockCtxs + findP tsc GlobalScope = Left tsc -- top scope - findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc) + findP tsc scp | Just x <- Map.lookup scp' blockCtxs = Right (scp', tsc, x) | otherwise = findP tsc scp' where -- Note that we only following the left parent of -- combined scopes. This loses us ticks, which we will @@ -118,7 +130,7 @@ scp' | SubScope _ scp' <- scp = scp' | CombinedScope scp' _ <- scp = scp' - scopeMap = foldl' (\acc (key, scope) -> insertMulti key scope acc) Map.empty childScopes + scopeMap = foldl' (\ acc (k, (k', a'), _) -> insertMulti k (k', a') acc) Map.empty childScopes -- This allows us to recover ticks that we lost by flattening -- the graph. Basically, if the parent is A but the child is @@ -137,7 +149,7 @@ | SubScope _ s' <- s = ticks ++ go s' | CombinedScope s1 s2 <- s = ticks ++ go s1 ++ go s2 | otherwise = panic "ticksToCopy impossible" - where ticks = bCtxsTicks $ fromMaybe [] $ Map.lookup s blockCtxs + where ticks = bCtxsTicks $ maybe [] toList $ Map.lookup s blockCtxs ticksToCopy _ = [] bCtxsTicks = concatMap (blockTicks . fst) @@ -147,21 +159,19 @@ -- (if we generated one, we probably want debug information to -- refer to it). bestSrcTick = minimumBy (comparing rangeRating) - rangeRating (SourceNote span _) + rangeRating (span, _) | srcSpanFile span == thisFile = 1 | otherwise = 2 :: Int - rangeRating note = pprPanic "rangeRating" (ppr note) thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc -- Returns block tree for this scope as well as all nested -- scopes. Note that if there are multiple blocks in the (exact) -- same scope we elect one as the "branch" node and add the rest -- as children. - blocksForScope :: Maybe CmmTickish -> CmmTickScope -> DebugBlock - blocksForScope cstick scope = mkBlock True (head bctxs) - where bctxs = fromJust $ Map.lookup scope blockCtxs - nested = fromMaybe [] $ Map.lookup scope scopeMap - childs = map (mkBlock False) (tail bctxs) ++ + blocksForScope :: Maybe (RealSrcSpan, LexicalFastString) -> (CmmTickScope, NonEmpty BlockContext) -> DebugBlock + blocksForScope cstick (scope, bctx:|bctxs) = mkBlock True bctx + where nested = fromMaybe [] $ Map.lookup scope scopeMap + childs = map (mkBlock False) bctxs ++ map (blocksForScope stick) nested mkBlock :: Bool -> BlockContext -> DebugBlock @@ -173,11 +183,13 @@ , dblParent = Nothing , dblTicks = ticks , dblPosition = Nothing -- see cmmDebugLink - , dblSourceTick = stick + , dblSourceTick = uncurry SourceNote <$> stick , dblBlocks = blocks , dblUnwind = [] } - where (CmmProc infos _entryLbl _ graph) = prc + where (infos, graph) = case prc of + CmmProc infos _ _ graph -> (infos, graph) + CmmData _ v -> case v of label = entryLabel block info = mapLookup label infos blocks | top = seqList childs childs @@ -185,26 +197,26 @@ -- A source tick scopes over all nested blocks. However -- their source ticks might take priority. - isSourceTick SourceNote {} = True - isSourceTick _ = False + isSourceTick (SourceNote span a) = Just (span, a) + isSourceTick _ = Nothing -- Collect ticks from all blocks inside the tick scope. -- We attempt to filter out duplicates while we're at it. ticks = nubBy (flip tickishContains) $ bCtxsTicks bctxs ++ ticksToCopy scope - stick = case filter isSourceTick ticks of - [] -> cstick - sticks -> Just $! bestSrcTick (sticks ++ maybeToList cstick) + stick = case nonEmpty $ mapMaybe isSourceTick ticks of + Nothing -> cstick + Just sticks -> Just $! bestSrcTick (sticks `NE.appendList` maybeToList cstick) -- | Build a map of blocks sorted by their tick scopes -- -- This involves a pre-order traversal, as we want blocks in rough -- control flow order (so ticks have a chance to be sorted in the -- right order). -blockContexts :: RawCmmGroup -> Map.Map CmmTickScope [BlockContext] -blockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls - where walkProc :: RawCmmDecl - -> Map.Map CmmTickScope [BlockContext] - -> Map.Map CmmTickScope [BlockContext] +blockContexts :: [GenCmmDecl a (LabelMap RawCmmStatics) CmmGraph] -> Map.Map CmmTickScope (NonEmpty BlockContext) +blockContexts = Map.map NE.reverse . foldr walkProc Map.empty + where walkProc :: GenCmmDecl a (LabelMap RawCmmStatics) CmmGraph + -> Map.Map CmmTickScope (NonEmpty BlockContext) + -> Map.Map CmmTickScope (NonEmpty BlockContext) walkProc CmmData{} m = m walkProc prc@(CmmProc _ _ _ graph) m | mapNull blocks = m @@ -213,26 +225,27 @@ entry = [mapFind (g_entry graph) blocks] emptyLbls = setEmpty :: LabelSet - walkBlock :: RawCmmDecl -> [Block CmmNode C C] - -> (LabelSet, Map.Map CmmTickScope [BlockContext]) - -> (LabelSet, Map.Map CmmTickScope [BlockContext]) + walkBlock :: GenCmmDecl a (LabelMap RawCmmStatics) CmmGraph -> [Block CmmNode C C] + -> (LabelSet, Map.Map CmmTickScope (NonEmpty BlockContext)) + -> (LabelSet, Map.Map CmmTickScope (NonEmpty BlockContext)) walkBlock _ [] c = c - walkBlock prc (block:blocks) (visited, m) - | lbl `setMember` visited - = walkBlock prc blocks (visited, m) - | otherwise - = walkBlock prc blocks $ - walkBlock prc succs - (lbl `setInsert` visited, - insertMulti scope (block, prc) m) + walkBlock prc (block:blocks) (visited, m) = case (prc, setMember lbl visited) of + (CmmProc x y z graph, False) -> + let succs = flip mapFind (toBlockMap graph) <$> + successors (lastNode block) in + walkBlock prc blocks $ + walkBlock prc succs + ( lbl `setInsert` visited + , insertMultiNE scope (block, CmmProc x y z graph) m ) + _ -> walkBlock prc blocks (visited, m) where CmmEntry lbl scope = firstNode block - (CmmProc _ _ _ graph) = prc - succs = map (flip mapFind (toBlockMap graph)) - (successors (lastNode block)) mapFind = mapFindWithDefault (error "contextTree: block not found!") insertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a] insertMulti k v = Map.insertWith (const (v:)) k [v] + +insertMultiNE :: Ord k => k -> a -> Map.Map k (NonEmpty a) -> Map.Map k (NonEmpty a) +insertMultiNE k v = Map.insertWith (const (v NE.<|)) k (NE.singleton v) cmmDebugLabels :: (BlockId -> Bool) -> (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label] cmmDebugLabels is_valid_label isMeta nats = seqList lbls lbls diff --git a/GHC/Cmm/InitFini.hs b/GHC/Cmm/InitFini.hs --- a/GHC/Cmm/InitFini.hs +++ b/GHC/Cmm/InitFini.hs @@ -2,7 +2,6 @@ module GHC.Cmm.InitFini ( InitOrFini(..) , isInitOrFiniArray - , isInitOrFiniSection ) where import GHC.Prelude @@ -64,8 +63,8 @@ data InitOrFini = IsInitArray | IsFiniArray isInitOrFiniArray :: RawCmmDecl -> Maybe (InitOrFini, [CLabel]) -isInitOrFiniArray (CmmData (Section t _) (CmmStaticsRaw _ lits)) - | Just initOrFini <- isInitOrFiniSection t +isInitOrFiniArray (CmmData sect (CmmStaticsRaw _ lits)) + | Just initOrFini <- isInitOrFiniSection sect = Just (initOrFini, map get_label lits) where get_label :: CmmStatic -> CLabel @@ -73,7 +72,7 @@ get_label static = pprPanic "isInitOrFiniArray: invalid entry" (ppr static) isInitOrFiniArray _ = Nothing -isInitOrFiniSection :: SectionType -> Maybe InitOrFini -isInitOrFiniSection InitArray = Just IsInitArray -isInitOrFiniSection FiniArray = Just IsFiniArray +isInitOrFiniSection :: Section -> Maybe InitOrFini +isInitOrFiniSection (Section InitArray _) = Just IsInitArray +isInitOrFiniSection (Section FiniArray _) = Just IsFiniArray isInitOrFiniSection _ = Nothing diff --git a/GHC/Cmm/LayoutStack.hs b/GHC/Cmm/LayoutStack.hs --- a/GHC/Cmm/LayoutStack.hs +++ b/GHC/Cmm/LayoutStack.hs @@ -36,6 +36,7 @@ import Control.Monad.Fix import Data.Array as Array import Data.List (nub) +import Data.List.NonEmpty ( NonEmpty (..) ) {- Note [Stack Layout] ~~~~~~~~~~~~~~~~~~~ @@ -346,7 +347,7 @@ this_sp_hwm | isGcJump last0 = 0 | otherwise = sp0 - sp_off - hwm' = maximum (acc_hwm : this_sp_hwm : map sm_sp (mapElems out)) + hwm' = maximum (acc_hwm :| this_sp_hwm : map sm_sp (mapElems out)) go bs acc_stackmaps' hwm' (final_blocks ++ acc_blocks) @@ -373,7 +374,7 @@ collectContInfo :: [CmmBlock] -> (ByteOff, LabelMap ByteOff) collectContInfo blocks - = (maximum ret_offs, mapFromList (catMaybes mb_argss)) + = (maximum (expectNonEmpty ret_offs), mapFromList (catMaybes mb_argss)) where (mb_argss, ret_offs) = mapAndUnzip get_cont blocks diff --git a/GHC/Cmm/Lexer.hs b/GHC/Cmm/Lexer.hs --- a/GHC/Cmm/Lexer.hs +++ b/GHC/Cmm/Lexer.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LINE 13 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Cmm/Lexer.x" #-} +{-# LINE 13 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Cmm/Lexer.x" #-} module GHC.Cmm.Lexer ( CmmToken(..), cmmlex, ) where @@ -831,7 +831,7 @@ -- match when checking the right context, just -- the first match will do. #endif -{-# LINE 144 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Cmm/Lexer.x" #-} +{-# LINE 144 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Cmm/Lexer.x" #-} data CmmToken = CmmT_SpecChar Char | CmmT_DotDot diff --git a/GHC/Cmm/Lint.hs b/GHC/Cmm/Lint.hs --- a/GHC/Cmm/Lint.hs +++ b/GHC/Cmm/Lint.hs @@ -102,9 +102,11 @@ platform <- getPlatform tys <- mapM lintCmmExpr args lintShiftOp op (zip args tys) - if map (typeWidth . cmmExprType platform) args == machOpArgReps platform op - then cmmCheckMachOp op args tys - else cmmLintMachOpErr expr (map (cmmExprType platform) args) (machOpArgReps platform op) + let machop_arg_widths = machOpArgReps platform op + arg_tys = map (cmmExprType platform) args + if map typeWidth arg_tys == machop_arg_widths + then cmmCheckMachOp op args tys + else cmmLintMachOpErr expr arg_tys machop_arg_widths lintCmmExpr (CmmRegOff reg offset) = do let rep = typeWidth (cmmRegType reg) lintCmmExpr (CmmMachOp (MO_Add rep) @@ -180,14 +182,13 @@ return () CmmUnsafeForeignCall target _formals actuals -> do - lintTarget target let lintArg expr = do -- Arguments can't mention caller-saved -- registers. See Note [Register parameter passing]. mayNotMentionCallerSavedRegs (text "foreign call argument") expr lintCmmExpr expr - - mapM_ lintArg actuals + arg_tys <- mapM lintArg actuals + lintTarget arg_tys target lintCmmLast :: LabelSet -> CmmNode O C -> CmmLint () @@ -213,7 +214,6 @@ maybe (return ()) checkTarget cont CmmForeignCall tgt _ args succ _ _ _ -> do - lintTarget tgt let lintArg expr = do -- Arguments can't mention caller-saved -- registers. See Note [Register @@ -223,19 +223,24 @@ -- places in caller-saved registers. mayNotMentionCallerSavedRegs (text "foreign call argument") expr lintCmmExpr expr - mapM_ lintArg args + arg_tys <- mapM lintArg args + lintTarget arg_tys tgt checkTarget succ where checkTarget id | setMember id labels = return () | otherwise = cmmLintErr (text "Branch to nonexistent id" <+> ppr id) -lintTarget :: ForeignTarget -> CmmLint () -lintTarget (ForeignTarget e _) = do +lintTarget :: [CmmType] -> ForeignTarget -> CmmLint () +lintTarget _arg_tys (ForeignTarget e _) = do mayNotMentionCallerSavedRegs (text "foreign target") e _ <- lintCmmExpr e return () -lintTarget (PrimTarget {}) = return () +lintTarget arg_tys (PrimTarget mop) = do + platform <- getPlatform + let machop_arg_tys = callishMachOpArgTys platform mop + unless (and $ zipWith cmmCompatType arg_tys machop_arg_tys) $ + cmmLintCallishMachOpErr mop arg_tys machop_arg_tys -- | As noted in Note [Register parameter passing], the arguments and -- 'ForeignTarget' of a foreign call mustn't mention @@ -285,6 +290,13 @@ nest 2 (pdoc platform expr) $$ (text "op is expecting: " <+> ppr opExpectsRep) $$ (text "arguments provide: " <+> ppr argsRep)) + +cmmLintCallishMachOpErr :: CallishMachOp -> [CmmType] -> [CmmType] -> CmmLint a +cmmLintCallishMachOpErr mop argTys mopTys + = cmmLintErr (text "in Callish MachOp application: " $$ + nest 2 (text $ show mop) $$ + (text "op is expecting: " <+> ppr mopTys) $$ + (text "arguments provide: " <+> ppr argTys)) cmmLintAssignErr :: CmmNode e x -> CmmType -> CmmType -> CmmLint a cmmLintAssignErr stmt e_ty r_ty diff --git a/GHC/Cmm/Liveness.hs b/GHC/Cmm/Liveness.hs --- a/GHC/Cmm/Liveness.hs +++ b/GHC/Cmm/Liveness.hs @@ -57,7 +57,7 @@ where entry = g_entry graph check facts = - noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts + noLiveOnEntry entry (expectJust $ mapLookup entry facts) facts cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalRegUse cmmGlobalLiveness platform graph = @@ -120,7 +120,7 @@ where entry = g_entry graph check facts = - noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts + noLiveOnEntryL entry (expectJust $ mapLookup entry facts) facts -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntryL :: BlockId -> LRegSet -> a -> a @@ -154,5 +154,4 @@ let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase !result = foldNodesBwdOO (gen_killL platform) middle joined in mapSingleton (entryLabel eNode) result - diff --git a/GHC/Cmm/MachOp.hs b/GHC/Cmm/MachOp.hs --- a/GHC/Cmm/MachOp.hs +++ b/GHC/Cmm/MachOp.hs @@ -1,7 +1,5 @@ {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module GHC.Cmm.MachOp ( MachOp(..) , pprMachOp, isCommutableMachOp, isAssociativeMachOp @@ -24,6 +22,7 @@ , CallishMachOp(..), callishMachOpHints , pprCallishMachOp , machOpMemcpyishAlign + , callishMachOpArgTys -- Atomic read-modify-write , MemoryOrdering(..) @@ -39,7 +38,10 @@ import GHC.Platform import GHC.Cmm.Type import GHC.Utils.Outputable +import GHC.Utils.Misc (expectNonEmpty) +import Data.List.NonEmpty (NonEmpty (..)) + ----------------------------------------------------------------------------- -- MachOp ----------------------------------------------------------------------------- @@ -168,16 +170,8 @@ | MO_V_Add Length Width | MO_V_Sub Length Width | MO_V_Mul Length Width - - -- Signed vector multiply/divide - | MO_VS_Quot Length Width - | MO_VS_Rem Length Width | MO_VS_Neg Length Width - -- Unsigned vector multiply/divide - | MO_VU_Quot Length Width - | MO_VU_Rem Length Width - -- Vector shuffles | MO_V_Shuffle Length Width [Int] | MO_VF_Shuffle Length Width [Int] @@ -513,14 +507,10 @@ MO_V_Sub l w -> cmmVec l (cmmBits w) MO_V_Mul l w -> cmmVec l (cmmBits w) - MO_VS_Quot l w -> cmmVec l (cmmBits w) - MO_VS_Rem l w -> cmmVec l (cmmBits w) MO_VS_Neg l w -> cmmVec l (cmmBits w) MO_VS_Min l w -> cmmVec l (cmmBits w) MO_VS_Max l w -> cmmVec l (cmmBits w) - MO_VU_Quot l w -> cmmVec l (cmmBits w) - MO_VU_Rem l w -> cmmVec l (cmmBits w) MO_VU_Min l w -> cmmVec l (cmmBits w) MO_VU_Max l w -> cmmVec l (cmmBits w) @@ -542,7 +532,7 @@ MO_RelaxedRead w -> cmmBits w MO_AlignmentCheck _ _ -> ty1 where - (ty1:_) = tys + ty1:|_ = expectNonEmpty tys comparisonResultRep :: Platform -> CmmType comparisonResultRep = bWord -- is it? @@ -630,14 +620,10 @@ MO_V_Sub l w -> [vecwidth l w, vecwidth l w] MO_V_Mul l w -> [vecwidth l w, vecwidth l w] - MO_VS_Quot l w -> [vecwidth l w, vecwidth l w] - MO_VS_Rem l w -> [vecwidth l w, vecwidth l w] MO_VS_Neg l w -> [vecwidth l w] MO_VS_Min l w -> [vecwidth l w, vecwidth l w] MO_VS_Max l w -> [vecwidth l w, vecwidth l w] - MO_VU_Quot l w -> [vecwidth l w, vecwidth l w] - MO_VU_Rem l w -> [vecwidth l w, vecwidth l w] MO_VU_Min l w -> [vecwidth l w, vecwidth l w] MO_VU_Max l w -> [vecwidth l w, vecwidth l w] @@ -751,6 +737,20 @@ | MO_SubIntC Width | MO_U_Mul2 Width + -- Signed vector divide + | MO_VS_Quot Length Width + | MO_VS_Rem Length Width + + -- Unsigned vector divide + | MO_VU_Quot Length Width + | MO_VU_Rem Length Width + + -- Int64X2/Word64X2 min/max + | MO_I64X2_Min + | MO_I64X2_Max + | MO_W64X2_Min + | MO_W64X2_Max + | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch @@ -845,3 +845,144 @@ MO_Memmove align -> Just align MO_Memcmp align -> Just align _ -> Nothing + +-- | Like 'machOpArgReps', but for 'CallishMachOp'. +-- +-- Used only in Cmm lint. +callishMachOpArgTys :: Platform -> CallishMachOp -> [CmmType] +callishMachOpArgTys platform = \case + MO_F64_Pwr -> [f64, f64] + MO_F64_Sin -> [f64] + MO_F64_Cos -> [f64] + MO_F64_Tan -> [f64] + MO_F64_Sinh -> [f64] + MO_F64_Cosh -> [f64] + MO_F64_Tanh -> [f64] + MO_F64_Asin -> [f64] + MO_F64_Acos -> [f64] + MO_F64_Atan -> [f64] + MO_F64_Asinh -> [f64] + MO_F64_Acosh -> [f64] + MO_F64_Atanh -> [f64] + MO_F64_Log -> [f64] + MO_F64_Log1P -> [f64] + MO_F64_Exp -> [f64] + MO_F64_ExpM1 -> [f64] + MO_F64_Fabs -> [f64] + MO_F64_Sqrt -> [f64] + MO_F32_Pwr -> [f32, f32] + MO_F32_Sin -> [f32] + MO_F32_Cos -> [f32] + MO_F32_Tan -> [f32] + MO_F32_Sinh -> [f32] + MO_F32_Cosh -> [f32] + MO_F32_Tanh -> [f32] + MO_F32_Asin -> [f32] + MO_F32_Acos -> [f32] + MO_F32_Atan -> [f32] + MO_F32_Asinh -> [f32] + MO_F32_Acosh -> [f32] + MO_F32_Atanh -> [f32] + MO_F32_Log -> [f32] + MO_F32_Log1P -> [f32] + MO_F32_Exp -> [f32] + MO_F32_ExpM1 -> [f32] + MO_F32_Fabs -> [f32] + MO_F32_Sqrt -> [f32] + MO_I64_ToI -> [b64] + MO_I64_FromI -> [bWord platform] + MO_W64_ToW -> [b64] + MO_W64_FromW -> [bWord platform] + MO_x64_Neg -> [b64] + MO_x64_Add -> [b64] + MO_x64_Sub -> [b64] + MO_x64_Mul -> [b64] + MO_I64_Quot -> [b64,b64] + MO_I64_Rem -> [b64,b64] + MO_W64_Quot -> [b64,b64] + MO_W64_Rem -> [b64,b64] + MO_x64_And -> [b64,b64] + MO_x64_Or -> [b64,b64] + MO_x64_Xor -> [b64,b64] + MO_x64_Not -> [b64] + MO_x64_Shl -> [b64,b64] + MO_I64_Shr -> [b64,b64] + MO_W64_Shr -> [b64,b64] + MO_x64_Eq -> [b64,b64] + MO_x64_Ne -> [b64,b64] + MO_I64_Ge -> [b64,b64] + MO_I64_Gt -> [b64,b64] + MO_I64_Le -> [b64,b64] + MO_I64_Lt -> [b64,b64] + MO_W64_Ge -> [b64,b64] + MO_W64_Gt -> [b64,b64] + MO_W64_Le -> [b64,b64] + MO_W64_Lt -> [b64,b64] + MO_UF_Conv _w -> [bWord platform] -- Word to Float/Double + MO_S_Mul2 w -> [cmmBits w, cmmBits w] + MO_S_QuotRem w -> [cmmBits w, cmmBits w] + MO_U_QuotRem w -> [cmmBits w, cmmBits w] + MO_U_QuotRem2 w -> [cmmBits w, cmmBits w] + MO_Add2 w -> [cmmBits w, cmmBits w] + MO_AddWordC w -> [cmmBits w, cmmBits w] + MO_SubWordC w -> [cmmBits w, cmmBits w] + MO_AddIntC w -> [cmmBits w, cmmBits w] + MO_SubIntC w -> [cmmBits w, cmmBits w] + MO_U_Mul2 w -> [cmmBits w, cmmBits w] + MO_VS_Quot l w -> [cmmVec l (cmmBits w), cmmVec l (cmmBits w)] + MO_VS_Rem l w -> [cmmVec l (cmmBits w), cmmVec l (cmmBits w)] + MO_VU_Quot l w -> [cmmVec l (cmmBits w), cmmVec l (cmmBits w)] + MO_VU_Rem l w -> [cmmVec l (cmmBits w), cmmVec l (cmmBits w)] + MO_I64X2_Min -> [cmmVec 2 (cmmBits W64), cmmVec 2 (cmmBits W64)] + MO_I64X2_Max -> [cmmVec 2 (cmmBits W64), cmmVec 2 (cmmBits W64)] + MO_W64X2_Min -> [cmmVec 2 (cmmBits W64), cmmVec 2 (cmmBits W64)] + MO_W64X2_Max -> [cmmVec 2 (cmmBits W64), cmmVec 2 (cmmBits W64)] + MO_Touch -> [gcWord platform] + MO_Prefetch_Data _n -> [addr] + MO_Memcpy _align -> [addr, addr, bWord platform] + MO_Memset _align -> + [ addr + , bWord platform -- byte to set: supplied as an int, converted to a byte + , bWord platform] + MO_Memmove _align -> [addr, addr, bWord platform] + MO_Memcmp _align -> [addr, addr, bWord platform] + MO_PopCnt w -> + case w of + W64 -> [cmmBits W64] + _ -> [bWord platform] + MO_Pdep w -> + case w of + W64 -> [cmmBits W64, cmmBits W64] + _ -> [bWord platform, bWord platform] + MO_Pext w -> + case w of + W64 -> [cmmBits W64, cmmBits W64] + _ -> [bWord platform, bWord platform] + MO_Clz w -> + case w of + W64 -> [cmmBits W64] + _ -> [bWord platform] + MO_Ctz w -> + case w of + W64 -> [cmmBits W64] + _ -> [bWord platform] + MO_BSwap w -> + case w of + W64 -> [cmmBits W64] + _ -> [bWord platform] + MO_BRev w -> + case w of + W64 -> [cmmBits W64] + _ -> [bWord platform] + MO_AcquireFence -> [] + MO_ReleaseFence -> [] + MO_SeqCstFence -> [] + MO_AtomicRMW w _op -> [addr, cmmBits w] + MO_AtomicRead _w _mem_ordering -> [addr] + MO_AtomicWrite w _mem_ordering -> [addr, cmmBits w] + MO_Cmpxchg w -> [addr, cmmBits w, cmmBits w] + MO_Xchg w -> [addr, cmmBits w] + MO_SuspendThread -> [] + MO_ResumeThread -> [] + where + addr = bWord platform diff --git a/GHC/Cmm/Opt.hs b/GHC/Cmm/Opt.hs --- a/GHC/Cmm/Opt.hs +++ b/GHC/Cmm/Opt.hs @@ -174,9 +174,9 @@ MO_S_Lt _ -> Just $! CmmLit (CmmInt (if x_s < y_s then 1 else 0) (wordWidth platform)) MO_S_Le _ -> Just $! CmmLit (CmmInt (if x_s <= y_s then 1 else 0) (wordWidth platform)) - MO_Add r -> Just $! CmmLit (CmmInt (x + y) r) - MO_Sub r -> Just $! CmmLit (CmmInt (x - y) r) - MO_Mul r -> Just $! CmmLit (CmmInt (x * y) r) + MO_Add r -> Just $! CmmLit (CmmInt (narrowU r $ x + y) r) + MO_Sub r -> Just $! CmmLit (CmmInt (narrowS r $ x - y) r) + MO_Mul r -> Just $! CmmLit (CmmInt (narrowU r $ x * y) r) MO_U_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `quot` y_u) r) MO_U_Rem r | y /= 0 -> Just $! CmmLit (CmmInt (x_u `rem` y_u) r) MO_S_Quot r | y /= 0 -> Just $! CmmLit (CmmInt (x_s `quot` y_s) r) @@ -186,7 +186,7 @@ MO_Or r -> Just $! CmmLit (CmmInt (x .|. y) r) MO_Xor r -> Just $! CmmLit (CmmInt (x `xor` y) r) - MO_Shl r -> Just $! CmmLit (CmmInt (x `shiftL` fromIntegral y) r) + MO_Shl r -> Just $! CmmLit (CmmInt (narrowU r $ x `shiftL` fromIntegral y) r) MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r) MO_S_Shr r -> Just $! CmmLit (CmmInt (x_s `shiftR` fromIntegral y) r) diff --git a/GHC/Cmm/ProcPoint.hs b/GHC/Cmm/ProcPoint.hs --- a/GHC/Cmm/ProcPoint.hs +++ b/GHC/Cmm/ProcPoint.hs @@ -263,7 +263,7 @@ let liveness = cmmGlobalLiveness platform g let ppLiveness pp = filter (isArgReg . globalRegUse_reg) $ regSetToList $ - expectJust "ppLiveness" $ mapLookup pp liveness + expectJust $ mapLookup pp liveness graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g -- Build a map from proc point BlockId to pairs of: @@ -325,7 +325,7 @@ (jumpEnv, jumpBlocks) <- foldM add_jump_block (mapEmpty, []) needed_jumps -- update the entry block - let b = expectJust "block in env" $ mapLookup ppId blockEnv + let b = expectJust $ mapLookup ppId blockEnv blockEnv' = mapInsert ppId b blockEnv -- replace branches to procpoints with branches to jumps blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv' @@ -343,7 +343,7 @@ stack_info = stack_info}) top_l live g' | otherwise - = case expectJust "pp label" $ mapLookup bid procLabels of + = case expectJust $ mapLookup bid procLabels of (lbl, Just info_lbl) -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl) , stack_info=stack_info}) @@ -377,8 +377,8 @@ foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int) (revPostorder g) let sort_fn (bid, _) (bid', _) = - compare (expectJust "block_order" $ mapLookup bid block_order) - (expectJust "block_order" $ mapLookup bid' block_order) + compare (expectJust $ mapLookup bid block_order) + (expectJust $ mapLookup bid' block_order) return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv diff --git a/GHC/Cmm/Sink.hs b/GHC/Cmm/Sink.hs --- a/GHC/Cmm/Sink.hs +++ b/GHC/Cmm/Sink.hs @@ -26,74 +26,76 @@ import GHC.Exts (inline) --------------------------------------------------------------------------------- -{- Note [Sinking and inlining] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Sinking is an optimisation pass that - (a) moves assignments closer to their uses, to reduce register pressure - (b) pushes assignments into a single branch of a conditional if possible - (c) inlines assignments to registers that are mentioned only once - (d) discards dead assignments - -This tightens up lots of register-heavy code. It is particularly -helpful in the Cmm generated by the Stg->Cmm code generator, in -which every function starts with a copyIn sequence like: - - x1 = R1 - x2 = Sp[8] - x3 = Sp[16] - if (Sp - 32 < SpLim) then L1 else L2 - -we really want to push the x1..x3 assignments into the L2 branch. - -Algorithm: - - * Start by doing liveness analysis. - - * Keep a list of assignments A; earlier ones may refer to later ones. - Currently we only sink assignments to local registers, because we don't - have liveness information about global registers. - - * Walk forwards through the graph, look at each node N: - - * If it is a dead assignment, i.e. assignment to a register that is - not used after N, discard it. - - * Try to inline based on current list of assignments - * If any assignments in A (1) occur only once in N, and (2) are - not live after N, inline the assignment and remove it - from A. - - * If an assignment in A is cheap (RHS is local register), then - inline the assignment and keep it in A in case it is used afterwards. - - * Otherwise don't inline. - - * If N is an assignment to a local register, pick up the assignment - and add it to A. - - * If N is not an assignment to a local register: - * remove any assignments from A that conflict with N, and - place them before N in the current block. We call this - "dropping" the assignments. - (See Note [When does an assignment conflict?] for what it means for - A to conflict with N.) - - * do this recursively, dropping dependent assignments - - * At an exit node: - * drop any assignments that are live on more than one successor - and are not trivial - * if any successor has more than one predecessor (a join-point), - drop everything live in that successor. Since we only propagate - assignments that are not dead at the successor, we will therefore - eliminate all assignments dead at this point. Thus analysis of a - join-point will always begin with an empty list of assignments. +-- ----------------------------------------------------------------------------- +-- Sinking and inlining -As a result of above algorithm, sinking deletes some dead assignments -(transitively, even). This isn't as good as removeDeadAssignments, -but it's much cheaper. --} +-- This is an optimisation pass that +-- (a) moves assignments closer to their uses, to reduce register pressure +-- (b) pushes assignments into a single branch of a conditional if possible +-- (c) inlines assignments to registers that are mentioned only once +-- (d) discards dead assignments +-- +-- This tightens up lots of register-heavy code. It is particularly +-- helpful in the Cmm generated by the Stg->Cmm code generator, in +-- which every function starts with a copyIn sequence like: +-- +-- x1 = R1 +-- x2 = Sp[8] +-- x3 = Sp[16] +-- if (Sp - 32 < SpLim) then L1 else L2 +-- +-- we really want to push the x1..x3 assignments into the L2 branch. +-- +-- Algorithm: +-- +-- * Start by doing liveness analysis. +-- +-- * Keep a list of assignments A; earlier ones may refer to later ones. +-- Currently we only sink assignments to local registers, because we don't +-- have liveness information about global registers. +-- +-- * Walk forwards through the graph, look at each node N: +-- +-- * If it is a dead assignment, i.e. assignment to a register that is +-- not used after N, discard it. +-- +-- * Try to inline based on current list of assignments +-- * If any assignments in A (1) occur only once in N, and (2) are +-- not live after N, inline the assignment and remove it +-- from A. +-- +-- * If an assignment in A is cheap (RHS is local register), then +-- inline the assignment and keep it in A in case it is used afterwards. +-- +-- * Otherwise don't inline. +-- +-- * If N is assignment to a local register pick up the assignment +-- and add it to A. +-- +-- * If N is not an assignment to a local register: +-- * remove any assignments from A that conflict with N, and +-- place them before N in the current block. We call this +-- "dropping" the assignments. +-- +-- * An assignment conflicts with N if it: +-- - assigns to a register mentioned in N +-- - mentions a register assigned by N +-- - reads from memory written by N +-- * do this recursively, dropping dependent assignments +-- +-- * At an exit node: +-- * drop any assignments that are live on more than one successor +-- and are not trivial +-- * if any successor has more than one predecessor (a join-point), +-- drop everything live in that successor. Since we only propagate +-- assignments that are not dead at the successor, we will therefore +-- eliminate all assignments dead at this point. Thus analysis of a +-- join-point will always begin with an empty list of assignments. +-- +-- +-- As a result of above algorithm, sinking deletes some dead assignments +-- (transitively, even). This isn't as good as removeDeadAssignments, +-- but it's much cheaper. -- ----------------------------------------------------------------------------- -- things that we aren't optimising very well yet. @@ -646,171 +648,110 @@ -- ----------------------------------------------------------------------------- -{- Note [When does an assignment conflict?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -An assignment 'A' conflicts with a statement 'N' if any of the following -conditions are satisfied: - - (C1) 'A' assigns to a register mentioned in 'N' - (C2) 'A' mentions a register assigned by 'N' - (C3) 'A' reads from memory written by 'N' - -In such a situation, it is not safe to commute 'A' past 'N'. For example, -it is not safe to commute - - A: r = 1 - N: s = r - -because 'r' may be undefined or hold a different value before 'A'. - -Remarks: - - (C3) includes all foreign calls, as they may modify the heap/stack. - - (C1) includes the following two situations: - - (C1a) 'N' defines the LHS register in the assignment 'A', for example: - - A: r = - N: r = - - (C1b) 'N' defines a register used in the RHS of 'A', for example: - - A: r = s - N: s = - - (C1c) 'suspendThread' clobbers every global register not backed by a - real register, as noted in #19237. - -Forgetting (C1a) led to bug #26550, in which we incorrectly commuted - - A: _c1rB::Fx2V128 = <0.0 :: W64, 0.0 :: W64> - N: _c1rB::Fx2V128 = %MO_VF_Insert_2_W64(<0.0 :: W64,0.0 :: W64>,%MO_F_Add_W64(F64[R1 + 7], 3.0 :: W64),0 :: W32) - --} - -- | @conflicts (r,e) node@ is @False@ if and only if the assignment -- @r = e@ can be safely commuted past statement @node@. --- --- See Note [When does an assignment conflict?]. conflicts :: Platform -> Assignment -> CmmNode O x -> Bool -conflicts platform assig@(r, rhs, addr) node +conflicts platform (r, rhs, addr) node - -- (C1) node defines registers that are either the assigned register or - -- are used by the rhs of the assignment. - -- This catches assignments and all three kinds of calls. - -- See Note [Sinking and calls] - | globalRegistersConflict platform rhs node = True - | localRegistersConflict platform assig node = True + -- (1) node defines registers used by rhs of assignment. This catches + -- assignments and all three kinds of calls. See Note [Sinking and calls] + | globalRegistersConflict platform rhs node = True + | localRegistersConflict platform rhs node = True - -- (C2) node uses register defined by assignment + -- (2) node uses register defined by assignment | foldRegsUsed platform (\b r' -> r == r' || b) False node = True - -- (C3) Node writes to memory that is read by the assignment. - - -- (a) a store to an address conflicts with a read of the same memory + -- (3) a store to an address conflicts with a read of the same memory | CmmStore addr' e _ <- node , memConflicts addr (loadAddr platform addr' (cmmExprWidth platform e)) = True - -- (b) an assignment to Hp/Sp conflicts with a heap/stack read respectively - | CmmAssign (CmmGlobal (GlobalRegUse Hp _)) _ <- node - , memConflicts addr HeapMem - = True - | CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node - , memConflicts addr StackMem - = True + -- (4) an assignment to Hp/Sp conflicts with a heap/stack read respectively + | HeapMem <- addr, CmmAssign (CmmGlobal (GlobalRegUse Hp _)) _ <- node = True + | StackMem <- addr, CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node = True + | SpMem{} <- addr, CmmAssign (CmmGlobal (GlobalRegUse Sp _)) _ <- node = True - -- (c) foreign calls clobber heap: see Note [Foreign calls clobber heap] + -- (5) foreign calls clobber heap: see Note [Foreign calls clobber heap] | CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem = True - -- (d) native calls clobber any memory - | CmmCall{} <- node, memConflicts addr AnyMem = True - - -- (C1c) suspendThread clobbers every global register not backed by a real - -- register. (It also clobbers heap and stack, but this is handled by (C3)(c) above.) + -- (6) suspendThread clobbers every global register not backed by a real + -- register. It also clobbers heap and stack but this is handled by (5) | CmmUnsafeForeignCall (PrimTarget MO_SuspendThread) _ _ <- node , foldRegsUsed platform (\b g -> globalRegMaybe platform g == Nothing || b) False rhs = True + -- (7) native calls clobber any memory + | CmmCall{} <- node, memConflicts addr AnyMem = True + + -- (8) otherwise, no conflict | otherwise = False {- Note [Inlining foldRegsDefd] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -foldRegsDefd is, after optimization, *not* a small function so -it's only marked INLINEABLE, but not INLINE. + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + foldRegsDefd is, after optimization, *not* a small function so + it's only marked INLINEABLE, but not INLINE. -However in some specific cases we call it *very* often making it -important to avoid the overhead of allocating the folding function. + However in some specific cases we call it *very* often making it + important to avoid the overhead of allocating the folding function. -So we simply force inlining via the magic inline function. -For T3294 this improves allocation with -O by ~1%. + So we simply force inlining via the magic inline function. + For T3294 this improves allocation with -O by ~1%. + -} --- | Returns @True@ if @node@ defines any global registers that are used in the --- Cmm expression. --- --- See (C1) in Note [When does an assignment conflict?]. +-- Returns True if node defines any global registers that are used in the +-- Cmm expression globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool globalRegistersConflict platform expr node = -- See Note [Inlining foldRegsDefd] inline foldRegsDefd platform (\b r -> b || globalRegUsedIn platform (globalRegUse_reg r) expr) False node - -- NB: no need to worry about (C1a), as the LHS of an assignment is always - -- a local register, never a global register. --- | Given an assignment @local_reg := expr@, return @True@ if @node@ defines any --- local registers mentioned in the assignment. --- --- See (C1) in Note [When does an assignment conflict?]. -localRegistersConflict :: Platform -> Assignment -> CmmNode e x -> Bool -localRegistersConflict platform (r, expr, _) node = +-- Returns True if node defines any local registers that are used in the +-- Cmm expression +localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +localRegistersConflict platform expr node = -- See Note [Inlining foldRegsDefd] - inline foldRegsDefd platform - (\b r' -> - b - || r' == r -- (C1a) - || regUsedIn platform (CmmLocal r') expr -- (C1b) - ) - False node - -{- Note [Sinking and calls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall) -and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after -stack layout (see Note [Sinking after stack layout]) which leads to two -invariants related to calls: - - a) during stack layout phase all safe foreign calls are turned into - unsafe foreign calls (see Note [Lower safe foreign calls]). This - means that we will never encounter CmmForeignCall node when running - sinking after stack layout - - b) stack layout saves all variables live across a call on the stack - just before making a call (remember we are not sinking assignments to - stack): - - L1: - x = R1 - P64[Sp - 16] = L2 - P64[Sp - 8] = x - Sp = Sp - 16 - call f() returns L2 - L2: - - We will attempt to sink { x = R1 } but we will detect conflict with - { P64[Sp - 8] = x } and hence we will drop { x = R1 } without even - checking whether it conflicts with { call f() }. In this way we will - never need to check any assignment conflicts with CmmCall. Remember - that we still need to check for potential memory conflicts. + inline foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) + False node -So the result is that we only need to worry about CmmUnsafeForeignCall nodes -when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]). -This assumption holds only when we do sinking after stack layout. If we run -it before stack layout we need to check for possible conflicts with all three -kinds of calls. Our `conflicts` function does that by using a generic -foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and -UserOfRegs typeclasses. --} +-- Note [Sinking and calls] +-- ~~~~~~~~~~~~~~~~~~~~~~~~ +-- We have three kinds of calls: normal (CmmCall), safe foreign (CmmForeignCall) +-- and unsafe foreign (CmmUnsafeForeignCall). We perform sinking pass after +-- stack layout (see Note [Sinking after stack layout]) which leads to two +-- invariants related to calls: +-- +-- a) during stack layout phase all safe foreign calls are turned into +-- unsafe foreign calls (see Note [Lower safe foreign calls]). This +-- means that we will never encounter CmmForeignCall node when running +-- sinking after stack layout +-- +-- b) stack layout saves all variables live across a call on the stack +-- just before making a call (remember we are not sinking assignments to +-- stack): +-- +-- L1: +-- x = R1 +-- P64[Sp - 16] = L2 +-- P64[Sp - 8] = x +-- Sp = Sp - 16 +-- call f() returns L2 +-- L2: +-- +-- We will attempt to sink { x = R1 } but we will detect conflict with +-- { P64[Sp - 8] = x } and hence we will drop { x = R1 } without even +-- checking whether it conflicts with { call f() }. In this way we will +-- never need to check any assignment conflicts with CmmCall. Remember +-- that we still need to check for potential memory conflicts. +-- +-- So the result is that we only need to worry about CmmUnsafeForeignCall nodes +-- when checking conflicts (see Note [Unsafe foreign calls clobber caller-save registers]). +-- This assumption holds only when we do sinking after stack layout. If we run +-- it before stack layout we need to check for possible conflicts with all three +-- kinds of calls. Our `conflicts` function does that by using a generic +-- foldRegsDefd and foldRegsUsed functions defined in DefinerOfRegs and +-- UserOfRegs typeclasses. +-- -- An abstraction of memory read or written. data AbsMem diff --git a/GHC/Cmm/Type.hs b/GHC/Cmm/Type.hs --- a/GHC/Cmm/Type.hs +++ b/GHC/Cmm/Type.hs @@ -57,12 +57,14 @@ deriving Show data CmmCat -- "Category" (not exported) - = GcPtrCat -- GC pointer - | BitsCat -- Non-pointer - | FloatCat -- Float - | VecCat Length CmmCat -- Vector + = GcPtrCat -- ^ GC pointer + | BitsCat -- ^ Integer (including non-GC pointer addresses) + -- + -- Makes no distinction between signed and unsigned integers, + -- see Note [Signed vs unsigned] in GHC.Cmm.Type. + | FloatCat -- ^ Float + | VecCat Length CmmCat -- ^ Vector deriving( Eq, Show ) - -- See Note [Signed vs unsigned] at the end instance Outputable CmmType where ppr (CmmType cat wid) = ppr cat <> ppr (widthInBits wid) diff --git a/GHC/Cmm/Utils.hs b/GHC/Cmm/Utils.hs --- a/GHC/Cmm/Utils.hs +++ b/GHC/Cmm/Utils.hs @@ -1,8 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- -- -- Cmm utilities. @@ -83,6 +81,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Foldable (toList) import GHC.Cmm.Dataflow.Graph import GHC.Cmm.Dataflow.Label import GHC.Cmm.Dataflow.Block @@ -520,14 +519,12 @@ -- | like 'toBlockList', but the entry block always comes first toBlockListEntryFirst :: CmmGraph -> [CmmBlock] -toBlockListEntryFirst g - | mapNull m = [] - | otherwise = entry_block : others +toBlockListEntryFirst g = do + entry_block <- toList $ mapLookup entry_id m + entry_block : filter ((/= entry_id) . entryLabel) (mapElems m) where m = toBlockMap g entry_id = g_entry g - Just entry_block = mapLookup entry_id m - others = filter ((/= entry_id) . entryLabel) (mapElems m) -- | Like 'toBlockListEntryFirst', but we strive to ensure that we order blocks -- so that the false case of a conditional jumps to the next block in the output @@ -538,13 +535,10 @@ -- of successors returned for CmmCondBranch by the NonLocal instance for CmmNode -- defined in "GHC.Cmm.Node". -GBM toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock] -toBlockListEntryFirstFalseFallthrough g - | mapNull m = [] - | otherwise = dfs setEmpty [entry_block] +toBlockListEntryFirstFalseFallthrough g = dfs setEmpty $ toList $ mapLookup entry_id m where m = toBlockMap g entry_id = g_entry g - Just entry_block = mapLookup entry_id m dfs :: LabelSet -> [CmmBlock] -> [CmmBlock] dfs _ [] = [] diff --git a/GHC/CmmToAsm.hs b/GHC/CmmToAsm.hs --- a/GHC/CmmToAsm.hs +++ b/GHC/CmmToAsm.hs @@ -68,6 +68,7 @@ import qualified GHC.CmmToAsm.AArch64 as AArch64 import qualified GHC.CmmToAsm.Wasm as Wasm32 import qualified GHC.CmmToAsm.RV64 as RV64 +import qualified GHC.CmmToAsm.LA64 as LA64 import GHC.CmmToAsm.Reg.Liveness import qualified GHC.CmmToAsm.Reg.Linear as Linear @@ -151,7 +152,7 @@ ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" ArchMipsel -> panic "nativeCodeGen: No NCG for mipsel" ArchRISCV64 -> nCG' (RV64.ncgRV64 config) - ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" + ArchLoongArch64 -> nCG' (LA64.ncgLA64 config) ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" ArchWasm32 -> Wasm32.ncgWasm config logger platform ts modLoc h cmms diff --git a/GHC/CmmToAsm/AArch64/CodeGen.hs b/GHC/CmmToAsm/AArch64/CodeGen.hs --- a/GHC/CmmToAsm/AArch64/CodeGen.hs +++ b/GHC/CmmToAsm/AArch64/CodeGen.hs @@ -1,5 +1,6 @@ {-# language GADTs, LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} + module GHC.CmmToAsm.AArch64.CodeGen ( cmmTopCodeGen , generateJumpTableForInstr @@ -23,7 +24,7 @@ import GHC.CmmToAsm.Monad ( NatM, getNewRegNat , getPicBaseMaybeNat, getPlatform, getConfig - , getDebugBlock, getFileId, getThisModuleNat + , getDebugBlock, getFileId, getNewLabelNat, getThisModuleNat ) -- import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC @@ -50,7 +51,7 @@ import GHC.Data.OrdList import GHC.Utils.Outputable -import Control.Monad ( mapAndUnzipM, foldM ) +import Control.Monad ( mapAndUnzipM ) import GHC.Float import GHC.Types.Basic @@ -209,43 +210,83 @@ -- ----------------------------------------------------------------------------- -- Generating a table-branch --- TODO jump tables would be a lot faster, but we'll use bare bones for now. --- this is usually done by sticking the jump table ids into an instruction --- and then have the @generateJumpTableForInstr@ callback produce the jump --- table as a static. --- --- See Ticket 19912 --- --- data SwitchTargets = --- SwitchTargets --- Bool -- Signed values --- (Integer, Integer) -- Range --- (Maybe Label) -- Default value --- (M.Map Integer Label) -- The branches --- --- Non Jumptable plan: --- xE <- expr +-- | Generate jump to jump table target -- -genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock -genSwitch expr targets = do -- pprPanic "genSwitch" (ppr expr) - (reg, format, code) <- getSomeReg expr - let w = formatToWidth format - let mkbranch acc (key, bid) = do - (keyReg, _format, code) <- getSomeReg (CmmLit (CmmInt key w)) - return $ code `appOL` - toOL [ CMP (OpReg w reg) (OpReg w keyReg) - , BCOND EQ (TBlock bid) - ] `appOL` acc - def_code = case switchTargetsDefault targets of - Just bid -> unitOL (B (TBlock bid)) - Nothing -> nilOL - - switch_code <- foldM mkbranch nilOL (switchTargetsCases targets) - return $ code `appOL` switch_code `appOL` def_code +-- The index into the jump table is calulated by evaluating @expr@. The +-- corresponding table entry contains the relative address to jump to (relative +-- to the jump table's first entry / the table's own label). +genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch config expr targets = do + (reg, fmt1, e_code) <- getSomeReg indexExpr + let fmt = II64 + targetReg <- getNewRegNat fmt + lbl <- getNewLabelNat + dynRef <- cmmMakeDynamicReference config DataReference lbl + (tableReg, fmt2, t_code) <- getSomeReg dynRef + let code = + toOL + [ COMMENT (text "indexExpr" <+> (text . show) indexExpr), + COMMENT (text "dynRef" <+> (text . show) dynRef) + ] + `appOL` e_code + `appOL` t_code + `appOL` toOL + [ COMMENT (ftext "Jump table for switch"), + -- index to offset into the table (relative to tableReg) + annExpr expr (LSL (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3))), + -- calculate table entry address + ADD (OpReg W64 targetReg) (OpReg (formatToWidth fmt1) reg) (OpReg (formatToWidth fmt2) tableReg), + -- load table entry (relative offset from tableReg (first entry) to target label) + LDR II64 (OpReg W64 targetReg) (OpAddr (AddrRegImm targetReg (ImmInt 0))), + -- calculate absolute address of the target label + ADD (OpReg W64 targetReg) (OpReg W64 targetReg) (OpReg W64 tableReg), + -- prepare jump to target label + J_TBL ids (Just lbl) targetReg + ] + return code + where + -- See Note [Sub-word subtlety during jump-table indexing] in + -- GHC.CmmToAsm.X86.CodeGen for why we must first offset, then widen. + indexExpr0 = cmmOffset platform expr offset + -- We widen to a native-width register to sanitize the high bits + indexExpr = + CmmMachOp + (MO_UU_Conv expr_w (platformWordWidth platform)) + [indexExpr0] + expr_w = cmmExprWidth platform expr + (offset, ids) = switchTargetsToTable targets + platform = ncgPlatform config --- We don't do jump tables for now, see Ticket 19912 -generateJumpTableForInstr :: NCGConfig -> Instr - -> Maybe (NatCmmDecl RawCmmStatics Instr) +-- | Generate jump table data (if required) +-- +-- The idea is to emit one table entry per case. The entry is the relative +-- address of the block to jump to (relative to the table's first entry / +-- table's own label.) The calculation itself is done by the linker. +generateJumpTableForInstr :: + NCGConfig -> + Instr -> + Maybe (NatCmmDecl RawCmmStatics Instr) +generateJumpTableForInstr config (J_TBL ids (Just lbl) _) = + let jumpTable = + map jumpTableEntryRel ids + where + jumpTableEntryRel Nothing = + CmmStaticLit (CmmInt 0 (ncgWordWidth config)) + jumpTableEntryRel (Just blockid) = + CmmStaticLit + ( CmmLabelDiffOff + blockLabel + lbl + 0 + (ncgWordWidth config) + ) + where + blockLabel = blockLbl blockid + sectionType = case platformOS (ncgPlatform config) of + -- Aarch64 Windows platform requires LLVM 20 to support .rodata + OSMinGW32 -> Text + _ -> ReadOnlyData + in Just (CmmData (Section sectionType lbl) (CmmStaticsRaw lbl jumpTable)) generateJumpTableForInstr _ _ = Nothing -- ----------------------------------------------------------------------------- @@ -266,6 +307,7 @@ stmtToInstrs stmt = do -- traceM $ "-- -------------------------- stmtToInstrs -------------------------- --\n" -- ++ showSDocUnsafe (ppr stmt) + config <- getConfig platform <- getPlatform case stmt of CmmUnsafeForeignCall target result_regs args @@ -294,7 +336,7 @@ CmmCondBranch arg true false _prediction -> genCondBranch true false arg - CmmSwitch arg ids -> genSwitch arg ids + CmmSwitch arg ids -> genSwitch config arg ids CmmCall { cml_target = arg } -> genJump arg @@ -339,12 +381,6 @@ -- ones which map to a real machine register on this -- platform. Hence if it's not mapped to a registers something -- went wrong earlier in the pipeline. --- | Convert a BlockId to some CmmStatic data --- TODO: Add JumpTable Logic, see Ticket 19912 --- jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic --- jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config)) --- jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) --- where blockLabel = blockLbl blockid -- ----------------------------------------------------------------------------- -- General things for putting together code sequences @@ -796,11 +832,7 @@ MO_V_Add {} -> notUnary MO_V_Sub {} -> notUnary MO_V_Mul {} -> notUnary - MO_VS_Quot {} -> notUnary - MO_VS_Rem {} -> notUnary MO_VS_Neg {} -> notUnary - MO_VU_Quot {} -> notUnary - MO_VU_Rem {} -> notUnary MO_V_Shuffle {} -> notUnary MO_VF_Shuffle {} -> notUnary MO_VF_Insert {} -> notUnary @@ -1189,11 +1221,7 @@ MO_V_Add {} -> vectorsNeedLlvm MO_V_Sub {} -> vectorsNeedLlvm MO_V_Mul {} -> vectorsNeedLlvm - MO_VS_Quot {} -> vectorsNeedLlvm - MO_VS_Rem {} -> vectorsNeedLlvm MO_VS_Neg {} -> vectorsNeedLlvm - MO_VU_Quot {} -> vectorsNeedLlvm - MO_VU_Rem {} -> vectorsNeedLlvm MO_VF_Extract {} -> vectorsNeedLlvm MO_VF_Add {} -> vectorsNeedLlvm MO_VF_Sub {} -> vectorsNeedLlvm @@ -2121,7 +2149,7 @@ -- Conversion MO_UF_Conv w -> mkCCall (word2FloatLabel w) - -- Arithmatic + -- Arithmetic -- These are not supported on X86, so I doubt they are used much. MO_S_QuotRem _w -> unsupported mop MO_U_QuotRem _w -> unsupported mop @@ -2131,6 +2159,16 @@ MO_SubWordC _w -> unsupported mop MO_AddIntC _w -> unsupported mop MO_SubIntC _w -> unsupported mop + + -- Vector + MO_VS_Quot {} -> unsupported mop + MO_VS_Rem {} -> unsupported mop + MO_VU_Quot {} -> unsupported mop + MO_VU_Rem {} -> unsupported mop + MO_I64X2_Min -> unsupported mop + MO_I64X2_Max -> unsupported mop + MO_W64X2_Min -> unsupported mop + MO_W64X2_Max -> unsupported mop -- Memory Ordering -- Set flags according to their C pendants (stdatomic.h): diff --git a/GHC/CmmToAsm/AArch64/Instr.hs b/GHC/CmmToAsm/AArch64/Instr.hs --- a/GHC/CmmToAsm/AArch64/Instr.hs +++ b/GHC/CmmToAsm/AArch64/Instr.hs @@ -29,7 +29,7 @@ import GHC.Utils.Panic -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, catMaybes) import GHC.Stack @@ -120,6 +120,7 @@ ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 4. Branch Instructions ---------------------------------------------------- J t -> usage (regTarget t, []) + J_TBL _ _ t -> usage ([t], []) B t -> usage (regTarget t, []) BCOND _ t -> usage (regTarget t, []) BL t ps -> usage (regTarget t ++ ps, callerSavedRegisters) @@ -210,7 +211,7 @@ -- | <---- argument passing -------------> | <-- callee saved (lower 64 bits) ---> | <--------------------------------------- caller saved ----------------------> | -- | <------ free registers -------------> | F1 | F2 | F3 | F4 | D1 | D2 | D3 | D4 | <------ free registers -----------------------------------------------------> | -- '---------------------------------------------------------------------------------------------------------------------------------------------------------------' --- IR: Indirect result location register, IP: Intra-procedure register, PL: Platform register, FP: Frame pointer, LR: Link register, SP: Stack pointer +-- IR: Indirect result location register, IP: Intra-procedure register, PL: Platform register (See Note [Aarch64 Register x18 at Darwin and Windows]), FP: Frame pointer, LR: Link register, SP: Stack pointer -- BR: Base, SL: SpLim -- -- TODO: The zero register is currently mapped to -1 but should get it's own separate number. @@ -275,10 +276,11 @@ ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) -- 4. Branch Instructions -------------------------------------------------- - J t -> J (patchTarget t) - B t -> B (patchTarget t) - BL t rs -> BL (patchTarget t) rs - BCOND c t -> BCOND c (patchTarget t) + J t -> J (patchTarget t) + J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t) + B t -> B (patchTarget t) + BL t rs -> BL (patchTarget t) rs + BCOND c t -> BCOND c (patchTarget t) -- 5. Atomic Instructions -------------------------------------------------- -- 6. Conditional Instructions --------------------------------------------- @@ -332,6 +334,7 @@ CBZ{} -> True CBNZ{} -> True J{} -> True + J_TBL{} -> True B{} -> True BL{} -> True BCOND{} -> True @@ -345,6 +348,7 @@ jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]] jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]] jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] jumpDestsOfInstr (BL t _) = [ id | TBlock id <- [t]] jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] @@ -353,6 +357,11 @@ canFallthroughTo :: Instr -> BlockId -> Bool canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid canFallthroughTo (J (TBlock target)) bid = bid == target +canFallthroughTo (J_TBL targets _ _) bid = all isTargetBid targets + where + isTargetBid target = case target of + Nothing -> True + Just target -> target == bid canFallthroughTo (B (TBlock target)) bid = bid == target canFallthroughTo _ _ = False @@ -366,6 +375,7 @@ CBZ r (TBlock bid) -> CBZ r (TBlock (patchF bid)) CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid)) J (TBlock bid) -> J (TBlock (patchF bid)) + J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r B (TBlock bid) -> B (TBlock (patchF bid)) BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid)) @@ -668,6 +678,7 @@ | CBNZ Operand Target -- if op /= 0, then branch. -- Branching. | J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others. + | J_TBL [Maybe BlockId] (Maybe CLabel) Reg -- A jump instruction with data for switch/jump tables | B Target -- unconditional branching b/br. (To a blockid, label or register) | BL Target [Reg] -- branch and link (e.g. set x30 to next pc, and branch) | BCOND Cond Target -- branch with condition. b. @@ -758,6 +769,7 @@ CBZ{} -> "CBZ" CBNZ{} -> "CBNZ" J{} -> "J" + J_TBL {} -> "J_TBL" B{} -> "B" BL{} -> "BL" BCOND{} -> "BCOND" diff --git a/GHC/CmmToAsm/AArch64/Ppr.hs b/GHC/CmmToAsm/AArch64/Ppr.hs --- a/GHC/CmmToAsm/AArch64/Ppr.hs +++ b/GHC/CmmToAsm/AArch64/Ppr.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP #-} module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr, pprBasicBlock) where @@ -20,7 +19,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.CLabel -import GHC.Cmm.InitFini import GHC.Types.Unique ( pprUniqueAlways, getUnique ) import GHC.Platform @@ -30,7 +28,9 @@ pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc pprNatCmmDecl config (CmmData section dats) = - pprSectionAlign config section $$ pprDatas config dats + let platform = ncgPlatform config + in + pprSectionAlign config section $$ pprDatas platform dats pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = let platform = ncgPlatform config @@ -42,7 +42,9 @@ pprSectionAlign config (Section Text lbl) $$ -- do not -- pprProcAlignment config $$ - pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed + (if lbl /= blockLbl (blockId (head blocks)) -- blocks can have clashed names + then pprLabel platform lbl -- blocks guaranteed not null, so label needed + else empty) $$ vcat (map (pprBasicBlock platform with_dwarf top_info) blocks) $$ (if ncgDwarfEnabled config then line (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':') else empty) $$ @@ -91,20 +93,9 @@ pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc pprSectionAlign _config (Section (OtherSection _) _) = panic "AArch64.Ppr.pprSectionAlign: unknown section" -pprSectionAlign config sec@(Section seg suffix) = +pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) - $$ coffSplitSectionComdatKey $$ pprAlignForSection (ncgPlatform config) seg - where - platform = ncgPlatform config - -- See Note [Split sections on COFF objects] - coffSplitSectionComdatKey - | OSMinGW32 <- platformOS platform - , ncgSplitSections config - , Nothing <- isInitOrFiniSection seg - = line (pprCOFFComdatKey platform suffix <> colon) - | otherwise - = empty -- | Output the ELF .size directive. pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc @@ -147,26 +138,20 @@ (l@LOCATION{} : _) -> pprInstr platform l _other -> empty -pprDatas :: IsDoc doc => NCGConfig -> RawCmmStatics -> doc +pprDatas :: IsDoc doc => Platform -> RawCmmStatics -> doc -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel". -pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _]) +pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _]) | lbl == mkIndStaticInfoLabel , let labelInd (CmmLabelOff l _) = Just l labelInd (CmmLabel l) = Just l labelInd _ = Nothing , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' - -- See Note [Split sections on COFF objects] - , not $ platformOS platform == OSMinGW32 && ncgSplitSections config = pprGloblDecl platform alias $$ line (text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind') - where - platform = ncgPlatform config -pprDatas config (CmmStaticsRaw lbl dats) +pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats) - where - platform = ncgPlatform config pprData :: IsDoc doc => Platform -> CmmStatic -> doc pprData _platform (CmmString str) = line (pprString str) @@ -441,6 +426,7 @@ -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t) + J_TBL _ _ r -> pprInstr platform (B (TReg r)) B (TBlock bid) -> line $ text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) B (TLabel lbl) -> line $ text "\tb" <+> pprAsmLabel platform lbl B (TReg r) -> line $ text "\tbr" <+> pprReg W64 r @@ -476,63 +462,51 @@ STR _f o1 o2 -> op2 (text "\tstr") o1 o2 STLR _f o1 o2 -> op2 (text "\tstlr") o1 o2 -#if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$ - op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. - - LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$ - op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. - - LDR _f o1 (OpImm (ImmIndex lbl off)) -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$ - op_add o1 (pprAsmLabel platform lbl <> text "@pageoff") $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. - - LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$ - op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") - - LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$ - op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") - - LDR _f o1 (OpImm (ImmCLbl lbl)) -> - op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$ - op_add o1 (pprAsmLabel platform lbl <> text "@pageoff") - -#else - LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$ - op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. + let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_ldr o1 (ldr') $$ + op_add o1 (check_off off) LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> - op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$ - op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. + case platformOS platform of + OSMinGW32 -> + let (adrp', add') = op_adrp_reloc_local $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_add o1 add' $$ + op_add o1 (check_off off) + _ -> + let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_ldr o1 (ldr') $$ + op_add o1 (check_off off) LDR _f o1 (OpImm (ImmIndex lbl off)) -> - op_adrp o1 (pprAsmLabel platform lbl) $$ - op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) $$ - op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. + let (adrp', add') = op_adrp_reloc_local $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_add o1 (add') $$ + op_add o1 (check_off off) LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> - op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$ - op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) + let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_ldr o1 (ldr') LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> - op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$ - op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) + case platformOS platform of + OSMinGW32 -> + let (adrp', add') = op_adrp_reloc_local $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_add o1 add' + _ -> + let (adrp', ldr') = op_adrp_reloc_dynamic $ pprAsmLabel platform lbl in + op_adrp o1 (adrp') $$ + op_ldr o1 (ldr') LDR _f o1 (OpImm (ImmCLbl lbl)) -> - op_adrp o1 (pprAsmLabel platform lbl) $$ - op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) - -#endif + let (adrp', ldr') = op_adrp_reloc_local $ pprAsmLabel platform lbl in + op_adrp o1 adrp' $$ + op_add o1 ldr' LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> op2 (text "\tldrb") o1 o2 @@ -567,6 +541,21 @@ op_ldr o1 rest = line $ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> rest <> text "]" op_adrp o1 rest = line $ text "\tadrp" <+> pprOp platform o1 <> comma <+> rest op_add o1 rest = line $ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest + + op_adrp_reloc_dynamic asm_lbl = case platformOS platform of + OSDarwin -> (asm_lbl <> text "@gotpage", asm_lbl <> text "@gotpageoff") + OSLinux -> (text ":got:" <> asm_lbl, text ":got_lo12:" <> asm_lbl) + OSMinGW32 -> (text "__imp_" <> asm_lbl, text ":lo12:__imp_" <> asm_lbl) + os' -> pgmError $ "GHC.CmmToAsm.AArch64.Ppr.op_adrp_reloc_dynamic : " ++ show os' ++ " is unsuppported by relocations" + + op_adrp_reloc_local asm_lbl = case platformOS platform of + OSDarwin -> (asm_lbl <> text "@page", asm_lbl <> text "@pageoff") + OSLinux -> (asm_lbl, text ":lo12:" <> asm_lbl) + OSMinGW32 -> (asm_lbl, text ":lo12:" <> asm_lbl) + os' -> pgmError $ "GHC.CmmToAsm.AArch64.Ppr.op_adrp_reloc_local : " ++ show os' ++ " is unsuppported by relocations" + + check_off off = if off >= 0 && off <= 4095 then char '#' <> int off else + pgmError $ "GHC.CmmToAsm.AArch64.Ppr.check_off : " ++ show off ++ " is out of 12 bit" pprBcond :: IsLine doc => Cond -> doc pprBcond c = text "b." <> pprCond c diff --git a/GHC/CmmToAsm/BlockLayout.hs b/GHC/CmmToAsm/BlockLayout.hs --- a/GHC/CmmToAsm/BlockLayout.hs +++ b/GHC/CmmToAsm/BlockLayout.hs @@ -508,8 +508,8 @@ union cFrom new_point merge edges chains where - cFrom = expectJust "mergeChains:chainMap:from" $ mapLookup from chains - cTo = expectJust "mergeChains:chainMap:to" $ mapLookup to chains + cFrom = expectJust $ mapLookup from chains + cTo = expectJust $ mapLookup to chains -- See Note [Chain based CFG serialization] for the general idea. @@ -757,7 +757,7 @@ --pprTraceIt "placedBlocks" $ -- ++ [] is still kinda expensive if null unplaced then blockList else blockList ++ unplaced - getBlock bid = expectJust "Block placement" $ mapLookup bid blockMap + getBlock bid = expectJust $ mapLookup bid blockMap in --Assert we placed all blocks given as input assert (all (\bid -> mapMember bid blockMap) placedBlocks) $ diff --git a/GHC/CmmToAsm/CFG.hs b/GHC/CmmToAsm/CFG.hs --- a/GHC/CmmToAsm/CFG.hs +++ b/GHC/CmmToAsm/CFG.hs @@ -311,8 +311,8 @@ cuts_vars <- traverse (\p -> (p,) <$> fresh (Just p)) (concatMap (\(a, b) -> [a] ++ maybe [] (:[]) b) cuts_list) let cuts_map = mapFromList cuts_vars :: LabelMap (Point s (Maybe BlockId)) -- Then unify according to the rewrites in the cuts map - mapM_ (\(from, to) -> expectJust "shortcutWeightMap" (mapLookup from cuts_map) - `union` expectJust "shortcutWeightMap" (maybe (Just null) (flip mapLookup cuts_map) to) ) cuts_list + mapM_ (\(from, to) -> expectJust (mapLookup from cuts_map) + `union` expectJust (maybe (Just null) (flip mapLookup cuts_map) to) ) cuts_list -- Then recover the unique representative, which is the result of following -- the chain to the end. mapM find cuts_map @@ -416,13 +416,10 @@ = Nothing getEdgeWeight :: CFG -> BlockId -> BlockId -> EdgeWeight -getEdgeWeight cfg from to = - edgeWeight $ expectJust "Edgeweight for nonexisting block" $ - getEdgeInfo from to cfg +getEdgeWeight cfg from to = edgeWeight $ expectJust $ getEdgeInfo from to cfg getTransitionSource :: BlockId -> BlockId -> CFG -> TransitionSource -getTransitionSource from to cfg = transitionSource $ expectJust "Source info for nonexisting block" $ - getEdgeInfo from to cfg +getTransitionSource from to cfg = transitionSource $ expectJust $ getEdgeInfo from to cfg reverseEdges :: CFG -> CFG reverseEdges cfg = mapFoldlWithKey (\cfg from toMap -> go (addNode cfg from) from toMap) mapEmpty cfg @@ -600,7 +597,7 @@ -} -- | Generate weights for a Cmm proc based on some simple heuristics. -getCfgProc :: Platform -> Weights -> RawCmmDecl -> CFG +getCfgProc :: Platform -> Weights -> GenCmmDecl d h CmmGraph -> CFG getCfgProc _ _ (CmmData {}) = mapEmpty getCfgProc platform weights (CmmProc _info _lab _live graph) = getCfg platform weights graph @@ -1004,7 +1001,7 @@ blockMapping = listArray (0,mapSize vertexMapping - 1) revOrder :: Array Int BlockId -- Map from blockId to indices starting at zero toVertex :: BlockId -> Int - toVertex blockId = expectJust "mkGlobalWeights" $ mapLookup blockId vertexMapping + toVertex blockId = expectJust $ mapLookup blockId vertexMapping -- Map from indices starting at zero to blockIds fromVertex :: Int -> BlockId fromVertex vertex = blockMapping ! vertex diff --git a/GHC/CmmToAsm/Dwarf/Constants.hs b/GHC/CmmToAsm/Dwarf/Constants.hs --- a/GHC/CmmToAsm/Dwarf/Constants.hs +++ b/GHC/CmmToAsm/Dwarf/Constants.hs @@ -241,6 +241,7 @@ ArchPPC_64 _ -> fromIntegral $ toRegNo r ArchAArch64 -> fromIntegral $ toRegNo r ArchRISCV64 -> fromIntegral $ toRegNo r + ArchLoongArch64 -> fromIntegral $ toRegNo r _other -> error "dwarfRegNo: Unsupported platform or unknown register!" -- | Virtual register number to use for return address. @@ -255,4 +256,5 @@ ArchPPC_64 ELF_V2 -> 65 -- lr (link register) ArchAArch64 -> 30 ArchRISCV64 -> 1 -- ra (return address) + ArchLoongArch64 -> 1 -- ra (return address) _other -> error "dwarfReturnRegNo: Unsupported platform!" diff --git a/GHC/CmmToAsm/Dwarf/Types.hs b/GHC/CmmToAsm/Dwarf/Types.hs --- a/GHC/CmmToAsm/Dwarf/Types.hs +++ b/GHC/CmmToAsm/Dwarf/Types.hs @@ -150,14 +150,14 @@ pprDwarfInfo :: IsDoc doc => Platform -> Bool -> DwarfInfo -> doc pprDwarfInfo platform haveSrc d = case d of - DwarfCompileUnit {} -> hasChildren - DwarfSubprogram {} -> hasChildren - DwarfBlock {} -> hasChildren - DwarfSrcNote {} -> noChildren + DwarfCompileUnit {dwChildren = kids} -> hasChildren kids + DwarfSubprogram {dwChildren = kids} -> hasChildren kids + DwarfBlock {dwChildren = kids} -> hasChildren kids + DwarfSrcNote {} -> noChildren where - hasChildren = + hasChildren kids = pprDwarfInfoOpen platform haveSrc d $$ - vcat (map (pprDwarfInfo platform haveSrc) (dwChildren d)) $$ + vcat (map (pprDwarfInfo platform haveSrc) kids) $$ pprDwarfInfoClose noChildren = pprDwarfInfoOpen platform haveSrc d {-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc #-} diff --git a/GHC/CmmToAsm/LA64.hs b/GHC/CmmToAsm/LA64.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64.hs @@ -0,0 +1,60 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Native code generator for LoongArch64 architectures +module GHC.CmmToAsm.LA64 ( ncgLA64 ) where + +import GHC.Prelude + +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Instr +import GHC.CmmToAsm.Monad +import GHC.CmmToAsm.Types +import GHC.Utils.Outputable (ftext) + +import qualified GHC.CmmToAsm.LA64.CodeGen as LA64 +import qualified GHC.CmmToAsm.LA64.Instr as LA64 +import qualified GHC.CmmToAsm.LA64.Ppr as LA64 +import qualified GHC.CmmToAsm.LA64.RegInfo as LA64 +import qualified GHC.CmmToAsm.LA64.Regs as LA64 + +ncgLA64 :: NCGConfig -> NcgImpl RawCmmStatics LA64.Instr LA64.JumpDest +ncgLA64 config = + NcgImpl + { ncgConfig = config, + cmmTopCodeGen = LA64.cmmTopCodeGen, + generateJumpTableForInstr = LA64.generateJumpTableForInstr config, + getJumpDestBlockId = LA64.getJumpDestBlockId, + canShortcut = LA64.canShortcut, + shortcutStatics = LA64.shortcutStatics, + shortcutJump = LA64.shortcutJump, + pprNatCmmDeclS = LA64.pprNatCmmDecl config, + pprNatCmmDeclH = LA64.pprNatCmmDecl config, + maxSpillSlots = LA64.maxSpillSlots config, + allocatableRegs = LA64.allocatableRegs platform, + ncgAllocMoreStack = LA64.allocMoreStack platform, + ncgMakeFarBranches = LA64.makeFarBranches, + extractUnwindPoints = const [], + invertCondBranches = \_ _ -> id + } + where + platform = ncgPlatform config + +-- | `Instruction` instance for LA64 +instance Instruction LA64.Instr where + regUsageOfInstr = LA64.regUsageOfInstr + patchRegsOfInstr _ = LA64.patchRegsOfInstr + isJumpishInstr = LA64.isJumpishInstr + canFallthroughTo = LA64.canFallthroughTo + jumpDestsOfInstr = LA64.jumpDestsOfInstr + patchJumpInstr = LA64.patchJumpInstr + mkSpillInstr = LA64.mkSpillInstr + mkLoadInstr = LA64.mkLoadInstr + takeDeltaInstr = LA64.takeDeltaInstr + isMetaInstr = LA64.isMetaInstr + mkRegRegMoveInstr _ _ = LA64.mkRegRegMoveInstr + takeRegRegMoveInstr _ = LA64.takeRegRegMoveInstr + mkJumpInstr = LA64.mkJumpInstr + mkStackAllocInstr = LA64.mkStackAllocInstr + mkStackDeallocInstr = LA64.mkStackDeallocInstr + mkComment = pure . LA64.COMMENT . ftext + pprInstr = LA64.pprInstr diff --git a/GHC/CmmToAsm/LA64/CodeGen.hs b/GHC/CmmToAsm/LA64/CodeGen.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/CodeGen.hs @@ -0,0 +1,2236 @@ +{-# language GADTs #-} +{-# language LambdaCase #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE OverloadedStrings #-} +module GHC.CmmToAsm.LA64.CodeGen ( + cmmTopCodeGen + , generateJumpTableForInstr + , makeFarBranches +) + +where + +import Data.Maybe +import Data.Word +import GHC.Cmm +import GHC.Cmm.BlockId +import GHC.Cmm.CLabel +import GHC.Cmm.Dataflow.Block +import GHC.Cmm.Dataflow.Graph +import GHC.Cmm.DebugBlock +import GHC.Cmm.Switch +import GHC.Cmm.Utils +import GHC.CmmToAsm.CPrim +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Monad + ( NatM, + getConfig, + getDebugBlock, + getFileId, + getNewLabelNat, + getNewRegNat, + getPicBaseMaybeNat, + getPlatform + ) +import GHC.CmmToAsm.PIC +import GHC.CmmToAsm.LA64.Cond +import GHC.CmmToAsm.LA64.Instr +import GHC.CmmToAsm.LA64.Regs +import GHC.CmmToAsm.Types +import GHC.Data.FastString +import GHC.Data.OrdList +import GHC.Float +import GHC.Platform +import GHC.Platform.Reg +import GHC.Platform.Regs +import GHC.Prelude hiding (EQ) +import GHC.Types.Basic +import GHC.Types.ForeignCall +import GHC.Types.SrcLoc (srcSpanFile, srcSpanStartCol, srcSpanStartLine) +import GHC.Types.Tickish (GenTickish (..)) +import GHC.Utils.Constants (debugIsOn) +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Monad +import Control.Monad +import GHC.Cmm.Dataflow.Label +import GHC.Types.Unique.DSM + +-- [General layout of an NCG] +cmmTopCodeGen :: + RawCmmDecl -> + NatM [NatCmmDecl RawCmmStatics Instr] +-- Thus we'll have to deal with either CmmProc ... +cmmTopCodeGen _cmm@(CmmProc info lab live graph) = do + picBaseMb <- getPicBaseMaybeNat + when (isJust picBaseMb) $ panic "LA64.cmmTopCodeGen: Unexpected PIC base register" + + let blocks = toBlockListEntryFirst graph + (nat_blocks, statics) <- mapAndUnzipM basicBlockCodeGen blocks + + let proc = CmmProc info lab live (ListGraph $ concat nat_blocks) + tops = proc : concat statics + + pure tops + +-- ... or CmmData. +cmmTopCodeGen (CmmData sec dat) = pure [CmmData sec dat] -- no translation, we just use CmmStatic + +basicBlockCodeGen :: + Block CmmNode C C -> + NatM + ( [NatBasicBlock Instr], + [NatCmmDecl RawCmmStatics Instr] + ) +basicBlockCodeGen block = do + config <- getConfig + let (_, nodes, tail) = blockSplit block + id = entryLabel block + stmts = blockToList nodes + + header_comment_instr + | debugIsOn = + unitOL + $ MULTILINE_COMMENT + ( text "-- --------------------------- basicBlockCodeGen --------------------------- --\n" + $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block) + ) + | otherwise = nilOL + + -- Generate location directive `.loc` (DWARF debug location info) + loc_instrs <- genLocInstrs + + -- Generate other instructions + mid_instrs <- stmtsToInstrs stmts + (!tail_instrs) <- stmtToInstrs tail + + let instrs = header_comment_instr `appOL` loc_instrs `appOL` mid_instrs `appOL` tail_instrs + + -- TODO: Then x86 backend runs @verifyBasicBlock@ here. How important it is to + -- have a valid CFG is an open question: This and the AArch64 and PPC NCGs + -- work fine without it. + + -- Code generation may introduce new basic block boundaries, which are + -- indicated by the NEWBLOCK instruction. We must split up the instruction + -- stream into basic blocks again. Also, we extract LDATAs here too. + (top, other_blocks, statics) = foldrOL mkBlocks ([], [], []) instrs + + return (BasicBlock id top : other_blocks, statics) + where + genLocInstrs :: NatM (OrdList Instr) + genLocInstrs = do + dbg <- getDebugBlock (entryLabel block) + case dblSourceTick =<< dbg of + Just (SourceNote span name) -> + do + fileId <- getFileId (srcSpanFile span) + let line = srcSpanStartLine span; col = srcSpanStartCol span + pure $ unitOL $ LOCATION fileId line col name + _ -> pure nilOL + +mkBlocks :: + Instr -> + ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g]) -> + ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g]) +mkBlocks (NEWBLOCK id) (instrs, blocks, statics) = + ([], BasicBlock id instrs : blocks, statics) +mkBlocks (LDATA sec dat) (instrs, blocks, statics) = + (instrs, blocks, CmmData sec dat : statics) +mkBlocks instr (instrs, blocks, statics) = + (instr : instrs, blocks, statics) + +-- ----------------------------------------------------------------------------- +-- | Utilities + +-- | Annotate an `Instr` with a `SDoc` comment +ann :: SDoc -> Instr -> Instr +ann doc instr {- debugIsOn -} = ANN doc instr +{-# INLINE ann #-} + +-- Using pprExpr will hide the AST, @ANN@ will end up in the assembly with +-- -dppr-debug. The idea is that we can trivially see how a cmm expression +-- ended up producing the assembly we see. By having the verbatim AST printed +-- we can simply check the patterns that were matched to arrive at the assembly +-- we generated. +-- +-- pprExpr will hide a lot of noise of the underlying data structure and print +-- the expression into something that can be easily read by a human. However +-- going back to the exact CmmExpr representation can be laborious and adds +-- indirections to find the matches that lead to the assembly. +-- +-- An improvement oculd be to have +-- +-- (pprExpr genericPlatform e) <> parens (text. show e) +-- +-- to have the best of both worlds. +-- +-- Note: debugIsOn is too restrictive, it only works for debug compilers. +-- However, we do not only want to inspect this for debug compilers. Ideally +-- we'd have a check for -dppr-debug here already, such that we don't even +-- generate the ANN expressions. However, as they are lazy, they shouldn't be +-- forced until we actually force them, and without -dppr-debug they should +-- never end up being forced. +annExpr :: CmmExpr -> Instr -> Instr +annExpr e {- debugIsOn -} = ANN (text . show $ e) +-- annExpr e instr {- debugIsOn -} = ANN (pprExpr genericPlatform e) instr +-- annExpr _ instr = instr +{-# INLINE annExpr #-} + +-- ----------------------------------------------------------------------------- +-- Generating a table-branch +-- The index into the jump table is calulated by evaluating @expr@. The +-- corresponding table entry contains the address to jump to. +genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch config expr targets = do + (reg, fmt1, e_code) <- getSomeReg indexExpr + targetReg <- getNewRegNat II64 + lbl <- getNewLabelNat + dynRef <- cmmMakeDynamicReference config DataReference lbl + (tableReg, fmt2, t_code) <- getSomeReg $ dynRef + let code = + toOL [ COMMENT (text "indexExpr" <+> (text . show) indexExpr) + , COMMENT (text "dynRef" <+> (text . show) dynRef) + ] + `appOL` e_code + `appOL` t_code + `appOL` toOL + [ + COMMENT (ftext "Jump table for switch"), + -- index to offset into the table (relative to tableReg) + annExpr expr (SLL (OpReg W64 reg) (OpReg (formatToWidth fmt1) reg) (OpImm (ImmInt 3))), + -- calculate table entry address + ADD (OpReg W64 targetReg) (OpReg W64 reg) (OpReg (formatToWidth fmt2) tableReg), + -- load table entry (relative offset from tableReg (first entry) to target label) + LDU II64 (OpReg W64 targetReg) (OpAddr (AddrRegImm targetReg (ImmInt 0))), + -- calculate absolute address of the target label + ADD (OpReg W64 targetReg) (OpReg W64 targetReg) (OpReg W64 tableReg), + -- prepare jump to target label + J_TBL bids (Just lbl) targetReg + ] + return code + where + platform = ncgPlatform config + expr_w = cmmExprWidth platform expr + indexExpr0 = cmmOffset platform expr offset + -- Widen to a native-width register(addressing modes) + indexExpr = CmmMachOp + (MO_UU_Conv expr_w (platformWordWidth platform)) + [indexExpr0] + (offset, bids) = switchTargetsToTable targets + + +-- Generate jump table data (if required) +-- +-- Relies on PIC relocations. The idea is to emit one table entry per case. The +-- entry is the label of the block to jump to. This will be relocated to be the +-- address of the jump target. +generateJumpTableForInstr :: + NCGConfig -> + Instr -> + Maybe (NatCmmDecl RawCmmStatics Instr) +generateJumpTableForInstr config (J_TBL ids (Just lbl) _) = + let jumpTable = + map jumpTableEntryRel ids + where + jumpTableEntryRel Nothing = + CmmStaticLit (CmmInt 0 (ncgWordWidth config)) + jumpTableEntryRel (Just blockid) = + CmmStaticLit + ( CmmLabelDiffOff + blockLabel + lbl + 0 + (ncgWordWidth config) + ) + where + blockLabel = blockLbl blockid + in Just (CmmData (Section ReadOnlyData lbl) (CmmStaticsRaw lbl jumpTable)) +generateJumpTableForInstr _ _ = Nothing + +-- ----------------------------------------------------------------------------- +-- Top-level of the instruction selector +stmtsToInstrs :: + -- | Cmm Statements + [CmmNode O O] -> + -- | Resulting instruction + NatM InstrBlock +stmtsToInstrs stmts = concatOL <$> mapM stmtToInstrs stmts + +stmtToInstrs :: + CmmNode e x -> + -- | Resulting instructions + NatM InstrBlock + +stmtToInstrs stmt = do + config <- getConfig + platform <- getPlatform + case stmt of + CmmUnsafeForeignCall target result_regs args + -> genCCall target result_regs args + + CmmComment s -> return (unitOL (COMMENT (ftext s))) + CmmTick {} -> return nilOL + + CmmAssign reg src + | isFloatType ty -> assignReg_FltCode format reg src + | otherwise -> assignReg_IntCode format reg src + where ty = cmmRegType reg + format = cmmTypeFormat ty + + CmmStore addr src _alignment + | isFloatType ty -> assignMem_FltCode format addr src + | otherwise -> assignMem_IntCode format addr src + where ty = cmmExprType platform src + format = cmmTypeFormat ty + + CmmBranch id -> genBranch id + + --We try to arrange blocks such that the likely branch is the fallthrough + --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here. + CmmCondBranch arg true false _prediction -> + genCondBranch true false arg + + CmmSwitch arg ids -> genSwitch config arg ids + + CmmCall { cml_target = arg } -> genJump arg + + CmmUnwind _regs -> pure nilOL + + _ -> pprPanic "stmtToInstrs: statement should have been cps'd away" (pdoc platform stmt) + +-- | 'InstrBlock's are the insn sequences generated by the insn selectors. +-- They are really trees of insns to facilitate fast appending, where a +-- left-to-right traversal yields the insns in the correct order. +type InstrBlock = + OrdList Instr + +-- | Register's passed up the tree. +-- If the stix code forces the register to live in a pre-decided machine +-- register, it comes out as @Fixed@; otherwise, it comes out as @Any@, and the +-- parent can decide which register to put it in. +data Register + = Fixed Format Reg InstrBlock + | Any Format (Reg -> InstrBlock) + +-- | Sometimes we need to change the Format of a register. Primarily during +-- conversion. +swizzleRegisterRep :: Format -> Register -> Register +swizzleRegisterRep format' (Fixed _ reg code) = Fixed format' reg code +swizzleRegisterRep format' (Any _ codefn) = Any format' codefn + +-- | Grab a `Reg` for a `CmmReg` +getRegisterReg :: Platform -> CmmReg -> Reg + +getRegisterReg _ (CmmLocal (LocalReg u pk)) + = RegVirtual $ mkVirtualReg u (cmmTypeFormat pk) + +getRegisterReg platform (CmmGlobal mid) + = case globalRegMaybe platform (globalRegUse_reg mid) of + Just reg -> RegReal reg + Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid) + +-- General things for putting together code sequences + +-- | Compute an expression into any register +getSomeReg :: CmmExpr -> NatM (Reg, Format, InstrBlock) +getSomeReg expr = do + r <- getRegister expr + case r of + Any rep code -> do + tmp <- getNewRegNat rep + return (tmp, rep, code tmp) + Fixed rep reg code -> + return (reg, rep, code) + +-- | Compute an expression into any floating-point register + +-- | Compute an expression into floating point register +-- If the initial expression is not a floating-point expression, finally move +-- the result into a floating-point register. +getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) +getFloatReg expr = do + r <- getRegister expr + case r of + Any rep code | isFloatFormat rep -> do + tmp <- getNewRegNat rep + return (tmp, rep, code tmp) + Any II32 code -> do + tmp <- getNewRegNat FF32 + return (tmp, FF32, code tmp) + Any II64 code -> do + tmp <- getNewRegNat FF64 + return (tmp, FF64, code tmp) + Any _w _code -> do + config <- getConfig + pprPanic "can't do getFloatReg on" (pdoc (ncgPlatform config) expr) + -- can't do much for fixed. + Fixed rep reg code -> + return (reg, rep, code) + +-- | Map `CmmLit` to `OpImm` +litToImm' :: CmmLit -> Operand +litToImm' = OpImm . litToImm + +-- Handling PIC on LA64 +-- Commonly, `PIC` means of `position independent code`, that to say, the execution +-- of code does not be influenced by Load_address. Through PC-Relative addressing +-- or GOT addressing, both can be used to implement `PIC`. +-- +-- For LoongArch's common compiler(GCC, Clang), they generate PIC code by default +-- without condition. The command option `-fPIC` dicates to generate code for +-- shared-library. If not just specified for shared-library, another option `-fPIE` +-- was be created. +-- +-- Like RV64, LA64 does not have a special PIC register, the general approach is to +-- simply do PC-relative addressing or go through the GOT. There is assembly support +-- for both. +-- +-- LA64 assembly has many `la*` (load address) pseudo-instructions, that allows +-- loading a symbols's address into a register. These instructions is desugared into +-- different addressing modes. See following: +-- +-- la rd, label + addend -> Load global symbol +-- la.global rd, label + addend -> Same as `la` +-- la.local rd, label + addend -> Load local symbol +-- la.pcrel rd, label + addend +-- la.got rd, label +-- la.abs rd, label + addend +-- +-- `la` is alias of `la.global`. Commonly recommended use `la.local` and `la.global`. +-- +-- PC-relative addressing: +-- pcalau12i $a0, %pc_hi20(a) +-- addi.d $a0, $a0, %pc_lo12(a) +-- +-- GOT addressing: +-- pcalau12i $a0, %got_pc_hi20(global_a) +-- ld.d $a0, $a0, %got_pc_lo12(global_a) +-- +-- PIC can be enabled/disabled through: +-- .option pic +-- +-- CmmGlobal @PicBaseReg@'s are generated in @GHC.CmmToAsm.PIC@ in the +-- @cmmMakePicReference@. This is in turn called from @cmmMakeDynamicReference@ +-- also in @Cmm.CmmToAsm.PIC@ from where it is also exported. There are two +-- callsites for this. One is in this module to produce the @target@ in @genCCall@ +-- the other is in @GHC.CmmToAsm@ in @cmmExprNative@. +-- +-- Conceptually we do not want any special PicBaseReg to be used on LA64. If +-- we want to distinguish between symbol loading, we need to address this through +-- the way we load it, not through a register. + +-- Compute a `CmmExpr` into a `Register` +getRegister :: CmmExpr -> NatM Register +getRegister e = do + config <- getConfig + getRegister' config (ncgPlatform config) e + +-- Signed arithmetic on LoongArch64 +-- +-- Handling signed arithmetic on sub-word-size values on LA64 is a bit tricky +-- as Cmm's type system does not capture signedness. While 32- and 64-bit +-- values are fairly easy to handle due to LA64's 32- and 64-bit instructions +-- with responding register, 8- and 16-bit values require quite some care. +-- +-- For LoongArch64, EXT.W.[B/H] will sign-extend 8- and 16-bit to 64-bit. +-- However, it is best to use EXT instruction only if the input and +-- output data widths are fully determined. +-- +-- We handle 16-and 8-bit values by using the following two steps: +-- 1. Sign- or Zero-extending operands. +-- 2. Truncate results as necessary. +-- +-- For simplicity we maintain the invariant that a register containing a +-- sub-word-size value always contains the zero-extended form of that value +-- in between operations. + +getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register + +-- OPTIMIZATION WARNING: CmmExpr rewrites + +-- Generic case. +getRegister' config plat expr = + case expr of + CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)) -> + pprPanic "getRegisterReg-memory" (ppr PicBaseReg) + + CmmLit lit -> + case lit of + CmmInt 0 w -> pure $ Fixed (intFormat w) zeroReg nilOL + CmmInt i w -> do + -- narrowU is important: Negative immediates may be + -- sign-extended on load! + let imm = OpImm . ImmInteger $ narrowU w i + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm))) + + CmmFloat 0 w -> do + let op = litToImm' lit + pure (Any (floatFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) op))) + + CmmFloat _f W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (pdoc plat expr) + CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr) + + CmmFloat f W32 -> do + let word = castFloatToWord32 (fromRational f) :: Word32 + tmp <- getNewRegNat (intFormat W32) + return (Any (floatFormat W32) (\dst -> toOL [ annExpr expr + $ MOV (OpReg W32 tmp) (OpImm (ImmInteger (fromIntegral word))) + , MOV (OpReg W32 dst) (OpReg W32 tmp) + ])) + CmmFloat f W64 -> do + let word = castDoubleToWord64 (fromRational f) :: Word64 + tmp <- getNewRegNat (intFormat W64) + return (Any (floatFormat W64) (\dst -> toOL [ annExpr expr + $ MOV (OpReg W64 tmp) (OpImm (ImmInteger (fromIntegral word))) + , MOV (OpReg W64 dst) (OpReg W64 tmp) + ])) + + CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (pdoc plat expr) + CmmVec _lits -> pprPanic "getRegister' (CmmLit:CmmVec): " (pdoc plat expr) + + CmmLabel lbl -> do + let op = OpImm (ImmCLbl lbl) + rep = cmmLitType plat lit + format = cmmTypeFormat rep + return (Any format (\dst -> unitOL $ annExpr expr (LD format (OpReg (formatToWidth format) dst) op))) + + CmmLabelOff lbl off | isNbitEncodeable 12 (fromIntegral off) -> do + let op = OpImm (ImmIndex lbl off) + rep = cmmLitType plat lit + format = cmmTypeFormat rep + return (Any format (\dst -> unitOL $ LD format (OpReg (formatToWidth format) dst) op)) + + CmmLabelOff lbl off -> do + let op = litToImm' (CmmLabel lbl) + rep = cmmLitType plat lit + format = cmmTypeFormat rep + width = typeWidth rep + (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) + return (Any format (\dst -> off_code `snocOL` + LD format (OpReg (formatToWidth format) dst) op `snocOL` + ADD (OpReg W64 dst) (OpReg width dst) (OpReg width off_r) + )) + + CmmLabelDiffOff {} -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr) + CmmBlock _ -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr) + CmmHighStackMark -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr) + + CmmLoad mem rep _ -> do + let format = cmmTypeFormat rep + width = typeWidth rep + Amode addr addr_code <- getAmode plat width mem + case width of + w | w `elem` [W8, W16, W32, W64] -> + -- Load without sign-extension. + pure (Any format (\dst -> + addr_code `snocOL` + LDU format (OpReg width dst) (OpAddr addr)) + ) + _ -> pprPanic ("Unknown width to load: " ++ show width) (pdoc plat expr) + + CmmStackSlot _ _ -> pprPanic "getRegister' (CmmStackSlot): " (pdoc plat expr) + + CmmReg reg -> return (Fixed (cmmTypeFormat (cmmRegType reg)) + (getRegisterReg plat reg) + nilOL + ) + + CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do + getRegister' config plat + $ CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] + where + width = typeWidth (cmmRegType reg) + CmmRegOff reg off -> do + (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) + (reg, _format, code) <- getSomeReg $ CmmReg reg + return $ Any (intFormat width) ( \dst -> + off_code `appOL` + code `snocOL` + ADD (OpReg W64 dst) (OpReg width reg) (OpReg width off_r) + ) + where + width = typeWidth (cmmRegType reg) + + -- Handle MO_RelaxedRead as a normal CmmLoad, to allow + -- non-trivial addressing modes to be used. + CmmMachOp (MO_RelaxedRead w) [e] -> + getRegister (CmmLoad e (cmmBits w) NaturallyAligned) + + -- for MachOps, see GHC.Cmm.MachOp + -- For CmmMachOp, see GHC.Cmm.Expr + CmmMachOp op [e] -> do + (reg, format, code) <- getSomeReg e + case op of + MO_Not w -> return $ Any (intFormat w) $ \dst -> + code `appOL` + -- pseudo instruction `not dst rd` is `nor dst, r0, rd` + truncateReg (formatToWidth format) W64 reg `snocOL` + -- At this point an 8- or 16-bit value would be zero-extended + -- to 64-bits. Truncate back down the final width. + ann (text "not") (NOR (OpReg W64 dst) (OpReg W64 reg) zero) `appOL` + truncateReg W64 w dst + + MO_S_Neg w -> negate code w reg + MO_F_Neg w -> return $ Any (floatFormat w) (\dst -> code `snocOL` FNEG (OpReg w dst) (OpReg w reg)) + + -- Floating convertion oprations + -- Float -> Float + MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` FCVT (OpReg to dst) (OpReg from reg)) + + -- Signed int -> Float + MO_SF_Round from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` SCVTF (OpReg to dst) (OpReg from reg)) + + -- Float -> Signed int + MO_FS_Truncate from to | from == W32 -> do + tmp <- getNewRegNat FF32 + return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from tmp) (OpReg from reg)) + + MO_FS_Truncate from to | from == W64-> do + tmp <- getNewRegNat FF64 + return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from tmp) (OpReg from reg)) + + -- unsigned int -> unsigned int + MO_UU_Conv from to -> return $ Any (intFormat to) (\dst -> + code `snocOL` BSTRPICK II64 (OpReg W64 dst) (OpReg W64 reg) (OpImm (ImmInt (widthToInt (min from to) - 1))) (OpImm (ImmInt 0)) + ) + + -- Signed int -> Signed int + MO_SS_Conv from to -> ss_conv from to reg code + + -- int -> int + MO_XX_Conv _from to -> swizzleRegisterRep (intFormat to) <$> getRegister e + + MO_WF_Bitcast w -> return $ Any (floatFormat w) (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg)) + MO_FW_Bitcast w -> return $ Any (intFormat w) (\dst -> code `snocOL` MOV (OpReg w dst) (OpReg w reg)) + + x -> pprPanic ("getRegister' (monadic CmmMachOp): " ++ show x) (pdoc plat expr) + where + -- In the case of 32- or 16- or 8-bit values we need to sign-extend to 64-bits + negate code w reg + | w `elem` [W8, W16] = do + return $ Any (intFormat w) $ \dst -> + code `snocOL` + EXT (OpReg W64 reg) (OpReg w reg) `snocOL` + NEG (OpReg W64 dst) (OpReg W64 reg) `appOL` + truncateReg W64 w dst + | otherwise = do + return $ Any (intFormat w) $ \dst -> + code `snocOL` + NEG (OpReg W64 dst) (OpReg w reg) + + ss_conv from to reg code + | from `elem` [W8, W16] || to `elem` [W8, W16] = do + return $ Any (intFormat to) $ \dst -> + code `snocOL` + EXT (OpReg W64 dst) (OpReg (min from to) reg) `appOL` + -- At this point an 8- or 16-bit value would be sign-extended + -- to 64-bits. Truncate back down the final width. + truncateReg W64 to dst + | from == W32 && to == W64 = do + return $ Any (intFormat to) $ \dst -> + code `snocOL` + SLL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt 0)) + | from == to = do + return $ Any (intFormat from) $ \dst -> + code `snocOL` MOV (OpReg from dst) (OpReg from reg) + | otherwise = do + return $ Any (intFormat to) $ \dst -> + code `appOL` + signExtend from W64 reg dst `appOL` + truncateReg W64 to dst + + +-- Dyadic machops: + -- + -- The general idea is: + -- compute x <- x + -- compute x <- y + -- OP x, x, x + -- + -- TODO: for now we'll only implement the 64bit versions. And rely on the + -- fallthrough to alert us if things go wrong! + -- OPTIMIZATION WARNING: Dyadic CmmMachOp destructuring + -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg + CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' + CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' + + CmmMachOp (MO_Add w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do + if w `elem` [W8, W16] + then do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + ADD (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + else do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ADD (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_Sub w) [x, CmmLit (CmmInt n _)] | fitsInNbits 12 (fromIntegral n) -> do + if w `elem` [W8, W16] + then do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SUB (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + else do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SUB (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_U_Quot w) [x, y] + | w `elem` [W8, W16] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (DIVU (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + -- 2. Shifts. + CmmMachOp (MO_Shl w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL` + SLL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y) + ) + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (SLL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- MO_S_Shr: signed-shift-right + CmmMachOp (MO_S_Shr w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (EXT (OpReg W64 reg_x) (OpReg w reg_x)) `snocOL` + EXT (OpReg W64 reg_y) (OpReg w reg_y) `snocOL` + SRA (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y) + ) + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (SRA (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- MO_U_Shr: unsigned-shift-right + CmmMachOp (MO_U_Shr w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16], 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + CmmLit (CmmInt n _) | 0 <= n, n < fromIntegral (widthInBits w) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + _ | w `elem` [W8, W16] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (SRL (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- 3. Logic &&, || + -- andi Instr's Imm-operand is zero-extended. + CmmMachOp (MO_And w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + _ | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (AND (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- ori Instr's Imm-operand is zero-extended. + CmmMachOp (MO_Or w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + _ | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (OR (OpReg W64 dst) (OpReg w reg_x) (OpReg w reg_y)) + ) + + -- xori Instr's Imm-operand is zero-extended. + CmmMachOp (MO_Xor w) [x, y] -> + case y of + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32], (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + + CmmLit (CmmInt n _) | (n :: Integer) >= 0, (n :: Integer) <= 4095 -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (XOR (OpReg W64 dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + + CmmLit (CmmInt n _) | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 tmp) + ) + + CmmLit (CmmInt n _) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + tmp <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (MOV (OpReg W64 tmp) (OpImm (ImmInteger n))) `snocOL` + XOR (OpReg W64 dst) (OpReg w reg_x) (OpReg W64 tmp) + ) + + _ | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + _ -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (XOR (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + -- CSET commands register operand being W64. + CmmMachOp (MO_Eq w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET EQ (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_Ne w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET NE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_S_Lt w) [x, CmmLit (CmmInt n _)] + | w `elem` [W8, W16, W32] + , fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + signExtend w W64 reg_x reg_x `snocOL` + annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + | fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLT (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_U_Lt w) [x, CmmLit (CmmInt n _)] + | w `elem` [W8, W16, W32] + , fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + truncateReg w W64 reg_x `snocOL` + annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n))) + ) + | fitsInNbits 12 (fromIntegral n) -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) ( \dst -> code_x `snocOL` annExpr expr (SSLTU (OpReg W64 dst) (OpReg W64 reg_x) (OpImm (ImmInteger n)))) + + CmmMachOp (MO_S_Lt w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET SLT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_S_Le w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET SLE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_S_Ge w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET SGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_S_Gt w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + signExtend w W64 reg_x reg_x `appOL` + signExtend w W64 reg_y reg_y `snocOL` + annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET SGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_U_Lt w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET ULT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_U_Le w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET ULE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_U_Ge w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET UGE (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + CmmMachOp (MO_U_Gt w) [x, y] + | w `elem` [W8, W16, W32] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `appOL` + truncateReg w W64 reg_x `appOL` + truncateReg w W64 reg_y `snocOL` + annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + | otherwise -> do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) ( \dst -> + code_x `appOL` + code_y `snocOL` + annExpr expr (CSET UGT (OpReg W64 dst) (OpReg W64 reg_x) (OpReg W64 reg_y)) + ) + + + -- Generic binary case. + CmmMachOp op [x, y] -> do + let + -- A (potentially signed) integer operation. + -- In the case of 8-, 16- and 32-bit signed arithmetic we must first + -- sign-extend all arguments to 64-bits. + -- TODO: can be simplified. + intOp is_signed w op = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + let w' = W64 + -- This is the width of the registers on which the operation + -- should be performed. + if not is_signed + then return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + -- zero-extend both operands + truncateReg (formatToWidth format_x) w' reg_x `appOL` + truncateReg (formatToWidth format_y) w' reg_y `snocOL` + op (OpReg w' dst) (OpReg w' reg_x) (OpReg w' reg_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width + else return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + -- sign-extend both operands + signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` + signExtend (formatToWidth format_x) W64 reg_y reg_y `snocOL` + op (OpReg w' dst) (OpReg w' reg_x) (OpReg w' reg_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width + + floatOp w op = do + (reg_fx, format_x, code_fx) <- getFloatReg x + (reg_fy, format_y, code_fy) <- getFloatReg y + massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatOp: non-float" + return $ Any (floatFormat w) (\dst -> code_fx `appOL` code_fy `appOL` op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy)) + + -- need a special one for conditionals, as they return ints + floatCond w op = do + (reg_fx, format_x, code_fx) <- getFloatReg x + (reg_fy, format_y, code_fy) <- getFloatReg y + massertPpr (isFloatFormat format_x && isFloatFormat format_y) $ text "floatCond: non-float" + return $ Any (intFormat w) (\dst -> code_fx `appOL` code_fy `appOL` op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy)) + + case op of + -- Integer operations + -- Add/Sub should only be Integer Options. + MO_Add w -> intOp False w (\d x y -> annExpr expr (ADD d x y)) + MO_Sub w -> intOp False w (\d x y -> annExpr expr (SUB d x y)) + + -- Signed multiply/divide/remain + MO_Mul w -> intOp True w (\d x y -> annExpr expr (MUL d x y)) + MO_S_MulMayOflo w -> do_mul_may_oflo w x y + + MO_S_Quot w -> intOp True w (\d x y -> annExpr expr (DIV d x y)) + MO_S_Rem w -> intOp True w (\d x y -> annExpr expr (MOD d x y)) + + -- Unsigned divide/remain + MO_U_Quot w -> intOp False w (\d x y -> annExpr expr (DIVU d x y)) + MO_U_Rem w -> intOp False w (\d x y -> annExpr expr (MODU d x y)) + + -- Floating point arithmetic + MO_F_Add w -> floatOp w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_F_Sub w -> floatOp w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_F_Mul w -> floatOp w (\d x y -> unitOL $ annExpr expr (MUL d x y)) + MO_F_Quot w -> floatOp w (\d x y -> unitOL $ annExpr expr (DIV d x y)) + MO_F_Min w -> floatOp w (\d x y -> unitOL $ annExpr expr (FMIN d x y)) + MO_F_Max w -> floatOp w (\d x y -> unitOL $ annExpr expr (FMAX d x y)) + + -- Floating point comparison + MO_F_Eq w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET EQ d x y)) + MO_F_Ne w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET NE d x y)) + MO_F_Ge w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FGE d x y)) + MO_F_Le w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FLE d x y)) + MO_F_Gt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FGT d x y)) + MO_F_Lt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET FLT d x y)) + + op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> pdoc plat expr + + -- Generic ternary case. + CmmMachOp op [x, y, z] -> + case op of + + -- Floating-point fused multiply-add operations + MO_FMA var l w + | l == 1 + -> case var of + FMAdd -> float3Op w (\d n m a -> unitOL $ FMA FMAdd d n m a) + FMSub -> float3Op w (\d n m a -> unitOL $ FMA FMSub d n m a) + FNMAdd -> float3Op w (\d n m a -> unitOL $ FMA FNMSub d n m a) + FNMSub -> float3Op w (\d n m a -> unitOL $ FMA FNMAdd d n m a) + | otherwise + -> sorry "The RISCV64 backend does not (yet) support vectors." + + _ -> pprPanic "getRegister' (unhandled ternary CmmMachOp): " $ (pprMachOp op) <+> text "in" <+> (pdoc plat expr) + + where + float3Op w op = do + (reg_fx, format_x, code_fx) <- getFloatReg x + (reg_fy, format_y, code_fy) <- getFloatReg y + (reg_fz, format_z, code_fz) <- getFloatReg z + massertPpr (isFloatFormat format_x && isFloatFormat format_y && isFloatFormat format_z) $ + text "float3Op: non-float" + pure $ + Any (floatFormat w) $ \ dst -> + code_fx `appOL` + code_fy `appOL` + code_fz `appOL` + op (OpReg w dst) (OpReg w reg_fx) (OpReg w reg_fy) (OpReg w reg_fz) + + CmmMachOp _op _xs + -> pprPanic "getRegister' (variadic CmmMachOp): " (pdoc plat expr) + + where + -- N.B. MUL does not set the overflow flag. + -- Return 0 when the operation cannot overflow, /= 0 otherwise + do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + do_mul_may_oflo W64 x y = do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + lo <- getNewRegNat II64 + hi <- getNewRegNat II64 + return $ Any (intFormat W64) (\dst -> + code_x `appOL` + code_y `snocOL` + MULH (OpReg W64 hi) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL` + MUL (OpReg W64 lo) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL` + SRA (OpReg W64 lo) (OpReg W64 lo) (OpImm (ImmInt 63)) `snocOL` + CSET NE (OpReg W64 dst) (OpReg W64 hi) (OpReg W64 lo) + ) + + do_mul_may_oflo W32 x y = do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + tmp1 <- getNewRegNat II64 + tmp2 <- getNewRegNat II64 + return $ Any (intFormat W32) (\dst -> + code_x `appOL` + code_y `snocOL` + MULW (OpReg W64 tmp1) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL` + ADD (OpReg W64 tmp2) (OpReg W32 tmp1) (OpImm (ImmInt 0)) `snocOL` + CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) + ) + + -- General case + do_mul_may_oflo w x y = do + -- Assert: 8bit * 8bit cannot overflow 16bit, and so on. + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + tmp1 <- getNewRegNat II64 + tmp2 <- getNewRegNat II64 + let width_x = formatToWidth format_x + width_y = formatToWidth format_y + extend dst src = + case w of + W8 -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0)) + W16 -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0)) + _ -> panic "Must be in [W8, W16, W32]!" + extract width dst src = + case width of + W8 -> EXT (OpReg W64 dst) (OpReg W8 src) + W16 -> EXT (OpReg W64 dst) (OpReg W16 src) + W32 -> SLL (OpReg W64 dst) (OpReg W32 src) (OpImm (ImmInt 0)) + _ -> panic "Must be in [W8, W16, W32]!" + + case w of + w | (width_x < w) && (width_y < w) -> + return $ Any (intFormat w) ( \dst -> + unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInt 0))) + ) + w | w <= W32 && width_x <= W32 && width_y <= W32 -> + return $ Any (intFormat W32) (\dst -> + code_x `appOL` + code_y `appOL` + -- signExtend [W8, W16] register to W64 and then SLL + -- nil for W32 + signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` + signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` + extend reg_x reg_x `snocOL` + extend reg_y reg_y `snocOL` + -- 64-bits MUL + MUL (OpReg W64 tmp1) (OpReg W64 reg_x) (OpReg W64 reg_y) `snocOL` + -- extract valid result via result's width + -- slli.w for W32, otherwise ext.w.[b, h] + extract w tmp2 tmp1 `snocOL` + CSET NE (OpReg W64 dst) (OpReg W64 tmp1) (OpReg W64 tmp2) + ) + + -- Should it be happened? + _ -> + return $ Any (intFormat w) ( \dst -> + unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInt 1)))) + +-- Sign-extend the value in the given register from width @w@ +-- up to width @w'@. +-- TODO: Is there room for optimization? +signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr +signExtend w w' r r' + | w > w' = pprPanic "Sign-extend Error: not a sign extension, but a truncation." $ ppr w <> text "->" <+> ppr w' + | w > W64 || w' > W64 = pprPanic "Sign-extend Error: from/to register width greater than 64-bit." $ ppr w <> text "->" <+> ppr w' + | w == W64 && w' == W64 && r == r' = nilOL + | w == W32 && w' == W64 = unitOL $ SLL (OpReg W64 r') (OpReg w r) (OpImm (ImmInt 0)) + -- Sign-extend W8 and W16 to W64. + | w `elem` [W8, W16] = unitOL $ EXT (OpReg W64 r') (OpReg w r) + | w == w' = unitOL $ MOV (OpReg w' r') (OpReg w r) + | otherwise = pprPanic "signExtend: Unexpected width: " $ ppr w <> text "->" <+> ppr w' + +-- | Instructions to truncate the value in the given register from width @w@ +-- down to width @w'@. +truncateReg :: Width -> Width -> Reg -> OrdList Instr +truncateReg w w' r + | w > W64 || w' > W64 = pprPanic "Tructate Error: from/to register width greater than 64-bit." $ ppr w <> text "->" <+> ppr w' + | w == w' = nilOL + | w /= w' = toOL + [ + ann + (text "truncateReg: " <+> ppr r <+> ppr w <> text "->" <> ppr w') + (BSTRPICK II64 (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) (OpImm (ImmInt 0))) + ] + | otherwise = pprPanic "truncateReg: Unexpected width: " $ ppr w <> text "->" <+> ppr w' + where + shift = (min (widthInBits w) (widthInBits w')) - 1 + +-- The 'Amode' type: Memory addressing modes passed up the tree. +data Amode = Amode AddrMode InstrBlock + +-- | Provide the value of a `CmmExpr` with an `Amode` +-- N.B. this function should be used to provide operands to load and store +-- instructions with signed 12bit wide immediates (S & I types). For other +-- immediate sizes and formats (e.g. B type uses multiples of 2) this function +-- would need to be adjusted. +getAmode :: Platform + -> Width -- ^ width of loaded value + -> CmmExpr + -> NatM Amode + +-- LD/ST: Immediate can be represented with 12bits +getAmode platform w (CmmRegOff reg off) + | w <= W64, fitsInNbits 12 (fromIntegral off) + = return $ Amode (AddrRegImm reg' off') nilOL + where reg' = getRegisterReg platform reg + off' = ImmInt off + +-- For Stores we often see something like this: +-- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2) +-- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] +-- for `n` in range. +getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) + | fitsInNbits 12 (fromIntegral off) + = do (reg, _format, code) <- getSomeReg expr + return $ Amode (AddrRegImm reg (ImmInteger off)) code + +getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) + | fitsInNbits 12 (fromIntegral (-off)) + = do (reg, _format, code) <- getSomeReg expr + return $ Amode (AddrRegImm reg (ImmInteger (-off))) code + +-- Generic case +getAmode _platform _ expr + = do (reg, _format, code) <- getSomeReg expr + return $ Amode (AddrReg reg) code + +-- ----------------------------------------------------------------------------- +-- Generating assignments + +-- Assignments are really at the heart of the whole code generation +-- business. Almost all top-level nodes of any real importance are +-- assignments, which correspond to loads, stores, or register +-- transfers. If we're really lucky, some of the register transfers +-- will go away, because we can use the destination register to +-- complete the code generation for the right hand side. This only +-- fails when the right hand side is forced into a fixed register +-- (e.g. the result of a call). + +assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock + +assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock + +assignMem_IntCode rep addrE srcE + = do + (src_reg, _format, code) <- getSomeReg srcE + platform <- getPlatform + let w = formatToWidth rep + Amode addr addr_code <- getAmode platform w addrE + return $ COMMENT (text "CmmStore" <+> parens (text (show addrE)) <+> parens (text (show srcE))) + `consOL` (code + `appOL` addr_code + `snocOL` ST rep (OpReg w src_reg) (OpAddr addr) + ) + +assignReg_IntCode _ reg src + = do + platform <- getPlatform + let dst = getRegisterReg platform reg + r <- getRegister src + return $ case r of + Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst + Fixed format freg fcode -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` + (fcode `snocOL` + MOV (OpReg (formatToWidth format) dst) (OpReg (formatToWidth format) freg) + ) + +-- Let's treat Floating point stuff +-- as integer code for now. Opaque. +assignMem_FltCode = assignMem_IntCode +assignReg_FltCode = assignReg_IntCode + +-- Jumps +genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock +genJump expr = do + case expr of + (CmmLit (CmmLabel lbl)) -> do + return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TLabel lbl))) + (CmmLit (CmmBlock bid)) -> do + return $ unitOL (annExpr expr (TAIL36 (OpReg W64 tmpReg) (TBlock bid))) + _ -> do + (target, _format, code) <- getSomeReg expr + -- I'd like to do more. + return $ COMMENT (text "genJump for unknow expr: " <+> (text (show expr))) `consOL` + (code `appOL` + unitOL (annExpr expr (J (TReg target))) + ) + +-- ----------------------------------------------------------------------------- +-- Unconditional branches +genBranch :: BlockId -> NatM InstrBlock +genBranch = return . toOL . mkJumpInstr + +-- ----------------------------------------------------------------------------- +-- Conditional branches +genCondJump + :: BlockId + -> CmmExpr + -> NatM InstrBlock +genCondJump bid expr = do + case expr of + -- Optimized == 0 case. + CmmMachOp (MO_Eq W64) [x, CmmLit (CmmInt 0 _)] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ + code_x `snocOL` + BEQZ (OpReg W64 reg_x) (TBlock bid) + CmmMachOp (MO_Eq w) [x, CmmLit (CmmInt 0 _)] + | w `elem` [W8, W16, W32] -> do + (reg_x, format_x, code_x) <- getSomeReg x + return $ + code_x `appOL` + signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` + BEQZ (OpReg W64 reg_x) (TBlock bid) + + -- Optimized /= 0 case. + CmmMachOp (MO_Ne W64) [x, CmmLit (CmmInt 0 _)] -> do + (reg_x, _format_x, code_x) <- getSomeReg x + return $ code_x `snocOL` (annExpr expr (BNEZ (OpReg W64 reg_x) (TBlock bid))) + CmmMachOp (MO_Ne w) [x, CmmLit (CmmInt 0 _)] + | w `elem` [W8, W16, W32] -> do + (reg_x, format_x, code_x) <- getSomeReg x + return $ + code_x `appOL` + signExtend (formatToWidth format_x) W64 reg_x reg_x `snocOL` + BNEZ (OpReg W64 reg_x) (TBlock bid) + + -- Generic case. + CmmMachOp mop [x, y] -> do + let ubcond w cmp = do + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + return $ case w of + w | w `elem` [W8, W16, W32] -> + code_x `appOL` + truncateReg (formatToWidth format_x) W64 reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) W64 reg_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + _ -> + code_x `appOL` + code_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + + sbcond w cmp = do + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + return $ case w of + w | w `elem` [W8, W16, W32] -> + code_x `appOL` + signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` + code_y `appOL` + signExtend (formatToWidth format_y) W64 reg_y reg_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + _ -> + code_x `appOL` + code_y `snocOL` + BCOND1 cmp (OpReg W64 reg_x) (OpReg W64 reg_y) (TBlock bid) + + fbcond w cmp = do + (reg_fx, _format_fx, code_fx) <- getFloatReg x + (reg_fy, _format_fy, code_fy) <- getFloatReg y + rst <- OpReg W64 <$> getNewRegNat II64 + oneReg <- OpReg W64 <$> getNewRegNat II64 + return $ + code_fx `appOL` + code_fy `snocOL` + CSET cmp rst (OpReg w reg_fx) (OpReg w reg_fy) `snocOL` + MOV oneReg (OpImm (ImmInt 1)) `snocOL` + BCOND1 EQ rst oneReg (TBlock bid) + + + case mop of + MO_F_Eq w -> fbcond w EQ + MO_F_Ne w -> fbcond w NE + MO_F_Gt w -> fbcond w FGT + MO_F_Ge w -> fbcond w FGE + MO_F_Lt w -> fbcond w FLT + MO_F_Le w -> fbcond w FLE + MO_Eq w -> sbcond w EQ + MO_Ne w -> sbcond w NE + MO_S_Gt w -> sbcond w SGT + MO_S_Ge w -> sbcond w SGE + MO_S_Lt w -> sbcond w SLT + MO_S_Le w -> sbcond w SLE + MO_U_Gt w -> ubcond w UGT + MO_U_Ge w -> ubcond w UGE + MO_U_Lt w -> ubcond w ULT + MO_U_Le w -> ubcond w ULE + _ -> pprPanic "LA64.genCondJump:case mop: " (text $ show expr) + + _ -> pprPanic "LA64.genCondJump: " (text $ show expr) + +-- | Generate conditional branching instructions +-- This is basically an "if with else" statement. +genCondBranch :: + BlockId -> + BlockId -> + CmmExpr -> + NatM InstrBlock +genCondBranch true false expr = do + b1 <- genCondJump true expr + b2 <- genBranch false + return (b1 `appOL` b2) + +-- ----------------------------------------------------------------------------- +{- +Generating C calls + +Generate a call to a C function: + +GARs: 8 general-purpose registers $a0 - $a7, where $a0 and $a1 are also used for +integral values. +FARs: 8 floating-point registers $fa0 - $fa7, where $fa0 and $fa1 are also used +for returning values. + +An argument is passed using the stack only when no appropriate argument register +is available. + +Subroutines should ensure that the initial values of the general-purpose registers +$s0 - $s9 and floating-point registers $fs0 - $fs7 are preserved across the call. + +At the entry of a procedure call, the return address of the call site is stored +in $ra. A branch jump to this address should be the last instruction executed in +the called procedure. + +The on-stack part of the structure and scalar arguments are aligned to the greater +of the type alignment and GRLEN bits, except when this alignment is larger than + the 16-byte stack alignment. In this case, the part of the argument should be +16-byte-aligned. + +In a procedure call, GARs / FARs are generally only used for passing non-floating +-point / floating-point argument data, respectively. However, the floating-point +member of a structure or union argument, or a vector/floating-point argument +wider than FRLEN may be passed in a GAR. +-} + +genCCall + :: ForeignTarget -- function to call + -> [CmmFormal] -- where to put the result + -> [CmmActual] -- arguments (of mixed type) + -> NatM InstrBlock + +-- TODO: Specialize where we can. +-- Generic impl +genCCall target dest_regs arg_regs = do + case target of + -- The target :: ForeignTarget call can either + -- be a foreign procedure with an address expr + -- and a calling convention. + ForeignTarget expr _cconv -> do + (call_target, call_target_code) <- case expr of + -- if this is a label, let's just directly to it. + (CmmLit (CmmLabel lbl)) -> pure (TLabel lbl, nilOL) + -- if it's not a label, let's compute the expression into a + -- register and jump to that. + _ -> do + (reg, _format, reg_code) <- getSomeReg expr + pure (TReg reg, reg_code) + -- compute the code and register logic for all arg_regs. + -- this will give us the format information to match on. + arg_regs' <- mapM getSomeReg arg_regs + + -- Now this is stupid. Our Cmm expressions doesn't carry the proper sizes + -- so while in Cmm we might get W64 incorrectly for an int, that is W32 in + -- STG; this thenn breaks packing of stack arguments, if we need to pack + -- for the pcs, e.g. darwinpcs. Option one would be to fix the Int type + -- in Cmm proper. Option two, which we choose here is to use extended Hint + -- information to contain the size information and use that when packing + -- arguments, spilled onto the stack. + let (_res_hints, arg_hints) = foreignTargetHints target + arg_regs'' = zipWith (\(r, f, c) h -> (r,f,h,c)) arg_regs' arg_hints + + (stackSpaceWords, passRegs, passArgumentsCode) <- passArguments allGpArgRegs allFpArgRegs arg_regs'' 0 [] nilOL + + readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL + + let moveStackDown 0 = toOL [ PUSH_STACK_FRAME + , DELTA (-16) + ] + moveStackDown i | odd i = moveStackDown (i + 1) + moveStackDown i = toOL [ PUSH_STACK_FRAME + , SUB (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i))) + , DELTA (-8 * i - 16) + ] + moveStackUp 0 = toOL [ POP_STACK_FRAME + , DELTA 0 + ] + moveStackUp i | odd i = moveStackUp (i + 1) + moveStackUp i = toOL [ ADD (OpReg W64 (spMachReg)) (OpReg W64 (spMachReg)) (OpImm (ImmInt (8 * i))) + , POP_STACK_FRAME + , DELTA 0 + ] + + let code = + call_target_code -- compute the label (possibly into a register) + `appOL` moveStackDown (stackSpaceWords) + `appOL` passArgumentsCode -- put the arguments into x0, ... + `snocOL` CALL call_target passRegs -- branch and link (C calls aren't tail calls, but return) + `appOL` readResultsCode -- parse the results into registers + `appOL` moveStackUp (stackSpaceWords) + return code + + PrimTarget MO_F32_Fabs + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W32 (\d x -> unitOL $ FABS d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F32_Fabs" + PrimTarget MO_F64_Fabs + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W64 (\d x -> unitOL $ FABS d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F64_Fabs" + + PrimTarget MO_F32_Sqrt + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W32 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F32_Sqrt" + PrimTarget MO_F64_Sqrt + | [arg_reg] <- arg_regs, [dest_reg] <- dest_regs -> + unaryFloatOp W64 (\d x -> unitOL $ FSQRT d x) arg_reg dest_reg + | otherwise -> panic "mal-formed MO_F64_Sqrt" + + PrimTarget (MO_Clz w) + | w `elem` [W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `snocOL` + CLZ (OpReg w dst_reg) (OpReg w reg_x) + ) + | w `elem` [W8, W16], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `appOL` toOL + [ + MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), + SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt (31-shift))), + SLL (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (32-shift))), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + CLZ (OpReg W64 dst_reg) (OpReg W32 dst_reg) + ] + ) + | otherwise -> unsupported (MO_Clz w) + where + shift = widthToInt w + + PrimTarget (MO_Ctz w) + | w `elem` [W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `snocOL` + CTZ (OpReg w dst_reg) (OpReg w reg_x) + ) + | w `elem` [W8, W16], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _format_x, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + return ( code_x `appOL` toOL + [ + MOV (OpReg W64 dst_reg) (OpImm (ImmInt 1)), + SLL (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpImm (ImmInt shift)), + BSTRPICK II64 (OpReg W64 reg_x) (OpReg W64 reg_x) (OpImm (ImmInt (shift-1))) (OpImm (ImmInt 0)), + OR (OpReg W64 dst_reg) (OpReg W64 dst_reg) (OpReg W64 reg_x), + CTZ (OpReg W64 dst_reg) (OpReg W64 dst_reg) + ] + ) + | otherwise -> unsupported (MO_Ctz w) + where + shift = (widthToInt w) + + -- mop :: CallishMachOp (see GHC.Cmm.MachOp) + PrimTarget mop -> do + -- We'll need config to construct forien targets + case mop of + -- 64 bit float ops + MO_F64_Pwr -> mkCCall "pow" + + MO_F64_Sin -> mkCCall "sin" + MO_F64_Cos -> mkCCall "cos" + MO_F64_Tan -> mkCCall "tan" + + MO_F64_Sinh -> mkCCall "sinh" + MO_F64_Cosh -> mkCCall "cosh" + MO_F64_Tanh -> mkCCall "tanh" + + MO_F64_Asin -> mkCCall "asin" + MO_F64_Acos -> mkCCall "acos" + MO_F64_Atan -> mkCCall "atan" + + MO_F64_Asinh -> mkCCall "asinh" + MO_F64_Acosh -> mkCCall "acosh" + MO_F64_Atanh -> mkCCall "atanh" + + MO_F64_Log -> mkCCall "log" + MO_F64_Log1P -> mkCCall "log1p" + MO_F64_Exp -> mkCCall "exp" + MO_F64_ExpM1 -> mkCCall "expm1" + + -- 32 bit float ops + MO_F32_Pwr -> mkCCall "powf" + + MO_F32_Sin -> mkCCall "sinf" + MO_F32_Cos -> mkCCall "cosf" + MO_F32_Tan -> mkCCall "tanf" + MO_F32_Sinh -> mkCCall "sinhf" + MO_F32_Cosh -> mkCCall "coshf" + MO_F32_Tanh -> mkCCall "tanhf" + MO_F32_Asin -> mkCCall "asinf" + MO_F32_Acos -> mkCCall "acosf" + MO_F32_Atan -> mkCCall "atanf" + MO_F32_Asinh -> mkCCall "asinhf" + MO_F32_Acosh -> mkCCall "acoshf" + MO_F32_Atanh -> mkCCall "atanhf" + MO_F32_Log -> mkCCall "logf" + MO_F32_Log1P -> mkCCall "log1pf" + MO_F32_Exp -> mkCCall "expf" + MO_F32_ExpM1 -> mkCCall "expm1f" + + -- 64-bit primops + MO_I64_ToI -> mkCCall "hs_int64ToInt" + MO_I64_FromI -> mkCCall "hs_intToInt64" + MO_W64_ToW -> mkCCall "hs_word64ToWord" + MO_W64_FromW -> mkCCall "hs_wordToWord64" + MO_x64_Neg -> mkCCall "hs_neg64" + MO_x64_Add -> mkCCall "hs_add64" + MO_x64_Sub -> mkCCall "hs_sub64" + MO_x64_Mul -> mkCCall "hs_mul64" + MO_I64_Quot -> mkCCall "hs_quotInt64" + MO_I64_Rem -> mkCCall "hs_remInt64" + MO_W64_Quot -> mkCCall "hs_quotWord64" + MO_W64_Rem -> mkCCall "hs_remWord64" + MO_x64_And -> mkCCall "hs_and64" + MO_x64_Or -> mkCCall "hs_or64" + MO_x64_Xor -> mkCCall "hs_xor64" + MO_x64_Not -> mkCCall "hs_not64" + MO_x64_Shl -> mkCCall "hs_uncheckedShiftL64" + MO_I64_Shr -> mkCCall "hs_uncheckedIShiftRA64" + MO_W64_Shr -> mkCCall "hs_uncheckedShiftRL64" + MO_x64_Eq -> mkCCall "hs_eq64" + MO_x64_Ne -> mkCCall "hs_ne64" + MO_I64_Ge -> mkCCall "hs_geInt64" + MO_I64_Gt -> mkCCall "hs_gtInt64" + MO_I64_Le -> mkCCall "hs_leInt64" + MO_I64_Lt -> mkCCall "hs_ltInt64" + MO_W64_Ge -> mkCCall "hs_geWord64" + MO_W64_Gt -> mkCCall "hs_gtWord64" + MO_W64_Le -> mkCCall "hs_leWord64" + MO_W64_Lt -> mkCCall "hs_ltWord64" + + -- Conversion + MO_UF_Conv w -> mkCCall (word2FloatLabel w) + + -- Optional MachOps + -- These are enabled/disabled by backend flags: GHC.StgToCmm.Config + MO_S_Mul2 _w -> unsupported mop + MO_S_QuotRem _w -> unsupported mop + MO_U_QuotRem _w -> unsupported mop + MO_U_QuotRem2 _w -> unsupported mop + MO_Add2 _w -> unsupported mop + MO_AddWordC _w -> unsupported mop + MO_SubWordC _w -> unsupported mop + MO_AddIntC _w -> unsupported mop + MO_SubIntC _w -> unsupported mop + MO_U_Mul2 _w -> unsupported mop + + MO_VS_Quot {} -> unsupported mop + MO_VS_Rem {} -> unsupported mop + MO_VU_Quot {} -> unsupported mop + MO_VU_Rem {} -> unsupported mop + MO_I64X2_Min -> unsupported mop + MO_I64X2_Max -> unsupported mop + MO_W64X2_Min -> unsupported mop + MO_W64X2_Max -> unsupported mop + + -- Memory Ordering + -- A hint value of 0 is mandatory by default, and it indicates a fully functional synchronization barrier. + -- Only after all previous load/store access operations are completely executed, the DBAR 0 instruction can be executed; + -- and only after the execution of DBAR 0 is completed, all subsequent load/store access operations can be executed. + + MO_AcquireFence -> pure (unitOL (DBAR Hint0)) + MO_ReleaseFence -> pure (unitOL (DBAR Hint0)) + MO_SeqCstFence -> pure (unitOL (DBAR Hint0)) + + MO_Touch -> pure nilOL -- Keep variables live (when using interior pointers) + -- Prefetch + MO_Prefetch_Data _n -> pure nilOL -- Prefetch hint. + + -- Memory copy/set/move/cmp, with alignment for optimization + + -- TODO Optimize and use e.g. quad registers to move memory around instead + -- of offloading this to memcpy. For small memcpys we can utilize + -- the 128bit quad registers in NEON to move block of bytes around. + -- Might also make sense of small memsets? Use xzr? What's the function + -- call overhead? + MO_Memcpy _align -> mkCCall "memcpy" + MO_Memset _align -> mkCCall "memset" + MO_Memmove _align -> mkCCall "memmove" + MO_Memcmp _align -> mkCCall "memcmp" + + MO_SuspendThread -> mkCCall "suspendThread" + MO_ResumeThread -> mkCCall "resumeThread" + + MO_PopCnt w -> mkCCall (popCntLabel w) + MO_Pdep w -> mkCCall (pdepLabel w) + MO_Pext w -> mkCCall (pextLabel w) + MO_BSwap w -> mkCCall (bSwapLabel w) + MO_BRev w -> mkCCall (bRevLabel w) + + -- or a possibly side-effecting machine operation + mo@(MO_AtomicRead w ord) + | [p_reg] <- arg_regs + , [dst_reg] <- dest_regs -> do + (p, _fmt_p, code_p) <- getSomeReg p_reg + platform <- getPlatform + let instrs = case ord of + MemOrderRelaxed -> unitOL $ ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)) + + MemOrderAcquire -> toOL [ + ann moDescr (LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)), + DBAR Hint0 + ] + MemOrderSeqCst -> toOL [ + ann moDescr (DBAR Hint0), + LD (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p), + DBAR Hint0 + ] + _ -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo + dst = getRegisterReg platform (CmmLocal dst_reg) + moDescr = (text . show) mo + code = code_p `appOL` instrs + pure code + | otherwise -> panic "mal-formed AtomicRead" + + mo@(MO_AtomicWrite w ord) + | [p_reg, val_reg] <- arg_regs -> do + (p, _fmt_p, code_p) <- getSomeReg p_reg + (val, fmt_val, code_val) <- getSomeReg val_reg + let instrs = case ord of + MemOrderRelaxed -> unitOL $ ann moDescr (ST fmt_val (OpReg w val) (OpAddr $ AddrReg p)) + MemOrderRelease -> toOL [ + ann moDescr (DBAR Hint0), + ST fmt_val (OpReg w val) (OpAddr $ AddrReg p) + ] + MemOrderSeqCst -> toOL [ + ann moDescr (DBAR Hint0), + ST fmt_val (OpReg w val) (OpAddr $ AddrReg p), + DBAR Hint0 + ] + _ -> panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo + moDescr = (text . show) mo + code = + code_p `appOL` + code_val `appOL` + instrs + pure code + | otherwise -> panic "mal-formed AtomicWrite" + + MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop) + MO_Cmpxchg w -> mkCCall (cmpxchgLabel w) + MO_Xchg w -> mkCCall (xchgLabel w) + + where + unsupported :: Show a => a -> b + unsupported mop = panic ("outOfLineCmmOp: " ++ show mop + ++ " not supported here") + + mkCCall :: FastString -> NatM InstrBlock + mkCCall name = do + config <- getConfig + target <- + cmmMakeDynamicReference config CallReference + $ mkForeignLabel name ForeignLabelInThisPackage IsFunction + let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn + genCCall (ForeignTarget target cconv) dest_regs arg_regs + + -- Implementiation of the LoongArch ABI calling convention. + -- https://github.com/loongson/la-abi-specs/blob/release/lapcs.adoc#passing-arguments + passArguments :: [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock) + + -- 1. Base case: no more arguments to pass (left) + passArguments _ _ [] stackSpaceWords accumRegs accumCode = return (stackSpaceWords, accumRegs, accumCode) + + -- 2. Still have GP regs, and we want to pass an GP argument. + passArguments (gpReg : gpRegs) fpRegs ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isIntFormat format = do + let w = formatToWidth format + ext + -- Specifically, LoongArch64's ABI requires that the caller + -- sign-extend arguments which are smaller than 64-bits. + | w `elem` [W8, W16, W32] + = case w of + W8 -> EXT (OpReg W64 gpReg) (OpReg w r) + W16 -> EXT (OpReg W64 gpReg) (OpReg w r) + W32 -> SLL (OpReg W64 gpReg) (OpReg w r) (OpImm (ImmInt 0)) + _ -> panic "Unexpected width(Here w < W64)!" + | otherwise + = MOV (OpReg w gpReg) (OpReg w r) + accumCode' = accumCode `appOL` + code_r `snocOL` + ann (text "Pass gp argument: " <> ppr r) ext + + passArguments gpRegs fpRegs args stackSpaceWords (gpReg : accumRegs) accumCode' + + -- 3. Still have FP regs, and we want to pass an FP argument. + passArguments gpRegs (fpReg : fpRegs) ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isFloatFormat format = do + let w = formatToWidth format + mov = MOV (OpReg w fpReg) (OpReg w r) + accumCode' = accumCode `appOL` + code_r `snocOL` + ann (text "Pass fp argument: " <> ppr r) mov + + passArguments gpRegs fpRegs args stackSpaceWords (fpReg : accumRegs) accumCode' + + -- 4. No mor regs left to pass. Must pass on stack. + passArguments [] [] ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode = do + let w = formatToWidth format + spOffet = 8 * stackSpaceWords + str = ST format (OpReg w r) (OpAddr (AddrRegImm spMachReg (ImmInt spOffet))) + stackCode = + code_r + `snocOL` (MOV (OpReg w tmpReg) (OpReg w r)) + `appOL` truncateReg w W64 tmpReg + `snocOL` ann (text "Pass signed argument (size " <> ppr w <> text ") on the stack: " <> ppr tmpReg) str + + passArguments [] [] args (stackSpaceWords + 1) accumRegs (stackCode `appOL` accumCode) + + -- 5. Still have fpRegs left, but want to pass a GP argument. Must be passed on the stack then. + passArguments [] fpRegs ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isIntFormat format = do + let w = formatToWidth format + spOffet = 8 * stackSpaceWords + str = ST format (OpReg w r) (OpAddr (AddrRegImm spMachReg (ImmInt spOffet))) + stackCode = + code_r + `snocOL` ann (text "Pass argument (size " <> ppr w <> text ") on the stack: " <> ppr r) str + + passArguments [] fpRegs args (stackSpaceWords + 1) accumRegs (stackCode `appOL` accumCode) + + -- 6. Still have gpRegs left, but want to pass a FP argument. Must be passed in gpReg then. + passArguments (gpReg : gpRegs) [] ((r, format, _hint, code_r) : args) stackSpaceWords accumRegs accumCode | isFloatFormat format = do + let w = formatToWidth format + mov = MOV (OpReg w gpReg) (OpReg w r) + accumCode' = accumCode `appOL` + code_r `snocOL` + ann (text "Pass fp argument in gpReg: " <> ppr r) mov + + passArguments gpRegs [] args stackSpaceWords (gpReg : accumRegs) accumCode' + + + passArguments _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + + readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg] -> InstrBlock -> NatM InstrBlock + readResults _ _ [] _ accumCode = return accumCode + readResults [] _ _ _ _ = do + platform <- getPlatform + pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target) + readResults _ [] _ _ _ = do + platform <- getPlatform + pprPanic "genCCall, out of fp registers when reading results" (pdoc platform target) + readResults (gpReg:gpRegs) (fpReg:fpRegs) (dst:dsts) accumRegs accumCode = do + -- gp/fp reg -> dst + platform <- getPlatform + let rep = cmmRegType (CmmLocal dst) + format = cmmTypeFormat rep + w = cmmRegWidth (CmmLocal dst) + r_dst = getRegisterReg platform (CmmLocal dst) + if isFloatFormat format + then readResults (gpReg : gpRegs) fpRegs dsts (fpReg : accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg)) + else + readResults gpRegs (fpReg : fpRegs) dsts (gpReg : accumRegs) + $ accumCode + `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg) + `appOL` + -- truncate, otherwise an unexpectedly big value might be used in upfollowing calculations + truncateReg W64 w r_dst + + unaryFloatOp w op arg_reg dest_reg = do + platform <- getPlatform + (reg_fx, _format_x, code_fx) <- getFloatReg arg_reg + let dst = getRegisterReg platform (CmmLocal dest_reg) + let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx) + pure code + +data BlockInRange = InRange | NotInRange BlockId + +genCondFarJump :: (MonadGetUnique m) => Cond -> Operand -> Operand -> BlockId -> m InstrBlock +genCondFarJump cond op1 op2 far_target = do + return $ toOL [ ann (text "Conditional far jump to: " <> ppr far_target) + $ BCOND cond op1 op2 (TBlock far_target) + ] + +makeFarBranches :: + Platform -> + LabelMap RawCmmStatics -> + [NatBasicBlock Instr] -> + UniqDSM [NatBasicBlock Instr] + +makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do + -- All offsets/positions are counted in multiples of 4 bytes (the size of LoongArch64 instructions) + -- That is an offset of 1 represents a 4-byte/one instruction offset. + let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks + if func_size < max_cond_jump_dist + then pure basic_blocks + else do + (_, blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks + pure $ concat blocks + where + max_cond_jump_dist = 2 ^ (15 :: Int) - 8 :: Int + -- Currently all inline info tables fit into 64 bytes. + max_info_size = 16 :: Int + long_bc_jump_dist = 2 :: Int + + -- Replace out of range conditional jumps with unconditional jumps. + replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqDSM (Int, [GenBasicBlock Instr]) + replace_blk !m !pos (BasicBlock lbl instrs) = do + -- Account for a potential info table before the label. + let !block_pos = pos + infoTblSize_maybe lbl + (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs + let instrs'' = concat instrs' + -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary. + let (top, split_blocks, no_data) = foldr mkBlocks ([], [], []) instrs'' + -- There should be no data in the instruction stream at this point + massert (null no_data) + + let final_blocks = BasicBlock lbl top : split_blocks + pure (pos', final_blocks) + + replace_jump :: LabelMap Int -> Int -> Instr -> UniqDSM (Int, [Instr]) + replace_jump !m !pos instr = do + case instr of + ANN ann instr -> do + replace_jump m pos instr >>= \case + (idx, instr' : instrs') -> pure (idx, ANN ann instr' : instrs') + (idx, []) -> pprPanic "replace_jump" (text "empty return list for " <+> ppr idx) + + BCOND1 cond op1 op2 t -> + case target_in_range m t pos of + InRange -> pure (pos + 1, [instr]) + NotInRange far_target -> do + jmp_code <- genCondFarJump cond op1 op2 far_target + pure (pos + long_bc_jump_dist, fromOL jmp_code) + + _ -> pure (pos + instr_size instr, [instr]) + + target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange + target_in_range m target src = + case target of + (TReg{}) -> InRange + (TBlock bid) -> block_in_range m src bid + (TLabel clbl) + | Just bid <- maybeLocalBlockLabel clbl + -> block_in_range m src bid + | otherwise + -> InRange + + block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange + block_in_range m src_pos dest_lbl = + case mapLookup dest_lbl m of + Nothing -> + pprTrace "not in range" (ppr dest_lbl) $ NotInRange dest_lbl + Just dest_pos -> + if abs (dest_pos - src_pos) < max_cond_jump_dist + then InRange + else NotInRange dest_lbl + + calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int) + calc_lbl_positions (pos, m) (BasicBlock lbl instrs) = + let !pos' = pos + infoTblSize_maybe lbl + in foldl' instr_pos (pos', mapInsert lbl pos' m) instrs + + instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int) + instr_pos (pos, m) instr = (pos + instr_size instr, m) + + infoTblSize_maybe bid = + case mapLookup bid statics of + Nothing -> 0 :: Int + Just _info_static -> max_info_size + + instr_size :: Instr -> Int + instr_size i = case i of + COMMENT {} -> 0 + MULTILINE_COMMENT {} -> 0 + ANN _ instr -> instr_size instr + LOCATION {} -> 0 + DELTA {} -> 0 + -- At this point there should be no NEWBLOCK in the instruction stream (pos, mapInsert bid pos m) + NEWBLOCK {} -> panic "mkFarBranched - Unexpected" + LDATA {} -> panic "mkFarBranched - Unexpected" + PUSH_STACK_FRAME -> 4 + POP_STACK_FRAME -> 4 + CSET {} -> 2 + LD _ _ (OpImm (ImmIndex _ _)) -> 3 + LD _ _ (OpImm (ImmCLbl _)) -> 2 + SCVTF {} -> 2 + FCVTZS {} -> 4 + BCOND {} -> long_bc_jump_dist + CALL (TReg _) _ -> 1 + CALL {} -> 2 + CALL36 {} -> 2 + TAIL36 {} -> 2 + _ -> 1 diff --git a/GHC/CmmToAsm/LA64/Cond.hs b/GHC/CmmToAsm/LA64/Cond.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/Cond.hs @@ -0,0 +1,33 @@ +module GHC.CmmToAsm.LA64.Cond where + +import GHC.Prelude hiding (EQ) + +-- | Condition codes. +-- Used in conditional branches and bit setters. According to the available +-- instruction set, some conditions are encoded as their negated opposites. I.e. +-- these are logical things that don't necessarily map 1:1 to hardware/ISA. +-- TODO: Maybe need to simplify or expand? +data Cond +-- ISA condition + = EQ -- beq + | NE -- bne + | LT -- blt + | GE -- bge + | LTU -- bltu + | GEU -- bgeu + | EQZ -- beqz + | NEZ -- bnez +-- Extra Logical condition + | SLT -- LT + | SLE + | SGE -- GE + | SGT + | ULT -- LTU + | ULE + | UGE -- GEU + | UGT + | FLT + | FLE + | FGE + | FGT + deriving (Eq, Show) diff --git a/GHC/CmmToAsm/LA64/Instr.hs b/GHC/CmmToAsm/LA64/Instr.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/Instr.hs @@ -0,0 +1,1012 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module GHC.CmmToAsm.LA64.Instr where + +import GHC.Prelude + +import GHC.CmmToAsm.LA64.Cond +import GHC.CmmToAsm.LA64.Regs + +import GHC.CmmToAsm.Instr (RegUsage(..)) +import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils +import GHC.CmmToAsm.Config +import GHC.Platform.Reg + +import GHC.Platform.Regs +import GHC.Platform.Reg.Class.Separate +import GHC.Cmm.BlockId +import GHC.Cmm.Dataflow.Label +import GHC.Cmm +import GHC.Cmm.CLabel +import GHC.Utils.Outputable +import GHC.Platform +import GHC.Types.Unique.DSM + +import GHC.Utils.Panic +import Data.Maybe +import GHC.Stack +import GHC.Data.FastString (LexicalFastString) + +-- | Stack frame header size +-- Each stack frame contains ra and fp -- prologue. +stackFrameHeaderSize :: Int +stackFrameHeaderSize = 2 * spillSlotSize + +-- | All registers are 8 byte wide. +spillSlotSize :: Int +spillSlotSize = 8 + +-- | The number of bytes that the stack pointer should be aligned to. +stackAlign :: Int +stackAlign = 16 + +-- | The number of spill slots available without allocating more. +maxSpillSlots :: NCGConfig -> Int +maxSpillSlots config + = ( + (ncgSpillPreallocSize config - stackFrameHeaderSize) + `div` + spillSlotSize + ) - 1 + +-- | Convert a spill slot number to a *byte* offset. +spillSlotToOffset :: Int -> Int +spillSlotToOffset slot + = stackFrameHeaderSize + spillSlotSize * slot + +instance Outputable RegUsage where + ppr (RU reads writes) = text "RegUsage(reads:" <+> ppr reads <> comma <+> text "writes:" <+> ppr writes <> char ')' + +-- | Get the registers that are being used by this instruction. +-- regUsage doesn't need to do any trickery for jumps and such. +-- Just state precisely the regs read and written by that insn. +-- The consequences of control flow transfers, as far as register +-- allocation goes, are taken care of by the register allocator. +-- +-- RegUsage = RU [] [] +regUsageOfInstr :: Platform -> Instr -> RegUsage +regUsageOfInstr platform instr = case instr of + -- Pseudo Instructions + ANN _ i -> regUsageOfInstr platform i + COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) + PUSH_STACK_FRAME -> usage ([], []) + POP_STACK_FRAME -> usage ([], []) + DELTA{} -> usage ([], []) + LOCATION{} -> usage ([], []) + + -- 1. Arithmetic Instructions ------------------------------------------------ + ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + ALSL dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + ALSLU dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + LU12I dst src1 -> usage (regOp src1, regOp dst) + LU32I dst src1 -> usage (regOp src1, regOp dst) + LU52I dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + SSLT dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + SSLTU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + PCADDI dst src1 -> usage (regOp src1, regOp dst) + PCADDU12I dst src1 -> usage (regOp src1, regOp dst) + PCADDU18I dst src1 -> usage (regOp src1, regOp dst) + PCALAU12I dst src1 -> usage (regOp src1, regOp dst) + AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + NOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + ANDN dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + ORN dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MULW dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MULWU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MULHU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIVU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MOD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MODU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- 2. Bit-shift Instructions ------------------------------------------ + SLL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + SRL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + SRA dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + ROTR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- 3. Bit Manipulation Instructions ------------------------------------------ + EXT dst src1 -> usage (regOp src1, regOp dst) + CLO dst src1 -> usage (regOp src1, regOp dst) + CLZ dst src1 -> usage (regOp src1, regOp dst) + CTO dst src1 -> usage (regOp src1, regOp dst) + CTZ dst src1 -> usage (regOp src1, regOp dst) + BYTEPICK dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + REVB2H dst src1 -> usage (regOp src1, regOp dst) + REVB4H dst src1 -> usage (regOp src1, regOp dst) + REVB2W dst src1 -> usage (regOp src1, regOp dst) + REVBD dst src1 -> usage (regOp src1, regOp dst) + REVH2W dst src1 -> usage (regOp src1, regOp dst) + REVHD dst src1 -> usage (regOp src1, regOp dst) + BITREV4B dst src1 -> usage (regOp src1, regOp dst) + BITREV8B dst src1 -> usage (regOp src1, regOp dst) + BITREVW dst src1 -> usage (regOp src1, regOp dst) + BITREVD dst src1 -> usage (regOp src1, regOp dst) + BSTRINS _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + BSTRPICK _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + MASKEQZ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + MASKNEZ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- + -- Pseudo instructions + NOP -> usage ([], []) + MOV dst src -> usage (regOp src, regOp dst) + NEG dst src -> usage (regOp src, regOp dst) + CSET _cond dst src1 src2 -> usage (regOp src1 ++ regOp src2 , regOp dst) + -- 4. Branch Instructions ---------------------------------------------------- + J t -> usage (regTarget t, []) + J_TBL _ _ t -> usage ([t], []) + B t -> usage (regTarget t, []) + BL t ps -> usage (regTarget t ++ ps, callerSavedRegisters) + CALL t ps -> usage (regTarget t ++ ps, callerSavedRegisters) + CALL36 t -> usage (regTarget t, []) + TAIL36 r t -> usage (regTarget t, regOp r) + -- Here two kinds of BCOND and BCOND1 are implemented, mainly because we want + -- to distinguish between two kinds of conditional jumps with different jump + -- ranges, corresponding to 2 and 1 instruction implementations respectively. + -- + -- BCOND1 is selected by default. + BCOND1 _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) + BCOND _ j d t -> usage (regTarget t ++ regOp j ++ regOp d, []) + BEQZ j t -> usage (regTarget t ++ regOp j, []) + BNEZ j t -> usage (regTarget t ++ regOp j, []) + -- 5. Common Memory Access Instructions -------------------------------------- + LD _ dst src -> usage (regOp src, regOp dst) + LDU _ dst src -> usage (regOp src, regOp dst) + ST _ dst src -> usage (regOp src ++ regOp dst, []) + LDX _ dst src -> usage (regOp src, regOp dst) + LDXU _ dst src -> usage (regOp src, regOp dst) + STX _ dst src -> usage (regOp src ++ regOp dst, []) + LDPTR _ dst src -> usage (regOp src, regOp dst) + STPTR _ dst src -> usage (regOp src ++ regOp dst, []) + PRELD _hint src -> usage (regOp src, []) + -- 6. Bound Check Memory Access Instructions --------------------------------- + -- LDCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- STCOND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- 7. Atomic Memory Access Instructions -------------------------------------- + -- 8. Barrier Instructions --------------------------------------------------- + DBAR _hint -> usage ([], []) + IBAR _hint -> usage ([], []) + -- 11. Floating Point Instructions ------------------------------------------- + FMAX dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + FMIN dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + FMAXA dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + FMINA dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + FNEG dst src1 -> usage (regOp src1, regOp dst) + + FCVT dst src -> usage (regOp src, regOp dst) + -- SCVTF dst src -> usage (regOp src, regOp src ++ regOp dst) + SCVTF dst src -> usage (regOp src, regOp dst) + FCVTZS dst src1 src2 -> usage (regOp src2, regOp src1 ++ regOp dst) + FABS dst src -> usage (regOp src, regOp dst) + FSQRT dst src -> usage (regOp src, regOp dst) + FMA _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) + + _ -> panic $ "regUsageOfInstr: " ++ instrCon instr + + where + -- filtering the usage is necessary, otherwise the register + -- allocator will try to allocate pre-defined fixed stg + -- registers as well, as they show up. + usage :: ([Reg], [Reg]) -> RegUsage + usage (srcRegs, dstRegs) = + RU + (map mkFmt $ filter (interesting platform) srcRegs) + (map mkFmt $ filter (interesting platform) dstRegs) + + mkFmt r = RegWithFormat r fmt + where + fmt = case cls of + RcInteger -> II64 + RcFloat -> FF64 + RcVector -> sorry "The LoongArch64 NCG does not (yet) support vectors; please use -fllvm." + cls = case r of + RegVirtual vr -> classOfVirtualReg (platformArch platform) vr + RegReal rr -> classOfRealReg rr + + regAddr :: AddrMode -> [Reg] + regAddr (AddrRegReg r1 r2) = [r1, r2] + regAddr (AddrRegImm r1 _) = [r1] + regAddr (AddrReg r1) = [r1] + + regOp :: Operand -> [Reg] + regOp (OpReg _ r1) = [r1] + regOp (OpAddr a) = regAddr a + regOp (OpImm _) = [] + + regTarget :: Target -> [Reg] + regTarget (TBlock _) = [] + regTarget (TLabel _) = [] + regTarget (TReg r1) = [r1] + + -- Is this register interesting for the register allocator? + interesting :: Platform -> Reg -> Bool + interesting _ (RegVirtual _) = True + interesting platform (RegReal (RealRegSingle i)) = freeReg platform i + +-- | Caller-saved registers (according to calling convention) +-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +-- | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | +-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +-- |zero| ra | tp | sp | a0 | a1 | a2 | a3 | a4 | a5 | a6 | a7 | t0 | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | Rv | fp | s0 | s1 | s2 | s3 | s4 | s5 | s6 | s7 | s8 | +-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +-- | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 42 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | +-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +--f| a0 | a1 | a2 | a3 | a4 | a5 | a6 | a7 | t0 | t1 | t2 | t3 | t4 | t5 | t6 | t7 | t8 | t9 | t10| t11| t12| t13| t14| t15| s0 | s1 | s2 | s3 | s4 | s5 | s6 | s7 | +-------------------------------------------------------------------------------------------------------------------------------------------------------------------- +callerSavedRegisters :: [Reg] +callerSavedRegisters = + -- TODO: Not sure. + [regSingle 1] -- ra + ++ map regSingle [4 .. 11] -- a0 - a7 + ++ map regSingle [12 .. 20] -- t0 - t8 + ++ map regSingle [32 .. 39] -- fa0 - fa7 + ++ map regSingle [40 .. 55] -- ft0 - ft15 + +-- | Apply a given mapping to all the register references in this instruction. +patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr +patchRegsOfInstr instr env = case instr of + -- 0. Meta Instructions + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr + LOCATION{} -> instr + -- 1. Arithmetic Instructions ------------------------------------------------ + ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) + SUB o1 o2 o3 -> SUB (patchOp o1) (patchOp o2) (patchOp o3) + ALSL o1 o2 o3 o4 -> ALSL (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + ALSLU o1 o2 o3 o4 -> ALSLU (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + LU12I o1 o2 -> LU12I (patchOp o1) (patchOp o2) + LU32I o1 o2 -> LU32I (patchOp o1) (patchOp o2) + LU52I o1 o2 o3 -> LU52I (patchOp o1) (patchOp o2) (patchOp o3) + SSLT o1 o2 o3 -> SSLT (patchOp o1) (patchOp o2) (patchOp o3) + SSLTU o1 o2 o3 -> SSLTU (patchOp o1) (patchOp o2) (patchOp o3) + PCADDI o1 o2 -> PCADDI (patchOp o1) (patchOp o2) + PCADDU12I o1 o2 -> PCADDU12I (patchOp o1) (patchOp o2) + PCADDU18I o1 o2 -> PCADDU18I (patchOp o1) (patchOp o2) + PCALAU12I o1 o2 -> PCALAU12I (patchOp o1) (patchOp o2) + AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3) + OR o1 o2 o3 -> OR (patchOp o1) (patchOp o2) (patchOp o3) + XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3) + NOR o1 o2 o3 -> NOR (patchOp o1) (patchOp o2) (patchOp o3) + ANDN o1 o2 o3 -> ANDN (patchOp o1) (patchOp o2) (patchOp o3) + ORN o1 o2 o3 -> ORN (patchOp o1) (patchOp o2) (patchOp o3) + MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3) + MULW o1 o2 o3 -> MULW (patchOp o1) (patchOp o2) (patchOp o3) + MULWU o1 o2 o3 -> MULWU (patchOp o1) (patchOp o2) (patchOp o3) + MULH o1 o2 o3 -> MULH (patchOp o1) (patchOp o2) (patchOp o3) + MULHU o1 o2 o3 -> MULHU (patchOp o1) (patchOp o2) (patchOp o3) + DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3) + MOD o1 o2 o3 -> MOD (patchOp o1) (patchOp o2) (patchOp o3) + DIVU o1 o2 o3 -> DIVU (patchOp o1) (patchOp o2) (patchOp o3) + MODU o1 o2 o3 -> MODU (patchOp o1) (patchOp o2) (patchOp o3) + -- 2. Bit-shift Instructions ------------------------------------------ + SLL o1 o2 o3 -> SLL (patchOp o1) (patchOp o2) (patchOp o3) + SRL o1 o2 o3 -> SRL (patchOp o1) (patchOp o2) (patchOp o3) + SRA o1 o2 o3 -> SRA (patchOp o1) (patchOp o2) (patchOp o3) + ROTR o1 o2 o3 -> ROTR (patchOp o1) (patchOp o2) (patchOp o3) + -- 3. Bit Manipulation Instructions ------------------------------------------ + EXT o1 o2 -> EXT (patchOp o1) (patchOp o2) + CLO o1 o2 -> CLO (patchOp o1) (patchOp o2) + CLZ o1 o2 -> CLZ (patchOp o1) (patchOp o2) + CTO o1 o2 -> CTO (patchOp o1) (patchOp o2) + CTZ o1 o2 -> CTZ (patchOp o1) (patchOp o2) + BYTEPICK o1 o2 o3 o4 -> BYTEPICK (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + REVB2H o1 o2 -> REVB2H (patchOp o1) (patchOp o2) + REVB4H o1 o2 -> REVB4H (patchOp o1) (patchOp o2) + REVB2W o1 o2 -> REVB2W (patchOp o1) (patchOp o2) + REVBD o1 o2 -> REVBD (patchOp o1) (patchOp o2) + REVH2W o1 o2 -> REVH2W (patchOp o1) (patchOp o2) + REVHD o1 o2 -> REVHD (patchOp o1) (patchOp o2) + BITREV4B o1 o2 -> BITREV4B (patchOp o1) (patchOp o2) + BITREV8B o1 o2 -> BITREV8B (patchOp o1) (patchOp o2) + BITREVW o1 o2 -> BITREVW (patchOp o1) (patchOp o2) + BITREVD o1 o2 -> BITREVD (patchOp o1) (patchOp o2) + BSTRINS f o1 o2 o3 o4 -> BSTRINS f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + BSTRPICK f o1 o2 o3 o4 -> BSTRPICK f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + MASKEQZ o1 o2 o3 -> MASKEQZ (patchOp o1) (patchOp o2) (patchOp o3) + MASKNEZ o1 o2 o3 -> MASKNEZ (patchOp o1) (patchOp o2) (patchOp o3) + -- + -- Pseudo instrcutions + NOP -> NOP + MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) + NEG o1 o2 -> NEG (patchOp o1) (patchOp o2) + CSET cond o1 o2 o3 -> CSET cond (patchOp o1) (patchOp o2) (patchOp o3) + -- 4. Branch Instructions ---------------------------------------------------- + -- TODO: + J t -> J (patchTarget t) + J_TBL ids mbLbl t -> J_TBL ids mbLbl (env t) + B t -> B (patchTarget t) + BL t ps -> BL (patchTarget t) ps + CALL t ps -> CALL (patchTarget t) ps + CALL36 t -> CALL36 (patchTarget t) + TAIL36 r t -> TAIL36 (patchOp r) (patchTarget t) + BCOND1 c j d t -> BCOND1 c (patchOp j) (patchOp d) (patchTarget t) + BCOND c j d t -> BCOND c (patchOp j) (patchOp d) (patchTarget t) + BEQZ j t -> BEQZ (patchOp j) (patchTarget t) + BNEZ j t -> BNEZ (patchOp j) (patchTarget t) + -- 5. Common Memory Access Instructions -------------------------------------- + -- TODO: + LD f o1 o2 -> LD f (patchOp o1) (patchOp o2) + LDU f o1 o2 -> LDU f (patchOp o1) (patchOp o2) + ST f o1 o2 -> ST f (patchOp o1) (patchOp o2) + LDX f o1 o2 -> LDX f (patchOp o1) (patchOp o2) + LDXU f o1 o2 -> LDXU f (patchOp o1) (patchOp o2) + STX f o1 o2 -> STX f (patchOp o1) (patchOp o2) + LDPTR f o1 o2 -> LDPTR f (patchOp o1) (patchOp o2) + STPTR f o1 o2 -> STPTR f (patchOp o1) (patchOp o2) + PRELD o1 o2 -> PRELD (patchOp o1) (patchOp o2) + -- 6. Bound Check Memory Access Instructions --------------------------------- + -- LDCOND o1 o2 o3 -> LDCOND (patchOp o1) (patchOp o2) (patchOp o3) + -- STCOND o1 o2 o3 -> STCOND (patchOp o1) (patchOp o2) (patchOp o3) + -- 7. Atomic Memory Access Instructions -------------------------------------- + -- 8. Barrier Instructions --------------------------------------------------- + -- TODO: need fix + DBAR o1 -> DBAR o1 + IBAR o1 -> IBAR o1 + -- 11. Floating Point Instructions ------------------------------------------- + FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) + SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2) + FCVTZS o1 o2 o3 -> FCVTZS (patchOp o1) (patchOp o2) (patchOp o3) + FMIN o1 o2 o3 -> FMIN (patchOp o1) (patchOp o2) (patchOp o3) + FMAX o1 o2 o3 -> FMAX (patchOp o1) (patchOp o2) (patchOp o3) + FMINA o1 o2 o3 -> FMINA (patchOp o1) (patchOp o2) (patchOp o3) + FMAXA o1 o2 o3 -> FMAXA (patchOp o1) (patchOp o2) (patchOp o3) + FNEG o1 o2 -> FNEG (patchOp o1) (patchOp o2) + FABS o1 o2 -> FABS (patchOp o1) (patchOp o2) + FSQRT o1 o2 -> FSQRT (patchOp o1) (patchOp o2) + FMA s o1 o2 o3 o4 -> FMA s (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) + + _ -> panic $ "patchRegsOfInstr: " ++ instrCon instr + where + -- TODO: + patchOp :: Operand -> Operand + patchOp (OpReg w r) = OpReg w (env r) + patchOp (OpAddr a) = OpAddr (patchAddr a) + patchOp opImm = opImm + + patchTarget :: Target -> Target + patchTarget (TReg r) = TReg (env r) + patchTarget t = t + + patchAddr :: AddrMode -> AddrMode + patchAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) + patchAddr (AddrRegImm r1 imm) = AddrRegImm (env r1) imm + patchAddr (AddrReg r) = AddrReg (env r) + +-------------------------------------------------------------------------------- + +-- | Checks whether this instruction is a jump/branch instruction. +-- One that can change the flow of control in a way that the +-- register allocator needs to worry about. +isJumpishInstr :: Instr -> Bool +isJumpishInstr instr = case instr of + ANN _ i -> isJumpishInstr i + J {} -> True + J_TBL {} -> True + B {} -> True + BL {} -> True + CALL {} -> True + CALL36 {} -> True + TAIL36 {} -> True + BCOND1 {} -> True + BCOND {} -> True + BEQZ {} -> True + BNEZ {} -> True + _ -> False + +-- | Get the `BlockId`s of the jump destinations (if any) +jumpDestsOfInstr :: Instr -> [BlockId] +jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i +jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids +jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BL t _) = [id | TBlock id <- [t]] +jumpDestsOfInstr (CALL t _) = [id | TBlock id <- [t]] +jumpDestsOfInstr (CALL36 t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (TAIL36 _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND1 _ _ _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BCOND _ _ _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BEQZ _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr (BNEZ _ t) = [id | TBlock id <- [t]] +jumpDestsOfInstr _ = [] + +-- | Change the destination of this (potential) jump instruction. +-- Used in the linear allocator when adding fixup blocks for join +-- points. +patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr +patchJumpInstr instr patchF = + case instr of + ANN d i -> ANN d (patchJumpInstr i patchF) + J (TBlock bid) -> J (TBlock (patchF bid)) + J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r + B (TBlock bid) -> B (TBlock (patchF bid)) + BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps + CALL (TBlock bid) ps -> CALL (TBlock (patchF bid)) ps + CALL36 (TBlock bid) -> CALL36 (TBlock (patchF bid)) + TAIL36 r (TBlock bid) -> TAIL36 r (TBlock (patchF bid)) + BCOND1 c o1 o2 (TBlock bid) -> BCOND1 c o1 o2 (TBlock (patchF bid)) + BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid)) + BEQZ j (TBlock bid) -> BEQZ j (TBlock (patchF bid)) + BNEZ j (TBlock bid) -> BNEZ j (TBlock (patchF bid)) + _ -> panic $ "patchJumpInstr: " ++ instrCon instr + +-- ----------------------------------------------------------------------------- +-- | Make a spill instruction, spill a register into spill slot. +mkSpillInstr + :: HasCallStack + => NCGConfig + -> RegWithFormat -- register to spill + -> Int -- current stack delta + -> Int -- spill slot to use + -> [Instr] + +mkSpillInstr _config (RegWithFormat reg _fmt) delta slot = + case off - delta of + imm | fitsInNbits 12 imm -> [mkStrSpImm imm] + imm -> + [ movImmToIp imm, + addSpToIp, + mkStrIp + ] + where + fmt = case reg of + RegReal (RealRegSingle n) | n < 32 -> II64 + _ -> FF64 + mkStrSpImm imm = ANN (text "Spill@" <> int (off - delta)) $ ST fmt (OpReg W64 reg) (OpAddr (AddrRegImm spMachReg (ImmInt imm))) + movImmToIp imm = ANN (text "Spill: TMP <- " <> int imm) $ MOV tmp (OpImm (ImmInt imm)) + addSpToIp = ANN (text "Spill: TMP <- SP + TMP ") $ ADD tmp tmp sp + mkStrIp = ANN (text "Spill@" <> int (off - delta)) $ ST fmt (OpReg W64 reg) (OpAddr (AddrReg tmpReg)) + off = spillSlotToOffset slot + +-- | Make a reload instruction, reload from spill slot to a register. +mkLoadInstr + :: NCGConfig + -> RegWithFormat + -> Int -- current stack delta + -> Int -- spill slot to use + -> [Instr] + +mkLoadInstr _config (RegWithFormat reg _fmt) delta slot = + case off - delta of + imm | fitsInNbits 12 imm -> [mkLdrSpImm imm] + imm -> + [ movImmToIp imm, + addSpToIp, + mkLdrIp + ] + where + fmt = case reg of + RegReal (RealRegSingle n) | n < 32 -> II64 + _ -> FF64 + mkLdrSpImm imm = ANN (text "Reload@" <> int (off - delta)) $ LD fmt (OpReg W64 reg) (OpAddr (AddrRegImm spMachReg (ImmInt imm))) + movImmToIp imm = ANN (text "Reload: TMP <- " <> int imm) $ MOV tmp (OpImm (ImmInt imm)) + addSpToIp = ANN (text "Reload: TMP <- SP + TMP ") $ ADD tmp tmp sp + mkLdrIp = ANN (text "Reload@" <> int (off - delta)) $ LD fmt (OpReg W64 reg) (OpAddr (AddrReg tmpReg)) + off = spillSlotToOffset slot + +-- | See if this instruction is telling us the current C stack delta +takeDeltaInstr :: Instr -> Maybe Int +takeDeltaInstr (ANN _ i) = takeDeltaInstr i +takeDeltaInstr (DELTA i) = Just i +takeDeltaInstr _ = Nothing + +-- | Not real instructions. Just meta data +isMetaInstr :: Instr -> Bool +isMetaInstr instr = + case instr of + ANN _ i -> isMetaInstr i + COMMENT {} -> True + MULTILINE_COMMENT {} -> True + LOCATION {} -> True + NEWBLOCK {} -> True + DELTA {} -> True + LDATA {} -> True + PUSH_STACK_FRAME -> True + POP_STACK_FRAME -> True + _ -> False + +canFallthroughTo :: Instr -> BlockId -> Bool +canFallthroughTo insn bid = + case insn of + J (TBlock target) -> bid == target + J_TBL targets _ _ -> all isTargetBid targets + B (TBlock target) -> bid == target + TAIL36 _ (TBlock target) -> bid == target + BCOND1 _ _ _ (TBlock target) -> bid == target + BCOND _ _ _ (TBlock target) -> bid == target + _ -> False + where + isTargetBid target = case target of + Nothing -> True + Just target -> target == bid + +-- | Copy the value in a register to another one. +-- Must work for all register classes. +mkRegRegMoveInstr :: Reg -> Reg -> Instr +mkRegRegMoveInstr src dst = ANN desc instr + where + desc = text "Reg->Reg Move: " <> ppr src <> text " -> " <> ppr dst + instr = MOV (OpReg W64 dst) (OpReg W64 src) + +-- | Take the source and destination from this (potential) reg -> reg move instruction +-- We have to be a bit careful here: A `MOV` can also mean an implicit +-- conversion. This case is filtered out. +takeRegRegMoveInstr :: Instr -> Maybe (Reg, Reg) +takeRegRegMoveInstr (MOV (OpReg width dst) (OpReg width' src)) + | width == width' && (isFloatReg dst == isFloatReg src) = pure (src, dst) +takeRegRegMoveInstr _ = Nothing + +-- | Make an unconditional jump instruction. +mkJumpInstr :: BlockId -> [Instr] +mkJumpInstr id = [TAIL36 (OpReg W64 tmpReg) (TBlock (id))] + +-- | Decrement @sp@ to allocate stack space. +mkStackAllocInstr :: Platform -> Int -> [Instr] +mkStackAllocInstr _platform n + | n == 0 = [] + | n > 0 && fitsInNbits 12 (fromIntegral n) = + [ ANN (text "Alloc stack") $ SUB sp sp (OpImm (ImmInt n)) ] + | n > 0 = + [ + ANN (text "Alloc more stack") (MOV tmp (OpImm (ImmInt n))), + SUB sp sp tmp + ] +mkStackAllocInstr _platform n = pprPanic "mkStackAllocInstr" (int n) + +-- | Increment SP to deallocate stack space. +mkStackDeallocInstr :: Platform -> Int -> [Instr] +mkStackDeallocInstr _platform n + | n == 0 = [] + | n > 0 && fitsInNbits 12 (fromIntegral n) = + [ ANN (text "Dealloc stack") $ ADD sp sp (OpImm (ImmInt n)) ] + | n > 0 = + [ + ANN (text "Dealloc more stack") (MOV tmp (OpImm (ImmInt n))), + ADD sp sp tmp + ] +mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n) + +allocMoreStack + :: Platform + -> Int + -> NatCmmDecl statics GHC.CmmToAsm.LA64.Instr.Instr + -> UniqDSM (NatCmmDecl statics GHC.CmmToAsm.LA64.Instr.Instr, [(BlockId,BlockId)]) + +allocMoreStack _ _ top@(CmmData _ _) = return (top, []) +allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do + let entries = entryBlocks proc + + retargetList <- mapM (\e -> (e,) <$> newBlockId) entries + + let + delta = ((x + stackAlign - 1) `quot` stackAlign) * stackAlign -- round up + where x = slots * spillSlotSize -- sp delta + + alloc = mkStackAllocInstr platform delta + dealloc = mkStackDeallocInstr platform delta + + new_blockmap :: LabelMap BlockId + new_blockmap = mapFromList retargetList + + insert_stack_insn (BasicBlock id insns) + | Just new_blockid <- mapLookup id new_blockmap = + [ BasicBlock id $ alloc ++ [ B (TBlock new_blockid) ], + BasicBlock new_blockid block' ] + | otherwise = + [ BasicBlock id block' ] + where + block' = foldr insert_dealloc [] insns + + insert_dealloc insn r = case insn of + J {} -> dealloc ++ (insn : r) + ANN _ e -> insert_dealloc e r + _other | jumpDestsOfInstr insn /= [] -> + patchJumpInstr insn retarget : r + _other -> insn : r + + where retarget b = fromMaybe b (mapLookup b new_blockmap) + + new_code = concatMap insert_stack_insn code + return (CmmProc info lbl live (ListGraph new_code), retargetList) + +-- ----------------------------------------------------------------------------- +-- Machine's assembly language + +-- We have a few common "instructions" (nearly all the pseudo-ops) but +-- mostly all of 'Instr' is machine-specific. + +data Instr + -- comment pseudo-op + = COMMENT SDoc + | MULTILINE_COMMENT SDoc + + -- Annotated instruction. Should print # + | ANN SDoc Instr + + -- location pseudo-op (file, line, col, name) + | LOCATION Int Int Int LexicalFastString + + -- start a new basic block. Useful during codegen, removed later. + -- Preceding instruction should be a jump, as per the invariants + -- for a BasicBlock (see Cmm). + | NEWBLOCK BlockId + + -- specify current stack offset for benefit of subsequent passes. + -- This carries a BlockId so it can be used in unwinding information. + | DELTA Int + + -- | Static data spat out during code generation. + | LDATA Section RawCmmStatics + + | PUSH_STACK_FRAME + | POP_STACK_FRAME + -- Basic Integer Instructions ------------------------------------------------ + -- 1. Arithmetic Instructions ------------------------------------------------ + | ADD Operand Operand Operand + | SUB Operand Operand Operand + | ALSL Operand Operand Operand Operand + | ALSLU Operand Operand Operand Operand + | LU12I Operand Operand + | LU32I Operand Operand + | LU52I Operand Operand Operand + | SSLT Operand Operand Operand + | SSLTU Operand Operand Operand + | PCADDI Operand Operand + | PCADDU12I Operand Operand + | PCADDU18I Operand Operand + | PCALAU12I Operand Operand + | AND Operand Operand Operand + | OR Operand Operand Operand + | XOR Operand Operand Operand + | NOR Operand Operand Operand + | ANDN Operand Operand Operand + | ORN Operand Operand Operand + | MUL Operand Operand Operand + | MULW Operand Operand Operand + | MULWU Operand Operand Operand + | MULH Operand Operand Operand + | MULHU Operand Operand Operand + | DIV Operand Operand Operand + | DIVU Operand Operand Operand + | MOD Operand Operand Operand + | MODU Operand Operand Operand + -- 2. Bit-shift Instuctions -------------------------------------------------- + | SLL Operand Operand Operand + | SRL Operand Operand Operand + | SRA Operand Operand Operand + | ROTR Operand Operand Operand + -- 3. Bit-manupulation Instructions ------------------------------------------ + | EXT Operand Operand + | CLO Operand Operand + | CTO Operand Operand + | CLZ Operand Operand + | CTZ Operand Operand + | BYTEPICK Operand Operand Operand Operand + | REVB2H Operand Operand + | REVB4H Operand Operand + | REVB2W Operand Operand + | REVBD Operand Operand + | REVH2W Operand Operand + | REVHD Operand Operand + | BITREV4B Operand Operand + | BITREV8B Operand Operand + | BITREVW Operand Operand + | BITREVD Operand Operand + | BSTRINS Format Operand Operand Operand Operand + | BSTRPICK Format Operand Operand Operand Operand + | MASKEQZ Operand Operand Operand + | MASKNEZ Operand Operand Operand + -- Pseudo instructions + | NOP + | MOV Operand Operand + | NEG Operand Operand + | CSET Cond Operand Operand Operand + -- 4. Branch Instructions ---------------------------------------------------- + | J Target + | J_TBL [Maybe BlockId] (Maybe CLabel) Reg + | B Target + | BL Target [Reg] + | CALL Target [Reg] + | CALL36 Target + | TAIL36 Operand Target + | BCOND1 Cond Operand Operand Target + | BCOND Cond Operand Operand Target + | BEQZ Operand Target + | BNEZ Operand Target + -- 5. Common Memory Access Instructions -------------------------------------- + | LD Format Operand Operand + | LDU Format Operand Operand + | ST Format Operand Operand + | LDX Format Operand Operand + | LDXU Format Operand Operand + | STX Format Operand Operand + | LDPTR Format Operand Operand + | STPTR Format Operand Operand + | PRELD Operand Operand + -- 6. Bound Check Memory Access Instructions --------------------------------- + -- 7. Atomic Memory Access Instructions -------------------------------------- + -- 8. Barrier Instructions --------------------------------------------------- + | DBAR BarrierType + | IBAR BarrierType + -- Basic Floating Point Instructions ----------------------------------------- + | FCVT Operand Operand + | SCVTF Operand Operand + | FCVTZS Operand Operand Operand + | FMAX Operand Operand Operand + | FMIN Operand Operand Operand + | FMAXA Operand Operand Operand + | FMINA Operand Operand Operand + | FNEG Operand Operand + | FABS Operand Operand + | FSQRT Operand Operand + -- Floating-point fused multiply-add instructions + -- fmadd : d = r1 * r2 + r3 + -- fnmsub: d = r1 * r2 - r3 + -- fmsub : d = - r1 * r2 + r3 + -- fnmadd: d = - r1 * r2 - r3 + | FMA FMASign Operand Operand Operand Operand + +-- TODO: Not complete. +data BarrierType = Hint0 + +instrCon :: Instr -> String +instrCon i = + case i of + COMMENT{} -> "COMMENT" + MULTILINE_COMMENT{} -> "COMMENT" + ANN{} -> "ANN" + LOCATION{} -> "LOCATION" + NEWBLOCK{} -> "NEWBLOCK" + DELTA{} -> "DELTA" + LDATA {} -> "LDATA" + PUSH_STACK_FRAME{} -> "PUSH_STACK_FRAME" + POP_STACK_FRAME{} -> "POP_STACK_FRAME" + + ADD{} -> "ADD" + SUB{} -> "SUB" + ALSL{} -> "ALSL" + ALSLU{} -> "ALSLU" + LU12I{} -> "LU12I" + LU32I{} -> "LU32I" + LU52I{} -> "LU52I" + SSLT{} -> "SSLT" + SSLTU{} -> "SSLTU" + PCADDI{} -> "PCADDI" + PCADDU12I{} -> "PCADDU12I" + PCADDU18I{} -> "PCADDU18I" + PCALAU12I{} -> "PCALAU12I" + AND{} -> "AND" + OR{} -> "OR" + XOR{} -> "XOR" + NOR{} -> "NOR" + ANDN{} -> "ANDN" + ORN{} -> "ORN" + MUL{} -> "MUL" + MULW{} -> "MULW" + MULWU{} -> "MULWU" + MULH{} -> "MULH" + MULHU{} -> "MULHU" + DIV{} -> "DIV" + MOD{} -> "MOD" + DIVU{} -> "DIVU" + MODU{} -> "MODU" + SLL{} -> "SLL" + SRL{} -> "SRL" + SRA{} -> "SRA" + ROTR{} -> "ROTR" + EXT{} -> "EXT" + CLO{} -> "CLO" + CLZ{} -> "CLZ" + CTO{} -> "CTO" + CTZ{} -> "CTZ" + BYTEPICK{} -> "BYTEPICK" + REVB2H{} -> "REVB2H" + REVB4H{} -> "REVB4H" + REVB2W{} -> "REVB2W" + REVBD{} -> "REVBD" + REVH2W{} -> "REVH2W" + REVHD{} -> "REVHD" + BITREV4B{} -> "BITREV4B" + BITREV8B{} -> "BITREV8B" + BITREVW{} -> "BITREVW" + BITREVD{} -> "BITREVD" + BSTRINS{} -> "BSTRINS" + BSTRPICK{} -> "BSTRPICK" + MASKEQZ{} -> "MASKEQZ" + MASKNEZ{} -> "MASKNEZ" + NOP{} -> "NOP" + MOV{} -> "MOV" + NEG{} -> "NEG" + CSET{} -> "CSET" + J{} -> "J" + J_TBL{} -> "J_TBL" + B{} -> "B" + BL{} -> "BL" + CALL{} -> "CALL" + CALL36{} -> "CALL36" + TAIL36{} -> "TAIL36" + BCOND1{} -> "BCOND1" + BCOND{} -> "BCOND" + BEQZ{} -> "BEQZ" + BNEZ{} -> "BNEZ" + LD{} -> "LD" + LDU{} -> "LDU" + ST{} -> "ST" + LDX{} -> "LDX" + LDXU{} -> "LDXU" + STX{} -> "STX" + LDPTR{} -> "LDPTR" + STPTR{} -> "STPTR" + PRELD{} -> "PRELD" + DBAR{} -> "DBAR" + IBAR{} -> "IBAR" + FCVT{} -> "FCVT" + SCVTF{} -> "SCVTF" + FCVTZS{} -> "FCVTZS" + FMAX{} -> "FMAX" + FMIN{} -> "FMIN" + FMAXA{} -> "FMAXA" + FMINA{} -> "FMINA" + FNEG{} -> "FNEG" + FABS{} -> "FABS" + FSQRT{} -> "FSQRT" + FMA variant _ _ _ _ -> + case variant of + FMAdd -> "FMADD" + FMSub -> "FMSUB" + FNMAdd -> "FNMADD" + FNMSub -> "FNMSUB" + +data Target + = TBlock BlockId + | TLabel CLabel + | TReg Reg + +data Operand + = OpReg Width Reg -- register + | OpImm Imm -- immediate + | OpAddr AddrMode -- address + deriving (Eq, Show) + +opReg :: Reg -> Operand +opReg = OpReg W64 + +opRegNo :: RegNo -> Operand +opRegNo = opReg . regSingle + +-- LoongArch64 has no ip register in ABI. Here ip register is for spilling/ +-- reloading register to/from slots. So make t8(r20) non-free for ip. +zero, ra, tp, sp, fp, tmp :: Operand +zero = opReg zeroReg +ra = opReg raReg +sp = opReg spMachReg +tp = opReg tpMachReg +fp = opReg fpMachReg +tmp = opReg tmpReg + +x0, x1, x2, x3, x4, x5, x6, x7 :: Operand +x8, x9, x10, x11, x12, x13, x14, x15 :: Operand +x16, x17, x18, x19, x20, x21, x22, x23 :: Operand +x24, x25, x26, x27, x28, x29, x30, x31 :: Operand +x0 = opRegNo 0 +x1 = opRegNo 1 +x2 = opRegNo 2 +x3 = opRegNo 3 +x4 = opRegNo 4 +x5 = opRegNo 5 +x6 = opRegNo 6 +x7 = opRegNo 7 +x8 = opRegNo 8 +x9 = opRegNo 9 +x10 = opRegNo 10 +x11 = opRegNo 11 +x12 = opRegNo 12 +x13 = opRegNo 13 +x14 = opRegNo 14 +x15 = opRegNo 15 +x16 = opRegNo 16 +x17 = opRegNo 17 +x18 = opRegNo 18 +x19 = opRegNo 19 +x20 = opRegNo 20 +x21 = opRegNo 21 +x22 = opRegNo 22 +x23 = opRegNo 23 +x24 = opRegNo 24 +x25 = opRegNo 25 +x26 = opRegNo 26 +x27 = opRegNo 27 +x28 = opRegNo 18 +x29 = opRegNo 29 +x30 = opRegNo 30 +x31 = opRegNo 31 + +d0, d1, d2, d3, d4, d5, d6, d7 :: Operand +d8, d9, d10, d11, d12, d13, d14, d15 :: Operand +d16, d17, d18, d19, d20, d21, d22, d23 :: Operand +d24, d25, d26, d27, d28, d29, d30, d31 :: Operand +d0 = opRegNo 32 +d1 = opRegNo 33 +d2 = opRegNo 34 +d3 = opRegNo 35 +d4 = opRegNo 36 +d5 = opRegNo 37 +d6 = opRegNo 38 +d7 = opRegNo 39 +d8 = opRegNo 40 +d9 = opRegNo 41 +d10 = opRegNo 42 +d11 = opRegNo 43 +d12 = opRegNo 44 +d13 = opRegNo 45 +d14 = opRegNo 46 +d15 = opRegNo 47 +d16 = opRegNo 48 +d17 = opRegNo 49 +d18 = opRegNo 50 +d19 = opRegNo 51 +d20 = opRegNo 52 +d21 = opRegNo 53 +d22 = opRegNo 54 +d23 = opRegNo 55 +d24 = opRegNo 56 +d25 = opRegNo 57 +d26 = opRegNo 58 +d27 = opRegNo 59 +d28 = opRegNo 60 +d29 = opRegNo 61 +d30 = opRegNo 62 +d31 = opRegNo 63 + +fitsInNbits :: Int -> Int -> Bool +fitsInNbits n i = (-1 `shiftL` (n - 1)) <= i && i <= (1 `shiftL` (n - 1) - 1) + +isUnsignOp :: Int -> Bool +isUnsignOp i = (i >= 0) + +isNbitEncodeable :: Int -> Integer -> Bool +isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + +isEncodeableInWidth :: Width -> Integer -> Bool +isEncodeableInWidth = isNbitEncodeable . widthInBits + +isIntOp :: Operand -> Bool +isIntOp = not . isFloatOp + +isFloatOp :: Operand -> Bool +isFloatOp (OpReg _ reg) | isFloatReg reg = True +isFloatOp _ = False + +isFloatReg :: Reg -> Bool +isFloatReg (RegReal (RealRegSingle i)) | i > 31 = True +isFloatReg (RegVirtual (VirtualRegD _)) = True +isFloatReg _ = False + +widthToInt :: Width -> Int +widthToInt W8 = 8 +widthToInt W16 = 16 +widthToInt W32 = 32 +widthToInt W64 = 64 +widthToInt _ = 64 + +widthFromOpReg :: Operand -> Width +widthFromOpReg (OpReg W8 _) = W8 +widthFromOpReg (OpReg W16 _) = W16 +widthFromOpReg (OpReg W32 _) = W32 +widthFromOpReg (OpReg W64 _) = W64 +widthFromOpReg _ = W64 + +ldFormat :: Format -> Format +ldFormat f + | f `elem` [II8, II16, II32, II64] = II64 + | f `elem` [FF32, FF64] = FF64 + | otherwise = pprPanic "unsupported ldFormat: " (text $ show f) diff --git a/GHC/CmmToAsm/LA64/Ppr.hs b/GHC/CmmToAsm/LA64/Ppr.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/Ppr.hs @@ -0,0 +1,1149 @@ +module GHC.CmmToAsm.LA64.Ppr (pprNatCmmDecl, pprInstr) where + +import GHC.Prelude hiding (EQ) + +import GHC.CmmToAsm.LA64.Regs +import GHC.CmmToAsm.LA64.Instr +import GHC.CmmToAsm.LA64.Cond +import GHC.CmmToAsm.Config +import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Ppr +import GHC.CmmToAsm.Types +import GHC.CmmToAsm.Utils +import GHC.Cmm hiding (topInfoTable) +import GHC.Cmm.BlockId +import GHC.Cmm.CLabel +import GHC.Cmm.Dataflow.Label +import GHC.Platform +import GHC.Platform.Reg +import GHC.Types.Unique ( pprUniqueAlways, getUnique ) +import GHC.Utils.Outputable +import GHC.Types.Basic (Alignment, alignmentBytes, mkAlignment) +import GHC.Utils.Panic + +pprNatCmmDecl :: forall doc. (IsDoc doc) => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc + +pprNatCmmDecl config (CmmData section dats) = + pprSectionAlign config section $$ pprDatas config dats + +pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = + let platform = ncgPlatform config + + pprProcAlignment :: doc + pprProcAlignment = maybe empty (pprAlign . mkAlignment) (ncgProcAlignment config) + in pprProcAlignment + $$ case topInfoTable proc of + Nothing -> + -- special case for code without info table: + pprSectionAlign config (Section Text lbl) + $$ + -- do not + -- pprProcAlignment config $$ + pprLabel platform lbl + $$ vcat (map (pprBasicBlock config top_info) blocks) -- blocks guaranteed not null, so label needed + $$ ppWhen + (ncgDwarfEnabled config) + (line (pprBlockEndLabel platform lbl) $$ line (pprProcEndLabel platform lbl)) + $$ pprSizeDecl platform lbl + Just (CmmStaticsRaw info_lbl _) -> + pprSectionAlign config (Section Text info_lbl) + $$ + -- pprProcAlignment config $$ + ( if platformHasSubsectionsViaSymbols platform + then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':') + else empty + ) + $$ vcat (map (pprBasicBlock config top_info) blocks) + $$ ppWhen (ncgDwarfEnabled config) (line (pprProcEndLabel platform info_lbl)) + $$ + -- above: Even the first block gets a label, because with branch-chain + -- elimination, it might be the target of a goto. + ( if platformHasSubsectionsViaSymbols platform + then -- See Note [Subsections Via Symbols] + + line + $ text "\t.long " + <+> pprAsmLabel platform info_lbl + <+> char '-' + <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl) + else empty + ) + $$ pprSizeDecl platform info_lbl +{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc #-} +{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable + +pprProcEndLabel :: IsLine doc => Platform -> CLabel -- ^ Procedure + -> doc +pprProcEndLabel platform lbl = + pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon + +pprBlockEndLabel :: IsLine doc => Platform -> CLabel -- ^ Block name + -> doc +pprBlockEndLabel platform lbl = + pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon + +pprLabel :: IsDoc doc => Platform -> CLabel -> doc +pprLabel platform lbl = + pprGloblDecl platform lbl + $$ pprTypeDecl platform lbl + $$ line (pprAsmLabel platform lbl <> char ':') + +pprAlign :: (IsDoc doc) => Alignment -> doc +pprAlign alignment = + -- .balign is stable, whereas .align is platform dependent. + line $ text "\t.balign " <> int (alignmentBytes alignment) + +-- | Print appropriate alignment for the given section type. +-- +-- Currently, this always aligns to a full machine word (8 byte.) A future +-- improvement could be to really do this per section type (though, it's +-- probably not a big gain.) +pprAlignForSection :: (IsDoc doc) => SectionType -> doc +pprAlignForSection _seg = pprAlign . mkAlignment $ 8 + +-- Print section header and appropriate alignment for that section. +-- This will e.g. emit a header like: +-- +-- .section .text +-- .balign 8 +-- +pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc +pprSectionAlign _config (Section (OtherSection _) _) = + panic "LA64.Ppr.pprSectionAlign: unknown section" +pprSectionAlign config sec@(Section seg _) = + line (pprSectionHeader config sec) + $$ pprAlignForSection seg + +-- | Output the ELF .size directive +pprSizeDecl :: (IsDoc doc) => Platform -> CLabel -> doc +pprSizeDecl platform lbl + | osElfTarget (platformOS platform) = + line $ text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl +pprSizeDecl _ _ = empty + +pprBasicBlock :: + (IsDoc doc) => + NCGConfig -> + LabelMap RawCmmStatics -> + NatBasicBlock Instr -> + doc + +pprBasicBlock config info_env (BasicBlock blockid instrs) + = maybe_infotable $ + pprLabel platform asmLbl $$ + vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$ + ppWhen (ncgDwarfEnabled config) ( + -- Emit both end labels since this may end up being a standalone + -- top-level block + line (pprBlockEndLabel platform asmLbl + <> pprProcEndLabel platform asmLbl) + ) + where + -- Filter out identity moves. E.g. mov x18, x18 will be dropped. + optInstrs = filter f instrs + where f (MOV o1 o2) | o1 == o2 = False + f _ = True + + asmLbl = blockLbl blockid + platform = ncgPlatform config + maybe_infotable c = case mapLookup blockid info_env of + Nothing -> c + Just (CmmStaticsRaw info_lbl info) -> + -- pprAlignForSection platform Text $$ + infoTableLoc $$ + vcat (map (pprData config) info) $$ + pprLabel platform info_lbl $$ + c $$ + ppWhen (ncgDwarfEnabled config) + (line (pprBlockEndLabel platform info_lbl)) + -- Make sure the info table has the right .loc for the block + -- coming right after it. See Note [Info Offset] + infoTableLoc = case instrs of + (l@LOCATION{} : _) -> pprInstr platform l + _other -> empty + +pprDatas :: IsDoc doc => NCGConfig -> RawCmmStatics -> doc +-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel". +pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _]) + | lbl == mkIndStaticInfoLabel + , let labelInd (CmmLabelOff l _) = Just l + labelInd (CmmLabel l) = Just l + labelInd _ = Nothing + , Just ind' <- labelInd ind + , alias `mayRedirectTo` ind' + = pprGloblDecl (ncgPlatform config) alias + $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind') + +pprDatas config (CmmStaticsRaw lbl dats) + = vcat (pprLabel platform lbl : map (pprData config) dats) + where + platform = ncgPlatform config + +pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc +pprData _config (CmmString str) = line (pprString str) +pprData _config (CmmFileEmbed path _) = line (pprFileEmbed path) + +pprData config (CmmUninitialised bytes) + = line $ let platform = ncgPlatform config + in if platformOS platform == OSDarwin + then text ".space " <> int bytes + else text ".skip " <> int bytes + +pprData config (CmmStaticLit lit) = pprDataItem config lit + +pprGloblDecl :: IsDoc doc => Platform -> CLabel -> doc +pprGloblDecl platform lbl + | not (externallyVisibleCLabel lbl) = empty + | otherwise = line (text "\t.globl " <> pprAsmLabel platform lbl) + +-- Always use objects for info tables +-- +-- See discussion in X86.Ppr for why this is necessary. Essentially we need to +-- ensure that we never pass function symbols when we might want to lookup the +-- info table. If we did, we could end up with procedure linking tables +-- (PLT)s, and thus the lookup wouldn't point to the function, but into the +-- jump table. +-- +-- Fun fact: The LLVMMangler exists to patch this issue su on the LLVM side as +-- well. +pprLabelType' :: IsLine doc => Platform -> CLabel -> doc +pprLabelType' platform lbl = + if isCFunctionLabel lbl || functionOkInfoTable + then text "@function" + else text "@object" + where + functionOkInfoTable = platformTablesNextToCode platform && + isInfoTableLabel lbl && not (isCmmInfoTableLabel lbl) && not (isConInfoTableLabel lbl) + +-- this is called pprTypeAndSizeDecl in PPC.Ppr +pprTypeDecl :: IsDoc doc => Platform -> CLabel -> doc +pprTypeDecl platform lbl + = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl + then line (text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl) + else empty + +pprDataItem :: IsDoc doc => NCGConfig -> CmmLit -> doc +pprDataItem config lit + = lines_ (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit) + where + platform = ncgPlatform config + + imm = litToImm lit + + ppr_item II8 _ = [text "\t.byte\t" <> pprDataImm platform imm] + ppr_item II16 _ = [text "\t.short\t" <> pprDataImm platform imm] + ppr_item II32 _ = [text "\t.long\t" <> pprDataImm platform imm] + ppr_item II64 _ = [text "\t.quad\t" <> pprDataImm platform imm] + + ppr_item FF32 (CmmFloat r _) + = let bs = floatToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> int (fromIntegral b)) bs + + ppr_item FF64 (CmmFloat r _) + = let bs = doubleToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> int (fromIntegral b)) bs + + ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit) + +-- | Pretty print an immediate value in the @data@ section +-- This does not include any checks. We rely on the Assembler to check for +-- errors. Use `pprOpImm` for immediates in instructions (operands.) +pprDataImm :: IsLine doc => Platform -> Imm -> doc +pprDataImm _ (ImmInt i) = int i +pprDataImm _ (ImmInteger i) = integer i +pprDataImm p (ImmCLbl l) = pprAsmLabel p l +pprDataImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i +pprDataImm _ (ImmLit s) = ftext s +pprDataImm _ (ImmFloat f) = float (fromRational f) +pprDataImm _ (ImmDouble d) = double (fromRational d) + +pprDataImm p (ImmConstantSum a b) = pprDataImm p a <> char '+' <> pprDataImm p b +pprDataImm p (ImmConstantDiff a b) = pprDataImm p a <> char '-' + <> lparen <> pprDataImm p b <> rparen + +asmComment :: SDoc -> SDoc +asmComment c = text "#" <+> c + +asmDoubleslashComment :: SDoc -> SDoc +asmDoubleslashComment c = text "//" <+> c + +asmMultilineComment :: SDoc -> SDoc +asmMultilineComment c = text "/*" $+$ c $+$ text "*/" + +-- | Pretty print an immediate operand of an instruction +pprOpImm :: (IsLine doc) => Platform -> Imm -> doc +pprOpImm platform imm = case imm of + ImmInt i -> int i + ImmInteger i -> integer i + ImmCLbl l -> char '=' <> pprAsmLabel platform l + ImmFloat f -> float (fromRational f) + ImmDouble d -> double (fromRational d) + _ -> pprPanic "LA64.Ppr.pprOpImm" (text "Unsupported immediate for instruction operands:" <+> (text . show) imm) + +negOp :: Operand -> Operand +negOp (OpImm (ImmInt i)) = OpImm (ImmInt (negate i)) +negOp (OpImm (ImmInteger i)) = OpImm (ImmInteger (negate i)) +negOp op = pprPanic "LA64.negOp" (text $ show op) + +pprOp :: IsLine doc => Platform -> Operand -> doc +pprOp plat op = case op of + OpReg w r -> pprReg w r + OpImm imm -> pprOpImm plat imm + OpAddr (AddrRegReg r1 r2) -> pprReg W64 r1 <> comma <+> pprReg W64 r2 + OpAddr (AddrRegImm r imm) -> pprReg W64 r <> comma <+> pprOpImm plat imm + OpAddr (AddrReg r) -> pprReg W64 r <+> text ", 0" + +pprReg :: forall doc. IsLine doc => Width -> Reg -> doc +pprReg w r = case r of + RegReal (RealRegSingle i) -> ppr_reg_no i + -- virtual regs should not show up, but this is helpful for debugging. + RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u + -- RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u + RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u + _ -> pprPanic "LA64.pprReg" (text (show r) <+> ppr w) + + where + ppr_reg_no :: Int -> doc + -- LoongArch's registers must be started from `$[fr]` + -- General Purpose Registers + ppr_reg_no 0 = text "$zero" + ppr_reg_no 1 = text "$ra" + ppr_reg_no 2 = text "$tp" + ppr_reg_no 3 = text "$sp" + ppr_reg_no 4 = text "$a0" + ppr_reg_no 5 = text "$a1" + ppr_reg_no 6 = text "$a2" + ppr_reg_no 7 = text "$a3" + ppr_reg_no 8 = text "$a4" + ppr_reg_no 9 = text "$a5" + ppr_reg_no 10 = text "$a6" + ppr_reg_no 11 = text "$a7" + ppr_reg_no 12 = text "$t0" + ppr_reg_no 13 = text "$t1" + ppr_reg_no 14 = text "$t2" + ppr_reg_no 15 = text "$t3" + ppr_reg_no 16 = text "$t4" + ppr_reg_no 17 = text "$t5" + ppr_reg_no 18 = text "$t6" + ppr_reg_no 19 = text "$t7" + ppr_reg_no 20 = text "$t8" + ppr_reg_no 21 = text "$u0" -- Reserverd + ppr_reg_no 22 = text "$fp" + ppr_reg_no 23 = text "$s0" + ppr_reg_no 24 = text "$s1" + ppr_reg_no 25 = text "$s2" + ppr_reg_no 26 = text "$s3" + ppr_reg_no 27 = text "$s4" + ppr_reg_no 28 = text "$s5" + ppr_reg_no 29 = text "$s6" + ppr_reg_no 30 = text "$s7" + ppr_reg_no 31 = text "$s8" + + -- Floating Point Registers + ppr_reg_no 32 = text "$fa0" + ppr_reg_no 33 = text "$fa1" + ppr_reg_no 34 = text "$fa2" + ppr_reg_no 35 = text "$fa3" + ppr_reg_no 36 = text "$fa4" + ppr_reg_no 37 = text "$fa5" + ppr_reg_no 38 = text "$fa6" + ppr_reg_no 39 = text "$fa7" + ppr_reg_no 40 = text "$ft0" + ppr_reg_no 41 = text "$ft1" + ppr_reg_no 42 = text "$ft2" + ppr_reg_no 43 = text "$ft3" + ppr_reg_no 44 = text "$ft4" + ppr_reg_no 45 = text "$ft5" + ppr_reg_no 46 = text "$ft6" + ppr_reg_no 47 = text "$ft7" + ppr_reg_no 48 = text "$ft8" + ppr_reg_no 49 = text "$ft9" + ppr_reg_no 50 = text "$ft10" + ppr_reg_no 51 = text "$ft11" + ppr_reg_no 52 = text "$ft12" + ppr_reg_no 53 = text "$ft13" + ppr_reg_no 54 = text "$ft14" + ppr_reg_no 55 = text "$ft15" + ppr_reg_no 56 = text "$fs0" + ppr_reg_no 57 = text "$fs1" + ppr_reg_no 58 = text "$fs2" + ppr_reg_no 59 = text "$fs3" + ppr_reg_no 60 = text "$fs4" + ppr_reg_no 61 = text "$fs5" + ppr_reg_no 62 = text "$fs6" + ppr_reg_no 63 = text "$fs7" + + ppr_reg_no i + | i < 0 = pprPanic "Unexpected register number (min is 0)" (ppr w <+> int i) + | i > 63 = pprPanic "Unexpected register number (max is 63)" (ppr w <+> int i) + -- no support for widths > W64. + | otherwise = pprPanic "Unsupported width in register (max is 64)" (ppr w <+> int i) + +-- | Single precission `Operand` (floating-point) +isSingleOp :: Operand -> Bool +isSingleOp (OpReg W32 _) = True +isSingleOp _ = False + +-- | Double precission `Operand` (floating-point) +isDoubleOp :: Operand -> Bool +isDoubleOp (OpReg W64 _) = True +isDoubleOp _ = False + +-- | `Operand` is an immediate value +isImmOp :: Operand -> Bool +isImmOp (OpImm _) = True +isImmOp _ = False + +-- | `Operand` is an immediate @0@ value +isImmZero :: Operand -> Bool +isImmZero (OpImm (ImmFloat 0)) = True +isImmZero (OpImm (ImmDouble 0)) = True +isImmZero (OpImm (ImmInt 0)) = True +isImmZero _ = False + +pprInstr :: IsDoc doc => Platform -> Instr -> doc +pprInstr platform instr = case instr of + -- Meta Instructions --------------------------------------------------------- + -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable + COMMENT s -> dualDoc (asmComment s) empty + MULTILINE_COMMENT s -> dualDoc (asmMultilineComment s) empty + ANN d i -> dualDoc (pprInstr platform i <+> asmDoubleslashComment d) (pprInstr platform i) + + LOCATION file line' col _name + -> line (text "\t.loc" <+> int file <+> int line' <+> int col) + DELTA d -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty + NEWBLOCK _ -> panic "PprInstr: NEWBLOCK" + LDATA _ _ -> panic "PprInstr: NEWBLOCK" + + -- Pseudo Instructions ------------------------------------------------------- + + PUSH_STACK_FRAME -> lines_ [ text "\taddi.d $sp, $sp, -16" + , text "\tst.d $ra, $sp, 8" + , text "\tst.d $fp, $sp, 0" + , text "\taddi.d $fp, $sp, 16" + ] + + POP_STACK_FRAME -> lines_ [ text "\tld.d $fp, $sp, 0" + , text "\tld.d $ra, $sp, 8" + , text "\taddi.d $sp, $sp, 16" + ] + + + -- =========================================================================== + -- LoongArch64 Instruction Set + -- Basic Integer Instructions ------------------------------------------------ + -- 1. Arithmetic Instructions ------------------------------------------------ + -- ADD.{W/D}, SUB.{W/D} + -- ADDI.{W/D}, ADDU16I.D + ADD o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfadd.s") o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfadd.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tadd.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tadd.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddi.w") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\taddi.d") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: ADD error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- TODO: Not complete. + -- Here we should add addu16i.d for optimizations of accelerating GOT accession + -- with ldptr.w/d, stptr.w/d + SUB o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfsub.s") o1 o2 o3 + | isFloatOp o2 && isFloatOp o3 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfsub.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsub.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsub.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddi.w") o1 o2 (negOp o3) + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\taddi.d") o1 o2 (negOp o3) + | otherwise -> pprPanic "LA64.ppr: SUB error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- ALSL.{W[U]/D} + ALSL o1 o2 o3 o4 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3, isImmOp o4 -> op4 (text "\talsl.w") o1 o2 o3 o4 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3, isImmOp o4 -> op4 (text "\talsl.d") o1 o2 o3 o4 + | otherwise -> pprPanic "LA64.ppr: ALSL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + ALSLU o1 o2 o3 o4 -> op4 (text "\talsl.wu") o1 o2 o3 o4 + -- LoongArch-Assembler should implement following pesudo instructions, here we can directly use them. + -- li.w rd, s32 + -- li.w rd, u32 + -- li.d rd, s64 + -- li.d rd, u64 + -- + -- # Load with one instruction + -- ori dst, $zero, imm[11:0] + -- + -- # Load with two instructions + -- lu12i.w dst, imm[31:12] + -- ori dst, dst, imm[11:0] + -- + -- # Load with four instructions + -- lu12i.w dst, imm[31:12] + -- ori dst, dst, imm[11:0] + -- lu32i.d dst, imm[51:32] + -- lu52i.d dst, dst, imm[63:52] + + -- -- LU12I.W, LU32I.D, LU52I.D + LU12I o1 o2 -> op2 (text "\tlu12i.w") o1 o2 + LU32I o1 o2 -> op2 (text "\tlu32i.d") o1 o2 + LU52I o1 o2 o3 -> op3 (text "\tlu52i.d") o1 o2 o3 + -- SSLT[U] + -- SSLT[U]I + SSLT o1 o2 o3 + | isImmOp o3 -> op3 (text "\tslti") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tslt") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: SSLT error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + SSLTU o1 o2 o3 + | isImmOp o3 -> op3 (text "\tsltui") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsltu") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: SSLTU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- PCADDI, PCADDU121, PCADDU18l, PCALAU12I + PCADDI o1 o2 -> op2 (text "\tpcaddi") o1 o2 + PCADDU12I o1 o2 -> op2 (text "\tpcaddu12i") o1 o2 + PCADDU18I o1 (OpImm (ImmCLbl lbl)) -> + lines_ [ + text "\tpcaddu18i" <+> pprOp platform o1 <> comma <+> text "%call36(" <+> pprAsmLabel platform lbl <+> text ")" + ] + PCALAU12I o1 o2 -> op2 (text "\tpcalau12i") o1 o2 + -- AND, OR, NOR, XOR, ANDN, ORN + -- ANDI, ORI, XORI: zero-extention + AND o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tand") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\tandi") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: AND error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + OR o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tor") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\tori") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: OR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + XOR o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\txor") o1 o2 o3 + | OpReg W64 _ <- o2, isImmOp o3 -> op3 (text "\txori") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: XOR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + NOR o1 o2 o3 -> op3 (text "\tnor") o1 o2 o3 + ANDN o1 o2 o3 -> op3 (text "\tandn") o1 o2 o3 + ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 + + ----------------------------------------------------------------------------- + -- Pseudo instructions + -- NOP, alias for "andi r0, r0, r0" + NOP -> line $ text "\tnop" + -- NEG o1 o2, alias for "sub o1, r0, o2" + NEG o1 o2 + | isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfneg.s") o1 o2 + | isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfneg.d") o1 o2 + | OpReg W32 _ <- o2 -> op3 (text "\tsub.w" ) o1 zero o2 + | OpReg W64 _ <- o2 -> op3 (text "\tsub.d" ) o1 zero o2 + | otherwise -> pprPanic "LA64.ppr: NEG error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + -- Here we can do more simplitcations. + -- To be honest, floating point instructions are too scarce, so maybe + -- we should reimplement some pseudo instructions with others. + MOV o1 o2 + | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> op2 (text "\tfmov.s") o1 o2 + | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> op2 (text "\tfmov.d") o1 o2 + | isFloatOp o1 && isImmZero o2 && isSingleOp o1 -> op2 (text "\tmovgr2fr.w") o1 zero + | isFloatOp o1 && isImmZero o2 && isDoubleOp o1 -> op2 (text "\tmovgr2fr.d") o1 zero + | isFloatOp o1 && not (isFloatOp o2) && isSingleOp o1 -> op2 (text "\tmovgr2fr.w") o1 o2 + | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tmovgr2fr.d") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tmovfr2gr.s") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tmovfr2gr.d") o1 o2 + | isImmOp o2, (OpImm (ImmInt i)) <- o2, fitsInNbits 12 (fromIntegral i) -> + lines_ [text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2] + | isImmOp o2, (OpImm (ImmInteger i)) <- o2, fitsInNbits 12 (fromIntegral i) -> + lines_ [text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <+> comma <> pprOp platform o2] + | OpReg W64 _ <- o2 -> op2 (text "\tmove") o1 o2 + | OpReg _ _ <- o2 -> + lines_ [ + text "\tbstrpick.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform (OpImm (ImmInt ((widthToInt (min (widthFromOpReg o1) (widthFromOpReg o2))) - 1))) <+> text ", 0" + ] + -- TODO: Maybe we can do more. + -- Let the assembler do these concret things. + | isImmOp o2 -> + lines_ [text "\tli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2] + | otherwise -> pprPanic "LA64.ppr: MOV error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + + -- CSET pesudo instrcutions implementation + CSET cond dst o1 o2 -> case cond of + -- SEQ dst, rd, rs -> [SUB rd, rd, rs; sltui dst, rd, 1] + EQ | isIntOp o1 && isIntOp o2 -> + lines_ [ + subFor o1 o2, + text "\tsltui" <+> pprOp platform dst <> comma <+> pprOp platform dst <> comma <+> pprOp platform (OpImm (ImmInt 1)) + ] + EQ | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.seq.d $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + EQ | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.seq.s $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + -- SNE rd, rs -> [SUB rd, rd, rs; sltu rd, zero, rs] + NE | isIntOp o1 && isIntOp o2 -> + lines_ [ + subFor o1 o2, + text "\tsltu" <+> pprOp platform dst <> comma <+> text "$r0" <+> comma <+> pprOp platform dst + ] + NE | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.cune.d $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + NE | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.cune.s $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + SLT -> lines_ [ sltFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2 ] + -- SLE rd, rs -> [SLT rd, rs; xori rd, rs, o1] + SLE -> + lines_ [ + sltFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\txori" <+> pprOp platform dst <> comma <+> pprOp platform dst <> comma <+> pprOp platform (OpImm (ImmInt 1)) + ] + -- SGE rd, rs -> [SLT rd, rs; xori rd, rs, o1] + SGE -> + lines_ [ + sltFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\txori" <+> pprOp platform dst <> comma <+> pprOp platform dst <> comma <+> pprOp platform (OpImm (ImmInt 1)) + ] + -- SGT rd, rs -> [SLT rd, rs] + SGT -> lines_ [ sltFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o1 ] + + ULT -> lines_ [ sltuFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2 ] + ULE -> + lines_ [ + sltuFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\txori" <+> pprOp platform dst <> comma <+> pprOp platform dst <> comma <+> pprOp platform (OpImm (ImmInt 1)) + ] + -- UGE rd, rs -> [SLTU rd, rs; xori rd, rs, 1] + UGE -> + lines_ [ + sltuFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\txori" <+> pprOp platform dst <> comma <+> pprOp platform dst <> comma <+> pprOp platform (OpImm (ImmInt 1)) + ] + -- SGTU rd, rs -> [SLTU rd, rs] + UGT -> lines_ [ sltuFor o1 o2 <+> pprOp platform dst <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o1 ] + + -- TODO: + -- LoongArch's floating point instrcutions don't write the compared result to an interger register, instead of cc. + -- Fcond dst o1 o2 -> [fcmp.cond.[s/d] fcc0 o1 o2; movcf2gr dst, fcc0] + FLT | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.slt.d $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FLE | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.sle.d $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FGT | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.slt.d $fcc0," <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FGE | isFloatOp o1 && isFloatOp o2 && isDoubleOp o1 && isDoubleOp o2 -> + lines_ [ + text "\tfcmp.sle.d $fcc0," <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + + FLT | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.slt.s $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FLE | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.sle.s $fcc0," <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FGT | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.slt.s $fcc0," <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + FGE | isFloatOp o1 && isFloatOp o2 && isSingleOp o1 && isSingleOp o2 -> + lines_ [ + text "\tfcmp.sle.s $fcc0," <+> pprOp platform o2 <> comma <+> pprOp platform o1, + text "\tmovcf2gr" <+> pprOp platform dst <+> text ", $fcc0" + ] + + _ -> pprPanic "LA64.ppr: CSET error: " (pprCond cond <+> pprOp platform dst <> comma <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + + where + subFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = + text "\taddi.d" <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform (negOp o2) + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = + text "\tsub.d" <+> pprOp platform dst <> comma <+> pprOp platform o1 <> comma <+> pprOp platform o2 + | otherwise = pprPanic "LA64.ppr: unknown subFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + + sltFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = text "\tslti" + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = text "\tslt" + | otherwise = pprPanic "LA64.ppr: unknown sltFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + + sltuFor o1 o2 | (OpReg W64 _) <- dst, (OpImm _) <- o2 = text "\tsltui" + | (OpReg W64 _) <- dst, (OpReg W64 _) <- o2 = text "\tsltu" + | otherwise = pprPanic "LA64.ppr: unknown sltuFor format: " ((ppr (widthFromOpReg dst)) <+> pprOp platform dst <+> (ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + + -- MUL.{W/D}, MULH, {W[U]/D[U]}, 'h' means high 32bit. + -- MULW.D.W[U] + MUL o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfmul.s") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfmul.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmul.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmul.d") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MUL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MULW o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.w") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MULW error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MULWU o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulw.d.wu") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MULWU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MULH o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o2 -> op3 (text "\tmulh.d") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MULH error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MULHU o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmulh.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmulh.du") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MULHU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- DIV.{W[U]/D[U]}, MOD.{W[U]/D[U]} + DIV o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isSingleOp o1 && isSingleOp o2 && isSingleOp o3 -> op3 (text "\tfdiv.s") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 && isDoubleOp o1 && isDoubleOp o2 && isDoubleOp o3 -> op3 (text "\tfdiv.d") o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.d") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: DIV error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + DIVU o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tdiv.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tdiv.du") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: DIVU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MOD o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.d") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MOD error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + MODU o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tmod.wu") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tmod.du") o1 o2 o3 + | otherwise -> pprPanic "LA64.ppr: MODU error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- 2. Bit-shift Instuctions -------------------------------------------------- + -- SLL.W, SRL.W, SRA.W, ROTR.W + -- SLL.D, SRL.D, SRA.D, ROTR.D + -- SLLI.W, SRLI.W, SRAI.W, ROTRI.W + -- SLLI.D, SRLI.D, SRAI.D, ROTRI.D + SLL o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsll.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsll.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> + lines_ [text "\tslli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | OpReg W64 _ <- o2, isImmOp o3 -> + lines_ [text "\tslli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | otherwise -> pprPanic "LA64.ppr: SLL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + SRL o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsrl.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsrl.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> + lines_ [text "\tsrli.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | OpReg W64 _ <- o2, isImmOp o3 -> + lines_ [text "\tsrli.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | otherwise -> pprPanic "LA64.ppr: SRL error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + SRA o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\tsra.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\tsra.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> + lines_ [text "\tsrai.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | OpReg W64 _ <- o2, isImmOp o3 -> + lines_ [text "\tsrai.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | otherwise -> pprPanic "LA64.ppr: SRA error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + ROTR o1 o2 o3 + | OpReg W32 _ <- o2, OpReg W32 _ <- o3 -> op3 (text "\trotr.w") o1 o2 o3 + | OpReg W64 _ <- o2, OpReg W64 _ <- o3 -> op3 (text "\trotr.d") o1 o2 o3 + | OpReg W32 _ <- o2, isImmOp o3 -> + lines_ [text "\trotri.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | OpReg W64 _ <- o2, isImmOp o3 -> + lines_ [text "\trotri.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3] + | otherwise -> pprPanic "LA64.ppr: ROTR error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2 <+> (ppr (widthFromOpReg o3)) <+> pprOp platform o3) + -- 3. Bit-manupulation Instructions ------------------------------------------ + -- EXT.W{B/H} + EXT o1 o2 + | OpReg W8 _ <- o2 -> op2 (text "\text.w.b") o1 o2 + | OpReg W16 _ <- o2 -> op2 (text "\text.w.h") o1 o2 + | otherwise -> pprPanic "LA64.ppr: EXT error: " ((ppr (widthFromOpReg o1)) <+> pprOp platform o1 <+> (ppr (widthFromOpReg o2)) <+> pprOp platform o2) + -- CL{O/Z}.{W/D}, CT{O/Z}.{W/D} + CLO o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tclo.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tclo.d") o1 o2 + | otherwise -> pprPanic "LA64.ppr: CLO error" (pprOp platform o1 <+> pprOp platform o2) + CLZ o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tclz.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tclz.d") o1 o2 + | otherwise -> pprPanic "LA64.ppr: CLZ error" (pprOp platform o1 <+> pprOp platform o2) + CTO o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tcto.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tcto.d") o1 o2 + | otherwise -> pprPanic "LA64.ppr: CTO error" (pprOp platform o1 <+> pprOp platform o2) + CTZ o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tctz.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tctz.d") o1 o2 + | otherwise -> pprPanic "LA64.ppr: CTZ error" (pprOp platform o1 <+> pprOp platform o2) + -- BYTEPICK.{W/D} rd, rj, rk, sa2/sa3 + BYTEPICK o1 o2 o3 o4 + | OpReg W32 _ <- o2 -> op4 (text "\tbytepick.w") o1 o2 o3 o4 + | OpReg W64 _ <- o2 -> op4 (text "\tbytepick.d") o1 o2 o3 o4 + | otherwise -> pprPanic "LA64.ppr: BYTEPICK error" (pprOp platform o1 <+> pprOp platform o2 <+> pprOp platform o3 <+> pprOp platform o4) + -- REVB.{2H/4H/2W/D} + REVB2H o1 o2 -> op2 (text "\trevb.2h") o1 o2 + REVB4H o1 o2 -> op2 (text "\trevb.4h") o1 o2 + REVB2W o1 o2 -> op2 (text "\trevb.2w") o1 o2 + REVBD o1 o2 -> op2 (text "\trevb.d") o1 o2 + -- REVH.{2W/D} + REVH2W o1 o2 -> op2 (text "\trevh.2w") o1 o2 + REVHD o1 o2 -> op2 (text "\trevh.d") o1 o2 + -- BITREV.{4B/8B} + -- BITREV.{W/D} + BITREV4B o1 o2 -> op2 (text "\tbitrev.4b") o1 o2 + BITREV8B o1 o2 -> op2 (text "\tbitrev.8b") o1 o2 + BITREVW o1 o2 -> op2 (text "\tbitrev.w") o1 o2 + BITREVD o1 o2 -> op2 (text "\tbitrev.d") o1 o2 + -- BSTRINS.{W/D} + BSTRINS II64 o1 o2 o3 o4 -> op4 (text "\tbstrins.d") o1 o2 o3 o4 + BSTRINS II32 o1 o2 o3 o4 -> op4 (text "\tbstrins.w") o1 o2 o3 o4 + -- BSTRPICK.{W/D} + BSTRPICK II64 o1 o2 o3 o4 -> op4 (text "\tbstrpick.d") o1 o2 o3 o4 + BSTRPICK II32 o1 o2 o3 o4 -> op4 (text "\tbstrpick.w") o1 o2 o3 o4 + -- MASKEQZ rd, rj, rk: if rk == 0 ? rd = 0 : rd = rj + MASKEQZ o1 o2 o3 -> op3 (text "\tmaskeqz") o1 o2 o3 + -- MASKNEZ: if rk == 0 ? rd = 0 : rd = rj + MASKNEZ o1 o2 o3 -> op3 (text "\tmasknez") o1 o2 o3 + -- 4. Branch Instructions ---------------------------------------------------- + -- BEQ, BNE, BLT[U], BGE[U] rj, rd, off16 + -- BEQZ, BNEZ rj, off21 + -- B + -- BL + -- JIRL + -- jr rd = jirl $zero, rd, 0: Commonly used for subroutine return. + J (TReg r) -> line $ text "\tjirl" <+> text "$r0" <> comma <+> pprReg W64 r <> comma <+> text " 0" + J_TBL _ _ r -> pprInstr platform (B (TReg r)) + + B (TBlock bid) -> line $ text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + B (TLabel lbl) -> line $ text "\tb" <+> pprAsmLabel platform lbl + B (TReg r) -> line $ text "\tjr" <+> pprReg W64 r + + BL (TBlock bid) _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BL (TLabel lbl) _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl + BL (TReg r) _ -> line $ text "\tjirl" <+> text "$r1" <> comma <+> pprReg W64 r <> comma <+> text " 0" + + CALL (TBlock bid) _ -> line $ text "\tcall36" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CALL (TLabel lbl) _ -> line $ text "\tcall36" <+> pprAsmLabel platform lbl + CALL (TReg r) _ -> line $ text "\tjirl" <+> text "$r1" <> comma <+> pprReg W64 r <> comma <+> text " 0" + + CALL36 (TBlock bid) -> line $ text "\tcall36" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + CALL36 (TLabel lbl) -> line $ text "\tcall36" <+> pprAsmLabel platform lbl + CALL36 _ -> panic "LA64.ppr: CALL36: Not to registers!" + TAIL36 r (TBlock bid) -> line $ text "\ttail36" <+> pprOp platform r <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + TAIL36 r (TLabel lbl) -> line $ text "\ttail36" <+> pprOp platform r <> comma <+> pprAsmLabel platform lbl + TAIL36 _ _ -> panic "LA64.ppr: TAIL36: Not to registers!" + + BCOND1 c j d (TBlock bid) -> case c of + SLE -> + line $ text "\tbge" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + SGT -> + line $ text "\tblt" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ULE -> + line $ text "\tbgeu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + UGT -> + line $ text "\tbltu" <+> pprOp platform d <> comma <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + _ -> line $ text "\t" <> pprBcond c <+> pprOp platform j <> comma <+> pprOp platform d <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + + BCOND1 _ _ _ (TLabel _) -> panic "LA64.ppr: BCOND1: No conditional branching to TLabel!" + + BCOND1 _ _ _ (TReg _) -> panic "LA64.ppr: BCOND1: No conditional branching to registers!" + + -- Reuse t8(IP) register + BCOND c j d (TBlock bid) -> case c of + SLE -> + lines_ [ + text "\tslt $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + SGT -> + lines_ [ + text "\tslt $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + ULE -> + lines_ [ + text "\tsltu $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + UGT -> + lines_ [ + text "\tsltu $t8, " <+> pprOp platform d <> comma <+> pprOp platform j, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + EQ -> + lines_ [ + text "\tsub.d $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + NE -> + lines_ [ + text "\tsub.d $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + SLT -> + lines_ [ + text "\tslt $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + SGE -> + lines_ [ + text "\tslt $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + ULT -> + lines_ [ + text "\tsltu $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbnez $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + UGE -> + lines_ [ + text "\tsltu $t8, " <+> pprOp platform j <> comma <+> pprOp platform d, + text "\tbeqz $t8, " <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + ] + _ -> panic "LA64.ppr: BCOND: Unsupported cond!" + + BCOND _ _ _ (TLabel _) -> panic "LA64.ppr: BCOND: No conditional branching to TLabel!" + + BCOND _ _ _ (TReg _) -> panic "LA64.ppr: BCOND: No conditional branching to registers!" + + BEQZ j (TBlock bid) -> + line $ text "\tbeqz" <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BEQZ j (TLabel lbl) -> + line $ text "\tbeqz" <+> pprOp platform j <> comma <+> pprAsmLabel platform lbl + BEQZ _ (TReg _) -> panic "LA64.ppr: BEQZ: No conditional branching to registers!" + + BNEZ j (TBlock bid) -> + line $ text "\tbnez" <+> pprOp platform j <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid)) + BNEZ j (TLabel lbl) -> + line $ text "\tbnez" <+> pprOp platform j <> comma <+> pprAsmLabel platform lbl + BNEZ _ (TReg _) -> panic "LA64.ppr: BNEZ: No conditional branching to registers!" + + -- 5. Common Memory Access Instructions -------------------------------------- + -- LD.{B[U]/H[U]/W[U]/D}, ST.{B/H/W/D}: AddrRegImm + -- LD: load, ST: store, x: offset in register, u: load unsigned imm. + -- LD format dst src: 'src' means final address, not single register or immdiate. + -- Load symbol's address + LD _fmt o1 (OpImm (ImmIndex lbl' off)) | Just (_, lbl) <- dynamicLinkerLabelInfo lbl' -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] + LD _fmt o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] + LD _fmt o1 (OpImm (ImmIndex lbl off)) -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off + ] + + LD _fmt o1 (OpImm (ImmCLbl lbl')) | Just (_, lbl) <- dynamicLinkerLabelInfo lbl' -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + ] + LD _fmt o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%got_pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\tld.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%got_pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + ] + LD _fmt o1 (OpImm (ImmCLbl lbl)) -> + lines_ [ text "\tpcalau12i" <+> pprOp platform o1 <> comma <+> text "%pc_hi20(" <> pprAsmLabel platform lbl <> text ")" + , text "\taddi.d" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%pc_lo12(" <> pprAsmLabel platform lbl <> text ")" + ] + + LD II8 o1 o2 -> op2 (text "\tld.b") o1 o2 + LD II16 o1 o2 -> op2 (text "\tld.h") o1 o2 + LD II32 o1 o2 -> op2 (text "\tld.w") o1 o2 + LD II64 o1 o2 -> op2 (text "\tld.d") o1 o2 + LD FF32 o1 o2 -> op2 (text "\tfld.s") o1 o2 + LD FF64 o1 o2 -> op2 (text "\tfld.d") o1 o2 + + LDU II8 o1 o2 -> op2 (text "\tld.bu") o1 o2 + LDU II16 o1 o2 -> op2 (text "\tld.hu") o1 o2 + LDU II32 o1 o2 -> op2 (text "\tld.wu") o1 o2 + LDU II64 o1 o2 -> op2 (text "\tld.d") o1 o2 -- double words (64bit) cannot be sign extended by definition + LDU FF32 o1 o2@(OpAddr (AddrReg _)) -> op2 (text "\tfld.s") o1 o2 + LDU FF32 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld.s") o1 o2 + LDU FF64 o1 o2@(OpAddr (AddrReg _)) -> op2 (text "\tfld.d") o1 o2 + LDU FF64 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld.d") o1 o2 + LDU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text.show) f <+> pprOp platform o1 <+> pprOp platform o2) + + ST II8 o1 o2 -> op2 (text "\tst.b") o1 o2 + ST II16 o1 o2 -> op2 (text "\tst.h") o1 o2 + ST II32 o1 o2 -> op2 (text "\tst.w") o1 o2 + ST II64 o1 o2 -> op2 (text "\tst.d") o1 o2 + ST FF32 o1 o2 -> op2 (text "\tfst.s") o1 o2 + ST FF64 o1 o2 -> op2 (text "\tfst.d") o1 o2 + + -- LDPTR.{W/D}, STPTR.{W/D}: AddrRegImm: AddrRegImm + LDPTR II32 o1 o2 -> op2 (text "\tldptr.w") o1 o2 + LDPTR II64 o1 o2 -> op2 (text "\tldptr.d") o1 o2 + STPTR II32 o1 o2 -> op2 (text "\tstptr.w") o1 o2 + STPTR II64 o1 o2 -> op2 (text "\tstptr.d") o1 o2 + + -- LDX.{B[U]/H[U]/W[U]/D}, STX.{B/H/W/D}: AddrRegReg + LDX II8 o1 o2 -> op2 (text "\tldx.b") o1 o2 + LDX II16 o1 o2 -> op2 (text "\tldx.h") o1 o2 + LDX II32 o1 o2 -> op2 (text "\tldx.w") o1 o2 + LDX II64 o1 o2 -> op2 (text "\tldx.d") o1 o2 + LDX FF32 o1 o2 -> op2 (text "\tfldx.s") o1 o2 + LDX FF64 o1 o2 -> op2 (text "\tfldx.d") o1 o2 + LDXU II8 o1 o2 -> op2 (text "\tldx.bu") o1 o2 + LDXU II16 o1 o2 -> op2 (text "\tldx.hu") o1 o2 + LDXU II32 o1 o2 -> op2 (text "\tldx.wu") o1 o2 + LDXU II64 o1 o2 -> op2 (text "\tldx.d") o1 o2 + STX II8 o1 o2 -> op2 (text "\tstx.b") o1 o2 + STX II16 o1 o2 -> op2 (text "\tstx.h") o1 o2 + STX II32 o1 o2 -> op2 (text "\tstx.w") o1 o2 + STX II64 o1 o2 -> op2 (text "\tstx.d") o1 o2 + STX FF32 o1 o2 -> op2 (text "\tfstx.s") o1 o2 + STX FF64 o1 o2 -> op2 (text "\tfstx.d") o1 o2 + + PRELD h o1@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tpreld") h o1 + -- 6. Bound Check Memory Access Instructions --------------------------------- + -- LD{GT/LE}.{B/H/W/D}, ST{GT/LE}.{B/H/W/D} + -- 7. Atomic Memory Access Instructions -------------------------------------- + -- AM{SWAP/ADD/AND/OR/XOR/MAX/MIN}[DB].{W/D}, AM{MAX/MIN}[_DB].{WU/DU} + -- AM.{SWAP/ADD}[_DB].{B/H} + -- AMCAS[_DB].{B/H/W/D} + -- LL.{W/D}, SC.{W/D} + -- SC.Q + -- LL.ACQ.{W/D}, SC.REL.{W/D} + -- 8. Barrier Instructions --------------------------------------------------- + -- DBAR, IBAR + DBAR h -> line $ text "\tdbar" <+> pprBarrierType h + IBAR h -> line $ text "\tibar" <+> pprBarrierType h + + -- Floating-point convert precision + FCVT o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.d") o1 o2 + FCVT o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.s") o1 o2 + FCVT o1 o2 -> pprPanic "LA64.pprInstr - impossible float conversion" $ + line (pprOp platform o1 <> text "->" <> pprOp platform o2) + -- Signed fixed-point convert to floating-point + -- For LoongArch, ffint.* instructions's second operand must be float-pointing register, + -- so we need one more operation. + -- Also to tfint.*. + SCVTF o1@(OpReg W32 _) o2@(OpReg W32 _) -> lines_ + [ + text "\tmovgr2fr.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tffint.s.w" <+> pprOp platform o1 <> comma <+> pprOp platform o1 + ] + SCVTF o1@(OpReg W32 _) o2@(OpReg W64 _) -> lines_ + [ + text "\tmovgr2fr.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tffint.s.l" <+> pprOp platform o1 <> comma <+> pprOp platform o1 + ] + SCVTF o1@(OpReg W64 _) o2@(OpReg W32 _) -> lines_ + [ + text "\tmovgr2fr.w" <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tffint.d.w" <+> pprOp platform o1 <> comma <+> pprOp platform o1 + ] + SCVTF o1@(OpReg W64 _) o2@(OpReg W64 _) -> lines_ + [ + text "\tmovgr2fr.d" <+> pprOp platform o1 <> comma <+> pprOp platform o2, + text "\tffint.d.l" <+> pprOp platform o1 <> comma <+> pprOp platform o1 + ] + SCVTF o1 o2 -> pprPanic "LA64.pprInstr - impossible integer to float conversion" $ + line (pprOp platform o1 <> text "->" <> pprOp platform o2) + + -- Floating-point convert to signed integer, rounding toward zero + -- TODO: FCVTZS will destroy src-floating register if the previous opertion + -- includes this reg. So I'm just stupidly saving and restoring by adding + -- an extra register. + FCVTZS o1@(OpReg W32 _) o2@(OpReg W32 _) o3@(OpReg W32 _) -> lines_ + [ + text "\tfmov.s" <+> pprOp platform o2 <> comma <+> pprOp platform o3, + text "\tftintrz.w.s" <+> pprOp platform o3 <> comma <+> pprOp platform o3, + text "\tmovfr2gr.s" <+> pprOp platform o1 <> comma <+> pprOp platform o3, + text "\tfmov.s" <+> pprOp platform o3 <> comma <+> pprOp platform o2 + ] + FCVTZS o1@(OpReg W32 _) o2@(OpReg W64 _) o3@(OpReg W64 _) -> lines_ + [ + text "\tfmov.d" <+> pprOp platform o2 <> comma <+> pprOp platform o3, + text "\tftintrz.w.d" <+> pprOp platform o3 <> comma <+> pprOp platform o3, + text "\tmovfr2gr.s" <+> pprOp platform o1 <> comma <+> pprOp platform o3, + text "\tfmov.s" <+> pprOp platform o3 <> comma <+> pprOp platform o2 + ] + FCVTZS o1@(OpReg W64 _) o2@(OpReg W32 _) o3@(OpReg W32 _) -> lines_ + [ + text "\tfmov.s" <+> pprOp platform o2 <> comma <+> pprOp platform o3, + text "\tftintrz.l.s" <+> pprOp platform o3 <> comma <+> pprOp platform o3, + text "\tmovfr2gr.d" <+> pprOp platform o1 <> comma <+> pprOp platform o3, + text "\tfmov.s" <+> pprOp platform o3 <> comma <+> pprOp platform o2 + ] + FCVTZS o1@(OpReg W64 _) o2@(OpReg W64 _) o3@(OpReg W64 _) -> lines_ + [ + text "\tfmov.d" <+> pprOp platform o2 <> comma <+> pprOp platform o3, + text "\tftintrz.l.d" <+> pprOp platform o3 <> comma <+> pprOp platform o3, + text "\tmovfr2gr.d" <+> pprOp platform o1 <> comma <+> pprOp platform o3, + text "\tfmov.d" <+> pprOp platform o3 <> comma <+> pprOp platform o2 + ] + FCVTZS o1 o2 o3 -> pprPanic "LA64.pprInstr - impossible float to integer conversion" $ + line (pprOp platform o3 <> text "->" <+> pprOp platform o1 <+> text "tmpReg:" <+> pprOp platform o2) + + FMIN o1 o2 o3 -> op3 (text "fmin." <> if isSingleOp o2 then text "s" else text "d") o1 o2 o3 + FMINA o1 o2 o3 -> op3 (text "fmina." <> if isSingleOp o2 then text "s" else text "d") o1 o2 o3 + FMAX o1 o2 o3 -> op3 (text "fmax." <> if isSingleOp o2 then text "s" else text "d") o1 o2 o3 + FMAXA o1 o2 o3 -> op3 (text "fmaxa." <> if isSingleOp o2 then text "s" else text "d") o1 o2 o3 + FABS o1 o2 -> op2 (text "fabs." <> if isSingleOp o2 then text "s" else text "d") o1 o2 + FNEG o1 o2 -> op2 (text "fneg." <> if isSingleOp o2 then text "s" else text "d") o1 o2 + FSQRT o1 o2 -> op2 (text "fsqrt." <> if isSingleOp o2 then text "s" else text "d") o1 o2 + FMA variant d o1 o2 o3 -> + let fma = case variant of + FMAdd -> text "\tfmadd." <+> floatPrecission d + FMSub -> text "\tfmsub." <+> floatPrecission d + FNMAdd -> text "\tfnmadd." <+> floatPrecission d + FNMSub -> text "\tfnmsub." <+> floatPrecission d + in op4 fma d o1 o2 o3 + + instr -> panic $ "LA64.pprInstr - Unknown instruction: " ++ (instrCon instr) + where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 + op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 + op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4 +{- + -- TODO: Support dbar with different hints. + On LoongArch uses "dbar 0" (full completion barrier) for everything. + But the full completion barrier has no performance to tell, so + Loongson-3A6000 and newer processors have made finer granularity hints + available: + + Bit4: ordering or completion (0: completion, 1: ordering) + Bit3: barrier for previous read (0: true, 1: false) + Bit2: barrier for previous write (0: true, 1: false) + Bit1: barrier for succeeding read (0: true, 1: false) + Bit0: barrier for succeeding write (0: true, 1: false) +-} + pprBarrierType Hint0 = text "0x0" + floatPrecission o | isSingleOp o = text "s" + | isDoubleOp o = text "d" + | otherwise = pprPanic "Impossible floating point precission: " (pprOp platform o) + +-- LoongArch64 Conditional Branch Instructions +pprBcond :: IsLine doc => Cond -> doc +pprBcond c = text "b" <> pprCond c + +pprCond :: IsLine doc => Cond -> doc +pprCond c = case c of + EQ -> text "eq" -- beq rj, rd, off16 + NE -> text "ne" -- bne rj, rd, off16 + SLT -> text "lt" -- blt rj, rd, off16 + SGE -> text "ge" -- bge rj, rd, off16 + ULT -> text "ltu" -- bltu rj, rd, off16 + UGE -> text "geu" -- bgeu rj, rd, off16 + -- Following not real instructions, just mark it. + SLE -> text "sle->ge" -- ble rj, rd, off16 -> bge rd, rj, off16 + SGT -> text "sgt->lt" -- bgt rj, rd, off16 -> blt rd, rj, off16 + ULE -> text "ule->geu" -- bleu rj, rd, off16 -> bgeu rd, rj, off16 + UGT -> text "ugt->ltu" -- bgtu rj, rd, off16 -> bltu rd, rj, off16 + _ -> panic $ "LA64.ppr: non-implemented branch condition: " ++ show c diff --git a/GHC/CmmToAsm/LA64/RegInfo.hs b/GHC/CmmToAsm/LA64/RegInfo.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/RegInfo.hs @@ -0,0 +1,25 @@ +-- Here maybe have something to be optimized in future? +module GHC.CmmToAsm.LA64.RegInfo where + +import GHC.Cmm +import GHC.Cmm.BlockId +import GHC.CmmToAsm.LA64.Instr +import GHC.Prelude +import GHC.Utils.Outputable + +newtype JumpDest = DestBlockId BlockId + +instance Outputable JumpDest where + ppr (DestBlockId bid) = text "jd:" <> ppr bid + +getJumpDestBlockId :: JumpDest -> Maybe BlockId +getJumpDestBlockId (DestBlockId bid) = Just bid + +canShortcut :: Instr -> Maybe JumpDest +canShortcut _ = Nothing + +shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics +shortcutStatics _ other_static = other_static + +shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr +shortcutJump _ other = other diff --git a/GHC/CmmToAsm/LA64/Regs.hs b/GHC/CmmToAsm/LA64/Regs.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/LA64/Regs.hs @@ -0,0 +1,155 @@ +module GHC.CmmToAsm.LA64.Regs where + +import GHC.Prelude +import GHC.Cmm +import GHC.Cmm.CLabel ( CLabel ) +import GHC.CmmToAsm.Format +import GHC.Data.FastString +import GHC.Platform +import GHC.Platform.Reg +import GHC.Platform.Reg.Class +import GHC.Platform.Reg.Class.Separate +import GHC.Platform.Regs +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Types.Unique + +-- All machine register numbers. +allMachRegNos :: [RegNo] +allMachRegNos = [0..31] ++ [32..63] + +zeroReg, raReg, tpMachReg, fpMachReg, spMachReg, tmpReg :: Reg +zeroReg = regSingle 0 +raReg = regSingle 1 +tpMachReg = regSingle 2 +-- Not to be confused with the `CmmReg` `spReg` +spMachReg = regSingle 3 +fpMachReg = regSingle 22 +-- Use t8(r20) for LA64 IP register. +tmpReg = regSingle 20 + +-- Registers available to the register allocator. +allocatableRegs :: Platform -> [RealReg] +allocatableRegs platform = + let isFree = freeReg platform + in map RealRegSingle $ filter isFree allMachRegNos + +-- Integer argument registers according to the calling convention +allGpArgRegs :: [Reg] +allGpArgRegs = map regSingle [4..11] + +-- | Floating point argument registers according to the calling convention +allFpArgRegs :: [Reg] +allFpArgRegs = map regSingle [32..39] + +-- Addressing modes +data AddrMode + = AddrRegReg Reg Reg + | AddrRegImm Reg Imm + | AddrReg Reg + deriving (Eq, Show) + +-- Immediates +data Imm + = ImmInt Int + | ImmInteger Integer -- Sigh. + | ImmCLbl CLabel -- AbstractC Label (with baggage) + | ImmLit FastString + | ImmIndex CLabel Int + | ImmFloat Rational + | ImmDouble Rational + | ImmConstantSum Imm Imm + | ImmConstantDiff Imm Imm + deriving (Eq, Show) + +-- Map CmmLit to Imm +litToImm :: CmmLit -> Imm +litToImm (CmmInt i w) = ImmInteger (narrowS w i) +-- narrow to the width: a CmmInt might be out of +-- range, but we assume that ImmInteger only contains +-- in-range values. A signed value should be fine here. +litToImm (CmmFloat f W32) = ImmFloat f +litToImm (CmmFloat f W64) = ImmDouble f +litToImm (CmmLabel l) = ImmCLbl l +litToImm (CmmLabelOff l off) = ImmIndex l off +litToImm (CmmLabelDiffOff l1 l2 off _) = + ImmConstantSum + (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2)) + (ImmInt off) +litToImm l = panic $ "LA64.Regs.litToImm: no match for " ++ show l + +-- == To satisfy GHC.CmmToAsm.Reg.Target ======================================= + +-- squeese functions for the graph allocator ----------------------------------- +-- | regSqueeze_class reg +-- Calculate the maximum number of register colors that could be +-- denied to a node of this class due to having this reg +-- as a neighbour. +-- +{-# INLINE virtualRegSqueeze #-} +virtualRegSqueeze :: RegClass -> VirtualReg -> Int +virtualRegSqueeze cls vr + = case cls of + RcInteger -> + case vr of + VirtualRegI {} -> 1 + VirtualRegHi {} -> 1 + _other -> 0 + RcFloat -> + case vr of + VirtualRegD {} -> 1 + _other -> 0 + RcVector -> + case vr of + VirtualRegV128 {} -> 1 + _other -> 0 + +{-# INLINE realRegSqueeze #-} +realRegSqueeze :: RegClass -> RealReg -> Int +realRegSqueeze cls rr = + case cls of + RcInteger -> + case rr of + RealRegSingle regNo + | regNo < 32 + -> 1 + | otherwise + -> 0 + RcFloat -> + case rr of + RealRegSingle regNo + | regNo < 32 + || regNo > 63 + -> 0 + | otherwise + -> 1 + RcVector -> + case rr of + RealRegSingle regNo + | regNo > 63 + -> 1 + | otherwise + -> 0 + +mkVirtualReg :: Unique -> Format -> VirtualReg +mkVirtualReg u format + | not (isFloatFormat format) = VirtualRegI u + | otherwise + = case format of + FF32 -> VirtualRegD u + FF64 -> VirtualRegD u + _ -> panic "LA64.mkVirtualReg" + +{-# INLINE classOfRealReg #-} +classOfRealReg :: RealReg -> RegClass +classOfRealReg (RealRegSingle i) + | i < 32 = RcInteger + | i > 63 = RcVector + | otherwise = RcFloat + +regDotColor :: RealReg -> SDoc +regDotColor reg + = case classOfRealReg reg of + RcInteger -> text "blue" + RcFloat -> text "red" + RcVector -> text "green" diff --git a/GHC/CmmToAsm/PIC.hs b/GHC/CmmToAsm/PIC.hs --- a/GHC/CmmToAsm/PIC.hs +++ b/GHC/CmmToAsm/PIC.hs @@ -137,6 +137,11 @@ addImport symbolPtr return $ cmmMakePicReference config symbolPtr + AccessViaSymbolPtr | ArchLoongArch64 <- platformArch platform -> do + let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl + addImport symbolPtr + return $ cmmMakePicReference config symbolPtr + AccessViaSymbolPtr -> do let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl addImport symbolPtr @@ -176,6 +181,9 @@ -- as on AArch64, there's no pic base register. | ArchRISCV64 <- platformArch platform + = CmmLit $ CmmLabel lbl + + | ArchLoongArch64 <- platformArch platform = CmmLit $ CmmLabel lbl | OSAIX <- platformOS platform diff --git a/GHC/CmmToAsm/PPC/CodeGen.hs b/GHC/CmmToAsm/PPC/CodeGen.hs --- a/GHC/CmmToAsm/PPC/CodeGen.hs +++ b/GHC/CmmToAsm/PPC/CodeGen.hs @@ -182,7 +182,7 @@ format = cmmTypeFormat ty CmmUnsafeForeignCall target result_regs args - -> genCCall platform target result_regs args + -> genCCall target result_regs args CmmBranch id -> genBranch id CmmCondBranch arg true false prediction -> do @@ -340,8 +340,6 @@ let Reg64 hi lo = localReg64 local_reg return (RegCode64 nilOL hi lo) -iselExpr64 regoff@(CmmRegOff _ _) = iselExpr64 $ mangleIndexTree regoff - iselExpr64 (CmmLit (CmmInt i _)) = do Reg64 rhi rlo <- getNewReg64 let @@ -471,27 +469,49 @@ return (Any II64 code) -- catch simple cases of zero- or sign-extended load -getRegister' _ _ (CmmMachOp (MO_UU_Conv src tgt) [CmmLoad mem pk _]) - | src < tgt - , cmmTypeFormat pk == intFormat src = loadZeroExpand mem pk tgt +getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr)) -getRegister' _ _ (CmmMachOp (MO_XX_Conv src tgt) [CmmLoad mem pk _]) - | src < tgt - , cmmTypeFormat pk == intFormat src = loadZeroExpand mem pk tgt +getRegister' _ _ (CmmMachOp (MO_XX_Conv W8 W32) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II32 (\dst -> addr_code `snocOL` LD II8 dst addr)) - -- XXX: This is ugly, refactor -getRegister' _ _ (CmmMachOp (MO_SS_Conv src tgt) [CmmLoad mem pk _]) - -- Note: there is no Load Byte Arithmetic instruction - | cmmTypeFormat pk /= II8 - , src < tgt = do - let format = cmmTypeFormat pk - -- lwa is DS-form. See Note [Power instruction format] - let form = if format >= II32 then DS else D - Amode addr addr_code <- getAmode form mem - let code dst = assert (format == intFormat src) - $ addr_code `snocOL` LA format dst addr - return (Any (intFormat tgt) code) +getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II64 (\dst -> addr_code `snocOL` LD II8 dst addr)) +getRegister' _ _ (CmmMachOp (MO_XX_Conv W8 W64) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II64 (\dst -> addr_code `snocOL` LD II8 dst addr)) + +-- Note: there is no Load Byte Arithmetic instruction, so no signed case here + +getRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II32 (\dst -> addr_code `snocOL` LD II16 dst addr)) + +getRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II32 (\dst -> addr_code `snocOL` LA II16 dst addr)) + +getRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II64 (\dst -> addr_code `snocOL` LD II16 dst addr)) + +getRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II64 (\dst -> addr_code `snocOL` LA II16 dst addr)) + +getRegister' _ _ (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad mem _ _]) = do + Amode addr addr_code <- getAmode D mem + return (Any II64 (\dst -> addr_code `snocOL` LD II32 dst addr)) + +getRegister' _ _ (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad mem _ _]) = do + -- lwa is DS-form. See Note [Power instruction format] + Amode addr addr_code <- getAmode DS mem + return (Any II64 (\dst -> addr_code `snocOL` LA II32 dst addr)) + getRegister' config platform (CmmMachOp (MO_RelaxedRead w) [e]) = getRegister' config platform (CmmLoad e (cmmBits w) NaturallyAligned) @@ -641,11 +661,7 @@ MO_V_Add {} -> vectorsNeedLlvm MO_V_Sub {} -> vectorsNeedLlvm MO_V_Mul {} -> vectorsNeedLlvm - MO_VS_Quot {} -> vectorsNeedLlvm - MO_VS_Rem {} -> vectorsNeedLlvm MO_VS_Neg {} -> vectorsNeedLlvm - MO_VU_Quot {} -> vectorsNeedLlvm - MO_VU_Rem {} -> vectorsNeedLlvm MO_VF_Extract {} -> vectorsNeedLlvm MO_VF_Add {} -> vectorsNeedLlvm MO_VF_Sub {} -> vectorsNeedLlvm @@ -775,12 +791,6 @@ extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr extendUExpr from to x = CmmMachOp (MO_UU_Conv from to) [x] -loadZeroExpand :: CmmExpr -> CmmType -> Width -> NatM Register -loadZeroExpand mem pk tgt = do - Amode addr addr_code <- getAmode D mem - let code dst = addr_code `snocOL` LD (cmmTypeFormat pk) dst addr - return (Any (intFormat tgt) code) - -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. @@ -1190,25 +1200,24 @@ -- @get_arg@, which moves the arguments to the correct registers/stack -- locations. Apart from that, the code is easy. -genCCall :: Platform - -> ForeignTarget -- function to call +genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall _ (PrimTarget MO_AcquireFence) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC -genCCall _ (PrimTarget MO_ReleaseFence) _ _ +genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC -genCCall _ (PrimTarget MO_SeqCstFence) _ _ +genCCall (PrimTarget MO_SeqCstFence) _ _ = return $ unitOL HWSYNC -genCCall _ (PrimTarget MO_Touch) _ _ +genCCall (PrimTarget MO_Touch) _ _ = return $ nilOL -genCCall _ (PrimTarget (MO_Prefetch_Data _)) _ _ +genCCall (PrimTarget (MO_Prefetch_Data _)) _ _ = return $ nilOL -genCCall _ (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] +genCCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = do let fmt = intFormat width reg_dst = getLocalRegReg dst (instr, n_code) <- case amop of @@ -1258,7 +1267,7 @@ (n_reg, n_code) <- getSomeReg n return (op dst dst (RIReg n_reg), n_code) -genCCall _ (PrimTarget (MO_AtomicRead width _)) [dst] [addr] +genCCall (PrimTarget (MO_AtomicRead width _)) [dst] [addr] = do let fmt = intFormat width reg_dst = getLocalRegReg dst form = if widthInBits width == 64 then DS else D @@ -1285,12 +1294,12 @@ -- This is also what gcc does. -genCCall _ (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do +genCCall (PrimTarget (MO_AtomicWrite width _)) [] [addr, val] = do code <- assignMem_IntCode (intFormat width) addr val return $ unitOL HWSYNC `appOL` code -genCCall platform (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] - | width == W32 || (width == W64 && not (target32Bit platform)) +genCCall (PrimTarget (MO_Cmpxchg width)) [dst] [addr, old, new] + | width == W32 || width == W64 = do (old_reg, old_code) <- getSomeReg old (new_reg, new_code) <- getSomeReg new @@ -1319,8 +1328,9 @@ format = intFormat width -genCCall platform (PrimTarget (MO_Clz width)) [dst] [src] - = do let reg_dst = getLocalRegReg dst +genCCall (PrimTarget (MO_Clz width)) [dst] [src] + = do platform <- getPlatform + let reg_dst = getLocalRegReg dst if target32Bit platform && width == W64 then do RegCode64 code vr_hi vr_lo <- iselExpr64 src @@ -1368,8 +1378,9 @@ let cntlz = unitOL (CNTLZ format reg_dst reg) return $ s_code `appOL` pre `appOL` cntlz `appOL` post -genCCall platform (PrimTarget (MO_Ctz width)) [dst] [src] - = do let reg_dst = getLocalRegReg dst +genCCall (PrimTarget (MO_Ctz width)) [dst] [src] + = do platform <- getPlatform + let reg_dst = getLocalRegReg dst if target32Bit platform && width == W64 then do let format = II32 @@ -1431,8 +1442,9 @@ , SUBFC dst r' (RIImm (ImmInt (format_bits))) ] -genCCall platform target dest_regs argsAndHints - = do case target of +genCCall target dest_regs argsAndHints + = do platform <- getPlatform + case target of PrimTarget (MO_S_QuotRem width) -> divOp1 True width dest_regs argsAndHints PrimTarget (MO_U_QuotRem width) -> divOp1 False width @@ -2176,6 +2188,14 @@ MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported + MO_VS_Quot {} -> unsupported + MO_VS_Rem {} -> unsupported + MO_VU_Quot {} -> unsupported + MO_VU_Rem {} -> unsupported + MO_I64X2_Min -> unsupported + MO_I64X2_Max -> unsupported + MO_W64X2_Min -> unsupported + MO_W64X2_Max -> unsupported MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported MO_SeqCstFence -> unsupported @@ -2430,8 +2450,8 @@ let op_len = max W32 width extend = if sgn then extendSExpr else extendUExpr (src1, code1) <- getSomeReg (extend width op_len x) - (src2, code2) <- getSomeReg y - + (src2, code2) <- getSomeReg (extendUExpr width op_len y) + -- Note: Shift amount `y` is unsigned let code dst = code1 `appOL` code2 `snocOL` instr (intFormat op_len) dst src1 (RIReg src2) return (Any (intFormat width) code) diff --git a/GHC/CmmToAsm/PPC/Instr.hs b/GHC/CmmToAsm/PPC/Instr.hs --- a/GHC/CmmToAsm/PPC/Instr.hs +++ b/GHC/CmmToAsm/PPC/Instr.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- -- -- Machine-dependent assembly language @@ -60,7 +58,7 @@ import Data.Foldable (toList) import qualified Data.List.NonEmpty as NE import GHC.Data.FastString (FastString) -import Data.Maybe (fromMaybe) +import GHC.Data.Maybe (expectJust, fromMaybe) -------------------------------------------------------------------------------- @@ -721,7 +719,7 @@ = BCCFAR cond tgt p | otherwise = BCC cond tgt p - where Just targetAddr = lookupUFM blockAddressMap tgt + where targetAddr = expectJust $ lookupUFM blockAddressMap tgt makeFar _ other = other -- 8192 instructions are allowed; let's keep some distance, as diff --git a/GHC/CmmToAsm/Ppr.hs b/GHC/CmmToAsm/Ppr.hs --- a/GHC/CmmToAsm/Ppr.hs +++ b/GHC/CmmToAsm/Ppr.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- @@ -16,7 +14,6 @@ pprASCII, pprString, pprFileEmbed, - pprCOFFComdatKey, pprSectionHeader ) @@ -26,7 +23,6 @@ import GHC.Utils.Asm import GHC.Cmm.CLabel -import GHC.Cmm.InitFini import GHC.Cmm import GHC.CmmToAsm.Config import GHC.Utils.Outputable as SDoc @@ -43,11 +39,6 @@ import GHC.Exts import GHC.Word -#if !MIN_VERSION_base(4,16,0) -word8ToWord# :: Word# -> Word# -word8ToWord# w = w -{-# INLINE word8ToWord# #-} -#endif -- ----------------------------------------------------------------------------- -- Converting floating-point literals to integrals for printing @@ -229,8 +220,8 @@ | otherwise -> text ".rodata" RelocatableReadOnlyData | OSMinGW32 <- platformOS platform -- Concept does not exist on Windows, - -- So map these to data. - -> text ".data" + -- So map these to R/O data. + -> text ".rdata$rel.ro" | otherwise -> text ".data.rel.ro" UninitialisedData -> text ".bss" InitArray @@ -247,74 +238,19 @@ | otherwise -> text ".rodata.str" OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" - flags - -- See - -- https://github.com/llvm/llvm-project/blob/llvmorg-21.1.8/lld/COFF/Chunks.cpp#L54 - -- and https://llvm.org/docs/Extensions.html#section-directive. - -- LLD COFF backend gc-sections only work on COMDAT sections so - -- we need to mark it as a COMDAT section. You can use clang64 - -- toolchain to compile small examples with - -- `-ffunction-sections -fdata-sections -S` to see these section - -- headers in the wild. Also see Note [Split sections on COFF objects] - -- below. - | OSMinGW32 <- platformOS platform, - splitSections = - if - | Just _ <- isInitOrFiniSection t -> text ",\"dw\"" - | otherwise -> - let coff_section_flags - | Text <- t = "xr" - | UninitialisedData <- t = "bw" - | ReadOnlySection <- sectionProtection t = "dr" - | otherwise = "dw" - in hcat - [ text ",\"", - text coff_section_flags, - text "\",one_only,", - pprCOFFComdatKey platform suffix - ] - | otherwise = - case t of - Text - | splitSections - -> text ",\"ax\"," <> sectionType platform "progbits" - CString - | OSMinGW32 <- platformOS platform - -> empty - | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1" - _ -> empty + flags = case t of + Text + | OSMinGW32 <- platformOS platform, splitSections + -> text ",\"xr\"" + | splitSections + -> text ",\"ax\"," <> sectionType platform "progbits" + CString + | OSMinGW32 <- platformOS platform + -> empty + | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1" + _ -> empty {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-} {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable - --- | Note [Split sections on COFF objects] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- On Windows/COFF, LLD's gc-sections only works on COMDAT sections, --- so we mark split sections as COMDAT and need to provide a unique --- "key" symbol. --- --- Important: We must not use a dot-prefixed local label (e.g. --- @.L...@) as the COMDAT key symbol, because LLVM's COFF assembler --- treats dot-prefixed COMDAT key symbols specially and forces them to --- have value 0 (the beginning of the section). That breaks --- @tablesNextToCode@, where the info label is intentionally placed --- after the info table data (at a non-zero offset). --- --- Therefore we generate a non-dot-prefixed key symbol derived from --- the section suffix, and (see arch-specific 'pprSectionAlign') we --- emit a label definition for it at the beginning of the section. --- --- ctor/dtor sections are specially treated; they must be emitted as --- regular data sections, otherwise LLD will drop them. --- --- Note that we must not emit .equiv directives for COMDAT sections in --- COFF objects, they seriously confuse LLD and we end up with access --- violations at runtimes. -pprCOFFComdatKey :: IsLine doc => Platform -> CLabel -> doc -pprCOFFComdatKey platform suffix = - text "__ghc_coff_comdat_" <> pprAsmLabel platform suffix -{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> SDoc #-} -{-# SPECIALIZE pprCOFFComdatKey :: Platform -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable -- XCOFF doesn't support relocating label-differences, so we place all -- RO sections into .text[PR] sections diff --git a/GHC/CmmToAsm/RV64/CodeGen.hs b/GHC/CmmToAsm/RV64/CodeGen.hs --- a/GHC/CmmToAsm/RV64/CodeGen.hs +++ b/GHC/CmmToAsm/RV64/CodeGen.hs @@ -1868,6 +1868,14 @@ MO_AddIntC _w -> unsupported mop MO_SubIntC _w -> unsupported mop MO_U_Mul2 _w -> unsupported mop + MO_VS_Quot {} -> unsupported mop + MO_VS_Rem {} -> unsupported mop + MO_VU_Quot {} -> unsupported mop + MO_VU_Rem {} -> unsupported mop + MO_I64X2_Min -> unsupported mop + MO_I64X2_Max -> unsupported mop + MO_W64X2_Min -> unsupported mop + MO_W64X2_Max -> unsupported mop -- Memory Ordering -- The related C functions are: -- #include diff --git a/GHC/CmmToAsm/Reg/Graph.hs b/GHC/CmmToAsm/Reg/Graph.hs --- a/GHC/CmmToAsm/Reg/Graph.hs +++ b/GHC/CmmToAsm/Reg/Graph.hs @@ -339,14 +339,14 @@ -- Conflicts between virtual and real regs are recorded as exclusions. graphAddConflictSet :: Platform - -> Regs + -> UniqSet RegWithFormat -> Color.Graph VirtualReg RegClass RealReg -> Color.Graph VirtualReg RegClass RealReg graphAddConflictSet platform regs graph = let arch = platformArch platform - virtuals = takeVirtualRegs $ getRegs regs - reals = takeRealRegs $ getRegs regs + virtuals = takeVirtualRegs regs + reals = takeRealRegs regs graph1 = Color.addConflicts virtuals (classOfVirtualReg arch) graph -- NB: we could add "arch" as argument to functions such as "addConflicts" diff --git a/GHC/CmmToAsm/Reg/Graph/Base.hs b/GHC/CmmToAsm/Reg/Graph/Base.hs --- a/GHC/CmmToAsm/Reg/Graph/Base.hs +++ b/GHC/CmmToAsm/Reg/Graph/Base.hs @@ -30,6 +30,7 @@ import GHC.Builtin.Uniques import GHC.Utils.Monad (concatMapM) +import Data.List.NonEmpty (NonEmpty (..)) -- Some basic register classes. -- These aren't necessarily in 1-to-1 correspondence with the allocatable @@ -113,7 +114,7 @@ regsS_conflict = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS - in maximum $ map sizeUniqSet $ regsS_conflict + in maximum $ 0 :| map sizeUniqSet regsS_conflict -- | For a node N of classN and neighbors of classesC diff --git a/GHC/CmmToAsm/Reg/Graph/Coalesce.hs b/GHC/CmmToAsm/Reg/Graph/Coalesce.hs --- a/GHC/CmmToAsm/Reg/Graph/Coalesce.hs +++ b/GHC/CmmToAsm/Reg/Graph/Coalesce.hs @@ -13,8 +13,10 @@ import GHC.Data.Bag import GHC.Data.Graph.Directed import GHC.Platform (Platform) +import GHC.Types.Unique (getUnique) import GHC.Types.Unique.FM import GHC.Types.Unique.Supply +import GHC.Types.Unique.Set -- | Do register coalescing on this top level thing -- @@ -86,8 +88,8 @@ slurpLI rs (LiveInstr _ Nothing) = rs slurpLI rs (LiveInstr instr (Just live)) | Just (r1, r2) <- takeRegRegMoveInstr platform instr - , r1 `elemRegs` liveDieRead live - , r2 `elemRegs` liveBorn live + , elemUniqSet_Directly (getUnique r1) $ liveDieRead live + , elemUniqSet_Directly (getUnique r2) $ liveBorn live -- only coalesce movs between two virtuals for now, -- else we end up with allocatable regs in the live diff --git a/GHC/CmmToAsm/Reg/Graph/Spill.hs b/GHC/CmmToAsm/Reg/Graph/Spill.hs --- a/GHC/CmmToAsm/Reg/Graph/Spill.hs +++ b/GHC/CmmToAsm/Reg/Graph/Spill.hs @@ -144,7 +144,7 @@ -- then record the fact that these slots are now live in those blocks -- in the given slotmap. patchLiveSlot - :: BlockMap IntSet -> BlockId -> Regs -> BlockMap IntSet + :: BlockMap IntSet -> BlockId -> UniqSet RegWithFormat-> BlockMap IntSet patchLiveSlot slotMap blockId regsLive = let @@ -154,8 +154,7 @@ moreSlotsLive = IntSet.fromList $ mapMaybe (lookupUFM regSlotMap . regWithFormat_reg) - $ nonDetEltsUniqSet - $ getRegs regsLive + $ nonDetEltsUniqSet regsLive -- See Note [Unique Determinism and code generation] slotMap' diff --git a/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/GHC/CmmToAsm/Reg/Graph/SpillClean.hs --- a/GHC/CmmToAsm/Reg/Graph/SpillClean.hs +++ b/GHC/CmmToAsm/Reg/Graph/SpillClean.hs @@ -47,12 +47,13 @@ import GHC.Types.Unique.FM import GHC.Types.Unique import GHC.Builtin.Uniques +import GHC.Utils.Misc import GHC.Utils.Monad.State.Strict import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Cmm.Dataflow.Label -import Data.List (nub, foldl1', find) +import Data.List (nub, find) import Data.Maybe import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet @@ -410,8 +411,7 @@ , sJumpValidAcc = emptyUFM } intersects :: [Assoc Store] -> Assoc Store -intersects [] = emptyAssoc -intersects assocs = foldl1' intersectAssoc assocs +intersects = foldl1WithDefault' emptyAssoc intersectAssoc -- | See if we have a reg with the same value as this slot in the association table. diff --git a/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/GHC/CmmToAsm/Reg/Graph/SpillCost.hs --- a/GHC/CmmToAsm/Reg/Graph/SpillCost.hs +++ b/GHC/CmmToAsm/Reg/Graph/SpillCost.hs @@ -36,8 +36,9 @@ import GHC.Utils.Monad.State.Strict import GHC.CmmToAsm.CFG import GHC.CmmToAsm.Format +import GHC.Utils.Misc -import Data.List (nub, minimumBy) +import Data.List (nub) import Data.Maybe import Control.Monad (join) @@ -101,7 +102,7 @@ countBlock info freqMap (BasicBlock blockId instrs) | LiveInfo _ _ blockLive _ <- info , Just rsLiveEntry <- mapLookup blockId blockLive - , rsLiveEntry_virt <- takeVirtualRegs $ getRegs rsLiveEntry + , rsLiveEntry_virt <- takeVirtualRegs rsLiveEntry = countLIs (ceiling $ blockFreq freqMap blockId) rsLiveEntry_virt instrs | otherwise @@ -135,9 +136,9 @@ mapM_ (incDefs scale) $ nub $ mapMaybe (takeVirtualReg . regWithFormat_reg) written -- Compute liveness for entry to next instruction. - let liveDieRead_virt = takeVirtualRegs $ getRegs (liveDieRead live) - let liveDieWrite_virt = takeVirtualRegs $ getRegs (liveDieWrite live) - let liveBorn_virt = takeVirtualRegs $ getRegs (liveBorn live) + let liveDieRead_virt = takeVirtualRegs (liveDieRead live) + let liveDieWrite_virt = takeVirtualRegs (liveDieWrite live) + let liveBorn_virt = takeVirtualRegs (liveBorn live) let rsLiveAcross = rsLiveEntry `minusUniqSet` liveDieRead_virt @@ -168,7 +169,7 @@ chooseSpill info graph = let cost = spillCost_length info graph node = minimumBy (\n1 n2 -> compare (cost $ nodeId n1) (cost $ nodeId n2)) - $ nonDetEltsUFM $ graphMap graph + $ expectNonEmpty $ nonDetEltsUFM $ graphMap graph -- See Note [Unique Determinism and code generation] in nodeId node diff --git a/GHC/CmmToAsm/Reg/Graph/Stats.hs b/GHC/CmmToAsm/Reg/Graph/Stats.hs --- a/GHC/CmmToAsm/Reg/Graph/Stats.hs +++ b/GHC/CmmToAsm/Reg/Graph/Stats.hs @@ -1,6 +1,3 @@ - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Carries interesting info for debugging / profiling of the -- graph coloring register allocator. module GHC.CmmToAsm.Reg.Graph.Stats ( @@ -219,11 +216,10 @@ pprStatsSpills stats = let - finals = [ s | s@RegAllocStatsColored{} <- stats] + finals = [srms | RegAllocStatsColored{ raSRMs = srms } <- stats] -- sum up how many stores\/loads\/reg-reg-moves were left in the code - total = foldl' addSRM (0, 0, 0) - $ map raSRMs finals + total = foldl' addSRM (0, 0, 0) finals in ( text "-- spills-added-total" $$ text "-- (stores, loads, reg_reg_moves_remaining)" @@ -237,8 +233,7 @@ pprStatsLifetimes stats = let info = foldl' plusSpillCostInfo zeroSpillCostInfo - [ raSpillCosts s - | s@RegAllocStatsStart{} <- stats ] + [ sc | RegAllocStatsStart{ raSpillCosts = sc } <- stats ] lifeBins = binLifetimeCount $ lifeMapFromSpillCostInfo info @@ -287,20 +282,21 @@ pprStatsLifeConflict stats graph = let lifeMap = lifeMapFromSpillCostInfo $ foldl' plusSpillCostInfo zeroSpillCostInfo - $ [ raSpillCosts s | s@RegAllocStatsStart{} <- stats ] + $ [ sc | RegAllocStatsStart{ raSpillCosts = sc } <- stats ] - scatter = map (\r -> let lifetime = case lookupUFM lifeMap r of - Just (_, l) -> l - Nothing -> 0 - Just node = Color.lookupNode graph r - in parens $ hcat $ punctuate (text ", ") - [ doubleQuotes $ ppr $ Color.nodeId node - , ppr $ sizeUniqSet (Color.nodeConflicts node) - , ppr $ lifetime ]) - $ map Color.nodeId - $ nonDetEltsUFM + scatter = + [ let lifetime = case lookupUFM lifeMap r of + Just (_, l) -> l + Nothing -> 0 + in parens $ hcat $ punctuate (text ", ") + [ doubleQuotes $ ppr $ Color.nodeId node + , ppr $ sizeUniqSet (Color.nodeConflicts node) + , ppr $ lifetime ] + | node <- nonDetEltsUFM -- See Note [Unique Determinism and code generation] $ Color.graphMap graph + , let r = Color.nodeId node + ] in ( text "-- vreg-conflict-lifetime" $$ text "-- (vreg, vreg_conflicts, vreg_lifetime)" diff --git a/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs b/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs --- a/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs +++ b/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs @@ -148,7 +148,10 @@ Separate.RcInteger -> 14 Separate.RcFloat -> 20 Separate.RcVector -> 20 - ArchLoongArch64->panic "trivColorable ArchLoongArch64" + ArchLoongArch64 -> case rc of + Separate.RcInteger -> 16 + Separate.RcFloat -> 24 + Separate.RcVector -> 24 ArchJavaScript-> panic "trivColorable ArchJavaScript" ArchWasm32 -> panic "trivColorable ArchWasm32" ArchUnknown -> panic "trivColorable ArchUnknown" diff --git a/GHC/CmmToAsm/Reg/Linear.hs b/GHC/CmmToAsm/Reg/Linear.hs --- a/GHC/CmmToAsm/Reg/Linear.hs +++ b/GHC/CmmToAsm/Reg/Linear.hs @@ -1,6 +1,4 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- -- -- The register allocator @@ -113,6 +111,7 @@ import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64 import qualified GHC.CmmToAsm.Reg.Linear.AArch64 as AArch64 import qualified GHC.CmmToAsm.Reg.Linear.RV64 as RV64 +import qualified GHC.CmmToAsm.Reg.Linear.LA64 as LA64 import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Reg.Liveness import GHC.CmmToAsm.Reg.Utils @@ -141,7 +140,7 @@ import Data.Containers.ListUtils import Data.Maybe -import Data.List (partition) +import Data.List (sortOn) import Control.Monad -- ----------------------------------------------------------------------------- @@ -178,8 +177,7 @@ -- make sure the block that was first in the input list -- stays at the front of the output - let !(!(!first':_), !rest') - = partition ((== first_id) . blockId) final_blocks + let !final_blocks' = sortOn ((/= first_id) . blockId) final_blocks let max_spill_slots = maxSpillSlots config extra_stack @@ -188,7 +186,7 @@ | otherwise = Nothing - return ( CmmProc info lbl live (ListGraph (first' : rest')) + return ( CmmProc info lbl live (ListGraph final_blocks') , extra_stack , Just stats) @@ -209,7 +207,7 @@ :: forall instr. (Instruction instr) => NCGConfig -> [BlockId] -- ^ entry points - -> BlockMap Regs + -> BlockMap (UniqSet RegWithFormat) -- ^ live regs on entry to each basic block -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" @@ -228,7 +226,7 @@ ArchMipseb -> panic "linearRegAlloc ArchMipseb" ArchMipsel -> panic "linearRegAlloc ArchMipsel" ArchRISCV64 -> go (frInitFreeRegs platform :: RV64.FreeRegs) - ArchLoongArch64-> panic "linearRegAlloc ArchLoongArch64" + ArchLoongArch64 -> go $ (frInitFreeRegs platform :: LA64.FreeRegs) ArchJavaScript -> panic "linearRegAlloc ArchJavaScript" ArchWasm32 -> panic "linearRegAlloc ArchWasm32" ArchUnknown -> panic "linearRegAlloc ArchUnknown" @@ -248,7 +246,7 @@ => NCGConfig -> freeRegs -> [BlockId] -- ^ entry points - -> BlockMap Regs -- ^ live regs on entry to each basic block + -> BlockMap (UniqSet RegWithFormat) -- ^ live regs on entry to each basic block -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" -> UniqDSM ([NatBasicBlock instr], RegAllocStats, Int) @@ -262,7 +260,7 @@ linearRA_SCCs :: OutputableRegConstraint freeRegs instr => [BlockId] - -> BlockMap Regs + -> BlockMap (UniqSet RegWithFormat) -> [NatBasicBlock instr] -> [SCC (LiveBasicBlock instr)] -> RegM freeRegs [NatBasicBlock instr] @@ -297,7 +295,7 @@ process :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr) => [BlockId] - -> BlockMap Regs + -> BlockMap (UniqSet RegWithFormat) -> [GenBasicBlock (LiveInstr instr)] -> RegM freeRegs [[NatBasicBlock instr]] process entry_ids block_live = @@ -336,7 +334,7 @@ -- processBlock :: OutputableRegConstraint freeRegs instr - => BlockMap Regs -- ^ live regs on entry to each basic block + => BlockMap (UniqSet RegWithFormat) -- ^ live regs on entry to each basic block -> LiveBasicBlock instr -- ^ block to do register allocation on -> RegM freeRegs [NatBasicBlock instr] -- ^ block with registers allocated @@ -353,7 +351,7 @@ -- | Load the freeregs and current reg assignment into the RegM state -- for the basic block with this BlockId. initBlock :: FR freeRegs - => BlockId -> BlockMap Regs -> RegM freeRegs () + => BlockId -> BlockMap (UniqSet RegWithFormat) -> RegM freeRegs () initBlock id block_live = do platform <- getPlatform block_assig <- getBlockAssigR @@ -370,7 +368,7 @@ setFreeRegsR (frInitFreeRegs platform) Just live -> setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform) - (nonDetEltsUniqSet $ takeRealRegs $ getRegs live) + (nonDetEltsUniqSet $ takeRealRegs live) -- See Note [Unique Determinism and code generation] setAssigR emptyRegMap @@ -383,7 +381,7 @@ -- | Do allocation for a sequence of instructions. linearRA :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr) - => BlockMap Regs -- ^ map of what vregs are live on entry to each block. + => BlockMap (UniqSet RegWithFormat) -- ^ map of what vregs are live on entry to each block. -> BlockId -- ^ id of the current block, for debugging. -> [LiveInstr instr] -- ^ liveness annotated instructions in this block. -> RegM freeRegs @@ -408,7 +406,7 @@ -- | Do allocation for a single instruction. raInsn :: OutputableRegConstraint freeRegs instr - => BlockMap Regs -- ^ map of what vregs are live on entry to each block. + => BlockMap (UniqSet RegWithFormat) -- ^ map of what vregs are love on entry to each block. -> [instr] -- ^ accumulator for instructions already processed. -> BlockId -- ^ the id of the current block, for debugging -> LiveInstr instr -- ^ the instr to have its regs allocated, with liveness info. @@ -429,7 +427,7 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live)) = do platform <- getPlatform - assig <- getAssigR + assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc) -- If we have a reg->reg move between virtual registers, where the -- src register is not live after this instruction, and the dst @@ -439,12 +437,12 @@ -- (we can't eliminate it if the source register is on the stack, because -- we do not want to use one spill slot for different virtual registers) case takeRegRegMoveInstr platform instr of - Just (src,dst) | Just fmt <- lookupReg src (liveDieRead live), + Just (src,dst) | Just (RegWithFormat _ fmt) <- lookupUniqSet_Directly (liveDieRead live) (getUnique src), isVirtualReg dst, not (dst `elemUFM` assig), isRealReg src || isInReg src assig -> do case src of - RegReal rr -> setAssigR (addToUFM assig dst (Loc (InReg rr) fmt)) + RegReal rr -> setAssigR (addToUFM assig dst (InReg $ RealRegUsage rr fmt)) -- if src is a fixed reg, then we just map dest to this -- reg in the assignment. src must be an allocatable reg, -- otherwise it wouldn't be in r_dying. @@ -463,8 +461,8 @@ return (new_instrs, []) _ -> genRaInsn block_live new_instrs id instr - (map regWithFormat_reg $ nonDetEltsUniqSet $ getRegs $ liveDieRead live) - (map regWithFormat_reg $ nonDetEltsUniqSet $ getRegs $ liveDieWrite live) + (map regWithFormat_reg $ nonDetEltsUniqSet $ liveDieRead live) + (map regWithFormat_reg $ nonDetEltsUniqSet $ liveDieWrite live) -- See Note [Unique Determinism and code generation] raInsn _ _ _ instr @@ -487,16 +485,13 @@ isInReg :: Reg -> RegMap Loc -> Bool -isInReg src assig - | Just (Loc (InReg _) _) <- lookupUFM assig src - = True - | otherwise - = False +isInReg src assig | Just (InReg _) <- lookupUFM assig src = True + | otherwise = False genRaInsn :: forall freeRegs instr. (OutputableRegConstraint freeRegs instr) - => BlockMap Regs + => BlockMap (UniqSet RegWithFormat) -> [instr] -> BlockId -> instr @@ -509,8 +504,8 @@ platform <- getPlatform case regUsageOfInstr platform instr of { RU read written -> do - let real_written = [ rr | RegWithFormat {regWithFormat_reg = RegReal rr} <- written ] - let virt_written = [ VirtualRegWithFormat vr fmt | RegWithFormat (RegVirtual vr) fmt <- written ] + let real_written = [ rr | RegWithFormat {regWithFormat_reg = RegReal rr} <- written ] + let virt_written = [ VirtualRegWithFormat vr fmt | RegWithFormat (RegVirtual vr) fmt <- written ] -- we don't need to do anything with real registers that are -- only read by this instr. (the list is typically ~2 elements, @@ -648,16 +643,14 @@ loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs loop assig !free (r:rs) = case lookupUFM assig r of - Just (Loc (InBoth real _) _) -> - loop (delFromUFM assig r) - (frReleaseReg platform real free) rs - Just (Loc (InReg real) _) -> - loop (delFromUFM assig r) - (frReleaseReg platform real free) rs - _ -> - loop (delFromUFM assig r) free rs + Just (InBoth real _) -> loop (delFromUFM assig r) + (frReleaseReg platform (realReg real) free) rs + Just (InReg real) -> loop (delFromUFM assig r) + (frReleaseReg platform (realReg real) free) rs + _ -> loop (delFromUFM assig r) free rs loop assig free regs + -- ----------------------------------------------------------------------------- -- Clobber real registers @@ -675,18 +668,17 @@ saveClobberedTemps :: forall instr freeRegs. (Instruction instr, FR freeRegs) - => [RealReg] -- ^ real registers clobbered by this instruction - -> [Reg] -- ^ registers which are no longer live after this instruction, - -- because read for the last time - -> RegM freeRegs [instr] -- return: instructions to spill any temps that will - -- be clobbered. + => [RealReg] -- real registers clobbered by this instruction + -> [Reg] -- registers which are no longer live after this insn + -> RegM freeRegs [instr] -- return: instructions to spill any temps that will + -- be clobbered. saveClobberedTemps [] _ = return [] saveClobberedTemps clobbered dying = do - assig <- getAssigR + assig <- getAssigR :: RegM freeRegs (UniqFM Reg Loc) (assig',instrs) <- nonDetStrictFoldUFM_DirectlyM maybe_spill (assig,[]) assig setAssigR assig' return $ -- mkComment (text "") ++ @@ -695,21 +687,19 @@ where -- Unique represents the VirtualReg -- Here we separate the cases which we do want to spill from these we don't. - maybe_spill :: Unique - -> (RegMap Loc,[instr]) - -> Loc - -> RegM freeRegs (RegMap Loc,[instr]) + maybe_spill :: Unique -> (RegMap Loc,[instr]) -> (Loc) -> RegM freeRegs (RegMap Loc,[instr]) maybe_spill !temp !(assig,instrs) !loc = case loc of -- This is non-deterministic but we do not -- currently support deterministic code-generation. -- See Note [Unique Determinism and code generation] - Loc (InReg reg) fmt - | any (realRegsAlias reg) clobbered + InReg reg + | any (realRegsAlias $ realReg reg) clobbered , temp `notElem` map getUnique dying - -> clobber temp (assig,instrs) (RealRegUsage reg fmt) + -> clobber temp (assig,instrs) reg _ -> return (assig,instrs) + -- See Note [UniqFM and the register allocator] clobber :: Unique -> (RegMap Loc,[instr]) -> RealRegUsage -> RegM freeRegs (RegMap Loc,[instr]) clobber temp (assig,instrs) (RealRegUsage reg fmt) @@ -728,7 +718,7 @@ (my_reg : _) -> do setFreeRegsR (frAllocateReg platform my_reg freeRegs) - let new_assign = addToUFM_Directly assig temp (Loc (InReg my_reg) fmt) + let new_assign = addToUFM_Directly assig temp (InReg (RealRegUsage my_reg fmt)) let instr = mkRegRegMoveInstr config fmt (RegReal reg) (RegReal my_reg) @@ -736,13 +726,12 @@ -- (2) no free registers: spill the value [] -> do - (spill, slot) <- spillR (RegWithFormat (RegReal reg) fmt) temp -- record why this reg was spilled for profiling recordSpill (SpillClobber temp) - let new_assign = addToUFM_Directly assig temp (Loc (InBoth reg slot) fmt) + let new_assign = addToUFM_Directly assig temp (InBoth (RealRegUsage reg fmt) slot) return (new_assign, (spill ++ instrs)) @@ -790,9 +779,9 @@ clobber assig [] = assig - clobber assig ((temp, Loc (InBoth reg slot) regFmt) : rest) - | any (realRegsAlias reg) clobbered - = clobber (addToUFM_Directly assig temp (Loc (InMem slot) regFmt)) rest + clobber assig ((temp, InBoth reg slot) : rest) + | any (realRegsAlias $ realReg reg) clobbered + = clobber (addToUFM_Directly assig temp (InMem slot)) rest clobber assig (_:rest) = clobber assig rest @@ -801,9 +790,9 @@ -- allocateRegsAndSpill -- Why are we performing a spill? -data SpillLoc = ReadMem StackSlot Format -- reading from register only in memory - | WriteNew -- writing to a new variable - | WriteMem -- writing to register only in memory +data SpillLoc = ReadMem StackSlot -- reading from register only in memory + | WriteNew -- writing to a new variable + | WriteMem -- writing to register only in memory -- Note that ReadNew is not valid, since you don't want to be reading -- from an uninitialized register. We also don't need the location of -- the register in memory, since that will be invalidated by the write. @@ -829,36 +818,28 @@ allocateRegsAndSpill _ _ spills alloc [] = return (spills, reverse alloc) -allocateRegsAndSpill reading keep spills alloc (r@(VirtualRegWithFormat vr vrFmt):rs) +allocateRegsAndSpill reading keep spills alloc (r@(VirtualRegWithFormat vr _fmt):rs) = do assig <- toVRegMap <$> getAssigR -- pprTraceM "allocateRegsAndSpill:assig" (ppr (r:rs) $$ ppr assig) -- See Note [UniqFM and the register allocator] let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig case lookupUFM assig vr of -- case (1a): already in a register - Just (Loc (InReg my_reg) in_reg_fmt) -> do - -- (RF1) from Note [Allocated register formats]: - -- writes redefine the format the register is used at. - when (not reading && vrFmt /= in_reg_fmt) $ - setAssigR $ toRegMap $ - addToUFM assig vr (Loc (InReg my_reg) vrFmt) - allocateRegsAndSpill reading keep spills (my_reg:alloc) rs + Just (InReg my_reg) -> + allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs -- case (1b): already in a register (and memory) - Just (Loc (InBoth my_reg _) _) -> do - -- NB1. if we're writing this register, update its assignment to be - -- InReg, because the memory value is no longer valid. - -- NB2. This is why we must process written registers here, even if they - -- are also read by the same instruction. - when (not reading) $ - setAssigR $ toRegMap $ - addToUFM assig vr (Loc (InReg my_reg) vrFmt) - allocateRegsAndSpill reading keep spills (my_reg:alloc) rs + -- NB1. if we're writing this register, update its assignment to be + -- InReg, because the memory value is no longer valid. + -- NB2. This is why we must process written registers here, even if they + -- are also read by the same instruction. + Just (InBoth my_reg _) + -> do when (not reading) (setAssigR $ toRegMap (addToUFM assig vr (InReg my_reg))) + allocateRegsAndSpill reading keep spills (realReg my_reg:alloc) rs -- Not already in a register, so we need to find a free one... - Just (Loc (InMem slot) memFmt) - | reading -> doSpill (ReadMem slot memFmt) - | otherwise -> doSpill WriteMem + Just (InMem slot) | reading -> doSpill (ReadMem slot) + | otherwise -> doSpill WriteMem Nothing | reading -> pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr vr) -- NOTE: if the input to the NCG contains some @@ -894,7 +875,7 @@ -> UniqFM VirtualReg Loc -> SpillLoc -> RegM freeRegs ([instr], [RealReg]) -allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrFmt) rs assig spill_loc +allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr fmt) rs assig spill_loc = do platform <- getPlatform freeRegs <- getFreeRegsR let regclass = classOfVirtualReg (platformArch platform) vr @@ -916,7 +897,7 @@ spills' <- loadTemp r spill_loc final_reg spills setAssigR $ toRegMap - $ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg vrFmt) + $ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg fmt) setFreeRegsR $ frAllocateReg platform final_reg freeRegs allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs @@ -930,7 +911,7 @@ let candidates' :: UniqFM VirtualReg Loc candidates' = flip delListFromUFM (fmap virtualRegWithFormat_reg keep) $ - filterUFM (inRegOrBoth . locWithFormat_loc) $ + filterUFM inRegOrBoth $ assig -- This is non-deterministic but we do not -- currently support deterministic code-generation. @@ -943,54 +924,50 @@ == regclass candidates_inBoth :: [(Unique, RealRegUsage, StackSlot)] candidates_inBoth - = [ (temp, RealRegUsage reg fmt, mem) - | (temp, Loc (InBoth reg mem) fmt) <- candidates - , compat reg ] + = [ (temp, reg, mem) + | (temp, InBoth reg mem) <- candidates + , compat (realReg reg) ] -- the vregs we could kick out that are only in a reg -- this would require writing the reg to a new slot before using it. let candidates_inReg - = [ (temp, RealRegUsage reg fmt) - | (temp, Loc (InReg reg) fmt) <- candidates - , compat reg ] + = [ (temp, reg) + | (temp, InReg reg) <- candidates + , compat (realReg reg) ] let result -- we have a temporary that is in both register and mem, -- just free up its register for use. - | (temp, (RealRegUsage cand_reg old_fmt), slot) : _ <- candidates_inBoth - = do spills' <- loadTemp r spill_loc cand_reg spills - let assig1 = addToUFM_Directly assig temp $ Loc (InMem slot) old_fmt - let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage cand_reg vrFmt) + | (temp, (RealRegUsage my_reg _old_fmt), slot) : _ <- candidates_inBoth + = do spills' <- loadTemp r spill_loc my_reg spills + let assig1 = addToUFM_Directly assig temp (InMem slot) + let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage my_reg fmt) setAssigR $ toRegMap assig2 - allocateRegsAndSpill reading keep spills' (cand_reg:alloc) rs + allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs -- otherwise, we need to spill a temporary that currently -- resides in a register. - | (temp_to_push_out, RealRegUsage cand_reg old_reg_fmt) : _ + | (temp_to_push_out, RealRegUsage my_reg fmt) : _ <- candidates_inReg = do - -- Spill what's currently in the register, with the format of what's in the register. - (spill_store, slot) <- spillR (RegWithFormat (RegReal cand_reg) old_reg_fmt) temp_to_push_out + (spill_store, slot) <- spillR (RegWithFormat (RegReal my_reg) fmt) temp_to_push_out -- record that this temp was spilled recordSpill (SpillAlloc temp_to_push_out) - -- Update the register assignment: - -- - the old data is now only in memory, - -- - the new data is now allocated to this register; - -- make sure to use the new format (#26542) - let assig1 = addToUFM_Directly assig temp_to_push_out $ Loc (InMem slot) old_reg_fmt - let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage cand_reg vrFmt) + -- update the register assignment + let assig1 = addToUFM_Directly assig temp_to_push_out (InMem slot) + let assig2 = addToUFM assig1 vr $! newLocation spill_loc (RealRegUsage my_reg fmt) setAssigR $ toRegMap assig2 -- if need be, load up a spilled temp into the reg we've just freed up. - spills' <- loadTemp r spill_loc cand_reg spills + spills' <- loadTemp r spill_loc my_reg spills allocateRegsAndSpill reading keep (spill_store ++ spills') - (cand_reg:alloc) rs + (my_reg:alloc) rs -- there wasn't anything to spill, so we're screwed. @@ -999,7 +976,7 @@ $ vcat [ text "allocating vreg: " <> text (show vr) , text "assignment: " <> ppr assig - , text "format: " <> ppr vrFmt + , text "format: " <> ppr fmt , text "freeRegs: " <> text (showRegs freeRegs) , text "initFreeRegs: " <> text (showRegs (frInitFreeRegs platform `asTypeOf` freeRegs)) ] @@ -1011,12 +988,9 @@ -- | Calculate a new location after a register has been loaded. newLocation :: SpillLoc -> RealRegUsage -> Loc -- if the tmp was read from a slot, then now its in a reg as well -newLocation (ReadMem slot memFmt) (RealRegUsage r _regFmt) = - -- See Note [Use spilled format when reloading] - Loc (InBoth r slot) memFmt - +newLocation (ReadMem slot) my_reg = InBoth my_reg slot -- writes will always result in only the register being available -newLocation _ (RealRegUsage r regFmt) = Loc (InReg r) regFmt +newLocation _ my_reg = InReg my_reg -- | Load up a spilled temporary if we need to (read from memory). loadTemp @@ -1027,91 +1001,11 @@ -> [instr] -> RegM freeRegs [instr] -loadTemp (VirtualRegWithFormat vreg _fmt) (ReadMem slot memFmt) hreg spills +loadTemp (VirtualRegWithFormat vreg fmt) (ReadMem slot) hreg spills = do - -- See Note [Use spilled format when reloading] - insn <- loadR (RegWithFormat (RegReal hreg) memFmt) slot + insn <- loadR (RegWithFormat (RegReal hreg) fmt) slot recordSpill (SpillLoad $ getUnique vreg) return $ {- mkComment (text "spill load") : -} insn ++ spills loadTemp _ _ _ spills = return spills - -{- Note [Allocated register formats] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We uphold the following principle for the format at which we keep track of -alllocated registers: - - RF1. Writes redefine the format. - - When we write to a register 'r' at format 'fmt', we consider the register - to hold that format going forwards. - - (In cases where a partial write is desired, the move instruction should - specify that the destination format is the full register, even if, say, - the instruction only writes to the low 64 bits of the register. - See also Wrinkle [Don't allow scalar partial writes] in - Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness.) - - RF2. Reads from a register do not redefine its format. - - Generally speaking, as explained in Note [Register formats in liveness analysis] - in GHC.CmmToAsm.Reg.Liveness, when computing the used format from a collection - of reads, we take a least upper bound. - -It is particularly important to get (RF1) correct, as otherwise we can end up in -the situation of T26411b, where code such as - - movsd .Ln6m(%rip),%v1 - shufpd $0,%v1,%v1 - -we start off with %v1 :: F64, but after shufpd (which broadcasts the low part -to the high part) we must consider that %v1 :: F64x2. If we fail to do that, -then we will silently discard the top bits in spill/reload operations. --} - -{- Note [Use spilled format when reloading] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We always reload at the full format that a register was spilled at. The rationale -is as follows: - - 1. If later instructions only need the lower 64 bits of an XMM register, - then we should have only spilled the lower 64 bits in the first place. - (Whether this is true currently is another question.) - 2. If later instructions need say 128 bits, then we should immediately load - the entire 128 bits, as this avoids multiple load instructions. - -For (2), consider the situation of #26526, where we need to spill around a C -call (because we are using the System V ABI with no callee saved XMM registers). -Before register allocation, we have: - - vmovupd %v1 %v0 - call ... - movsd %v0 %v3 - movhlps %v0 %v4 - -The contents of %v0 need to be preserved across the call. We must spill %v0 at -format F64x2 (as later instructions need the entire 128 bits), and reload it -later. We thus expect something like: - - vmovupd %xmm1 %xmm0 - vmovupd %xmm0 72(%rsp) -- spill to preserve - call ... - vmovupd 72(%rsp) %xmm0 -- restore - movsd %xmm0 %xmm3 - movhlps %xmm0 %xmm4 - -This is certainly better than doing two loads from the stack, e.g. - - call ... - movsd 72(%rsp) %xmm0 -- restore only lower 64 bits - movsd %xmm0 %xmm3 - vmovupd 72(%rsp) %xmm0 -- restore the full 128 bits - movhlps %xmm0 %xmm4 - -The latter being especially risky because we don't want to believe %v0 is 'InBoth' -with format F64. The risk is that, when allocating registers for the 'VMOVUPD' -instruction, we think our data is already in a register and thus doesn't need to -be reloaded from memory, when in fact we have only loaded the lower 64 bits of -the data. --} diff --git a/GHC/CmmToAsm/Reg/Linear/AArch64.hs b/GHC/CmmToAsm/Reg/Linear/AArch64.hs --- a/GHC/CmmToAsm/Reg/Linear/AArch64.hs +++ b/GHC/CmmToAsm/Reg/Linear/AArch64.hs @@ -118,6 +118,7 @@ getFreeRegs cls (FreeRegs g f) = case cls of RcFloatOrVector -> go 32 f 31 + -- x18 is a platform-reserved register for Win/Mac and free for Linux (See Note [Aarch64 Register x18 at Darwin and Windows]) RcInteger -> go 0 g 18 where go _ _ i | i < 0 = [] diff --git a/GHC/CmmToAsm/Reg/Linear/Base.hs b/GHC/CmmToAsm/Reg/Linear/Base.hs --- a/GHC/CmmToAsm/Reg/Linear/Base.hs +++ b/GHC/CmmToAsm/Reg/Linear/Base.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} -- | Put common type definitions here to break recursive module dependencies. @@ -10,7 +9,7 @@ emptyBlockAssignment, updateBlockAssignment, - VLoc(..), Loc(..), IgnoreFormat(..), + Loc(..), regsOfLoc, RealRegUsage(..), @@ -40,6 +39,8 @@ import GHC.CmmToAsm.Reg.Utils import GHC.CmmToAsm.Format +import Data.Function ( on ) + data ReadingOrWriting = Reading | Writing deriving (Eq,Ord) -- | Used to store the register assignment on entry to a basic block. @@ -69,13 +70,8 @@ -> BlockAssignment freeRegs -> BlockAssignment freeRegs updateBlockAssignment dest (freeRegs, regMap) (BlockAssignment {..}) = - BlockAssignment - (mapInsert dest (freeRegs, regMap) blockMap) - (mergeUFM combWithExisting id - (mapMaybeUFM (fromVLoc . locWithFormat_loc)) - firstUsed - (toVRegMap regMap) - ) + BlockAssignment (mapInsert dest (freeRegs, regMap) blockMap) + (mergeUFM combWithExisting id (mapMaybeUFM fromLoc) (firstUsed) (toVRegMap regMap)) where -- The blocks are processed in dependency order, so if there's already an -- entry in the map then keep that assignment rather than writing the new @@ -83,14 +79,13 @@ combWithExisting :: RealReg -> Loc -> Maybe RealReg combWithExisting old_reg _ = Just $ old_reg - fromVLoc :: VLoc -> Maybe RealReg - fromVLoc (InReg rr) = Just rr - fromVLoc (InBoth rr _) = Just rr - fromVLoc _ = Nothing + fromLoc :: Loc -> Maybe RealReg + fromLoc (InReg rr) = Just $ realReg rr + fromLoc (InBoth rr _) = Just $ realReg rr + fromLoc _ = Nothing --- | Where a vreg is currently stored. --- --- + +-- | Where a vreg is currently stored -- A temporary can be marked as living in both a register and memory -- (InBoth), for example if it was recently loaded from a spill location. -- This makes it cheap to spill (no save instruction required), but we @@ -101,40 +96,21 @@ -- save it in a spill location, but mark it as InBoth because the current -- instruction might still want to read it. -- -data VLoc +data Loc -- | vreg is in a register - = InReg {-# UNPACK #-} !RealReg + = InReg {-# UNPACK #-} !RealRegUsage -- | vreg is held in stack slots - | InMem {-# UNPACK #-} !StackSlot + | InMem {-# UNPACK #-} !StackSlot + -- | vreg is held in both a register and stack slots - | InBoth {-# UNPACK #-} !RealReg - {-# UNPACK #-} !StackSlot + | InBoth {-# UNPACK #-} !RealRegUsage + {-# UNPACK #-} !StackSlot deriving (Eq, Ord, Show) --- | Where a virtual register is stored, together with the format it is stored at. --- --- See 'VLoc'. -data Loc - = Loc - { locWithFormat_loc :: {-# UNPACK #-} !VLoc - , locWithFormat_format :: Format - } - --- | A newtype used to hang off 'Eq' and 'Ord' instances for 'Loc' which --- ignore the format, as used in 'GHC.CmmToAsm.Reg.Linear.JoinToTargets'. -newtype IgnoreFormat a = IgnoreFormat a -instance Eq (IgnoreFormat Loc) where - IgnoreFormat (Loc l1 _) == IgnoreFormat (Loc l2 _) = l1 == l2 -instance Ord (IgnoreFormat Loc) where - compare (IgnoreFormat (Loc l1 _)) (IgnoreFormat (Loc l2 _)) = compare l1 l2 - -instance Outputable VLoc where - ppr l = text (show l) - instance Outputable Loc where - ppr (Loc loc fmt) = parens (ppr loc <+> dcolon <+> ppr fmt) + ppr l = text (show l) -- | A 'RealReg', together with the specific 'Format' it is used at. data RealRegUsage @@ -146,12 +122,22 @@ instance Outputable RealRegUsage where ppr (RealRegUsage r fmt) = ppr r <> dcolon <+> ppr fmt +-- NB: these instances only compare the underlying 'RealReg', as that is what +-- is important for register allocation. +-- +-- (It would nonetheless be a good idea to remove these instances.) +instance Eq RealRegUsage where + (==) = (==) `on` realReg +instance Ord RealRegUsage where + compare = compare `on` realReg + -- | Get the reg numbers stored in this Loc. -regsOfLoc :: VLoc -> [RealReg] +regsOfLoc :: Loc -> [RealRegUsage] regsOfLoc (InReg r) = [r] regsOfLoc (InBoth r _) = [r] regsOfLoc (InMem _) = [] + -- | Reasons why instructions might be inserted by the spiller. -- Used when generating stats for -ddrop-asm-stats. -- @@ -220,5 +206,4 @@ , ra_fixups :: [(BlockId,BlockId,BlockId)] } - diff --git a/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs b/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs --- a/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs +++ b/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs @@ -34,11 +34,13 @@ import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64 import qualified GHC.CmmToAsm.Reg.Linear.AArch64 as AArch64 import qualified GHC.CmmToAsm.Reg.Linear.RV64 as RV64 +import qualified GHC.CmmToAsm.Reg.Linear.LA64 as LA64 import qualified GHC.CmmToAsm.PPC.Instr as PPC.Instr import qualified GHC.CmmToAsm.X86.Instr as X86.Instr import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.Instr import qualified GHC.CmmToAsm.RV64.Instr as RV64.Instr +import qualified GHC.CmmToAsm.LA64.Instr as LA64.Instr class Show freeRegs => FR freeRegs where frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs @@ -76,6 +78,12 @@ frInitFreeRegs = RV64.initFreeRegs frReleaseReg = const RV64.releaseReg +instance FR LA64.FreeRegs where + frAllocateReg = \_ -> LA64.allocateReg + frGetFreeRegs = \_ -> LA64.getFreeRegs + frInitFreeRegs = LA64.initFreeRegs + frReleaseReg = \_ -> LA64.releaseReg + allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg] allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs plat rcls fr) allRegClasses where @@ -98,7 +106,7 @@ ArchMipseb -> panic "maxSpillSlots ArchMipseb" ArchMipsel -> panic "maxSpillSlots ArchMipsel" ArchRISCV64 -> RV64.Instr.maxSpillSlots config - ArchLoongArch64->panic "maxSpillSlots ArchLoongArch64" + ArchLoongArch64 -> LA64.Instr.maxSpillSlots config ArchJavaScript-> panic "maxSpillSlots ArchJavaScript" ArchWasm32 -> panic "maxSpillSlots ArchWasm32" ArchUnknown -> panic "maxSpillSlots ArchUnknown" diff --git a/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs --- a/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs +++ b/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Handles joining of a jump instruction to its targets. -- The first time we encounter a jump to a particular basic block, we @@ -25,6 +23,7 @@ import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Label import GHC.Data.Graph.Directed +import GHC.Data.Maybe import GHC.Utils.Panic import GHC.Utils.Monad (concatMapM) import GHC.Types.Unique @@ -34,14 +33,12 @@ import GHC.CmmToAsm.Format import GHC.Types.Unique.Set -import Data.Coerce (coerce) - -- | For a jump instruction at the end of a block, generate fixup code so its -- vregs are in the correct regs for its destination. -- joinToTargets :: (FR freeRegs, Instruction instr) - => BlockMap Regs -- ^ maps the unique of the blockid to the set of vregs + => BlockMap (UniqSet RegWithFormat) -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. -> BlockId -- ^ id of the current block @@ -65,7 +62,7 @@ ----- joinToTargets' :: (FR freeRegs, Instruction instr) - => BlockMap Regs -- ^ maps the unique of the blockid to the set of vregs + => BlockMap (UniqSet RegWithFormat) -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. -> [NatBasicBlock instr] -- ^ acc blocks of fixup code. @@ -92,24 +89,24 @@ -- adjust the current assignment to remove any vregs that are not live -- on entry to the destination block. - let Just live_set = mapLookup dest block_live - let still_live uniq _ = uniq `elemUniqSet_Directly` getRegs live_set + let live_set = expectJust $ mapLookup dest block_live + let still_live uniq _ = uniq `elemUniqSet_Directly` live_set let adjusted_assig = filterUFM_Directly still_live assig -- and free up those registers which are now free. let to_free = - [ r | (reg, Loc loc _locFmt) <- nonDetUFMToList assig + [ r | (reg, loc) <- nonDetUFMToList assig -- This is non-deterministic but we do not -- currently support deterministic code-generation. -- See Note [Unique Determinism and code generation] - , not (elemUniqSet_Directly reg $ getRegs live_set) + , not (elemUniqSet_Directly reg live_set) , r <- regsOfLoc loc ] case lookupBlockAssignment dest block_assig of Nothing -> joinToTargets_first block_live new_blocks block_id instr dest dests - block_assig adjusted_assig to_free + block_assig adjusted_assig $ map realReg to_free Just (_, dest_assig) -> joinToTargets_again @@ -119,7 +116,7 @@ -- this is the first time we jumped to this block. joinToTargets_first :: (FR freeRegs, Instruction instr) - => BlockMap Regs + => BlockMap (UniqSet RegWithFormat) -> [NatBasicBlock instr] -> BlockId -> instr @@ -145,9 +142,10 @@ joinToTargets' block_live new_blocks block_id instr dests + -- we've jumped to this block before joinToTargets_again :: (Instruction instr, FR freeRegs) - => BlockMap Regs + => BlockMap (UniqSet RegWithFormat) -> [NatBasicBlock instr] -> BlockId -> instr @@ -161,9 +159,7 @@ src_assig dest_assig -- the assignments already match, no problem. - | equalIgnoringFormats - (nonDetUFMToList dest_assig) - (nonDetUFMToList src_assig) + | nonDetUFMToList dest_assig == nonDetUFMToList src_assig -- This is non-deterministic but we do not -- currently support deterministic code-generation. -- See Note [Unique Determinism and code generation] @@ -187,7 +183,7 @@ -- -- We need to do the R2 -> R3 move before R1 -> R2. -- - let sccs = movementGraphSCCs graph + let sccs = stronglyConnCompFromEdgedVerticesOrdR graph -- debugging {- @@ -271,38 +267,32 @@ -- expandNode :: a - -> Loc -- ^ source of move - -> Loc -- ^ destination of move - -> [Node Loc a] -expandNode vreg src@(Loc srcLoc srcFmt) dst@(Loc dstLoc dstFmt) = - case (srcLoc, dstLoc) of - (InReg srcReg, InBoth dstReg dstMem) - | srcReg == dstReg - -> [DigraphNode vreg src [Loc (InMem dstMem) dstFmt]] - | otherwise - -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt - ,Loc (InMem dstMem) dstFmt]] - (InMem srcMem, InBoth dstReg dstMem) - | srcMem == dstMem - -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt]] - | otherwise - -> [DigraphNode vreg src [Loc (InReg dstReg) dstFmt - ,Loc (InMem dstMem) dstFmt]] - (InBoth _ srcMem, InMem dstMem) - | srcMem == dstMem - -> [] -- guaranteed to be true - (InBoth srcReg _, InReg dstReg) - | srcReg == dstReg - -> [] - (InBoth srcReg _, _) - -> expandNode vreg (Loc (InReg srcReg) srcFmt) dst - _ - | srcLoc == dstLoc - -> [] - | otherwise - -> [DigraphNode vreg src [dst]] + -> Loc -- ^ source of move + -> Loc -- ^ destination of move + -> [Node Loc a ] +expandNode vreg loc@(InReg src) (InBoth dst mem) + | src == dst = [DigraphNode vreg loc [InMem mem]] + | otherwise = [DigraphNode vreg loc [InReg dst, InMem mem]] +expandNode vreg loc@(InMem src) (InBoth dst mem) + | src == mem = [DigraphNode vreg loc [InReg dst]] + | otherwise = [DigraphNode vreg loc [InReg dst, InMem mem]] + +expandNode _ (InBoth _ src) (InMem dst) + | src == dst = [] -- guaranteed to be true + +expandNode _ (InBoth src _) (InReg dst) + | src == dst = [] + +expandNode vreg (InBoth src _) dst + = expandNode vreg (InReg src) dst + +expandNode vreg src dst + | src == dst = [] + | otherwise = [DigraphNode vreg src [dst]] + + -- | Generate fixup code for a particular component in the move graph -- This component tells us what values need to be moved to what -- destinations. We have eliminated any possibility of single-node @@ -337,7 +327,7 @@ -- require a fixup. -- handleComponent delta instr - (CyclicSCC ((DigraphNode vreg (Loc (InReg sreg) scls) ((Loc (InReg dreg) dcls: _))) : rest)) + (CyclicSCC ((DigraphNode vreg (InReg (RealRegUsage sreg scls)) ((InReg (RealRegUsage dreg dcls): _))) : rest)) -- dest list may have more than one element, if the reg is also InMem. = do -- spill the source into its slot @@ -348,7 +338,7 @@ instrLoad <- loadR (RegWithFormat (RegReal dreg) dcls) slot remainingFixUps <- mapM (handleComponent delta instr) - (movementGraphSCCs rest) + (stronglyConnCompFromEdgedVerticesOrdR rest) -- make sure to do all the reloads after all the spills, -- so we don't end up clobbering the source values. @@ -357,37 +347,29 @@ handleComponent _ _ (CyclicSCC _) = panic "Register Allocator: handleComponent cyclic" --- Helper functions that use the @Ord (IgnoreFormat Loc)@ instance. -equalIgnoringFormats :: [(Unique, Loc)] -> [(Unique, Loc)] -> Bool -equalIgnoringFormats = - coerce $ (==) @[(Unique, IgnoreFormat Loc)] -movementGraphSCCs :: [Node Loc Unique] -> [SCC (Node Loc Unique)] -movementGraphSCCs = - coerce $ stronglyConnCompFromEdgedVerticesOrdR @(IgnoreFormat Loc) @Unique - -- | Move a vreg between these two locations. -- makeMove :: Instruction instr - => Int -- ^ current C stack delta - -> Unique -- ^ unique of the vreg that we're moving - -> Loc -- ^ source location - -> Loc -- ^ destination location - -> RegM freeRegs [instr] -- ^ move instruction + => Int -- ^ current C stack delta. + -> Unique -- ^ unique of the vreg that we're moving. + -> Loc -- ^ source location. + -> Loc -- ^ destination location. + -> RegM freeRegs [instr] -- ^ move instruction. -makeMove delta vreg (Loc src _srcFmt) (Loc dst dstFmt) +makeMove delta vreg src dst = do config <- getConfig case (src, dst) of - (InReg s, InReg d) -> + (InReg (RealRegUsage s _), InReg (RealRegUsage d fmt)) -> do recordSpill (SpillJoinRR vreg) - return $ [mkRegRegMoveInstr config dstFmt (RegReal s) (RegReal d)] - (InMem s, InReg d) -> + return $ [mkRegRegMoveInstr config fmt (RegReal s) (RegReal d)] + (InMem s, InReg (RealRegUsage d cls)) -> do recordSpill (SpillJoinRM vreg) - return $ mkLoadInstr config (RegWithFormat (RegReal d) dstFmt) delta s - (InReg s, InMem d) -> + return $ mkLoadInstr config (RegWithFormat (RegReal d) cls) delta s + (InReg (RealRegUsage s cls), InMem d) -> do recordSpill (SpillJoinRM vreg) - return $ mkSpillInstr config (RegWithFormat (RegReal s) dstFmt) delta d + return $ mkSpillInstr config (RegWithFormat (RegReal s) cls) delta d _ -> -- we don't handle memory to memory moves. -- they shouldn't happen because we don't share diff --git a/GHC/CmmToAsm/Reg/Linear/LA64.hs b/GHC/CmmToAsm/Reg/Linear/LA64.hs new file mode 100644 --- /dev/null +++ b/GHC/CmmToAsm/Reg/Linear/LA64.hs @@ -0,0 +1,71 @@ +module GHC.CmmToAsm.Reg.Linear.LA64 where + +import GHC.Prelude + +import Data.Word +import GHC.CmmToAsm.LA64.Regs +import GHC.Platform +import GHC.Platform.Reg +import GHC.Platform.Reg.Class +import GHC.Platform.Reg.Class.Separate +import GHC.Stack +import GHC.Utils.Outputable +import GHC.Utils.Panic + +data FreeRegs = FreeRegs !Word32 !Word32 + +noFreeRegs :: FreeRegs +noFreeRegs = FreeRegs 0 0 + +instance Show FreeRegs where + show (FreeRegs g f) = "FreeRegs 0b" ++ showBits g ++ " 0b" ++ showBits f + +-- | Show bits as a `String` of @1@s and @0@s +showBits :: Word32 -> String +showBits w = map (\i -> if testBit w i then '1' else '0') [0 .. 31] + +instance Outputable FreeRegs where + ppr (FreeRegs g f) = + text " " <+> foldr (\i x -> pad_int i <+> x) (text "") [0 .. 31] + $$ text "GPR" <+> foldr (\i x -> show_bit g i <+> x) (text "") [0 .. 31] + $$ text "FPR" <+> foldr (\i x -> show_bit f i <+> x) (text "") [0 .. 31] + where + pad_int i | i < 10 = char ' ' <> int i + pad_int i = int i + -- remember bit = 1 means it's available. + show_bit bits bit | testBit bits bit = text " " + show_bit _ _ = text " x" + +-- | Set bits of all allocatable registers to 1 +initFreeRegs :: Platform -> FreeRegs +initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform) + +-- | Get all free `RealReg`s (i.e. those where the corresponding bit is 1) +getFreeRegs :: RegClass -> FreeRegs -> [RealReg] +getFreeRegs cls (FreeRegs g f) + | RcInteger <- cls = go 0 g allocatableIntRegs + | RcFloat <- cls = go 32 f allocatableDoubleRegs + | RcVector <- cls = sorry "Linear.LA64.getFreeRegs: vector registers are not supported" + where + go _ _ [] = [] + go off x (i : is) + | testBit x i = RealRegSingle (off + i) : (go off x $! is) + | otherwise = go off x $! is + allocatableIntRegs = [4 .. 11] ++ [12 .. 19] + allocatableDoubleRegs = [0 .. 7] ++ [8 .. 23] + +-- | Set corresponding register bit to 0 +allocateReg :: (HasCallStack) => RealReg -> FreeRegs -> FreeRegs +allocateReg (RealRegSingle r) (FreeRegs g f) + | r > 31 && testBit f (r - 32) = FreeRegs g (clearBit f (r - 32)) + | r < 32 && testBit g r = FreeRegs (clearBit g r) f + | r > 31 = panic $ "Linear.LA64.allocReg: double allocation of float reg v" ++ show (r - 32) ++ "; " ++ showBits f + | otherwise = pprPanic "Linear.LA64.allocReg" $ text ("double allocation of gp reg x" ++ show r ++ "; " ++ showBits g) + +-- | Set corresponding register bit to 1 +releaseReg :: (HasCallStack) => RealReg -> FreeRegs -> FreeRegs +releaseReg (RealRegSingle r) (FreeRegs g f) + | r > 31 && testBit f (r - 32) = pprPanic "Linear.LA64.releaseReg" (text "can't release non-allocated reg v" <> int (r - 32)) + | r < 32 && testBit g r = pprPanic "Linear.LA64.releaseReg" (text "can't release non-allocated reg x" <> int r) + | r > 31 = FreeRegs g (setBit f (r - 32)) + | otherwise = FreeRegs (setBit g r) f diff --git a/GHC/CmmToAsm/Reg/Linear/StackMap.hs b/GHC/CmmToAsm/Reg/Linear/StackMap.hs --- a/GHC/CmmToAsm/Reg/Linear/StackMap.hs +++ b/GHC/CmmToAsm/Reg/Linear/StackMap.hs @@ -37,11 +37,7 @@ -- See Note [UniqFM and the register allocator] -- | Assignment of vregs to stack slots. - -- - -- We record not just the slot, but also how many stack slots the vreg - -- takes up, in order to avoid re-using a stack slot for a register - -- that has grown but already had a stack slot (#26668). - , stackMapAssignment :: UniqFM Unique (StackSlot, Int) } + , stackMapAssignment :: UniqFM Unique StackSlot } -- | An empty stack map, with all slots available. @@ -54,19 +50,14 @@ -- getStackSlotFor :: StackMap -> Format -> Unique -> (StackMap, Int) -getStackSlotFor fs@(StackMap freeSlot reserved) fmt regUnique - -- The register already has a stack slot; try to re-use it. - | Just (slot, nbSlots) <- lookupUFM reserved regUnique - -- Make sure the slot is big enough for this format, in case the register - -- has grown (#26668). - , nbNeededSlots <= nbSlots - = (fs, slot) - | otherwise - = (StackMap (freeSlot+nbNeededSlots) (addToUFM reserved regUnique (freeSlot, nbNeededSlots)), freeSlot) - -- NB: this can create fragmentation if a register keeps growing. - -- That's probably OK, as this is only happens very rarely. - where - !nbNeededSlots = (formatInBytes fmt + 7) `div` 8 +getStackSlotFor fs@(StackMap _ reserved) _fmt regUnique + | Just slot <- lookupUFM reserved regUnique = (fs, slot) + +getStackSlotFor (StackMap freeSlot reserved) fmt regUnique = + let + nbSlots = (formatInBytes fmt + 7) `div` 8 + in + (StackMap (freeSlot+nbSlots) (addToUFM reserved regUnique freeSlot), freeSlot) -- | Return the number of stack slots that were allocated getStackUse :: StackMap -> Int diff --git a/GHC/CmmToAsm/Reg/Liveness.hs b/GHC/CmmToAsm/Reg/Liveness.hs --- a/GHC/CmmToAsm/Reg/Liveness.hs +++ b/GHC/CmmToAsm/Reg/Liveness.hs @@ -1,8 +1,5 @@ {-# LANGUAGE TypeFamilies #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- -- -- The register liveness determinator @@ -33,9 +30,7 @@ patchRegsLiveInstr, reverseBlocksInTops, regLiveness, - cmmTopLiveness, - - module GHC.CmmToAsm.Reg.Regs + cmmTopLiveness ) where import GHC.Prelude @@ -46,14 +41,13 @@ import GHC.CmmToAsm.Format import GHC.CmmToAsm.Types import GHC.CmmToAsm.Utils -import GHC.CmmToAsm.Reg.Regs import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Label import GHC.Cmm +import GHC.CmmToAsm.Reg.Target import GHC.Data.Graph.Directed -import GHC.Data.OrdList import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic @@ -65,7 +59,7 @@ import GHC.Data.Bag import GHC.Utils.Monad.State.Strict -import Data.List (mapAccumL, partition) +import Data.List (mapAccumL, sortOn) import Data.Maybe import Data.IntSet (IntSet) import GHC.Utils.Misc @@ -194,9 +188,9 @@ data Liveness = Liveness - { liveBorn :: Regs -- ^ registers born in this instruction (written to for first time). - , liveDieRead :: Regs -- ^ registers that died because they were read for the last time. - , liveDieWrite :: Regs } -- ^ registers that died because they were clobbered by something. + { liveBorn :: UniqSet RegWithFormat -- ^ registers born in this instruction (written to for first time). + , liveDieRead :: UniqSet RegWithFormat -- ^ registers that died because they were read for the last time. + , liveDieWrite :: UniqSet RegWithFormat} -- ^ registers that died because they were clobbered by something. -- | Stash regs live on entry to each basic block in the info part of the cmm code. @@ -205,7 +199,7 @@ (LabelMap RawCmmStatics) -- cmm info table static stuff [BlockId] -- entry points (first one is the -- entry point for the proc). - (BlockMap Regs) -- argument locals live on entry to this block + (BlockMap (UniqSet RegWithFormat)) -- argument locals live on entry to this block (BlockMap IntSet) -- stack slots live on entry to this block @@ -251,8 +245,8 @@ , pprRegs (text "# w_dying: ") (liveDieWrite live) ] $+$ space) - where pprRegs :: SDoc -> Regs -> SDoc - pprRegs name ( Regs regs ) + where pprRegs :: SDoc -> UniqSet RegWithFormat -> SDoc + pprRegs name regs | isEmptyUniqSet regs = empty | otherwise = name <> (pprUFM (getUniqSet regs) (hcat . punctuate space . map ppr)) @@ -335,7 +329,7 @@ :: Instruction instr => Platform -> LiveCmmDecl statics instr - -> (Bag Regs, Bag (Reg, Reg)) + -> (Bag (UniqSet RegWithFormat), Bag (Reg, Reg)) slurpConflicts platform live = slurpCmm (emptyBag, emptyBag) live @@ -369,22 +363,23 @@ = let -- regs that die because they are read for the last time at the start of an instruction -- are not live across it. - rsLiveAcross = rsLiveEntry `minusRegs` (liveDieRead live) + rsLiveAcross = rsLiveEntry `minusUniqSet` (liveDieRead live) -- regs live on entry to the next instruction. -- be careful of orphans, make sure to delete dying regs _after_ unioning -- in the ones that are born here. - rsLiveNext = (rsLiveAcross `unionRegsMaxFmt` (liveBorn live)) - `minusCoveredRegs` (liveDieWrite live) + rsLiveNext = (rsLiveAcross `unionUniqSets` (liveBorn live)) + `minusUniqSet` (liveDieWrite live) -- orphan vregs are the ones that die in the same instruction they are born in. -- these are likely to be results that are never used, but we still -- need to assign a hreg to them.. - rsOrphans = intersectRegsMaxFmt + rsOrphans = intersectUniqSets (liveBorn live) - (unionRegsMaxFmt (liveDieWrite live) (liveDieRead live)) + (unionUniqSets (liveDieWrite live) (liveDieRead live)) - rsConflicts = unionRegsMaxFmt rsLiveNext rsOrphans + -- + rsConflicts = unionUniqSets rsLiveNext rsOrphans in case takeRegRegMoveInstr platform instr of Just rr -> slurpLIs rsLiveNext @@ -532,11 +527,10 @@ -- make sure the block that was first in the input list -- stays at the front of the output. This is the entry point -- of the proc, and it needs to come first. - ((first':_), rest') - = partition ((== first_id) . blockId) final_blocks + final_blocks' = sortOn ((/= first_id) . blockId) final_blocks - in CmmProc info label live - (ListGraph $ map (stripLiveBlock config) $ first' : rest') + in CmmProc info label live $ ListGraph $ + map (stripLiveBlock config) final_blocks' -- If the proc has blocks but we don't know what the first one was, then we're dead. stripCmm proc @@ -568,28 +562,32 @@ = BasicBlock i instrs' where (instrs', _) - = runState (spillNat nilOL lis) 0 + = runState (spillNat [] lis) 0 - spillNat :: Instruction instr => OrdList instr -> [LiveInstr instr] -> State Int [instr] + -- spillNat :: [instr] -> [LiveInstr instr] -> State Int [instr] + spillNat :: Instruction instr => [instr] -> [LiveInstr instr] -> State Int [instr] spillNat acc [] - = return (fromOL acc) + = return (reverse acc) + -- The SPILL/RELOAD cases do not appear to be exercised by our codegens + -- spillNat acc (LiveInstr (SPILL reg slot) _ : instrs) = do delta <- get - spillNat (acc `appOL` toOL (mkSpillInstr config reg delta slot)) instrs + spillNat (mkSpillInstr config reg delta slot ++ acc) instrs spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs) = do delta <- get - spillNat (acc `appOL` toOL (mkLoadInstr config reg delta slot)) instrs + spillNat (mkLoadInstr config reg delta slot ++ acc) instrs spillNat acc (LiveInstr (Instr instr) _ : instrs) | Just i <- takeDeltaInstr instr = do put i spillNat acc instrs - | otherwise - = spillNat (acc `snocOL` instr) instrs + spillNat acc (LiveInstr (Instr instr) _ : instrs) + = spillNat (instr : acc) instrs + -- | Erase Delta instructions. eraseDeltasLive @@ -624,7 +622,7 @@ | LiveInfo static id blockMap mLiveSlots <- info = let -- See Note [Unique Determinism and code generation] - blockMap' = mapMap (mapRegs patchF) blockMap + blockMap' = mapMap (mapRegFormatSet patchF) blockMap info' = LiveInfo static id blockMap' mLiveSlots in CmmProc info' label live $ map patchSCC sccs @@ -653,8 +651,8 @@ | r1 == r2 = True -- destination reg is never used - | r2 `elemRegs` liveBorn live - , r2 `elemRegs` liveDieRead live || r2 `elemRegs` liveDieWrite live + | elemUniqSet_Directly (getUnique r2) (liveBorn live) + , elemUniqSet_Directly (getUnique r2) (liveDieRead live) || elemUniqSet_Directly (getUnique r2) (liveDieWrite live) = True | otherwise = False @@ -678,9 +676,9 @@ (patchRegsOfInstr platform instr patchF) (Just live { -- WARNING: have to go via lists here because patchF changes the uniq in the Reg - liveBorn = mapRegs patchF $ liveBorn live - , liveDieRead = mapRegs patchF $ liveDieRead live - , liveDieWrite = mapRegs patchF $ liveDieWrite live }) + liveBorn = mapRegFormatSet patchF $ liveBorn live + , liveDieRead = mapRegFormatSet patchF $ liveDieRead live + , liveDieWrite = mapRegFormatSet patchF $ liveDieWrite live }) -- See Note [Unique Determinism and code generation] -------------------------------------------------------------------------------- @@ -870,7 +868,7 @@ -> [SCC (LiveBasicBlock instr)] -> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers -- which are "dead after this instruction". - BlockMap Regs) -- blocks annotated with set of live registers + BlockMap (UniqSet RegWithFormat)) -- blocks annotated with set of live registers -- on entry to the block. computeLiveness platform sccs @@ -885,11 +883,11 @@ livenessSCCs :: Instruction instr => Platform - -> BlockMap Regs + -> BlockMap (UniqSet RegWithFormat) -> [SCC (LiveBasicBlock instr)] -- accum -> [SCC (LiveBasicBlock instr)] -> ( [SCC (LiveBasicBlock instr)] - , BlockMap Regs) + , BlockMap (UniqSet RegWithFormat)) livenessSCCs _ blockmap done [] = (done, blockmap) @@ -918,14 +916,13 @@ linearLiveness :: Instruction instr - => BlockMap Regs -> [LiveBasicBlock instr] - -> (BlockMap Regs, [LiveBasicBlock instr]) + => BlockMap (UniqSet RegWithFormat) -> [LiveBasicBlock instr] + -> (BlockMap (UniqSet RegWithFormat), [LiveBasicBlock instr]) linearLiveness = mapAccumL (livenessBlock platform) -- probably the least efficient way to compare two -- BlockMaps for equality. - equalBlockMaps :: BlockMap Regs -> BlockMap Regs -> Bool equalBlockMaps a b = a' == b' where a' = mapToList a @@ -939,14 +936,14 @@ livenessBlock :: Instruction instr => Platform - -> BlockMap Regs + -> BlockMap (UniqSet RegWithFormat) -> LiveBasicBlock instr - -> (BlockMap Regs, LiveBasicBlock instr) + -> (BlockMap (UniqSet RegWithFormat), LiveBasicBlock instr) livenessBlock platform blockmap (BasicBlock block_id instrs) = let (regsLiveOnEntry, instrs1) - = livenessBack platform noRegs blockmap [] (reverse instrs) + = livenessBack platform emptyUniqSet blockmap [] (reverse instrs) blockmap' = mapInsert block_id regsLiveOnEntry blockmap instrs2 = livenessForward platform regsLiveOnEntry instrs1 @@ -961,26 +958,23 @@ livenessForward :: Instruction instr => Platform - -> Regs -- regs live on this instr + -> UniqSet RegWithFormat -- regs live on this instr -> [LiveInstr instr] -> [LiveInstr instr] livenessForward _ _ [] = [] livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis) | Just live <- mLive = let - RU _ rsWritten = regUsageOfInstr platform instr + RU _ written = regUsageOfInstr platform instr -- Regs that are written to but weren't live on entry to this instruction -- are recorded as being born here. - rsBorn = mkRegsMaxFmt - [ reg - | reg@( RegWithFormat r _ ) <- rsWritten - , not $ r `elemRegs` rsLiveEntry - ] + rsBorn = mkUniqSet + $ filter (\ r -> not $ elemUniqSet_Directly (getUnique r) rsLiveEntry) + $ written - -- See Note [Register formats in liveness analysis] - rsLiveNext = (rsLiveEntry `addRegsMaxFmt` rsWritten) - `minusRegs` (liveDieRead live) -- (FmtFwd1) - `minusRegs` (liveDieWrite live) -- (FmtFwd2) + rsLiveNext = (rsLiveEntry `unionUniqSets` rsBorn) + `minusUniqSet` (liveDieRead live) + `minusUniqSet` (liveDieWrite live) in LiveInstr instr (Just live { liveBorn = rsBorn }) : livenessForward platform rsLiveNext lis @@ -995,11 +989,11 @@ livenessBack :: Instruction instr => Platform - -> Regs -- ^ regs live on this instr - -> BlockMap Regs -- ^ regs live on entry to other BBs - -> [LiveInstr instr] -- ^ instructions (accum) - -> [LiveInstr instr] -- ^ instructions - -> (Regs, [LiveInstr instr]) + -> UniqSet RegWithFormat -- regs live on this instr + -> BlockMap (UniqSet RegWithFormat) -- regs live on entry to other BBs + -> [LiveInstr instr] -- instructions (accum) + -> [LiveInstr instr] -- instructions + -> (UniqSet RegWithFormat, [LiveInstr instr]) livenessBack _ liveregs _ done [] = (liveregs, done) @@ -1007,14 +1001,15 @@ = let !(!liveregs', instr') = liveness1 platform liveregs blockmap instr in livenessBack platform liveregs' blockmap (instr' : acc) instrs + -- don't bother tagging comments or deltas with liveness liveness1 :: Instruction instr => Platform - -> Regs - -> BlockMap Regs + -> UniqSet RegWithFormat + -> BlockMap (UniqSet RegWithFormat) -> LiveInstr instr - -> (Regs, LiveInstr instr) + -> (UniqSet RegWithFormat, LiveInstr instr) liveness1 _ liveregs _ (LiveInstr instr _) | isMetaInstr instr @@ -1025,14 +1020,14 @@ | not_a_branch = (liveregs1, LiveInstr instr (Just $ Liveness - { liveBorn = noRegs + { liveBorn = emptyUniqSet , liveDieRead = r_dying , liveDieWrite = w_dying })) | otherwise = (liveregs_br, LiveInstr instr (Just $ Liveness - { liveBorn = noRegs + { liveBorn = emptyUniqSet , liveDieRead = r_dying_br , liveDieWrite = w_dying })) @@ -1041,22 +1036,21 @@ -- registers that were written here are dead going backwards. -- registers that were read here are live going backwards. - -- As for the formats, see Note [Register formats in liveness analysis] - liveregs1 = (liveregs `minusCoveredRegs` mkRegsMaxFmt written) -- (FmtBwd2) - `addRegsMaxFmt` read -- (FmtBwd1) + liveregs1 = (liveregs `delListFromUniqSet` written) + `addListToUniqSet` read - -- registers that are not live beyond this point are recorded - -- as dying here. - r_dying = mkRegsMaxFmt + -- registers that are not live beyond this point, are recorded + -- as dying here. + r_dying = mkUniqSet [ reg | reg@(RegWithFormat r _) <- read , not $ any (\ w -> getUnique w == getUnique r) written - , not $ r `elemRegs` liveregs ] + , not (elementOfUniqSet reg liveregs) ] - w_dying = mkRegsMaxFmt + w_dying = mkUniqSet [ reg - | reg@(RegWithFormat r _) <- written - , not $ r `elemRegs` liveregs ] + | reg <- written + , not (elementOfUniqSet reg liveregs) ] -- union in the live regs from all the jump destinations of this -- instruction. @@ -1066,91 +1060,14 @@ targetLiveRegs target = case mapLookup target blockmap of Just ra -> ra - Nothing -> noRegs - - -- registers that are live only in the branch targets should - -- be listed as dying here. - live_from_branch = unionManyRegsMaxFmt (map targetLiveRegs targets) - liveregs_br = liveregs1 `unionRegsMaxFmt` live_from_branch - live_branch_only = live_from_branch `minusRegs` liveregs - r_dying_br = r_dying `unionRegsMaxFmt` live_branch_only - -- NB: we treat registers live in branches similar to any other - -- registers read by the instruction, so the logic here matches - -- the logic in the definition of 'r_dying' above. - -{- Note [Register formats in liveness analysis] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We keep track of which format each virtual register is live at, and make use -of this information during liveness analysis. - -First, we do backwards liveness analysis: - - (FmtBwd1) Take the larger format when computing registers live going backwards. - - Suppose for example that we have: - - - movps %v0 %v1 - movupd %v0 %v2 - - Here we read %v0 both at format F64 and F64x2, so we must consider it live - at format F64x2, going backwards, in the previous instructions. - Not doing so caused #26411. - - (FmtBwd2) Only consider fully clobbered registers to be dead going backwards. - - Consider for example the liveness of %v0 going backwards in the following - instruction block: - - movlhps %v5 %v0 -- write the upper F64 of %v0 - movupd %v1 %v2 -- some unrelated instruction - movsd %v3 %v0 -- write the lower F64 of %v0 - movupd %v0 %v4 -- read %v0 at format F64x2 - - We must not consider %v0 to be dead going backwards from 'movsd %v3 %v0'. - If we do, that means we think %v0 is dead during 'movupd %v1 %v2', and thus - that we can assign both %v0 and %v2 to the same real register. However, this - would be catastrophic, as 'movupd %v1 %v2' would then clobber the data - written to '%v0' in 'movlhps %v5 %v0'. - - Wrinkle [Don't allow scalar partial writes] - - We don't allow partial writes within scalar registers, for many reasons: - - - partial writes can cause partial register stalls, which can have - disastrous performance implications (as seen in #20405) - - partial writes makes register allocation more difficult, as they can - require preserving the contents of a register across many instructions, - as in: - - mulw %v0 -- 32-bit write to %rax - - mulb %v1 -- 16-bit partial write to %rax - - The current register allocator is not equipped for spilling real - registers (only virtual registers), which means that e.g. on i386 we - end up with only 2 allocatable real GP registers for , - which is insufficient for instructions that require 3 registers. - - We could allow this to be customised depending on the architecture, but - currently we simply never allow scalar partial writes. - -The forwards analysis is a bit simpler: - - (FmtFwd1) Remove without considering format when dead going forwards. - - If a register is no longer read after an instruction, then it is dead - going forwards. The format doesn't matter. + Nothing -> emptyUniqSet - (FmtFwd2) Consider all writes as making a register dead going forwards. + live_from_branch = unionManyUniqSets (map targetLiveRegs targets) - If we write to the lower 64 bits of a 128 bit register, we don't currently - have a way to say "the lower 64 bits are dead but the top 64 bits are still live". - We would need a notion of partial register, similar to 'VirtualRegHi' for - the top 32 bits of a I32x2 virtual register. + liveregs_br = liveregs1 `unionUniqSets` live_from_branch - As a result, the current approach is to consider the entire register to - be dead. This might cause us to unnecessarily spill/reload an entire vector - register to avoid its lower bits getting clobbered even though later - instructions might only care about its upper bits. --} + -- registers that are live only in the branch targets should + -- be listed as dying here. + live_branch_only = live_from_branch `minusUniqSet` liveregs + r_dying_br = (r_dying `unionUniqSets` live_branch_only) + -- See Note [Unique Determinism and code generation] diff --git a/GHC/CmmToAsm/Reg/Regs.hs b/GHC/CmmToAsm/Reg/Regs.hs deleted file mode 100644 --- a/GHC/CmmToAsm/Reg/Regs.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-# LANGUAGE DerivingStrategies #-} - -module GHC.CmmToAsm.Reg.Regs ( - Regs(..), - noRegs, - addRegMaxFmt, addRegsMaxFmt, - mkRegsMaxFmt, - minusCoveredRegs, - minusRegs, - unionRegsMaxFmt, - unionManyRegsMaxFmt, - intersectRegsMaxFmt, - shrinkingRegs, - mapRegs, - elemRegs, lookupReg, - - ) where - -import GHC.Prelude - -import GHC.Platform.Reg ( Reg ) -import GHC.CmmToAsm.Format ( Format, RegWithFormat(..), isVecFormat ) - -import GHC.Utils.Outputable ( Outputable ) -import GHC.Types.Unique ( Uniquable(..) ) -import GHC.Types.Unique.Set - -import Data.Coerce ( coerce ) - ------------------------------------------------------------------------------ - --- | A set of registers, with their respective formats, mostly for use in --- register liveness analysis. See Note [Register formats in liveness analysis] --- in GHC.CmmToAsm.Reg.Liveness. -newtype Regs = Regs { getRegs :: UniqSet RegWithFormat } - deriving newtype (Eq, Outputable) - -maxRegWithFormat :: RegWithFormat -> RegWithFormat -> RegWithFormat -maxRegWithFormat r1@(RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2) - = if fmt1 >= fmt2 - then r1 - else r2 - -- Re-using one of the arguments avoids allocating a new 'RegWithFormat', - -- compared with returning 'RegWithFormat r1 (max fmt1 fmt2)'. - -noRegs :: Regs -noRegs = Regs emptyUniqSet - -addRegsMaxFmt :: Regs -> [RegWithFormat] -> Regs -addRegsMaxFmt = foldl' addRegMaxFmt - -mkRegsMaxFmt :: [RegWithFormat] -> Regs -mkRegsMaxFmt = addRegsMaxFmt noRegs - -addRegMaxFmt :: Regs -> RegWithFormat -> Regs -addRegMaxFmt = coerce $ strictAddOneToUniqSet_C maxRegWithFormat - -- Don't build up thunks when combining with 'maxRegWithFormat' - --- | Remove 2nd argument registers from the 1st argument, but only --- if the format in the second argument is at least as large as the format --- in the first argument. -minusCoveredRegs :: Regs -> Regs -> Regs -minusCoveredRegs = coerce $ minusUniqSet_C f - where - f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat - f r1@(RegWithFormat _ fmt1) (RegWithFormat _ fmt2) = - if fmt2 >= fmt1 - || - not ( isVecFormat fmt1 ) - -- See Wrinkle [Don't allow scalar partial writes] - -- in Note [Register formats in liveness analysis] in GHC.CmmToAsm.Reg.Liveness. - then Nothing - else Just r1 - --- | Remove 2nd argument registers from the 1st argument, regardless of format. --- --- See also 'minusCoveredRegs', which looks at the formats. -minusRegs :: Regs -> Regs -> Regs -minusRegs = coerce $ minusUniqSet @RegWithFormat - -unionRegsMaxFmt :: Regs -> Regs -> Regs -unionRegsMaxFmt = coerce $ strictUnionUniqSets_C maxRegWithFormat - -- Don't build up thunks when combining with 'maxRegWithFormat' - -unionManyRegsMaxFmt :: [Regs] -> Regs -unionManyRegsMaxFmt = coerce $ strictUnionManyUniqSets_C maxRegWithFormat - -- Don't build up thunks when combining with 'maxRegWithFormat' - -intersectRegsMaxFmt :: Regs -> Regs -> Regs -intersectRegsMaxFmt = coerce $ strictIntersectUniqSets_C maxRegWithFormat - -- Don't build up thunks when combining with 'maxRegWithFormat' - --- | Computes the set of registers in both arguments whose size is smaller in --- the second argument than in the first. -shrinkingRegs :: Regs -> Regs -> Regs -shrinkingRegs = coerce $ minusUniqSet_C f - where - f :: RegWithFormat -> RegWithFormat -> Maybe RegWithFormat - f (RegWithFormat _ fmt1) r2@(RegWithFormat _ fmt2) - | fmt2 < fmt1 - = Just r2 - | otherwise - = Nothing - --- | Map a function that may change the 'Unique' of the register, --- which entails going via lists. --- --- See Note [UniqSet invariant] in GHC.Types.Unique.Set. -mapRegs :: (Reg -> Reg) -> Regs -> Regs -mapRegs f (Regs live) = - Regs $ - mapUniqSet (\ (RegWithFormat r fmt) -> RegWithFormat (f r) fmt) live - -elemRegs :: Reg -> Regs -> Bool -elemRegs r (Regs live) = elemUniqSet_Directly (getUnique r) live - -lookupReg :: Reg -> Regs -> Maybe Format -lookupReg r (Regs live) = - regWithFormat_format <$> lookupUniqSet_Directly live (getUnique r) diff --git a/GHC/CmmToAsm/Reg/Target.hs b/GHC/CmmToAsm/Reg/Target.hs --- a/GHC/CmmToAsm/Reg/Target.hs +++ b/GHC/CmmToAsm/Reg/Target.hs @@ -15,6 +15,7 @@ targetMkVirtualReg, targetRegDotColor, targetClassOfReg, + mapRegFormatSet, ) where @@ -26,8 +27,10 @@ import GHC.CmmToAsm.Format import GHC.Utils.Outputable +import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Types.Unique +import GHC.Types.Unique.Set import GHC.Platform import qualified GHC.CmmToAsm.X86.Regs as X86 @@ -35,6 +38,7 @@ import qualified GHC.CmmToAsm.PPC.Regs as PPC import qualified GHC.CmmToAsm.AArch64.Regs as AArch64 import qualified GHC.CmmToAsm.RV64.Regs as RV64 +import qualified GHC.CmmToAsm.LA64.Regs as LA64 targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> Int targetVirtualRegSqueeze platform @@ -50,7 +54,7 @@ ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb" ArchMipsel -> panic "targetVirtualRegSqueeze ArchMipsel" ArchRISCV64 -> RV64.virtualRegSqueeze - ArchLoongArch64->panic "targetVirtualRegSqueeze ArchLoongArch64" + ArchLoongArch64 -> LA64.virtualRegSqueeze ArchJavaScript-> panic "targetVirtualRegSqueeze ArchJavaScript" ArchWasm32 -> panic "targetVirtualRegSqueeze ArchWasm32" ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown" @@ -70,7 +74,7 @@ ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb" ArchMipsel -> panic "targetRealRegSqueeze ArchMipsel" ArchRISCV64 -> RV64.realRegSqueeze - ArchLoongArch64->panic "targetRealRegSqueeze ArchLoongArch64" + ArchLoongArch64 -> LA64.realRegSqueeze ArchJavaScript-> panic "targetRealRegSqueeze ArchJavaScript" ArchWasm32 -> panic "targetRealRegSqueeze ArchWasm32" ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown" @@ -89,7 +93,7 @@ ArchMipseb -> panic "targetClassOfRealReg ArchMipseb" ArchMipsel -> panic "targetClassOfRealReg ArchMipsel" ArchRISCV64 -> RV64.classOfRealReg - ArchLoongArch64->panic "targetClassOfRealReg ArchLoongArch64" + ArchLoongArch64 -> LA64.classOfRealReg ArchJavaScript-> panic "targetClassOfRealReg ArchJavaScript" ArchWasm32 -> panic "targetClassOfRealReg ArchWasm32" ArchUnknown -> panic "targetClassOfRealReg ArchUnknown" @@ -108,7 +112,7 @@ ArchMipseb -> panic "targetMkVirtualReg ArchMipseb" ArchMipsel -> panic "targetMkVirtualReg ArchMipsel" ArchRISCV64 -> RV64.mkVirtualReg - ArchLoongArch64->panic "targetMkVirtualReg ArchLoongArch64" + ArchLoongArch64 -> LA64.mkVirtualReg ArchJavaScript-> panic "targetMkVirtualReg ArchJavaScript" ArchWasm32 -> panic "targetMkVirtualReg ArchWasm32" ArchUnknown -> panic "targetMkVirtualReg ArchUnknown" @@ -127,7 +131,7 @@ ArchMipseb -> panic "targetRegDotColor ArchMipseb" ArchMipsel -> panic "targetRegDotColor ArchMipsel" ArchRISCV64 -> RV64.regDotColor - ArchLoongArch64->panic "targetRegDotColor ArchLoongArch64" + ArchLoongArch64 -> LA64.regDotColor ArchJavaScript-> panic "targetRegDotColor ArchJavaScript" ArchWasm32 -> panic "targetRegDotColor ArchWasm32" ArchUnknown -> panic "targetRegDotColor ArchUnknown" @@ -138,3 +142,6 @@ = case reg of RegVirtual vr -> classOfVirtualReg (platformArch platform) vr RegReal rr -> targetClassOfRealReg platform rr + +mapRegFormatSet :: HasDebugCallStack => (Reg -> Reg) -> UniqSet RegWithFormat -> UniqSet RegWithFormat +mapRegFormatSet f = mapUniqSet (\ ( RegWithFormat r fmt ) -> RegWithFormat ( f r ) fmt) diff --git a/GHC/CmmToAsm/Wasm/FromCmm.hs b/GHC/CmmToAsm/Wasm/FromCmm.hs --- a/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -113,7 +113,7 @@ -- | Calculate a data section's kind, see haddock docs of -- 'DataSectionKind' for more explanation. dataSectionKindFromCmmSection :: Section -> DataSectionKind -dataSectionKindFromCmmSection (Section t _) = case sectionProtection t of +dataSectionKindFromCmmSection s = case sectionProtection s of ReadWriteSection -> SectionData _ -> SectionROData diff --git a/GHC/CmmToAsm/X86/CodeGen.hs b/GHC/CmmToAsm/X86/CodeGen.hs --- a/GHC/CmmToAsm/X86/CodeGen.hs +++ b/GHC/CmmToAsm/X86/CodeGen.hs @@ -6,5115 +6,6252 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ------------------------------------------------------------------------------ --- --- Generating machine code (instruction selection) --- --- (c) The University of Glasgow 1996-2004 --- ------------------------------------------------------------------------------ - --- This is a big module, but, if you pay attention to --- (a) the sectioning, and (b) the type signatures, the --- structure should not be too overwhelming. - -module GHC.CmmToAsm.X86.CodeGen ( - cmmTopCodeGen, - generateJumpTableForInstr, - extractUnwindPoints, - invertCondBranches, - InstrBlock -) - -where - --- NCG stuff: -import GHC.Prelude - -import GHC.CmmToAsm.X86.Instr -import GHC.CmmToAsm.X86.Cond -import GHC.CmmToAsm.X86.Regs -import GHC.CmmToAsm.X86.Ppr -import GHC.CmmToAsm.X86.RegInfo - -import GHC.Platform.Regs -import GHC.CmmToAsm.CPrim -import GHC.CmmToAsm.Types -import GHC.Cmm.DebugBlock - ( DebugBlock(..), UnwindPoint(..), UnwindTable - , UnwindExpr(UwReg), toUnwindExpr - ) -import GHC.CmmToAsm.PIC -import GHC.CmmToAsm.Monad - ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat - , getDeltaNat, getBlockIdNat, getPicBaseNat - , Reg64(..), RegCode64(..), getNewReg64, localReg64 - , getPicBaseMaybeNat, getDebugBlock, getFileId - , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform - , getCfgWeights - ) -import GHC.CmmToAsm.CFG -import GHC.CmmToAsm.Format -import GHC.CmmToAsm.Config -import GHC.Platform.Reg -import GHC.CmmToAsm.Reg.Target (targetClassOfReg) -import GHC.Platform -import GHC.Platform.Reg.Class.Unified (RegClass(..)) - --- Our intermediate code: -import GHC.Types.Basic -import GHC.Cmm.BlockId -import GHC.Unit.Types ( primUnitId ) -import GHC.Cmm.Utils -import GHC.Cmm.Switch -import GHC.Cmm -import GHC.Cmm.Dataflow.Block -import GHC.Cmm.Dataflow.Graph -import GHC.Cmm.Dataflow.Label -import GHC.Cmm.CLabel -import GHC.Types.Tickish ( GenTickish(..) ) -import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol ) - --- The rest: -import GHC.Data.Maybe ( expectJust ) -import GHC.Types.ForeignCall ( CCallConv(..) ) -import GHC.Data.OrdList -import GHC.Utils.Outputable -import GHC.Utils.Constants (debugIsOn) -import GHC.Utils.Monad ( foldMapM ) -import GHC.Utils.Panic -import GHC.Data.FastString -import GHC.Utils.Misc -import GHC.Types.Unique.DSM ( getUniqueM ) - -import qualified Data.Semigroup as S - -import Control.Monad -import Control.Monad.Trans.State.Strict - ( StateT, evalStateT, get, put ) -import Control.Monad.Trans.Class (lift) -import Data.Foldable (fold) -import Data.Int -import Data.Maybe -import Data.Word - -import qualified Data.Map as Map - -is32BitPlatform :: NatM Bool -is32BitPlatform = do - platform <- getPlatform - return $ target32Bit platform - -sse4_1Enabled :: NatM Bool -sse4_1Enabled = do - config <- getConfig - return (ncgSseVersion config >= Just SSE4) - -sse4_2Enabled :: NatM Bool -sse4_2Enabled = do - config <- getConfig - return (ncgSseVersion config >= Just SSE42) - -avxEnabled :: NatM Bool -avxEnabled = do - config <- getConfig - return (ncgAvxEnabled config) - -cmmTopCodeGen - :: RawCmmDecl - -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr] - -cmmTopCodeGen (CmmProc info lab live graph) = do - let blocks = toBlockListEntryFirst graph - (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks - picBaseMb <- getPicBaseMaybeNat - platform <- getPlatform - let proc = CmmProc info lab live (ListGraph $ concat nat_blocks) - tops = proc : concat statics - os = platformOS platform - - case picBaseMb of - Just picBase -> initializePicBase_x86 os picBase tops - Nothing -> return tops - -cmmTopCodeGen (CmmData sec dat) = - return [CmmData sec (mkAlignment 1, dat)] -- no translation, we just use CmmStatic - -{- Note [Verifying basic blocks] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - We want to guarantee a few things about the results - of instruction selection. - - Namely that each basic blocks consists of: - * A (potentially empty) sequence of straight line instructions - followed by - * A (potentially empty) sequence of jump like instructions. - - We can verify this by going through the instructions and - making sure that any non-jumpish instruction can't appear - after a jumpish instruction. - - There are gotchas however: - * CALLs are strictly speaking control flow but here we care - not about them. Hence we treat them as regular instructions. - - It's safe for them to appear inside a basic block - as (ignoring side effects inside the call) they will result in - straight line code. - - * NEWBLOCK marks the start of a new basic block so can - be followed by any instructions. --} - --- Verifying basic blocks is cheap, but not cheap enough to enable it unconditionally. -verifyBasicBlock :: Platform -> [Instr] -> () -verifyBasicBlock platform instrs - | debugIsOn = go False instrs - | otherwise = () - where - go _ [] = () - go atEnd (i:instr) - = case i of - -- Start a new basic block - NEWBLOCK {} -> go False instr - -- Calls are not viable block terminators - CALL {} | atEnd -> faultyBlockWith i - | not atEnd -> go atEnd instr - -- All instructions ok, check if we reached the end and continue. - _ | not atEnd -> go (isJumpishInstr i) instr - -- Only jumps allowed at the end of basic blocks. - | otherwise -> if isJumpishInstr i - then go True instr - else faultyBlockWith i - faultyBlockWith i - = pprPanic "Non control flow instructions after end of basic block." - (pprInstr platform i <+> text "in:" $$ vcat (map (pprInstr platform) instrs)) - -basicBlockCodeGen - :: CmmBlock - -> NatM ( [NatBasicBlock Instr] - , [NatCmmDecl (Alignment, RawCmmStatics) Instr]) - -basicBlockCodeGen block = do - let (_, nodes, tail) = blockSplit block - id = entryLabel block - stmts = blockToList nodes - -- Generate location directive - dbg <- getDebugBlock (entryLabel block) - loc_instrs <- case dblSourceTick =<< dbg of - Just (SourceNote span (LexicalFastString name)) - -> do fileId <- getFileId (srcSpanFile span) - let line = srcSpanStartLine span; col = srcSpanStartCol span - return $ unitOL $ LOCATION fileId line col (unpackFS name) - _ -> return nilOL - (mid_instrs,mid_bid) <- stmtsToInstrs id stmts - (!tail_instrs,_) <- stmtToInstrs mid_bid tail - let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs - platform <- getPlatform - return $! verifyBasicBlock platform (fromOL instrs) - instrs' <- fold <$> traverse addSpUnwindings instrs - -- code generation may introduce new basic block boundaries, which - -- are indicated by the NEWBLOCK instruction. We must split up the - -- instruction stream into basic blocks again. Also, we extract - -- LDATAs here too. - let - (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs' - - mkBlocks (NEWBLOCK id) (instrs,blocks,statics) - = ([], BasicBlock id instrs : blocks, statics) - mkBlocks (LDATA sec dat) (instrs,blocks,statics) - = (instrs, blocks, CmmData sec dat:statics) - mkBlocks instr (instrs,blocks,statics) - = (instr:instrs, blocks, statics) - return (BasicBlock id top : other_blocks, statics) - --- | Convert 'DELTA' instructions into 'UNWIND' instructions to capture changes --- in the @sp@ register. See Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock" --- for details. -addSpUnwindings :: Instr -> NatM (OrdList Instr) -addSpUnwindings instr@(DELTA d) = do - config <- getConfig - let platform = ncgPlatform config - if ncgDwarfUnwindings config - then do lbl <- mkAsmTempLabel <$> getUniqueM - let unwind = Map.singleton MachSp (Just $ UwReg (GlobalRegUse MachSp (bWord platform)) $ negate d) - return $ toOL [ instr, UNWIND lbl unwind ] - else return (unitOL instr) -addSpUnwindings instr = return $ unitOL instr - -{- Note [Keeping track of the current block] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When generating instructions for Cmm we sometimes require -the current block for things like retry loops. - -We also sometimes change the current block, if a MachOP -results in branching control flow. - -Issues arise if we have two statements in the same block, -which both depend on the current block id *and* change the -basic block after them. This happens for atomic primops -in the X86 backend where we want to update the CFG data structure -when introducing new basic blocks. - -For example in #17334 we got this Cmm code: - - c3Bf: // global - (_s3t1::I64) = call MO_AtomicRMW W64 AMO_And(_s3sQ::P64 + 88, 18); - (_s3t4::I64) = call MO_AtomicRMW W64 AMO_Or(_s3sQ::P64 + 88, 0); - _s3sT::I64 = _s3sV::I64; - goto c3B1; - -This resulted in two new basic blocks being inserted: - - c3Bf: - movl $18,%vI_n3Bo - movq 88(%vI_s3sQ),%rax - jmp _n3Bp - n3Bp: - ... - cmpxchgq %vI_n3Bq,88(%vI_s3sQ) - jne _n3Bp - ... - jmp _n3Bs - n3Bs: - ... - cmpxchgq %vI_n3Bt,88(%vI_s3sQ) - jne _n3Bs - ... - jmp _c3B1 - ... - -Based on the Cmm we called stmtToInstrs we translated both atomic operations under -the assumption they would be placed into their Cmm basic block `c3Bf`. -However for the retry loop we introduce new labels, so this is not the case -for the second statement. -This resulted in a desync between the explicit control flow graph -we construct as a separate data type and the actual control flow graph in the code. - -Instead we now return the new basic block if a statement causes a change -in the current block and use the block for all following statements. - -For this reason genForeignCall is also split into two parts. One for calls which -*won't* change the basic blocks in which successive instructions will be -placed (since they only evaluate CmmExpr, which can only contain MachOps, which -cannot introduce basic blocks in their lowerings). A different one for calls -which *are* known to change the basic block. - --} - --- See Note [Keeping track of the current block] for why --- we pass the BlockId. -stmtsToInstrs :: BlockId -- ^ Basic block these statement will start to be placed in. - -> [CmmNode O O] -- ^ Cmm Statement - -> NatM (InstrBlock, BlockId) -- ^ Resulting instruction -stmtsToInstrs bid stmts = - go bid stmts nilOL - where - go bid [] instrs = return (instrs,bid) - go bid (s:stmts) instrs = do - (instrs',bid') <- stmtToInstrs bid s - -- If the statement introduced a new block, we use that one - let !newBid = fromMaybe bid bid' - go newBid stmts (instrs `appOL` instrs') - --- | `bid` refers to the current block and is used to update the CFG --- if new blocks are inserted in the control flow. --- See Note [Keeping track of the current block] for more details. -stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed in. - -> CmmNode e x - -> NatM (InstrBlock, Maybe BlockId) - -- ^ Instructions, and bid of new block if successive - -- statements are placed in a different basic block. -stmtToInstrs bid stmt = do - is32Bit <- is32BitPlatform - platform <- getPlatform - case stmt of - CmmUnsafeForeignCall target result_regs args - -> genForeignCall target result_regs args bid - - _ -> (,Nothing) <$> case stmt of - CmmComment s -> return (unitOL (COMMENT s)) - CmmTick {} -> return nilOL - - CmmUnwind regs -> do - let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable - to_unwind_entry (reg, expr) = Map.singleton reg (fmap (toUnwindExpr platform) expr) - case foldMap to_unwind_entry regs of - tbl | Map.null tbl -> return nilOL - | otherwise -> do - lbl <- mkAsmTempLabel <$> getUniqueM - return $ unitOL $ UNWIND lbl tbl - - CmmAssign reg src - | isFloatType ty -> assignReg_FltCode reg src - | is32Bit && isWord64 ty -> assignReg_I64Code reg src - | isVecType ty -> assignReg_VecCode reg src - | otherwise -> assignReg_IntCode reg src - where ty = cmmRegType reg - - CmmStore addr src _alignment - | isFloatType ty -> assignMem_FltCode format addr src - | is32Bit && isWord64 ty -> assignMem_I64Code addr src - | isVecType ty -> assignMem_VecCode format addr src - | otherwise -> assignMem_IntCode format addr src - where ty = cmmExprType platform src - format = cmmTypeFormat ty - - CmmBranch id -> return $ genBranch id - - --We try to arrange blocks such that the likely branch is the fallthrough - --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here. - CmmCondBranch arg true false _ -> genCondBranch bid true false arg - CmmSwitch arg ids -> genSwitch arg ids - CmmCall { cml_target = arg - , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs) - _ -> - panic "stmtToInstrs: statement should have been cps'd away" - - -jumpRegs :: Platform -> [GlobalRegUse] -> [RegWithFormat] -jumpRegs platform gregs = - [ RegWithFormat (RegReal r) (cmmTypeFormat ty) - | GlobalRegUse gr ty <- gregs - , Just r <- [globalRegMaybe platform gr] ] - --------------------------------------------------------------------------------- --- | 'InstrBlock's are the insn sequences generated by the insn selectors. --- They are really trees of insns to facilitate fast appending, where a --- left-to-right traversal yields the insns in the correct order. --- -type InstrBlock - = OrdList Instr - - --- | Condition codes passed up the tree. --- -data CondCode - = CondCode Bool Cond InstrBlock - - --- | Register's passed up the tree. If the stix code forces the register --- to live in a pre-decided machine register, it comes out as @Fixed@; --- otherwise, it comes out as @Any@, and the parent can decide which --- register to put it in. --- -data Register - = Fixed Format Reg InstrBlock - | Any Format (Reg -> InstrBlock) - - -swizzleRegisterRep :: Register -> Format -> Register -swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code -swizzleRegisterRep (Any _ codefn) format = Any format codefn - -getLocalRegReg :: LocalReg -> Reg -getLocalRegReg (LocalReg u ty) - = -- by assuming SSE2, Int, Word, Float, Double and vectors all can be register allocated - RegVirtual (mkVirtualReg u (cmmTypeFormat ty)) - --- | Grab the Reg for a CmmReg -getRegisterReg :: Platform -> CmmReg -> Reg - -getRegisterReg _ (CmmLocal lreg) = getLocalRegReg lreg - -getRegisterReg platform (CmmGlobal mid) - = case globalRegMaybe platform $ globalRegUse_reg mid of - Just reg -> RegReal $ reg - Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid) - -- By this stage, the only MagicIds remaining should be the - -- ones which map to a real machine register on this - -- platform. Hence ... - --- | Memory addressing modes passed up the tree. -data Amode - = Amode AddrMode InstrBlock - -{- -Now, given a tree (the argument to a CmmLoad) that references memory, -produce a suitable addressing mode. - -A Rule of the Game (tm) for Amodes: use of the addr bit must -immediately follow use of the code part, since the code part puts -values in registers which the addr then refers to. So you can't put -anything in between, lest it overwrite some of those registers. If -you need to do some other computation between the code part and use of -the addr bit, first store the effective address from the amode in a -temporary, then do the other computation, and then use the temporary: - - code - LEA amode, tmp - ... other computation ... - ... (tmp) ... --} - -{- -Note [%rip-relative addressing on x86-64] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -On x86-64 GHC produces code for use in the "small" or, when `-fPIC` is set, -"small PIC" code models defined by the x86-64 System V ABI (section 3.5.1 of -specification version 0.99). - -In general the small code model would allow us to assume that code is located -between 0 and 2^31 - 1. However, this is not true on Windows which, due to -high-entropy ASLR, may place the executable image anywhere in 64-bit address -space. This is problematic since immediate operands in x86-64 are generally -32-bit sign-extended values (with the exception of the 64-bit MOVABS encoding). -Consequently, to avoid overflowing we use %rip-relative addressing universally. -Since %rip-relative addressing comes essentially for free and makes linking far -easier, we use it even on non-Windows platforms. - -See also: the documentation for GCC's `-mcmodel=small` flag. --} - - --- | Check whether an integer will fit in 32 bits. --- A CmmInt is intended to be truncated to the appropriate --- number of bits, so here we truncate it to Int64. This is --- important because e.g. -1 as a CmmInt might be either --- -1 or 18446744073709551615. --- -is32BitInteger :: Integer -> Bool -is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 - where i64 = fromIntegral i :: Int64 - - --- | Convert a BlockId to some CmmStatic data -jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic -jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config)) -jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) - where blockLabel = blockLbl blockid - - --- ----------------------------------------------------------------------------- --- General things for putting together code sequences - --- Expand CmmRegOff. ToDo: should we do it this way around, or convert --- CmmExprs into CmmRegOff? -mangleIndexTree :: CmmReg -> Int -> CmmExpr -mangleIndexTree reg off - = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType reg) - --- | The dual to getAnyReg: compute an expression into a register, but --- we don't mind which one it is. -getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock) -getSomeReg expr = do - r <- getRegister expr - case r of - Any rep code -> do - tmp <- getNewRegNat rep - return (tmp, code tmp) - Fixed _ reg code -> - return (reg, code) - -assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock -assignMem_I64Code addrTree valueTree = do - Amode addr addr_code <- getAmode addrTree - RegCode64 vcode rhi rlo <- iselExpr64 valueTree - let - -- Little-endian store - mov_lo = MOV II32 (OpReg rlo) (OpAddr addr) - mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4))) - return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) - - -assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock -assignReg_I64Code (CmmLocal dst) valueTree = do - RegCode64 vcode r_src_hi r_src_lo <- iselExpr64 valueTree - let - Reg64 r_dst_hi r_dst_lo = localReg64 dst - mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo) - mov_hi = MOV II32 (OpReg r_src_hi) (OpReg r_dst_hi) - return ( - vcode `snocOL` mov_lo `snocOL` mov_hi - ) - -assignReg_I64Code _ _ - = panic "assignReg_I64Code(i386): invalid lvalue" - -iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock) -iselExpr64 (CmmLit (CmmInt i _)) = do - Reg64 rhi rlo <- getNewReg64 - let - r = fromIntegral (fromIntegral i :: Word32) - q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32) - code = toOL [ - MOV II32 (OpImm (ImmInteger r)) (OpReg rlo), - MOV II32 (OpImm (ImmInteger q)) (OpReg rhi) - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmLoad addrTree ty _) | isWord64 ty = do - Amode addr addr_code <- getAmode addrTree - Reg64 rhi rlo <- getNewReg64 - let - mov_lo = MOV II32 (OpAddr addr) (OpReg rlo) - mov_hi = MOV II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi) - return ( - RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rhi rlo - ) - -iselExpr64 (CmmReg (CmmLocal local_reg)) = do - let Reg64 hi lo = localReg64 local_reg - return (RegCode64 nilOL hi lo) - -iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - Reg64 rhi rlo <- getNewReg64 - let - r = fromIntegral (fromIntegral i :: Word32) - q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32) - code = code1 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - ADD II32 (OpImm (ImmInteger r)) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - ADC II32 (OpImm (ImmInteger q)) (OpReg rhi) ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - ADD II32 (OpReg r2lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - ADC II32 (OpReg r2hi) (OpReg rhi) ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - SUB II32 (OpReg r2lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - SBB II32 (OpReg r2hi) (OpReg rhi) ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do - code <- getAnyReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code r_dst_lo `snocOL` - XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi)) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_UU_Conv W16 W64) [expr]) = do - (rsrc, code) <- getByteReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code `appOL` toOL [ - MOVZxL II16 (OpReg rsrc) (OpReg r_dst_lo), - XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) - ]) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_UU_Conv W8 W64) [expr]) = do - (rsrc, code) <- getByteReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code `appOL` toOL [ - MOVZxL II8 (OpReg rsrc) (OpReg r_dst_lo), - XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) - ]) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do - code <- getAnyReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code r_dst_lo `snocOL` - MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` - CLTD II32 `snocOL` - MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` - MOV II32 (OpReg edx) (OpReg r_dst_hi)) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do - (r, code) <- getByteReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code `appOL` toOL [ - MOVSxL II16 (OpReg r) (OpReg eax), - CLTD II32, - MOV II32 (OpReg eax) (OpReg r_dst_lo), - MOV II32 (OpReg edx) (OpReg r_dst_hi)]) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do - (r, code) <- getByteReg expr - Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code `appOL` toOL [ - MOVSxL II8 (OpReg r) (OpReg eax), - CLTD II32, - MOV II32 (OpReg eax) (OpReg r_dst_lo), - MOV II32 (OpReg edx) (OpReg r_dst_hi)]) - r_dst_hi - r_dst_lo - -iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do - RegCode64 code rhi rlo <- iselExpr64 expr - Reg64 rohi rolo <- getNewReg64 - let - ocode = code `appOL` - toOL [ MOV II32 (OpReg rlo) (OpReg rolo), - XOR II32 (OpReg rohi) (OpReg rohi), - NEGI II32 (OpReg rolo), - SBB II32 (OpReg rhi) (OpReg rohi) ] - return (RegCode64 ocode rohi rolo) - --- To multiply two 64-bit numbers we use the following decomposition (in C notation): --- --- ((r1hi << 32) + r1lo) * ((r2hi << 32) + r2lo) --- = ((r2lo * r1hi) << 32) --- + ((r1lo * r2hi) << 32) --- + r1lo * r2lo --- --- Note that @(r1hi * r2hi) << 64@ can be dropped because it overflows completely. - -iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - tmp <- getNewRegNat II32 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg eax), - MOV II32 (OpReg r2lo) (OpReg tmp), - MOV II32 (OpReg r1hi) (OpReg rhi), - IMUL II32 (OpReg tmp) (OpReg rhi), - MOV II32 (OpReg r2hi) (OpReg rlo), - IMUL II32 (OpReg eax) (OpReg rlo), - ADD II32 (OpReg rlo) (OpReg rhi), - MUL2 II32 (OpReg tmp), - ADD II32 (OpReg edx) (OpReg rhi), - MOV II32 (OpReg eax) (OpReg rlo) - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_S_MulMayOflo W64) _) = do - -- Performance sensitive users won't use 32 bit so let's keep it simple: - -- We always return a (usually false) positive. - Reg64 rhi rlo <- getNewReg64 - let code = toOL [ - MOV II32 (OpImm (ImmInt 1)) (OpReg rhi), - MOV II32 (OpImm (ImmInt 1)) (OpReg rlo) - ] - return (RegCode64 code rhi rlo) - - --- To shift a 64-bit number to the left we use the SHLD and SHL instructions. --- We use SHLD to shift the bits in @rhi@ to the left while copying --- high bits from @rlo@ to fill the new space in the low bits of @rhi@. --- That leaves @rlo@ unchanged, so we use SHL to shift the bits of @rlo@ left. --- However, both these instructions only use the lowest 5 bits from %cl to do --- their shifting. So if the sixth bit (0x32) is set then we additionally move --- the contents of @rlo@ to @rhi@ and clear @rlo@. - -iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - code2 <- getAnyReg e2 - Reg64 rhi rlo <- getNewReg64 - lbl1 <- newBlockId - lbl2 <- newBlockId - let - code = code1 `appOL` - code2 ecx `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), - SHL II32 (OpReg ecx) (OpReg rlo), - TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ lbl2, - JXX ALWAYS lbl1, - NEWBLOCK lbl1, - MOV II32 (OpReg rlo) (OpReg rhi), - XOR II32 (OpReg rlo) (OpReg rlo), - JXX ALWAYS lbl2, - NEWBLOCK lbl2 - ] - return (RegCode64 code rhi rlo) - --- Similar to above, however now we're shifting to the right --- and we're doing a signed shift which means that @rhi@ needs --- to be set to either 0 if @rhi@ is positive or 0xffffffff otherwise, --- and if the sixth bit of %cl is set (so the shift amount is more than 32). --- To accomplish that we shift @rhi@ by 31. - -iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - (r2, code2) <- getSomeReg e2 - Reg64 rhi rlo <- getNewReg64 - lbl1 <- newBlockId - lbl2 <- newBlockId - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - MOV II32 (OpReg r2) (OpReg ecx), - SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), - SAR II32 (OpReg ecx) (OpReg rhi), - TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ lbl2, - JXX ALWAYS lbl1, - NEWBLOCK lbl1, - MOV II32 (OpReg rhi) (OpReg rlo), - SAR II32 (OpImm (ImmInt 31)) (OpReg rhi), - JXX ALWAYS lbl2, - NEWBLOCK lbl2 - ] - return (RegCode64 code rhi rlo) - --- Similar to the above. - -iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - (r2, code2) <- getSomeReg e2 - Reg64 rhi rlo <- getNewReg64 - lbl1 <- newBlockId - lbl2 <- newBlockId - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - MOV II32 (OpReg r2) (OpReg ecx), - SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), - SHR II32 (OpReg ecx) (OpReg rhi), - TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ lbl2, - JXX ALWAYS lbl1, - NEWBLOCK lbl1, - MOV II32 (OpReg rhi) (OpReg rlo), - XOR II32 (OpReg rhi) (OpReg rhi), - JXX ALWAYS lbl2, - NEWBLOCK lbl2 - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_And _) [e1,e2]) = iselExpr64ParallelBin AND e1 e2 -iselExpr64 (CmmMachOp (MO_Or _) [e1,e2]) = iselExpr64ParallelBin OR e1 e2 -iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = iselExpr64ParallelBin XOR e1 e2 - -iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - NOT II32 (OpReg rlo), - NOT II32 (OpReg rhi) - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmRegOff r i) = iselExpr64 (mangleIndexTree r i) - -iselExpr64 expr - = do - platform <- getPlatform - pprPanic "iselExpr64(i386)" (pdoc platform expr $+$ text (show expr)) - -iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr) - -> CmmExpr -> CmmExpr -> NatM (RegCode64 (OrdList Instr)) -iselExpr64ParallelBin op e1 e2 = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - op II32 (OpReg r2lo) (OpReg rlo), - op II32 (OpReg r2hi) (OpReg rhi) - ] - return (RegCode64 code rhi rlo) - --------------------------------------------------------------------------------- - --- This is a helper data type which helps reduce the code duplication for --- the code generation of arithmetic operations. This is not specifically --- targetted for any particular type like Int8, Int32 etc -data VectorArithInstns = VA_Add | VA_Sub | VA_Mul | VA_Div | VA_Min | VA_Max - -getRegister :: HasDebugCallStack => CmmExpr -> NatM Register -getRegister e = do platform <- getPlatform - is32Bit <- is32BitPlatform - getRegister' platform is32Bit e - -getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register - -getRegister' platform is32Bit (CmmReg reg) - = case reg of - CmmGlobal (GlobalRegUse PicBaseReg _) - | is32Bit -> - -- on x86_64, we have %rip for PicBaseReg, but it's not - -- a full-featured register, it can only be used for - -- rip-relative addressing. - do reg' <- getPicBaseNat (archWordFormat is32Bit) - return (Fixed (archWordFormat is32Bit) reg' nilOL) - _ -> - let ty = cmmRegType reg - reg_fmt = cmmTypeFormat ty - in return $ Fixed reg_fmt (getRegisterReg platform reg) nilOL - -getRegister' platform is32Bit (CmmRegOff r n) - = getRegister' platform is32Bit $ mangleIndexTree r n - -getRegister' platform is32Bit (CmmMachOp (MO_RelaxedRead w) [e]) - = getRegister' platform is32Bit (CmmLoad e (cmmBits w) NaturallyAligned) - -getRegister' platform is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e]) - = addAlignmentCheck align <$> getRegister' platform is32Bit e - --- for 32-bit architectures, support some 64 -> 32 bit conversions: --- TO_W_(x), TO_W_(x >> 32) - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) - [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) - | is32Bit = do - RegCode64 code rhi _rlo <- iselExpr64 x - return $ Fixed II32 rhi code - -getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) - [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) - | is32Bit = do - RegCode64 code rhi _rlo <- iselExpr64 x - return $ Fixed II32 rhi code - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x]) - | is32Bit = do - RegCode64 code _rhi rlo <- iselExpr64 x - return $ Fixed II32 rlo code - -getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x]) - | is32Bit = do - RegCode64 code _rhi rlo <- iselExpr64 x - return $ Fixed II32 rlo code - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W8) [x]) - | is32Bit = do - RegCode64 code _rhi rlo <- iselExpr64 x - ro <- getNewRegNat II8 - return $ Fixed II8 ro (code `appOL` toOL [ MOVZxL II8 (OpReg rlo) (OpReg ro) ]) - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W16) [x]) - | is32Bit = do - RegCode64 code _rhi rlo <- iselExpr64 x - ro <- getNewRegNat II16 - return $ Fixed II16 ro (code `appOL` toOL [ MOVZxL II16 (OpReg rlo) (OpReg ro) ]) - --- catch simple cases of zero- or sign-extended load -getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad addr _ _]) = do - code <- intLoadCode (MOVZxL II8) addr - return (Any II32 code) - -getRegister' _ _ (CmmMachOp (MO_SS_Conv W8 W32) [CmmLoad addr _ _]) = do - code <- intLoadCode (MOVSxL II8) addr - return (Any II32 code) - -getRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad addr _ _]) = do - code <- intLoadCode (MOVZxL II16) addr - return (Any II32 code) - -getRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad addr _ _]) = do - code <- intLoadCode (MOVSxL II16) addr - return (Any II32 code) - --- catch simple cases of zero- or sign-extended load -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOVZxL II8) addr - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W8 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOVSxL II8) addr - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOVZxL II16) addr - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOVSxL II16) addr - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOV II32) addr -- 32-bit loads zero-extend - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _ _]) - | not is32Bit = do - code <- intLoadCode (MOVSxL II32) addr - return (Any II64 code) - -getRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)), - CmmLit displacement]) - | not is32Bit = - return $ Any II64 (\dst -> unitOL $ - LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst)) - -getRegister' _ _ (CmmMachOp mop []) = - pprPanic "getRegister(x86): nullary MachOp" (text $ show mop) - -getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps - avx <- avxEnabled - case mop of - MO_F_Neg w -> sse2NegCode w x - - - MO_S_Neg w -> triv_ucode NEGI (intFormat w) - MO_Not w -> triv_ucode NOT (intFormat w) - - -- Nop conversions - MO_UU_Conv W32 W8 -> toI8Reg W32 x - MO_SS_Conv W32 W8 -> toI8Reg W32 x - MO_XX_Conv W32 W8 -> toI8Reg W32 x - MO_UU_Conv W16 W8 -> toI8Reg W16 x - MO_SS_Conv W16 W8 -> toI8Reg W16 x - MO_XX_Conv W16 W8 -> toI8Reg W16 x - MO_UU_Conv W32 W16 -> toI16Reg W32 x - MO_SS_Conv W32 W16 -> toI16Reg W32 x - MO_XX_Conv W32 W16 -> toI16Reg W32 x - - MO_UU_Conv W64 W32 | not is32Bit -> conversionNop II64 x - MO_SS_Conv W64 W32 | not is32Bit -> conversionNop II64 x - MO_XX_Conv W64 W32 | not is32Bit -> conversionNop II64 x - MO_UU_Conv W64 W16 | not is32Bit -> toI16Reg W64 x - MO_SS_Conv W64 W16 | not is32Bit -> toI16Reg W64 x - MO_XX_Conv W64 W16 | not is32Bit -> toI16Reg W64 x - MO_UU_Conv W64 W8 | not is32Bit -> toI8Reg W64 x - MO_SS_Conv W64 W8 | not is32Bit -> toI8Reg W64 x - MO_XX_Conv W64 W8 | not is32Bit -> toI8Reg W64 x - - MO_UU_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x - MO_SS_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x - MO_XX_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x - - MO_FW_Bitcast W32 -> bitcast FF32 II32 x - MO_WF_Bitcast W32 -> bitcast II32 FF32 x - MO_FW_Bitcast W64 -> bitcast FF64 II64 x - MO_WF_Bitcast W64 -> bitcast II64 FF64 x - MO_WF_Bitcast {} -> incorrectOperands - MO_FW_Bitcast {} -> incorrectOperands - - -- widenings - MO_UU_Conv W8 W32 -> integerExtend W8 W32 MOVZxL x - MO_UU_Conv W16 W32 -> integerExtend W16 W32 MOVZxL x - MO_UU_Conv W8 W16 -> integerExtend W8 W16 MOVZxL x - - MO_SS_Conv W8 W32 -> integerExtend W8 W32 MOVSxL x - MO_SS_Conv W16 W32 -> integerExtend W16 W32 MOVSxL x - MO_SS_Conv W8 W16 -> integerExtend W8 W16 MOVSxL x - - -- We don't care about the upper bits for MO_XX_Conv, so MOV is enough. However, on 32-bit we - -- have 8-bit registers only for a few registers (as opposed to x86-64 where every register - -- has 8-bit version). So for 32-bit code, we'll just zero-extend. - MO_XX_Conv W8 W32 - | is32Bit -> integerExtend W8 W32 MOVZxL x - | otherwise -> integerExtend W8 W32 MOV x - MO_XX_Conv W8 W16 - | is32Bit -> integerExtend W8 W16 MOVZxL x - | otherwise -> integerExtend W8 W16 MOV x - MO_XX_Conv W16 W32 -> integerExtend W16 W32 MOV x - - MO_UU_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOVZxL x - MO_UU_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVZxL x - MO_UU_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVZxL x - MO_SS_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOVSxL x - MO_SS_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVSxL x - MO_SS_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVSxL x - -- For 32-to-64 bit zero extension, amd64 uses an ordinary movl. - -- However, we don't want the register allocator to throw it - -- away as an unnecessary reg-to-reg move, so we keep it in - -- the form of a movzl and print it as a movl later. - -- This doesn't apply to MO_XX_Conv since in this case we don't care about - -- the upper bits. So we can just use MOV. - MO_XX_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOV x - MO_XX_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOV x - MO_XX_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOV x - - MO_FF_Conv W32 W64 -> coerceFP2FP W64 x - MO_FF_Conv W64 W32 -> coerceFP2FP W32 x - - MO_FF_Conv from to -> invalidConversion from to - MO_UU_Conv from to -> invalidConversion from to - MO_SS_Conv from to -> invalidConversion from to - MO_XX_Conv from to -> invalidConversion from to - - MO_FS_Truncate from to -> coerceFP2Int from to x - MO_SF_Round from to -> coerceInt2FP from to x - - MO_VF_Neg l w | avx -> vector_float_negate_avx l w x - | otherwise -> vector_float_negate_sse l w x - -- SIMD NCG TODO: add integer negation - MO_VS_Neg {} -> needLlvm mop - - MO_VF_Broadcast l w - | avx - -> vector_float_broadcast_avx l w x - | otherwise - -> vector_float_broadcast_sse l w x - MO_V_Broadcast l w - -> vector_int_broadcast l w x - - -- Binary MachOps - MO_Add {} -> incorrectOperands - MO_Sub {} -> incorrectOperands - MO_Eq {} -> incorrectOperands - MO_Ne {} -> incorrectOperands - MO_Mul {} -> incorrectOperands - MO_S_MulMayOflo {} -> incorrectOperands - MO_S_Quot {} -> incorrectOperands - MO_S_Rem {} -> incorrectOperands - MO_U_Quot {} -> incorrectOperands - MO_U_Rem {} -> incorrectOperands - MO_S_Ge {} -> incorrectOperands - MO_S_Le {} -> incorrectOperands - MO_S_Gt {} -> incorrectOperands - MO_S_Lt {} -> incorrectOperands - MO_U_Ge {} -> incorrectOperands - MO_U_Le {} -> incorrectOperands - MO_U_Gt {} -> incorrectOperands - MO_U_Lt {} -> incorrectOperands - MO_F_Add {} -> incorrectOperands - MO_F_Sub {} -> incorrectOperands - MO_F_Mul {} -> incorrectOperands - MO_F_Quot {} -> incorrectOperands - MO_F_Eq {} -> incorrectOperands - MO_F_Ne {} -> incorrectOperands - MO_F_Ge {} -> incorrectOperands - MO_F_Le {} -> incorrectOperands - MO_F_Gt {} -> incorrectOperands - MO_F_Lt {} -> incorrectOperands - MO_F_Min {} -> incorrectOperands - MO_F_Max {} -> incorrectOperands - MO_And {} -> incorrectOperands - MO_Or {} -> incorrectOperands - MO_Xor {} -> incorrectOperands - MO_Shl {} -> incorrectOperands - MO_U_Shr {} -> incorrectOperands - MO_S_Shr {} -> incorrectOperands - - MO_V_Extract {} -> incorrectOperands - MO_V_Add {} -> incorrectOperands - MO_V_Sub {} -> incorrectOperands - MO_V_Mul {} -> incorrectOperands - MO_VS_Quot {} -> incorrectOperands - MO_VS_Rem {} -> incorrectOperands - MO_VU_Quot {} -> incorrectOperands - MO_VU_Rem {} -> incorrectOperands - MO_V_Shuffle {} -> incorrectOperands - MO_VF_Shuffle {} -> incorrectOperands - MO_VU_Min {} -> incorrectOperands - MO_VU_Max {} -> incorrectOperands - MO_VS_Min {} -> incorrectOperands - MO_VS_Max {} -> incorrectOperands - MO_VF_Min {} -> incorrectOperands - MO_VF_Max {} -> incorrectOperands - - MO_VF_Extract {} -> incorrectOperands - MO_VF_Add {} -> incorrectOperands - MO_VF_Sub {} -> incorrectOperands - MO_VF_Mul {} -> incorrectOperands - MO_VF_Quot {} -> incorrectOperands - - -- Ternary MachOps - MO_FMA {} -> incorrectOperands - MO_VF_Insert {} -> incorrectOperands - MO_V_Insert {} -> incorrectOperands - - --_other -> pprPanic "getRegister" (pprMachOp mop) - where - triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register - triv_ucode instr format = trivialUCode format (instr format) x - - -- signed or unsigned extension. - integerExtend :: Width -> Width - -> (Format -> Operand -> Operand -> Instr) - -> CmmExpr -> NatM Register - integerExtend from to instr expr = do - (reg,e_code) <- if from == W8 then getByteReg expr - else getSomeReg expr - let - code dst = - e_code `snocOL` - instr (intFormat from) (OpReg reg) (OpReg dst) - return (Any (intFormat to) code) - - bitcast :: Format -> Format -> CmmExpr -> NatM Register - bitcast fmt rfmt expr = - do (src, e_code) <- getSomeReg expr - let code = \dst -> e_code `snocOL` (MOVD fmt rfmt (OpReg src) (OpReg dst)) - return (Any rfmt code) - - toI8Reg :: Width -> CmmExpr -> NatM Register - toI8Reg new_rep expr - = do codefn <- getAnyReg expr - return (Any (intFormat new_rep) codefn) - -- HACK: use getAnyReg to get a byte-addressable register. - -- If the source was a Fixed register, this will add the - -- mov instruction to put it into the desired destination. - -- We're assuming that the destination won't be a fixed - -- non-byte-addressable register; it won't be, because all - -- fixed registers are word-sized. - - toI16Reg = toI8Reg -- for now - - conversionNop :: Format -> CmmExpr -> NatM Register - conversionNop new_format expr - = do e_code <- getRegister' platform is32Bit expr - return (swizzleRegisterRep e_code new_format) - - vector_float_negate_avx :: Length -> Width -> CmmExpr -> NatM Register - vector_float_negate_avx l w expr = do - let fmt :: Format - mask :: CmmLit - (fmt, mask) = case w of - W32 -> (VecFormat l FmtFloat , CmmInt (bit 31) w) -- TODO: these should be negative 0 floating point literals, - W64 -> (VecFormat l FmtDouble, CmmInt (bit 63) w) -- but we don't currently have those in Cmm. - _ -> panic "AVX floating-point negation: elements must be FF32 or FF64" - (maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l mask) - (reg, exp) <- getSomeReg expr - let code dst = maskCode `appOL` - exp `snocOL` - (VMOVU fmt (OpReg reg) (OpReg dst)) `snocOL` - (VXOR fmt (OpReg maskReg) dst dst) - return (Any fmt code) - - vector_float_negate_sse :: Length -> Width -> CmmExpr -> NatM Register - vector_float_negate_sse l w expr = do - let fmt :: Format - mask :: CmmLit - (fmt, mask) = case w of - W32 -> (VecFormat l FmtFloat , CmmInt (bit 31) w) -- Same comment as for vector_float_negate_avx, - W64 -> (VecFormat l FmtDouble, CmmInt (bit 63) w) -- these should be -0.0 CmmFloat values. - _ -> panic "SSE floating-point negation: elements must be FF32 or FF64" - (maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l mask) - (reg, exp) <- getSomeReg expr - let code dst = maskCode `appOL` - exp `snocOL` - (MOVU fmt (OpReg reg) (OpReg dst)) `snocOL` - (XOR fmt (OpReg maskReg) (OpReg dst)) - return (Any fmt code) - - ----------------------- - - -- TODO: we could use VBROADCASTSS/SD when AVX2 is available. - vector_float_broadcast_avx :: Length - -> Width - -> CmmExpr - -> NatM Register - vector_float_broadcast_avx len w expr = do - (dst, exp) <- getSomeReg expr - let fmt = VecFormat len (floatScalarFormat w) - code = VSHUF fmt (ImmInt 0) (OpReg dst) dst dst - return $ Fixed fmt dst (exp `snocOL` code) - - vector_float_broadcast_sse :: Length - -> Width - -> CmmExpr - -> NatM Register - vector_float_broadcast_sse len w expr = do - (dst, exp) <- getSomeReg expr - let fmt = VecFormat len (floatScalarFormat w) - code = SHUF fmt (ImmInt 0) (OpReg dst) dst - return $ Fixed fmt dst (exp `snocOL` code) - - vector_int_broadcast :: Length - -> Width - -> CmmExpr - -> NatM Register - vector_int_broadcast len W64 expr = do - (reg, exp) <- getNonClobberedReg expr - let fmt = VecFormat len FmtInt64 - return $ Any fmt (\dst -> exp `snocOL` - (MOVD II64 fmt (OpReg reg) (OpReg dst)) `snocOL` - (PUNPCKLQDQ fmt (OpReg dst) dst) - ) - vector_int_broadcast len W32 expr = do - (reg, exp) <- getNonClobberedReg expr - let fmt = VecFormat len FmtInt32 - return $ Any fmt (\dst -> exp `snocOL` - (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL` - (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst) - ) - vector_int_broadcast _ _ _ = - sorry "Unsupported Integer vector broadcast operation; please use -fllvm." - - -getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps - avx <- avxEnabled - case mop of - MO_F_Eq _ -> condFltReg is32Bit EQQ x y - MO_F_Ne _ -> condFltReg is32Bit NE x y - MO_F_Gt _ -> condFltReg is32Bit GTT x y - MO_F_Ge _ -> condFltReg is32Bit GE x y - -- Invert comparison condition and swap operands - -- See Note [SSE Parity Checks] - MO_F_Lt _ -> condFltReg is32Bit GTT y x - MO_F_Le _ -> condFltReg is32Bit GE y x - - MO_Eq _ -> condIntReg EQQ x y - MO_Ne _ -> condIntReg NE x y - - MO_S_Gt _ -> condIntReg GTT x y - MO_S_Ge _ -> condIntReg GE x y - MO_S_Lt _ -> condIntReg LTT x y - MO_S_Le _ -> condIntReg LE x y - - MO_U_Gt _ -> condIntReg GU x y - MO_U_Ge _ -> condIntReg GEU x y - MO_U_Lt _ -> condIntReg LU x y - MO_U_Le _ -> condIntReg LEU x y - - MO_F_Add w -> trivialFCode_sse2 w ADD x y - MO_F_Sub w -> trivialFCode_sse2 w SUB x y - MO_F_Quot w -> trivialFCode_sse2 w FDIV x y - MO_F_Mul w -> trivialFCode_sse2 w MUL x y - MO_F_Min w -> trivialFCode_sse2 w (MINMAX Min FloatMinMax) x y - MO_F_Max w -> trivialFCode_sse2 w (MINMAX Max FloatMinMax) x y - - MO_Add rep -> add_code rep x y - MO_Sub rep -> sub_code rep x y - - MO_S_Quot rep -> div_code rep True True x y - MO_S_Rem rep -> div_code rep True False x y - MO_U_Quot rep -> div_code rep False True x y - MO_U_Rem rep -> div_code rep False False x y - - MO_S_MulMayOflo rep -> imulMayOflo rep x y - - MO_Mul W8 -> imulW8 x y - MO_Mul rep -> triv_op rep IMUL - MO_And rep -> triv_op rep AND - MO_Or rep -> triv_op rep OR - MO_Xor rep -> triv_op rep XOR - - {- Shift ops on x86s have constraints on their source, it - either has to be Imm, CL or 1 - => trivialCode is not restrictive enough (sigh.) - -} - MO_Shl rep -> shift_code rep SHL x y {-False-} - MO_U_Shr rep -> shift_code rep SHR x y {-False-} - MO_S_Shr rep -> shift_code rep SAR x y {-False-} - - MO_VF_Shuffle l w is - | l * widthInBits w == 128 - -> if - | avx - -> vector_shuffle_float l w x y is - | otherwise - -> sorry "Please enable the -mavx flag" - | otherwise - -> sorry "Please use -fllvm for wide shuffle instructions" - - MO_VF_Extract l W32 | avx -> vector_float_extract l W32 x y - | otherwise -> vector_float_extract_sse l W32 x y - MO_VF_Extract l W64 -> vector_float_extract l W64 x y - MO_VF_Extract {} -> incorrectOperands - - MO_V_Extract l W64 -> vector_int_extract_sse l W64 x y - -- SIMD NCG TODO: W32, W16, W8 - MO_V_Extract {} -> needLlvm mop - - MO_VF_Add l w | avx -> vector_float_op_avx VA_Add l w x y - | otherwise -> vector_float_op_sse VA_Add l w x y - - MO_VF_Sub l w | avx -> vector_float_op_avx VA_Sub l w x y - | otherwise -> vector_float_op_sse VA_Sub l w x y - - MO_VF_Mul l w | avx -> vector_float_op_avx VA_Mul l w x y - | otherwise -> vector_float_op_sse VA_Mul l w x y - - MO_VF_Quot l w | avx -> vector_float_op_avx VA_Div l w x y - | otherwise -> vector_float_op_sse VA_Div l w x y - - MO_VF_Min l w | avx -> vector_float_op_avx VA_Min l w x y - | otherwise -> vector_float_op_sse VA_Min l w x y - - MO_VF_Max l w | avx -> vector_float_op_avx VA_Max l w x y - | otherwise -> vector_float_op_sse VA_Max l w x y - - -- SIMD NCG TODO: integer vector operations - MO_V_Shuffle {} -> needLlvm mop - MO_V_Add {} -> needLlvm mop - MO_V_Sub {} -> needLlvm mop - MO_V_Mul {} -> needLlvm mop - MO_VS_Quot {} -> needLlvm mop - MO_VS_Rem {} -> needLlvm mop - MO_VU_Quot {} -> needLlvm mop - MO_VU_Rem {} -> needLlvm mop - - MO_VU_Min {} -> needLlvm mop - MO_VU_Max {} -> needLlvm mop - MO_VS_Min {} -> needLlvm mop - MO_VS_Max {} -> needLlvm mop - - -- Unary MachOps - MO_S_Neg {} -> incorrectOperands - MO_F_Neg {} -> incorrectOperands - MO_Not {} -> incorrectOperands - MO_SF_Round {} -> incorrectOperands - MO_FS_Truncate {} -> incorrectOperands - MO_SS_Conv {} -> incorrectOperands - MO_XX_Conv {} -> incorrectOperands - MO_FF_Conv {} -> incorrectOperands - MO_UU_Conv {} -> incorrectOperands - MO_WF_Bitcast {} -> incorrectOperands - MO_FW_Bitcast {} -> incorrectOperands - MO_RelaxedRead {} -> incorrectOperands - MO_AlignmentCheck {} -> incorrectOperands - MO_VS_Neg {} -> incorrectOperands - MO_VF_Neg {} -> incorrectOperands - MO_V_Broadcast {} -> incorrectOperands - MO_VF_Broadcast {} -> incorrectOperands - - -- Ternary MachOps - MO_FMA {} -> incorrectOperands - MO_V_Insert {} -> incorrectOperands - MO_VF_Insert {} -> incorrectOperands - - where - -------------------- - triv_op width instr = trivialCode width op (Just op) x y - where op = instr (intFormat width) - - -- Special case for IMUL for bytes, since the result of IMULB will be in - -- %ax, the split to %dx/%edx/%rdx and %ax/%eax/%rax happens only for wider - -- values. - imulW8 :: CmmExpr -> CmmExpr -> NatM Register - imulW8 arg_a arg_b = do - (a_reg, a_code) <- getNonClobberedReg arg_a - b_code <- getAnyReg arg_b - - let code = a_code `appOL` b_code eax `appOL` - toOL [ IMUL2 format (OpReg a_reg) ] - format = intFormat W8 - - return (Fixed format eax code) - - imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register - imulMayOflo W8 a b = do - -- The general case (W16, W32, W64) doesn't work for W8 as its - -- multiplication doesn't use two registers. - -- - -- The plan is: - -- 1. truncate and sign-extend a and b to 8bit width - -- 2. multiply a' = a * b in 32bit width - -- 3. copy and sign-extend 8bit from a' to c - -- 4. compare a' and c: they are equal if there was no overflow - (a_reg, a_code) <- getNonClobberedReg a - (b_reg, b_code) <- getNonClobberedReg b - let - code = a_code `appOL` b_code `appOL` - toOL [ - MOVSxL II8 (OpReg a_reg) (OpReg a_reg), - MOVSxL II8 (OpReg b_reg) (OpReg b_reg), - IMUL II32 (OpReg b_reg) (OpReg a_reg), - MOVSxL II8 (OpReg a_reg) (OpReg eax), - CMP II16 (OpReg a_reg) (OpReg eax), - SETCC NE (OpReg eax) - ] - return (Fixed II8 eax code) - imulMayOflo rep a b = do - (a_reg, a_code) <- getNonClobberedReg a - b_code <- getAnyReg b - let - shift_amt = case rep of - W16 -> 15 - W32 -> 31 - W64 -> 63 - w -> panic ("shift_amt: " ++ show w) - - format = intFormat rep - code = a_code `appOL` b_code eax `appOL` - toOL [ - IMUL2 format (OpReg a_reg), -- result in %edx:%eax - SAR format (OpImm (ImmInt shift_amt)) (OpReg eax), - -- sign extend lower part - SUB format (OpReg edx) (OpReg eax) - -- compare against upper - -- eax==0 if high part == sign extended low part - ] - return (Fixed format eax code) - - -------------------- - shift_code :: Width - -> (Format -> Operand -> Operand -> Instr) - -> CmmExpr - -> CmmExpr - -> NatM Register - - {- Case1: shift length as immediate -} - shift_code width instr x (CmmLit lit) - -- Handle the case of a shift larger than the width of the shifted value. - -- This is necessary since x86 applies a mask of 0x1f to the shift - -- amount, meaning that, e.g., `shr 47, $eax` will actually shift by - -- `47 & 0x1f == 15`. See #20626. - | CmmInt n _ <- lit - , n >= fromIntegral (widthInBits width) - = getRegister $ CmmLit $ CmmInt 0 width - - | otherwise = do - x_code <- getAnyReg x - let - format = intFormat width - code dst - = x_code dst `snocOL` - instr format (OpImm (litToImm lit)) (OpReg dst) - return (Any format code) - - {- Case2: shift length is complex (non-immediate) - * y must go in %ecx. - * we cannot do y first *and* put its result in %ecx, because - %ecx might be clobbered by x. - * if we do y second, then x cannot be - in a clobbered reg. Also, we cannot clobber x's reg - with the instruction itself. - * so we can either: - - do y first, put its result in a fresh tmp, then copy it to %ecx later - - do y second and put its result into %ecx. x gets placed in a fresh - tmp. This is likely to be better, because the reg alloc can - eliminate this reg->reg move here (it won't eliminate the other one, - because the move is into the fixed %ecx). - * in the case of C calls the use of ecx here can interfere with arguments. - We avoid this with the hack described in Note [Evaluate C-call - arguments before placing in destination registers] - -} - shift_code width instr x y{-amount-} = do - x_code <- getAnyReg x - let format = intFormat width - tmp <- getNewRegNat format - y_code <- getAnyReg y - let - code = x_code tmp `appOL` - y_code ecx `snocOL` - instr format (OpReg ecx) (OpReg tmp) - return (Fixed format tmp code) - - -------------------- - add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register - add_code rep x (CmmLit (CmmInt y _)) - | is32BitInteger y - , rep /= W8 -- LEA doesn't support byte size (#18614) - = add_int rep x y - add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y - where format = intFormat rep - -- TODO: There are other interesting patterns we want to replace - -- with a LEA, e.g. `(x + offset) + (y << shift)`. - - -------------------- - sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register - sub_code rep x (CmmLit (CmmInt y _)) - | is32BitInteger (-y) - , rep /= W8 -- LEA doesn't support byte size (#18614) - = add_int rep x (-y) - sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y - - -- our three-operand add instruction: - add_int width x y = do - (x_reg, x_code) <- getSomeReg x - let - format = intFormat width - imm = ImmInt (fromInteger y) - code dst - = x_code `snocOL` - LEA format - (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm)) - (OpReg dst) - -- - return (Any format code) - - ---------------------- - - -- See Note [DIV/IDIV for bytes] - div_code W8 signed quotient x y = do - let widen | signed = MO_SS_Conv W8 W16 - | otherwise = MO_UU_Conv W8 W16 - div_code - W16 - signed - quotient - (CmmMachOp widen [x]) - (CmmMachOp widen [y]) - - div_code width signed quotient x y = do - (y_op, y_code) <- getRegOrMem y -- cannot be clobbered - x_code <- getAnyReg x - let - format = intFormat width - widen | signed = CLTD format - | otherwise = XOR format (OpReg edx) (OpReg edx) - - instr | signed = IDIV - | otherwise = DIV - - code = y_code `appOL` - x_code eax `appOL` - toOL [widen, instr format y_op] - - result | quotient = eax - | otherwise = edx - - return (Fixed format result code) - - ----------------------- - -- Vector operations--- - vector_float_op_avx :: VectorArithInstns - -> Length - -> Width - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_float_op_avx op l w expr1 expr2 = do - (reg1, exp1) <- getSomeReg expr1 - (reg2, exp2) <- getSomeReg expr2 - let format = case w of - W32 -> VecFormat l FmtFloat - W64 -> VecFormat l FmtDouble - _ -> pprPanic "Floating-point AVX vector operation not supported at this width" - (text "width:" <+> ppr w) - code dst = case op of - VA_Add -> arithInstr VADD - VA_Sub -> arithInstr VSUB - VA_Mul -> arithInstr VMUL - VA_Div -> arithInstr VDIV - VA_Min -> arithInstr (VMINMAX Min FloatMinMax) - VA_Max -> arithInstr (VMINMAX Max FloatMinMax) - where - -- opcode src2 src1 dst <==> dst = src1 `opcode` src2 - arithInstr instr = exp1 `appOL` exp2 `snocOL` - (instr format (OpReg reg2) reg1 dst) - return (Any format code) - - vector_float_op_sse :: VectorArithInstns - -> Length - -> Width - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_float_op_sse op l w expr1 expr2 = do - -- This function is similar to genTrivialCode, but re-using it would require - -- handling alignment correctly: SSE vector instructions typically require 16-byte - -- alignment for their memory operand (this restriction is relaxed with VEX-encoded - -- instructions). - -- For now, we always load the value into a register and avoid the alignment issue. - exp1_code <- getAnyReg expr1 - (reg2, exp2_code) <- getSomeReg expr2 - let format = case w of - W32 -> VecFormat l FmtFloat - W64 -> VecFormat l FmtDouble - _ -> pprPanic "Floating-point SSE vector operation not supported at this width" - (text "width:" <+> ppr w) - tmp <- getNewRegNat format - let code dst = case op of - VA_Add -> arithInstr ADD - VA_Sub -> arithInstr SUB - VA_Mul -> arithInstr MUL - VA_Div -> arithInstr FDIV - VA_Min -> arithInstr (MINMAX Min FloatMinMax) - VA_Max -> arithInstr (MINMAX Max FloatMinMax) - where - -- opcode src2 src1 <==> src1 = src1 `opcode` src2 - arithInstr instr - | dst == reg2 = exp2_code `snocOL` - (MOVU format (OpReg reg2) (OpReg tmp)) `appOL` - exp1_code dst `snocOL` - instr format (OpReg tmp) (OpReg dst) - | otherwise = exp2_code `appOL` - exp1_code dst `snocOL` - instr format (OpReg reg2) (OpReg dst) - return (Any format code) - -------------------- - vector_float_extract :: Length - -> Width - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_float_extract l W32 expr (CmmLit lit) = do - (r, exp) <- getSomeReg expr - let format = VecFormat l FmtFloat - imm = litToImm lit - code dst - = case lit of - CmmInt 0 _ -> exp `snocOL` (MOV FF32 (OpReg r) (OpReg dst)) - CmmInt _ _ -> exp `snocOL` (VPSHUFD format imm (OpReg r) dst) - _ -> pprPanic "Unsupported AVX floating-point vector extract offset" (ppr lit) - return (Any FF32 code) - vector_float_extract l W64 expr (CmmLit lit) = do - (r, exp) <- getSomeReg expr - let format = VecFormat l FmtDouble - code dst - = case lit of - CmmInt 0 _ -> exp `snocOL` - (MOV FF64 (OpReg r) (OpReg dst)) - CmmInt 1 _ -> exp `snocOL` - (MOVHLPS format r dst) - _ -> pprPanic "Unsupported AVX floating-point vector extract offset" (ppr lit) - return (Any FF64 code) - vector_float_extract _ w c e = - pprPanic "Unsupported AVX floating-point vector extract" (pdoc platform c $$ pdoc platform e $$ ppr w) - ----------------------- - - vector_float_extract_sse :: Length - -> Width - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_float_extract_sse l W32 expr (CmmLit lit) - = do - (r,exp) <- getSomeReg expr - let format = VecFormat l FmtFloat - imm = litToImm lit - code dst - = case lit of - CmmInt 0 _ -> exp `snocOL` (MOVU format (OpReg r) (OpReg dst)) - CmmInt _ _ -> exp `snocOL` (PSHUFD format imm (OpReg r) dst) - _ -> pprPanic "Unsupported SSE floating-point vector extract offset" (ppr lit) - return (Any FF32 code) - vector_float_extract_sse _ w c e - = pprPanic "Unsupported SSE floating-point vector extract" (pdoc platform c $$ pdoc platform e $$ ppr w) - ----------------------- - - vector_int_extract_sse :: Length - -> Width - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_int_extract_sse l@2 W64 expr (CmmLit lit) - = do - (r, exp) <- getSomeReg expr - let fmt = VecFormat l FmtInt64 - tmp <- getNewRegNat fmt - let code dst = - case lit of - CmmInt 0 _ -> exp `snocOL` - (MOVD fmt II64 (OpReg r) (OpReg dst)) - CmmInt 1 _ -> exp `snocOL` - (MOVHLPS fmt r tmp) `snocOL` - (MOVD fmt II64 (OpReg tmp) (OpReg dst)) - _ -> panic "Error in offset while unpacking" - return (Any II64 code) - vector_int_extract_sse _ w c e - = pprPanic "Unsupported SSE floating-point vector extract" (pdoc platform c $$ pdoc platform e $$ ppr w) - - vector_shuffle_float :: Length -> Width -> CmmExpr -> CmmExpr -> [Int] -> NatM Register - vector_shuffle_float l w v1 v2 is = do - (r1, exp1) <- getSomeReg v1 - (r2, exp2) <- getSomeReg v2 - let fmt = VecFormat l (if w == W32 then FmtFloat else FmtDouble) - code dst - = exp1 `appOL` (exp2 `appOL` shuffleInstructions fmt r1 r2 is dst) - return (Any fmt code) - - shuffleInstructions :: Format -> Reg -> Reg -> [Int] -> Reg -> OrdList Instr - shuffleInstructions fmt v1 v2 is dst = - case fmt of - VecFormat 2 FmtDouble -> - case is of - [i1, i2] -> case (i1, i2) of - (0,0) -> unitOL (VSHUF fmt (ImmInt 0b00) (OpReg v1) v1 dst) - (1,1) -> unitOL (VSHUF fmt (ImmInt 0b11) (OpReg v1) v1 dst) - (2,2) -> unitOL (VSHUF fmt (ImmInt 0b00) (OpReg v2) v2 dst) - (3,3) -> unitOL (VSHUF fmt (ImmInt 0b11) (OpReg v2) v2 dst) - (0,1) -> unitOL (VMOVU fmt (OpReg v1) (OpReg dst)) - (2,3) -> unitOL (VMOVU fmt (OpReg v2) (OpReg dst)) - (1,0) -> unitOL (VSHUF fmt (ImmInt 0b01) (OpReg v1) v1 dst) - (3,2) -> unitOL (VSHUF fmt (ImmInt 0b01) (OpReg v2) v2 dst) - (0,2) -> unitOL (VSHUF fmt (ImmInt 0b00) (OpReg v2) v1 dst) - (2,0) -> unitOL (VSHUF fmt (ImmInt 0b00) (OpReg v1) v2 dst) - (0,3) -> unitOL (VSHUF fmt (ImmInt 0b10) (OpReg v2) v1 dst) - (3,0) -> unitOL (VSHUF fmt (ImmInt 0b01) (OpReg v1) v2 dst) - (1,2) -> unitOL (VSHUF fmt (ImmInt 0b01) (OpReg v2) v1 dst) - (2,1) -> unitOL (VSHUF fmt (ImmInt 0b10) (OpReg v1) v2 dst) - (1,3) -> unitOL (VSHUF fmt (ImmInt 0b11) (OpReg v2) v1 dst) - (3,1) -> unitOL (VSHUF fmt (ImmInt 0b11) (OpReg v1) v2 dst) - _ -> pprPanic "vector shuffle: indices out of bounds 0 <= i <= 3" (ppr is) - _ -> pprPanic "vector shuffle: wrong number of indices (expected 2)" (ppr is) - VecFormat 4 FmtFloat - -- indices 0 <= i <= 7 - | all ( (>= 0) <&&> (<= 7) ) is -> - case is of - [i1, i2, i3, i4] - | all ( <= 3 ) is - , let imm = i1 + i2 `shiftL` 2 + i3 `shiftL` 4 + i4 `shiftL` 6 - -> unitOL (VSHUF fmt (ImmInt imm) (OpReg v1) v1 dst) - | all ( >= 4 ) is - , let [j1, j2, j3, j4] = map ( subtract 4 ) is - imm = j1 + j2 `shiftL` 2 + j3 `shiftL` 4 + j4 `shiftL` 6 - -> unitOL (VSHUF fmt (ImmInt imm) (OpReg v2) v2 dst) - | i1 <= 3, i2 <= 3 - , i3 >= 4, i4 >= 4 - , let imm = i1 + i2 `shiftL` 2 + (i3 - 4) `shiftL` 4 + (i4 - 4) `shiftL` 6 - -> unitOL (VSHUF fmt (ImmInt imm) (OpReg v2) v1 dst) - | i1 >= 4, i2 >= 4 - , i3 <= 3, i4 <= 3 - , let imm = (i1 - 4) + (i2 - 4) `shiftL` 2 + i3 `shiftL` 4 + i4 `shiftL` 6 - -> unitOL (VSHUF fmt (ImmInt imm) (OpReg v1) v2 dst) - | otherwise - -> - -- Fall-back code with 4 INSERTPS operations. - -- SIMD NCG TODO: handle more cases with better lowering. - let -- bits: ss_dd_zzzz - -- ss: pick source location - -- dd: pick destination location - -- zzzz: pick locations to be zeroed - insertImm src dst = shiftL ( src `mod` 4 ) 6 - .|. shiftL dst 4 - vec src = if src >= 4 then v2 else v1 - in unitOL - (INSERTPS fmt (ImmInt $ insertImm i1 0 .|. 0b1110) (OpReg $ vec i1) dst) - `snocOL` - (INSERTPS fmt (ImmInt $ insertImm i2 1) (OpReg $ vec i2) dst) - `snocOL` - (INSERTPS fmt (ImmInt $ insertImm i3 2) (OpReg $ vec i3) dst) - `snocOL` - (INSERTPS fmt (ImmInt $ insertImm i4 3) (OpReg $ vec i4) dst) - _ -> pprPanic "vector shuffle: wrong number of indices (expected 4)" (ppr is) - | otherwise - -> pprPanic "vector shuffle: indices out of bounds 0 <= i <= 7" (ppr is) - _ -> - pprPanic "vector shuffle: unsupported format" (ppr fmt) - -getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps - avx <- avxEnabled - sse4_1 <- sse4_1Enabled - case mop of - -- Floating point fused multiply-add operations @ ± x*y ± z@ - MO_FMA var l w - | l * widthInBits w > 256 - -> sorry "Please use -fllvm for wide vector FMA support" - | otherwise - -> genFMA3Code l w var x y z - - -- Ternary vector operations - MO_VF_Insert l W32 | l == 4 -> vector_floatx4_insert_sse sse4_1 x y z - | otherwise -> - sorry $ "FloatX" ++ show l ++ "# insert operations require -fllvm" - -- SIMD NCG TODO: - -- - -- - add support for FloatX8, FloatX16. - MO_VF_Insert l W64 -> vector_double_insert avx l x y z - MO_V_Insert l W64 -> vector_int_insert_sse l W64 x y z - - _other -> pprPanic "getRegister(x86) - ternary CmmMachOp (1)" - (pprMachOp mop) - - where - -- SIMD NCG TODO: - -- - -- - add support for FloatX8, FloatX16. - vector_floatx4_insert_sse :: Bool - -> CmmExpr - -> CmmExpr - -> CmmExpr - -> NatM Register - vector_floatx4_insert_sse sse4_1 vecExpr valExpr (CmmLit (CmmInt offset _)) - | sse4_1 = do - (r, exp) <- getNonClobberedReg valExpr - fn <- getAnyReg vecExpr - let fmt = VecFormat 4 FmtFloat - imm = litToImm (CmmInt (offset `shiftL` 4) W32) - code dst = exp `appOL` - (fn dst) `snocOL` - (INSERTPS fmt imm (OpReg r) dst) - in return $ Any fmt code - | otherwise = do -- SSE <= 3 - (r, exp) <- getNonClobberedReg valExpr - fn <- getAnyReg vecExpr - let fmt = VecFormat 4 FmtFloat - tmp <- getNewRegNat fmt - let code dst - = case offset of - 0 -> exp `appOL` - (fn dst) `snocOL` - -- The following MOV compiles to MOVSS instruction and merges two vectors - (MOV fmt (OpReg r) (OpReg dst)) -- dst <- (r[0],dst[1],dst[2],dst[3]) - 1 -> exp `appOL` - (fn dst) `snocOL` - (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst - (UNPCKL fmt (OpReg r) dst) `snocOL` -- dst <- (dst[0],r[0],dst[1],r[1]) - (SHUF fmt (ImmInt 0xe4) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[2],tmp[3]) - 2 -> exp `appOL` - (fn dst) `snocOL` - (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst - (MOV fmt (OpReg r) (OpReg tmp)) `snocOL` -- tmp <- (r[0],tmp[1],tmp[2],tmp[3]) with MOVSS - (SHUF fmt (ImmInt 0xc4) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[0],tmp[3]) - 3 -> exp `appOL` - (fn dst) `snocOL` - (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst - (MOV fmt (OpReg r) (OpReg tmp)) `snocOL` -- tmp <- (r[0],tmp[1],tmp[2],tmp[3]) with MOVSS - (SHUF fmt (ImmInt 0x24) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[2],tmp[0]) - _ -> panic "MO_VF_Insert FloatX4: unsupported offset" - in return $ Any fmt code - vector_floatx4_insert_sse _ _ _ offset - = pprPanic "Unsupported vector insert operation" $ - vcat - [ text "FloatX4#" - , text "offset:" <+> pdoc platform offset ] - - - -- SIMD NCG TODO: - -- - -- - add support for DoubleX4#, DoubleX8#. - vector_double_insert :: Bool - -> Length - -> CmmExpr - -> CmmExpr - -> CmmExpr - -> NatM Register - -- DoubleX2 - vector_double_insert avx len@2 vecExpr valExpr (CmmLit offset) - = do - (valReg, valExp) <- getNonClobberedReg valExpr - (vecReg, vecExp) <- getSomeReg vecExpr -- NB: vector regs never clobbered by instruction - let movu = if avx then VMOVU else MOVU - fmt = VecFormat len FmtDouble - code dst - = case offset of - CmmInt 0 _ -> valExp `appOL` - vecExp `snocOL` - (movu (VecFormat 2 FmtDouble) (OpReg vecReg) (OpReg dst)) `snocOL` - -- The following MOV compiles to MOVSD instruction and merges two vectors - (MOV (VecFormat 2 FmtDouble) (OpReg valReg) (OpReg dst)) - CmmInt 1 _ -> valExp `appOL` - vecExp `snocOL` - (movu (VecFormat 2 FmtDouble) (OpReg vecReg) (OpReg dst)) `snocOL` - (SHUF fmt (ImmInt 0b00) (OpReg valReg) dst) - _ -> pprPanic "MO_VF_Insert DoubleX2: unsupported offset" (ppr offset) - in return $ Any fmt code - vector_double_insert _ _ _ _ _ = - sorry "Unsupported floating-point vector insert operation; please use -fllvm" - -- For DoubleX4: use VSHUFPD. - -- For DoubleX8: use something like vinsertf64x2 followed by vpblendd? - - -- SIMD NCG TODO: - -- - -- - only supports Int64X2, add support for everything else: - -- (Int32X{4,2}, Int16X{8,4,2}, Int8X{16,8,4,2}) - vector_int_insert_sse :: HasCallStack => Length - -> Width - -> CmmExpr - -> CmmExpr - -> CmmExpr - -> NatM Register - -- Int64X2 - vector_int_insert_sse len@2 W64 vecExpr valExpr (CmmLit offset) - = do - (valReg, valExp) <- getNonClobberedReg valExpr - (vecReg, vecExp) <- getSomeReg vecExpr -- NB: vector regs never clobbered by instruction - let fmt = VecFormat len FmtInt64 - tmp <- getNewRegNat fmt - let code dst - = case offset of - CmmInt 0 _ -> valExp `appOL` - vecExp `snocOL` - (MOVHLPS fmt vecReg tmp) `snocOL` - (MOVD II64 fmt (OpReg valReg) (OpReg dst)) `snocOL` - (PUNPCKLQDQ fmt (OpReg tmp) dst) - CmmInt 1 _ -> valExp `appOL` - vecExp `snocOL` - (MOVDQU fmt (OpReg vecReg) (OpReg dst)) `snocOL` - (MOVD II64 fmt (OpReg valReg) (OpReg tmp)) `snocOL` - (PUNPCKLQDQ fmt (OpReg tmp) dst) - _ -> pprPanic "MO_V_Insert Int64X2: unsupported offset" (ppr offset) - in return $ Any fmt code - vector_int_insert_sse _ _ _ _ _ = - sorry "Unsupported integer vector insert operation; please use -fllvm" - -getRegister' _ _ (CmmMachOp mop (_:_:_:_:_)) = - pprPanic "getRegister(x86): MachOp with >= 4 arguments" (text $ show mop) - -getRegister' platform is32Bit load@(CmmLoad mem ty _) - | isVecType ty - = do - config <- getConfig - Amode addr mem_code <- getAmode mem - let code dst = - mem_code `snocOL` - movInstr config format (OpAddr addr) (OpReg dst) - return (Any format code) - | isFloatType ty - = do - Amode addr mem_code <- getAmode mem - loadAmode (floatFormat width) addr mem_code - - | is32Bit && not (isWord64 ty) - = do - let - instr = case width of - W8 -> MOVZxL II8 - -- We always zero-extend 8-bit loads, if we - -- can't think of anything better. This is because - -- we can't guarantee access to an 8-bit variant of every register - -- (esi and edi don't have 8-bit variants), so to make things - -- simpler we do our 8-bit arithmetic with full 32-bit registers. - _other -> MOV format - code <- intLoadCode instr mem - return (Any format code) - - | not is32Bit - -- Simpler memory load code on x86_64 - = do - code <- intLoadCode (MOV format) mem - return (Any format code) - - | otherwise - = pprPanic "getRegister(x86) CmmLoad" (pdoc platform load) - where - format = cmmTypeFormat ty - width = typeWidth ty - --- Handle symbol references with LEA and %rip-relative addressing. --- See Note [%rip-relative addressing on x86-64]. -getRegister' platform is32Bit (CmmLit lit) - | is_label lit - , not is32Bit - = do let format = cmmTypeFormat (cmmLitType platform lit) - imm = litToImm lit - op = OpAddr (AddrBaseIndex EABaseRip EAIndexNone imm) - code dst = unitOL (LEA format op (OpReg dst)) - return (Any format code) - where - is_label (CmmLabel {}) = True - is_label (CmmLabelOff {}) = True - is_label (CmmLabelDiffOff {}) = True - is_label _ = False - -getRegister' platform is32Bit (CmmLit lit) = do - avx <- avxEnabled - - -- NB: it is important that the code produced here (to load a literal into - -- a register) doesn't clobber any registers other than the destination - -- register; the code for generating C calls relies on this property. - -- - -- In particular, we have: - -- - -- > loadIntoRegMightClobberOtherReg (CmmLit _) = False - -- - -- which means that we assume that loading a literal into a register - -- will not clobber any other registers. - - -- TODO: this function mishandles floating-point negative zero, - -- because -0.0 == 0.0 returns True and because we represent CmmFloat as - -- Rational, which can't properly represent negative zero. - - if - -- Zero: use XOR. - | isZeroLit lit - -> let code dst - | isIntFormat fmt - = let fmt' - | is32Bit - = fmt - | otherwise - -- x86_64: 32-bit xor is one byte shorter, - -- and zero-extends to 64 bits - = case fmt of - II64 -> II32 - _ -> fmt - in unitOL (XOR fmt' (OpReg dst) (OpReg dst)) - | avx - = if float_or_floatvec - then unitOL (VXOR fmt (OpReg dst) dst dst) - else unitOL (VPXOR fmt dst dst dst) - | otherwise - = if float_or_floatvec - then unitOL (XOR fmt (OpReg dst) (OpReg dst)) - else unitOL (PXOR fmt (OpReg dst) dst) - in return $ Any fmt code - - -- Constant vector: use broadcast. - | VecFormat l sFmt <- fmt - , CmmVec (f:fs) <- lit - , all (== f) fs - -> do let w = scalarWidth sFmt - broadcast = if isFloatScalarFormat sFmt - then MO_VF_Broadcast l w - else MO_V_Broadcast l w - valCode <- getAnyReg (CmmMachOp broadcast [CmmLit f]) - return $ Any fmt valCode - - -- Optimisation for loading small literals on x86_64: take advantage - -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit - -- instruction forms are shorter. - | not is32Bit, isWord64 cmmTy, not (isBigLit lit) - -> let - imm = litToImm lit - code dst = unitOL (MOV II32 (OpImm imm) (OpReg dst)) - in - return (Any II64 code) - - -- Scalar integer: use an immediate. - | isIntFormat fmt - -> let imm = litToImm lit - code dst = unitOL (MOV fmt (OpImm imm) (OpReg dst)) - in return (Any fmt code) - - -- General case: load literal from data address. - | otherwise - -> do let w = formatToWidth fmt - Amode addr addr_code <- memConstant (mkAlignment $ widthInBytes w) lit - loadAmode fmt addr addr_code - - where - cmmTy = cmmLitType platform lit - fmt = cmmTypeFormat cmmTy - float_or_floatvec = isFloatOrFloatVecFormat fmt - isZeroLit (CmmInt i _) = i == 0 - isZeroLit (CmmFloat f _) = f == 0 -- TODO: mishandles negative zero - isZeroLit (CmmVec fs) = all isZeroLit fs - isZeroLit _ = False - - isBigLit (CmmInt i _) = i < 0 || i > 0xffffffff - isBigLit _ = False - -- note1: not the same as (not.is32BitLit), because that checks for - -- signed literals that fit in 32 bits, but we want unsigned - -- literals here. - -- note2: all labels are small, because we're assuming the - -- small memory model. See Note [%rip-relative addressing on x86-64]. - -getRegister' platform _ slot@(CmmStackSlot {}) = - pprPanic "getRegister(x86) CmmStackSlot" (pdoc platform slot) - -intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr - -> NatM (Reg -> InstrBlock) -intLoadCode instr mem = do - Amode src mem_code <- getAmode mem - return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst)) - --- Compute an expression into *any* register, adding the appropriate --- move instruction if necessary. -getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock) -getAnyReg expr = do - r <- getRegister expr - anyReg r - -anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock) -anyReg (Any _ code) = return code -anyReg (Fixed rep reg fcode) = do - config <- getConfig - return (\dst -> fcode `snocOL` mkRegRegMoveInstr config rep reg dst) - --- A bit like getSomeReg, but we want a reg that can be byte-addressed. --- Fixed registers might not be byte-addressable, so we make sure we've --- got a temporary, inserting an extra reg copy if necessary. -getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) -getByteReg expr = do - config <- getConfig - is32Bit <- is32BitPlatform - if is32Bit - then do r <- getRegister expr - case r of - Any rep code -> do - tmp <- getNewRegNat rep - return (tmp, code tmp) - Fixed rep reg code - | isVirtualReg reg -> return (reg,code) - | otherwise -> do - tmp <- getNewRegNat rep - return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp) - -- ToDo: could optimise slightly by checking for - -- byte-addressable real registers, but that will - -- happen very rarely if at all. - else getSomeReg expr -- all regs are byte-addressable on x86_64 - --- Another variant: this time we want the result in a register that cannot --- be modified by code to evaluate an arbitrary expression. -getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) -getNonClobberedReg expr = do - r <- getRegister expr - config <- getConfig - let platform = ncgPlatform config - case r of - Any rep code -> do - tmp <- getNewRegNat rep - return (tmp, code tmp) - Fixed rep reg code - -- only certain regs can be clobbered - | reg `elem` instrClobberedRegs platform - -> do - tmp <- getNewRegNat rep - return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp) - | otherwise -> - return (reg, code) - --------------------------------------------------------------------------------- - --- | Convert a 'CmmExpr' representing a memory address into an 'Amode'. --- --- An 'Amode' is a datatype representing a valid address form for the target --- (e.g. "Base + Index + disp" or immediate) and the code to compute it. -getAmode :: CmmExpr -> NatM Amode -getAmode e = do - platform <- getPlatform - let is32Bit = target32Bit platform - - case e of - CmmRegOff r n - -> getAmode $ mangleIndexTree r n - - CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)), CmmLit displacement] - | not is32Bit - -> return $ Amode (ripRel (litToImm displacement)) nilOL - - -- This is all just ridiculous, since it carefully undoes - -- what mangleIndexTree has just done. - CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)] - | is32BitLit platform lit - -- assert (rep == II32)??? - -> do - (x_reg, x_code) <- getSomeReg x - let off = ImmInt (-(fromInteger i)) - return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) - - CmmMachOp (MO_Add _rep) [x, CmmLit lit] - | is32BitLit platform lit - -- assert (rep == II32)??? - -> do - (x_reg, x_code) <- getSomeReg x - let off = litToImm lit - return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) - - -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be - -- recognised by the next rule. - CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)] - -> getAmode (CmmMachOp (MO_Add rep) [b,a]) - - -- Matches: (x + offset) + (y << shift) - CmmMachOp (MO_Add _) [CmmRegOff x offset, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]] - | shift == 0 || shift == 1 || shift == 2 || shift == 3 - -> x86_complex_amode (CmmReg x) y shift (fromIntegral offset) - - CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]] - | shift == 0 || shift == 1 || shift == 2 || shift == 3 - -> x86_complex_amode x y shift 0 - - CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _) - [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]] - | shift == 0 || shift == 1 || shift == 2 || shift == 3 - && is32BitInteger offset - -> x86_complex_amode x y shift offset - - CmmMachOp (MO_Add _) [x,y] - | not (isLit y) -- we already handle valid literals above. - -> x86_complex_amode x y 0 0 - - CmmLit lit@(CmmFloat {}) - -> pprPanic "X86 CodeGen: attempt to use floating-point value as a memory address" - (ppr lit) - - -- Handle labels with %rip-relative addressing since in general the image - -- may be loaded anywhere in the 64-bit address space (e.g. on Windows - -- with high-entropy ASLR). See Note [%rip-relative addressing on x86-64]. - CmmLit lit - | not is32Bit - , is_label lit - -> return (Amode (AddrBaseIndex EABaseRip EAIndexNone (litToImm lit)) nilOL) - - CmmLit lit - | is32BitLit platform lit - -> return (Amode (ImmAddr (litToImm lit) 0) nilOL) - - -- Literal with offsets too big (> 32 bits) fails during the linking phase - -- (#15570). We already handled valid literals above so we don't have to - -- test anything here. - CmmLit (CmmLabelOff l off) - -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabel l) - , CmmLit (CmmInt (fromIntegral off) W64) - ]) - CmmLit (CmmLabelDiffOff l1 l2 off w) - -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabelDiffOff l1 l2 0 w) - , CmmLit (CmmInt (fromIntegral off) W64) - ]) - - -- in case we can't do something better, we just compute the expression - -- and put the result in a register - _ -> do - (reg,code) <- getSomeReg e - return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code) - where - is_label (CmmLabel{}) = True - is_label (CmmLabelOff{}) = True - is_label (CmmLabelDiffOff{}) = True - is_label _ = False - - --- | Like 'getAmode', but on 32-bit use simple register addressing --- (i.e. no index register). This stops us from running out of --- registers on x86 when using instructions such as cmpxchg, which can --- use up to three virtual registers and one fixed register. -getSimpleAmode :: CmmExpr -> NatM Amode -getSimpleAmode addr = is32BitPlatform >>= \case - False -> getAmode addr - True -> do - addr_code <- getAnyReg addr - config <- getConfig - addr_r <- getNewRegNat (intFormat (ncgWordWidth config)) - let amode = AddrBaseIndex (EABaseReg addr_r) EAIndexNone (ImmInt 0) - return $! Amode amode (addr_code addr_r) - -x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode -x86_complex_amode base index shift offset - = do (x_reg, x_code) <- getNonClobberedReg base - -- x must be in a temp, because it has to stay live over y_code - -- we could compare x_reg and y_reg and do something better here... - (y_reg, y_code) <- getSomeReg index - let - code = x_code `appOL` y_code - base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8; - n -> panic $ "x86_complex_amode: unhandled shift! (" ++ show n ++ ")" - return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset))) - code) - - - - --- ----------------------------------------------------------------------------- --- getOperand: sometimes any operand will do. - --- getNonClobberedOperand: the value of the operand will remain valid across --- the computation of an arbitrary expression, unless the expression --- is computed directly into a register which the operand refers to --- (see trivialCode where this function is used for an example). - -getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock) -getNonClobberedOperand (CmmLit lit) = - if isSuitableFloatingPointLit lit - then do - let CmmFloat _ w = lit - Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit - return (OpAddr addr, code) - else do - platform <- getPlatform - if is32BitLit platform lit && isIntFormat (cmmTypeFormat (cmmLitType platform lit)) - then return (OpImm (litToImm lit), nilOL) - else getNonClobberedOperand_generic (CmmLit lit) - -getNonClobberedOperand (CmmLoad mem ty _) = do - is32Bit <- is32BitPlatform - -- this logic could be simplified - -- TODO FIXME - if (if is32Bit then not (isWord64 ty) else True) - -- if 32bit and ty is at float/double/simd value - -- or if 64bit - -- this could use some eyeballs or i'll need to stare at it more later - then do - platform <- ncgPlatform <$> getConfig - Amode src mem_code <- getAmode mem - (src',save_code) <- - if (amodeCouldBeClobbered platform src) - then do - tmp <- getNewRegNat (archWordFormat is32Bit) - return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0), - unitOL (LEA (archWordFormat is32Bit) - (OpAddr src) - (OpReg tmp))) - else - return (src, nilOL) - return (OpAddr src', mem_code `appOL` save_code) - else - -- if its a word or gcptr on 32bit? - getNonClobberedOperand_generic (CmmLoad mem ty NaturallyAligned) - -getNonClobberedOperand e = getNonClobberedOperand_generic e - -getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) -getNonClobberedOperand_generic e = do - (reg, code) <- getNonClobberedReg e - return (OpReg reg, code) - -amodeCouldBeClobbered :: Platform -> AddrMode -> Bool -amodeCouldBeClobbered platform amode = any (regClobbered platform) (addrModeRegs amode) - -regClobbered :: Platform -> Reg -> Bool -regClobbered platform (RegReal (RealRegSingle rr)) = freeReg platform rr -regClobbered _ _ = False - --- getOperand: the operand is not required to remain valid across the --- computation of an arbitrary expression. -getOperand :: CmmExpr -> NatM (Operand, InstrBlock) - -getOperand (CmmLit lit) = do - if isSuitableFloatingPointLit lit - then do - let CmmFloat _ w = lit - Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit - return (OpAddr addr, code) - else do - - platform <- getPlatform - if is32BitLit platform lit && (isIntFormat $ cmmTypeFormat (cmmLitType platform lit)) - then return (OpImm (litToImm lit), nilOL) - else getOperand_generic (CmmLit lit) - -getOperand (CmmLoad mem ty _) = do - is32Bit <- is32BitPlatform - if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True) - then do - Amode src mem_code <- getAmode mem - return (OpAddr src, mem_code) - else - getOperand_generic (CmmLoad mem ty NaturallyAligned) - -getOperand e = getOperand_generic e - -getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) -getOperand_generic e = do - (reg, code) <- getSomeReg e - return (OpReg reg, code) - -isOperand :: Platform -> CmmExpr -> Bool -isOperand _ (CmmLoad _ _ _) = True -isOperand platform (CmmLit lit) - = is32BitLit platform lit - || isSuitableFloatingPointLit lit -isOperand _ _ = False - --- | Given a 'Register', produce a new 'Register' with an instruction block --- which will check the value for alignment. Used for @-falignment-sanitisation@. -addAlignmentCheck :: Int -> Register -> Register -addAlignmentCheck align reg = - case reg of - Fixed fmt reg code -> Fixed fmt reg (code `appOL` check fmt reg) - Any fmt f -> Any fmt (\reg -> f reg `appOL` check fmt reg) - where - check :: Format -> Reg -> InstrBlock - check fmt reg = - assert (isIntFormat fmt) $ - toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg) - , JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel - ] - -memConstant :: Alignment -> CmmLit -> NatM Amode -memConstant align lit = do - lbl <- getNewLabelNat - let rosection = Section ReadOnlyData lbl - config <- getConfig - platform <- getPlatform - (addr, addr_code) <- if target32Bit platform - then do dynRef <- cmmMakeDynamicReference - config - DataReference - lbl - Amode addr addr_code <- getAmode dynRef - return (addr, addr_code) - else return (ripRel (ImmCLbl lbl), nilOL) - let code = - LDATA rosection (align, CmmStaticsRaw lbl [CmmStaticLit lit]) - `consOL` addr_code - return (Amode addr code) - --- | Load the value at the given address into any register. -loadAmode :: Format -> AddrMode -> InstrBlock -> NatM Register -loadAmode fmt addr addr_code = do - config <- getConfig - let load dst = movInstr config fmt (OpAddr addr) (OpReg dst) - return $ Any fmt (\ dst -> addr_code `snocOL` load dst) - --- if we want a floating-point literal as an operand, we can --- use it directly from memory. However, if the literal is --- zero, we're better off generating it into a register using --- xor. -isSuitableFloatingPointLit :: CmmLit -> Bool -isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0 -isSuitableFloatingPointLit _ = False - -getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock) -getRegOrMem e@(CmmLoad mem ty _) = do - is32Bit <- is32BitPlatform - if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True) - then do - Amode src mem_code <- getAmode mem - return (OpAddr src, mem_code) - else do - (reg, code) <- getNonClobberedReg e - return (OpReg reg, code) -getRegOrMem e = do - (reg, code) <- getNonClobberedReg e - return (OpReg reg, code) - -is32BitLit :: Platform -> CmmLit -> Bool -is32BitLit platform _lit - | target32Bit platform = True -is32BitLit platform lit = - case lit of - CmmInt i W64 -> is32BitInteger i - -- Except on Windows, assume that labels are in the range 0-2^31-1: this - -- assumes the small memory model. Note [%rip-relative addressing on - -- x86-64]. - CmmLabel _ -> low_image - -- however we can't assume that label offsets are in this range - -- (see #15570) - CmmLabelOff _ off -> low_image && is32BitInteger (fromIntegral off) - CmmLabelDiffOff _ _ off _ -> low_image && is32BitInteger (fromIntegral off) - _ -> True - where - -- Is the executable image certain to be located below 4GB? As noted in - -- Note [%rip-relative addressing on x86-64], this is not true on Windows. - low_image = - case platformOS platform of - OSMinGW32 -> False -- See Note [%rip-relative addressing on x86-64] - _ -> True - - --- Set up a condition code for a conditional branch. - -getCondCode :: CmmExpr -> NatM CondCode - --- yes, they really do seem to want exactly the same! - -getCondCode (CmmMachOp mop [x, y]) - = - case mop of - MO_F_Eq W32 -> condFltCode EQQ x y - MO_F_Ne W32 -> condFltCode NE x y - MO_F_Gt W32 -> condFltCode GTT x y - MO_F_Ge W32 -> condFltCode GE x y - -- Invert comparison condition and swap operands - -- See Note [SSE Parity Checks] - MO_F_Lt W32 -> condFltCode GTT y x - MO_F_Le W32 -> condFltCode GE y x - - MO_F_Eq W64 -> condFltCode EQQ x y - MO_F_Ne W64 -> condFltCode NE x y - MO_F_Gt W64 -> condFltCode GTT x y - MO_F_Ge W64 -> condFltCode GE x y - MO_F_Lt W64 -> condFltCode GTT y x - MO_F_Le W64 -> condFltCode GE y x - - _ -> condIntCode (machOpToCond mop) x y - -getCondCode other = do - platform <- getPlatform - pprPanic "getCondCode(2)(x86,x86_64)" (pdoc platform other) - -machOpToCond :: MachOp -> Cond -machOpToCond mo = case mo of - MO_Eq _ -> EQQ - MO_Ne _ -> NE - MO_S_Gt _ -> GTT - MO_S_Ge _ -> GE - MO_S_Lt _ -> LTT - MO_S_Le _ -> LE - MO_U_Gt _ -> GU - MO_U_Ge _ -> GEU - MO_U_Lt _ -> LU - MO_U_Le _ -> LEU - _other -> pprPanic "machOpToCond" (pprMachOp mo) - -{- Note [64-bit integer comparisons on 32-bit] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - When doing these comparisons there are 2 kinds of - comparisons. - - * Comparison for equality (or lack thereof) - - We use xor to check if high/low bits are - equal. Then combine the results using or. - - * Other comparisons: - - We first compare the low registers - and use a subtraction with borrow to compare the high registers. - - For signed numbers the condition is determined by - the sign and overflow flags agreeing or not - and for unsigned numbers the condition is the carry flag. - --} - --- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be --- passed back up the tree. - -condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode -condIntCode cond x y = do platform <- getPlatform - condIntCode' platform cond x y - -condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode - --- 64-bit integer comparisons on 32-bit --- See Note [64-bit integer comparisons on 32-bit] -condIntCode' platform cond x y - | target32Bit platform && isWord64 (cmmExprType platform x) = do - - RegCode64 code1 r1hi r1lo <- iselExpr64 x - RegCode64 code2 r2hi r2lo <- iselExpr64 y - - -- we mustn't clobber r1/r2 so we use temporaries - tmp1 <- getNewRegNat II32 - tmp2 <- getNewRegNat II32 - - let (cond', cmpCode) = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2 - return $ CondCode False cond' (code1 `appOL` code2 `appOL` cmpCode) - - where - intComparison cond r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = - case cond of - -- These don't occur as argument of condIntCode' - ALWAYS -> panic "impossible" - NEG -> panic "impossible" - POS -> panic "impossible" - CARRY -> panic "impossible" - OFLO -> panic "impossible" - PARITY -> panic "impossible" - NOTPARITY -> panic "impossible" - -- Special case #1 x == y and x != y - EQQ -> (EQQ, cmpExact) - NE -> (NE, cmpExact) - -- [x >= y] - GE -> (GE, cmpGE) - GEU -> (GEU, cmpGE) - -- [x > y] - GTT -> (LTT, cmpLE) - GU -> (LU, cmpLE) - -- [x <= y] - LE -> (GE, cmpLE) - LEU -> (GEU, cmpLE) - -- [x < y] - LTT -> (LTT, cmpGE) - LU -> (LU, cmpGE) - where - cmpExact :: OrdList Instr - cmpExact = - toOL - [ MOV II32 (OpReg r1_hi) (OpReg tmp1) - , MOV II32 (OpReg r1_lo) (OpReg tmp2) - , XOR II32 (OpReg r2_hi) (OpReg tmp1) - , XOR II32 (OpReg r2_lo) (OpReg tmp2) - , OR II32 (OpReg tmp1) (OpReg tmp2) - ] - cmpGE = toOL - [ MOV II32 (OpReg r1_hi) (OpReg tmp1) - , CMP II32 (OpReg r2_lo) (OpReg r1_lo) - , SBB II32 (OpReg r2_hi) (OpReg tmp1) - ] - cmpLE = toOL - [ MOV II32 (OpReg r2_hi) (OpReg tmp1) - , CMP II32 (OpReg r1_lo) (OpReg r2_lo) - , SBB II32 (OpReg r1_hi) (OpReg tmp1) - ] - --- memory vs immediate -condIntCode' platform cond (CmmLoad x ty _) (CmmLit lit) - | is32BitLit platform lit = do - Amode x_addr x_code <- getAmode x - let - imm = litToImm lit - code = x_code `snocOL` - CMP (cmmTypeFormat ty) (OpImm imm) (OpAddr x_addr) - -- - return (CondCode False cond code) - --- anything vs zero, using a mask --- TODO: Add some sanity checking!!!! -condIntCode' platform cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 ty)) - | (CmmLit lit@(CmmInt mask _)) <- o2, is32BitLit platform lit - = do - (x_reg, x_code) <- getSomeReg x - let - code = x_code `snocOL` - TEST (intFormat ty) (OpImm (ImmInteger mask)) (OpReg x_reg) - -- - return (CondCode False cond code) - --- anything vs zero -condIntCode' _ cond x (CmmLit (CmmInt 0 ty)) = do - (x_reg, x_code) <- getSomeReg x - let - code = x_code `snocOL` - TEST (intFormat ty) (OpReg x_reg) (OpReg x_reg) - -- - return (CondCode False cond code) - --- anything vs operand -condIntCode' platform cond x y - | isOperand platform y = do - (x_reg, x_code) <- getNonClobberedReg x - (y_op, y_code) <- getOperand y - let - code = x_code `appOL` y_code `snocOL` - CMP (cmmTypeFormat (cmmExprType platform x)) y_op (OpReg x_reg) - return (CondCode False cond code) --- operand vs. anything: invert the comparison so that we can use a --- single comparison instruction. - | isOperand platform x - , Just revcond <- maybeFlipCond cond = do - (y_reg, y_code) <- getNonClobberedReg y - (x_op, x_code) <- getOperand x - let - code = y_code `appOL` x_code `snocOL` - CMP (cmmTypeFormat (cmmExprType platform x)) x_op (OpReg y_reg) - return (CondCode False revcond code) - --- anything vs anything -condIntCode' platform cond x y = do - (y_reg, y_code) <- getNonClobberedReg y - (x_op, x_code) <- getRegOrMem x - let - code = y_code `appOL` - x_code `snocOL` - CMP (cmmTypeFormat (cmmExprType platform x)) (OpReg y_reg) x_op - return (CondCode False cond code) - - - --------------------------------------------------------------------------------- -condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode - -condFltCode cond x y - = condFltCode_sse2 - where - - - -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be - -- an operand, but the right must be a reg. We can probably do better - -- than this general case... - condFltCode_sse2 = do - platform <- getPlatform - (x_reg, x_code) <- getNonClobberedReg x - (y_op, y_code) <- getOperand y - let - code = x_code `appOL` - y_code `snocOL` - CMP (floatFormat $ cmmExprWidth platform x) y_op (OpReg x_reg) - -- NB(1): we need to use the unsigned comparison operators on the - -- result of this comparison. - return (CondCode True (condToUnsigned cond) code) - --- ----------------------------------------------------------------------------- --- Generating assignments - --- Assignments are really at the heart of the whole code generation --- business. Almost all top-level nodes of any real importance are --- assignments, which correspond to loads, stores, or register --- transfers. If we're really lucky, some of the register transfers --- will go away, because we can use the destination register to --- complete the code generation for the right hand side. This only --- fails when the right hand side is forced into a fixed register --- (e.g. the result of a call). - -assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_IntCode :: CmmReg -> CmmExpr -> NatM InstrBlock - -assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_FltCode :: CmmReg -> CmmExpr -> NatM InstrBlock - -assignMem_VecCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock -assignReg_VecCode :: CmmReg -> CmmExpr -> NatM InstrBlock - --- integer assignment to memory - --- specific case of adding/subtracting an integer to a particular address. --- ToDo: catch other cases where we can use an operation directly on a memory --- address. -assignMem_IntCode ty addr (CmmMachOp op [CmmLoad addr2 _ _, - CmmLit (CmmInt i _)]) - | addr == addr2, ty /= II64 || is32BitInteger i, - Just instr <- check op - = do Amode amode code_addr <- getAmode addr - let code = code_addr `snocOL` - instr ty (OpImm (ImmInt (fromIntegral i))) (OpAddr amode) - return code - where - check (MO_Add _) = Just ADD - check (MO_Sub _) = Just SUB - check _ = Nothing - -- ToDo: more? - --- general case -assignMem_IntCode ty addr src = do - platform <- getPlatform - Amode addr code_addr <- getAmode addr - (code_src, op_src) <- get_op_RI platform src - let - code = code_src `appOL` - code_addr `snocOL` - MOV ty op_src (OpAddr addr) - -- NOTE: op_src is stable, so it will still be valid - -- after code_addr. This may involve the introduction - -- of an extra MOV to a temporary register, but we hope - -- the register allocator will get rid of it. - -- - return code - where - get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock,Operand) -- code, operator - get_op_RI platform (CmmLit lit) | is32BitLit platform lit - = return (nilOL, OpImm (litToImm lit)) - get_op_RI _ op - = do (reg,code) <- getNonClobberedReg op - return (code, OpReg reg) - - --- Assign; dst is a reg, rhs is mem -assignReg_IntCode reg (CmmLoad src _ _) = do - let ty = cmmTypeFormat $ cmmRegType reg - load_code <- intLoadCode (MOV ty) src - platform <- ncgPlatform <$> getConfig - return (load_code (getRegisterReg platform reg)) - --- dst is a reg, but src could be anything -assignReg_IntCode reg src = do - platform <- ncgPlatform <$> getConfig - code <- getAnyReg src - return (code (getRegisterReg platform reg)) - - --- Floating point assignment to memory -assignMem_FltCode ty addr src = do - (src_reg, src_code) <- getNonClobberedReg src - Amode addr addr_code <- getAmode addr - let - code = src_code `appOL` - addr_code `snocOL` - MOV ty (OpReg src_reg) (OpAddr addr) - - return code - --- Floating point assignment to a register/temporary -assignReg_FltCode reg src = do - src_code <- getAnyReg src - platform <- ncgPlatform <$> getConfig - return (src_code (getRegisterReg platform reg)) - --- Vector assignment to a register/temporary -assignMem_VecCode ty addr src = do - (src_reg, src_code) <- getNonClobberedReg src - Amode addr addr_code <- getAmode addr - config <- getConfig - let - code = src_code `appOL` - addr_code `snocOL` - movInstr config ty (OpReg src_reg) (OpAddr addr) - return code - -assignReg_VecCode reg src = do - platform <- ncgPlatform <$> getConfig - src_code <- getAnyReg src - return (src_code (getRegisterReg platform reg)) - -genJump :: CmmExpr{-the branch target-} -> [RegWithFormat] -> NatM InstrBlock - -genJump (CmmLoad mem _ _) regs = do - Amode target code <- getAmode mem - return (code `snocOL` JMP (OpAddr target) regs) - -genJump (CmmLit lit) regs = - return (unitOL (JMP (OpImm (litToImm lit)) regs)) - -genJump expr regs = do - (reg,code) <- getSomeReg expr - return (code `snocOL` JMP (OpReg reg) regs) - - --- ----------------------------------------------------------------------------- --- Unconditional branches - -genBranch :: BlockId -> InstrBlock -genBranch = toOL . mkJumpInstr - - - --- ----------------------------------------------------------------------------- --- Conditional jumps/branches - -{- -Conditional jumps are always to local labels, so we can use branch -instructions. We peek at the arguments to decide what kind of -comparison to do. - -I386: First, we have to ensure that the condition -codes are set according to the supplied comparison operation. --} - -genCondBranch - :: BlockId -- the source of the jump - -> BlockId -- the true branch target - -> BlockId -- the false branch target - -> CmmExpr -- the condition on which to branch - -> NatM InstrBlock -- Instructions - -genCondBranch bid id false expr = do - is32Bit <- is32BitPlatform - genCondBranch' is32Bit bid id false expr - --- | We return the instructions generated. -genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr - -> NatM InstrBlock - -genCondBranch' _ bid id false bool = do - CondCode is_float cond cond_code <- getCondCode bool - if not is_float - then - return (cond_code `snocOL` JXX cond id `appOL` genBranch false) - else do - -- See Note [SSE Parity Checks] - let jmpFalse = genBranch false - code - = case cond of - NE -> or_unordered - GU -> plain_test - GEU -> plain_test - -- Use ASSERT so we don't break releases if - -- LTT/LE creep in somehow. - LTT -> - assertPpr False (text "Should have been turned into >") - and_ordered - LE -> - assertPpr False (text "Should have been turned into >=") - and_ordered - _ -> and_ordered - - plain_test = unitOL ( - JXX cond id - ) `appOL` jmpFalse - or_unordered = toOL [ - JXX cond id, - JXX PARITY id - ] `appOL` jmpFalse - and_ordered = toOL [ - JXX PARITY false, - JXX cond id, - JXX ALWAYS false - ] - updateCfgNat (\cfg -> adjustEdgeWeight cfg (+3) bid false) - return (cond_code `appOL` code) - -{- Note [Introducing cfg edges inside basic blocks] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - During instruction selection a statement `s` - in a block B with control of the sort: B -> C - will sometimes result in control - flow of the sort: - - ┌ < ┐ - v ^ - B -> B1 ┴ -> C - - as is the case for some atomic operations. - - Now to keep the CFG in sync when introducing B1 we clearly - want to insert it between B and C. However there is - a catch when we have to deal with self loops. - - We might start with code and a CFG of these forms: - - loop: - stmt1 ┌ < ┐ - .... v ^ - stmtX loop ┘ - stmtY - .... - goto loop: - - Now we introduce B1: - ┌ ─ ─ ─ ─ ─┐ - loop: │ ┌ < ┐ │ - instrs v │ │ ^ - .... loop ┴ B1 ┴ ┘ - instrsFromX - stmtY - goto loop: - - This is simple, all outgoing edges from loop now simply - start from B1 instead and the code generator knows which - new edges it introduced for the self loop of B1. - - Disaster strikes if the statement Y follows the same pattern. - If we apply the same rule that all outgoing edges change then - we end up with: - - loop ─> B1 ─> B2 ┬─┐ - │ │ └─<┤ │ - │ └───<───┘ │ - └───────<────────┘ - - This is problematic. The edge B1->B1 is modified as expected. - However the modification is wrong! - - The assembly in this case looked like this: - - _loop: - - _B1: - ... - cmpxchgq ... - jne _B1 - - - _B2: - ... - cmpxchgq ... - jne _B2 - - jmp loop - - There is no edge _B2 -> _B1 here. It's still a self loop onto _B1. - - The problem here is that really B1 should be two basic blocks. - Otherwise we have control flow in the *middle* of a basic block. - A contradiction! - - So to account for this we add yet another basic block marker: - - _B: - - _B1: - ... - cmpxchgq ... - jne _B1 - jmp _B1' - _B1': - - - _B2: - ... - - Now when inserting B2 we will only look at the outgoing edges of B1' and - everything will work out nicely. - - You might also wonder why we don't insert jumps at the end of _B1'. There is - no way another block ends up jumping to the labels _B1 or _B2 since they are - essentially invisible to other blocks. View them as control flow labels local - to the basic block if you'd like. - - Not doing this ultimately caused (part 2 of) #17334. --} - - --- ----------------------------------------------------------------------------- --- Generating C calls - --- Now the biggest nightmare---calls. Most of the nastiness is buried in --- @get_arg@, which moves the arguments to the correct registers/stack --- locations. Apart from that, the code is easy. --- --- (If applicable) Do not fill the delay slots here; you will confuse the --- register allocator. --- --- See Note [Keeping track of the current block] for information why we need --- to take/return a block id. - -genForeignCall - :: ForeignTarget -- ^ function to call - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> BlockId -- ^ The block we are in - -> NatM (InstrBlock, Maybe BlockId) - -genForeignCall target dst args bid = do - case target of - PrimTarget prim -> genPrim bid prim dst args - ForeignTarget addr conv -> (,Nothing) <$> genCCall bid addr conv dst args - -genPrim - :: BlockId -- ^ The block we are in - -> CallishMachOp -- ^ MachOp - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> NatM (InstrBlock, Maybe BlockId) - --- First we deal with cases which might introduce new blocks in the stream. -genPrim bid (MO_AtomicRMW width amop) [dst] [addr, n] - = genAtomicRMW bid width amop dst addr n -genPrim bid (MO_Ctz width) [dst] [src] - = genCtz bid width dst src - --- Then we deal with cases which not introducing new blocks in the stream. -genPrim bid prim dst args - = (,Nothing) <$> genSimplePrim bid prim dst args - -genSimplePrim - :: BlockId -- ^ the block we are in - -> CallishMachOp -- ^ MachOp - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> NatM InstrBlock -genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid align dst src n -genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n -genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n -genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genSimplePrim _ MO_SeqCstFence [] [] = return $ unitOL MFENCE -genSimplePrim _ MO_Touch [] [_] = return nilOL -genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src -genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src -genSimplePrim bid (MO_BRev width) [dst] [src] = genBitRev bid width dst src -genSimplePrim bid (MO_PopCnt width) [dst] [src] = genPopCnt bid width dst src -genSimplePrim bid (MO_Pdep width) [dst] [src,mask] = genPdep bid width dst src mask -genSimplePrim bid (MO_Pext width) [dst] [src,mask] = genPext bid width dst src mask -genSimplePrim bid (MO_Clz width) [dst] [src] = genClz bid width dst src -genSimplePrim bid (MO_UF_Conv width) [dst] [src] = genWordToFloat bid width dst src -genSimplePrim _ (MO_AtomicRead w mo) [dst] [addr] = genAtomicRead w mo dst addr -genSimplePrim _ (MO_AtomicWrite w mo) [] [addr,val] = genAtomicWrite w mo addr val -genSimplePrim bid (MO_Cmpxchg width) [dst] [addr,old,new] = genCmpXchg bid width dst addr old new -genSimplePrim _ (MO_Xchg width) [dst] [addr, value] = genXchg width dst addr value -genSimplePrim _ (MO_AddWordC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y -genSimplePrim _ (MO_SubWordC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) CARRY r c x y -genSimplePrim _ (MO_AddIntC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (Just . ADD_CC) OFLO r c x y -genSimplePrim _ (MO_SubIntC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) OFLO r c x y -genSimplePrim _ (MO_Add2 w) [h,l] [x,y] = genAddWithCarry w h l x y -genSimplePrim _ (MO_U_Mul2 w) [h,l] [x,y] = genUnsignedLargeMul w h l x y -genSimplePrim _ (MO_S_Mul2 w) [c,h,l] [x,y] = genSignedLargeMul w c h l x y -genSimplePrim _ (MO_S_QuotRem w) [q,r] [x,y] = genQuotRem w True q r Nothing x y -genSimplePrim _ (MO_U_QuotRem w) [q,r] [x,y] = genQuotRem w False q r Nothing x y -genSimplePrim _ (MO_U_QuotRem2 w) [q,r] [hx,lx,y] = genQuotRem w False q r (Just hx) lx y -genSimplePrim _ MO_F32_Fabs [dst] [src] = genFloatAbs W32 dst src -genSimplePrim _ MO_F64_Fabs [dst] [src] = genFloatAbs W64 dst src -genSimplePrim _ MO_F32_Sqrt [dst] [src] = genFloatSqrt FF32 dst src -genSimplePrim _ MO_F64_Sqrt [dst] [src] = genFloatSqrt FF64 dst src -genSimplePrim bid MO_F32_Sin [dst] [src] = genLibCCall bid (fsLit "sinf") [dst] [src] -genSimplePrim bid MO_F32_Cos [dst] [src] = genLibCCall bid (fsLit "cosf") [dst] [src] -genSimplePrim bid MO_F32_Tan [dst] [src] = genLibCCall bid (fsLit "tanf") [dst] [src] -genSimplePrim bid MO_F32_Exp [dst] [src] = genLibCCall bid (fsLit "expf") [dst] [src] -genSimplePrim bid MO_F32_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1f") [dst] [src] -genSimplePrim bid MO_F32_Log [dst] [src] = genLibCCall bid (fsLit "logf") [dst] [src] -genSimplePrim bid MO_F32_Log1P [dst] [src] = genLibCCall bid (fsLit "log1pf") [dst] [src] -genSimplePrim bid MO_F32_Asin [dst] [src] = genLibCCall bid (fsLit "asinf") [dst] [src] -genSimplePrim bid MO_F32_Acos [dst] [src] = genLibCCall bid (fsLit "acosf") [dst] [src] -genSimplePrim bid MO_F32_Atan [dst] [src] = genLibCCall bid (fsLit "atanf") [dst] [src] -genSimplePrim bid MO_F32_Sinh [dst] [src] = genLibCCall bid (fsLit "sinhf") [dst] [src] -genSimplePrim bid MO_F32_Cosh [dst] [src] = genLibCCall bid (fsLit "coshf") [dst] [src] -genSimplePrim bid MO_F32_Tanh [dst] [src] = genLibCCall bid (fsLit "tanhf") [dst] [src] -genSimplePrim bid MO_F32_Pwr [dst] [x,y] = genLibCCall bid (fsLit "powf") [dst] [x,y] -genSimplePrim bid MO_F32_Asinh [dst] [src] = genLibCCall bid (fsLit "asinhf") [dst] [src] -genSimplePrim bid MO_F32_Acosh [dst] [src] = genLibCCall bid (fsLit "acoshf") [dst] [src] -genSimplePrim bid MO_F32_Atanh [dst] [src] = genLibCCall bid (fsLit "atanhf") [dst] [src] -genSimplePrim bid MO_F64_Sin [dst] [src] = genLibCCall bid (fsLit "sin") [dst] [src] -genSimplePrim bid MO_F64_Cos [dst] [src] = genLibCCall bid (fsLit "cos") [dst] [src] -genSimplePrim bid MO_F64_Tan [dst] [src] = genLibCCall bid (fsLit "tan") [dst] [src] -genSimplePrim bid MO_F64_Exp [dst] [src] = genLibCCall bid (fsLit "exp") [dst] [src] -genSimplePrim bid MO_F64_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1") [dst] [src] -genSimplePrim bid MO_F64_Log [dst] [src] = genLibCCall bid (fsLit "log") [dst] [src] -genSimplePrim bid MO_F64_Log1P [dst] [src] = genLibCCall bid (fsLit "log1p") [dst] [src] -genSimplePrim bid MO_F64_Asin [dst] [src] = genLibCCall bid (fsLit "asin") [dst] [src] -genSimplePrim bid MO_F64_Acos [dst] [src] = genLibCCall bid (fsLit "acos") [dst] [src] -genSimplePrim bid MO_F64_Atan [dst] [src] = genLibCCall bid (fsLit "atan") [dst] [src] -genSimplePrim bid MO_F64_Sinh [dst] [src] = genLibCCall bid (fsLit "sinh") [dst] [src] -genSimplePrim bid MO_F64_Cosh [dst] [src] = genLibCCall bid (fsLit "cosh") [dst] [src] -genSimplePrim bid MO_F64_Tanh [dst] [src] = genLibCCall bid (fsLit "tanh") [dst] [src] -genSimplePrim bid MO_F64_Pwr [dst] [x,y] = genLibCCall bid (fsLit "pow") [dst] [x,y] -genSimplePrim bid MO_F64_Asinh [dst] [src] = genLibCCall bid (fsLit "asinh") [dst] [src] -genSimplePrim bid MO_F64_Acosh [dst] [src] = genLibCCall bid (fsLit "acosh") [dst] [src] -genSimplePrim bid MO_F64_Atanh [dst] [src] = genLibCCall bid (fsLit "atanh") [dst] [src] -genSimplePrim bid MO_SuspendThread [tok] [rs,i] = genRTSCCall bid (fsLit "suspendThread") [tok] [rs,i] -genSimplePrim bid MO_ResumeThread [rs] [tok] = genRTSCCall bid (fsLit "resumeThread") [rs] [tok] -genSimplePrim bid MO_I64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64") [dst] [x,y] -genSimplePrim bid MO_I64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64") [dst] [x,y] -genSimplePrim bid MO_W64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64") [dst] [x,y] -genSimplePrim bid MO_W64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64") [dst] [x,y] -genSimplePrim _ op dst args = do - platform <- ncgPlatform <$> getConfig - pprPanic "genSimplePrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args)) - -{- Note [Evaluate C-call arguments before placing in destination registers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When producing code for C calls we must take care when placing arguments -in their final registers. Specifically, we must ensure that temporary register -usage due to evaluation of one argument does not clobber a register in which we -already placed a previous argument (e.g. as the code generation logic for -MO_Shl can clobber %rcx due to x86 instruction limitations). - -This is precisely what happened in #18527. Consider this C--: - - (result::I64) = call "ccall" doSomething(_s2hp::I64, 2244, _s2hq::I64, _s2hw::I64 | (1 << _s2hz::I64)); - -Here we are calling the C function `doSomething` with three arguments, the last -involving a non-trivial expression involving MO_Shl. In this case the NCG could -naively generate the following assembly (where $tmp denotes some temporary -register and $argN denotes the register for argument N, as dictated by the -platform's calling convention): - - mov _s2hp, $arg1 # place first argument - mov _s2hq, $arg2 # place second argument - - # Compute 1 << _s2hz - mov _s2hz, %rcx - shl %cl, $tmp - - # Compute (_s2hw | (1 << _s2hz)) - mov _s2hw, $arg3 - or $tmp, $arg3 - - # Perform the call - call func - -This code is outright broken on Windows which assigns $arg1 to %rcx. This means -that the evaluation of the last argument clobbers the first argument. - -To avoid this we use a rather awful hack: when producing code for a C call with -at least one non-trivial argument, we first evaluate all of the arguments into -local registers before moving them into their final calling-convention-defined -homes. This is performed by 'evalArgs'. Here we define "non-trivial" to be an -expression which might contain a MachOp since these are the only cases which -might clobber registers. Furthermore, we use a conservative approximation of -this condition (only looking at the top-level of CmmExprs) to avoid spending -too much effort trying to decide whether we want to take the fast path. - -Note that this hack *also* applies to calls to out-of-line PrimTargets (which -are lowered via a C call), which will ultimately end up in -genForeignCall{32,64}. --} - --- | See Note [Evaluate C-call arguments before placing in destination registers] -evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual]) -evalArgs bid actuals - | any loadIntoRegMightClobberOtherReg actuals = do - regs_blks <- mapM evalArg actuals - return (concatOL $ map fst regs_blks, map snd regs_blks) - | otherwise = return (nilOL, actuals) - where - - evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr) - evalArg actual = do - platform <- getPlatform - lreg <- newLocalReg $ cmmExprType platform actual - (instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual - -- The above assignment shouldn't change the current block - massert (isNothing bid1) - return (instrs, CmmReg $ CmmLocal lreg) - - newLocalReg :: CmmType -> NatM LocalReg - newLocalReg ty = LocalReg <$> getUniqueM <*> pure ty - --- | Might the code to put this expression into a register --- clobber any other registers? -loadIntoRegMightClobberOtherReg :: CmmExpr -> Bool -loadIntoRegMightClobberOtherReg (CmmReg _) = False -loadIntoRegMightClobberOtherReg (CmmRegOff _ _) = False -loadIntoRegMightClobberOtherReg (CmmLit _) = False - -- NB: this last 'False' is slightly risky, because the code for loading - -- a literal into a register is not entirely trivial. -loadIntoRegMightClobberOtherReg _ = True - --- Note [DIV/IDIV for bytes] --- ~~~~~~~~~~~~~~~~~~~~~~~~~ --- IDIV reminder: --- Size Dividend Divisor Quotient Remainder --- byte %ax r/m8 %al %ah --- word %dx:%ax r/m16 %ax %dx --- dword %edx:%eax r/m32 %eax %edx --- qword %rdx:%rax r/m64 %rax %rdx --- --- We do a special case for the byte division because the current --- codegen doesn't deal well with accessing %ah register (also, --- accessing %ah in 64-bit mode is complicated because it cannot be an --- operand of many instructions). So we just widen operands to 16 bits --- and get the results from %al, %dl. This is not optimal, but a few --- register moves are probably not a huge deal when doing division. - - --- | Generate C call to the given function in ghc-prim -genPrimCCall - :: BlockId - -> FastString - -> [CmmFormal] - -> [CmmActual] - -> NatM InstrBlock -genPrimCCall bid lbl_txt dsts args = do - config <- getConfig - -- FIXME: we should use mkForeignLabel instead of mkCmmCodeLabel - let lbl = mkCmmCodeLabel primUnitId lbl_txt - addr <- cmmMakeDynamicReference config CallReference lbl - let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args - --- | Generate C call to the given function in libc -genLibCCall - :: BlockId - -> FastString - -> [CmmFormal] - -> [CmmActual] - -> NatM InstrBlock -genLibCCall bid lbl_txt dsts args = do - config <- getConfig - -- Assume we can call these functions directly, and that they're not in a dynamic library. - -- TODO: Why is this ok? Under linux this code will be in libm.so - -- Is it because they're really implemented as a primitive instruction by the assembler?? -- BL 2009/12/31 - let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction - addr <- cmmMakeDynamicReference config CallReference lbl - let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args - --- | Generate C call to the given function in the RTS -genRTSCCall - :: BlockId - -> FastString - -> [CmmFormal] - -> [CmmActual] - -> NatM InstrBlock -genRTSCCall bid lbl_txt dsts args = do - config <- getConfig - -- Assume we can call these functions directly, and that they're not in a dynamic library. - let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction - addr <- cmmMakeDynamicReference config CallReference lbl - let conv = ForeignConvention CCallConv [] [] CmmMayReturn - genCCall bid addr conv dsts args - --- | Generate a real C call to the given address with the given convention -genCCall - :: BlockId - -> CmmExpr - -> ForeignConvention - -> [CmmFormal] - -> [CmmActual] - -> NatM InstrBlock -genCCall bid addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do - platform <- getPlatform - is32Bit <- is32BitPlatform - let args_hints = zip args (argHints ++ repeat NoHint) - prom_args = map (maybePromoteCArgToW32 platform) args_hints - (instrs0, args') <- evalArgs bid prom_args - instrs1 <- if is32Bit - then genCCall32 addr conv dest_regs args' - else genCCall64 addr conv dest_regs args' - return (instrs0 `appOL` instrs1) - -maybePromoteCArgToW32 :: Platform -> (CmmExpr, ForeignHint) -> CmmExpr -maybePromoteCArgToW32 platform (arg, hint) - | wfrom < wto = - -- As wto=W32, we only need to handle integer conversions, - -- never Float -> Double. - case hint of - SignedHint -> CmmMachOp (MO_SS_Conv wfrom wto) [arg] - _ -> CmmMachOp (MO_UU_Conv wfrom wto) [arg] - | otherwise = arg - where - ty = cmmExprType platform arg - wfrom = typeWidth ty - wto = W32 - -genCCall32 :: CmmExpr -- ^ address of the function to call - -> ForeignConvention -- ^ calling convention - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> NatM InstrBlock -genCCall32 addr _conv dest_regs args = do - config <- getConfig - let platform = ncgPlatform config - - -- If the size is smaller than the word, we widen things (see maybePromoteCArg) - arg_size_bytes :: CmmType -> Int - arg_size_bytes ty = max (widthInBytes (typeWidth ty)) (widthInBytes (wordWidth platform)) - - roundTo a x | x `mod` a == 0 = x - | otherwise = x + a - (x `mod` a) - - push_arg :: CmmActual {-current argument-} - -> NatM InstrBlock -- code - - push_arg arg -- we don't need the hints on x86 - | isWord64 arg_ty = do - RegCode64 code r_hi r_lo <- iselExpr64 arg - delta <- getDeltaNat - setDeltaNat (delta - 8) - return ( code `appOL` - toOL [PUSH II32 (OpReg r_hi), DELTA (delta - 4), - PUSH II32 (OpReg r_lo), DELTA (delta - 8), - DELTA (delta-8)] - ) - - | isFloatType arg_ty || isVecType arg_ty = do - (reg, code) <- getSomeReg arg - delta <- getDeltaNat - setDeltaNat (delta-size) - return (code `appOL` - toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp), - DELTA (delta-size), - let addr = AddrBaseIndex (EABaseReg esp) - EAIndexNone - (ImmInt 0) - format = cmmTypeFormat arg_ty - in - - movInstr config format (OpReg reg) (OpAddr addr) - - ] - ) - - | otherwise = do - -- Arguments can be smaller than 32-bit, but we still use @PUSH - -- II32@ - the usual calling conventions expect integers to be - -- 4-byte aligned. - massert ((typeWidth arg_ty) <= W32) - (operand, code) <- getOperand arg - delta <- getDeltaNat - setDeltaNat (delta-size) - return (code `snocOL` - PUSH II32 operand `snocOL` - DELTA (delta-size)) - - where - arg_ty = cmmExprType platform arg - size = arg_size_bytes arg_ty -- Byte size - - let - -- Align stack to 16n for calls, assuming a starting stack - -- alignment of 16n - word_size on procedure entry. Which we - -- maintain. See Note [Stack Alignment on X86] in rts/StgCRun.c. - sizes = map (arg_size_bytes . cmmExprType platform) (reverse args) - raw_arg_size = sum sizes + platformWordSizeInBytes platform - arg_pad_size = (roundTo 16 $ raw_arg_size) - raw_arg_size - tot_arg_size = raw_arg_size + arg_pad_size - platformWordSizeInBytes platform - - - delta0 <- getDeltaNat - setDeltaNat (delta0 - arg_pad_size) - - push_codes <- mapM push_arg (reverse args) - delta <- getDeltaNat - massert (delta == delta0 - tot_arg_size) - - -- deal with static vs dynamic call targets - callinsns <- - case addr of - CmmLit (CmmLabel lbl) - -> return $ unitOL (CALL (Left fn_imm) []) - where fn_imm = ImmCLbl lbl - _ - -> do { (dyn_r, dyn_c) <- getSomeReg addr - ; massert (isWord32 (cmmExprType platform addr)) - ; return $ dyn_c `snocOL` CALL (Right dyn_r) [] } - let push_code - | arg_pad_size /= 0 - = toOL [SUB II32 (OpImm (ImmInt arg_pad_size)) (OpReg esp), - DELTA (delta0 - arg_pad_size)] - `appOL` concatOL push_codes - | otherwise - = concatOL push_codes - - call = callinsns `appOL` - toOL ( - (if tot_arg_size == 0 then [] else - [ADD II32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)]) - ++ - [DELTA delta0] - ) - setDeltaNat delta0 - - let - -- assign the results, if necessary - assign_code [] = nilOL - assign_code [dest] - | isVecType ty - = unitOL (mkRegRegMoveInstr config (cmmTypeFormat ty) xmm0 r_dest) - | isFloatType ty = - -- we assume SSE2 - let tmp_amode = AddrBaseIndex (EABaseReg esp) - EAIndexNone - (ImmInt 0) - fmt = floatFormat w - in toOL [ SUB II32 (OpImm (ImmInt b)) (OpReg esp), - DELTA (delta0 - b), - X87Store fmt tmp_amode, - -- X87Store only supported for the CDECL ABI - -- NB: This code will need to be - -- revisited once GHC does more work around - -- SIGFPE f - MOV fmt (OpAddr tmp_amode) (OpReg r_dest), - ADD II32 (OpImm (ImmInt b)) (OpReg esp), - DELTA delta0] - | isWord64 ty = toOL [MOV II32 (OpReg eax) (OpReg r_dest), - MOV II32 (OpReg edx) (OpReg r_dest_hi)] - | otherwise = unitOL (MOV (intFormat w) - (OpReg eax) - (OpReg r_dest)) - where - ty = localRegType dest - w = typeWidth ty - b = widthInBytes w - r_dest_hi = getHiVRegFromLo r_dest - r_dest = getLocalRegReg dest - assign_code many = pprPanic "genForeignCall.assign_code - too many return values:" (ppr many) - - return (push_code `appOL` - call `appOL` - assign_code dest_regs) - -genCCall64 :: CmmExpr -- ^ address of function to call - -> ForeignConvention -- ^ calling convention - -> [CmmFormal] -- ^ where to put the result - -> [CmmActual] -- ^ arguments (of mixed type) - -> NatM InstrBlock -genCCall64 addr conv dest_regs args = do - config <- getConfig - let platform = ncgPlatform config - word_size = platformWordSizeInBytes platform - wordFmt = archWordFormat (target32Bit platform) - - -- Compute the code for loading arguments into registers, - -- returning the leftover arguments that will need to be passed on the stack. - -- - -- NB: the code for loading references to data into registers is computed - -- later (in 'pushArgs'), because we don't yet know where the data will be - -- placed (due to alignment requirements). - LoadArgs - { stackArgs = proper_stack_args - , stackDataArgs = stack_data_args - , usedRegs = arg_regs_used - , assignArgsCode = assign_args_code - } - <- loadArgs config args - - let - - -- Pad all arguments and data passed on stack to align them properly. - (stk_args_with_padding, args_aligned_16) = - padStackArgs platform (proper_stack_args, stack_data_args) - - -- Align stack to 16n for calls, assuming a starting stack - -- alignment of 16n - word_size on procedure entry. Which we - -- maintain. See Note [Stack Alignment on X86] in rts/StgCRun.c - need_realign_call = args_aligned_16 - align_call_code <- - if need_realign_call - then addStackPadding word_size - else return nilOL - - -- Compute the code that pushes data to the stack, and also - -- the code that loads references to that data into registers, - -- when the data is passed by reference in a register. - (load_data_refs, push_code) <- - pushArgs config proper_stack_args stk_args_with_padding - - -- On Windows, leave stack space for the arguments that we are passing - -- in registers (the so-called shadow space). - let shadow_space = - if platformOS platform == OSMinGW32 - then 8 * length (allArgRegs platform) - -- NB: the shadow store is always 8 * 4 = 32 bytes large, - -- i.e. the cumulative size of rcx, rdx, r8, r9 (see 'allArgRegs'). - else 0 - shadow_space_code <- addStackPadding shadow_space - - let total_args_size - = shadow_space - + sum (map (stackArgSpace platform) stk_args_with_padding) - real_size = - total_args_size + if need_realign_call then word_size else 0 - - -- End of argument passing. - -- - -- Next step: emit the appropriate call instruction. - delta <- getDeltaNat - - let -- The System V AMD64 ABI requires us to set %al to the number of SSE2 - -- registers that contain arguments, if the called routine - -- is a varargs function. We don't know whether it's a - -- varargs function or not, so we have to assume it is. - -- - -- It's not safe to omit this assignment, even if the number - -- of SSE2 regs in use is zero. If %al is larger than 8 - -- on entry to a varargs function, seg faults ensue. - is_sse_reg (RegWithFormat r _) = - -- NB: use 'targetClassOfRealReg' to compute whether this is an SSE - -- register or not, as we may have decided to e.g. store a 64-bit - -- integer in an xmm register. - case targetClassOfReg platform r of - RcFloatOrVector -> True - RcInteger -> False - nb_sse_regs_used = count is_sse_reg arg_regs_used - assign_eax_sse_regs - = unitOL (MOV II32 (OpImm (ImmInt nb_sse_regs_used)) (OpReg eax)) - -- Note: we do this on Windows as well. It's not entirely clear why - -- it's needed (the Windows X86_64 calling convention does not - -- dictate it), but we get segfaults without it. - -- - -- One test case exhibiting the issue is T20030_test1j; - -- if you change this, make sure to run it in a loop for a while - -- with at least -j8 to check. - - -- Live registers we are annotating the call instruction with - arg_regs = [RegWithFormat eax wordFmt] ++ arg_regs_used - - -- deal with static vs dynamic call targets - (callinsns,_cconv) <- case addr of - CmmLit (CmmLabel lbl) -> - return (unitOL (CALL (Left (ImmCLbl lbl)) arg_regs), conv) - _ -> do - (dyn_r, dyn_c) <- getSomeReg addr - return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv) - - let call = callinsns `appOL` - toOL ( - -- Deallocate parameters after call for ccall - (if real_size==0 then [] else - [ADD (intFormat (platformWordWidth platform)) (OpImm (ImmInt real_size)) (OpReg esp)]) - ++ - [DELTA (delta + real_size)] - ) - setDeltaNat (delta + real_size) - - let - -- assign the results, if necessary - assign_code [] = nilOL - assign_code [dest] = - unitOL $ - mkRegRegMoveInstr config fmt reg r_dest - where - reg = if isIntFormat fmt then rax else xmm0 - fmt = cmmTypeFormat rep - rep = localRegType dest - r_dest = getRegisterReg platform (CmmLocal dest) - assign_code _many = panic "genForeignCall.assign_code many" - - return (align_call_code `appOL` - push_code `appOL` - assign_args_code `appOL` - load_data_refs `appOL` - shadow_space_code `appOL` - assign_eax_sse_regs `appOL` - call `appOL` - assign_code dest_regs) - --- ----------------------------------------------------------------------------- --- Loading arguments into registers for 64-bit C calls. - --- | Information needed to know how to pass arguments in a C call, --- and in particular how to load them into registers. -data LoadArgs - = LoadArgs - -- | Arguments that should be passed on the stack - { stackArgs :: [RawStackArg] - -- | Additional values to store onto the stack. - , stackDataArgs :: [CmmExpr] - -- | Which registers are we using for argument passing? - , usedRegs :: [RegWithFormat] - -- | The code to assign arguments to registers used for argument passing. - , assignArgsCode :: InstrBlock - } -instance Semigroup LoadArgs where - LoadArgs a1 d1 r1 j1 <> LoadArgs a2 d2 r2 j2 - = LoadArgs (a1 ++ a2) (d1 ++ d2) (r1 ++ r2) (j1 S.<> j2) -instance Monoid LoadArgs where - mempty = LoadArgs [] [] [] nilOL - --- | An argument passed on the stack, either directly or by reference. --- --- The padding information hasn't yet been computed (see 'StackArg'). -data RawStackArg - -- | Pass the argument on the stack directly. - = RawStackArg { stackArgExpr :: CmmExpr } - -- | Pass the argument by reference. - | RawStackArgRef - { stackRef :: StackRef - -- ^ is the reference passed in a register, or on the stack? - , stackRefArgSize :: Int - -- ^ the size of the data pointed to - } - deriving ( Show ) - --- | An argument passed on the stack, either directly or by reference, --- with additional padding information. -data StackArg - -- | Pass the argument on the stack directly. - = StackArg - { stackArgExpr :: CmmExpr - , stackArgPadding :: Int - -- ^ padding required (in bytes) - } - -- | Pass the argument by reference. - | StackArgRef - { stackRef :: StackRef - -- ^ where the reference is passed - , stackRefArgSize :: Int - -- ^ the size of the data pointed to - , stackRefArgPadding :: Int - -- ^ padding of the data pointed to - -- (the reference itself never requires padding) - } - deriving ( Show ) - --- | Where is a reference to data on the stack passed? -data StackRef - -- | In a register. - = InReg Reg - -- | On the stack. - | OnStack - deriving ( Eq, Ord, Show ) - -newtype Padding = Padding { paddingBytes :: Int } - deriving ( Show, Eq, Ord ) - --- | How much space does this 'StackArg' take up on the stack? --- --- Only counts the "reference" part for references, not the data it points to. -stackArgSpace :: Platform -> StackArg -> Int -stackArgSpace platform = \case - StackArg arg padding -> - argSize platform arg + padding - StackArgRef { stackRef = ref } -> - case ref of - InReg {} -> 0 - OnStack {} -> 8 - --- | Pad arguments, assuming we start aligned to a 16-byte boundary. --- --- Returns padded arguments, together with whether we end up aligned --- to a 16-byte boundary. -padStackArgs :: Platform - -> ([RawStackArg], [CmmExpr]) - -> ([StackArg], Bool) -padStackArgs platform (args0, data_args0) = - let - -- Pad the direct args - (args, align_16_mid) = pad_args True args0 - - -- Pad the data section - (data_args, align_16_end) = pad_args align_16_mid (map RawStackArg data_args0) - - -- Now figure out where the data is placed relative to the direct arguments, - -- in order to resolve references. - resolve_args :: [(RawStackArg, Padding)] -> [Padding] -> [StackArg] - resolve_args [] _ = [] - resolve_args ((stk_arg, Padding pad):rest) pads = - let (this_arg, pads') = - case stk_arg of - RawStackArg arg -> (StackArg arg pad, pads) - RawStackArgRef ref size -> - let (Padding arg_pad : rest_pads) = pads - arg = - StackArgRef - { stackRef = ref - , stackRefArgSize = size - , stackRefArgPadding = arg_pad } - in (arg, rest_pads) - in this_arg : resolve_args rest pads' - - in - ( resolve_args args (fmap snd data_args) ++ - [ case data_arg of - RawStackArg arg -> StackArg arg pad - RawStackArgRef {} -> panic "padStackArgs: reference in data section" - | (data_arg, Padding pad) <- data_args - ] - , align_16_end ) - - where - pad_args :: Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool) - pad_args aligned_16 [] = ([], aligned_16) - pad_args aligned_16 (arg:args) - | needed_alignment > 16 - -- We don't know if the stack is aligned to 8 (mod 32) or 24 (mod 32). - -- This makes aligning the stack to a 32 or 64 byte boundary more - -- complicated, in particular with DELTA. - = sorry $ unlines - [ "X86_86 C call: unsupported argument." - , " Alignment requirement: " ++ show needed_alignment ++ " bytes." - , if platformOS platform == OSMinGW32 - then " The X86_64 NCG does not (yet) support Windows C calls with 256/512 bit vectors." - else " The X86_64 NCG cannot (yet) pass 256/512 bit vectors on the stack for C calls." - , " Please use the LLVM backend (-fllvm)." ] - | otherwise - = let ( rest, final_align_16 ) = pad_args next_aligned_16 args - in ( (arg, Padding padding) : rest, final_align_16 ) - - where - needed_alignment = case arg of - RawStackArg arg -> argSize platform arg - RawStackArgRef {} -> platformWordSizeInBytes platform - padding - | needed_alignment < 16 || aligned_16 - = 0 - | otherwise - = 8 - next_aligned_16 = not ( aligned_16 && needed_alignment < 16 ) - --- | Load arguments into available registers. -loadArgs :: NCGConfig -> [CmmExpr] -> NatM LoadArgs -loadArgs config args - | platformOS platform == OSMinGW32 - = evalStateT (loadArgsWin config args) (allArgRegs platform) - | otherwise - = evalStateT (loadArgsSysV config args) (allIntArgRegs platform - ,allFPArgRegs platform) - where - platform = ncgPlatform config - --- | Load arguments into available registers (System V AMD64 ABI). -loadArgsSysV :: NCGConfig - -> [CmmExpr] - -> StateT ([Reg], [Reg]) NatM LoadArgs -loadArgsSysV _ [] = return mempty -loadArgsSysV config (arg:rest) = do - (iregs, fregs) <- get - -- No available registers: pass everything on the stack (shortcut). - if null iregs && null fregs - then return $ - LoadArgs - { stackArgs = map RawStackArg (arg:rest) - , stackDataArgs = [] - , assignArgsCode = nilOL - , usedRegs = [] - } - else do - mbReg <- - if - | isIntFormat arg_fmt - , ireg:iregs' <- iregs - -> do put (iregs', fregs) - return $ Just ireg - | isFloatFormat arg_fmt || isVecFormat arg_fmt - , freg:fregs' <- fregs - -> do put (iregs, fregs') - return $ Just freg - | otherwise - -> return Nothing - this_arg <- - case mbReg of - Just reg -> do - assign_code <- lift $ loadArgIntoReg arg reg - return $ - LoadArgs - { stackArgs = [] -- passed in register - , stackDataArgs = [] - , assignArgsCode = assign_code - , usedRegs = [RegWithFormat reg arg_fmt] - } - Nothing -> do - return $ - -- No available register for this argument: pass it on the stack. - LoadArgs - { stackArgs = [RawStackArg arg] - , stackDataArgs = [] - , assignArgsCode = nilOL - , usedRegs = [] - } - others <- loadArgsSysV config rest - return $ this_arg S.<> others - - where - platform = ncgPlatform config - arg_fmt = cmmTypeFormat (cmmExprType platform arg) - --- | Compute all things that will need to be pushed to the stack. --- --- On Windows, an argument passed by reference will require two pieces of data: --- --- - the reference (returned in the first position) --- - the actual data (returned in the second position) -computeWinPushArgs :: Platform -> [CmmExpr] -> ([RawStackArg], [CmmExpr]) -computeWinPushArgs platform = go - where - go :: [CmmExpr] -> ([RawStackArg], [CmmExpr]) - go [] = ([], []) - go (arg:args) = - let - arg_size = argSize platform arg - (this_arg, add_this_arg) - | arg_size > 8 - = ( RawStackArgRef OnStack arg_size, (arg :) ) - | otherwise - = ( RawStackArg arg, id ) - (stk_args, stk_data) = go args - in - (this_arg:stk_args, add_this_arg stk_data) - --- | Load arguments into available registers (Windows C X64 calling convention). -loadArgsWin :: NCGConfig -> [CmmExpr] -> StateT [(Reg,Reg)] NatM LoadArgs -loadArgsWin _ [] = return mempty -loadArgsWin config (arg:rest) = do - regs <- get - case regs of - reg:regs' -> do - put regs' - this_arg <- lift $ load_arg_win reg - rest <- loadArgsWin config rest - return $ this_arg S.<> rest - [] -> do - -- No more registers available: pass all (remaining) arguments on the stack. - let (stk_args, data_args) = computeWinPushArgs platform (arg:rest) - return $ - LoadArgs - { stackArgs = stk_args - , stackDataArgs = data_args - , assignArgsCode = nilOL - , usedRegs = [] - } - where - platform = ncgPlatform config - arg_fmt = cmmTypeFormat $ cmmExprType platform arg - load_arg_win (ireg, freg) - | isVecFormat arg_fmt - -- Vectors are passed by reference. - -- See Note [The Windows X64 C calling convention]. - = do return $ - LoadArgs - -- Pass the reference in a register, - -- and the argument data on the stack. - { stackArgs = [RawStackArgRef (InReg ireg) (argSize platform arg)] - , stackDataArgs = [arg] -- we don't yet know where the data will reside, - , assignArgsCode = nilOL -- so we defer computing the reference and storing it - -- in the register until later - , usedRegs = [RegWithFormat ireg II64] - } - | otherwise - = do let arg_reg - | isFloatFormat arg_fmt - = freg - | otherwise - = ireg - assign_code <- loadArgIntoReg arg arg_reg - -- Recall that, for varargs, we must pass floating-point - -- arguments in both fp and integer registers. - let (assign_code', regs') - | isFloatFormat arg_fmt = - ( assign_code `snocOL` MOVD FF64 II64 (OpReg freg) (OpReg ireg), - [ RegWithFormat freg FF64 - , RegWithFormat ireg II64 ]) - | otherwise = (assign_code, [RegWithFormat ireg II64]) - return $ - LoadArgs - { stackArgs = [] -- passed in register - , stackDataArgs = [] - , assignArgsCode = assign_code' - , usedRegs = regs' - } - --- | Load an argument into a register. --- --- Assumes that the expression does not contain any MachOps, --- as per Note [Evaluate C-call arguments before placing in destination registers]. -loadArgIntoReg :: CmmExpr -> Reg -> NatM InstrBlock -loadArgIntoReg arg reg = do - when (debugIsOn && loadIntoRegMightClobberOtherReg arg) $ do - platform <- getPlatform - massertPpr False $ - vcat [ text "loadArgIntoReg: arg might contain MachOp" - , text "arg:" <+> pdoc platform arg ] - arg_code <- getAnyReg arg - return $ arg_code reg - --- ----------------------------------------------------------------------------- --- Pushing arguments onto the stack for 64-bit C calls. - --- | The size of an argument (in bytes). --- --- Never smaller than the platform word width. -argSize :: Platform -> CmmExpr -> Int -argSize platform arg = - max (platformWordSizeInBytes platform) $ - widthInBytes (typeWidth $ cmmExprType platform arg) - --- | Add the given amount of padding on the stack. -addStackPadding :: Int -- ^ padding (in bytes) - -> NatM InstrBlock -addStackPadding pad_bytes - | pad_bytes == 0 - = return nilOL - | otherwise - = do delta <- getDeltaNat - setDeltaNat (delta - pad_bytes) - return $ - toOL [ SUB II64 (OpImm (ImmInt pad_bytes)) (OpReg rsp) - , DELTA (delta - pad_bytes) - ] - --- | Push one argument directly to the stack (by value). --- --- Assumes the current stack pointer fulfills any necessary alignment requirements. -pushArgByValue :: NCGConfig -> CmmExpr -> NatM InstrBlock -pushArgByValue config arg - -- For 64-bit integer arguments, use PUSH II64. - -- - -- Note: we *must not* do this for smaller arguments. - -- For example, if we tried to push an argument such as @CmmLoad addr W32 aln@, - -- we could end up reading unmapped memory and segfaulting. - | isIntFormat fmt - , formatInBytes fmt == 8 - = do - (arg_op, arg_code) <- getOperand arg - delta <- getDeltaNat - setDeltaNat (delta-arg_size) - return $ - arg_code `appOL` toOL - [ PUSH II64 arg_op - , DELTA (delta-arg_size) ] - - | otherwise - = do - (arg_reg, arg_code) <- getSomeReg arg - delta <- getDeltaNat - setDeltaNat (delta-arg_size) - return $ arg_code `appOL` toOL - [ SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_size)) (OpReg rsp) - , DELTA (delta-arg_size) - , movInstr config fmt (OpReg arg_reg) (OpAddr (spRel platform 0)) ] - - where - platform = ncgPlatform config - arg_size = argSize platform arg - arg_rep = cmmExprType platform arg - fmt = cmmTypeFormat arg_rep - --- | Load an argument into a register or push it to the stack. -loadOrPushArg :: NCGConfig -> (StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock) -loadOrPushArg config (stk_arg, mb_off) = - case stk_arg of - StackArg arg pad -> do - push_code <- pushArgByValue config arg - pad_code <- addStackPadding pad - return (nilOL, push_code `appOL` pad_code) - StackArgRef { stackRef = ref } -> - case ref of - -- Pass the reference in a register - InReg ireg -> - return (unitOL $ LEA II64 (OpAddr (spRel platform off)) (OpReg ireg), nilOL) - -- Pass the reference on the stack - OnStack {} -> do - tmp <- getNewRegNat II64 - delta <- getDeltaNat - setDeltaNat (delta-arg_ref_size) - let push_code = toOL - [ SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_ref_size)) (OpReg rsp) - , DELTA (delta-arg_ref_size) - , LEA II64 (OpAddr (spRel platform off)) (OpReg tmp) - , MOV II64 (OpReg tmp) (OpAddr (spRel platform 0)) ] - return (nilOL, push_code) - where off = expectJust "push_arg_win offset" mb_off - where - arg_ref_size = 8 -- passing a reference to the argument - platform = ncgPlatform config - --- | Push arguments to the stack, right to left. --- --- On Windows, some arguments may need to be passed by reference, --- which requires separately passing the data and the reference. --- See Note [The Windows X64 C calling convention]. -pushArgs :: NCGConfig - -> [RawStackArg] - -- ^ arguments proper (i.e. don't include the data for arguments passed by reference) - -> [StackArg] - -- ^ arguments we are passing on the stack - -> NatM (InstrBlock, InstrBlock) -pushArgs config proper_args all_stk_args - = do { let - vec_offs :: [Maybe Int] - vec_offs - | platformOS platform == OSMinGW32 - = go stack_arg_size all_stk_args - | otherwise - = repeat Nothing - - --------------------- - -- Windows-only code - - -- Size of the arguments we are passing on the stack, counting only - -- the reference part for arguments passed by reference. - stack_arg_size = 8 * count not_in_reg proper_args - not_in_reg (RawStackArg {}) = True - not_in_reg (RawStackArgRef { stackRef = ref }) = - case ref of - InReg {} -> False - OnStack {} -> True - - -- Check an offset is valid (8-byte aligned), for assertions. - ok off = off `rem` 8 == 0 - - -- Tricky code: compute the stack offset to the vector data - -- for this argument. - -- - -- If you're confused, Note [The Windows X64 C calling convention] - -- contains a helpful diagram. - go :: Int -> [StackArg] -> [Maybe Int] - go _ [] = [] - go off (stk_arg:args) = - assertPpr (ok off) (text "unaligned offset:" <+> ppr off) $ - case stk_arg of - StackArg {} -> - -- Only account for the stack pointer movement. - let off' = off - stackArgSpace platform stk_arg - in Nothing : go off' args - StackArgRef - { stackRefArgSize = data_size - , stackRefArgPadding = data_pad } -> - assertPpr (ok data_size) (text "unaligned data size:" <+> ppr data_size) $ - assertPpr (ok data_pad) (text "unaligned data padding:" <+> ppr data_pad) $ - let off' = off - -- Next piece of data is after the data for this reference - + data_size + data_pad - -- ... and account for the stack pointer movement. - - stackArgSpace platform stk_arg - in Just (data_pad + off) : go off' args - - -- end of Windows-only code - ---------------------------- - - -- Push the stack arguments (right to left), - -- including both the reference and the data for arguments passed by reference. - ; (load_regs, push_args) <- foldMapM (loadOrPushArg config) (reverse $ zip all_stk_args vec_offs) - ; return (load_regs, push_args) } - where - platform = ncgPlatform config - -{- Note [The Windows X64 C calling convention] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Here are a few facts about the Windows X64 C calling convention that -are important: - - - any argument larger than 8 bytes must be passed by reference, - and arguments smaller than 8 bytes are padded to 8 bytes. - - - the first four arguments are passed in registers: - - floating-point scalar arguments are passed in %xmm0, %xmm1, %xmm2, %xmm3 - - other arguments are passed in %rcx, %rdx, %r8, %r9 - (this includes vector arguments, passed by reference) - - For variadic functions, it is additionally expected that floating point - scalar arguments are copied to the corresponding integer register, e.g. - the data in xmm2 should also be copied to r8. - - There is no requirement about setting %al like there is for the - System V AMD64 ABI. - - - subsequent arguments are passed on the stack. - -There are also alignment requirements: - - - the data for vectors must be aligned to the size of the vector, - e.g. a 32 byte vector must be aligned on a 32 byte boundary, - - - the call instruction must be aligned to 16 bytes. - (This differs from the System V AMD64 ABI, which mandates that the call - instruction must be aligned to 32 bytes if there are any 32 byte vectors - passed on the stack.) - -This motivates our handling of vector values. Suppose we have a function call -with many arguments, several of them being vectors. We proceed as follows: - - - Add some padding, if necessary, to ensure the stack, when executing the call - instruction, is 16-byte aligned. Whether this padding is necessary depends - on what happens next. (Recall also that we start off at 8 (mod 16) alignment, - as per Note [Stack Alignment on X86] in rts/StgCRun.c) - - Push all the vectors to the stack first, adding padding after each one - if necessary. - - Then push the arguments: - - for non-vectors, proceed as usual, - - for vectors, push the address of the vector data we pushed above. - - Then assign the registers: - - for non-vectors, proceed as usual, - - for vectors, store the address in a general-purpose register, as opposed - to storing the data in an xmm register. - -For a concrete example, suppose we have a call of the form: - - f x1 x2 x3 x4 x5 x6 x7 - -in which: - - - x2, x3, x5 and x7 are 16 byte vectors - - the other arguments are all 8 byte wide - -Now, x1, x2, x3, x4 will get passed in registers, except that we pass -x2 and x3 by reference, because they are vectors. We proceed as follows: - - - push the vectors to the stack: x7, x5, x3, x2 (in that order) - - push the stack arguments in order: addr(x7), x6, addr(x5) - - load the remaining arguments into registers: x4, addr(x3), addr(x2), x1 - -The tricky part is to get the right offsets for the addresses of the vector -data. The following visualisation will hopefully clear things up: - - ┌──┐ - │▓▓│ ─── padding to align the call instruction - ╭─╴ ╞══╡ (ensures Sp, below, is 16-byte aligned) - │ │ │ - │ x7 ───╴ │ │ - │ ├──┤ - │ │ │ - │ x5 ───╴ │ │ - │ ├──┤ - vector data ────┤ │ │ -(individually padded) │ x3 ───╴ │ │ - │ ├──┤ - │ │ │ - │ x2 ───╴ │ │ - │ ├┄┄┤ - │ │▓▓│ ─── padding to align x2 to 16 bytes - ╭─╴ ╰─╴ ╞══╡ - │ addr(x7) ───╴ │ │ ╭─ from here: x7 is +64 - │ ├──┤ ╾──╯ = 64 (position of x5) - stack ───┤ x6 ───╴ │ │ + 16 (size of x5) + 0 (padding of x7) - arguments │ ├──┤ - 2 * 8 (x7 is 2 arguments higher than x5) - │ addr(x5) ───╴ │ │ - ╰─╴ ╭─╴ ╞══╡ ╾─── from here: - │ │ │ - x2 is +32 = 24 (stack_arg_size) + 8 (padding of x2) - shadow ───┤ │ │ - x3 is +48 = 32 (position of x2) + 16 (size of x2) + 0 (padding of x3) - space │ │ │ - x5 is +64 = 48 (position of x3) + 16 (size of x3) + 0 (padding of x5) - │ │ │ - ╰─╴ └──┘ ╾─── Sp - -This is all tested in the simd013 test. --} - --- ----------------------------------------------------------------------------- --- Generating a table-branch - -{- -Note [Sub-word subtlety during jump-table indexing] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Offset the index by the start index of the jump table. -It's important that we do this *before* the widening below. To see -why, consider a switch with a sub-word, signed discriminant such as: - - switch [-5...+2] x::I16 { - case -5: ... - ... - case +2: ... - } - -Consider what happens if we offset *after* widening in the case that -x=-4: - - // x == -4 == 0xfffc::I16 - indexWidened = UU_Conv(x); // == 0xfffc::I64 - indexExpr = indexWidened - (-5); // == 0x10000::I64 - -This index is clearly nonsense given that the jump table only has -eight entries. - -By contrast, if we widen *after* we offset then we get the correct -index (1), - - // x == -4 == 0xfffc::I16 - indexOffset = x - (-5); // == 1::I16 - indexExpr = UU_Conv(indexOffset); // == 1::I64 - -See #21186. --} - -genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock - -genSwitch expr targets = do - config <- getConfig - let platform = ncgPlatform config - expr_w = cmmExprWidth platform expr - indexExpr0 = cmmOffset platform expr offset - -- We widen to a native-width register because we cannot use arbitrary sizes - -- in x86 addressing modes. - -- See Note [Sub-word subtlety during jump-table indexing]. - indexExpr = CmmMachOp - (MO_UU_Conv expr_w (platformWordWidth platform)) - [indexExpr0] - if ncgPIC config - then do - (reg,e_code) <- getNonClobberedReg indexExpr - -- getNonClobberedReg because it needs to survive across t_code - lbl <- getNewLabelNat - let is32bit = target32Bit platform - os = platformOS platform - -- Might want to use .rodata. instead, but as - -- long as it's something unique it'll work out since the - -- references to the jump table are in the appropriate section. - rosection = case os of - -- on Mac OS X/x86_64, put the jump table in the text section to - -- work around a limitation of the linker. - -- ld64 is unable to handle the relocations for - -- .quad L1 - L0 - -- if L0 is not preceded by a non-anonymous label in its section. - OSDarwin | not is32bit -> Section Text lbl - _ -> Section ReadOnlyData lbl - dynRef <- cmmMakeDynamicReference config DataReference lbl - (tableReg,t_code) <- getSomeReg $ dynRef - let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) - (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) - - return $ e_code `appOL` t_code `appOL` toOL [ - ADD (intFormat (platformWordWidth platform)) op (OpReg tableReg), - JMP_TBL (OpReg tableReg) ids rosection lbl - ] - else do - (reg,e_code) <- getSomeReg indexExpr - lbl <- getNewLabelNat - let is32bit = target32Bit platform - if is32bit - then let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl lbl)) - jmp_code = JMP_TBL op ids (Section ReadOnlyData lbl) lbl - in return $ e_code `appOL` unitOL jmp_code - else do - -- See Note [%rip-relative addressing on x86-64]. - tableReg <- getNewRegNat (intFormat (platformWordWidth platform)) - targetReg <- getNewRegNat (intFormat (platformWordWidth platform)) - let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) - fmt = archWordFormat is32bit - code = e_code `appOL` toOL - [ LEA fmt (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl lbl))) (OpReg tableReg) - , MOV fmt op (OpReg targetReg) - , JMP_TBL (OpReg targetReg) ids (Section ReadOnlyData lbl) lbl - ] - return code - where - (offset, blockIds) = switchTargetsToTable targets - ids = map (fmap DestBlockId) blockIds - -generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr) -generateJumpTableForInstr config (JMP_TBL _ ids section lbl) - = let getBlockId (DestBlockId id) = id - getBlockId _ = panic "Non-Label target in Jump Table" - blockIds = map (fmap getBlockId) ids - in Just (createJumpTable config blockIds section lbl) -generateJumpTableForInstr _ _ = Nothing - -createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel - -> GenCmmDecl (Alignment, RawCmmStatics) h g -createJumpTable config ids section lbl - = let jumpTable - | ncgPIC config = - let ww = ncgWordWidth config - jumpTableEntryRel Nothing - = CmmStaticLit (CmmInt 0 ww) - jumpTableEntryRel (Just blockid) - = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0 ww) - where blockLabel = blockLbl blockid - in map jumpTableEntryRel ids - | otherwise = map (jumpTableEntry config) ids - in CmmData section (mkAlignment 1, CmmStaticsRaw lbl jumpTable) - -extractUnwindPoints :: [Instr] -> [UnwindPoint] -extractUnwindPoints instrs = - [ UnwindPoint lbl unwinds | UNWIND lbl unwinds <- instrs] - --- ----------------------------------------------------------------------------- --- 'condIntReg' and 'condFltReg': condition codes into registers - --- Turn those condition codes into integers now (when they appear on --- the right hand side of an assignment). --- --- (If applicable) Do not fill the delay slots here; you will confuse the --- register allocator. - -condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register - -condIntReg cond x y = do - CondCode _ cond cond_code <- condIntCode cond x y - tmp <- getNewRegNat II8 - let - code dst = cond_code `appOL` toOL [ - SETCC cond (OpReg tmp), - MOVZxL II8 (OpReg tmp) (OpReg dst) - ] - return (Any II32 code) - - --- Note [SSE Parity Checks] --- ~~~~~~~~~~~~~~~~~~~~~~~~ --- We have to worry about unordered operands (eg. comparisons --- against NaN). If the operands are unordered, the comparison --- sets the parity flag, carry flag and zero flag. --- All comparisons are supposed to return false for unordered --- operands except for !=, which returns true. --- --- Optimisation: we don't have to test the parity flag if we --- know the test has already excluded the unordered case: eg > --- and >= test for a zero carry flag, which can only occur for --- ordered operands. --- --- By reversing comparisons we can avoid testing the parity --- for < and <= as well. If any of the arguments is an NaN we --- return false either way. If both arguments are valid then --- x <= y <-> y >= x holds. So it's safe to swap these. --- --- We invert the condition inside getRegister'and getCondCode --- which should cover all invertable cases. --- All other functions translating FP comparisons to assembly --- use these to two generate the comparison code. --- --- As an example consider a simple check: --- --- func :: Float -> Float -> Int --- func x y = if x < y then 1 else 0 --- --- Which in Cmm gives the floating point comparison. --- --- if (%MO_F_Lt_W32(F1, F2)) goto c2gg; else goto c2gf; --- --- We used to compile this to an assembly code block like this: --- _c2gh: --- ucomiss %xmm2,%xmm1 --- jp _c2gf --- jb _c2gg --- jmp _c2gf --- --- Where we have to introduce an explicit --- check for unordered results (using jmp parity): --- --- We can avoid this by exchanging the arguments and inverting the direction --- of the comparison. This results in the sequence of: --- --- ucomiss %xmm1,%xmm2 --- ja _c2g2 --- jmp _c2g1 --- --- Removing the jump reduces the pressure on the branch prediction system --- and plays better with the uOP cache. - -condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register -condFltReg is32Bit cond x y = condFltReg_sse2 - where - - - condFltReg_sse2 = do - CondCode _ cond cond_code <- condFltCode cond x y - tmp1 <- getNewRegNat (archWordFormat is32Bit) - tmp2 <- getNewRegNat (archWordFormat is32Bit) - let -- See Note [SSE Parity Checks] - code dst = - cond_code `appOL` - (case cond of - NE -> or_unordered dst - GU -> plain_test dst - GEU -> plain_test dst - -- Use ASSERT so we don't break releases if these creep in. - LTT -> assertPpr False (text "Should have been turned into >") $ - and_ordered dst - LE -> assertPpr False (text "Should have been turned into >=") $ - and_ordered dst - _ -> and_ordered dst) - - plain_test dst = toOL [ - SETCC cond (OpReg tmp1), - MOVZxL II8 (OpReg tmp1) (OpReg dst) - ] - or_unordered dst = toOL [ - SETCC cond (OpReg tmp1), - SETCC PARITY (OpReg tmp2), - OR II8 (OpReg tmp1) (OpReg tmp2), - MOVZxL II8 (OpReg tmp2) (OpReg dst) - ] - and_ordered dst = toOL [ - SETCC cond (OpReg tmp1), - SETCC NOTPARITY (OpReg tmp2), - AND II8 (OpReg tmp1) (OpReg tmp2), - MOVZxL II8 (OpReg tmp2) (OpReg dst) - ] - return (Any II32 code) - - --- ----------------------------------------------------------------------------- --- 'trivial*Code': deal with trivial instructions - --- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode', --- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions. --- Only look for constants on the right hand side, because that's --- where the generic optimizer will have put them. - --- Similarly, for unary instructions, we don't have to worry about --- matching an StInt as the argument, because genericOpt will already --- have handled the constant-folding. - - -{- -The Rules of the Game are: - -* You cannot assume anything about the destination register dst; - it may be anything, including a fixed reg. - -* You may compute an operand into a fixed reg, but you may not - subsequently change the contents of that fixed reg. If you - want to do so, first copy the value either to a temporary - or into dst. You are free to modify dst even if it happens - to be a fixed reg -- that's not your problem. - -* You cannot assume that a fixed reg will stay live over an - arbitrary computation. The same applies to the dst reg. - -* Temporary regs obtained from getNewRegNat are distinct from - each other and from all other regs, and stay live over - arbitrary computations. - --------------------- - -SDM's version of The Rules: - -* If getRegister returns Any, that means it can generate correct - code which places the result in any register, period. Even if that - register happens to be read during the computation. - - Corollary #1: this means that if you are generating code for an - operation with two arbitrary operands, you cannot assign the result - of the first operand into the destination register before computing - the second operand. The second operand might require the old value - of the destination register. - - Corollary #2: A function might be able to generate more efficient - code if it knows the destination register is a new temporary (and - therefore not read by any of the sub-computations). - -* If getRegister returns Any, then the code it generates may modify only: - (a) fresh temporaries - (b) the destination register - (c) known registers (eg. %ecx is used by shifts) - In particular, it may *not* modify global registers, unless the global - register happens to be the destination register. --} - -trivialCode :: Width -> (Operand -> Operand -> Instr) - -> Maybe (Operand -> Operand -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register -trivialCode width instr m a b - = do platform <- getPlatform - trivialCode' platform width instr m a b - -trivialCode' :: Platform -> Width -> (Operand -> Operand -> Instr) - -> Maybe (Operand -> Operand -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register -trivialCode' platform width _ (Just revinstr) (CmmLit lit_a) b - | is32BitLit platform lit_a = do - b_code <- getAnyReg b - let - code dst - = b_code dst `snocOL` - revinstr (OpImm (litToImm lit_a)) (OpReg dst) - return (Any (intFormat width) code) - -trivialCode' _ width instr _ a b - = genTrivialCode (intFormat width) instr a b - --- This is re-used for floating pt instructions too. -genTrivialCode :: Format -> (Operand -> Operand -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register -genTrivialCode rep instr a b = do - (b_op, b_code) <- getNonClobberedOperand b - a_code <- getAnyReg a - tmp <- getNewRegNat rep - let - -- We want the value of 'b' to stay alive across the computation of 'a'. - -- But, we want to calculate 'a' straight into the destination register, - -- because the instruction only has two operands (dst := dst `op` src). - -- The troublesome case is when the result of 'b' is in the same register - -- as the destination 'reg'. In this case, we have to save 'b' in a - -- new temporary across the computation of 'a'. - code dst - | dst `regClashesWithOp` b_op = - b_code `appOL` - unitOL (MOV rep b_op (OpReg tmp)) `appOL` - a_code dst `snocOL` - instr (OpReg tmp) (OpReg dst) - | otherwise = - b_code `appOL` - a_code dst `snocOL` - instr b_op (OpReg dst) - return (Any rep code) - -regClashesWithOp :: Reg -> Operand -> Bool -reg `regClashesWithOp` OpReg reg2 = reg == reg2 -reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode) -_ `regClashesWithOp` _ = False - --- | Generate code for a fused multiply-add operation, of the form @± x * y ± z@, --- with 3 operands (FMA3 instruction set). -genFMA3Code :: Length - -> Width - -> FMASign - -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register -genFMA3Code l w signs x y z = do - config <- getConfig - -- For the FMA instruction, we want to compute x * y + z - -- - -- There are three possible instructions we could emit: - -- - -- - fmadd213 z y x, result in x, z can be a memory address - -- - fmadd132 x z y, result in y, x can be a memory address - -- - fmadd231 y x z, result in z, y can be a memory address - -- - -- This suggests two possible optimisations: - -- - -- - OPTIMISATION 1 - -- If one argument is an address, use the instruction that allows - -- a memory address in that position. - -- - -- - OPTIMISATION 2 - -- If one argument is in a fixed register, use the instruction that puts - -- the result in that same register. - -- - -- Currently we follow neither of these optimisations, - -- opting to always use fmadd213 for simplicity. - -- - -- We would like to compute the result directly into the requested register. - -- To do so we must first compute `x` into the destination register. This is - -- only possible if the other arguments don't use the destination register. - -- We check for this and if there is a conflict we move the result only after - -- the computation. See #24496 how this went wrong in the past. - let rep - | l == 1 - = floatFormat w - | otherwise - = vecFormat (cmmVec l $ cmmFloat w) - (y_reg, y_code) <- getNonClobberedReg y - (z_op, z_code) <- getNonClobberedOperand z - x_code <- getAnyReg x - x_tmp <- getNewRegNat rep - let - fma213 = FMA3 rep signs FMA213 - - code, code_direct, code_mov :: Reg -> InstrBlock - -- Ideal: Compute the result directly into dst - code_direct dst = x_code dst `snocOL` - fma213 z_op y_reg dst - -- Fallback: Compute the result into a tmp reg and then move it. - code_mov dst = x_code x_tmp `snocOL` - fma213 z_op y_reg x_tmp `snocOL` - mkRegRegMoveInstr config rep x_tmp dst - - code dst = - y_code `appOL` - z_code `appOL` - ( if arg_regs_conflict then code_mov dst else code_direct dst ) - - where - - arg_regs_conflict = - y_reg == dst || - case z_op of - OpReg z_reg -> z_reg == dst - OpAddr amode -> dst `elem` addrModeRegs amode - OpImm {} -> False - - -- NB: Computing the result into a desired register using Any can be tricky. - -- So for now, we keep it simple. (See #24496). - return (Any rep code) - ------------ - -trivialUCode :: Format -> (Operand -> Instr) - -> CmmExpr -> NatM Register -trivialUCode rep instr x = do - x_code <- getAnyReg x - let - code dst = - x_code dst `snocOL` - instr (OpReg dst) - return (Any rep code) - ------------ - - -trivialFCode_sse2 :: Width -> (Format -> Operand -> Operand -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register -trivialFCode_sse2 ty instr x y - = genTrivialCode format (instr format) x y - where format = floatFormat ty - - --------------------------------------------------------------------------------- -coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register -coerceInt2FP from to x = coerce_sse2 - where - - coerce_sse2 = do - (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand - let - opc = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD - n -> panic $ "coerceInt2FP.sse: unhandled width (" - ++ show n ++ ")" - code dst = x_code `snocOL` opc (intFormat from) x_op dst - return (Any (floatFormat to) code) - -- works even if the destination rep is Width -> CmmExpr -> NatM Register -coerceFP2Int from to x = coerceFP2Int_sse2 - where - coerceFP2Int_sse2 = do - (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand - let - opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ; - n -> panic $ "coerceFP2Init.sse: unhandled width (" - ++ show n ++ ")" - code dst = x_code `snocOL` opc (intFormat to) x_op dst - return (Any (intFormat to) code) - -- works even if the destination rep is CmmExpr -> NatM Register -coerceFP2FP to x = do - (x_reg, x_code) <- getSomeReg x - let - opc = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD; - n -> panic $ "coerceFP2FP: unhandled width (" - ++ show n ++ ")" - code dst = x_code `snocOL` opc x_reg dst - return (Any ( floatFormat to) code) - --------------------------------------------------------------------------------- - -sse2NegCode :: Width -> CmmExpr -> NatM Register -sse2NegCode w x = do - let fmt = floatFormat w - x_code <- getAnyReg x - -- This is how gcc does it, so it can't be that bad: - let - const = case fmt of - FF32 -> CmmInt 0x80000000 W32 - FF64 -> CmmInt 0x8000000000000000 W64 - x@II8 -> wrongFmt x - x@II16 -> wrongFmt x - x@II32 -> wrongFmt x - x@II64 -> wrongFmt x - x@(VecFormat {}) -> wrongFmt x - - where - wrongFmt x = panic $ "sse2NegCode: " ++ show x - Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const - tmp <- getNewRegNat fmt - let - code dst = x_code dst `appOL` amode_code `appOL` toOL [ - MOV fmt (OpAddr amode) (OpReg tmp), - XOR fmt (OpReg tmp) (OpReg dst) - ] - -- - return (Any fmt code) - -needLlvm :: MachOp -> NatM a -needLlvm mop = - sorry $ unlines [ "Unsupported vector instruction for the native code generator:" - , show mop - , "Please use -fllvm." ] - -incorrectOperands :: NatM a -incorrectOperands = sorry "Incorrect number of operands" - -invalidConversion :: Width -> Width -> NatM a -invalidConversion from to = - sorry $ "Invalid conversion operation from " ++ show from ++ " to " ++ show to - --- | This works on the invariant that all jumps in the given blocks are required. --- Starting from there we try to make a few more jumps redundant by reordering --- them. --- We depend on the information in the CFG to do so so without a given CFG --- we do nothing. -invertCondBranches :: Maybe CFG -- ^ CFG if present - -> LabelMap a -- ^ Blocks with info tables - -> [NatBasicBlock Instr] -- ^ List of basic blocks - -> [NatBasicBlock Instr] -invertCondBranches Nothing _ bs = bs -invertCondBranches (Just cfg) keep bs = - invert bs - where - invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr] - invert (BasicBlock lbl1 ins:b2@(BasicBlock lbl2 _):bs) - | --pprTrace "Block" (ppr lbl1) True, - Just (jmp1,jmp2) <- last2 ins - , JXX cond1 target1 <- jmp1 - , target1 == lbl2 - --, pprTrace "CutChance" (ppr b1) True - , JXX ALWAYS target2 <- jmp2 - -- We have enough information to check if we can perform the inversion - -- TODO: We could also check for the last asm instruction which sets - -- status flags instead. Which I suspect is worse in terms of compiler - -- performance, but might be applicable to more cases - , Just edgeInfo1 <- getEdgeInfo lbl1 target1 cfg - , Just edgeInfo2 <- getEdgeInfo lbl1 target2 cfg - -- Both jumps come from the same cmm statement - , transitionSource edgeInfo1 == transitionSource edgeInfo2 - , CmmSource {trans_cmmNode = cmmCondBranch} <- transitionSource edgeInfo1 - - --Int comparisons are invertable - , CmmCondBranch (CmmMachOp op _args) _ _ _ <- cmmCondBranch - , Just _ <- maybeIntComparison op - , Just invCond <- maybeInvertCond cond1 - - --Swap the last two jumps, invert the conditional jumps condition. - = let jumps = - case () of - -- We are free the eliminate the jmp. So we do so. - _ | not (mapMember target1 keep) - -> [JXX invCond target2] - -- If the conditional target is unlikely we put the other - -- target at the front. - | edgeWeight edgeInfo2 > edgeWeight edgeInfo1 - -> [JXX invCond target2, JXX ALWAYS target1] - -- Keep things as-is otherwise - | otherwise - -> [jmp1, jmp2] - in --pprTrace "Cutable" (ppr [jmp1,jmp2] <+> text "=>" <+> ppr jumps) $ - (BasicBlock lbl1 - (dropTail 2 ins ++ jumps)) - : invert (b2:bs) - invert (b:bs) = b : invert bs - invert [] = [] - -genAtomicRMW - :: BlockId - -> Width - -> AtomicMachOp - -> LocalReg - -> CmmExpr - -> CmmExpr - -> NatM (InstrBlock, Maybe BlockId) -genAtomicRMW bid width amop dst addr n = do - Amode amode addr_code <- - if amop `elem` [AMO_Add, AMO_Sub] - then getAmode addr - else getSimpleAmode addr -- See genForeignCall for MO_Cmpxchg - arg <- getNewRegNat format - arg_code <- getAnyReg n - platform <- ncgPlatform <$> getConfig - - let dst_r = getRegisterReg platform (CmmLocal dst) - (code, lbl) <- op_code dst_r arg amode - return (addr_code `appOL` arg_code arg `appOL` code, Just lbl) - where - -- Code for the operation - op_code :: Reg -- Destination reg - -> Reg -- Register containing argument - -> AddrMode -- Address of location to mutate - -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId - op_code dst_r arg amode = do - case amop of - -- In the common case where dst_r is a virtual register the - -- final move should go away, because it's the last use of arg - -- and the first use of dst_r. - AMO_Add -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode)) - , MOV format (OpReg arg) (OpReg dst_r) - ], bid) - AMO_Sub -> return $ (toOL [ NEGI format (OpReg arg) - , LOCK (XADD format (OpReg arg) (OpAddr amode)) - , MOV format (OpReg arg) (OpReg dst_r) - ], bid) - -- In these cases we need a new block id, and have to return it so - -- that later instruction selection can reference it. - AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst) - AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst - , NOT format dst - ]) - AMO_Or -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst) - AMO_Xor -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst) - where - -- Simulate operation that lacks a dedicated instruction using - -- cmpxchg. - cmpxchg_code :: (Operand -> Operand -> OrdList Instr) - -> NatM (OrdList Instr, BlockId) - cmpxchg_code instrs = do - lbl1 <- getBlockIdNat - lbl2 <- getBlockIdNat - tmp <- getNewRegNat format - - --Record inserted blocks - -- We turn A -> B into A -> A' -> A'' -> B - -- with a self loop on A'. - addImmediateSuccessorNat bid lbl1 - addImmediateSuccessorNat lbl1 lbl2 - updateCfgNat (addWeightEdge lbl1 lbl1 0) - - return $ (toOL - [ MOV format (OpAddr amode) (OpReg eax) - , JXX ALWAYS lbl1 - , NEWBLOCK lbl1 - -- Keep old value so we can return it: - , MOV format (OpReg eax) (OpReg dst_r) - , MOV format (OpReg eax) (OpReg tmp) - ] - `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL - [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode)) - , JXX NE lbl1 - -- See Note [Introducing cfg edges inside basic blocks] - -- why this basic block is required. - , JXX ALWAYS lbl2 - , NEWBLOCK lbl2 - ], - lbl2) - format = intFormat width - --- | Count trailing zeroes -genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId) -genCtz bid width dst src = do - is32Bit <- is32BitPlatform - if is32Bit && width == W64 - then genCtz64_32 bid dst src - else (,Nothing) <$> genCtzGeneric width dst src - --- | Count trailing zeroes --- --- 64-bit width on 32-bit architecture -genCtz64_32 - :: BlockId - -> LocalReg - -> CmmExpr - -> NatM (InstrBlock, Maybe BlockId) -genCtz64_32 bid dst src = do - RegCode64 vcode rhi rlo <- iselExpr64 src - let dst_r = getLocalRegReg dst - lbl1 <- getBlockIdNat - lbl2 <- getBlockIdNat - tmp_r <- getNewRegNat II64 - - -- New CFG Edges: - -- bid -> lbl2 - -- bid -> lbl1 -> lbl2 - -- We also changes edges originating at bid to start at lbl2 instead. - weights <- getCfgWeights - updateCfgNat (addWeightEdge bid lbl1 110 . - addWeightEdge lbl1 lbl2 110 . - addImmediateSuccessor weights bid lbl2) - - -- The following instruction sequence corresponds to the pseudo-code - -- - -- if (src) { - -- dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32); - -- } else { - -- dst = 64; - -- } - let instrs = vcode `appOL` toOL - ([ MOV II32 (OpReg rhi) (OpReg tmp_r) - , OR II32 (OpReg rlo) (OpReg tmp_r) - , MOV II32 (OpImm (ImmInt 64)) (OpReg dst_r) - , JXX EQQ lbl2 - , JXX ALWAYS lbl1 - - , NEWBLOCK lbl1 - , BSF II32 (OpReg rhi) dst_r - , ADD II32 (OpImm (ImmInt 32)) (OpReg dst_r) - , BSF II32 (OpReg rlo) tmp_r - , CMOV NE II32 (OpReg tmp_r) dst_r - , JXX ALWAYS lbl2 - - , NEWBLOCK lbl2 - ]) - return (instrs, Just lbl2) - --- | Count trailing zeroes --- --- Generic case (width <= word size) -genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock -genCtzGeneric width dst src = do - code_src <- getAnyReg src - config <- getConfig - let bw = widthInBits width - let dst_r = getLocalRegReg dst - if ncgBmiVersion config >= Just BMI2 - then do - src_r <- getNewRegNat (intFormat width) - let instrs = appOL (code_src src_r) $ case width of - W8 -> toOL - [ OR II32 (OpImm (ImmInteger 0xFFFFFF00)) (OpReg src_r) - , TZCNT II32 (OpReg src_r) dst_r - ] - W16 -> toOL - [ TZCNT II16 (OpReg src_r) dst_r - , MOVZxL II16 (OpReg dst_r) (OpReg dst_r) - ] - _ -> unitOL $ TZCNT (intFormat width) (OpReg src_r) dst_r - return instrs - else do - -- The following insn sequence makes sure 'ctz 0' has a defined value. - -- starting with Haswell, one could use the TZCNT insn instead. - let format = if width == W8 then II16 else intFormat width - src_r <- getNewRegNat format - tmp_r <- getNewRegNat format - let instrs = code_src src_r `appOL` toOL - ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ - [ BSF format (OpReg src_r) tmp_r - , MOV II32 (OpImm (ImmInt bw)) (OpReg dst_r) - , CMOV NE format (OpReg tmp_r) dst_r - ]) -- NB: We don't need to zero-extend the result for the - -- W8/W16 cases because the 'MOV' insn already - -- took care of implicitly clearing the upper bits - return instrs - - - --- | Copy memory --- --- Unroll memcpy calls if the number of bytes to copy isn't too large (cf --- ncgInlineThresholdMemcpy). Otherwise, call C's memcpy. -genMemCpy - :: BlockId - -> Int - -> CmmExpr - -> CmmExpr - -> CmmExpr - -> NatM InstrBlock -genMemCpy bid align dst src arg_n = do - - let libc_memcpy = genLibCCall bid (fsLit "memcpy") [] [dst,src,arg_n] - - case arg_n of - CmmLit (CmmInt n _) -> do - -- try to inline it - mcode <- genMemCpyInlineMaybe align dst src n - -- if it didn't inline, call the C function - case mcode of - Nothing -> libc_memcpy - Just c -> pure c - - -- not a literal size argument: call the C function - _ -> libc_memcpy - - - -genMemCpyInlineMaybe - :: Int - -> CmmExpr - -> CmmExpr - -> Integer - -> NatM (Maybe InstrBlock) -genMemCpyInlineMaybe align dst src n = do - config <- getConfig - let - platform = ncgPlatform config - maxAlignment = wordAlignment platform - -- only machine word wide MOVs are supported - effectiveAlignment = min (alignmentOf align) maxAlignment - format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment - - - -- The size of each move, in bytes. - let sizeBytes :: Integer - sizeBytes = fromIntegral (formatInBytes format) - - -- The number of instructions we will generate (approx). We need 2 - -- instructions per move. - let insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes) - - go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr - go dst src tmp i - | i >= sizeBytes = - unitOL (MOV format (OpAddr src_addr) (OpReg tmp)) `appOL` - unitOL (MOV format (OpReg tmp) (OpAddr dst_addr)) `appOL` - go dst src tmp (i - sizeBytes) - -- Deal with remaining bytes. - | i >= 4 = -- Will never happen on 32-bit - unitOL (MOV II32 (OpAddr src_addr) (OpReg tmp)) `appOL` - unitOL (MOV II32 (OpReg tmp) (OpAddr dst_addr)) `appOL` - go dst src tmp (i - 4) - | i >= 2 = - unitOL (MOVZxL II16 (OpAddr src_addr) (OpReg tmp)) `appOL` - unitOL (MOV II16 (OpReg tmp) (OpAddr dst_addr)) `appOL` - go dst src tmp (i - 2) - | i >= 1 = - unitOL (MOVZxL II8 (OpAddr src_addr) (OpReg tmp)) `appOL` - unitOL (MOV II8 (OpReg tmp) (OpAddr dst_addr)) `appOL` - go dst src tmp (i - 1) - | otherwise = nilOL - where - src_addr = AddrBaseIndex (EABaseReg src) EAIndexNone - (ImmInteger (n - i)) - - dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone - (ImmInteger (n - i)) - - if insns > fromIntegral (ncgInlineThresholdMemcpy config) - then pure Nothing - else do - code_dst <- getAnyReg dst - dst_r <- getNewRegNat format - code_src <- getAnyReg src - src_r <- getNewRegNat format - tmp_r <- getNewRegNat format - pure $ Just $ code_dst dst_r `appOL` code_src src_r `appOL` - go dst_r src_r tmp_r (fromInteger n) - --- | Set memory to the given byte --- --- Unroll memset calls if the number of bytes to copy isn't too large (cf --- ncgInlineThresholdMemset). Otherwise, call C's memset. -genMemSet - :: BlockId - -> Int - -> CmmExpr - -> CmmExpr - -> CmmExpr - -> NatM InstrBlock -genMemSet bid align dst arg_c arg_n = do - - let libc_memset = genLibCCall bid (fsLit "memset") [] [dst,arg_c,arg_n] - - case (arg_c,arg_n) of - (CmmLit (CmmInt c _), CmmLit (CmmInt n _)) -> do - -- try to inline it - mcode <- genMemSetInlineMaybe align dst c n - -- if it didn't inline, call the C function - case mcode of - Nothing -> libc_memset - Just c -> pure c - - -- not literal size arguments: call the C function - _ -> libc_memset - -genMemSetInlineMaybe - :: Int - -> CmmExpr - -> Integer - -> Integer - -> NatM (Maybe InstrBlock) -genMemSetInlineMaybe align dst c n = do - config <- getConfig - let - platform = ncgPlatform config - maxAlignment = wordAlignment platform -- only machine word wide MOVs are supported - effectiveAlignment = min (alignmentOf align) maxAlignment - format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment - c2 = c `shiftL` 8 .|. c - c4 = c2 `shiftL` 16 .|. c2 - c8 = c4 `shiftL` 32 .|. c4 - - -- The number of instructions we will generate (approx). We need 1 - -- instructions per move. - insns = (n + sizeBytes - 1) `div` sizeBytes - - -- The size of each move, in bytes. - sizeBytes :: Integer - sizeBytes = fromIntegral (formatInBytes format) - - -- Depending on size returns the widest MOV instruction and its - -- width. - gen4 :: AddrMode -> Integer -> (InstrBlock, Integer) - gen4 addr size - | size >= 4 = - (unitOL (MOV II32 (OpImm (ImmInteger c4)) (OpAddr addr)), 4) - | size >= 2 = - (unitOL (MOV II16 (OpImm (ImmInteger c2)) (OpAddr addr)), 2) - | size >= 1 = - (unitOL (MOV II8 (OpImm (ImmInteger c)) (OpAddr addr)), 1) - | otherwise = (nilOL, 0) - - -- Generates a 64-bit wide MOV instruction from REG to MEM. - gen8 :: AddrMode -> Reg -> InstrBlock - gen8 addr reg8byte = - unitOL (MOV format (OpReg reg8byte) (OpAddr addr)) - - -- Unrolls memset when the widest MOV is <= 4 bytes. - go4 :: Reg -> Integer -> InstrBlock - go4 dst left = - if left <= 0 then nilOL - else curMov `appOL` go4 dst (left - curWidth) - where - possibleWidth = minimum [left, sizeBytes] - dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone (ImmInteger (n - left)) - (curMov, curWidth) = gen4 dst_addr possibleWidth - - -- Unrolls memset when the widest MOV is 8 bytes (thus another Reg - -- argument). Falls back to go4 when all 8 byte moves are - -- exhausted. - go8 :: Reg -> Reg -> Integer -> InstrBlock - go8 dst reg8byte left = - if possibleWidth >= 8 then - let curMov = gen8 dst_addr reg8byte - in curMov `appOL` go8 dst reg8byte (left - 8) - else go4 dst left - where - possibleWidth = minimum [left, sizeBytes] +----------------------------------------------------------------------------- +-- +-- Generating machine code (instruction selection) +-- +-- (c) The University of Glasgow 1996-2004 +-- +----------------------------------------------------------------------------- + +-- This is a big module, but, if you pay attention to +-- (a) the sectioning, and (b) the type signatures, the +-- structure should not be too overwhelming. + +module GHC.CmmToAsm.X86.CodeGen ( + cmmTopCodeGen, + generateJumpTableForInstr, + extractUnwindPoints, + invertCondBranches, + InstrBlock +) + +where + +-- NCG stuff: +import GHC.Prelude + +import GHC.CmmToAsm.X86.Instr +import GHC.CmmToAsm.X86.Cond +import GHC.CmmToAsm.X86.Regs +import GHC.CmmToAsm.X86.Ppr +import GHC.CmmToAsm.X86.RegInfo + +import GHC.Platform.Regs +import GHC.CmmToAsm.CPrim +import GHC.CmmToAsm.Types +import GHC.Cmm.DebugBlock + ( DebugBlock(..), UnwindPoint(..), UnwindTable + , UnwindExpr(UwReg), toUnwindExpr + ) +import GHC.CmmToAsm.PIC +import GHC.CmmToAsm.Monad + ( NatM, getNewRegNat, getNewLabelNat, setDeltaNat + , getDeltaNat, getBlockIdNat, getPicBaseNat + , Reg64(..), RegCode64(..), getNewReg64, localReg64 + , getPicBaseMaybeNat, getDebugBlock, getFileId + , addImmediateSuccessorNat, updateCfgNat, getConfig, getPlatform + , getCfgWeights + ) +import GHC.CmmToAsm.CFG +import GHC.CmmToAsm.Format +import GHC.CmmToAsm.Config +import GHC.Platform.Reg +import GHC.Platform + +-- Our intermediate code: +import GHC.Types.Basic +import GHC.Cmm.BlockId +import GHC.Unit.Types ( ghcInternalUnitId ) +import GHC.Cmm.Utils +import GHC.Cmm.Switch +import GHC.Cmm +import GHC.Cmm.Dataflow.Block +import GHC.Cmm.Dataflow.Graph +import GHC.Cmm.Dataflow.Label +import GHC.Cmm.CLabel +import GHC.Types.Tickish ( GenTickish(..) ) +import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol ) + +-- The rest: +import GHC.Data.Maybe ( expectJust ) +import GHC.Types.ForeignCall ( CCallConv(..) ) +import GHC.Data.OrdList +import GHC.Utils.Outputable +import GHC.Utils.Constants (debugIsOn) +import GHC.Utils.Monad ( foldMapM ) +import GHC.Utils.Panic +import GHC.Data.FastString +import GHC.Utils.Misc +import GHC.Types.Unique.DSM ( getUniqueM ) + +import qualified Data.Semigroup as S + +import Control.Monad +import Control.Monad.Trans.State.Strict + ( StateT, evalStateT, get, put ) +import Control.Monad.Trans.Class (lift) +import Data.Foldable (fold) +import Data.Int +import Data.List (partition, (\\)) +import Data.Maybe +import Data.Word + +import qualified Data.Map as Map + +is32BitPlatform :: NatM Bool +is32BitPlatform = do + platform <- getPlatform + return $ target32Bit platform + +ssse3Enabled :: NatM Bool +ssse3Enabled = do + config <- getConfig + return (ncgSseVersion config >= Just SSSE3) + +sse4_1Enabled :: NatM Bool +sse4_1Enabled = do + config <- getConfig + return (ncgSseVersion config >= Just SSE4) + +sse4_2Enabled :: NatM Bool +sse4_2Enabled = do + config <- getConfig + return (ncgSseVersion config >= Just SSE42) + +avxEnabled :: NatM Bool +avxEnabled = do + config <- getConfig + return (ncgAvxEnabled config) + +avx2Enabled :: NatM Bool +avx2Enabled = do + config <- getConfig + return (ncgAvx2Enabled config) + +cmmTopCodeGen + :: RawCmmDecl + -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr] + +cmmTopCodeGen (CmmProc info lab live graph) = do + let blocks = toBlockListEntryFirst graph + (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks + picBaseMb <- getPicBaseMaybeNat + platform <- getPlatform + let proc = CmmProc info lab live (ListGraph $ concat nat_blocks) + tops = proc : concat statics + os = platformOS platform + + case picBaseMb of + Just picBase -> initializePicBase_x86 os picBase tops + Nothing -> return tops + +cmmTopCodeGen (CmmData sec dat) = + return [CmmData sec (mkAlignment 1, dat)] -- no translation, we just use CmmStatic + +{- Note [Verifying basic blocks] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + We want to guarantee a few things about the results + of instruction selection. + + Namely that each basic blocks consists of: + * A (potentially empty) sequence of straight line instructions + followed by + * A (potentially empty) sequence of jump like instructions. + + We can verify this by going through the instructions and + making sure that any non-jumpish instruction can't appear + after a jumpish instruction. + + There are gotchas however: + * CALLs are strictly speaking control flow but here we care + not about them. Hence we treat them as regular instructions. + + It's safe for them to appear inside a basic block + as (ignoring side effects inside the call) they will result in + straight line code. + + * NEWBLOCK marks the start of a new basic block so can + be followed by any instructions. +-} + +-- Verifying basic blocks is cheap, but not cheap enough to enable it unconditionally. +verifyBasicBlock :: Platform -> [Instr] -> () +verifyBasicBlock platform instrs + | debugIsOn = go False instrs + | otherwise = () + where + go _ [] = () + go atEnd (i:instr) + = case i of + -- Start a new basic block + NEWBLOCK {} -> go False instr + -- Calls are not viable block terminators + CALL {} | atEnd -> faultyBlockWith i + | not atEnd -> go atEnd instr + -- All instructions ok, check if we reached the end and continue. + _ | not atEnd -> go (isJumpishInstr i) instr + -- Only jumps allowed at the end of basic blocks. + | otherwise -> if isJumpishInstr i + then go True instr + else faultyBlockWith i + faultyBlockWith i + = pprPanic "Non control flow instructions after end of basic block." + (pprInstr platform i <+> text "in:" $$ vcat (map (pprInstr platform) instrs)) + +basicBlockCodeGen + :: CmmBlock + -> NatM ( [NatBasicBlock Instr] + , [NatCmmDecl (Alignment, RawCmmStatics) Instr]) + +basicBlockCodeGen block = do + let (_, nodes, tail) = blockSplit block + id = entryLabel block + stmts = blockToList nodes + -- Generate location directive + dbg <- getDebugBlock (entryLabel block) + loc_instrs <- case dblSourceTick =<< dbg of + Just (SourceNote span (LexicalFastString name)) + -> do fileId <- getFileId (srcSpanFile span) + let line = srcSpanStartLine span; col = srcSpanStartCol span + return $ unitOL $ LOCATION fileId line col (unpackFS name) + _ -> return nilOL + (mid_instrs,mid_bid) <- stmtsToInstrs id stmts + (!tail_instrs,_) <- stmtToInstrs mid_bid tail + let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs + platform <- getPlatform + return $! verifyBasicBlock platform (fromOL instrs) + instrs' <- fold <$> traverse addSpUnwindings instrs + -- code generation may introduce new basic block boundaries, which + -- are indicated by the NEWBLOCK instruction. We must split up the + -- instruction stream into basic blocks again. Also, we extract + -- LDATAs here too. + let + (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs' + + mkBlocks (NEWBLOCK id) (instrs,blocks,statics) + = ([], BasicBlock id instrs : blocks, statics) + mkBlocks (LDATA sec dat) (instrs,blocks,statics) + = (instrs, blocks, CmmData sec dat:statics) + mkBlocks instr (instrs,blocks,statics) + = (instr:instrs, blocks, statics) + return (BasicBlock id top : other_blocks, statics) + +-- | Convert 'DELTA' instructions into 'UNWIND' instructions to capture changes +-- in the @sp@ register. See Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock" +-- for details. +addSpUnwindings :: Instr -> NatM (OrdList Instr) +addSpUnwindings instr@(DELTA d) = do + config <- getConfig + let platform = ncgPlatform config + if ncgDwarfUnwindings config + then do lbl <- mkAsmTempLabel <$> getUniqueM + let unwind = Map.singleton MachSp (Just $ UwReg (GlobalRegUse MachSp (bWord platform)) $ negate d) + return $ toOL [ instr, UNWIND lbl unwind ] + else return (unitOL instr) +addSpUnwindings instr = return $ unitOL instr + +{- Note [Keeping track of the current block] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When generating instructions for Cmm we sometimes require +the current block for things like retry loops. + +We also sometimes change the current block, if a MachOP +results in branching control flow. + +Issues arise if we have two statements in the same block, +which both depend on the current block id *and* change the +basic block after them. This happens for atomic primops +in the X86 backend where we want to update the CFG data structure +when introducing new basic blocks. + +For example in #17334 we got this Cmm code: + + c3Bf: // global + (_s3t1::I64) = call MO_AtomicRMW W64 AMO_And(_s3sQ::P64 + 88, 18); + (_s3t4::I64) = call MO_AtomicRMW W64 AMO_Or(_s3sQ::P64 + 88, 0); + _s3sT::I64 = _s3sV::I64; + goto c3B1; + +This resulted in two new basic blocks being inserted: + + c3Bf: + movl $18,%vI_n3Bo + movq 88(%vI_s3sQ),%rax + jmp _n3Bp + n3Bp: + ... + cmpxchgq %vI_n3Bq,88(%vI_s3sQ) + jne _n3Bp + ... + jmp _n3Bs + n3Bs: + ... + cmpxchgq %vI_n3Bt,88(%vI_s3sQ) + jne _n3Bs + ... + jmp _c3B1 + ... + +Based on the Cmm we called stmtToInstrs we translated both atomic operations under +the assumption they would be placed into their Cmm basic block `c3Bf`. +However for the retry loop we introduce new labels, so this is not the case +for the second statement. +This resulted in a desync between the explicit control flow graph +we construct as a separate data type and the actual control flow graph in the code. + +Instead we now return the new basic block if a statement causes a change +in the current block and use the block for all following statements. + +For this reason genForeignCall is also split into two parts. One for calls which +*won't* change the basic blocks in which successive instructions will be +placed (since they only evaluate CmmExpr, which can only contain MachOps, which +cannot introduce basic blocks in their lowerings). A different one for calls +which *are* known to change the basic block. + +-} + +-- See Note [Keeping track of the current block] for why +-- we pass the BlockId. +stmtsToInstrs :: BlockId -- ^ Basic block these statement will start to be placed in. + -> [CmmNode O O] -- ^ Cmm Statement + -> NatM (InstrBlock, BlockId) -- ^ Resulting instruction +stmtsToInstrs bid stmts = + go bid stmts nilOL + where + go bid [] instrs = return (instrs,bid) + go bid (s:stmts) instrs = do + (instrs',bid') <- stmtToInstrs bid s + -- If the statement introduced a new block, we use that one + let !newBid = fromMaybe bid bid' + go newBid stmts (instrs `appOL` instrs') + +-- | `bid` refers to the current block and is used to update the CFG +-- if new blocks are inserted in the control flow. +-- See Note [Keeping track of the current block] for more details. +stmtToInstrs :: BlockId -- ^ Basic block this statement will start to be placed in. + -> CmmNode e x + -> NatM (InstrBlock, Maybe BlockId) + -- ^ Instructions, and bid of new block if successive + -- statements are placed in a different basic block. +stmtToInstrs bid stmt = do + is32Bit <- is32BitPlatform + platform <- getPlatform + case stmt of + CmmUnsafeForeignCall target result_regs args + -> genForeignCall target result_regs args bid + + _ -> (,Nothing) <$> case stmt of + CmmComment s -> return (unitOL (COMMENT s)) + CmmTick {} -> return nilOL + + CmmUnwind regs -> do + let to_unwind_entry :: (GlobalReg, Maybe CmmExpr) -> UnwindTable + to_unwind_entry (reg, expr) = Map.singleton reg (fmap (toUnwindExpr platform) expr) + case foldMap to_unwind_entry regs of + tbl | Map.null tbl -> return nilOL + | otherwise -> do + lbl <- mkAsmTempLabel <$> getUniqueM + return $ unitOL $ UNWIND lbl tbl + + CmmAssign reg src + | isFloatType ty -> assignReg_FltCode reg src + | is32Bit && isWord64 ty -> assignReg_I64Code reg src + | isVecType ty -> assignReg_VecCode reg src + | otherwise -> assignReg_IntCode reg src + where ty = cmmRegType reg + + CmmStore addr src _alignment + | isFloatType ty -> assignMem_FltCode format addr src + | is32Bit && isWord64 ty -> assignMem_I64Code addr src + | isVecType ty -> assignMem_VecCode format addr src + | otherwise -> assignMem_IntCode format addr src + where ty = cmmExprType platform src + format = cmmTypeFormat ty + + CmmBranch id -> return $ genBranch id + + --We try to arrange blocks such that the likely branch is the fallthrough + --in GHC.Cmm.ContFlowOpt. So we can assume the condition is likely false here. + CmmCondBranch arg true false _ -> genCondBranch bid true false arg + CmmSwitch arg ids -> genSwitch arg ids + CmmCall { cml_target = arg + , cml_args_regs = gregs } -> genJump arg (jumpRegs platform gregs) + _ -> + panic "stmtToInstrs: statement should have been cps'd away" + + +jumpRegs :: Platform -> [GlobalRegUse] -> [RegWithFormat] +jumpRegs platform gregs = + [ RegWithFormat (RegReal r) (cmmTypeFormat ty) + | GlobalRegUse gr ty <- gregs + , Just r <- [globalRegMaybe platform gr] ] + +-------------------------------------------------------------------------------- +-- | 'InstrBlock's are the insn sequences generated by the insn selectors. +-- They are really trees of insns to facilitate fast appending, where a +-- left-to-right traversal yields the insns in the correct order. +-- +type InstrBlock + = OrdList Instr + + +-- | Condition codes passed up the tree. +-- +data CondCode + = CondCode Bool Cond InstrBlock + + +-- | Register's passed up the tree. If the stix code forces the register +-- to live in a pre-decided machine register, it comes out as @Fixed@; +-- otherwise, it comes out as @Any@, and the parent can decide which +-- register to put it in. +-- +data Register + = Fixed Format Reg InstrBlock + | Any Format (Reg -> InstrBlock) + + +swizzleRegisterRep :: Register -> Format -> Register +swizzleRegisterRep (Fixed _ reg code) format = Fixed format reg code +swizzleRegisterRep (Any _ codefn) format = Any format codefn + +getLocalRegReg :: LocalReg -> Reg +getLocalRegReg (LocalReg u ty) + = -- by assuming SSE2, Int, Word, Float, Double and vectors all can be register allocated + RegVirtual (mkVirtualReg u (cmmTypeFormat ty)) + +-- | Grab the Reg for a CmmReg +getRegisterReg :: Platform -> CmmReg -> Reg + +getRegisterReg _ (CmmLocal lreg) = getLocalRegReg lreg + +getRegisterReg platform (CmmGlobal mid) + = case globalRegMaybe platform $ globalRegUse_reg mid of + Just reg -> RegReal $ reg + Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid) + -- By this stage, the only MagicIds remaining should be the + -- ones which map to a real machine register on this + -- platform. Hence ... + +-- | Memory addressing modes passed up the tree. +data Amode + = Amode AddrMode InstrBlock + +{- +Now, given a tree (the argument to a CmmLoad) that references memory, +produce a suitable addressing mode. + +A Rule of the Game (tm) for Amodes: use of the addr bit must +immediately follow use of the code part, since the code part puts +values in registers which the addr then refers to. So you can't put +anything in between, lest it overwrite some of those registers. If +you need to do some other computation between the code part and use of +the addr bit, first store the effective address from the amode in a +temporary, then do the other computation, and then use the temporary: + + code + LEA amode, tmp + ... other computation ... + ... (tmp) ... +-} + +{- +Note [%rip-relative addressing on x86-64] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +On x86-64 GHC produces code for use in the "small" or, when `-fPIC` is set, +"small PIC" code models defined by the x86-64 System V ABI (section 3.5.1 of +specification version 0.99). + +In general the small code model would allow us to assume that code is located +between 0 and 2^31 - 1. However, this is not true on Windows which, due to +high-entropy ASLR, may place the executable image anywhere in 64-bit address +space. This is problematic since immediate operands in x86-64 are generally +32-bit sign-extended values (with the exception of the 64-bit MOVABS encoding). +Consequently, to avoid overflowing we use %rip-relative addressing universally. +Since %rip-relative addressing comes essentially for free and makes linking far +easier, we use it even on non-Windows platforms. + +See also: the documentation for GCC's `-mcmodel=small` flag. +-} + + +-- | Check whether an integer will fit in 32 bits. +-- A CmmInt is intended to be truncated to the appropriate +-- number of bits, so here we truncate it to Int64. This is +-- important because e.g. -1 as a CmmInt might be either +-- -1 or 18446744073709551615. +-- +is32BitInteger :: Integer -> Bool +is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 + where i64 = fromIntegral i :: Int64 + + +-- | Convert a BlockId to some CmmStatic data +jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic +jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config)) +jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) + where blockLabel = blockLbl blockid + + +-- ----------------------------------------------------------------------------- +-- General things for putting together code sequences + +-- Expand CmmRegOff. ToDo: should we do it this way around, or convert +-- CmmExprs into CmmRegOff? +mangleIndexTree :: CmmReg -> Int -> CmmExpr +mangleIndexTree reg off + = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] + where width = typeWidth (cmmRegType reg) + +-- | The dual to getAnyReg: compute an expression into a register, but +-- we don't mind which one it is. +getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock) +getSomeReg expr = do + r <- getRegister expr + case r of + Any rep code -> do + tmp <- getNewRegNat rep + return (tmp, code tmp) + Fixed _ reg code -> + return (reg, code) + +assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock +assignMem_I64Code addrTree valueTree = do + Amode addr addr_code <- getAmode addrTree + RegCode64 vcode rhi rlo <- iselExpr64 valueTree + let + -- Little-endian store + mov_lo = MOV II32 (OpReg rlo) (OpAddr addr) + mov_hi = MOV II32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4))) + return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) + + +assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock +assignReg_I64Code (CmmLocal dst) valueTree = do + RegCode64 vcode r_src_hi r_src_lo <- iselExpr64 valueTree + let + Reg64 r_dst_hi r_dst_lo = localReg64 dst + mov_lo = MOV II32 (OpReg r_src_lo) (OpReg r_dst_lo) + mov_hi = MOV II32 (OpReg r_src_hi) (OpReg r_dst_hi) + return ( + vcode `snocOL` mov_lo `snocOL` mov_hi + ) + +assignReg_I64Code _ _ + = panic "assignReg_I64Code(i386): invalid lvalue" + +iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock) +iselExpr64 (CmmLit (CmmInt i _)) = do + Reg64 rhi rlo <- getNewReg64 + let + r = fromIntegral (fromIntegral i :: Word32) + q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32) + code = toOL [ + MOV II32 (OpImm (ImmInteger r)) (OpReg rlo), + MOV II32 (OpImm (ImmInteger q)) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmLoad addrTree ty _) | isWord64 ty = do + Amode addr addr_code <- getAmode addrTree + Reg64 rhi rlo <- getNewReg64 + let + mov_lo = MOV II32 (OpAddr addr) (OpReg rlo) + mov_hi = MOV II32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi) + return ( + RegCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rhi rlo + ) + +iselExpr64 (CmmReg (CmmLocal local_reg)) = do + let Reg64 hi lo = localReg64 local_reg + return (RegCode64 nilOL hi lo) + +iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + Reg64 rhi rlo <- getNewReg64 + let + r = fromIntegral (fromIntegral i :: Word32) + q = fromIntegral (fromIntegral (i `shiftR` 32) :: Word32) + code = code1 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + ADD II32 (OpImm (ImmInteger r)) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + ADC II32 (OpImm (ImmInteger q)) (OpReg rhi) ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + ADD II32 (OpReg r2lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + ADC II32 (OpReg r2hi) (OpReg rhi) ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + SUB II32 (OpReg r2lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + SBB II32 (OpReg r2hi) (OpReg rhi) ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do + code <- getAnyReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code r_dst_lo `snocOL` + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi)) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_UU_Conv W16 W64) [expr]) = do + (rsrc, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II16 (OpReg rsrc) (OpReg r_dst_lo), + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) + ]) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_UU_Conv W8 W64) [expr]) = do + (rsrc, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II8 (OpReg rsrc) (OpReg r_dst_lo), + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) + ]) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do + code <- getAnyReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code r_dst_lo `snocOL` + MOV II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` + CLTD II32 `snocOL` + MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` + MOV II32 (OpReg edx) (OpReg r_dst_hi)) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do + (r, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVSxL II16 (OpReg r) (OpReg eax), + CLTD II32, + MOV II32 (OpReg eax) (OpReg r_dst_lo), + MOV II32 (OpReg edx) (OpReg r_dst_hi)]) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do + (r, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVSxL II8 (OpReg r) (OpReg eax), + CLTD II32, + MOV II32 (OpReg eax) (OpReg r_dst_lo), + MOV II32 (OpReg edx) (OpReg r_dst_hi)]) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do + RegCode64 code rhi rlo <- iselExpr64 expr + Reg64 rohi rolo <- getNewReg64 + let + ocode = code `appOL` + toOL [ MOV II32 (OpReg rlo) (OpReg rolo), + XOR II32 (OpReg rohi) (OpReg rohi), + NEGI II32 (OpReg rolo), + SBB II32 (OpReg rhi) (OpReg rohi) ] + return (RegCode64 ocode rohi rolo) + +-- To multiply two 64-bit numbers we use the following decomposition (in C notation): +-- +-- ((r1hi << 32) + r1lo) * ((r2hi << 32) + r2lo) +-- = ((r2lo * r1hi) << 32) +-- + ((r1lo * r2hi) << 32) +-- + r1lo * r2lo +-- +-- Note that @(r1hi * r2hi) << 64@ can be dropped because it overflows completely. + +iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + tmp <- getNewRegNat II32 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg eax), + MOV II32 (OpReg r2lo) (OpReg tmp), + MOV II32 (OpReg r1hi) (OpReg rhi), + IMUL II32 (OpReg tmp) (OpReg rhi), + MOV II32 (OpReg r2hi) (OpReg rlo), + IMUL II32 (OpReg eax) (OpReg rlo), + ADD II32 (OpReg rlo) (OpReg rhi), + MUL2 II32 (OpReg tmp), + ADD II32 (OpReg edx) (OpReg rhi), + MOV II32 (OpReg eax) (OpReg rlo) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_S_MulMayOflo W64) _) = do + -- Performance sensitive users won't use 32 bit so let's keep it simple: + -- We always return a (usually false) positive. + Reg64 rhi rlo <- getNewReg64 + let code = toOL [ + MOV II32 (OpImm (ImmInt 1)) (OpReg rhi), + MOV II32 (OpImm (ImmInt 1)) (OpReg rlo) + ] + return (RegCode64 code rhi rlo) + + +-- To shift a 64-bit number to the left we use the SHLD and SHL instructions. +-- We use SHLD to shift the bits in @rhi@ to the left while copying +-- high bits from @rlo@ to fill the new space in the low bits of @rhi@. +-- That leaves @rlo@ unchanged, so we use SHL to shift the bits of @rlo@ left. +-- However, both these instructions only use the lowest 5 bits from %cl to do +-- their shifting. So if the sixth bit (0x32) is set then we additionally move +-- the contents of @rlo@ to @rhi@ and clear @rlo@. + +iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + code2 <- getAnyReg e2 + Reg64 rhi rlo <- getNewReg64 + lbl1 <- newBlockId + lbl2 <- newBlockId + let + code = code1 `appOL` + code2 ecx `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), + SHL II32 (OpReg ecx) (OpReg rlo), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, + MOV II32 (OpReg rlo) (OpReg rhi), + XOR II32 (OpReg rlo) (OpReg rlo), + JXX ALWAYS lbl2, + NEWBLOCK lbl2 + ] + return (RegCode64 code rhi rlo) + +-- Similar to above, however now we're shifting to the right +-- and we're doing a signed shift which means that @rhi@ needs +-- to be set to either 0 if @rhi@ is positive or 0xffffffff otherwise, +-- and if the sixth bit of %cl is set (so the shift amount is more than 32). +-- To accomplish that we shift @rhi@ by 31. + +iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + (r2, code2) <- getSomeReg e2 + Reg64 rhi rlo <- getNewReg64 + lbl1 <- newBlockId + lbl2 <- newBlockId + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + MOV II32 (OpReg r2) (OpReg ecx), + SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), + SAR II32 (OpReg ecx) (OpReg rhi), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, + MOV II32 (OpReg rhi) (OpReg rlo), + SAR II32 (OpImm (ImmInt 31)) (OpReg rhi), + JXX ALWAYS lbl2, + NEWBLOCK lbl2 + ] + return (RegCode64 code rhi rlo) + +-- Similar to the above. + +iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + (r2, code2) <- getSomeReg e2 + Reg64 rhi rlo <- getNewReg64 + lbl1 <- newBlockId + lbl2 <- newBlockId + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + MOV II32 (OpReg r2) (OpReg ecx), + SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), + SHR II32 (OpReg ecx) (OpReg rhi), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, + MOV II32 (OpReg rhi) (OpReg rlo), + XOR II32 (OpReg rhi) (OpReg rhi), + JXX ALWAYS lbl2, + NEWBLOCK lbl2 + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_And _) [e1,e2]) = iselExpr64ParallelBin AND e1 e2 +iselExpr64 (CmmMachOp (MO_Or _) [e1,e2]) = iselExpr64ParallelBin OR e1 e2 +iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = iselExpr64ParallelBin XOR e1 e2 + +iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + NOT II32 (OpReg rlo), + NOT II32 (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmRegOff r i) = iselExpr64 (mangleIndexTree r i) + +iselExpr64 expr + = do + platform <- getPlatform + pprPanic "iselExpr64(i386)" (pdoc platform expr $+$ text (show expr)) + +iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM (RegCode64 (OrdList Instr)) +iselExpr64ParallelBin op e1 e2 = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + op II32 (OpReg r2lo) (OpReg rlo), + op II32 (OpReg r2hi) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +-------------------------------------------------------------------------------- + +getRegister :: HasDebugCallStack => CmmExpr -> NatM Register +getRegister e = do platform <- getPlatform + is32Bit <- is32BitPlatform + getRegister' platform is32Bit e + +getRegister' :: HasDebugCallStack => Platform -> Bool -> CmmExpr -> NatM Register + +getRegister' platform is32Bit (CmmReg reg) + = case reg of + CmmGlobal (GlobalRegUse PicBaseReg _) + | is32Bit -> + -- on x86_64, we have %rip for PicBaseReg, but it's not + -- a full-featured register, it can only be used for + -- rip-relative addressing. + do reg' <- getPicBaseNat (archWordFormat is32Bit) + return (Fixed (archWordFormat is32Bit) reg' nilOL) + _ -> + let ty = cmmRegType reg + reg_fmt = cmmTypeFormat ty + in return $ Fixed reg_fmt (getRegisterReg platform reg) nilOL + +getRegister' platform is32Bit (CmmRegOff r n) + = getRegister' platform is32Bit $ mangleIndexTree r n + +getRegister' platform is32Bit (CmmMachOp (MO_RelaxedRead w) [e]) + = getRegister' platform is32Bit (CmmLoad e (cmmBits w) NaturallyAligned) + +getRegister' platform is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e]) + = addAlignmentCheck align <$> getRegister' platform is32Bit e + +-- for 32-bit architectures, support some 64 -> 32 bit conversions: +-- TO_W_(x), TO_W_(x >> 32) + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) + [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) + | is32Bit = do + RegCode64 code rhi _rlo <- iselExpr64 x + return $ Fixed II32 rhi code + +getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) + [CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) + | is32Bit = do + RegCode64 code rhi _rlo <- iselExpr64 x + return $ Fixed II32 rhi code + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + return $ Fixed II32 rlo code + +getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + return $ Fixed II32 rlo code + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W8) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + ro <- getNewRegNat II8 + return $ Fixed II8 ro (code `appOL` toOL [ MOVZxL II8 (OpReg rlo) (OpReg ro) ]) + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W16) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + ro <- getNewRegNat II16 + return $ Fixed II16 ro (code `appOL` toOL [ MOVZxL II16 (OpReg rlo) (OpReg ro) ]) + +-- catch simple cases of zero- or sign-extended load +getRegister' _ _ (CmmMachOp (MO_UU_Conv W8 W32) [CmmLoad addr _ _]) = do + code <- intLoadCode (MOVZxL II8) addr + return (Any II32 code) + +getRegister' _ _ (CmmMachOp (MO_SS_Conv W8 W32) [CmmLoad addr _ _]) = do + code <- intLoadCode (MOVSxL II8) addr + return (Any II32 code) + +getRegister' _ _ (CmmMachOp (MO_UU_Conv W16 W32) [CmmLoad addr _ _]) = do + code <- intLoadCode (MOVZxL II16) addr + return (Any II32 code) + +getRegister' _ _ (CmmMachOp (MO_SS_Conv W16 W32) [CmmLoad addr _ _]) = do + code <- intLoadCode (MOVSxL II16) addr + return (Any II32 code) + +-- catch simple cases of zero- or sign-extended load +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W8 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOVZxL II8) addr + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W8 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOVSxL II8) addr + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W16 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOVZxL II16) addr + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W16 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOVSxL II16) addr + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W32 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOV II32) addr -- 32-bit loads zero-extend + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _ _]) + | not is32Bit = do + code <- intLoadCode (MOVSxL II32) addr + return (Any II64 code) + +getRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)), + CmmLit displacement]) + | not is32Bit = + return $ Any II64 (\dst -> unitOL $ + LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst)) + +getRegister' _ _ (CmmMachOp mop []) = + pprPanic "getRegister(x86): nullary MachOp" (text $ show mop) + +getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps + avx <- avxEnabled + avx2 <- avx2Enabled + case mop of + MO_F_Neg w -> sse2NegCode w x + + + MO_S_Neg w -> triv_ucode NEGI (intFormat w) + MO_Not w -> triv_ucode NOT (intFormat w) + + -- Nop conversions + MO_UU_Conv W32 W8 -> toI8Reg W32 x + MO_SS_Conv W32 W8 -> toI8Reg W32 x + MO_XX_Conv W32 W8 -> toI8Reg W32 x + MO_UU_Conv W16 W8 -> toI8Reg W16 x + MO_SS_Conv W16 W8 -> toI8Reg W16 x + MO_XX_Conv W16 W8 -> toI8Reg W16 x + MO_UU_Conv W32 W16 -> toI16Reg W32 x + MO_SS_Conv W32 W16 -> toI16Reg W32 x + MO_XX_Conv W32 W16 -> toI16Reg W32 x + + MO_UU_Conv W64 W32 | not is32Bit -> conversionNop II64 x + MO_SS_Conv W64 W32 | not is32Bit -> conversionNop II64 x + MO_XX_Conv W64 W32 | not is32Bit -> conversionNop II64 x + MO_UU_Conv W64 W16 | not is32Bit -> toI16Reg W64 x + MO_SS_Conv W64 W16 | not is32Bit -> toI16Reg W64 x + MO_XX_Conv W64 W16 | not is32Bit -> toI16Reg W64 x + MO_UU_Conv W64 W8 | not is32Bit -> toI8Reg W64 x + MO_SS_Conv W64 W8 | not is32Bit -> toI8Reg W64 x + MO_XX_Conv W64 W8 | not is32Bit -> toI8Reg W64 x + + MO_UU_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x + MO_SS_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x + MO_XX_Conv rep1 rep2 | rep1 == rep2 -> conversionNop (intFormat rep1) x + + MO_FW_Bitcast W32 -> bitcast FF32 II32 x + MO_WF_Bitcast W32 -> bitcast II32 FF32 x + MO_FW_Bitcast W64 -> bitcast FF64 II64 x + MO_WF_Bitcast W64 -> bitcast II64 FF64 x + MO_WF_Bitcast {} -> incorrectOperands + MO_FW_Bitcast {} -> incorrectOperands + + -- widenings + MO_UU_Conv W8 W32 -> integerExtend W8 W32 MOVZxL x + MO_UU_Conv W16 W32 -> integerExtend W16 W32 MOVZxL x + MO_UU_Conv W8 W16 -> integerExtend W8 W16 MOVZxL x + + MO_SS_Conv W8 W32 -> integerExtend W8 W32 MOVSxL x + MO_SS_Conv W16 W32 -> integerExtend W16 W32 MOVSxL x + MO_SS_Conv W8 W16 -> integerExtend W8 W16 MOVSxL x + + -- We don't care about the upper bits for MO_XX_Conv, so MOV is enough. However, on 32-bit we + -- have 8-bit registers only for a few registers (as opposed to x86-64 where every register + -- has 8-bit version). So for 32-bit code, we'll just zero-extend. + MO_XX_Conv W8 W32 + | is32Bit -> integerExtend W8 W32 MOVZxL x + | otherwise -> integerExtend W8 W32 MOV x + MO_XX_Conv W8 W16 + | is32Bit -> integerExtend W8 W16 MOVZxL x + | otherwise -> integerExtend W8 W16 MOV x + MO_XX_Conv W16 W32 -> integerExtend W16 W32 MOV x + + MO_UU_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOVZxL x + MO_UU_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVZxL x + MO_UU_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVZxL x + MO_SS_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOVSxL x + MO_SS_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOVSxL x + MO_SS_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOVSxL x + -- For 32-to-64 bit zero extension, amd64 uses an ordinary movl. + -- However, we don't want the register allocator to throw it + -- away as an unnecessary reg-to-reg move, so we keep it in + -- the form of a movzl and print it as a movl later. + -- This doesn't apply to MO_XX_Conv since in this case we don't care about + -- the upper bits. So we can just use MOV. + MO_XX_Conv W8 W64 | not is32Bit -> integerExtend W8 W64 MOV x + MO_XX_Conv W16 W64 | not is32Bit -> integerExtend W16 W64 MOV x + MO_XX_Conv W32 W64 | not is32Bit -> integerExtend W32 W64 MOV x + + MO_FF_Conv W32 W64 -> coerceFP2FP W64 x + MO_FF_Conv W64 W32 -> coerceFP2FP W32 x + + MO_FF_Conv from to -> invalidConversion from to + MO_UU_Conv from to -> invalidConversion from to + MO_SS_Conv from to -> invalidConversion from to + MO_XX_Conv from to -> invalidConversion from to + + MO_FS_Truncate from to -> coerceFP2Int from to x + MO_SF_Round from to -> coerceInt2FP from to x + + MO_VF_Neg l w | avx -> vector_float_negate_avx l w x + | otherwise -> vector_float_negate_sse l w x + -- SIMD NCG TODO: Support 256/512-bit integer vectors + MO_VS_Neg l w -> getRegister' platform is32Bit (CmmMachOp (MO_V_Sub l w) [zero_vec, x]) + where zero_vec = CmmLit $ CmmVec $ replicate l $ CmmInt 0 w + + MO_VF_Broadcast l w + | avx + -> vector_float_broadcast_avx l w x + | otherwise + -> vector_float_broadcast_sse l w x + MO_V_Broadcast l w + | avx2, l * widthInBits w `elem` [128, 256] -- AVX-512 is not supported for now + -> vector_int_broadcast_avx2 l w x + MO_V_Broadcast 16 W8 -> vector_int8x16_broadcast x + MO_V_Broadcast 8 W16 -> vector_int16x8_broadcast x + MO_V_Broadcast 4 W32 -> vector_int32x4_broadcast x + MO_V_Broadcast 2 W64 -> vector_int64x2_broadcast x + MO_V_Broadcast {} + -> pprPanic "Unsupported integer vector broadcast operation for: " (pdoc platform x) + + -- Binary MachOps + MO_Add {} -> incorrectOperands + MO_Sub {} -> incorrectOperands + MO_Eq {} -> incorrectOperands + MO_Ne {} -> incorrectOperands + MO_Mul {} -> incorrectOperands + MO_S_MulMayOflo {} -> incorrectOperands + MO_S_Quot {} -> incorrectOperands + MO_S_Rem {} -> incorrectOperands + MO_U_Quot {} -> incorrectOperands + MO_U_Rem {} -> incorrectOperands + MO_S_Ge {} -> incorrectOperands + MO_S_Le {} -> incorrectOperands + MO_S_Gt {} -> incorrectOperands + MO_S_Lt {} -> incorrectOperands + MO_U_Ge {} -> incorrectOperands + MO_U_Le {} -> incorrectOperands + MO_U_Gt {} -> incorrectOperands + MO_U_Lt {} -> incorrectOperands + MO_F_Add {} -> incorrectOperands + MO_F_Sub {} -> incorrectOperands + MO_F_Mul {} -> incorrectOperands + MO_F_Quot {} -> incorrectOperands + MO_F_Eq {} -> incorrectOperands + MO_F_Ne {} -> incorrectOperands + MO_F_Ge {} -> incorrectOperands + MO_F_Le {} -> incorrectOperands + MO_F_Gt {} -> incorrectOperands + MO_F_Lt {} -> incorrectOperands + MO_F_Min {} -> incorrectOperands + MO_F_Max {} -> incorrectOperands + MO_And {} -> incorrectOperands + MO_Or {} -> incorrectOperands + MO_Xor {} -> incorrectOperands + MO_Shl {} -> incorrectOperands + MO_U_Shr {} -> incorrectOperands + MO_S_Shr {} -> incorrectOperands + + MO_V_Extract {} -> incorrectOperands + MO_V_Add {} -> incorrectOperands + MO_V_Sub {} -> incorrectOperands + MO_V_Mul {} -> incorrectOperands + MO_V_Shuffle {} -> incorrectOperands + MO_VF_Shuffle {} -> incorrectOperands + MO_VU_Min {} -> incorrectOperands + MO_VU_Max {} -> incorrectOperands + MO_VS_Min {} -> incorrectOperands + MO_VS_Max {} -> incorrectOperands + MO_VF_Min {} -> incorrectOperands + MO_VF_Max {} -> incorrectOperands + + MO_VF_Extract {} -> incorrectOperands + MO_VF_Add {} -> incorrectOperands + MO_VF_Sub {} -> incorrectOperands + MO_VF_Mul {} -> incorrectOperands + MO_VF_Quot {} -> incorrectOperands + + -- Ternary MachOps + MO_FMA {} -> incorrectOperands + MO_VF_Insert {} -> incorrectOperands + MO_V_Insert {} -> incorrectOperands + + --_other -> pprPanic "getRegister" (pprMachOp mop) + where + triv_ucode :: (Format -> Operand -> Instr) -> Format -> NatM Register + triv_ucode instr format = trivialUCode format (instr format) x + + -- signed or unsigned extension. + integerExtend :: Width -> Width + -> (Format -> Operand -> Operand -> Instr) + -> CmmExpr -> NatM Register + integerExtend from to instr expr = do + (reg,e_code) <- if from == W8 then getByteReg expr + else getSomeReg expr + let + code dst = + e_code `snocOL` + instr (intFormat from) (OpReg reg) (OpReg dst) + return (Any (intFormat to) code) + + bitcast :: Format -> Format -> CmmExpr -> NatM Register + bitcast fmt rfmt expr = + do (src, e_code) <- getSomeReg expr + let code = \dst -> e_code `snocOL` (MOVD fmt rfmt (OpReg src) (OpReg dst)) + return (Any rfmt code) + + toI8Reg :: Width -> CmmExpr -> NatM Register + toI8Reg new_rep expr + = do codefn <- getAnyReg expr + return (Any (intFormat new_rep) codefn) + -- HACK: use getAnyReg to get a byte-addressable register. + -- If the source was a Fixed register, this will add the + -- mov instruction to put it into the desired destination. + -- We're assuming that the destination won't be a fixed + -- non-byte-addressable register; it won't be, because all + -- fixed registers are word-sized. + + toI16Reg = toI8Reg -- for now + + conversionNop :: Format -> CmmExpr -> NatM Register + conversionNop new_format expr + = do e_code <- getRegister' platform is32Bit expr + return (swizzleRegisterRep e_code new_format) + + vector_float_negate_avx :: Length -> Width -> CmmExpr -> NatM Register + vector_float_negate_avx l w expr = do + let fmt :: Format + mask :: CmmLit + (fmt, mask) = case w of + W32 -> (VecFormat l FmtFloat , CmmInt (bit 31) w) -- TODO: these should be negative 0 floating point literals, + W64 -> (VecFormat l FmtDouble, CmmInt (bit 63) w) -- but we don't currently have those in Cmm. + _ -> panic "AVX floating-point negation: elements must be FF32 or FF64" + (maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l mask) + (reg, exp) <- getSomeReg expr + let code dst = maskCode `appOL` + exp `snocOL` + (VMOVU fmt (OpReg reg) (OpReg dst)) `snocOL` + (VXOR fmt (OpReg maskReg) dst dst) + return (Any fmt code) + + vector_float_negate_sse :: Length -> Width -> CmmExpr -> NatM Register + vector_float_negate_sse l w expr = do + let fmt :: Format + mask :: CmmLit + (fmt, mask) = case w of + W32 -> (VecFormat l FmtFloat , CmmInt (bit 31) w) -- Same comment as for vector_float_negate_avx, + W64 -> (VecFormat l FmtDouble, CmmInt (bit 63) w) -- these should be -0.0 CmmFloat values. + _ -> panic "SSE floating-point negation: elements must be FF32 or FF64" + (maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l mask) + (reg, exp) <- getSomeReg expr + let code dst = maskCode `appOL` + exp `snocOL` + (MOVU fmt (OpReg reg) (OpReg dst)) `snocOL` + (XOR fmt (OpReg maskReg) (OpReg dst)) + return (Any fmt code) + + ----------------------- + + -- TODO: we could use VBROADCASTSS/SD when AVX2 is available. + vector_float_broadcast_avx :: Length + -> Width + -> CmmExpr + -> NatM Register + vector_float_broadcast_avx len w expr = do + (dst, exp) <- getSomeReg expr + let fmt = VecFormat len (floatScalarFormat w) + code = VSHUF fmt (ImmInt 0) (OpReg dst) dst dst + return $ Fixed fmt dst (exp `snocOL` code) + + vector_float_broadcast_sse :: Length + -> Width + -> CmmExpr + -> NatM Register + vector_float_broadcast_sse len w expr = do + (dst, exp) <- getSomeReg expr + let fmt = VecFormat len (floatScalarFormat w) + code = SHUF fmt (ImmInt 0) (OpReg dst) dst + return $ Fixed fmt dst (exp `snocOL` code) + + vector_int_broadcast_avx2 :: Length + -> Width + -> CmmExpr + -> NatM Register + vector_int_broadcast_avx2 len w expr = do + (reg, exp) <- getNonClobberedReg expr + let (movFormat, fmt) = case w of + W8 -> (II32, VecFormat len FmtInt8) + W16 -> (II32, VecFormat len FmtInt16) + W32 -> (II32, VecFormat len FmtInt32) + W64 -> (II64, VecFormat len FmtInt64) + _ -> pprPanic "Broadcast not supported for: " (pdoc platform expr) + code dst = exp `snocOL` + -- VPBROADCAST from GPR requires AVX-512, + -- so we use an additional MOVD. + (MOVD movFormat fmt (OpReg reg) (OpReg dst)) `snocOL` + (VPBROADCAST fmt fmt (OpReg dst) dst) + return $ Any fmt code + + vector_int8x16_broadcast :: CmmExpr + -> NatM Register + vector_int8x16_broadcast expr = do + (reg, exp) <- getNonClobberedReg expr + let fmt = VecFormat 16 FmtInt8 + return $ Any fmt (\dst -> exp `snocOL` + (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL` + (PUNPCKLBW fmt (OpReg dst) dst) `snocOL` + (PUNPCKLWD (VecFormat 8 FmtInt16) (OpReg dst) dst) `snocOL` + (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst) + ) + + vector_int16x8_broadcast :: CmmExpr + -> NatM Register + vector_int16x8_broadcast expr = do + (reg, exp) <- getNonClobberedReg expr + let fmt = VecFormat 8 FmtInt16 + return $ Any fmt (\dst -> exp `snocOL` + (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL` + (PUNPCKLWD fmt (OpReg dst) dst) `snocOL` + (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst) + ) + + vector_int32x4_broadcast :: CmmExpr + -> NatM Register + vector_int32x4_broadcast expr = do + (reg, exp) <- getNonClobberedReg expr + let fmt = VecFormat 4 FmtInt32 + return $ Any fmt (\dst -> exp `snocOL` + (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL` + (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst) + ) + + vector_int64x2_broadcast :: CmmExpr + -> NatM Register + vector_int64x2_broadcast expr = do + (reg, exp) <- getNonClobberedReg expr + let fmt = VecFormat 2 FmtInt64 + return $ Any fmt (\dst -> exp `snocOL` + (MOVD II64 fmt (OpReg reg) (OpReg dst)) `snocOL` + (PUNPCKLQDQ fmt (OpReg dst) dst) + ) + +getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps + sse4_1 <- sse4_1Enabled + sse4_2 <- sse4_2Enabled + avx <- avxEnabled + case mop of + MO_F_Eq _ -> condFltReg is32Bit EQQ x y + MO_F_Ne _ -> condFltReg is32Bit NE x y + MO_F_Gt _ -> condFltReg is32Bit GTT x y + MO_F_Ge _ -> condFltReg is32Bit GE x y + -- Invert comparison condition and swap operands + -- See Note [SSE Parity Checks] + MO_F_Lt _ -> condFltReg is32Bit GTT y x + MO_F_Le _ -> condFltReg is32Bit GE y x + + MO_Eq _ -> condIntReg EQQ x y + MO_Ne _ -> condIntReg NE x y + + MO_S_Gt _ -> condIntReg GTT x y + MO_S_Ge _ -> condIntReg GE x y + MO_S_Lt _ -> condIntReg LTT x y + MO_S_Le _ -> condIntReg LE x y + + MO_U_Gt _ -> condIntReg GU x y + MO_U_Ge _ -> condIntReg GEU x y + MO_U_Lt _ -> condIntReg LU x y + MO_U_Le _ -> condIntReg LEU x y + + MO_F_Add w -> trivialFCode_sse2 w (\fmt op2 -> ADD fmt op2 . OpReg) x y + MO_F_Sub w -> trivialFCode_sse2 w (\fmt op2 -> SUB fmt op2 . OpReg) x y + MO_F_Quot w -> trivialFCode_sse2 w FDIV x y + MO_F_Mul w -> trivialFCode_sse2 w (\fmt op2 -> MUL fmt op2 . OpReg) x y + MO_F_Min w -> trivialFCode_sse2 w (MINMAX Min FloatMinMax) x y + MO_F_Max w -> trivialFCode_sse2 w (MINMAX Max FloatMinMax) x y + + MO_Add rep -> add_code rep x y + MO_Sub rep -> sub_code rep x y + + MO_S_Quot rep -> div_code rep True True x y + MO_S_Rem rep -> div_code rep True False x y + MO_U_Quot rep -> div_code rep False True x y + MO_U_Rem rep -> div_code rep False False x y + + MO_S_MulMayOflo rep -> imulMayOflo rep x y + + MO_Mul W8 -> imulW8 x y + MO_Mul rep -> triv_op rep IMUL + MO_And rep -> triv_op rep AND + MO_Or rep -> triv_op rep OR + MO_Xor rep -> triv_op rep XOR + + {- Shift ops on x86s have constraints on their source, it + either has to be Imm, CL or 1 + => trivialCode is not restrictive enough (sigh.) + -} + MO_Shl rep -> shift_code rep SHL x y {-False-} + MO_U_Shr rep -> shift_code rep SHR x y {-False-} + MO_S_Shr rep -> shift_code rep SAR x y {-False-} + + MO_VF_Shuffle 4 W32 is | avx -> vector_shuffle_float_avx 4 x y is + | otherwise -> vector_shuffle_floatx4_sse sse4_1 x y is + MO_VF_Shuffle 2 W64 is | avx -> vector_shuffle_double_avx 2 x y is + | otherwise -> vector_shuffle_doublex2_sse x y is + MO_VF_Shuffle {} -> sorry "Please use -fllvm for wide shuffle instructions" + + MO_VF_Extract l W32 | avx -> vector_float_extract l W32 x y + | otherwise -> vector_float_extract_sse l W32 x y + MO_VF_Extract l W64 -> vector_float_extract l W64 x y + MO_VF_Extract {} -> incorrectOperands + + MO_V_Extract 16 W8 | sse4_1 -> vector_int_extract_pextr 16 W8 x y + | otherwise -> vector_int8x16_extract_sse2 x y + MO_V_Extract 8 W16 -> vector_int_extract_pextr 8 W16 x y -- PEXTRW (SSE2) + MO_V_Extract 4 W32 | sse4_1 -> vector_int_extract_pextr 4 W32 x y + | otherwise -> vector_int32x4_extract_sse2 x y + MO_V_Extract 2 W64 | sse4_1 -> vector_int_extract_pextr 2 W64 x y + | otherwise -> vector_int64x2_extract_sse2 x y + -- SIMD NCG TODO: 256/512-bit vector + MO_V_Extract {} -> needLlvm mop + + MO_VF_Add l w | avx -> vector_float_op_avx VADD l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> ADD fmt op2 . OpReg) l w x y + + MO_VF_Sub l w | avx -> vector_float_op_avx VSUB l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> SUB fmt op2 . OpReg) l w x y + + MO_VF_Mul l w | avx -> vector_float_op_avx VMUL l w x y + | otherwise -> vector_float_op_sse (\fmt op2 -> MUL fmt op2 . OpReg) l w x y + + MO_VF_Quot l w | avx -> vector_float_op_avx VDIV l w x y + | otherwise -> vector_float_op_sse FDIV l w x y + + MO_VF_Min l w | avx -> vector_float_op_avx (VMINMAX Min FloatMinMax) l w x y + | otherwise -> vector_float_op_sse (MINMAX Min FloatMinMax) l w x y + + MO_VF_Max l w | avx -> vector_float_op_avx (VMINMAX Max FloatMinMax) l w x y + | otherwise -> vector_float_op_sse (MINMAX Max FloatMinMax) l w x y + + -- SIMD NCG TODO: 256/512-bit integer vector operations + MO_V_Shuffle 16 W8 is | not is32Bit -> vector_shuffle_int8x16 sse4_1 x y is + MO_V_Shuffle 8 W16 is -> vector_shuffle_int16x8 sse4_1 x y is + MO_V_Shuffle 4 W32 is -> vector_shuffle_int32x4 sse4_1 x y is + MO_V_Shuffle 2 W64 is -> vector_shuffle_int64x2 sse4_1 x y is + MO_V_Shuffle {} -> needLlvm mop + MO_V_Add l w | l * widthInBits w == 128 -> vector_int_op_sse PADD l w x y + | otherwise -> needLlvm mop + MO_V_Sub l w | l * widthInBits w == 128 -> vector_int_op_sse PSUB l w x y + | otherwise -> needLlvm mop + MO_V_Mul 16 W8 -> vector_int8x16_mul_sse2 x y + MO_V_Mul l@8 w@W16 -> vector_int_op_sse PMULL l w x y -- PMULLW (SSE2) + MO_V_Mul l@4 w@W32 | sse4_1 -> vector_int_op_sse PMULL l w x y -- PMULLD (SSE4.1) + | otherwise -> vector_int32x4_mul_sse2 x y + MO_V_Mul 2 W64 -> vector_int64x2_mul_sse2 x y + MO_V_Mul {} -> needLlvm mop + + MO_VU_Min l@16 w@W8 + -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUB (SSE2) + MO_VU_Min l@8 w@W16 + | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUW (SSE4.1) + | otherwise -> vector_word_minmax_sse Min l w x y + MO_VU_Min l@4 w@W32 + | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUD (SSE4.1) + | otherwise -> vector_word_minmax_sse Min l w x y + MO_VU_Min l@2 w@W64 + | sse4_2 -> vector_word_minmax_sse Min l w x y -- PCMPGTQ requires SSE4.2 + -- The SSE2 version is implemented as a C call (MO_W64X2_Min) + MO_VU_Min {} -> needLlvm mop + MO_VU_Max l@16 w@W8 + -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUB (SSE2) + MO_VU_Max l@8 w@W16 + | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUW (SSE4.1) + | otherwise -> vector_word_minmax_sse Max l w x y + MO_VU_Max l@4 w@W32 + | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUD (SSE4.1) + | otherwise -> vector_word_minmax_sse Max l w x y + MO_VU_Max l@2 w@W64 + | sse4_2 -> vector_word_minmax_sse Max l w x y -- PCMPGTQ requires SSE4.2 + -- The SSE2 version is implemented as a C call (MO_W64X2_Max) + MO_VU_Max {} -> needLlvm mop + MO_VS_Min l@16 w@W8 + | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSB (SSE4.1) + | otherwise -> vector_int_minmax_sse Min l w x y + MO_VS_Min l@8 w@W16 + -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSW (SSE2) + MO_VS_Min l@4 w@W32 + | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSD (SSE4.1) + | otherwise -> vector_int_minmax_sse Min l w x y + MO_VS_Min l@2 w@W64 + | sse4_2 -> vector_int_minmax_sse Min l w x y -- PCMPGTQ requires SSE4.2 + -- The SSE2 version is implemented as a C call (MO_I64X2_Min) + MO_VS_Min {} -> needLlvm mop + MO_VS_Max l@16 w@W8 + | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSB (SSE4.1) + | otherwise -> vector_int_minmax_sse Max l w x y + MO_VS_Max l@8 w@W16 + -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSW (SSE2) + MO_VS_Max l@4 w@W32 + | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSD (SSE4.1) + | otherwise -> vector_int_minmax_sse Max l w x y + MO_VS_Max l@2 w@W64 + | sse4_2 -> vector_int_minmax_sse Max l w x y -- PCMPGTQ requires SSE4.2 + -- The SSE2 version is implemented as a C call (MO_I64X2_Max) + MO_VS_Max {} -> needLlvm mop + + -- Unary MachOps + MO_S_Neg {} -> incorrectOperands + MO_F_Neg {} -> incorrectOperands + MO_Not {} -> incorrectOperands + MO_SF_Round {} -> incorrectOperands + MO_FS_Truncate {} -> incorrectOperands + MO_SS_Conv {} -> incorrectOperands + MO_XX_Conv {} -> incorrectOperands + MO_FF_Conv {} -> incorrectOperands + MO_UU_Conv {} -> incorrectOperands + MO_WF_Bitcast {} -> incorrectOperands + MO_FW_Bitcast {} -> incorrectOperands + MO_RelaxedRead {} -> incorrectOperands + MO_AlignmentCheck {} -> incorrectOperands + MO_VS_Neg {} -> incorrectOperands + MO_VF_Neg {} -> incorrectOperands + MO_V_Broadcast {} -> incorrectOperands + MO_VF_Broadcast {} -> incorrectOperands + + -- Ternary MachOps + MO_FMA {} -> incorrectOperands + MO_V_Insert {} -> incorrectOperands + MO_VF_Insert {} -> incorrectOperands + + where + -------------------- + triv_op width instr = trivialCode width op (Just op) x y + where op = instr (intFormat width) + + -- Special case for IMUL for bytes, since the result of IMULB will be in + -- %ax, the split to %dx/%edx/%rdx and %ax/%eax/%rax happens only for wider + -- values. + imulW8 :: CmmExpr -> CmmExpr -> NatM Register + imulW8 arg_a arg_b = do + (a_reg, a_code) <- getNonClobberedReg arg_a + b_code <- getAnyReg arg_b + + let code = a_code `appOL` b_code eax `appOL` + toOL [ IMUL2 format (OpReg a_reg) ] + format = intFormat W8 + + return (Fixed format eax code) + + imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + imulMayOflo W8 a b = do + -- The general case (W16, W32, W64) doesn't work for W8 as its + -- multiplication doesn't use two registers. + -- + -- The plan is: + -- 1. truncate and sign-extend a and b to 8bit width + -- 2. multiply a' = a * b in 32bit width + -- 3. copy and sign-extend 8bit from a' to c + -- 4. compare a' and c: they are equal if there was no overflow + (a_reg, a_code) <- getNonClobberedReg a + (b_reg, b_code) <- getNonClobberedReg b + let + code = a_code `appOL` b_code `appOL` + toOL [ + MOVSxL II8 (OpReg a_reg) (OpReg a_reg), + MOVSxL II8 (OpReg b_reg) (OpReg b_reg), + IMUL II32 (OpReg b_reg) (OpReg a_reg), + MOVSxL II8 (OpReg a_reg) (OpReg eax), + CMP II16 (OpReg a_reg) (OpReg eax), + SETCC NE (OpReg eax) + ] + return (Fixed II8 eax code) + imulMayOflo rep a b = do + (a_reg, a_code) <- getNonClobberedReg a + b_code <- getAnyReg b + let + shift_amt = case rep of + W16 -> 15 + W32 -> 31 + W64 -> 63 + w -> panic ("shift_amt: " ++ show w) + + format = intFormat rep + code = a_code `appOL` b_code eax `appOL` + toOL [ + IMUL2 format (OpReg a_reg), -- result in %edx:%eax + SAR format (OpImm (ImmInt shift_amt)) (OpReg eax), + -- sign extend lower part + SUB format (OpReg edx) (OpReg eax) + -- compare against upper + -- eax==0 if high part == sign extended low part + ] + return (Fixed format eax code) + + -------------------- + shift_code :: Width + -> (Format -> Operand -> Operand -> Instr) + -> CmmExpr + -> CmmExpr + -> NatM Register + + {- Case1: shift length as immediate -} + shift_code width instr x (CmmLit lit) + -- Handle the case of a shift larger than the width of the shifted value. + -- This is necessary since x86 applies a mask of 0x1f to the shift + -- amount, meaning that, e.g., `shr 47, $eax` will actually shift by + -- `47 & 0x1f == 15`. See #20626. + | CmmInt n _ <- lit + , n >= fromIntegral (widthInBits width) + = getRegister $ CmmLit $ CmmInt 0 width + + | otherwise = do + x_code <- getAnyReg x + let + format = intFormat width + code dst + = x_code dst `snocOL` + instr format (OpImm (litToImm lit)) (OpReg dst) + return (Any format code) + + {- Case2: shift length is complex (non-immediate) + * y must go in %ecx. + * we cannot do y first *and* put its result in %ecx, because + %ecx might be clobbered by x. + * if we do y second, then x cannot be + in a clobbered reg. Also, we cannot clobber x's reg + with the instruction itself. + * so we can either: + - do y first, put its result in a fresh tmp, then copy it to %ecx later + - do y second and put its result into %ecx. x gets placed in a fresh + tmp. This is likely to be better, because the reg alloc can + eliminate this reg->reg move here (it won't eliminate the other one, + because the move is into the fixed %ecx). + * in the case of C calls the use of ecx here can interfere with arguments. + We avoid this with the hack described in Note [Evaluate C-call + arguments before placing in destination registers] + -} + shift_code width instr x y{-amount-} = do + x_code <- getAnyReg x + let format = intFormat width + tmp <- getNewRegNat format + y_code <- getAnyReg y + let + code = x_code tmp `appOL` + y_code ecx `snocOL` + instr format (OpReg ecx) (OpReg tmp) + return (Fixed format tmp code) + + -------------------- + add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + add_code rep x (CmmLit (CmmInt y _)) + | is32BitInteger y + , rep /= W8 -- LEA doesn't support byte size (#18614) + = add_int rep x y + add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y + where format = intFormat rep + -- TODO: There are other interesting patterns we want to replace + -- with a LEA, e.g. `(x + offset) + (y << shift)`. + + -------------------- + sub_code :: Width -> CmmExpr -> CmmExpr -> NatM Register + sub_code rep x (CmmLit (CmmInt y _)) + | is32BitInteger (-y) + , rep /= W8 -- LEA doesn't support byte size (#18614) + = add_int rep x (-y) + sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y + + -- our three-operand add instruction: + add_int width x y = do + (x_reg, x_code) <- getSomeReg x + let + format = intFormat width + imm = ImmInt (fromInteger y) + code dst + = x_code `snocOL` + LEA format + (OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm)) + (OpReg dst) + -- + return (Any format code) + + ---------------------- + + -- See Note [DIV/IDIV for bytes] + div_code W8 signed quotient x y = do + let widen | signed = MO_SS_Conv W8 W16 + | otherwise = MO_UU_Conv W8 W16 + div_code + W16 + signed + quotient + (CmmMachOp widen [x]) + (CmmMachOp widen [y]) + + div_code width signed quotient x y = do + (y_op, y_code) <- getRegOrMem y -- cannot be clobbered + x_code <- getAnyReg x + let + format = intFormat width + widen | signed = CLTD format + | otherwise = XOR format (OpReg edx) (OpReg edx) + + instr | signed = IDIV + | otherwise = DIV + + code = y_code `appOL` + x_code eax `appOL` + toOL [widen, instr format y_op] + + result | quotient = eax + | otherwise = edx + + return (Fixed format result code) + + ----------------------- + -- Vector operations--- + vector_float_op_avx :: (Format -> Operand -> Reg -> Reg -> Instr) + -> Length + -> Width + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_float_op_avx instr l w = vector_op_avx_reg (\fmt -> instr fmt . OpReg) format + where format = case w of + W32 -> VecFormat l FmtFloat + W64 -> VecFormat l FmtDouble + _ -> pprPanic "Floating-point AVX vector operation not supported at this width" + (text "width:" <+> ppr w) + + vector_op_avx_reg :: (Format -> Reg -> Reg -> Reg -> Instr) + -> Format + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_op_avx_reg instr format expr1 expr2 = do + (reg1, exp1) <- getSomeReg expr1 + (reg2, exp2) <- getSomeReg expr2 + let -- opcode src2 src1 dst <==> dst = src1 `opcode` src2 + code dst = exp1 `appOL` exp2 `snocOL` + (instr format reg2 reg1 dst) + return (Any format code) + + vector_float_op_sse :: (Format -> Operand -> Reg -> Instr) + -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register + vector_float_op_sse instr l w = vector_op_sse instr format + where format = case w of + W32 -> VecFormat l FmtFloat + W64 -> VecFormat l FmtDouble + _ -> pprPanic "Floating-point SSE vector operation not supported at this width" + (text "width:" <+> ppr w) + + vector_int_op_sse :: (Format -> Operand -> Reg -> Instr) + -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register + vector_int_op_sse instr l w = vector_op_sse instr format + where format = case w of + W8 -> VecFormat l FmtInt8 + W16 -> VecFormat l FmtInt16 + W32 -> VecFormat l FmtInt32 + W64 -> VecFormat l FmtInt64 + _ -> pprPanic "Integer SSE vector operation not supported at this width" + (text "width:" <+> ppr w) + + -- This function is similar to genTrivialCode, but re-using it would require + -- handling alignment correctly: SSE vector instructions typically require 16-byte + -- alignment for their memory operand (this restriction is relaxed with VEX-encoded + -- instructions). + -- For now, we always load the value into a register and avoid the alignment issue. + vector_op_sse :: (Format -> Operand -> Reg -> Instr) + -> Format + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_op_sse instr = vector_op_sse_reg (\fmt -> instr fmt . OpReg) + + vector_op_sse_reg :: (Format -> Reg -> Reg -> Instr) + -> Format + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_op_sse_reg instr format expr1 expr2 = do + config <- getConfig + exp1_code <- getAnyReg expr1 + (reg2, exp2_code) <- getSomeReg expr2 -- vector registers are never clobbered by an instruction + tmp <- getNewRegNat format + let code dst + -- opcode src2 src1 <==> src1 = src1 `opcode` src2 + | dst == reg2 = exp2_code `snocOL` + movInstr config format (OpReg reg2) (OpReg tmp) `appOL` -- MOVU or MOVDQU + exp1_code dst `snocOL` + instr format tmp dst + | otherwise = exp2_code `appOL` + exp1_code dst `snocOL` + instr format reg2 dst + return (Any format code) + -------------------- + vector_float_extract :: Length + -> Width + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_float_extract l W32 expr (CmmLit lit) = do + (r, exp) <- getSomeReg expr + let format = VecFormat l FmtFloat + imm = litToImm lit + code dst + = case lit of + CmmInt 0 _ -> exp `snocOL` (MOV FF32 (OpReg r) (OpReg dst)) + CmmInt _ _ -> exp `snocOL` (VPSHUFD format imm (OpReg r) dst) + _ -> pprPanic "Unsupported AVX floating-point vector extract offset" (ppr lit) + return (Any FF32 code) + vector_float_extract _ W64 expr (CmmLit lit) = do + (r, exp) <- getSomeReg expr + let code dst + = case lit of + CmmInt 0 _ -> exp `snocOL` + (MOV FF64 (OpReg r) (OpReg dst)) + CmmInt 1 _ -> exp `snocOL` + (MOVHLPS FF64 r dst) + _ -> pprPanic "Unsupported AVX floating-point vector extract offset" (ppr lit) + return (Any FF64 code) + vector_float_extract _ w c e = + pprPanic "Unsupported AVX floating-point vector extract" (pdoc platform c $$ pdoc platform e $$ ppr w) + ----------------------- + + vector_float_extract_sse :: Length + -> Width + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_float_extract_sse l W32 expr (CmmLit lit) + = do + (r,exp) <- getSomeReg expr + let format = VecFormat l FmtFloat + imm = litToImm lit + code dst + = case lit of + CmmInt 0 _ -> exp `snocOL` (MOVU format (OpReg r) (OpReg dst)) + CmmInt _ _ -> exp `snocOL` (PSHUFD format imm (OpReg r) dst) + _ -> pprPanic "Unsupported SSE floating-point vector extract offset" (ppr lit) + return (Any FF32 code) + vector_float_extract_sse _ w c e + = pprPanic "Unsupported SSE floating-point vector extract" (pdoc platform c $$ pdoc platform e $$ ppr w) + ----------------------- + + -- PEXTRW ("to GPR" variant) is an SSE2 instruction, + -- whereas PEXTR{B,D,Q} and PEXTRW ("to memory" variant) require SSE4.1. + vector_int_extract_pextr :: Length + -> Width + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int_extract_pextr l w expr (CmmLit (CmmInt i _)) + | 0 <= i, i < toInteger l + = do + (r, exp) <- getSomeReg expr -- vector registers are never clobbered by an instruction + let (scalarFormat, vectorFormat) = case w of + W8 -> (II32, VecFormat l FmtInt8) + W16 -> (II32, VecFormat l FmtInt16) + W32 -> (II32, VecFormat l FmtInt32) + W64 -> (II64, VecFormat l FmtInt64) + _ -> sorry "Unsupported vector format" + code dst = exp `snocOL` + (PEXTR scalarFormat vectorFormat (ImmInteger i) r (OpReg dst)) + return (Any scalarFormat code) + vector_int_extract_pextr _ _ _ i + = pprPanic "Unsupported offset" (pdoc platform i) + + vector_int8x16_extract_sse2 :: CmmExpr + -> CmmExpr + -> NatM Register + vector_int8x16_extract_sse2 expr (CmmLit (CmmInt i _)) + | 0 <= i, i < 16 + = do + (r, exp) <- getSomeReg expr + let code dst = + case i `quotRem` 2 of + (j, 0) -> exp `snocOL` + (PEXTR II32 (VecFormat 8 FmtInt16) (ImmInteger j) r (OpReg dst)) -- PEXTRW + (j, _) -> exp `snocOL` + (PEXTR II32 (VecFormat 8 FmtInt16) (ImmInteger j) r (OpReg dst)) `snocOL` -- PEXTRW + (SHR II32 (OpImm (ImmInt 8)) (OpReg dst)) + return (Any II8 code) + vector_int8x16_extract_sse2 _ offset + = pprPanic "Unsupported offset" (pdoc platform offset) + + vector_int32x4_extract_sse2 :: CmmExpr + -> CmmExpr + -> NatM Register + vector_int32x4_extract_sse2 expr (CmmLit (CmmInt i _)) + | 0 <= i, i < 4 + = do + (r, exp) <- getSomeReg expr + let fmt = VecFormat 4 FmtInt32 + tmp <- getNewRegNat fmt + let code dst = + case i of + 0 -> exp `snocOL` + (MOVD fmt II32 (OpReg r) (OpReg dst)) + 1 -> exp `snocOL` + (PSHUFD fmt (ImmInt 0b01_01_01_01) (OpReg r) tmp) `snocOL` -- tmp <- (r[1],r[1],r[1],r[1]) + (MOVD fmt II32 (OpReg tmp) (OpReg dst)) + 2 -> exp `snocOL` + (PSHUFD fmt (ImmInt 0b11_10_11_10) (OpReg r) tmp) `snocOL` -- tmp <- (r[2],r[3],r[2],r[3]) + (MOVD fmt II32 (OpReg tmp) (OpReg dst)) + _ -> exp `snocOL` + (PSHUFD fmt (ImmInt 0b11_11_11_11) (OpReg r) tmp) `snocOL` -- tmp <- (r[3],r[3],r[3],r[3]) + (MOVD fmt II32 (OpReg tmp) (OpReg dst)) + return (Any II32 code) + vector_int32x4_extract_sse2 _ offset + = pprPanic "Unsupported offset" (pdoc platform offset) + + vector_int64x2_extract_sse2 :: CmmExpr + -> CmmExpr + -> NatM Register + vector_int64x2_extract_sse2 expr (CmmLit lit) + = do + (r, exp) <- getSomeReg expr + let fmt = VecFormat 2 FmtInt64 + tmp <- getNewRegNat fmt + let code dst = + case lit of + CmmInt 0 _ -> exp `snocOL` + (MOVD fmt II64 (OpReg r) (OpReg dst)) + CmmInt 1 _ -> exp `snocOL` + (MOVHLPS FF64 r tmp) `snocOL` + (MOVD fmt II64 (OpReg tmp) (OpReg dst)) + _ -> panic "Error in offset while unpacking" + return (Any II64 code) + vector_int64x2_extract_sse2 _ offset + = pprPanic "Unsupported offset" (pdoc platform offset) + + vector_int8x16_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register + vector_int8x16_mul_sse2 expr1 expr2 = do + -- use two SSE2 PMULLW (low 16 bits of int16 multiplication) operations + (reg1, exp1) <- getSomeReg expr1 + (reg2, exp2) <- getSomeReg expr2 + let format = VecFormat 16 FmtInt8 + format16 = VecFormat 8 FmtInt16 -- for PMULLW + tmp1lo <- getNewRegNat format + tmp1hi <- getNewRegNat format + tmp2hi <- getNewRegNat format + tmp2lo <- getNewRegNat format + (maskReg, maskCode) <- getSomeReg (CmmLit $ CmmVec $ replicate 8 (CmmInt 0xff W16)) -- (0xff,0,0xff,0,...,0xff,0) :: Int8X16 + let code = exp1 `appOL` exp2 `appOL` maskCode `snocOL` + (MOVDQU format (OpReg reg1) (OpReg tmp1lo)) `snocOL` -- tmp1lo <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp2lo)) `snocOL` -- tmp2lo <- reg2 + (PUNPCKLBW format (OpReg reg1) tmp1lo) `snocOL` -- tmp1lo <- (tmp1lo[0],reg1[0],tmp1lo[1],reg1[1],...,tmp1lo[7],reg1[7]); The first operand does not really matter + (PUNPCKLBW format (OpReg reg2) tmp2lo) `snocOL` -- tmp2lo <- (tmp2lo[0],reg2[0],tmp2lo[1],reg2[1],...,tmp2lo[7],reg2[7]); The first operand does not really matter + (MOVDQU format (OpReg reg1) (OpReg tmp1hi)) `snocOL` -- tmp1hi <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp2hi)) `snocOL` -- tmp2hi <- reg2 + (PUNPCKHBW format (OpReg reg1) tmp1hi) `snocOL` -- tmp1hi <- (tmp1hi[8],reg1[8],tmp1hi[9],reg1[9],...,tmp1hi[15],reg1[15]); The first operand does not really matter + (PMULL format16 (OpReg tmp2lo) tmp1lo) `snocOL` -- PMULLW; tmp1lo <- (tmp1lo[0]*tmp2lo[0],*,tmp1lo[2]*tmp2lo[2],*,...,tmp1lo[14]*tmp2lo[14],*) + (PUNPCKHBW format (OpReg reg2) tmp2hi) `snocOL` -- tmp2hi <- (tmp2hi[8],reg2[8],tmp2hi[9],reg2[9],...,tmp2hi[15],reg2[15]); The first operand does not really matter + (PMULL format16 (OpReg tmp2hi) tmp1hi) `snocOL` -- PMULLW; tmp1hi <- (tmp1hi[0]*tmp2hi[0],*,tmp1hi[2]*tmp2hi[2],*,...,tmp1hi[14]*tmp2hi[14],*) + (PAND format (OpReg maskReg) tmp1lo) `snocOL` -- tmp1lo <- (tmp1lo[0],0,tmp1lo[2],0,...,tmp1lo[14],0) + (PAND format (OpReg maskReg) tmp1hi) `snocOL` -- tmp1hi <- (tmp1hi[0],0,tmp1hi[2],0,...,tmp1hi[14],0) + (PACKUSWB format (OpReg tmp1hi) tmp1lo) -- tmp1lo <- (tmp1lo[0],tmp1lo[2],...,tmp1lo[14],tmp1hi[0],tmp1hi[2],...tmp1hi[14]) + return (Fixed format tmp1lo code) + + vector_int32x4_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register + vector_int32x4_mul_sse2 expr1 expr2 = do + -- use two SSE2 PMULUDQ (int32 x int32 -> int64 multiplication) operations + (reg1, exp1) <- getSomeReg expr1 + (reg2, exp2) <- getSomeReg expr2 + let format = VecFormat 4 FmtInt32 + tmpEven <- getNewRegNat format + tmpOdd1 <- getNewRegNat format + tmpOdd2 <- getNewRegNat format + let code dst = exp1 `appOL` exp2 `snocOL` + (MOVDQU format (OpReg reg1) (OpReg tmpEven)) `snocOL` -- tmpEven <- reg1 + (PSHUFD format (ImmInt 0b11_11_01_01) (OpReg reg1) tmpOdd1) `snocOL` -- tmpOdd1 <- (reg1[1],reg1[1],reg1[3],reg1[3]) + (PMULUDQ format (OpReg reg2) tmpEven) `snocOL` -- tmpEven <- (tmpEven[0]*reg2[0],*,tmpEven[2]*reg2[2],*) + (PSHUFD format (ImmInt 0b11_11_01_01) (OpReg reg2) tmpOdd2) `snocOL` -- tmpOdd2 <- (reg2[1],reg2[1],reg2[3],reg2[3]) + (PMULUDQ format (OpReg tmpOdd2) tmpOdd1) `snocOL` -- tmpOdd1 <- (tmpOdd1[0]*tmpOdd2[0],*,tmpOdd1[2]*tmpOdd2[2],*) + (PSHUFD format (ImmInt 0b00_00_10_00) (OpReg tmpEven) dst) `snocOL` -- dst <- (tmpEven[0],tmpEven[2],tmpEven[0],tmpEven[0]) + (PSHUFD format (ImmInt 0b00_00_10_00) (OpReg tmpOdd1) tmpOdd1) `snocOL` -- tmpOdd1 <- (tmpOdd1[0],tmpOdd1[2],tmpOdd1[0],tmpOdd1[0]) + (PUNPCKLDQ format (OpReg tmpOdd1) dst) -- dst <- (dst[0],tmpOdd1[0],dst[1],tmpOdd1[1]) + return (Any format code) + + -- TODO: We could use `VPMULLQ` if AVX-512 or AVX10.1 is available. + vector_int64x2_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register + vector_int64x2_mul_sse2 expr1 expr2 = do + -- implement 64 bit multiplication using 32-bit PMULUDQ multiplication instructions + -- (lo1 + shiftL hi1 32) * (lo2 + shiftL hi2 32) = lo1 * lo2 + shiftL (lo1 * hi2) 32 + shiftL (lo2 * hi1) 32 + exp1 <- getAnyReg expr1 + exp2 <- getAnyReg expr2 + let format = VecFormat 2 FmtInt64 + reg1 <- getNewRegNat format + reg2 <- getNewRegNat format + tmp1Hi <- getNewRegNat format + tmp2Hi <- getNewRegNat format + let code dst = exp1 reg1 `appOL` exp2 reg2 `snocOL` + (MOVDQU format (OpReg reg1) (OpReg dst)) `snocOL` -- dst <- reg1 + (MOVDQU format (OpReg reg1) (OpReg tmp1Hi)) `snocOL` -- tmp1Hi <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp2Hi)) `snocOL` -- tmp2Hi <- reg2 + (PSRL format (OpImm (ImmInt 32)) tmp1Hi) `snocOL` -- PSRLQ (logical shift); tmp1Hi <- (tmp1Hi[0] >> 32, tmp1Hi[1] >> 32) + (PMULUDQ format (OpReg reg2) dst) `snocOL` -- dst <- ((dst as Word32X4)[0] * (reg2 as Word32X4)[0] as Word64, (dst as Word32X4)[2] * (reg2 as Word32X4)[2] as Word64) + (PSRL format (OpImm (ImmInt 32)) tmp2Hi) `snocOL` -- PSRLQ (logical shift); tmp2Hi <- (tmp2Hi[0] >> 32, tmp2Hi[1] >> 32) + (PMULUDQ format (OpReg reg2) tmp1Hi) `snocOL` -- tmp1Hi <- ((tmp1Hi as Word32X4)[0] * (reg2 as Word32X4)[0] as Word64, (tmp1Hi as Word32X4)[2] * (reg2 as Word32X4)[2] as Word64) + (PMULUDQ format (OpReg reg1) tmp2Hi) `snocOL` -- tmp2Hi <- ((tmp2Hi as Word32X4)[0] * (reg1 as Word32X4)[0] as Word64, (tmp2Hi as Word32X4)[2] * (reg1 as Word32X4)[2] as Word64) + (PADD format (OpReg tmp2Hi) tmp1Hi) `snocOL` -- PADDQ; tmp1Hi <- (tmp1Hi[0] + tmp2Hi[0], tmp1Hi[1] + tmp2Hi[1]) + (PSLL format (OpImm (ImmInt 32)) tmp1Hi) `snocOL` -- PSLLQ; tmp1Hi <- (tmp1Hi[0] << 32, tmp1Hi[1] << 32) + (PADD format (OpReg tmp1Hi) dst) -- PADDQ; dst <- (dst[0] + tmp1Hi[0], dst[1] + tmp1Hi[1]) + return (Any format code) + + vector_int_minmax_sse :: MinOrMax -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register + vector_int_minmax_sse minmax l w expr1 expr2 = do + -- SSE2 fallback: compute a mask of 0s/1s using PCMPGT, then max a b = (mask & a) | (not mask & b) + exp1 <- getAnyReg expr1 + exp2 <- getAnyReg expr2 + let format = case w of + W8 -> VecFormat l FmtInt8 + W16 -> VecFormat l FmtInt16 + W32 -> VecFormat l FmtInt32 + W64 -> VecFormat l FmtInt64 + _ -> panic "Unsupported width" + reg1 <- getNewRegNat format + reg2 <- getNewRegNat format + tmp <- getNewRegNat format + let codeMin dst = exp1 reg1 `appOL` exp2 reg2 `snocOL` + (MOVDQU format (OpReg reg1) (OpReg dst)) `snocOL` -- dst <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp)) `snocOL` -- tmp <- reg2 + (PCMPGT format (OpReg reg2) dst) `snocOL` -- dst <- if dst > reg2 then True(-1) else False(0) + (PAND format (OpReg dst) tmp) `snocOL` -- tmp <- tmp & dst; if dst then tmp else 0 + (PANDN format (OpReg reg1) dst) `snocOL` -- dst <- ~dst & reg1; if dst then 0 else reg1 + (POR format (OpReg tmp) dst) -- dst <- tmp | dst + codeMax dst = exp1 reg1 `appOL` exp2 reg2 `snocOL` + (MOVDQU format (OpReg reg1) (OpReg dst)) `snocOL` -- dst <- reg1 + (MOVDQU format (OpReg reg1) (OpReg tmp)) `snocOL` -- tmp <- reg1 + (PCMPGT format (OpReg reg2) dst) `snocOL` -- dst <- if dst > reg2 then True(-1) else False(0) + (PAND format (OpReg dst) tmp) `snocOL` -- tmp <- tmp & dst; if dst then tmp else 0 + (PANDN format (OpReg reg2) dst) `snocOL` -- dst <- ~dst & reg2; if dst then 0 else reg2 + (POR format (OpReg tmp) dst) -- dst <- tmp | dst + return $ case minmax of + Min -> Any format codeMin + Max -> Any format codeMax + + vector_word_minmax_sse :: MinOrMax -> Length -> Width -> CmmExpr -> CmmExpr -> NatM Register + vector_word_minmax_sse minmax l w expr1 expr2 = do + -- SSE2 fallback: compute a mask of 0s/1s using PCMPGT, then max a b = (mask & a) | (not mask & b) + -- We can use PCMPGT to compare unsigned integers by flipping the most significant bit. + exp1 <- getAnyReg expr1 + exp2 <- getAnyReg expr2 + let (format, sign) = case w of + W8 -> (VecFormat l FmtInt8, 0x80) + W16 -> (VecFormat l FmtInt16, 0x8000) + W32 -> (VecFormat l FmtInt32, 2^(31 :: Int)) + W64 -> (VecFormat l FmtInt64, 2^(63 :: Int)) + _ -> panic "Unsupported width" + reg1 <- getNewRegNat format + reg2 <- getNewRegNat format + tmp1 <- getNewRegNat format + tmp2 <- getNewRegNat format + (signReg, signCode) <- getSomeReg (CmmLit $ CmmVec $ replicate l (CmmInt sign w)) + let codeMin dst = exp1 reg1 `appOL` exp2 reg2 `appOL` signCode `snocOL` + (MOVDQU format (OpReg reg1) (OpReg dst)) `snocOL` -- dst <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp1)) `snocOL` -- tmp1 <- reg2 + (MOVDQU format (OpReg reg2) (OpReg tmp2)) `snocOL` -- tmp2 <- reg2 + (PXOR format (OpReg signReg) dst) `snocOL` -- dst <- dst ^ 2^(w-1) + (PXOR format (OpReg signReg) tmp1) `snocOL` -- tmp1 < dst ^ 2^(w-1) + (PCMPGT format (OpReg tmp1) dst) `snocOL` -- dst <- if dst > tmp1 then True(-1) else False(0) + (PAND format (OpReg dst) tmp2) `snocOL` -- tmp2 <- tmp2 & dst; if dst then tmp2 else 0 + (PANDN format (OpReg reg1) dst) `snocOL` -- dst <- ~dst & reg1; if dst then 0 else reg1 + (POR format (OpReg tmp2) dst) -- dst <- tmp2 | dst + codeMax dst = exp1 reg1 `appOL` exp2 reg2 `appOL` signCode `snocOL` + (MOVDQU format (OpReg reg1) (OpReg dst)) `snocOL` -- dst <- reg1 + (MOVDQU format (OpReg reg2) (OpReg tmp1)) `snocOL` -- tmp1 <- reg2 + (MOVDQU format (OpReg reg1) (OpReg tmp2)) `snocOL` -- tmp2 <- reg1 + (PXOR format (OpReg signReg) dst) `snocOL` -- dst <- dst ^ 2^(w-1) + (PXOR format (OpReg signReg) tmp1) `snocOL` -- tmp1 <- tmp1 ^ 2^(w-1) + (PCMPGT format (OpReg tmp1) dst) `snocOL` -- dst <- if dst > tmp1 then True(-1) else False(0) + (PAND format (OpReg dst) tmp2) `snocOL` -- tmp2 <- tmp2 & dst; if dst then tmp2 else 0 + (PANDN format (OpReg reg2) dst) `snocOL` -- dst <- ~dst & reg2; if dst then 0 else reg2 + (POR format (OpReg tmp2) dst) -- dst <- tmp2 | dst + return $ case minmax of + Min -> Any format codeMin + Max -> Any format codeMax + + vector_shuffle_floatx4_sse :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_floatx4_sse sse4_1 v1 v2 is + | length is == 4, all (\i -> 0 <= i && i < 8) is = do + let fmt = VecFormat 4 FmtFloat + + -- A helper function to shuffle a vector `r` in-place using (dst,src) pairs + -- (r[d0],r[d1],...) <- (r[s0],r[s1],...) + inplaceShuffle pairs r = do + let mask = foldl' (\acc (dst,src) -> acc .|. (src `shiftL` (2 * dst))) 0 pairs + case mask of + 0b11_10_01_00 -> nilOL -- trivial + 0b01_00_01_00 -> unitOL (MOVLHPS fmt r r) + 0b11_10_11_10 -> unitOL (MOVHLPS fmt r r) + 0b01_01_00_00 -> unitOL (UNPCKL fmt (OpReg r) r) + 0b11_11_10_10 -> unitOL (UNPCKH fmt (OpReg r) r) + _ -> unitOL (SHUF fmt (ImmInt mask) (OpReg r) r) + + -- All elements are from one source vector + oneSource p0 p1 p2 p3 v = do + exp <- getAnyReg v + let code dst = exp dst `appOL` + inplaceShuffle [p0,p1,p2,p3] dst + return $ Any fmt code + + -- Two elements from one vector, other two from the other vector + twoAndTwo (0,0) (1,1) (2,0) (3,1) v1 v2 = vector_op_sse_reg MOVLHPS fmt v1 v2 + twoAndTwo (2,0) (3,1) (0,0) (1,1) v1 v2 = vector_op_sse_reg MOVLHPS fmt v2 v1 + twoAndTwo (2,2) (3,3) (0,2) (1,3) v1 v2 = vector_op_sse_reg MOVHLPS fmt v1 v2 + twoAndTwo (0,2) (1,3) (2,2) (3,3) v1 v2 = vector_op_sse_reg MOVHLPS fmt v2 v1 + twoAndTwo (0,0) (2,1) (1,0) (3,1) v1 v2 = vector_op_sse UNPCKL fmt v1 v2 + twoAndTwo (1,0) (3,1) (0,0) (2,1) v1 v2 = vector_op_sse UNPCKL fmt v2 v1 + twoAndTwo (0,2) (2,3) (1,2) (3,3) v1 v2 = vector_op_sse UNPCKH fmt v1 v2 + twoAndTwo (1,2) (3,3) (0,2) (2,3) v1 v2 = vector_op_sse UNPCKH fmt v2 v1 + twoAndTwo p0 p1 q0 q1 v1 v2 = + if sse4_1 && all (\(dst,src) -> dst == src) [p0,p1,q0,q1] then + let imm = (1 `shiftL` fst q0) .|. (1 `shiftL` fst q1) + in vector_op_sse (`BLEND` (ImmInt imm)) fmt v1 v2 + else do + let imm = snd p0 .|. (snd p1 `shiftL` 2) .|. (snd q0 `shiftL` 4) .|. (snd q1 `shiftL` 6) + reg <- vector_op_sse (`SHUF` (ImmInt imm)) fmt v1 v2 + exp <- anyReg reg + let code dst = exp dst `appOL` + inplaceShuffle [(fst p0,0),(fst p1,1),(fst q0,2),(fst q1,3)] dst + return $ Any fmt code + + -- Three elements from one vector, the last one from the other vector + threeAndOne p0 p1 p2 q0 v1 v2 + | sse4_1 = do -- Use INSERTPS + exp1 <- getAnyReg v1 + (r2, exp2) <- getSomeReg v2 + let imm2 = (snd q0 `shiftL` 6) .|. (fst q0 `shiftL` 4) + dst <- getNewRegNat fmt + let code = exp1 dst `appOL` exp2 `appOL` + inplaceShuffle [p0,p1,p2,(fst q0,fst q0)] dst `snocOL` + (INSERTPS fmt (ImmInt imm2) (OpReg r2) dst) + return $ Fixed fmt dst code + + | (_, 0) <- q0, 0 `notElem` [snd p0,snd p1,snd p2] = do -- Use MOVSS + exp1 <- getAnyReg v1 + (r2, exp2) <- getSomeReg v2 + dst <- getNewRegNat fmt + let code = exp1 dst `appOL` exp2 `snocOL` + (MOV fmt (OpReg r2) (OpReg dst)) `appOL` + inplaceShuffle [p0,p1,p2,(fst q0,0)] dst + return $ Fixed fmt dst code + + | otherwise = do -- Use two or three SHUFPSs + (r1, exp1) <- getSomeReg v1 + exp2 <- getAnyReg v2 + let makeMask i0 i1 i2 i3 = i0 .|. (i1 `shiftL` 2) .|. (i2 `shiftL` 4) .|. (i3 `shiftL` 6) + let imm1 = makeMask (snd q0) (snd q0) (snd p0) (snd p0) + (imm2, pairs) = + if fst q0 == 1 then + (makeMask 2 1 (snd p1) (snd p2), [(fst p0,0),(fst q0,1),(fst p1,2),(fst p2,3)]) + -- dst <- (dst[2],dst[1],r1[snd p1],r1[snd p2]) = (v1[snd p0],v2[snd q0],v1[snd p1],v1[snd p2]) + -- (dst[fst p0],dst[fst q0],dst[fst p1],dst[fst p2]) <- dst + else + (makeMask 0 2 (snd p1) (snd p2), [(fst q0,0),(fst p0,1),(fst p1,2),(fst p2,3)]) + -- dst <- (dst[0],dst[2],r1[snd p1],r1[snd p2]) = (v2[snd q0],v1[snd p0],v1[snd p1],v1[snd p2]) + -- (dst[fst p0],dst[fst q0],dst[fst p1],dst[fst p2]) <- dst + dst <- getNewRegNat fmt + let code = exp1 `appOL` exp2 dst `snocOL` + (SHUF fmt (ImmInt imm1) (OpReg r1) dst) `snocOL` -- dst <- (dst[snd q0],dst[snd q0],r1[snd p0],r1[snd p0]) = (v2[snd q0],v2[snd q0],v1[snd p0],v1[snd p0]) + (SHUF fmt (ImmInt imm2) (OpReg r1) dst) `appOL` + inplaceShuffle pairs dst + return $ Fixed fmt dst code + + -- We partition the list of indices into those that refer to the first vector and those that + -- refer to the second, and handle each case depending on the number of indices in each group. + let (from_first, from_second) = partition (\(_dstPos, srcPos) -> srcPos < 4) (zip [0..] is) + case (from_first, map (\(dst, src) -> (dst, src - 4)) from_second) of + ([p0,p1,p2,p3], []) -> oneSource p0 p1 p2 p3 v1 + ([], [q0,q1,q2,q3]) -> oneSource q0 q1 q2 q3 v2 + ([p0,p1], [q0,q1]) -> twoAndTwo p0 p1 q0 q1 v1 v2 + ([p0], [q0,q1,q2]) -> threeAndOne q0 q1 q2 p0 v2 v1 + ([p0,p1,p2], [q0]) -> threeAndOne p0 p1 p2 q0 v1 v2 + _ -> pprPanic "vector shuffle: cannot occur" (ppr is) + | otherwise = pprPanic "vector shuffle: wrong indices" (ppr is) + + -- Shuffle with AVX instructions. + -- The components above 128 bits are shuffled in the same way as the lower 128 bits. + -- For example, `l == 8 && is == [0,2,5,7]` would represent `shuffleFloatX8# _ _ (# 0#, 2#, 9#, 11#, 4#, 6#, 13#, 15# #)`. + vector_shuffle_float_avx :: Length -- Vector length. 4 for XMM, 8 for YMM, 16 for ZMM. + -> CmmExpr + -> CmmExpr + -> [Int] -- 4-element list of indices + -> NatM Register + vector_shuffle_float_avx l v1 v2 is + | length is == 4, all (\i -> 0 <= i && i < 8) is = do + let fmt = VecFormat l FmtFloat + + -- A helper function to shuffle a vector using (dst,src) pairs + -- (dst[d0],dst[d1],...) <- (r[s0],r[s1],...) + inplaceShuffle pairs r dst = do + let mask = foldl' (\acc (dst,src) -> acc .|. (src `shiftL` (2 * dst))) 0 pairs + case mask of + 0b11_10_01_00 | r == dst -> nilOL + | otherwise -> unitOL (VMOVU fmt (OpReg r) (OpReg dst)) -- trivial + 0b01_00_01_00 | l == 4 -> unitOL (VMOVLHPS fmt r r dst) -- 128-bit only + 0b11_10_11_10 | l == 4 -> unitOL (VMOVHLPS fmt r r dst) -- 128-bit only + 0b01_01_00_00 -> unitOL (VUNPCKL fmt (OpReg r) r dst) + 0b11_11_10_10 -> unitOL (VUNPCKH fmt (OpReg r) r dst) + _ -> unitOL (VSHUF fmt (ImmInt mask) (OpReg r) r dst) + + -- All elements are from one source vector + oneSource p0 p1 p2 p3 v = do + (r, exp) <- getSomeReg v + let code dst = exp `appOL` + inplaceShuffle [p0,p1,p2,p3] r dst + return $ Any fmt code + + -- Two elements from one vector, other two from the other vector + twoAndTwo (0,0) (1,1) (2,0) (3,1) v1 v2 | l == 4 = vector_op_avx_reg VMOVLHPS fmt v1 v2 + twoAndTwo (2,0) (3,1) (0,0) (1,1) v1 v2 | l == 4 = vector_op_avx_reg VMOVLHPS fmt v2 v1 + twoAndTwo (2,2) (3,3) (0,2) (1,3) v1 v2 | l == 4 = vector_op_avx_reg VMOVHLPS fmt v1 v2 + twoAndTwo (0,2) (1,3) (2,2) (3,3) v1 v2 | l == 4 = vector_op_avx_reg VMOVHLPS fmt v2 v1 + twoAndTwo (0,0) (2,1) (1,0) (3,1) v1 v2 = vector_float_op_avx VUNPCKL l W32 v1 v2 + twoAndTwo (1,0) (3,1) (0,0) (2,1) v1 v2 = vector_float_op_avx VUNPCKL l W32 v2 v1 + twoAndTwo (0,2) (2,3) (1,2) (3,3) v1 v2 = vector_float_op_avx VUNPCKH l W32 v1 v2 + twoAndTwo (1,2) (3,3) (0,2) (2,3) v1 v2 = vector_float_op_avx VUNPCKH l W32 v2 v1 + twoAndTwo p0 p1 q0 q1 v1 v2 = + if l <= 8 && all (\(dst,src) -> dst == src) [p0,p1,q0,q1] then + -- VBLENDPS does not support ZMM (no EVEX-encoded variant) + let imm = (1 `shiftL` fst q0) .|. (1 `shiftL` fst q1) + imm' = if l == 4 then imm .|. (imm `shiftL` 4) else imm + in vector_float_op_avx (`VBLEND` (ImmInt imm')) l W32 v1 v2 + else do + let imm1 = snd p0 .|. (snd p1 `shiftL` 2) .|. (snd q0 `shiftL` 4) .|. (snd q1 `shiftL` 6) + reg <- vector_float_op_avx (`VSHUF` (ImmInt imm1)) l W32 v1 v2 + exp <- anyReg reg + let code dst = exp dst `appOL` + inplaceShuffle [(fst p0,0),(fst p1,1),(fst q0,2),(fst q1,3)] dst dst + return $ Any fmt code + + -- Three elements from one vector, the last one from the other vector + threeAndOne p0 p1 p2 q0 v1 v2 + | l == 4, (_, 0) <- q0, 0 `notElem` [snd p0,snd p1,snd p2] = do -- Use VMOVSS (128-bit only) + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + let code dst = exp1 `appOL` exp2 `snocOL` + (VMOV_MERGE fmt r2 r1 dst) `appOL` + inplaceShuffle [p0,p1,p2,(fst q0,0)] dst dst + return $ Any fmt code + + | l == 4 = do -- Use VINSERTPS (128-bit only) + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + let i = case [0, 1, 2, 3] \\ [snd p0, snd p1, snd p2] of + i:_ -> i -- We can clobber this position of r1 + _ -> panic "cannot occur" + imm = (snd q0 `shiftL` 6) .|. (i `shiftL` 4) + code dst = exp1 `appOL` exp2 `snocOL` + (VINSERTPS fmt (ImmInt imm) (OpReg r2) r1 dst) `appOL` + inplaceShuffle [p0,p1,p2,(fst q0,i)] dst dst + return $ Any fmt code + + | otherwise = do -- Use two or three VSHUFPSs + (r1, exp1) <- getSomeReg v1 + exp2 <- getAnyReg v2 + let makeMask i0 i1 i2 i3 = i0 .|. (i1 `shiftL` 2) .|. (i2 `shiftL` 4) .|. (i3 `shiftL` 6) + let imm1 = makeMask (snd q0) (snd q0) (snd p0) (snd p0) + (imm2, pairs) = + if fst q0 == 1 then + (makeMask 2 1 (snd p1) (snd p2), [(fst p0,0),(fst q0,1),(fst p1,2),(fst p2,3)]) + -- dst <- (dst[2],dst[1],r1[snd p1],r1[snd p2]) = (v1[snd p0],v2[snd q0],v1[snd p1],v1[snd p2]) + -- (dst[fst p0],dst[fst q0],dst[fst p1],dst[fst p2]) <- dst + else + (makeMask 0 2 (snd p1) (snd p2), [(fst q0,0),(fst p0,1),(fst p1,2),(fst p2,3)]) + -- dst <- (dst[0],dst[2],r1[snd p1],r1[snd p2]) = (v2[snd q0],v1[snd p0],v1[snd p1],v1[snd p2]) + -- (dst[fst p0],dst[fst q0],dst[fst p1],dst[fst p2]) <- dst + dst <- getNewRegNat fmt + let code = exp1 `appOL` exp2 dst `snocOL` + (VSHUF fmt (ImmInt imm1) (OpReg r1) dst dst) `snocOL` -- dst <- (dst[snd q0],dst[snd q0],r1[snd p0],r1[snd p0]) = (v2[snd q0],v2[snd q0],v1[snd p0],v1[snd p0]) + (VSHUF fmt (ImmInt imm2) (OpReg r1) dst dst) `appOL` + inplaceShuffle pairs dst dst + return $ Fixed fmt dst code + + -- We partition the list of indices into those that refer to the first vector and those that + -- refer to the second, and handle each case depending on the number of indices in each group. + let (from_first, from_second) = partition (\(_dstPos, srcPos) -> srcPos < 4) (zip [0..] is) + case (from_first, map (\(dst, src) -> (dst, src - 4)) from_second) of + ([p0,p1,p2,p3], []) -> oneSource p0 p1 p2 p3 v1 + ([], [q0,q1,q2,q3]) -> oneSource q0 q1 q2 q3 v2 + ([p0,p1], [q0,q1]) -> twoAndTwo p0 p1 q0 q1 v1 v2 + ([p0], [q0,q1,q2]) -> threeAndOne q0 q1 q2 p0 v2 v1 + ([p0,p1,p2], [q0]) -> threeAndOne p0 p1 p2 q0 v1 v2 + _ -> pprPanic "vector shuffle: cannot occur" (ppr is) + | otherwise = pprPanic "vector shuffle: wrong indices" (ppr is) + + vector_shuffle_doublex2_sse :: CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_doublex2_sse v1 v2 is + | [i0, i1] <- is = + let fmt = VecFormat 2 FmtDouble + in case (i0, i1) of + -- Trivial cases + (0, 1) -> getRegister' platform is32Bit v1 + (2, 3) -> getRegister' platform is32Bit v2 + + -- MOVSD/UNPCKLPD/UNPCKHPD have shorter encoding than SHUFPD + -- If SSE4.1 is available, BLENDPD could also be used in place of MOVSD (the encoding is longer though) + (0, 3) -> vector_op_sse (\_ src -> MOV fmt src . OpReg) fmt v2 v1 -- MOVSD + (2, 1) -> vector_op_sse (\_ src -> MOV fmt src . OpReg) fmt v1 v2 -- MOVSD + _ | i0 == i1 -> do + exp <- getAnyReg (if i0 <= 1 then v1 else v2) + let unpck = if i0 == 0 || i0 == 2 + then UNPCKL + else UNPCKH + code dst = exp dst `snocOL` + (unpck fmt (OpReg dst) dst) + return (Any fmt code) + (0, 2) -> vector_op_sse UNPCKL fmt v1 v2 + (2, 0) -> vector_op_sse UNPCKL fmt v2 v1 + (1, 3) -> vector_op_sse UNPCKH fmt v1 v2 + (3, 1) -> vector_op_sse UNPCKH fmt v2 v1 + + -- SHUFPD + (1, 2) -> vector_op_sse (`SHUF` (ImmInt 0b01)) fmt v1 v2 + (3, 0) -> vector_op_sse (`SHUF` (ImmInt 0b01)) fmt v2 v1 + (1, 0) -> do + exp <- getAnyReg v1 + let code dst = exp dst `snocOL` + (SHUF fmt (ImmInt 0b01) (OpReg dst) dst) + return (Any fmt code) + (3, 2) -> do + exp <- getAnyReg v2 + let code dst = exp dst `snocOL` + (SHUF fmt (ImmInt 0b01) (OpReg dst) dst) + return (Any fmt code) + _ -> pprPanic "vector shuffle: indices out of bounds 0 <= i <= 3" (ppr is) + | otherwise = pprPanic "vector shuffle: wrong number of indices (expected 2)" (ppr is) + + -- Shuffle with AVX instructions. + -- The components above 128 bits are shuffled in the same way as the lower 128 bits. + -- For example, `l == 4 && is == [0,3]` would represent `shuffleDoubleX4# _ _ (# 0#, 5#, 2#, 7# #)`. + vector_shuffle_double_avx :: Length -- Vector length. 2 for XMM, 4 for YMM, 8 for ZMM. + -> CmmExpr + -> CmmExpr + -> [Int] -- 2-element list of indices + -> NatM Register + vector_shuffle_double_avx l v1 v2 is + | [i0, i1] <- is = + let fmt = VecFormat l FmtDouble + repeatShufpdMask m = case l of + 8 -> m .|. (m `shiftL` 2) .|. (m `shiftL` 4) .|. (m `shiftL` 6) + 4 -> m .|. (m `shiftL` 2) + _ -> m + in case (i0, i1) of + -- Trivial cases + (0, 1) -> getRegister' platform is32Bit v1 + (2, 3) -> getRegister' platform is32Bit v2 + + -- VMOVSD/VUNPCKLPD/VUNPCKHPD have shorter encoding than VSHUFPD + (0, 3) | l == 2 -> do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + let code dst = exp1 `appOL` exp2 `snocOL` + (VMOV_MERGE fmt r1 r2 dst) -- VMOVSD + return (Any fmt code) + | otherwise -> vector_float_op_avx (`VSHUF` (ImmInt $ repeatShufpdMask 0b10)) l W64 v1 v2 + (2, 1) | l == 2 -> do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + let code dst = exp1 `appOL` exp2 `snocOL` + (VMOV_MERGE fmt r2 r1 dst) -- VMOVSD + return (Any fmt code) + | otherwise -> vector_float_op_avx (`VSHUF` (ImmInt $ repeatShufpdMask 0b10)) l W64 v2 v1 + _ | i0 == i1 -> do + (r, exp) <- getSomeReg (if i0 <= 1 then v1 else v2) + let unpck = if i0 == 0 || i0 == 2 + then VUNPCKL + else VUNPCKH + code dst = exp `snocOL` + (unpck fmt (OpReg r) r dst) + return (Any fmt code) + (0, 2) -> vector_float_op_avx VUNPCKL l W64 v1 v2 + (2, 0) -> vector_float_op_avx VUNPCKL l W64 v2 v1 + (1, 3) -> vector_float_op_avx VUNPCKH l W64 v1 v2 + (3, 1) -> vector_float_op_avx VUNPCKH l W64 v2 v1 + + -- SHUFPD + (1, 2) -> vector_float_op_avx (`VSHUF` (ImmInt $ repeatShufpdMask 0b01)) l W64 v1 v2 + (3, 0) -> vector_float_op_avx (`VSHUF` (ImmInt $ repeatShufpdMask 0b01)) l W64 v2 v1 + (1, 0) -> do + (r, exp) <- getSomeReg v1 + let code dst = exp `snocOL` + (VSHUF fmt (ImmInt $ repeatShufpdMask 0b01) (OpReg r) r dst) + return (Any fmt code) + (3, 2) -> do + (r, exp) <- getSomeReg v2 + let code dst = exp `snocOL` + (VSHUF fmt (ImmInt $ repeatShufpdMask 0b01) (OpReg r) r dst) + return (Any fmt code) + _ -> pprPanic "vector shuffle: indices out of bounds 0 <= i <= 3" (ppr is) + | otherwise = pprPanic "vector shuffle: wrong number of indices (expected 2)" (ppr is) + + isZeroVecLit :: CmmExpr -> Bool + isZeroVecLit (CmmLit (CmmVec elems)) = all (\lit -> case lit of CmmInt 0 _ -> True; _ -> False) elems + isZeroVecLit _ = False + + vector_shuffle_int128_common :: Bool -> Format -> CmmExpr -> CmmExpr -> [Int] -> Maybe (NatM Register) + vector_shuffle_int128_common sse4_1 fmt v1 v2 is + | length is == n, all (\i -> 0 <= i && i < 2 * n) is = if + -- Trivial cases + | is == [0..n-1] -> Just $ getRegister' platform is32Bit v1 + | is == [n..2*n-1] -> Just $ getRegister' platform is32Bit v2 + + -- We would like to emit PXOR for these trivial cases, instead of PSLLDQ. + -- These conditions can be generalized to the cases where all elements are equal, + -- or more generally, a constant-folding rule. + | v1IsZero, all (< n) is -> Just $ getRegister' platform is32Bit v1 + | v2IsZero, all (>= n) is -> Just $ getRegister' platform is32Bit v2 + + -- PSLLDQ: v2 == 0 && is == [n..(2n-1),...,n..(2n-1);0,1,2,3,...,n-i-1] + | v2IsZero, (z, js) <- span (>= n) is, and (zipWith (==) js [0..]) -> Just $ do + exp1 <- getAnyReg v1 + let code dst = exp1 dst `snocOL` + (PSLLDQ fmt (ImmInt (widthInBytes * length z)) dst) + return (Any fmt code) + + -- PSLLDQ: v1 == 0 && is == [0..(n-1),...,0..(n-1);n,n+1,...,2n-i-1] + | v1IsZero, (z, js) <- span (< n) is, and (zipWith (==) js [n..]) -> Just $ do + exp2 <- getAnyReg v2 + let code dst = exp2 dst `snocOL` + (PSLLDQ fmt (ImmInt (widthInBytes * length z)) dst) + return (Any fmt code) + + -- PSRLDQ: v2 == 0 && is == [i,i+1,...,n-2,n-1;n..(2n-1),...,n..(2n-1)] + | v2IsZero, (js, z) <- span (< n) is, all (>= n) z, and (zipWith (==) (reverse js) [n-1,n-2..]) -> Just $ do + exp1 <- getAnyReg v1 + let code dst = exp1 dst `snocOL` + (PSRLDQ fmt (ImmInt (widthInBytes * length z)) dst) + return (Any fmt code) + + -- PSRLDQ: v1 == 0 && is == [n+i,...,2n-2,2n-1;0..(n-1),...,0..(n-1)] + | v1IsZero, (js, z) <- span (>= n) is, all (< n) z, and (zipWith (==) (reverse js) [2*n-1,2*n-2..]) -> Just $ do + exp2 <- getAnyReg v2 + let code dst = exp2 dst `snocOL` + (PSRLDQ fmt (ImmInt (widthInBytes * length z)) dst) + return (Any fmt code) + + -- PALIGNR (SSSE3) or PSLLDQ + PSRLDQ: is == [i,i+1,...,n-2,n-1;n,n+1,...,n+i-1] + | (js, ks) <- span (< n) is, and (zipWith (==) (reverse js) [n-1,n-2..]), and (zipWith (==) ks [n..]) -> Just $ do + ssse3 <- ssse3Enabled + let amountInBytes = widthInBytes * length ks + if ssse3 + then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v2 v1 + else do + exp1 <- getAnyReg v1 + exp2 <- getAnyReg v2 + tmp <- getNewRegNat fmt + let code dst = exp1 tmp `snocOL` + (PSRLDQ fmt (ImmInt amountInBytes) tmp) `appOL` + exp2 dst `snocOL` + (PSLLDQ fmt (ImmInt (16 - amountInBytes)) dst) `snocOL` + (POR fmt (OpReg tmp) dst) + return (Any fmt code) + + -- PALIGNR (SSSE3) or PSLLDQ + PSRLDQ: is == [n+i,n+i+1,...,2n-2,2n-1;0,1,...,i-1] + | (js, ks) <- span (>= n) is, and (zipWith (==) (reverse js) [2*n-1,2*n-2..]), and (zipWith (==) ks [0..]) -> Just $ do + ssse3 <- ssse3Enabled + let amountInBytes = widthInBytes * length ks + if ssse3 + then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v1 v2 + else do + exp1 <- getAnyReg v1 + exp2 <- getAnyReg v2 + tmp <- getNewRegNat fmt + let code dst = exp2 tmp `snocOL` + (PSRLDQ fmt (ImmInt amountInBytes) tmp) `appOL` + exp1 dst `snocOL` + (PSLLDQ fmt (ImmInt (16 - amountInBytes)) dst) `snocOL` + (POR fmt (OpReg tmp) dst) + return (Any fmt code) + + -- PBLENDW (SSE4.1): map (`mod` n) is == [0,1,...,n-1] if widthInBytes >= 2 + | sse4_1, widthInBytes >= 2, and (zipWith (\i j -> i `rem` n == j) is [0..]) -> Just $ do + let k = widthInBytes `quot` 2 + m = bit k - 1 + imm = foldr (\i acc -> if i >= n then (acc `shiftL` k) .|. m else acc `shiftL` k) 0 is + vector_op_sse (`PBLENDW` (ImmInt imm)) fmt v1 v2 + + | otherwise -> Nothing + + | otherwise = pprPanic "vector shuffle: wrong indices" (ppr is) + where + (n, widthInBytes) = case fmt of + VecFormat 16 FmtInt8 -> (16, 1) + VecFormat 8 FmtInt16 -> (8, 2) + VecFormat 4 FmtInt32 -> (4, 4) + VecFormat 2 FmtInt64 -> (2, 8) + _ -> pprPanic "Invalid format" (ppr fmt) + v1IsZero = isZeroVecLit v1 + v2IsZero = isZeroVecLit v2 + + vector_shuffle_int8x16 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_int8x16 sse4_1 v1 v2 is + | Just commonCase <- vector_shuffle_int128_common sse4_1 fmt v1 v2 is = commonCase + | otherwise = do + ssse3 <- ssse3Enabled + let fmtInt16X8 = VecFormat 8 FmtInt16 + v1IsZero = isZeroVecLit v1 + v2IsZero = isZeroVecLit v2 + tryInt16X8Mask [] = Just [] + tryInt16X8Mask (j0:j1:js) + | even j0, j1 == j0 + 1 = (j0 `quot` 2 :) <$> tryInt16X8Mask js + tryInt16X8Mask _ = Nothing + if + -- PUNPCKLBW / PUNPCKHBW + | [0,16,1,17,2,18,3,19,4,20,5,21,6,22,7,23] <- is -> vector_op_sse PUNPCKLBW fmt v1 v2 + | [16,0,17,1,18,2,19,3,20,4,21,5,22,6,23,7] <- is -> vector_op_sse PUNPCKLBW fmt v2 v1 + | [8,24,9,25,10,26,11,27,12,28,13,29,14,30,15,31] <- is -> vector_op_sse PUNPCKHBW fmt v1 v2 + | [24,8,25,9,26,10,27,11,28,12,29,13,30,14,31,15] <- is -> vector_op_sse PUNPCKHBW fmt v2 v1 + + -- PSHUFB (SSSE3) + | ssse3, all (< 16) is || v2IsZero -> do + exp1 <- getAnyReg v1 + let mask1 = CmmVec $ map (\i -> CmmInt (toInteger $ if i < 16 then i else 255) W8) is + Amode amode1 amode_code1 <- memConstant (mkAlignment 16) mask1 + let code dst = exp1 dst `appOL` + amode_code1 `snocOL` + (PSHUFB fmt (OpAddr amode1) dst) + return (Any fmt code) + + -- PSHUFB (SSSE3) + | ssse3, all (>= 16) is || v1IsZero -> do + exp2 <- getAnyReg v2 + let mask2 = CmmVec $ map (\i -> CmmInt (toInteger $ if i >= 16 then i - 16 else 255) W8) is + Amode amode2 amode_code2 <- memConstant (mkAlignment 16) mask2 + let code dst = exp2 dst `appOL` + amode_code2 `snocOL` + (PSHUFB fmt (OpAddr amode2) dst) + return (Any fmt code) + + -- PBLENDW (SSE4.1): js <- tryInt16X8Mask is, map (`mod` 8) js == [0,1,...,7] + | sse4_1, Just js <- tryInt16X8Mask is, and (zipWith (\i j -> i `rem` 8 == j) js [0..]) -> do + let imm = foldr (\i acc -> if i >= 8 then (acc `shiftL` 1) .|. 1 else acc `shiftL` 1) 0 js + vector_op_sse (`PBLENDW` (ImmInt imm)) fmt v1 v2 + + -- General case with SSSE3: PSHUFB + PSHUFB + POR + | ssse3 -> do + exp1 <- getAnyReg v1 + exp2 <- getAnyReg v2 + tmp1 <- getNewRegNat fmt + let mask1 = CmmVec $ map (\i -> CmmInt (toInteger $ if i < 16 then i else 255) W8) is + mask2 = CmmVec $ map (\i -> CmmInt (toInteger $ if i >= 16 then i - 16 else 255) W8) is + Amode amode1 amode_code1 <- memConstant (mkAlignment 16) mask1 + Amode amode2 amode_code2 <- memConstant (mkAlignment 16) mask2 + let code dst = exp1 tmp1 `appOL` exp2 dst `appOL` + amode_code1 `snocOL` + (PSHUFB fmt (OpAddr amode1) tmp1) `appOL` + amode_code2 `snocOL` + (PSHUFB fmt (OpAddr amode2) dst) `snocOL` + (POR fmt (OpReg tmp1) dst) + return (Any fmt code) + + -- General case with SSE2: GPR + MOVQ + PUNPCKLQDQ + | otherwise -> do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + tmp <- getNewRegNat II64 + tmpLo <- getNewRegNat II64 + tmpHi <- getNewRegNat II64 + tmpXmm <- getNewRegNat fmt + dst <- getNewRegNat fmt + let place8Bits srcPos dstPos dst = + -- Assumption: 0 <= srcPos < 32, 0 <= dstPos < 8 + -- tmp <- (src[srcPos] `shiftR` ((srcPos `rem` 16) * 8)) .&. 0xff + -- dst <- dst .|. (tmp `shiftL` (dstPos * 8)) + let r = if srcPos < 16 then r1 else r2 + in case (srcPos `rem` 16) `quotRem` 2 of + (k, 0) -> toOL [ PEXTR II32 fmtInt16X8 (ImmInt k) r (OpReg tmp) + , MOVZxL II8 (OpReg tmp) (OpReg tmp) + , SHL II64 (OpImm (ImmInt (8 * dstPos))) (OpReg tmp) + , OR II64 (OpReg tmp) (OpReg dst) + ] + (k, _) -> (PEXTR II32 fmtInt16X8 (ImmInt k) r (OpReg tmp)) `consOL` + ((case dstPos of + 0 -> unitOL (SHR II32 (OpImm (ImmInt 8)) (OpReg tmp)) + 1 -> unitOL (AND II32 (OpImm (ImmInt 0xff00)) (OpReg tmp)) + _ -> toOL [ AND II32 (OpImm (ImmInt 0xff00)) (OpReg tmp) + , SHL II64 (OpImm (ImmInt (8 * (dstPos - 1)))) (OpReg tmp) ]) `snocOL` + (OR II64 (OpReg tmp) (OpReg dst))) + makeInt8x8OnGPR dst js = (XOR II32 (OpReg dst) (OpReg dst)) `consOL` + concatOL [ place8Bits srcPos dstPos dst | (srcPos, dstPos) <- zip js [0..] ] + code = exp1 `appOL` exp2 `appOL` + makeInt8x8OnGPR tmpLo (take 8 is) `snocOL` + (MOVD II64 fmt (OpReg tmpLo) (OpReg dst)) `appOL` + makeInt8x8OnGPR tmpHi (drop 8 is) `snocOL` + (MOVD II64 fmt (OpReg tmpHi) (OpReg tmpXmm)) `snocOL` + (PUNPCKLQDQ fmt (OpReg tmpXmm) dst) + return (Fixed fmt dst code) + where fmt = VecFormat 16 FmtInt8 + + vector_shuffle_int16x8 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_int16x8 sse4_1 v1 v2 is@(i0:i1:i2:i3:i4567@[i4,i5,i6,i7]) + | Just commonCase <- vector_shuffle_int128_common sse4_1 fmt v1 v2 is = commonCase + | otherwise = do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + let -- shufL src dst k0 k1 k2 k3 (0 <= k_i < 4): + -- dst <- (src[k0],src[k1],src[k2],src[k3],src[4],src[5],src[6],src[7]) + shufL src dst 0 1 2 3 | src == dst = nilOL + | otherwise = unitOL (MOVDQU fmt (OpReg src) (OpReg dst)) + shufL src dst k0 k1 k2 k3 = let imm = k0 + (k1 `shiftL` 2) + (k2 `shiftL` 4) + (k3 `shiftL` 6) + in unitOL (PSHUFLW fmt (ImmInt imm) (OpReg src) dst) + -- shufH src dst k0 k1 k2 k3 (4 <= k_i < 8): + -- dst <- (src[0],src[1],src[2],src[3],src[k0],src[k1],src[k2],src[k3]) + shufH src dst 4 5 6 7 | src == dst = nilOL + | otherwise = unitOL (MOVDQU fmt (OpReg src) (OpReg dst)) + shufH src dst k0 k1 k2 k3 = let imm = (k0 - 4) + ((k1 - 4) `shiftL` 2) + ((k2 - 4) `shiftL` 4) + ((k3 - 4) `shiftL` 6) + in unitOL (PSHUFHW fmt (ImmInt imm) (OpReg src) dst) + + shufLHImm src dst immLo immHi = case (immLo, immHi) of + (0b11_10_01_00, 0b11_10_01_00) + | src == dst -> nilOL + | otherwise -> unitOL (MOVDQU fmt (OpReg src) (OpReg dst)) + (0b11_10_01_00, _) -> unitOL (PSHUFHW fmt (ImmInt immHi) (OpReg src) dst) + (_, 0b11_10_01_00) -> unitOL (PSHUFLW fmt (ImmInt immLo) (OpReg src) dst) + (_, _) -> toOL [PSHUFLW fmt (ImmInt immLo) (OpReg src) dst, + PSHUFHW fmt (ImmInt immHi) (OpReg dst) dst] + + -- ks = [k0,...,k7] + -- Assumption: 0 <= k_i < 4 for 0 <= i < 4, 4 <= k_i < 8 for 4 <= i < 8 + -- dst <- (src[k0],...,src[k7]) + shufLH src dst ks + = let (k_lo, k_hi) = splitAt 4 ks + immLo = foldr (\k acc -> (acc `shiftL` 2) + k) 0 k_lo + immHi = foldr (\k acc -> (acc `shiftL` 2) + (k - 4)) 0 k_hi + in shufLHImm src dst immLo immHi + + -- shufRev src dst j0 j1 j2 j3 j4 j5 j6 j7: + -- Assumption: [j0,j1,j2,j3] `elem` permutations [0,1,2,3] && [j4,j5,j6,j7] `elem` permutations [4,5,6,7]: + -- dst[j0] <- src[0]; dst[j1] <- src[1]; dst[j2] <- src[2]; dst[j3] <- src[3]; + -- dst[j4] <- src[4]; dst[j5] <- src[5]; dst[j6] <- src[6]; dst[j7] <- src[7]; + shufRev src dst _j0 j1 j2 j3 _j4 j5 j6 j7 + = let immLo = (1 `shiftL` (2 * j1)) + (2 `shiftL` (2 * j2)) + (3 `shiftL` (2 * j3)) + immHi = (1 `shiftL` (2 * (j5 - 4))) + (2 `shiftL` (2 * (j6 - 4))) + (3 `shiftL` (2 * (j7 - 4))) + in shufLHImm src dst immLo immHi + i0123 = [i0, i1, i2, i3] + if + -- PSHUFLW + PSHUFHW + | all (\i -> i < 4) i0123 + , all (\i -> 4 <= i && i < 8) i4567 + -> do + let code dst = exp1 `appOL` + shufLH r1 dst is + return (Any fmt code) + + -- PSHUFLW + PSHUFHW + | all (\i -> 8 <= i && i < 12) i0123 + , all (\i -> 12 <= i) i4567 + -> do + let code dst = exp2 `appOL` + shufLH r2 dst (map (subtract 8) is) + return (Any fmt code) + + -- PSHUF{L,H}W + PBLENDW (SSE4.1) + | sse4_1 + , all (\i -> i `rem` 8 < 4) i0123 + , all (\i -> 4 <= i `rem` 8) i4567 + -> do + tmp <- getNewRegNat fmt + let imm = foldl' (\acc (i,p) -> if i >= 8 then setBit acc p else acc) 0 (zip is [0..]) + js = zipWith (\i p -> if i >= 8 then p else i) is [0..] + ks = zipWith (\i p -> if i >= 8 then i - 8 else p) is [0..] + code dst = exp1 `appOL` exp2 `appOL` + shufLH r2 tmp ks `appOL` + shufLH r1 dst js `snocOL` + (PBLENDW fmt (ImmInt imm) (OpReg tmp) dst) + return (Any fmt code) + + -- PSHUFLW + PSHUFLW + PUNPCKLWD + PSHUFLW + PSHUFHW + | all (\i -> i < 4 || (8 <= i && i < 12)) is + , ([(j0, k0), (j1, k1)], [(j2, k2), (j3, k3)]) <- partition (\(_, i) -> i < 4) [(0, i0), (1, i1), (2, i2), (3, i3)] + , ([(j4, k4), (j5, k5)], [(j6, k6), (j7, k7)]) <- partition (\(_, i) -> i < 4) [(4, i4), (5, i5), (6, i6), (7, i7)] + -> do + tmp1 <- getNewRegNat fmt + tmp2 <- getNewRegNat fmt + let code dst = exp1 `appOL` exp2 `appOL` + shufL r1 tmp1 k0 k1 k4 k5 `appOL` + shufL r2 tmp2 (k2 - 8) (k3 - 8) (k6 - 8) (k7 - 8) `snocOL` + (PUNPCKLWD fmt (OpReg tmp2) tmp1) `appOL` + shufRev tmp1 dst j0 j2 j1 j3 j4 j6 j5 j7 + return (Any fmt code) + + -- PSHUFHW + PSHUFHW + PUNPCKHWD + PSHUFLW + PSHUFHW + | all (\i -> (4 <= i && i < 8) || 12 <= i) is + , ([(j0, k0), (j1, k1)], [(j2, k2), (j3, k3)]) <- partition (\(_, i) -> i < 8) [(0, i0), (1, i1), (2, i2), (3, i3)] + , ([(j4, k4), (j5, k5)], [(j6, k6), (j7, k7)]) <- partition (\(_, i) -> i < 8) [(4, i4), (5, i5), (6, i6), (7, i7)] + -> do + tmp1 <- getNewRegNat fmt + tmp2 <- getNewRegNat fmt + let code dst = exp1 `appOL` exp2 `appOL` + shufH r1 tmp1 k0 k1 k4 k5 `appOL` + shufH r2 tmp2 (k2 - 8) (k3 - 8) (k6 - 8) (k7 - 8) `snocOL` + (PUNPCKHWD fmt (OpReg tmp2) tmp1) `appOL` + shufRev tmp1 dst j0 j2 j1 j3 j4 j6 j5 j7 + return (Any fmt code) + + -- Generic implementation + | otherwise -> do + tmp0 <- getNewRegNat II32 + tmps <- replicateM 7 (getNewRegNat II32) + let code dst = exp1 `appOL` exp2 `appOL` + toOL [ PEXTR II32 fmt (ImmInt i') r (OpReg tmp) + | (i, tmp) <- zip is (tmp0:tmps) + , let (i', r) = if i < 8 then (i, r1) else (i - 8, r2) + ] `snocOL` + (MOVD II32 fmt (OpReg tmp0) (OpReg dst)) `appOL` + toOL [ PINSR II32 fmt (ImmInt i) (OpReg tmp) dst + | (i, tmp) <- zip [1..] tmps + ] + return (Any fmt code) + where fmt = VecFormat 8 FmtInt16 + vector_shuffle_int16x8 _ _ _ is = pprPanic "vector shuffle: wrong number of indices (expected 8)" (ppr is) + + vector_shuffle_int32x4 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_int32x4 sse4_1 v1 v2 is + | Just commonCase <- vector_shuffle_int128_common sse4_1 fmt v1 v2 is = commonCase + | otherwise = do + let -- `pshufd imm src dst` is equivalent to `PSHUFD fmt (ImmInt imm) (OpReg src) dst` + pshufd 0b11_10_01_00 src dst + | src == dst = nilOL + | otherwise = unitOL (MOVDQU fmt (OpReg src) (OpReg dst)) + pshufd imm src dst = unitOL (PSHUFD fmt (ImmInt imm) (OpReg src) dst) + + -- PSHUFD (composeImm imm1 imm2) src dst == (PSHUFD imm1 src tmp; PSHUFD imm2 tmp dst) + composeMask :: Int -> Int -> Int + composeMask imm1 imm2 = foldr (\i acc -> let j = (imm2 `shiftR` (2 * i)) .&. 3 + in (imm1 `shiftR` (2 * j) .&. 3) .|. (acc `shiftL` 2) + ) 0 [0..3] + + makeMask :: [(Int, Int)] -- List of (dst,src). If src == -1, the value there can be anything. + -> Int + makeMask m = foldl' (.|.) 0 [ src `shiftL` (2 * dst) | dst <- [0..3], let src = fromMaybe dst (mfilter (>= 0) $ lookup dst m) ] + + twoAndTwo p0@(1,_) p1@(3,_) q0@(0,_) q1@(2,_) imm4 v1 v2 = twoAndTwo' q0 q1 p0 p1 imm4 v2 v1 + twoAndTwo p0 p1 q0 q1 imm4 v1 v2 = twoAndTwo' p0 p1 q0 q1 imm4 v1 v2 + twoAndTwo' p0 p1 q0 q1 imm4 v1 v2 = do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + tmp <- getNewRegNat fmt + let (instr, imm1, imm2) = + if all (\(_,i) -> 2 <= i || i == -1) [p0,p1,q0,q1] then + -- The inputs are all from higher lanes + (PUNPCKHDQ, makeMask [(2,snd p0),(3,snd p1)], makeMask [(2,snd q0),(3,snd q1)]) + else + (PUNPCKLDQ, makeMask [(0,snd p0),(1,snd p1)], makeMask [(0,snd q0),(1,snd q1)]) + imm3 = makeMask [(fst p0,0),(fst q0,1),(fst p1,2),(fst q1,3)] + code dst = exp1 `appOL` exp2 `appOL` + pshufd imm2 r2 tmp `appOL` -- tmp <- (*,*,r2[snd q0],r2[snd q1]) or (r2[snd q0],r2[snd q1],*,*) + pshufd imm1 r1 dst `snocOL` -- dst <- (*,*,r1[snd p0],r1[snd p1]) or (r1[snd p0],r1[snd p1],*,*) + instr fmt (OpReg tmp) dst `appOL` -- dst <- (dst[0],tmp[0],dst[1],tmp[1]) = (r1[snd p0],r2[snd q0],r1[snd p1],r2[snd q1]) + pshufd (composeMask imm3 imm4) dst dst -- (dst[fst p0],dst[fst q0],dst[fst p1],dst[fst q1]) <- dst + return $ Any fmt code + + threeAndOne p0 p1 p2 q0 + | snd p0 == snd p1 = twoAndTwo p0 p2 q0 (fst p1,-1) (makeMask [(fst p0,fst p0),(fst p1,fst p0),(fst p2,fst p2),(fst q0,fst q0)]) + | snd p0 == snd p2 = twoAndTwo p0 p1 q0 (fst p2,-1) (makeMask [(fst p0,fst p0),(fst p1,fst p1),(fst p2,fst p0),(fst q0,fst q0)]) + | snd p1 == snd p2 = twoAndTwo p0 p1 q0 (fst p2,-1) (makeMask [(fst p0,fst p0),(fst p1,fst p1),(fst p2,fst p1),(fst q0,fst q0)]) + | otherwise = \v1 v2 -> do + (r1, exp1) <- getSomeReg v1 + (r2, exp2) <- getSomeReg v2 + tmp1 <- getNewRegNat fmt + if sse4_1 + then do + let imm1 = makeMask [p0,p1,p2] + imm2 = makeMask [q0] + imm3 = foldl' (.|.) 0 [ (if i == fst q0 then 0 else 3) `shiftL` (2 * i) | i <- [0..3] ] + let code dst = exp1 `appOL` exp2 `appOL` + pshufd imm1 r1 tmp1 `appOL` + pshufd imm2 r2 dst `snocOL` + PBLENDW fmt (ImmInt imm3) (OpReg tmp1) dst + return $ Any fmt code + else do + tmp2 <- getNewRegNat fmt + tmp3 <- getNewRegNat fmt + let imm1 = snd q0 .|. 0b11_10_01_00 + imm2 = snd p1 .|. 0b11_10_01_00 + imm3 = snd p0 .|. (snd p2 `shiftL` 2) .|. 0b11_10_00_00 + imm6 = makeMask [(fst q0,0),(fst p0,1),(fst p1,2),(fst p2,3)] + code dst = exp1 `appOL` exp2 `appOL` + pshufd imm1 r2 tmp1 `appOL` -- tmp1 <- (y0,*,*,*) + pshufd imm2 r1 tmp2 `appOL` -- tmp2 <- (x1,*,*,*) + pshufd imm3 r1 tmp3 `snocOL` -- tmp3 <- (x0,x2,*,*) + PUNPCKLDQ fmt (OpReg tmp2) tmp1 `snocOL` -- tmp1 <- unpckldq tmp1 tmp2 = (y0,x1,*,*) + PUNPCKLDQ fmt (OpReg tmp3) tmp1 `appOL` -- tmp1 <- unpckldq tmp1 tmp3 = (y0,x0,x1,x2) + pshufd imm6 tmp1 dst -- dst <- shuffle tmp1 + return $ Any fmt code + + let (from_first, from_second) = partition (\(_dstPos,srcPos) -> srcPos < 4) (zip [0..] is) + case (from_first, map (\(dstPos,srcPos) -> (dstPos, srcPos - 4)) from_second) of + ([p0,p1,p2,p3], []) -> do + (r, exp) <- getSomeReg v1 + let imm = makeMask [p0,p1,p2,p3] + code dst = exp `appOL` pshufd imm r dst + return $ Any fmt code + + ([], [q0,q1,q2,q3]) -> do + (r, exp) <- getSomeReg v2 + let imm = makeMask [q0,q1,q2,q3] + code dst = exp `appOL` pshufd imm r dst + return $ Any fmt code + + ([p0,p1], [q0,q1]) -> twoAndTwo p0 p1 q0 q1 0b11_10_01_00 v1 v2 + ([p0], [q0,q1,q2]) -> threeAndOne q0 q1 q2 p0 v2 v1 + ([p0,p1,p2], [q0]) -> threeAndOne p0 p1 p2 q0 v1 v2 + + _ -> pprPanic "vector shuffle: cannot occur" (ppr is) + where fmt = VecFormat 4 FmtInt32 + + vector_shuffle_int64x2 :: Bool -> CmmExpr -> CmmExpr -> [Int] -> NatM Register + vector_shuffle_int64x2 sse4_1 v1 v2 is + | Just commonCase <- vector_shuffle_int128_common sse4_1 fmt v1 v2 is = commonCase + | otherwise = case is of + -- PUNPCKLQDQ / PUNPCKHQDQ + [i, i'] | i == i' -> do + exp <- getAnyReg $ if i < 2 then v1 else v2 + let instr = if i == 0 || i == 2 + then PUNPCKLQDQ + else PUNPCKHQDQ + code dst = exp dst `snocOL` + (instr fmt (OpReg dst) dst) + return $ Any fmt code + [0, 2] -> vector_op_sse PUNPCKLQDQ fmt v1 v2 + [2, 0] -> vector_op_sse PUNPCKLQDQ fmt v2 v1 + [1, 3] -> vector_op_sse PUNPCKHQDQ fmt v1 v2 + [3, 1] -> vector_op_sse PUNPCKHQDQ fmt v2 v1 + + -- PSHUFD + [1, 0] -> do + (r1, exp1) <- getSomeReg v1 + let code dst = exp1 `snocOL` + (PSHUFD fmt (ImmInt 0b01_00_11_10) (OpReg r1) dst) + return $ Any fmt code + [3, 2] -> do + (r2, exp2) <- getSomeReg v2 + let code dst = exp2 `snocOL` + (PSHUFD fmt (ImmInt 0b01_00_11_10) (OpReg r2) dst) + return $ Any fmt code + + -- Others: + -- If SSE4.1 is available, use PBLENDW (see vector_shuffle_int128_common). + -- Otherwise, we resort to SHUFPD. + [0, 3] -> vector_op_sse (\_ -> SHUF doubleFormat (ImmInt 2)) fmt v1 v2 + [2, 1] -> vector_op_sse (\_ -> SHUF doubleFormat (ImmInt 2)) fmt v2 v1 + + -- [0, 1], [2, 3], [1, 2], [3, 0] are covered by the common cases + + -- Indices are checked in vector_shuffle_int128_common, so the following line should be unreachable: + _ -> pprPanic "vector shuffle: wrong number of indices (expected 2)" (ppr is) + where fmt = VecFormat 2 FmtInt64 + doubleFormat = VecFormat 2 FmtDouble + + +getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps + avx <- avxEnabled + sse4_1 <- sse4_1Enabled + case mop of + -- Floating point fused multiply-add operations @ ± x*y ± z@ + MO_FMA var l w + | l * widthInBits w > 256 + -> sorry "Please use -fllvm for wide vector FMA support" + | otherwise + -> genFMA3Code l w var x y z + + -- Ternary vector operations + MO_VF_Insert l W32 | l == 4 -> vector_floatx4_insert_sse sse4_1 x y z + | otherwise -> + sorry $ "FloatX" ++ show l ++ "# insert operations require -fllvm" + -- SIMD NCG TODO: + -- + -- - add support for FloatX8, FloatX16. + MO_VF_Insert l W64 -> vector_double_insert avx l x y z + MO_V_Insert 16 W8 | sse4_1 -> vector_int_insert_pinsr 16 W8 x y z + | otherwise -> vector_int8x16_insert_sse2 x y z + MO_V_Insert 8 W16 -> vector_int_insert_pinsr 8 W16 x y z -- PINSRW (SSE2) + MO_V_Insert 4 W32 | sse4_1 -> vector_int_insert_pinsr 4 W32 x y z + | otherwise -> vector_int32x4_insert_sse2 x y z + MO_V_Insert 2 W64 | sse4_1 -> vector_int_insert_pinsr 2 W64 x y z + | otherwise -> vector_int64x2_insert_sse2 x y z + MO_V_Insert _ _ -> sorry "Unsupported integer vector insert operation; please use -fllvm" + + _other -> pprPanic "getRegister(x86) - ternary CmmMachOp (1)" + (pprMachOp mop) + + where + -- SIMD NCG TODO: + -- + -- - add support for FloatX8, FloatX16. + vector_floatx4_insert_sse :: Bool + -> CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_floatx4_insert_sse sse4_1 vecExpr valExpr (CmmLit (CmmInt offset _)) + | sse4_1 = do + (r, exp) <- getNonClobberedReg valExpr + fn <- getAnyReg vecExpr + let fmt = VecFormat 4 FmtFloat + imm = litToImm (CmmInt (offset `shiftL` 4) W32) + code dst = exp `appOL` + (fn dst) `snocOL` + (INSERTPS fmt imm (OpReg r) dst) + in return $ Any fmt code + | otherwise = do -- SSE <= 3 + (r, exp) <- getNonClobberedReg valExpr + fn <- getAnyReg vecExpr + let fmt = VecFormat 4 FmtFloat + tmp <- getNewRegNat fmt + let code dst + = case offset of + 0 -> exp `appOL` + (fn dst) `snocOL` + -- The following MOV compiles to MOVSS instruction and merges two vectors + (MOV fmt (OpReg r) (OpReg dst)) -- dst <- (r[0],dst[1],dst[2],dst[3]) + 1 -> exp `appOL` + (fn dst) `snocOL` + (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst + (UNPCKL fmt (OpReg r) dst) `snocOL` -- dst <- (dst[0],r[0],dst[1],r[1]) + (SHUF fmt (ImmInt 0xe4) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[2],tmp[3]) + 2 -> exp `appOL` + (fn dst) `snocOL` + (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst + (MOV fmt (OpReg r) (OpReg tmp)) `snocOL` -- tmp <- (r[0],tmp[1],tmp[2],tmp[3]) with MOVSS + (SHUF fmt (ImmInt 0xc4) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[0],tmp[3]) + 3 -> exp `appOL` + (fn dst) `snocOL` + (MOVU fmt (OpReg dst) (OpReg tmp)) `snocOL` -- tmp <- dst + (MOV fmt (OpReg r) (OpReg tmp)) `snocOL` -- tmp <- (r[0],tmp[1],tmp[2],tmp[3]) with MOVSS + (SHUF fmt (ImmInt 0x24) (OpReg tmp) dst) -- dst <- (dst[0],dst[1],tmp[2],tmp[0]) + _ -> panic "MO_VF_Insert FloatX4: unsupported offset" + in return $ Any fmt code + vector_floatx4_insert_sse _ _ _ offset + = pprPanic "Unsupported vector insert operation" $ + vcat + [ text "FloatX4#" + , text "offset:" <+> pdoc platform offset ] + + + -- SIMD NCG TODO: + -- + -- - add support for DoubleX4#, DoubleX8#. + vector_double_insert :: Bool + -> Length + -> CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + -- DoubleX2 + vector_double_insert avx len@2 vecExpr valExpr (CmmLit offset) + = do + (valReg, valExp) <- getNonClobberedReg valExpr + (vecReg, vecExp) <- getSomeReg vecExpr -- NB: vector regs never clobbered by instruction + let movu = if avx then VMOVU else MOVU + fmt = VecFormat len FmtDouble + code dst + = case offset of + CmmInt 0 _ -> valExp `appOL` + vecExp `snocOL` + (movu (VecFormat 2 FmtDouble) (OpReg vecReg) (OpReg dst)) `snocOL` + -- The following MOV compiles to MOVSD instruction and merges two vectors + (MOV (VecFormat 2 FmtDouble) (OpReg valReg) (OpReg dst)) + CmmInt 1 _ -> valExp `appOL` + vecExp `snocOL` + (movu (VecFormat 2 FmtDouble) (OpReg vecReg) (OpReg dst)) `snocOL` + (SHUF fmt (ImmInt 0b00) (OpReg valReg) dst) + _ -> pprPanic "MO_VF_Insert DoubleX2: unsupported offset" (ppr offset) + in return $ Any fmt code + vector_double_insert _ _ _ _ _ = + sorry "Unsupported floating-point vector insert operation; please use -fllvm" + -- For DoubleX4: use VSHUFPD. + -- For DoubleX8: use something like vinsertf64x2 followed by vpblendd? + + -- SIMD NCG TODO: + -- + -- - only supports 128-bit vector types (Int64X2, Int32X4, Int16X8, Int8X16), + -- add support for 256-bit and 512-bit vector types. + + -- PINSRW is an SSE2 instruction, whereas PINSR{B,D,Q} require SSE4.1. + vector_int_insert_pinsr :: HasCallStack => Length + -> Width + -> CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int_insert_pinsr len w vecExpr valExpr (CmmLit (CmmInt offset _)) + | 0 <= offset, offset < toInteger len + = do + (valReg, valExp) <- getNonClobberedReg valExpr + vecCode <- getAnyReg vecExpr + let (scalarFormat, vectorFormat) = case w of + W8 -> (II32, VecFormat len FmtInt8) + W16 -> (II32, VecFormat len FmtInt16) + W32 -> (II32, VecFormat len FmtInt32) + W64 -> (II64, VecFormat len FmtInt64) + _ -> sorry "Unsupported vector format" + code dst = valExp `appOL` + (vecCode dst) `snocOL` + (PINSR scalarFormat vectorFormat (ImmInteger offset) (OpReg valReg) dst) + return $ Any vectorFormat code + vector_int_insert_pinsr _ _ _ _ offset = pprPanic "MO_V_Insert: unsupported offset" (pdoc platform offset) + + vector_int8x16_insert_sse2 :: CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int8x16_insert_sse2 vecExpr valExpr (CmmLit (CmmInt offset _)) + | 0 <= offset, offset < 16 + = do + (valReg, valExp) <- getNonClobberedReg valExpr + vecCode <- getAnyReg vecExpr + tmp <- getNewRegNat II32 + let vectorFormat = VecFormat 16 FmtInt8 + code dst + = case offset `quotRem` 2 of + (j, 0) -> valExp `appOL` + (vecCode dst) `snocOL` + (PEXTR II32 (VecFormat 8 FmtInt16) (ImmInteger j) dst (OpReg tmp)) `snocOL` -- PEXTRW + (AND II32 (OpImm (ImmInt 0xff00)) (OpReg tmp)) `snocOL` + (MOVZxL II8 (OpReg valReg) (OpReg valReg)) `snocOL` + (OR II32 (OpReg valReg) (OpReg tmp)) `snocOL` + (PINSR II32 (VecFormat 8 FmtInt16) (ImmInteger j) (OpReg tmp) dst) -- PINSRW + (j, _) -> valExp `appOL` + (vecCode dst) `snocOL` + (PEXTR II32 (VecFormat 8 FmtInt16) (ImmInteger j) dst (OpReg tmp)) `snocOL` -- PEXTRW + (MOVZxL II8 (OpReg tmp) (OpReg tmp)) `snocOL` + (SHL II32 (OpImm (ImmInt 8)) (OpReg valReg)) `snocOL` + (OR II32 (OpReg valReg) (OpReg tmp)) `snocOL` + (PINSR II32 (VecFormat 8 FmtInt16) (ImmInteger j) (OpReg tmp) dst) -- PINSRW + return $ Any vectorFormat code + vector_int8x16_insert_sse2 _ _ offset = pprPanic "MO_V_Insert: unsupported offset" (pdoc platform offset) + + vector_int32x4_insert_sse2 :: CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int32x4_insert_sse2 vecExpr valExpr (CmmLit (CmmInt offset _)) + | 0 <= offset, offset < 4 + = do + (valReg, valExp) <- getNonClobberedReg valExpr + vecCode <- getAnyReg vecExpr + -- Since SSE2 does not have an integer vector instruction to achieve this, + -- we are forced to either use floating-point vector instructions + -- or lots of integer vector instructions. (sigh) + let floatVectorFormat = VecFormat 4 FmtFloat + tmp1 <- getNewRegNat floatVectorFormat + tmp2 <- getNewRegNat floatVectorFormat + let vectorFormat = VecFormat 4 FmtInt32 + code dst + = case offset of + 0 -> valExp `appOL` + (vecCode dst) `snocOL` + (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL` + (MOV floatVectorFormat (OpReg tmp1) (OpReg dst)) -- MOVSS; dst <- (tmp1[0],dst[1],dst[2],dst[3]) + 1 -> valExp `appOL` + (vecCode tmp1) `snocOL` + (MOVD II32 vectorFormat (OpReg valReg) (OpReg dst)) `snocOL` -- dst <- (val,0,0,0) + (PUNPCKLQDQ vectorFormat (OpReg tmp1) dst) `snocOL` -- dst <- (dst[0],dst[1],tmp1[0],tmp1[1]) + (SHUF floatVectorFormat (ImmInt 0b11_10_00_10) (OpReg tmp1) dst) -- SHUFPS; dst <- (dst[2],dst[0],tmp1[2],tmp1[3]) + 2 -> valExp `appOL` + (vecCode dst) `snocOL` + (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0) + (MOVU floatVectorFormat (OpReg dst) (OpReg tmp2)) `snocOL` -- MOVUPS; tmp2 <- dst + (SHUF floatVectorFormat (ImmInt 0b01_00_01_11) (OpReg tmp1) tmp2) `snocOL` -- SHUFPS; tmp2 <- (tmp2[3],tmp2[1],tmp1[0],tmp1[1]) + (SHUF floatVectorFormat (ImmInt 0b00_10_01_00) (OpReg tmp2) dst) -- SHUFPS; dst <- (dst[0],dst[1],tmp2[2],tmp2[0]) + _ -> valExp `appOL` + (vecCode dst) `snocOL` + (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0) + (SHUF floatVectorFormat (ImmInt 0b11_10_01_00) (OpReg dst) tmp1) `snocOL` -- SHUFPS; tmp1 <- (tmp1[0],tmp1[1],dst[2],dst[3]) + (SHUF floatVectorFormat (ImmInt 0b00_10_01_00) (OpReg tmp1) dst) -- SHUFPS; dst <- (dst[0],dst[1],tmp1[2],tmp1[0]) + return $ Any vectorFormat code + vector_int32x4_insert_sse2 _ _ offset = pprPanic "MO_V_Insert: unsupported offset" (pdoc platform offset) + + vector_int64x2_insert_sse2 :: CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM Register + vector_int64x2_insert_sse2 vecExpr valExpr (CmmLit offset) + = do + (valReg, valExp) <- getNonClobberedReg valExpr + (vecReg, vecExp) <- getSomeReg vecExpr -- NB: vector regs never clobbered by instruction + let fmt = VecFormat 2 FmtInt64 + tmp <- getNewRegNat fmt + let code dst + = case offset of + CmmInt 0 _ -> valExp `appOL` + vecExp `snocOL` + (MOVHLPS FF64 vecReg tmp) `snocOL` + (MOVD II64 fmt (OpReg valReg) (OpReg dst)) `snocOL` + (PUNPCKLQDQ fmt (OpReg tmp) dst) + CmmInt 1 _ -> valExp `appOL` + vecExp `snocOL` + (MOVDQU fmt (OpReg vecReg) (OpReg dst)) `snocOL` + (MOVD II64 fmt (OpReg valReg) (OpReg tmp)) `snocOL` + (PUNPCKLQDQ fmt (OpReg tmp) dst) + _ -> pprPanic "MO_V_Insert Int64X2: unsupported offset" (ppr offset) + in return $ Any fmt code + vector_int64x2_insert_sse2 _ _ offset = pprPanic "MO_V_Insert Int64X2: unsupported offset" (pdoc platform offset) + +getRegister' _ _ (CmmMachOp mop (_:_:_:_:_)) = + pprPanic "getRegister(x86): MachOp with >= 4 arguments" (text $ show mop) + +getRegister' platform is32Bit load@(CmmLoad mem ty _) + | isVecType ty + = do + config <- getConfig + Amode addr mem_code <- getAmode mem + let code dst = + mem_code `snocOL` + movInstr config format (OpAddr addr) (OpReg dst) + return (Any format code) + | isFloatType ty + = do + Amode addr mem_code <- getAmode mem + loadAmode (floatFormat width) addr mem_code + + | is32Bit && not (isWord64 ty) + = do + let + instr = case width of + W8 -> MOVZxL II8 + -- We always zero-extend 8-bit loads, if we + -- can't think of anything better. This is because + -- we can't guarantee access to an 8-bit variant of every register + -- (esi and edi don't have 8-bit variants), so to make things + -- simpler we do our 8-bit arithmetic with full 32-bit registers. + _other -> MOV format + code <- intLoadCode instr mem + return (Any format code) + + | not is32Bit + -- Simpler memory load code on x86_64 + = do + code <- intLoadCode (MOV format) mem + return (Any format code) + + | otherwise + = pprPanic "getRegister(x86) CmmLoad" (pdoc platform load) + where + format = cmmTypeFormat ty + width = typeWidth ty + +-- Handle symbol references with LEA and %rip-relative addressing. +-- See Note [%rip-relative addressing on x86-64]. +getRegister' platform is32Bit (CmmLit lit) + | is_label lit + , not is32Bit + = do let format = cmmTypeFormat (cmmLitType platform lit) + imm = litToImm lit + op = OpAddr (AddrBaseIndex EABaseRip EAIndexNone imm) + code dst = unitOL (LEA format op (OpReg dst)) + return (Any format code) + where + is_label (CmmLabel {}) = True + is_label (CmmLabelOff {}) = True + is_label (CmmLabelDiffOff {}) = True + is_label _ = False + +getRegister' platform is32Bit (CmmLit lit) = do + avx <- avxEnabled + + -- NB: it is important that the code produced here (to load a literal into + -- a register) doesn't clobber any registers other than the destination + -- register; the code for generating C calls relies on this property. + -- + -- In particular, we have: + -- + -- > loadIntoRegMightClobberOtherReg (CmmLit _) = False + -- + -- which means that we assume that loading a literal into a register + -- will not clobber any other registers. + + -- TODO: this function mishandles floating-point negative zero, + -- because -0.0 == 0.0 returns True and because we represent CmmFloat as + -- Rational, which can't properly represent negative zero. + + if + -- Zero: use XOR. + | isZeroLit lit + -> let code dst + | isIntFormat fmt + = let fmt' + | is32Bit + = fmt + | otherwise + -- x86_64: 32-bit xor is one byte shorter, + -- and zero-extends to 64 bits + = case fmt of + II64 -> II32 + _ -> fmt + in unitOL (XOR fmt' (OpReg dst) (OpReg dst)) + | avx + = if float_or_floatvec + then unitOL (VXOR fmt (OpReg dst) dst dst) + else unitOL (VPXOR fmt dst dst dst) + | otherwise + = if float_or_floatvec + then unitOL (XOR fmt (OpReg dst) (OpReg dst)) + else unitOL (PXOR fmt (OpReg dst) dst) + in return $ Any fmt code + + -- Constant vector: use broadcast. + | VecFormat l sFmt <- fmt + , CmmVec (f:fs) <- lit + , all (== f) fs + -> do let w = scalarWidth sFmt + broadcast = if isFloatScalarFormat sFmt + then MO_VF_Broadcast l w + else MO_V_Broadcast l w + valCode <- getAnyReg (CmmMachOp broadcast [CmmLit f]) + return $ Any fmt valCode + + -- Optimisation for loading small literals on x86_64: take advantage + -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit + -- instruction forms are shorter. + | not is32Bit, isWord64 cmmTy, not (isBigLit lit) + -> let + imm = litToImm lit + code dst = unitOL (MOV II32 (OpImm imm) (OpReg dst)) + in + return (Any II64 code) + + -- Scalar integer: use an immediate. + | isIntFormat fmt + -> let imm = litToImm lit + code dst = unitOL (MOV fmt (OpImm imm) (OpReg dst)) + in return (Any fmt code) + + -- General case: load literal from data address. + | otherwise + -> do let w = formatToWidth fmt + Amode addr addr_code <- memConstant (mkAlignment $ widthInBytes w) lit + loadAmode fmt addr addr_code + + where + cmmTy = cmmLitType platform lit + fmt = cmmTypeFormat cmmTy + float_or_floatvec = isFloatOrFloatVecFormat fmt + isZeroLit (CmmInt i _) = i == 0 + isZeroLit (CmmFloat f _) = f == 0 -- TODO: mishandles negative zero + isZeroLit (CmmVec fs) = all isZeroLit fs + isZeroLit _ = False + + isBigLit (CmmInt i _) = i < 0 || i > 0xffffffff + isBigLit _ = False + -- note1: not the same as (not.is32BitLit), because that checks for + -- signed literals that fit in 32 bits, but we want unsigned + -- literals here. + -- note2: all labels are small, because we're assuming the + -- small memory model. See Note [%rip-relative addressing on x86-64]. + +getRegister' platform _ slot@(CmmStackSlot {}) = + pprPanic "getRegister(x86) CmmStackSlot" (pdoc platform slot) + +intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr + -> NatM (Reg -> InstrBlock) +intLoadCode instr mem = do + Amode src mem_code <- getAmode mem + return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst)) + +-- Compute an expression into *any* register, adding the appropriate +-- move instruction if necessary. +getAnyReg :: HasDebugCallStack => CmmExpr -> NatM (Reg -> InstrBlock) +getAnyReg expr = do + r <- getRegister expr + anyReg r + +anyReg :: HasDebugCallStack => Register -> NatM (Reg -> InstrBlock) +anyReg (Any _ code) = return code +anyReg (Fixed rep reg fcode) = do + config <- getConfig + return (\dst -> fcode `snocOL` mkRegRegMoveInstr config rep reg dst) + +-- A bit like getSomeReg, but we want a reg that can be byte-addressed. +-- Fixed registers might not be byte-addressable, so we make sure we've +-- got a temporary, inserting an extra reg copy if necessary. +getByteReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) +getByteReg expr = do + config <- getConfig + is32Bit <- is32BitPlatform + if is32Bit + then do r <- getRegister expr + case r of + Any rep code -> do + tmp <- getNewRegNat rep + return (tmp, code tmp) + Fixed rep reg code + | isVirtualReg reg -> return (reg,code) + | otherwise -> do + tmp <- getNewRegNat rep + return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp) + -- ToDo: could optimise slightly by checking for + -- byte-addressable real registers, but that will + -- happen very rarely if at all. + else getSomeReg expr -- all regs are byte-addressable on x86_64 + +-- Another variant: this time we want the result in a register that cannot +-- be modified by code to evaluate an arbitrary expression. +getNonClobberedReg :: HasDebugCallStack => CmmExpr -> NatM (Reg, InstrBlock) +getNonClobberedReg expr = do + r <- getRegister expr + config <- getConfig + let platform = ncgPlatform config + case r of + Any rep code -> do + tmp <- getNewRegNat rep + return (tmp, code tmp) + Fixed rep reg code + -- only certain regs can be clobbered + | reg `elem` instrClobberedRegs platform + -> do + tmp <- getNewRegNat rep + return (tmp, code `snocOL` mkRegRegMoveInstr config rep reg tmp) + | otherwise -> + return (reg, code) + +-------------------------------------------------------------------------------- + +-- | Convert a 'CmmExpr' representing a memory address into an 'Amode'. +-- +-- An 'Amode' is a datatype representing a valid address form for the target +-- (e.g. "Base + Index + disp" or immediate) and the code to compute it. +getAmode :: CmmExpr -> NatM Amode +getAmode e = do + platform <- getPlatform + let is32Bit = target32Bit platform + + case e of + CmmRegOff r n + -> getAmode $ mangleIndexTree r n + + CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)), CmmLit displacement] + | not is32Bit + -> return $ Amode (ripRel (litToImm displacement)) nilOL + + -- This is all just ridiculous, since it carefully undoes + -- what mangleIndexTree has just done. + CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)] + | is32BitLit platform lit + -- assert (rep == II32)??? + -> do + (x_reg, x_code) <- getSomeReg x + let off = ImmInt (-(fromInteger i)) + return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) + + CmmMachOp (MO_Add _rep) [x, CmmLit lit] + | is32BitLit platform lit + -- assert (rep == II32)??? + -> do + (x_reg, x_code) <- getSomeReg x + let off = litToImm lit + return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) + + -- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be + -- recognised by the next rule. + CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)] + -> getAmode (CmmMachOp (MO_Add rep) [b,a]) + + -- Matches: (x + offset) + (y << shift) + CmmMachOp (MO_Add _) [CmmRegOff x offset, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]] + | shift == 0 || shift == 1 || shift == 2 || shift == 3 + -> x86_complex_amode (CmmReg x) y shift (fromIntegral offset) + + CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]] + | shift == 0 || shift == 1 || shift == 2 || shift == 3 + -> x86_complex_amode x y shift 0 + + CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _) + [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]] + | shift == 0 || shift == 1 || shift == 2 || shift == 3 + && is32BitInteger offset + -> x86_complex_amode x y shift offset + + CmmMachOp (MO_Add _) [x,y] + | not (isLit y) -- we already handle valid literals above. + -> x86_complex_amode x y 0 0 + + CmmLit lit@(CmmFloat {}) + -> pprPanic "X86 CodeGen: attempt to use floating-point value as a memory address" + (ppr lit) + + -- Handle labels with %rip-relative addressing since in general the image + -- may be loaded anywhere in the 64-bit address space (e.g. on Windows + -- with high-entropy ASLR). See Note [%rip-relative addressing on x86-64]. + CmmLit lit + | not is32Bit + , is_label lit + -> return (Amode (AddrBaseIndex EABaseRip EAIndexNone (litToImm lit)) nilOL) + + CmmLit lit + | is32BitLit platform lit + -> return (Amode (ImmAddr (litToImm lit) 0) nilOL) + + -- Literal with offsets too big (> 32 bits) fails during the linking phase + -- (#15570). We already handled valid literals above so we don't have to + -- test anything here. + CmmLit (CmmLabelOff l off) + -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabel l) + , CmmLit (CmmInt (fromIntegral off) W64) + ]) + CmmLit (CmmLabelDiffOff l1 l2 off w) + -> getAmode (CmmMachOp (MO_Add W64) [ CmmLit (CmmLabelDiffOff l1 l2 0 w) + , CmmLit (CmmInt (fromIntegral off) W64) + ]) + + -- in case we can't do something better, we just compute the expression + -- and put the result in a register + _ -> do + (reg,code) <- getSomeReg e + return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code) + where + is_label (CmmLabel{}) = True + is_label (CmmLabelOff{}) = True + is_label (CmmLabelDiffOff{}) = True + is_label _ = False + + +-- | Like 'getAmode', but on 32-bit use simple register addressing +-- (i.e. no index register). This stops us from running out of +-- registers on x86 when using instructions such as cmpxchg, which can +-- use up to three virtual registers and one fixed register. +getSimpleAmode :: CmmExpr -> NatM Amode +getSimpleAmode addr = is32BitPlatform >>= \case + False -> getAmode addr + True -> do + addr_code <- getAnyReg addr + config <- getConfig + addr_r <- getNewRegNat (intFormat (ncgWordWidth config)) + let amode = AddrBaseIndex (EABaseReg addr_r) EAIndexNone (ImmInt 0) + return $! Amode amode (addr_code addr_r) + +x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode +x86_complex_amode base index shift offset + = do (x_reg, x_code) <- getNonClobberedReg base + -- x must be in a temp, because it has to stay live over y_code + -- we could compare x_reg and y_reg and do something better here... + (y_reg, y_code) <- getSomeReg index + let + code = x_code `appOL` y_code + base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8; + n -> panic $ "x86_complex_amode: unhandled shift! (" ++ show n ++ ")" + return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset))) + code) + + + + +-- ----------------------------------------------------------------------------- +-- getOperand: sometimes any operand will do. + +-- getNonClobberedOperand: the value of the operand will remain valid across +-- the computation of an arbitrary expression, unless the expression +-- is computed directly into a register which the operand refers to +-- (see trivialCode where this function is used for an example). + +getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock) +getNonClobberedOperand (CmmLit lit) + | Just w <- isSuitableFloatingPointLit_maybe lit = do + Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit + return (OpAddr addr, code) + | otherwise = do + platform <- getPlatform + if is32BitLit platform lit && isIntFormat (cmmTypeFormat (cmmLitType platform lit)) + then return (OpImm (litToImm lit), nilOL) + else getNonClobberedOperand_generic (CmmLit lit) + +getNonClobberedOperand (CmmLoad mem ty _) = do + is32Bit <- is32BitPlatform + -- this logic could be simplified + -- TODO FIXME + if (if is32Bit then not (isWord64 ty) else True) + -- if 32bit and ty is at float/double/simd value + -- or if 64bit + -- this could use some eyeballs or i'll need to stare at it more later + then do + platform <- ncgPlatform <$> getConfig + Amode src mem_code <- getAmode mem + (src',save_code) <- + if (amodeCouldBeClobbered platform src) + then do + tmp <- getNewRegNat (archWordFormat is32Bit) + return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0), + unitOL (LEA (archWordFormat is32Bit) + (OpAddr src) + (OpReg tmp))) + else + return (src, nilOL) + return (OpAddr src', mem_code `appOL` save_code) + else + -- if its a word or gcptr on 32bit? + getNonClobberedOperand_generic (CmmLoad mem ty NaturallyAligned) + +getNonClobberedOperand e = getNonClobberedOperand_generic e + +getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) +getNonClobberedOperand_generic e = do + (reg, code) <- getNonClobberedReg e + return (OpReg reg, code) + +amodeCouldBeClobbered :: Platform -> AddrMode -> Bool +amodeCouldBeClobbered platform amode = any (regClobbered platform) (addrModeRegs amode) + +regClobbered :: Platform -> Reg -> Bool +regClobbered platform (RegReal (RealRegSingle rr)) = freeReg platform rr +regClobbered _ _ = False + +-- getOperand: the operand is not required to remain valid across the +-- computation of an arbitrary expression. +getOperand :: CmmExpr -> NatM (Operand, InstrBlock) + +getOperand (CmmLit lit) = case isSuitableFloatingPointLit_maybe lit of + Just w -> do + Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit + return (OpAddr addr, code) + Nothing -> do + platform <- getPlatform + if is32BitLit platform lit && (isIntFormat $ cmmTypeFormat (cmmLitType platform lit)) + then return (OpImm (litToImm lit), nilOL) + else getOperand_generic (CmmLit lit) + +getOperand (CmmLoad mem ty _) = do + is32Bit <- is32BitPlatform + if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True) + then do + Amode src mem_code <- getAmode mem + return (OpAddr src, mem_code) + else + getOperand_generic (CmmLoad mem ty NaturallyAligned) + +getOperand e = getOperand_generic e + +getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) +getOperand_generic e = do + (reg, code) <- getSomeReg e + return (OpReg reg, code) + +isOperand :: Platform -> CmmExpr -> Bool +isOperand _ (CmmLoad _ _ _) = True +isOperand platform (CmmLit lit) + = is32BitLit platform lit + || isSuitableFloatingPointLit lit +isOperand _ _ = False + +-- | Given a 'Register', produce a new 'Register' with an instruction block +-- which will check the value for alignment. Used for @-falignment-sanitisation@. +addAlignmentCheck :: Int -> Register -> Register +addAlignmentCheck align reg = + case reg of + Fixed fmt reg code -> Fixed fmt reg (code `appOL` check fmt reg) + Any fmt f -> Any fmt (\reg -> f reg `appOL` check fmt reg) + where + check :: Format -> Reg -> InstrBlock + check fmt reg = + assert (isIntFormat fmt) $ + toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg) + , JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel + ] + +memConstant :: Alignment -> CmmLit -> NatM Amode +memConstant align lit = do + lbl <- getNewLabelNat + let rosection = Section ReadOnlyData lbl + config <- getConfig + platform <- getPlatform + (addr, addr_code) <- if target32Bit platform + then do dynRef <- cmmMakeDynamicReference + config + DataReference + lbl + Amode addr addr_code <- getAmode dynRef + return (addr, addr_code) + else return (ripRel (ImmCLbl lbl), nilOL) + let code = + LDATA rosection (align, CmmStaticsRaw lbl [CmmStaticLit lit]) + `consOL` addr_code + return (Amode addr code) + +-- | Load the value at the given address into any register. +loadAmode :: Format -> AddrMode -> InstrBlock -> NatM Register +loadAmode fmt addr addr_code = do + config <- getConfig + let load dst = movInstr config fmt (OpAddr addr) (OpReg dst) + return $ Any fmt (\ dst -> addr_code `snocOL` load dst) + +-- if we want a floating-point literal as an operand, we can +-- use it directly from memory. However, if the literal is +-- zero, we're better off generating it into a register using +-- xor. +isSuitableFloatingPointLit :: CmmLit -> Bool +isSuitableFloatingPointLit = isJust . isSuitableFloatingPointLit_maybe + +isSuitableFloatingPointLit_maybe :: CmmLit -> Maybe Width +isSuitableFloatingPointLit_maybe (CmmFloat f w) = w <$ guard (f /= 0.0) +isSuitableFloatingPointLit_maybe _ = Nothing + +getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock) +getRegOrMem e@(CmmLoad mem ty _) = do + is32Bit <- is32BitPlatform + if isIntFormat (cmmTypeFormat ty) && (if is32Bit then not (isWord64 ty) else True) + then do + Amode src mem_code <- getAmode mem + return (OpAddr src, mem_code) + else do + (reg, code) <- getNonClobberedReg e + return (OpReg reg, code) +getRegOrMem e = do + (reg, code) <- getNonClobberedReg e + return (OpReg reg, code) + +is32BitLit :: Platform -> CmmLit -> Bool +is32BitLit platform _lit + | target32Bit platform = True +is32BitLit platform lit = + case lit of + CmmInt i W64 -> is32BitInteger i + -- Except on Windows, assume that labels are in the range 0-2^31-1: this + -- assumes the small memory model. Note [%rip-relative addressing on + -- x86-64]. + CmmLabel _ -> low_image + -- however we can't assume that label offsets are in this range + -- (see #15570) + CmmLabelOff _ off -> low_image && is32BitInteger (fromIntegral off) + CmmLabelDiffOff _ _ off _ -> low_image && is32BitInteger (fromIntegral off) + _ -> True + where + -- Is the executable image certain to be located below 4GB? As noted in + -- Note [%rip-relative addressing on x86-64], this is not true on Windows. + low_image = + case platformOS platform of + OSMinGW32 -> False -- See Note [%rip-relative addressing on x86-64] + _ -> True + + +-- Set up a condition code for a conditional branch. + +getCondCode :: CmmExpr -> NatM CondCode + +-- yes, they really do seem to want exactly the same! + +getCondCode (CmmMachOp mop [x, y]) + = + case mop of + MO_F_Eq W32 -> condFltCode EQQ x y + MO_F_Ne W32 -> condFltCode NE x y + MO_F_Gt W32 -> condFltCode GTT x y + MO_F_Ge W32 -> condFltCode GE x y + -- Invert comparison condition and swap operands + -- See Note [SSE Parity Checks] + MO_F_Lt W32 -> condFltCode GTT y x + MO_F_Le W32 -> condFltCode GE y x + + MO_F_Eq W64 -> condFltCode EQQ x y + MO_F_Ne W64 -> condFltCode NE x y + MO_F_Gt W64 -> condFltCode GTT x y + MO_F_Ge W64 -> condFltCode GE x y + MO_F_Lt W64 -> condFltCode GTT y x + MO_F_Le W64 -> condFltCode GE y x + + _ -> condIntCode (machOpToCond mop) x y + +getCondCode other = do + platform <- getPlatform + pprPanic "getCondCode(2)(x86,x86_64)" (pdoc platform other) + +machOpToCond :: MachOp -> Cond +machOpToCond mo = case mo of + MO_Eq _ -> EQQ + MO_Ne _ -> NE + MO_S_Gt _ -> GTT + MO_S_Ge _ -> GE + MO_S_Lt _ -> LTT + MO_S_Le _ -> LE + MO_U_Gt _ -> GU + MO_U_Ge _ -> GEU + MO_U_Lt _ -> LU + MO_U_Le _ -> LEU + _other -> pprPanic "machOpToCond" (pprMachOp mo) + +{- Note [64-bit integer comparisons on 32-bit] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + When doing these comparisons there are 2 kinds of + comparisons. + + * Comparison for equality (or lack thereof) + + We use xor to check if high/low bits are + equal. Then combine the results using or. + + * Other comparisons: + + We first compare the low registers + and use a subtraction with borrow to compare the high registers. + + For signed numbers the condition is determined by + the sign and overflow flags agreeing or not + and for unsigned numbers the condition is the carry flag. + +-} + +-- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be +-- passed back up the tree. + +condIntCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode +condIntCode cond x y = do platform <- getPlatform + condIntCode' platform cond x y + +condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode + +-- 64-bit integer comparisons on 32-bit +-- See Note [64-bit integer comparisons on 32-bit] +condIntCode' platform cond x y + | target32Bit platform && isWord64 (cmmExprType platform x) = do + + RegCode64 code1 r1hi r1lo <- iselExpr64 x + RegCode64 code2 r2hi r2lo <- iselExpr64 y + + -- we mustn't clobber r1/r2 so we use temporaries + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 + + let (cond', cmpCode) = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2 + return $ CondCode False cond' (code1 `appOL` code2 `appOL` cmpCode) + + where + intComparison cond r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = + case cond of + -- These don't occur as argument of condIntCode' + ALWAYS -> panic "impossible" + NEG -> panic "impossible" + POS -> panic "impossible" + CARRY -> panic "impossible" + OFLO -> panic "impossible" + PARITY -> panic "impossible" + NOTPARITY -> panic "impossible" + -- Special case #1 x == y and x != y + EQQ -> (EQQ, cmpExact) + NE -> (NE, cmpExact) + -- [x >= y] + GE -> (GE, cmpGE) + GEU -> (GEU, cmpGE) + -- [x > y] + GTT -> (LTT, cmpLE) + GU -> (LU, cmpLE) + -- [x <= y] + LE -> (GE, cmpLE) + LEU -> (GEU, cmpLE) + -- [x < y] + LTT -> (LTT, cmpGE) + LU -> (LU, cmpGE) + where + cmpExact :: OrdList Instr + cmpExact = + toOL + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , MOV II32 (OpReg r1_lo) (OpReg tmp2) + , XOR II32 (OpReg r2_hi) (OpReg tmp1) + , XOR II32 (OpReg r2_lo) (OpReg tmp2) + , OR II32 (OpReg tmp1) (OpReg tmp2) + ] + cmpGE = toOL + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , CMP II32 (OpReg r2_lo) (OpReg r1_lo) + , SBB II32 (OpReg r2_hi) (OpReg tmp1) + ] + cmpLE = toOL + [ MOV II32 (OpReg r2_hi) (OpReg tmp1) + , CMP II32 (OpReg r1_lo) (OpReg r2_lo) + , SBB II32 (OpReg r1_hi) (OpReg tmp1) + ] + +-- memory vs immediate +condIntCode' platform cond (CmmLoad x ty _) (CmmLit lit) + | is32BitLit platform lit = do + Amode x_addr x_code <- getAmode x + let + imm = litToImm lit + code = x_code `snocOL` + CMP (cmmTypeFormat ty) (OpImm imm) (OpAddr x_addr) + -- + return (CondCode False cond code) + +-- anything vs zero, using a mask +-- TODO: Add some sanity checking!!!! +condIntCode' platform cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 ty)) + | (CmmLit lit@(CmmInt mask _)) <- o2, is32BitLit platform lit + = do + (x_reg, x_code) <- getSomeReg x + let + code = x_code `snocOL` + TEST (intFormat ty) (OpImm (ImmInteger mask)) (OpReg x_reg) + -- + return (CondCode False cond code) + +-- anything vs zero +condIntCode' _ cond x (CmmLit (CmmInt 0 ty)) = do + (x_reg, x_code) <- getSomeReg x + let + code = x_code `snocOL` + TEST (intFormat ty) (OpReg x_reg) (OpReg x_reg) + -- + return (CondCode False cond code) + +-- anything vs operand +condIntCode' platform cond x y + | isOperand platform y = do + (x_reg, x_code) <- getNonClobberedReg x + (y_op, y_code) <- getOperand y + let + code = x_code `appOL` y_code `snocOL` + CMP (cmmTypeFormat (cmmExprType platform x)) y_op (OpReg x_reg) + return (CondCode False cond code) +-- operand vs. anything: invert the comparison so that we can use a +-- single comparison instruction. + | isOperand platform x + , Just revcond <- maybeFlipCond cond = do + (y_reg, y_code) <- getNonClobberedReg y + (x_op, x_code) <- getOperand x + let + code = y_code `appOL` x_code `snocOL` + CMP (cmmTypeFormat (cmmExprType platform x)) x_op (OpReg y_reg) + return (CondCode False revcond code) + +-- anything vs anything +condIntCode' platform cond x y = do + (y_reg, y_code) <- getNonClobberedReg y + (x_op, x_code) <- getRegOrMem x + let + code = y_code `appOL` + x_code `snocOL` + CMP (cmmTypeFormat (cmmExprType platform x)) (OpReg y_reg) x_op + return (CondCode False cond code) + + + +-------------------------------------------------------------------------------- +condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode + +condFltCode cond x y + = condFltCode_sse2 + where + + + -- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be + -- an operand, but the right must be a reg. We can probably do better + -- than this general case... + condFltCode_sse2 = do + platform <- getPlatform + (x_reg, x_code) <- getNonClobberedReg x + (y_op, y_code) <- getOperand y + let + code = x_code `appOL` + y_code `snocOL` + CMP (floatFormat $ cmmExprWidth platform x) y_op (OpReg x_reg) + -- NB(1): we need to use the unsigned comparison operators on the + -- result of this comparison. + return (CondCode True (condToUnsigned cond) code) + +-- ----------------------------------------------------------------------------- +-- Generating assignments + +-- Assignments are really at the heart of the whole code generation +-- business. Almost all top-level nodes of any real importance are +-- assignments, which correspond to loads, stores, or register +-- transfers. If we're really lucky, some of the register transfers +-- will go away, because we can use the destination register to +-- complete the code generation for the right hand side. This only +-- fails when the right hand side is forced into a fixed register +-- (e.g. the result of a call). + +assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_IntCode :: CmmReg -> CmmExpr -> NatM InstrBlock + +assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_FltCode :: CmmReg -> CmmExpr -> NatM InstrBlock + +assignMem_VecCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock +assignReg_VecCode :: CmmReg -> CmmExpr -> NatM InstrBlock + +-- integer assignment to memory + +-- specific case of adding/subtracting an integer to a particular address. +-- ToDo: catch other cases where we can use an operation directly on a memory +-- address. +assignMem_IntCode ty addr (CmmMachOp op [CmmLoad addr2 _ _, + CmmLit (CmmInt i _)]) + | addr == addr2, ty /= II64 || is32BitInteger i, + Just instr <- check op + = do Amode amode code_addr <- getAmode addr + let code = code_addr `snocOL` + instr ty (OpImm (ImmInt (fromIntegral i))) (OpAddr amode) + return code + where + check (MO_Add _) = Just ADD + check (MO_Sub _) = Just SUB + check _ = Nothing + -- ToDo: more? + +-- general case +assignMem_IntCode ty addr src = do + platform <- getPlatform + Amode addr code_addr <- getAmode addr + (code_src, op_src) <- get_op_RI platform src + let + code = code_src `appOL` + code_addr `snocOL` + MOV ty op_src (OpAddr addr) + -- NOTE: op_src is stable, so it will still be valid + -- after code_addr. This may involve the introduction + -- of an extra MOV to a temporary register, but we hope + -- the register allocator will get rid of it. + -- + return code + where + get_op_RI :: Platform -> CmmExpr -> NatM (InstrBlock,Operand) -- code, operator + get_op_RI platform (CmmLit lit) | is32BitLit platform lit + = return (nilOL, OpImm (litToImm lit)) + get_op_RI _ op + = do (reg,code) <- getNonClobberedReg op + return (code, OpReg reg) + + +-- Assign; dst is a reg, rhs is mem +assignReg_IntCode reg (CmmLoad src _ _) = do + let ty = cmmTypeFormat $ cmmRegType reg + load_code <- intLoadCode (MOV ty) src + platform <- ncgPlatform <$> getConfig + return (load_code (getRegisterReg platform reg)) + +-- dst is a reg, but src could be anything +assignReg_IntCode reg src = do + platform <- ncgPlatform <$> getConfig + code <- getAnyReg src + return (code (getRegisterReg platform reg)) + + +-- Floating point assignment to memory +assignMem_FltCode ty addr src = do + (src_reg, src_code) <- getNonClobberedReg src + Amode addr addr_code <- getAmode addr + let + code = src_code `appOL` + addr_code `snocOL` + MOV ty (OpReg src_reg) (OpAddr addr) + + return code + +-- Floating point assignment to a register/temporary +assignReg_FltCode reg src = do + src_code <- getAnyReg src + platform <- ncgPlatform <$> getConfig + return (src_code (getRegisterReg platform reg)) + +-- Vector assignment to a register/temporary +assignMem_VecCode ty addr src = do + (src_reg, src_code) <- getNonClobberedReg src + Amode addr addr_code <- getAmode addr + config <- getConfig + let + code = src_code `appOL` + addr_code `snocOL` + movInstr config ty (OpReg src_reg) (OpAddr addr) + return code + +assignReg_VecCode reg src = do + platform <- ncgPlatform <$> getConfig + src_code <- getAnyReg src + return (src_code (getRegisterReg platform reg)) + +genJump :: CmmExpr{-the branch target-} -> [RegWithFormat] -> NatM InstrBlock + +genJump (CmmLoad mem _ _) regs = do + Amode target code <- getAmode mem + return (code `snocOL` JMP (OpAddr target) regs) + +genJump (CmmLit lit) regs = + return (unitOL (JMP (OpImm (litToImm lit)) regs)) + +genJump expr regs = do + (reg,code) <- getSomeReg expr + return (code `snocOL` JMP (OpReg reg) regs) + + +-- ----------------------------------------------------------------------------- +-- Unconditional branches + +genBranch :: BlockId -> InstrBlock +genBranch = toOL . mkJumpInstr + + + +-- ----------------------------------------------------------------------------- +-- Conditional jumps/branches + +{- +Conditional jumps are always to local labels, so we can use branch +instructions. We peek at the arguments to decide what kind of +comparison to do. + +I386: First, we have to ensure that the condition +codes are set according to the supplied comparison operation. +-} + +genCondBranch + :: BlockId -- the source of the jump + -> BlockId -- the true branch target + -> BlockId -- the false branch target + -> CmmExpr -- the condition on which to branch + -> NatM InstrBlock -- Instructions + +genCondBranch bid id false expr = do + is32Bit <- is32BitPlatform + genCondBranch' is32Bit bid id false expr + +-- | We return the instructions generated. +genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr + -> NatM InstrBlock + +genCondBranch' _ bid id false bool = do + CondCode is_float cond cond_code <- getCondCode bool + if not is_float + then + return (cond_code `snocOL` JXX cond id `appOL` genBranch false) + else do + -- See Note [SSE Parity Checks] + let jmpFalse = genBranch false + code + = case cond of + NE -> or_unordered + GU -> plain_test + GEU -> plain_test + -- Use ASSERT so we don't break releases if + -- LTT/LE creep in somehow. + LTT -> + assertPpr False (text "Should have been turned into >") + and_ordered + LE -> + assertPpr False (text "Should have been turned into >=") + and_ordered + _ -> and_ordered + + plain_test = unitOL ( + JXX cond id + ) `appOL` jmpFalse + or_unordered = toOL [ + JXX cond id, + JXX PARITY id + ] `appOL` jmpFalse + and_ordered = toOL [ + JXX PARITY false, + JXX cond id, + JXX ALWAYS false + ] + updateCfgNat (\cfg -> adjustEdgeWeight cfg (+3) bid false) + return (cond_code `appOL` code) + +{- Note [Introducing cfg edges inside basic blocks] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + During instruction selection a statement `s` + in a block B with control of the sort: B -> C + will sometimes result in control + flow of the sort: + + ┌ < ┐ + v ^ + B -> B1 ┴ -> C + + as is the case for some atomic operations. + + Now to keep the CFG in sync when introducing B1 we clearly + want to insert it between B and C. However there is + a catch when we have to deal with self loops. + + We might start with code and a CFG of these forms: + + loop: + stmt1 ┌ < ┐ + .... v ^ + stmtX loop ┘ + stmtY + .... + goto loop: + + Now we introduce B1: + ┌ ─ ─ ─ ─ ─┐ + loop: │ ┌ < ┐ │ + instrs v │ │ ^ + .... loop ┴ B1 ┴ ┘ + instrsFromX + stmtY + goto loop: + + This is simple, all outgoing edges from loop now simply + start from B1 instead and the code generator knows which + new edges it introduced for the self loop of B1. + + Disaster strikes if the statement Y follows the same pattern. + If we apply the same rule that all outgoing edges change then + we end up with: + + loop ─> B1 ─> B2 ┬─┐ + │ │ └─<┤ │ + │ └───<───┘ │ + └───────<────────┘ + + This is problematic. The edge B1->B1 is modified as expected. + However the modification is wrong! + + The assembly in this case looked like this: + + _loop: + + _B1: + ... + cmpxchgq ... + jne _B1 + + + _B2: + ... + cmpxchgq ... + jne _B2 + + jmp loop + + There is no edge _B2 -> _B1 here. It's still a self loop onto _B1. + + The problem here is that really B1 should be two basic blocks. + Otherwise we have control flow in the *middle* of a basic block. + A contradiction! + + So to account for this we add yet another basic block marker: + + _B: + + _B1: + ... + cmpxchgq ... + jne _B1 + jmp _B1' + _B1': + + + _B2: + ... + + Now when inserting B2 we will only look at the outgoing edges of B1' and + everything will work out nicely. + + You might also wonder why we don't insert jumps at the end of _B1'. There is + no way another block ends up jumping to the labels _B1 or _B2 since they are + essentially invisible to other blocks. View them as control flow labels local + to the basic block if you'd like. + + Not doing this ultimately caused (part 2 of) #17334. +-} + + +-- ----------------------------------------------------------------------------- +-- Generating C calls + +-- Now the biggest nightmare---calls. Most of the nastiness is buried in +-- @get_arg@, which moves the arguments to the correct registers/stack +-- locations. Apart from that, the code is easy. +-- +-- (If applicable) Do not fill the delay slots here; you will confuse the +-- register allocator. +-- +-- See Note [Keeping track of the current block] for information why we need +-- to take/return a block id. + +genForeignCall + :: ForeignTarget -- ^ function to call + -> [CmmFormal] -- ^ where to put the result + -> [CmmActual] -- ^ arguments (of mixed type) + -> BlockId -- ^ The block we are in + -> NatM (InstrBlock, Maybe BlockId) + +genForeignCall target dst args bid = do + case target of + PrimTarget prim -> genPrim bid prim dst args + ForeignTarget addr conv -> (,Nothing) <$> genCCall bid addr conv dst args + +genPrim + :: BlockId -- ^ The block we are in + -> CallishMachOp -- ^ MachOp + -> [CmmFormal] -- ^ where to put the result + -> [CmmActual] -- ^ arguments (of mixed type) + -> NatM (InstrBlock, Maybe BlockId) + +-- First we deal with cases which might introduce new blocks in the stream. +genPrim bid (MO_AtomicRMW width amop) [dst] [addr, n] + = genAtomicRMW bid width amop dst addr n +genPrim bid (MO_Ctz width) [dst] [src] + = genCtz bid width dst src + +-- Then we deal with cases which not introducing new blocks in the stream. +genPrim bid prim dst args + = (,Nothing) <$> genSimplePrim bid prim dst args + +genSimplePrim + :: BlockId -- ^ the block we are in + -> CallishMachOp -- ^ MachOp + -> [CmmFormal] -- ^ where to put the result + -> [CmmActual] -- ^ arguments (of mixed type) + -> NatM InstrBlock +genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid align dst src n +genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n +genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n +genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genSimplePrim _ MO_SeqCstFence [] [] = return $ unitOL MFENCE +genSimplePrim _ MO_Touch [] [_] = return nilOL +genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src +genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src +genSimplePrim bid (MO_BRev width) [dst] [src] = genBitRev bid width dst src +genSimplePrim bid (MO_PopCnt width) [dst] [src] = genPopCnt bid width dst src +genSimplePrim bid (MO_Pdep width) [dst] [src,mask] = genPdep bid width dst src mask +genSimplePrim bid (MO_Pext width) [dst] [src,mask] = genPext bid width dst src mask +genSimplePrim bid (MO_Clz width) [dst] [src] = genClz bid width dst src +genSimplePrim bid (MO_UF_Conv width) [dst] [src] = genWordToFloat bid width dst src +genSimplePrim _ (MO_AtomicRead w mo) [dst] [addr] = genAtomicRead w mo dst addr +genSimplePrim _ (MO_AtomicWrite w mo) [] [addr,val] = genAtomicWrite w mo addr val +genSimplePrim bid (MO_Cmpxchg width) [dst] [addr,old,new] = genCmpXchg bid width dst addr old new +genSimplePrim _ (MO_Xchg width) [dst] [addr, value] = genXchg width dst addr value +genSimplePrim _ (MO_AddWordC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (const Nothing) CARRY r c x y +genSimplePrim _ (MO_SubWordC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) CARRY r c x y +genSimplePrim _ (MO_AddIntC w) [r,c] [x,y] = genAddSubRetCarry w ADD_CC (Just . ADD_CC) OFLO r c x y +genSimplePrim _ (MO_SubIntC w) [r,c] [x,y] = genAddSubRetCarry w SUB_CC (const Nothing) OFLO r c x y +genSimplePrim _ (MO_Add2 w) [h,l] [x,y] = genAddWithCarry w h l x y +genSimplePrim _ (MO_U_Mul2 w) [h,l] [x,y] = genUnsignedLargeMul w h l x y +genSimplePrim _ (MO_S_Mul2 w) [c,h,l] [x,y] = genSignedLargeMul w c h l x y +genSimplePrim _ (MO_S_QuotRem w) [q,r] [x,y] = genQuotRem w True q r Nothing x y +genSimplePrim _ (MO_U_QuotRem w) [q,r] [x,y] = genQuotRem w False q r Nothing x y +genSimplePrim _ (MO_U_QuotRem2 w) [q,r] [hx,lx,y] = genQuotRem w False q r (Just hx) lx y +genSimplePrim _ MO_F32_Fabs [dst] [src] = genFloatAbs W32 dst src +genSimplePrim _ MO_F64_Fabs [dst] [src] = genFloatAbs W64 dst src +genSimplePrim _ MO_F32_Sqrt [dst] [src] = genFloatSqrt FF32 dst src +genSimplePrim _ MO_F64_Sqrt [dst] [src] = genFloatSqrt FF64 dst src +genSimplePrim bid MO_F32_Sin [dst] [src] = genLibCCall bid (fsLit "sinf") [dst] [src] +genSimplePrim bid MO_F32_Cos [dst] [src] = genLibCCall bid (fsLit "cosf") [dst] [src] +genSimplePrim bid MO_F32_Tan [dst] [src] = genLibCCall bid (fsLit "tanf") [dst] [src] +genSimplePrim bid MO_F32_Exp [dst] [src] = genLibCCall bid (fsLit "expf") [dst] [src] +genSimplePrim bid MO_F32_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1f") [dst] [src] +genSimplePrim bid MO_F32_Log [dst] [src] = genLibCCall bid (fsLit "logf") [dst] [src] +genSimplePrim bid MO_F32_Log1P [dst] [src] = genLibCCall bid (fsLit "log1pf") [dst] [src] +genSimplePrim bid MO_F32_Asin [dst] [src] = genLibCCall bid (fsLit "asinf") [dst] [src] +genSimplePrim bid MO_F32_Acos [dst] [src] = genLibCCall bid (fsLit "acosf") [dst] [src] +genSimplePrim bid MO_F32_Atan [dst] [src] = genLibCCall bid (fsLit "atanf") [dst] [src] +genSimplePrim bid MO_F32_Sinh [dst] [src] = genLibCCall bid (fsLit "sinhf") [dst] [src] +genSimplePrim bid MO_F32_Cosh [dst] [src] = genLibCCall bid (fsLit "coshf") [dst] [src] +genSimplePrim bid MO_F32_Tanh [dst] [src] = genLibCCall bid (fsLit "tanhf") [dst] [src] +genSimplePrim bid MO_F32_Pwr [dst] [x,y] = genLibCCall bid (fsLit "powf") [dst] [x,y] +genSimplePrim bid MO_F32_Asinh [dst] [src] = genLibCCall bid (fsLit "asinhf") [dst] [src] +genSimplePrim bid MO_F32_Acosh [dst] [src] = genLibCCall bid (fsLit "acoshf") [dst] [src] +genSimplePrim bid MO_F32_Atanh [dst] [src] = genLibCCall bid (fsLit "atanhf") [dst] [src] +genSimplePrim bid MO_F64_Sin [dst] [src] = genLibCCall bid (fsLit "sin") [dst] [src] +genSimplePrim bid MO_F64_Cos [dst] [src] = genLibCCall bid (fsLit "cos") [dst] [src] +genSimplePrim bid MO_F64_Tan [dst] [src] = genLibCCall bid (fsLit "tan") [dst] [src] +genSimplePrim bid MO_F64_Exp [dst] [src] = genLibCCall bid (fsLit "exp") [dst] [src] +genSimplePrim bid MO_F64_ExpM1 [dst] [src] = genLibCCall bid (fsLit "expm1") [dst] [src] +genSimplePrim bid MO_F64_Log [dst] [src] = genLibCCall bid (fsLit "log") [dst] [src] +genSimplePrim bid MO_F64_Log1P [dst] [src] = genLibCCall bid (fsLit "log1p") [dst] [src] +genSimplePrim bid MO_F64_Asin [dst] [src] = genLibCCall bid (fsLit "asin") [dst] [src] +genSimplePrim bid MO_F64_Acos [dst] [src] = genLibCCall bid (fsLit "acos") [dst] [src] +genSimplePrim bid MO_F64_Atan [dst] [src] = genLibCCall bid (fsLit "atan") [dst] [src] +genSimplePrim bid MO_F64_Sinh [dst] [src] = genLibCCall bid (fsLit "sinh") [dst] [src] +genSimplePrim bid MO_F64_Cosh [dst] [src] = genLibCCall bid (fsLit "cosh") [dst] [src] +genSimplePrim bid MO_F64_Tanh [dst] [src] = genLibCCall bid (fsLit "tanh") [dst] [src] +genSimplePrim bid MO_F64_Pwr [dst] [x,y] = genLibCCall bid (fsLit "pow") [dst] [x,y] +genSimplePrim bid MO_F64_Asinh [dst] [src] = genLibCCall bid (fsLit "asinh") [dst] [src] +genSimplePrim bid MO_F64_Acosh [dst] [src] = genLibCCall bid (fsLit "acosh") [dst] [src] +genSimplePrim bid MO_F64_Atanh [dst] [src] = genLibCCall bid (fsLit "atanh") [dst] [src] +genSimplePrim bid MO_SuspendThread [tok] [rs,i] = genRTSCCall bid (fsLit "suspendThread") [tok] [rs,i] +genSimplePrim bid MO_ResumeThread [rs] [tok] = genRTSCCall bid (fsLit "resumeThread") [rs] [tok] +genSimplePrim bid MO_I64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64") [dst] [x,y] +genSimplePrim bid MO_I64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64") [dst] [x,y] +genSimplePrim bid MO_W64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64") [dst] [x,y] +genSimplePrim bid MO_W64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64") [dst] [x,y] +genSimplePrim bid (MO_VS_Quot 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt8X16") [dst] [x,y] +genSimplePrim bid (MO_VS_Quot 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt16X8") [dst] [x,y] +genSimplePrim bid (MO_VS_Quot 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt32X4") [dst] [x,y] +genSimplePrim bid (MO_VS_Quot 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64X2") [dst] [x,y] +genSimplePrim _ op@(MO_VS_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genSimplePrim bid (MO_VS_Rem 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt8X16") [dst] [x,y] +genSimplePrim bid (MO_VS_Rem 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt16X8") [dst] [x,y] +genSimplePrim bid (MO_VS_Rem 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt32X4") [dst] [x,y] +genSimplePrim bid (MO_VS_Rem 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64X2") [dst] [x,y] +genSimplePrim _ op@(MO_VS_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genSimplePrim bid (MO_VU_Quot 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord8X16") [dst] [x,y] +genSimplePrim bid (MO_VU_Quot 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord16X8") [dst] [x,y] +genSimplePrim bid (MO_VU_Quot 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord32X4") [dst] [x,y] +genSimplePrim bid (MO_VU_Quot 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64X2") [dst] [x,y] +genSimplePrim _ op@(MO_VU_Quot {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genSimplePrim bid (MO_VU_Rem 16 W8) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord8X16") [dst] [x,y] +genSimplePrim bid (MO_VU_Rem 8 W16) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord16X8") [dst] [x,y] +genSimplePrim bid (MO_VU_Rem 4 W32) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord32X4") [dst] [x,y] +genSimplePrim bid (MO_VU_Rem 2 W64) [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64X2") [dst] [x,y] +genSimplePrim _ op@(MO_VU_Rem {}) _ _ = pprPanic "Unsupported vector instruction for the native code generator:" (pprCallishMachOp op) +genSimplePrim bid MO_I64X2_Min [dst] [x,y] = genPrimCCall bid (fsLit "hs_minInt64X2") [dst] [x,y] +genSimplePrim bid MO_I64X2_Max [dst] [x,y] = genPrimCCall bid (fsLit "hs_maxInt64X2") [dst] [x,y] +genSimplePrim bid MO_W64X2_Min [dst] [x,y] = genPrimCCall bid (fsLit "hs_minWord64X2") [dst] [x,y] +genSimplePrim bid MO_W64X2_Max [dst] [x,y] = genPrimCCall bid (fsLit "hs_maxWord64X2") [dst] [x,y] +genSimplePrim _ op dst args = do + platform <- ncgPlatform <$> getConfig + pprPanic "genSimplePrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args)) + +{- Note [Evaluate C-call arguments before placing in destination registers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When producing code for C calls we must take care when placing arguments +in their final registers. Specifically, we must ensure that temporary register +usage due to evaluation of one argument does not clobber a register in which we +already placed a previous argument (e.g. as the code generation logic for +MO_Shl can clobber %rcx due to x86 instruction limitations). + +This is precisely what happened in #18527. Consider this C--: + + (result::I64) = call "ccall" doSomething(_s2hp::I64, 2244, _s2hq::I64, _s2hw::I64 | (1 << _s2hz::I64)); + +Here we are calling the C function `doSomething` with three arguments, the last +involving a non-trivial expression involving MO_Shl. In this case the NCG could +naively generate the following assembly (where $tmp denotes some temporary +register and $argN denotes the register for argument N, as dictated by the +platform's calling convention): + + mov _s2hp, $arg1 # place first argument + mov _s2hq, $arg2 # place second argument + + # Compute 1 << _s2hz + mov _s2hz, %rcx + shl %cl, $tmp + + # Compute (_s2hw | (1 << _s2hz)) + mov _s2hw, $arg3 + or $tmp, $arg3 + + # Perform the call + call func + +This code is outright broken on Windows which assigns $arg1 to %rcx. This means +that the evaluation of the last argument clobbers the first argument. + +To avoid this we use a rather awful hack: when producing code for a C call with +at least one non-trivial argument, we first evaluate all of the arguments into +local registers before moving them into their final calling-convention-defined +homes. This is performed by 'evalArgs'. Here we define "non-trivial" to be an +expression which might contain a MachOp since these are the only cases which +might clobber registers. Furthermore, we use a conservative approximation of +this condition (only looking at the top-level of CmmExprs) to avoid spending +too much effort trying to decide whether we want to take the fast path. + +Note that this hack *also* applies to calls to out-of-line PrimTargets (which +are lowered via a C call), which will ultimately end up in +genForeignCall{32,64}. +-} + +-- | See Note [Evaluate C-call arguments before placing in destination registers] +evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual]) +evalArgs bid actuals + | any loadIntoRegMightClobberOtherReg actuals = do + regs_blks <- mapM evalArg actuals + return (concatOL $ map fst regs_blks, map snd regs_blks) + | otherwise = return (nilOL, actuals) + where + + evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr) + evalArg actual = do + platform <- getPlatform + lreg <- newLocalReg $ cmmExprType platform actual + (instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual + -- The above assignment shouldn't change the current block + massert (isNothing bid1) + return (instrs, CmmReg $ CmmLocal lreg) + + newLocalReg :: CmmType -> NatM LocalReg + newLocalReg ty = LocalReg <$> getUniqueM <*> pure ty + +-- | Might the code to put this expression into a register +-- clobber any other registers? +loadIntoRegMightClobberOtherReg :: CmmExpr -> Bool +loadIntoRegMightClobberOtherReg (CmmReg _) = False +loadIntoRegMightClobberOtherReg (CmmRegOff _ _) = False +loadIntoRegMightClobberOtherReg (CmmLit _) = False + -- NB: this last 'False' is slightly risky, because the code for loading + -- a literal into a register is not entirely trivial. +loadIntoRegMightClobberOtherReg _ = True + +-- Note [DIV/IDIV for bytes] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~ +-- IDIV reminder: +-- Size Dividend Divisor Quotient Remainder +-- byte %ax r/m8 %al %ah +-- word %dx:%ax r/m16 %ax %dx +-- dword %edx:%eax r/m32 %eax %edx +-- qword %rdx:%rax r/m64 %rax %rdx +-- +-- We do a special case for the byte division because the current +-- codegen doesn't deal well with accessing %ah register (also, +-- accessing %ah in 64-bit mode is complicated because it cannot be an +-- operand of many instructions). So we just widen operands to 16 bits +-- and get the results from %al, %dl. This is not optimal, but a few +-- register moves are probably not a huge deal when doing division. + + +-- | Generate C call to the given function in ghc-prim +genPrimCCall + :: BlockId + -> FastString + -> [CmmFormal] + -> [CmmActual] + -> NatM InstrBlock +genPrimCCall bid lbl_txt dsts args = do + config <- getConfig + -- FIXME: we should use mkForeignLabel instead of mkCmmCodeLabel + let lbl = mkCmmCodeLabel ghcInternalUnitId lbl_txt + addr <- cmmMakeDynamicReference config CallReference lbl + let conv = ForeignConvention CCallConv [] [] CmmMayReturn + genCCall bid addr conv dsts args + +-- | Generate C call to the given function in libc +genLibCCall + :: BlockId + -> FastString + -> [CmmFormal] + -> [CmmActual] + -> NatM InstrBlock +genLibCCall bid lbl_txt dsts args = do + config <- getConfig + -- Assume we can call these functions directly, and that they're not in a dynamic library. + -- TODO: Why is this ok? Under linux this code will be in libm.so + -- Is it because they're really implemented as a primitive instruction by the assembler?? -- BL 2009/12/31 + let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction + addr <- cmmMakeDynamicReference config CallReference lbl + let conv = ForeignConvention CCallConv [] [] CmmMayReturn + genCCall bid addr conv dsts args + +-- | Generate C call to the given function in the RTS +genRTSCCall + :: BlockId + -> FastString + -> [CmmFormal] + -> [CmmActual] + -> NatM InstrBlock +genRTSCCall bid lbl_txt dsts args = do + config <- getConfig + -- Assume we can call these functions directly, and that they're not in a dynamic library. + let lbl = mkForeignLabel lbl_txt ForeignLabelInThisPackage IsFunction + addr <- cmmMakeDynamicReference config CallReference lbl + let conv = ForeignConvention CCallConv [] [] CmmMayReturn + genCCall bid addr conv dsts args + +-- | Generate a real C call to the given address with the given convention +genCCall + :: BlockId + -> CmmExpr + -> ForeignConvention + -> [CmmFormal] + -> [CmmActual] + -> NatM InstrBlock +genCCall bid addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do + platform <- getPlatform + is32Bit <- is32BitPlatform + let args_hints = zip args (argHints ++ repeat NoHint) + prom_args = map (maybePromoteCArgToW32 platform) args_hints + (instrs0, args') <- evalArgs bid prom_args + instrs1 <- if is32Bit + then genCCall32 addr conv dest_regs args' + else genCCall64 addr conv dest_regs args' + return (instrs0 `appOL` instrs1) + +maybePromoteCArgToW32 :: Platform -> (CmmExpr, ForeignHint) -> CmmExpr +maybePromoteCArgToW32 platform (arg, hint) + | wfrom < wto = + -- As wto=W32, we only need to handle integer conversions, + -- never Float -> Double. + case hint of + SignedHint -> CmmMachOp (MO_SS_Conv wfrom wto) [arg] + _ -> CmmMachOp (MO_UU_Conv wfrom wto) [arg] + | otherwise = arg + where + ty = cmmExprType platform arg + wfrom = typeWidth ty + wto = W32 + +genCCall32 :: CmmExpr -- ^ address of the function to call + -> ForeignConvention -- ^ calling convention + -> [CmmFormal] -- ^ where to put the result + -> [CmmActual] -- ^ arguments (of mixed type) + -> NatM InstrBlock +genCCall32 addr _conv dest_regs args = do + config <- getConfig + let platform = ncgPlatform config + + -- If the size is smaller than the word, we widen things (see maybePromoteCArg) + arg_size_bytes :: CmmType -> Int + arg_size_bytes ty = max (widthInBytes (typeWidth ty)) (widthInBytes (wordWidth platform)) + + roundTo a x | x `mod` a == 0 = x + | otherwise = x + a - (x `mod` a) + + push_arg :: CmmActual {-current argument-} + -> NatM InstrBlock -- code + + push_arg arg -- we don't need the hints on x86 + | isWord64 arg_ty = do + RegCode64 code r_hi r_lo <- iselExpr64 arg + delta <- getDeltaNat + setDeltaNat (delta - 8) + return ( code `appOL` + toOL [PUSH II32 (OpReg r_hi), DELTA (delta - 4), + PUSH II32 (OpReg r_lo), DELTA (delta - 8), + DELTA (delta-8)] + ) + + | isFloatType arg_ty || isVecType arg_ty = do + (reg, code) <- getSomeReg arg + delta <- getDeltaNat + setDeltaNat (delta-size) + return (code `appOL` + toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp), + DELTA (delta-size), + let addr = AddrBaseIndex (EABaseReg esp) + EAIndexNone + (ImmInt 0) + format = cmmTypeFormat arg_ty + in + + movInstr config format (OpReg reg) (OpAddr addr) + + ] + ) + + | otherwise = do + -- Arguments can be smaller than 32-bit, but we still use @PUSH + -- II32@ - the usual calling conventions expect integers to be + -- 4-byte aligned. + massert ((typeWidth arg_ty) <= W32) + (operand, code) <- getOperand arg + delta <- getDeltaNat + setDeltaNat (delta-size) + return (code `snocOL` + PUSH II32 operand `snocOL` + DELTA (delta-size)) + + where + arg_ty = cmmExprType platform arg + size = arg_size_bytes arg_ty -- Byte size + + let + -- Align stack to 16n for calls, assuming a starting stack + -- alignment of 16n - word_size on procedure entry. Which we + -- maintain. See Note [Stack Alignment on X86] in rts/StgCRun.c. + sizes = map (arg_size_bytes . cmmExprType platform) (reverse args) + raw_arg_size = sum sizes + platformWordSizeInBytes platform + arg_pad_size = (roundTo 16 $ raw_arg_size) - raw_arg_size + tot_arg_size = raw_arg_size + arg_pad_size - platformWordSizeInBytes platform + + + delta0 <- getDeltaNat + setDeltaNat (delta0 - arg_pad_size) + + push_codes <- mapM push_arg (reverse args) + delta <- getDeltaNat + massert (delta == delta0 - tot_arg_size) + + -- deal with static vs dynamic call targets + callinsns <- + case addr of + CmmLit (CmmLabel lbl) + -> return $ unitOL (CALL (Left fn_imm) []) + where fn_imm = ImmCLbl lbl + _ + -> do { (dyn_r, dyn_c) <- getSomeReg addr + ; massert (isWord32 (cmmExprType platform addr)) + ; return $ dyn_c `snocOL` CALL (Right dyn_r) [] } + let push_code + | arg_pad_size /= 0 + = toOL [SUB II32 (OpImm (ImmInt arg_pad_size)) (OpReg esp), + DELTA (delta0 - arg_pad_size)] + `appOL` concatOL push_codes + | otherwise + = concatOL push_codes + + call = callinsns `appOL` + toOL ( + (if tot_arg_size == 0 then [] else + [ADD II32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)]) + ++ + [DELTA delta0] + ) + setDeltaNat delta0 + + let + -- assign the results, if necessary + assign_code [] = nilOL + assign_code [dest] + | isVecType ty + = unitOL (mkRegRegMoveInstr config (cmmTypeFormat ty) xmm0 r_dest) + | isFloatType ty = + -- we assume SSE2 + let tmp_amode = AddrBaseIndex (EABaseReg esp) + EAIndexNone + (ImmInt 0) + fmt = floatFormat w + in toOL [ SUB II32 (OpImm (ImmInt b)) (OpReg esp), + DELTA (delta0 - b), + X87Store fmt tmp_amode, + -- X87Store only supported for the CDECL ABI + -- NB: This code will need to be + -- revisited once GHC does more work around + -- SIGFPE f + MOV fmt (OpAddr tmp_amode) (OpReg r_dest), + ADD II32 (OpImm (ImmInt b)) (OpReg esp), + DELTA delta0] + | isWord64 ty = toOL [MOV II32 (OpReg eax) (OpReg r_dest), + MOV II32 (OpReg edx) (OpReg r_dest_hi)] + | otherwise = unitOL (MOV (intFormat w) + (OpReg eax) + (OpReg r_dest)) + where + ty = localRegType dest + w = typeWidth ty + b = widthInBytes w + r_dest_hi = getHiVRegFromLo r_dest + r_dest = getLocalRegReg dest + assign_code many = pprPanic "genForeignCall.assign_code - too many return values:" (ppr many) + + return (push_code `appOL` + call `appOL` + assign_code dest_regs) + +genCCall64 :: CmmExpr -- ^ address of function to call + -> ForeignConvention -- ^ calling convention + -> [CmmFormal] -- ^ where to put the result + -> [CmmActual] -- ^ arguments (of mixed type) + -> NatM InstrBlock +genCCall64 addr conv dest_regs args = do + config <- getConfig + let platform = ncgPlatform config + word_size = platformWordSizeInBytes platform + wordFmt = archWordFormat (target32Bit platform) + + -- Compute the code for loading arguments into registers, + -- returning the leftover arguments that will need to be passed on the stack. + -- + -- NB: the code for loading references to data into registers is computed + -- later (in 'pushArgs'), because we don't yet know where the data will be + -- placed (due to alignment requirements). + LoadArgs + { stackArgs = proper_stack_args + , stackDataArgs = stack_data_args + , usedRegs = arg_regs_used + , assignArgsCode = assign_args_code + } + <- loadArgs config args + + let + + -- Pad all arguments and data passed on stack to align them properly. + (stk_args_with_padding, args_aligned_16) = + padStackArgs platform (proper_stack_args, stack_data_args) + + -- Align stack to 16n for calls, assuming a starting stack + -- alignment of 16n - word_size on procedure entry. Which we + -- maintain. See Note [Stack Alignment on X86] in rts/StgCRun.c + need_realign_call = args_aligned_16 + align_call_code <- + if need_realign_call + then addStackPadding word_size + else return nilOL + + -- Compute the code that pushes data to the stack, and also + -- the code that loads references to that data into registers, + -- when the data is passed by reference in a register. + (load_data_refs, push_code) <- + pushArgs config proper_stack_args stk_args_with_padding + + -- On Windows, leave stack space for the arguments that we are passing + -- in registers (the so-called shadow space). + let shadow_space = + if platformOS platform == OSMinGW32 + then 8 * length (allArgRegs platform) + -- NB: the shadow store is always 8 * 4 = 32 bytes large, + -- i.e. the cumulative size of rcx, rdx, r8, r9 (see 'allArgRegs'). + else 0 + shadow_space_code <- addStackPadding shadow_space + + let total_args_size + = shadow_space + + sum (map (stackArgSpace platform) stk_args_with_padding) + real_size = + total_args_size + if need_realign_call then word_size else 0 + + -- End of argument passing. + -- + -- Next step: emit the appropriate call instruction. + delta <- getDeltaNat + + let -- The System V AMD64 ABI requires us to set %al to the number of SSE2 + -- registers that contain arguments, if the called routine + -- is a varargs function. We don't know whether it's a + -- varargs function or not, so we have to assume it is. + -- + -- It's not safe to omit this assignment, even if the number + -- of SSE2 regs in use is zero. If %al is larger than 8 + -- on entry to a varargs function, seg faults ensue. + nb_sse_regs_used = count (isFloatFormat . regWithFormat_format) arg_regs_used + assign_eax_sse_regs + = unitOL (MOV II32 (OpImm (ImmInt nb_sse_regs_used)) (OpReg eax)) + -- Note: we do this on Windows as well. It's not entirely clear why + -- it's needed (the Windows X86_64 calling convention does not + -- dictate it), but we get segfaults without it. + -- + -- One test case exhibiting the issue is T20030_test1j; + -- if you change this, make sure to run it in a loop for a while + -- with at least -j8 to check. + + -- Live registers we are annotating the call instruction with + arg_regs = [RegWithFormat eax wordFmt] ++ arg_regs_used + + -- deal with static vs dynamic call targets + (callinsns,_cconv) <- case addr of + CmmLit (CmmLabel lbl) -> + return (unitOL (CALL (Left (ImmCLbl lbl)) arg_regs), conv) + _ -> do + (dyn_r, dyn_c) <- getSomeReg addr + return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv) + + let call = callinsns `appOL` + toOL ( + -- Deallocate parameters after call for ccall + (if real_size==0 then [] else + [ADD (intFormat (platformWordWidth platform)) (OpImm (ImmInt real_size)) (OpReg esp)]) + ++ + [DELTA (delta + real_size)] + ) + setDeltaNat (delta + real_size) + + let + -- assign the results, if necessary + assign_code [] = nilOL + assign_code [dest] = + unitOL $ + mkRegRegMoveInstr config fmt reg r_dest + where + reg = if isIntFormat fmt then rax else xmm0 + fmt = cmmTypeFormat rep + rep = localRegType dest + r_dest = getRegisterReg platform (CmmLocal dest) + assign_code _many = panic "genForeignCall.assign_code many" + + return (align_call_code `appOL` + push_code `appOL` + assign_args_code `appOL` + load_data_refs `appOL` + shadow_space_code `appOL` + assign_eax_sse_regs `appOL` + call `appOL` + assign_code dest_regs) + +-- ----------------------------------------------------------------------------- +-- Loading arguments into registers for 64-bit C calls. + +-- | Information needed to know how to pass arguments in a C call, +-- and in particular how to load them into registers. +data LoadArgs + = LoadArgs + -- | Arguments that should be passed on the stack + { stackArgs :: [RawStackArg] + -- | Additional values to store onto the stack. + , stackDataArgs :: [CmmExpr] + -- | Which registers are we using for argument passing? + , usedRegs :: [RegWithFormat] + -- | The code to assign arguments to registers used for argument passing. + , assignArgsCode :: InstrBlock + } +instance Semigroup LoadArgs where + LoadArgs a1 d1 r1 j1 <> LoadArgs a2 d2 r2 j2 + = LoadArgs (a1 ++ a2) (d1 ++ d2) (r1 ++ r2) (j1 S.<> j2) +instance Monoid LoadArgs where + mempty = LoadArgs [] [] [] nilOL + +-- | An argument passed on the stack, either directly or by reference. +-- +-- The padding information hasn't yet been computed (see 'StackArg'). +data RawStackArg + -- | Pass the argument on the stack directly. + = RawStackArg { stackArgExpr :: CmmExpr } + -- | Pass the argument by reference. + | RawStackArgRef + { stackRef :: StackRef + -- ^ is the reference passed in a register, or on the stack? + , stackRefArgSize :: Int + -- ^ the size of the data pointed to + } + deriving ( Show ) + +-- | An argument passed on the stack, either directly or by reference, +-- with additional padding information. +data StackArg + -- | Pass the argument on the stack directly. + = StackArg + { stackArgExpr :: CmmExpr + , stackArgPadding :: Int + -- ^ padding required (in bytes) + } + -- | Pass the argument by reference. + | StackArgRef + { stackRef :: StackRef + -- ^ where the reference is passed + , stackRefArgSize :: Int + -- ^ the size of the data pointed to + , stackRefArgPadding :: Int + -- ^ padding of the data pointed to + -- (the reference itself never requires padding) + } + deriving ( Show ) + +-- | Where is a reference to data on the stack passed? +data StackRef + -- | In a register. + = InReg Reg + -- | On the stack. + | OnStack + deriving ( Eq, Ord, Show ) + +newtype Padding = Padding { paddingBytes :: Int } + deriving ( Show, Eq, Ord ) + +-- | How much space does this 'StackArg' take up on the stack? +-- +-- Only counts the "reference" part for references, not the data it points to. +stackArgSpace :: Platform -> StackArg -> Int +stackArgSpace platform = \case + StackArg arg padding -> + argSize platform arg + padding + StackArgRef { stackRef = ref } -> + case ref of + InReg {} -> 0 + OnStack {} -> 8 + +-- | Pad arguments, assuming we start aligned to a 16-byte boundary. +-- +-- Returns padded arguments, together with whether we end up aligned +-- to a 16-byte boundary. +padStackArgs :: Platform + -> ([RawStackArg], [CmmExpr]) + -> ([StackArg], Bool) +padStackArgs platform (args0, data_args0) = + let + -- Pad the direct args + (args, align_16_mid) = pad_args True args0 + + -- Pad the data section + (data_args, align_16_end) = pad_args align_16_mid (map RawStackArg data_args0) + + -- Now figure out where the data is placed relative to the direct arguments, + -- in order to resolve references. + resolve_args :: [(RawStackArg, Padding)] -> [Padding] -> [StackArg] + resolve_args [] _ = [] + resolve_args ((stk_arg, Padding pad):rest) pads = + let (this_arg, pads') = + case stk_arg of + RawStackArg arg -> (StackArg arg pad, pads) + RawStackArgRef ref size -> case pads of + Padding arg_pad : rest_pads -> + let arg = StackArgRef + { stackRef = ref + , stackRefArgSize = size + , stackRefArgPadding = arg_pad } + in (arg, rest_pads) + _ -> panic "padStackArgs: no padding info found for StackArgRef" + in this_arg : resolve_args rest pads' + + in + ( resolve_args args (fmap snd data_args) ++ + [ case data_arg of + RawStackArg arg -> StackArg arg pad + RawStackArgRef {} -> panic "padStackArgs: reference in data section" + | (data_arg, Padding pad) <- data_args + ] + , align_16_end ) + + where + pad_args :: Bool -> [RawStackArg] -> ([(RawStackArg, Padding)], Bool) + pad_args aligned_16 [] = ([], aligned_16) + pad_args aligned_16 (arg:args) + | needed_alignment > 16 + -- We don't know if the stack is aligned to 8 (mod 32) or 24 (mod 32). + -- This makes aligning the stack to a 32 or 64 byte boundary more + -- complicated, in particular with DELTA. + = sorry $ unlines + [ "X86_86 C call: unsupported argument." + , " Alignment requirement: " ++ show needed_alignment ++ " bytes." + , if platformOS platform == OSMinGW32 + then " The X86_64 NCG does not (yet) support Windows C calls with 256/512 bit vectors." + else " The X86_64 NCG cannot (yet) pass 256/512 bit vectors on the stack for C calls." + , " Please use the LLVM backend (-fllvm)." ] + | otherwise + = let ( rest, final_align_16 ) = pad_args next_aligned_16 args + in ( (arg, Padding padding) : rest, final_align_16 ) + + where + needed_alignment = case arg of + RawStackArg arg -> argSize platform arg + RawStackArgRef {} -> platformWordSizeInBytes platform + padding + | needed_alignment < 16 || aligned_16 + = 0 + | otherwise + = 8 + next_aligned_16 = not ( aligned_16 && needed_alignment < 16 ) + +-- | Load arguments into available registers. +loadArgs :: NCGConfig -> [CmmExpr] -> NatM LoadArgs +loadArgs config args + | platformOS platform == OSMinGW32 + = evalStateT (loadArgsWin config args) (allArgRegs platform) + | otherwise + = evalStateT (loadArgsSysV config args) (allIntArgRegs platform + ,allFPArgRegs platform) + where + platform = ncgPlatform config + +-- | Load arguments into available registers (System V AMD64 ABI). +loadArgsSysV :: NCGConfig + -> [CmmExpr] + -> StateT ([Reg], [Reg]) NatM LoadArgs +loadArgsSysV _ [] = return mempty +loadArgsSysV config (arg:rest) = do + (iregs, fregs) <- get + -- No available registers: pass everything on the stack (shortcut). + if null iregs && null fregs + then return $ + LoadArgs + { stackArgs = map RawStackArg (arg:rest) + , stackDataArgs = [] + , assignArgsCode = nilOL + , usedRegs = [] + } + else do + mbReg <- + if + | isIntFormat arg_fmt + , ireg:iregs' <- iregs + -> do put (iregs', fregs) + return $ Just ireg + | isFloatFormat arg_fmt || isVecFormat arg_fmt + , freg:fregs' <- fregs + -> do put (iregs, fregs') + return $ Just freg + | otherwise + -> return Nothing + this_arg <- + case mbReg of + Just reg -> do + assign_code <- lift $ loadArgIntoReg arg reg + return $ + LoadArgs + { stackArgs = [] -- passed in register + , stackDataArgs = [] + , assignArgsCode = assign_code + , usedRegs = [RegWithFormat reg arg_fmt] + } + Nothing -> do + return $ + -- No available register for this argument: pass it on the stack. + LoadArgs + { stackArgs = [RawStackArg arg] + , stackDataArgs = [] + , assignArgsCode = nilOL + , usedRegs = [] + } + others <- loadArgsSysV config rest + return $ this_arg S.<> others + + where + platform = ncgPlatform config + arg_fmt = cmmTypeFormat (cmmExprType platform arg) + +-- | Compute all things that will need to be pushed to the stack. +-- +-- On Windows, an argument passed by reference will require two pieces of data: +-- +-- - the reference (returned in the first position) +-- - the actual data (returned in the second position) +computeWinPushArgs :: Platform -> [CmmExpr] -> ([RawStackArg], [CmmExpr]) +computeWinPushArgs platform = go + where + go :: [CmmExpr] -> ([RawStackArg], [CmmExpr]) + go [] = ([], []) + go (arg:args) = + let + arg_size = argSize platform arg + (this_arg, add_this_arg) + | arg_size > 8 + = ( RawStackArgRef OnStack arg_size, (arg :) ) + | otherwise + = ( RawStackArg arg, id ) + (stk_args, stk_data) = go args + in + (this_arg:stk_args, add_this_arg stk_data) + +-- | Load arguments into available registers (Windows C X64 calling convention). +loadArgsWin :: NCGConfig -> [CmmExpr] -> StateT [(Reg,Reg)] NatM LoadArgs +loadArgsWin _ [] = return mempty +loadArgsWin config (arg:rest) = do + regs <- get + case regs of + reg:regs' -> do + put regs' + this_arg <- lift $ load_arg_win reg + rest <- loadArgsWin config rest + return $ this_arg S.<> rest + [] -> do + -- No more registers available: pass all (remaining) arguments on the stack. + let (stk_args, data_args) = computeWinPushArgs platform (arg:rest) + return $ + LoadArgs + { stackArgs = stk_args + , stackDataArgs = data_args + , assignArgsCode = nilOL + , usedRegs = [] + } + where + platform = ncgPlatform config + arg_fmt = cmmTypeFormat $ cmmExprType platform arg + load_arg_win (ireg, freg) + | isVecFormat arg_fmt + -- Vectors are passed by reference. + -- See Note [The Windows X64 C calling convention]. + = do return $ + LoadArgs + -- Pass the reference in a register, + -- and the argument data on the stack. + { stackArgs = [RawStackArgRef (InReg ireg) (argSize platform arg)] + , stackDataArgs = [arg] -- we don't yet know where the data will reside, + , assignArgsCode = nilOL -- so we defer computing the reference and storing it + -- in the register until later + , usedRegs = [RegWithFormat ireg II64] + } + | otherwise + = do let arg_reg + | isFloatFormat arg_fmt + = freg + | otherwise + = ireg + assign_code <- loadArgIntoReg arg arg_reg + -- Recall that, for varargs, we must pass floating-point + -- arguments in both fp and integer registers. + let (assign_code', regs') + | isFloatFormat arg_fmt = + ( assign_code `snocOL` MOVD FF64 II64 (OpReg freg) (OpReg ireg), + [ RegWithFormat freg FF64 + , RegWithFormat ireg II64 ]) + | otherwise = (assign_code, [RegWithFormat ireg II64]) + return $ + LoadArgs + { stackArgs = [] -- passed in register + , stackDataArgs = [] + , assignArgsCode = assign_code' + , usedRegs = regs' + } + +-- | Load an argument into a register. +-- +-- Assumes that the expression does not contain any MachOps, +-- as per Note [Evaluate C-call arguments before placing in destination registers]. +loadArgIntoReg :: CmmExpr -> Reg -> NatM InstrBlock +loadArgIntoReg arg reg = do + when (debugIsOn && loadIntoRegMightClobberOtherReg arg) $ do + platform <- getPlatform + massertPpr False $ + vcat [ text "loadArgIntoReg: arg might contain MachOp" + , text "arg:" <+> pdoc platform arg ] + arg_code <- getAnyReg arg + return $ arg_code reg + +-- ----------------------------------------------------------------------------- +-- Pushing arguments onto the stack for 64-bit C calls. + +-- | The size of an argument (in bytes). +-- +-- Never smaller than the platform word width. +argSize :: Platform -> CmmExpr -> Int +argSize platform arg = + max (platformWordSizeInBytes platform) $ + widthInBytes (typeWidth $ cmmExprType platform arg) + +-- | Add the given amount of padding on the stack. +addStackPadding :: Int -- ^ padding (in bytes) + -> NatM InstrBlock +addStackPadding pad_bytes + | pad_bytes == 0 + = return nilOL + | otherwise + = do delta <- getDeltaNat + setDeltaNat (delta - pad_bytes) + return $ + toOL [ SUB II64 (OpImm (ImmInt pad_bytes)) (OpReg rsp) + , DELTA (delta - pad_bytes) + ] + +-- | Push one argument directly to the stack (by value). +-- +-- Assumes the current stack pointer fulfills any necessary alignment requirements. +pushArgByValue :: NCGConfig -> CmmExpr -> NatM InstrBlock +pushArgByValue config arg + -- For 64-bit integer arguments, use PUSH II64. + -- + -- Note: we *must not* do this for smaller arguments. + -- For example, if we tried to push an argument such as @CmmLoad addr W32 aln@, + -- we could end up reading unmapped memory and segfaulting. + | isIntFormat fmt + , formatInBytes fmt == 8 + = do + (arg_op, arg_code) <- getOperand arg + delta <- getDeltaNat + setDeltaNat (delta-arg_size) + return $ + arg_code `appOL` toOL + [ PUSH II64 arg_op + , DELTA (delta-arg_size) ] + + | otherwise + = do + (arg_reg, arg_code) <- getSomeReg arg + delta <- getDeltaNat + setDeltaNat (delta-arg_size) + return $ arg_code `appOL` toOL + [ SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_size)) (OpReg rsp) + , DELTA (delta-arg_size) + , movInstr config fmt (OpReg arg_reg) (OpAddr (spRel platform 0)) ] + + where + platform = ncgPlatform config + arg_size = argSize platform arg + arg_rep = cmmExprType platform arg + fmt = cmmTypeFormat arg_rep + +-- | Load an argument into a register or push it to the stack. +loadOrPushArg :: NCGConfig -> (StackArg, Maybe Int) -> NatM (InstrBlock, InstrBlock) +loadOrPushArg config (stk_arg, mb_off) = + case stk_arg of + StackArg arg pad -> do + push_code <- pushArgByValue config arg + pad_code <- addStackPadding pad + return (nilOL, push_code `appOL` pad_code) + StackArgRef { stackRef = ref } -> + case ref of + -- Pass the reference in a register + InReg ireg -> + return (unitOL $ LEA II64 (OpAddr (spRel platform off)) (OpReg ireg), nilOL) + -- Pass the reference on the stack + OnStack {} -> do + tmp <- getNewRegNat II64 + delta <- getDeltaNat + setDeltaNat (delta-arg_ref_size) + let push_code = toOL + [ SUB (intFormat (wordWidth platform)) (OpImm (ImmInt arg_ref_size)) (OpReg rsp) + , DELTA (delta-arg_ref_size) + , LEA II64 (OpAddr (spRel platform off)) (OpReg tmp) + , MOV II64 (OpReg tmp) (OpAddr (spRel platform 0)) ] + return (nilOL, push_code) + where off = expectJust mb_off + where + arg_ref_size = 8 -- passing a reference to the argument + platform = ncgPlatform config + +-- | Push arguments to the stack, right to left. +-- +-- On Windows, some arguments may need to be passed by reference, +-- which requires separately passing the data and the reference. +-- See Note [The Windows X64 C calling convention]. +pushArgs :: NCGConfig + -> [RawStackArg] + -- ^ arguments proper (i.e. don't include the data for arguments passed by reference) + -> [StackArg] + -- ^ arguments we are passing on the stack + -> NatM (InstrBlock, InstrBlock) +pushArgs config proper_args all_stk_args + = do { let + vec_offs :: [Maybe Int] + vec_offs + | platformOS platform == OSMinGW32 + = go stack_arg_size all_stk_args + | otherwise + = repeat Nothing + + --------------------- + -- Windows-only code + + -- Size of the arguments we are passing on the stack, counting only + -- the reference part for arguments passed by reference. + stack_arg_size = 8 * count not_in_reg proper_args + not_in_reg (RawStackArg {}) = True + not_in_reg (RawStackArgRef { stackRef = ref }) = + case ref of + InReg {} -> False + OnStack {} -> True + + -- Check an offset is valid (8-byte aligned), for assertions. + ok off = off `rem` 8 == 0 + + -- Tricky code: compute the stack offset to the vector data + -- for this argument. + -- + -- If you're confused, Note [The Windows X64 C calling convention] + -- contains a helpful diagram. + go :: Int -> [StackArg] -> [Maybe Int] + go _ [] = [] + go off (stk_arg:args) = + assertPpr (ok off) (text "unaligned offset:" <+> ppr off) $ + case stk_arg of + StackArg {} -> + -- Only account for the stack pointer movement. + let off' = off - stackArgSpace platform stk_arg + in Nothing : go off' args + StackArgRef + { stackRefArgSize = data_size + , stackRefArgPadding = data_pad } -> + assertPpr (ok data_size) (text "unaligned data size:" <+> ppr data_size) $ + assertPpr (ok data_pad) (text "unaligned data padding:" <+> ppr data_pad) $ + let off' = off + -- Next piece of data is after the data for this reference + + data_size + data_pad + -- ... and account for the stack pointer movement. + - stackArgSpace platform stk_arg + in Just (data_pad + off) : go off' args + + -- end of Windows-only code + ---------------------------- + + -- Push the stack arguments (right to left), + -- including both the reference and the data for arguments passed by reference. + ; (load_regs, push_args) <- foldMapM (loadOrPushArg config) (reverse $ zip all_stk_args vec_offs) + ; return (load_regs, push_args) } + where + platform = ncgPlatform config + +{- Note [The Windows X64 C calling convention] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here are a few facts about the Windows X64 C calling convention that +are important: + + - any argument larger than 8 bytes must be passed by reference, + and arguments smaller than 8 bytes are padded to 8 bytes. + + - the first four arguments are passed in registers: + - floating-point scalar arguments are passed in %xmm0, %xmm1, %xmm2, %xmm3 + - other arguments are passed in %rcx, %rdx, %r8, %r9 + (this includes vector arguments, passed by reference) + + For variadic functions, it is additionally expected that floating point + scalar arguments are copied to the corresponding integer register, e.g. + the data in xmm2 should also be copied to r8. + + There is no requirement about setting %al like there is for the + System V AMD64 ABI. + + - subsequent arguments are passed on the stack. + +There are also alignment requirements: + + - the data for vectors must be aligned to the size of the vector, + e.g. a 32 byte vector must be aligned on a 32 byte boundary, + + - the call instruction must be aligned to 16 bytes. + (This differs from the System V AMD64 ABI, which mandates that the call + instruction must be aligned to 32 bytes if there are any 32 byte vectors + passed on the stack.) + +This motivates our handling of vector values. Suppose we have a function call +with many arguments, several of them being vectors. We proceed as follows: + + - Add some padding, if necessary, to ensure the stack, when executing the call + instruction, is 16-byte aligned. Whether this padding is necessary depends + on what happens next. (Recall also that we start off at 8 (mod 16) alignment, + as per Note [Stack Alignment on X86] in rts/StgCRun.c) + - Push all the vectors to the stack first, adding padding after each one + if necessary. + - Then push the arguments: + - for non-vectors, proceed as usual, + - for vectors, push the address of the vector data we pushed above. + - Then assign the registers: + - for non-vectors, proceed as usual, + - for vectors, store the address in a general-purpose register, as opposed + to storing the data in an xmm register. + +For a concrete example, suppose we have a call of the form: + + f x1 x2 x3 x4 x5 x6 x7 + +in which: + + - x2, x3, x5 and x7 are 16 byte vectors + - the other arguments are all 8 byte wide + +Now, x1, x2, x3, x4 will get passed in registers, except that we pass +x2 and x3 by reference, because they are vectors. We proceed as follows: + + - push the vectors to the stack: x7, x5, x3, x2 (in that order) + - push the stack arguments in order: addr(x7), x6, addr(x5) + - load the remaining arguments into registers: x4, addr(x3), addr(x2), x1 + +The tricky part is to get the right offsets for the addresses of the vector +data. The following visualisation will hopefully clear things up: + + ┌──┐ + │▓▓│ ─── padding to align the call instruction + ╭─╴ ╞══╡ (ensures Sp, below, is 16-byte aligned) + │ │ │ + │ x7 ───╴ │ │ + │ ├──┤ + │ │ │ + │ x5 ───╴ │ │ + │ ├──┤ + vector data ────┤ │ │ +(individually padded) │ x3 ───╴ │ │ + │ ├──┤ + │ │ │ + │ x2 ───╴ │ │ + │ ├┄┄┤ + │ │▓▓│ ─── padding to align x2 to 16 bytes + ╭─╴ ╰─╴ ╞══╡ + │ addr(x7) ───╴ │ │ ╭─ from here: x7 is +64 + │ ├──┤ ╾──╯ = 64 (position of x5) + stack ───┤ x6 ───╴ │ │ + 16 (size of x5) + 0 (padding of x7) + arguments │ ├──┤ - 2 * 8 (x7 is 2 arguments higher than x5) + │ addr(x5) ───╴ │ │ + ╰─╴ ╭─╴ ╞══╡ ╾─── from here: + │ │ │ - x2 is +32 = 24 (stack_arg_size) + 8 (padding of x2) + shadow ───┤ │ │ - x3 is +48 = 32 (position of x2) + 16 (size of x2) + 0 (padding of x3) + space │ │ │ - x5 is +64 = 48 (position of x3) + 16 (size of x3) + 0 (padding of x5) + │ │ │ + ╰─╴ └──┘ ╾─── Sp + +This is all tested in the simd013 test. +-} + +-- ----------------------------------------------------------------------------- +-- Generating a table-branch + +{- +Note [Sub-word subtlety during jump-table indexing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Offset the index by the start index of the jump table. +It's important that we do this *before* the widening below. To see +why, consider a switch with a sub-word, signed discriminant such as: + + switch [-5...+2] x::I16 { + case -5: ... + ... + case +2: ... + } + +Consider what happens if we offset *after* widening in the case that +x=-4: + + // x == -4 == 0xfffc::I16 + indexWidened = UU_Conv(x); // == 0xfffc::I64 + indexExpr = indexWidened - (-5); // == 0x10000::I64 + +This index is clearly nonsense given that the jump table only has +eight entries. + +By contrast, if we widen *after* we offset then we get the correct +index (1), + + // x == -4 == 0xfffc::I16 + indexOffset = x - (-5); // == 1::I16 + indexExpr = UU_Conv(indexOffset); // == 1::I64 + +See #21186. +-} + +genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock + +genSwitch expr targets = do + config <- getConfig + let platform = ncgPlatform config + expr_w = cmmExprWidth platform expr + indexExpr0 = cmmOffset platform expr offset + -- We widen to a native-width register because we cannot use arbitrary sizes + -- in x86 addressing modes. + -- See Note [Sub-word subtlety during jump-table indexing]. + indexExpr = CmmMachOp + (MO_UU_Conv expr_w (platformWordWidth platform)) + [indexExpr0] + if ncgPIC config + then do + (reg,e_code) <- getNonClobberedReg indexExpr + -- getNonClobberedReg because it needs to survive across t_code + lbl <- getNewLabelNat + let is32bit = target32Bit platform + os = platformOS platform + -- Might want to use .rodata. instead, but as + -- long as it's something unique it'll work out since the + -- references to the jump table are in the appropriate section. + rosection = case os of + -- on Mac OS X/x86_64, put the jump table in the text section to + -- work around a limitation of the linker. + -- ld64 is unable to handle the relocations for + -- .quad L1 - L0 + -- if L0 is not preceded by a non-anonymous label in its section. + OSDarwin | not is32bit -> Section Text lbl + _ -> Section ReadOnlyData lbl + dynRef <- cmmMakeDynamicReference config DataReference lbl + (tableReg,t_code) <- getSomeReg $ dynRef + let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) + (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) + + return $ e_code `appOL` t_code `appOL` toOL [ + ADD (intFormat (platformWordWidth platform)) op (OpReg tableReg), + JMP_TBL (OpReg tableReg) ids rosection lbl + ] + else do + (reg,e_code) <- getSomeReg indexExpr + lbl <- getNewLabelNat + let is32bit = target32Bit platform + if is32bit + then let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl lbl)) + jmp_code = JMP_TBL op ids (Section ReadOnlyData lbl) lbl + in return $ e_code `appOL` unitOL jmp_code + else do + -- See Note [%rip-relative addressing on x86-64]. + tableReg <- getNewRegNat (intFormat (platformWordWidth platform)) + targetReg <- getNewRegNat (intFormat (platformWordWidth platform)) + let op = OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)) + fmt = archWordFormat is32bit + code = e_code `appOL` toOL + [ LEA fmt (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl lbl))) (OpReg tableReg) + , MOV fmt op (OpReg targetReg) + , JMP_TBL (OpReg targetReg) ids (Section ReadOnlyData lbl) lbl + ] + return code + where + (offset, blockIds) = switchTargetsToTable targets + ids = map (fmap DestBlockId) blockIds + +generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl (Alignment, RawCmmStatics) Instr) +generateJumpTableForInstr config (JMP_TBL _ ids section lbl) + = let getBlockId (DestBlockId id) = id + getBlockId _ = panic "Non-Label target in Jump Table" + blockIds = map (fmap getBlockId) ids + in Just (createJumpTable config blockIds section lbl) +generateJumpTableForInstr _ _ = Nothing + +createJumpTable :: NCGConfig -> [Maybe BlockId] -> Section -> CLabel + -> GenCmmDecl (Alignment, RawCmmStatics) h g +createJumpTable config ids section lbl + = let jumpTable + | ncgPIC config = + let ww = ncgWordWidth config + jumpTableEntryRel Nothing + = CmmStaticLit (CmmInt 0 ww) + jumpTableEntryRel (Just blockid) + = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0 ww) + where blockLabel = blockLbl blockid + in map jumpTableEntryRel ids + | otherwise = map (jumpTableEntry config) ids + in CmmData section (mkAlignment 1, CmmStaticsRaw lbl jumpTable) + +extractUnwindPoints :: [Instr] -> [UnwindPoint] +extractUnwindPoints instrs = + [ UnwindPoint lbl unwinds | UNWIND lbl unwinds <- instrs] + +-- ----------------------------------------------------------------------------- +-- 'condIntReg' and 'condFltReg': condition codes into registers + +-- Turn those condition codes into integers now (when they appear on +-- the right hand side of an assignment). +-- +-- (If applicable) Do not fill the delay slots here; you will confuse the +-- register allocator. + +condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register + +condIntReg cond x y = do + CondCode _ cond cond_code <- condIntCode cond x y + tmp <- getNewRegNat II8 + let + code dst = cond_code `appOL` toOL [ + SETCC cond (OpReg tmp), + MOVZxL II8 (OpReg tmp) (OpReg dst) + ] + return (Any II32 code) + + +-- Note [SSE Parity Checks] +-- ~~~~~~~~~~~~~~~~~~~~~~~~ +-- We have to worry about unordered operands (eg. comparisons +-- against NaN). If the operands are unordered, the comparison +-- sets the parity flag, carry flag and zero flag. +-- All comparisons are supposed to return false for unordered +-- operands except for !=, which returns true. +-- +-- Optimisation: we don't have to test the parity flag if we +-- know the test has already excluded the unordered case: eg > +-- and >= test for a zero carry flag, which can only occur for +-- ordered operands. +-- +-- By reversing comparisons we can avoid testing the parity +-- for < and <= as well. If any of the arguments is an NaN we +-- return false either way. If both arguments are valid then +-- x <= y <-> y >= x holds. So it's safe to swap these. +-- +-- We invert the condition inside getRegister'and getCondCode +-- which should cover all invertable cases. +-- All other functions translating FP comparisons to assembly +-- use these to two generate the comparison code. +-- +-- As an example consider a simple check: +-- +-- func :: Float -> Float -> Int +-- func x y = if x < y then 1 else 0 +-- +-- Which in Cmm gives the floating point comparison. +-- +-- if (%MO_F_Lt_W32(F1, F2)) goto c2gg; else goto c2gf; +-- +-- We used to compile this to an assembly code block like this: +-- _c2gh: +-- ucomiss %xmm2,%xmm1 +-- jp _c2gf +-- jb _c2gg +-- jmp _c2gf +-- +-- Where we have to introduce an explicit +-- check for unordered results (using jmp parity): +-- +-- We can avoid this by exchanging the arguments and inverting the direction +-- of the comparison. This results in the sequence of: +-- +-- ucomiss %xmm1,%xmm2 +-- ja _c2g2 +-- jmp _c2g1 +-- +-- Removing the jump reduces the pressure on the branch prediction system +-- and plays better with the uOP cache. + +condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register +condFltReg is32Bit cond x y = condFltReg_sse2 + where + + + condFltReg_sse2 = do + CondCode _ cond cond_code <- condFltCode cond x y + tmp1 <- getNewRegNat (archWordFormat is32Bit) + tmp2 <- getNewRegNat (archWordFormat is32Bit) + let -- See Note [SSE Parity Checks] + code dst = + cond_code `appOL` + (case cond of + NE -> or_unordered dst + GU -> plain_test dst + GEU -> plain_test dst + -- Use ASSERT so we don't break releases if these creep in. + LTT -> assertPpr False (text "Should have been turned into >") $ + and_ordered dst + LE -> assertPpr False (text "Should have been turned into >=") $ + and_ordered dst + _ -> and_ordered dst) + + plain_test dst = toOL [ + SETCC cond (OpReg tmp1), + MOVZxL II8 (OpReg tmp1) (OpReg dst) + ] + or_unordered dst = toOL [ + SETCC cond (OpReg tmp1), + SETCC PARITY (OpReg tmp2), + OR II8 (OpReg tmp1) (OpReg tmp2), + MOVZxL II8 (OpReg tmp2) (OpReg dst) + ] + and_ordered dst = toOL [ + SETCC cond (OpReg tmp1), + SETCC NOTPARITY (OpReg tmp2), + AND II8 (OpReg tmp1) (OpReg tmp2), + MOVZxL II8 (OpReg tmp2) (OpReg dst) + ] + return (Any II32 code) + + +-- ----------------------------------------------------------------------------- +-- 'trivial*Code': deal with trivial instructions + +-- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode', +-- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions. +-- Only look for constants on the right hand side, because that's +-- where the generic optimizer will have put them. + +-- Similarly, for unary instructions, we don't have to worry about +-- matching an StInt as the argument, because genericOpt will already +-- have handled the constant-folding. + + +{- +The Rules of the Game are: + +* You cannot assume anything about the destination register dst; + it may be anything, including a fixed reg. + +* You may compute an operand into a fixed reg, but you may not + subsequently change the contents of that fixed reg. If you + want to do so, first copy the value either to a temporary + or into dst. You are free to modify dst even if it happens + to be a fixed reg -- that's not your problem. + +* You cannot assume that a fixed reg will stay live over an + arbitrary computation. The same applies to the dst reg. + +* Temporary regs obtained from getNewRegNat are distinct from + each other and from all other regs, and stay live over + arbitrary computations. + +-------------------- + +SDM's version of The Rules: + +* If getRegister returns Any, that means it can generate correct + code which places the result in any register, period. Even if that + register happens to be read during the computation. + + Corollary #1: this means that if you are generating code for an + operation with two arbitrary operands, you cannot assign the result + of the first operand into the destination register before computing + the second operand. The second operand might require the old value + of the destination register. + + Corollary #2: A function might be able to generate more efficient + code if it knows the destination register is a new temporary (and + therefore not read by any of the sub-computations). + +* If getRegister returns Any, then the code it generates may modify only: + (a) fresh temporaries + (b) the destination register + (c) known registers (eg. %ecx is used by shifts) + In particular, it may *not* modify global registers, unless the global + register happens to be the destination register. +-} + +trivialCode :: Width -> (Operand -> Operand -> Instr) + -> Maybe (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialCode width instr m a b + = do platform <- getPlatform + trivialCode' platform width instr m a b + +trivialCode' :: Platform -> Width -> (Operand -> Operand -> Instr) + -> Maybe (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialCode' platform width _ (Just revinstr) (CmmLit lit_a) b + | is32BitLit platform lit_a = do + b_code <- getAnyReg b + let + code dst + = b_code dst `snocOL` + revinstr (OpImm (litToImm lit_a)) (OpReg dst) + return (Any (intFormat width) code) + +trivialCode' _ width instr _ a b + = genTrivialCode (intFormat width) (\op2 -> instr op2 . OpReg) a b + +-- This is re-used for floating pt instructions too. +genTrivialCode :: Format -> (Operand -> Reg -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +genTrivialCode rep instr a b = do + (b_op, b_code) <- getNonClobberedOperand b + a_code <- getAnyReg a + tmp <- getNewRegNat rep + let + -- We want the value of 'b' to stay alive across the computation of 'a'. + -- But, we want to calculate 'a' straight into the destination register, + -- because the instruction only has two operands (dst := dst `op` src). + -- The troublesome case is when the result of 'b' is in the same register + -- as the destination 'reg'. In this case, we have to save 'b' in a + -- new temporary across the computation of 'a'. + code dst + | dst `regClashesWithOp` b_op = + b_code `appOL` + unitOL (MOV rep b_op (OpReg tmp)) `appOL` + a_code dst `snocOL` + instr (OpReg tmp) dst + | otherwise = + b_code `appOL` + a_code dst `snocOL` + instr b_op dst + return (Any rep code) + +regClashesWithOp :: Reg -> Operand -> Bool +reg `regClashesWithOp` OpReg reg2 = reg == reg2 +reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode) +_ `regClashesWithOp` _ = False + +-- | Generate code for a fused multiply-add operation, of the form @± x * y ± z@, +-- with 3 operands (FMA3 instruction set). +genFMA3Code :: Length + -> Width + -> FMASign + -> CmmExpr -> CmmExpr -> CmmExpr -> NatM Register +genFMA3Code l w signs x y z = do + config <- getConfig + -- For the FMA instruction, we want to compute x * y + z + -- + -- There are three possible instructions we could emit: + -- + -- - fmadd213 z y x, result in x, z can be a memory address + -- - fmadd132 x z y, result in y, x can be a memory address + -- - fmadd231 y x z, result in z, y can be a memory address + -- + -- This suggests two possible optimisations: + -- + -- - OPTIMISATION 1 + -- If one argument is an address, use the instruction that allows + -- a memory address in that position. + -- + -- - OPTIMISATION 2 + -- If one argument is in a fixed register, use the instruction that puts + -- the result in that same register. + -- + -- Currently we follow neither of these optimisations, + -- opting to always use fmadd213 for simplicity. + -- + -- We would like to compute the result directly into the requested register. + -- To do so we must first compute `x` into the destination register. This is + -- only possible if the other arguments don't use the destination register. + -- We check for this and if there is a conflict we move the result only after + -- the computation. See #24496 how this went wrong in the past. + let rep + | l == 1 + = floatFormat w + | otherwise + = vecFormat (cmmVec l $ cmmFloat w) + (y_reg, y_code) <- getNonClobberedReg y + (z_op, z_code) <- getNonClobberedOperand z + x_code <- getAnyReg x + x_tmp <- getNewRegNat rep + let + fma213 = FMA3 rep signs FMA213 + + code, code_direct, code_mov :: Reg -> InstrBlock + -- Ideal: Compute the result directly into dst + code_direct dst = x_code dst `snocOL` + fma213 z_op y_reg dst + -- Fallback: Compute the result into a tmp reg and then move it. + code_mov dst = x_code x_tmp `snocOL` + fma213 z_op y_reg x_tmp `snocOL` + mkRegRegMoveInstr config rep x_tmp dst + + code dst = + y_code `appOL` + z_code `appOL` + ( if arg_regs_conflict then code_mov dst else code_direct dst ) + + where + + arg_regs_conflict = + y_reg == dst || + case z_op of + OpReg z_reg -> z_reg == dst + OpAddr amode -> dst `elem` addrModeRegs amode + OpImm {} -> False + + -- NB: Computing the result into a desired register using Any can be tricky. + -- So for now, we keep it simple. (See #24496). + return (Any rep code) + +----------- + +trivialUCode :: Format -> (Operand -> Instr) + -> CmmExpr -> NatM Register +trivialUCode rep instr x = do + x_code <- getAnyReg x + let + code dst = + x_code dst `snocOL` + instr (OpReg dst) + return (Any rep code) + +----------- + + +trivialFCode_sse2 :: Width -> (Format -> Operand -> Reg -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialFCode_sse2 ty instr x y + = genTrivialCode format (instr format) x y + where format = floatFormat ty + + +-------------------------------------------------------------------------------- +coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register +coerceInt2FP from to x = coerce_sse2 + where + + coerce_sse2 = do + (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand + let + opc = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD + n -> panic $ "coerceInt2FP.sse: unhandled width (" + ++ show n ++ ")" + code dst = x_code `snocOL` opc (intFormat from) x_op dst + return (Any (floatFormat to) code) + -- works even if the destination rep is Width -> CmmExpr -> NatM Register +coerceFP2Int from to x = coerceFP2Int_sse2 + where + coerceFP2Int_sse2 = do + (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand + let + opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ; + n -> panic $ "coerceFP2Init.sse: unhandled width (" + ++ show n ++ ")" + code dst = x_code `snocOL` opc (intFormat to) x_op dst + return (Any (intFormat to) code) + -- works even if the destination rep is CmmExpr -> NatM Register +coerceFP2FP to x = do + (x_reg, x_code) <- getSomeReg x + let + opc = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD; + n -> panic $ "coerceFP2FP: unhandled width (" + ++ show n ++ ")" + code dst = x_code `snocOL` opc x_reg dst + return (Any ( floatFormat to) code) + +-------------------------------------------------------------------------------- + +sse2NegCode :: Width -> CmmExpr -> NatM Register +sse2NegCode w x = do + let fmt = floatFormat w + x_code <- getAnyReg x + -- This is how gcc does it, so it can't be that bad: + let + const = case fmt of + FF32 -> CmmInt 0x80000000 W32 + FF64 -> CmmInt 0x8000000000000000 W64 + x@II8 -> wrongFmt x + x@II16 -> wrongFmt x + x@II32 -> wrongFmt x + x@II64 -> wrongFmt x + x@(VecFormat {}) -> wrongFmt x + + where + wrongFmt x = panic $ "sse2NegCode: " ++ show x + Amode amode amode_code <- memConstant (mkAlignment $ widthInBytes w) const + tmp <- getNewRegNat fmt + let + code dst = x_code dst `appOL` amode_code `appOL` toOL [ + MOV fmt (OpAddr amode) (OpReg tmp), + XOR fmt (OpReg tmp) (OpReg dst) + ] + -- + return (Any fmt code) + +needLlvm :: MachOp -> NatM a +needLlvm mop = + sorry $ unlines [ "Unsupported vector instruction for the native code generator:" + , show mop + , "Please use -fllvm." ] + +incorrectOperands :: NatM a +incorrectOperands = sorry "Incorrect number of operands" + +invalidConversion :: Width -> Width -> NatM a +invalidConversion from to = + sorry $ "Invalid conversion operation from " ++ show from ++ " to " ++ show to + +-- | This works on the invariant that all jumps in the given blocks are required. +-- Starting from there we try to make a few more jumps redundant by reordering +-- them. +-- We depend on the information in the CFG to do so so without a given CFG +-- we do nothing. +invertCondBranches :: Maybe CFG -- ^ CFG if present + -> LabelMap a -- ^ Blocks with info tables + -> [NatBasicBlock Instr] -- ^ List of basic blocks + -> [NatBasicBlock Instr] +invertCondBranches Nothing _ bs = bs +invertCondBranches (Just cfg) keep bs = + invert bs + where + invert :: [NatBasicBlock Instr] -> [NatBasicBlock Instr] + invert (BasicBlock lbl1 ins:b2@(BasicBlock lbl2 _):bs) + | --pprTrace "Block" (ppr lbl1) True, + Just (jmp1,jmp2) <- last2 ins + , JXX cond1 target1 <- jmp1 + , target1 == lbl2 + --, pprTrace "CutChance" (ppr b1) True + , JXX ALWAYS target2 <- jmp2 + -- We have enough information to check if we can perform the inversion + -- TODO: We could also check for the last asm instruction which sets + -- status flags instead. Which I suspect is worse in terms of compiler + -- performance, but might be applicable to more cases + , Just edgeInfo1 <- getEdgeInfo lbl1 target1 cfg + , Just edgeInfo2 <- getEdgeInfo lbl1 target2 cfg + -- Both jumps come from the same cmm statement + , transitionSource edgeInfo1 == transitionSource edgeInfo2 + , CmmSource {trans_cmmNode = cmmCondBranch} <- transitionSource edgeInfo1 + + --Int comparisons are invertable + , CmmCondBranch (CmmMachOp op _args) _ _ _ <- cmmCondBranch + , Just _ <- maybeIntComparison op + , Just invCond <- maybeInvertCond cond1 + + --Swap the last two jumps, invert the conditional jumps condition. + = let jumps = + case () of + -- We are free the eliminate the jmp. So we do so. + _ | not (mapMember target1 keep) + -> [JXX invCond target2] + -- If the conditional target is unlikely we put the other + -- target at the front. + | edgeWeight edgeInfo2 > edgeWeight edgeInfo1 + -> [JXX invCond target2, JXX ALWAYS target1] + -- Keep things as-is otherwise + | otherwise + -> [jmp1, jmp2] + in --pprTrace "Cutable" (ppr [jmp1,jmp2] <+> text "=>" <+> ppr jumps) $ + (BasicBlock lbl1 + (dropTail 2 ins ++ jumps)) + : invert (b2:bs) + invert (b:bs) = b : invert bs + invert [] = [] + +genAtomicRMW + :: BlockId + -> Width + -> AtomicMachOp + -> LocalReg + -> CmmExpr + -> CmmExpr + -> NatM (InstrBlock, Maybe BlockId) +genAtomicRMW bid width amop dst addr n = do + Amode amode addr_code <- + if amop `elem` [AMO_Add, AMO_Sub] + then getAmode addr + else getSimpleAmode addr -- See genForeignCall for MO_Cmpxchg + arg <- getNewRegNat format + arg_code <- getAnyReg n + platform <- ncgPlatform <$> getConfig + + let dst_r = getRegisterReg platform (CmmLocal dst) + (code, lbl) <- op_code dst_r arg amode + return (addr_code `appOL` arg_code arg `appOL` code, Just lbl) + where + -- Code for the operation + op_code :: Reg -- Destination reg + -> Reg -- Register containing argument + -> AddrMode -- Address of location to mutate + -> NatM (OrdList Instr,BlockId) -- TODO: Return Maybe BlockId + op_code dst_r arg amode = do + case amop of + -- In the common case where dst_r is a virtual register the + -- final move should go away, because it's the last use of arg + -- and the first use of dst_r. + AMO_Add -> return $ (toOL [ LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) + ], bid) + AMO_Sub -> return $ (toOL [ NEGI format (OpReg arg) + , LOCK (XADD format (OpReg arg) (OpAddr amode)) + , MOV format (OpReg arg) (OpReg dst_r) + ], bid) + -- In these cases we need a new block id, and have to return it so + -- that later instruction selection can reference it. + AMO_And -> cmpxchg_code (\ src dst -> unitOL $ AND format src dst) + AMO_Nand -> cmpxchg_code (\ src dst -> toOL [ AND format src dst + , NOT format dst + ]) + AMO_Or -> cmpxchg_code (\ src dst -> unitOL $ OR format src dst) + AMO_Xor -> cmpxchg_code (\ src dst -> unitOL $ XOR format src dst) + where + -- Simulate operation that lacks a dedicated instruction using + -- cmpxchg. + cmpxchg_code :: (Operand -> Operand -> OrdList Instr) + -> NatM (OrdList Instr, BlockId) + cmpxchg_code instrs = do + lbl1 <- getBlockIdNat + lbl2 <- getBlockIdNat + tmp <- getNewRegNat format + + --Record inserted blocks + -- We turn A -> B into A -> A' -> A'' -> B + -- with a self loop on A'. + addImmediateSuccessorNat bid lbl1 + addImmediateSuccessorNat lbl1 lbl2 + updateCfgNat (addWeightEdge lbl1 lbl1 0) + + return $ (toOL + [ MOV format (OpAddr amode) (OpReg eax) + , JXX ALWAYS lbl1 + , NEWBLOCK lbl1 + -- Keep old value so we can return it: + , MOV format (OpReg eax) (OpReg dst_r) + , MOV format (OpReg eax) (OpReg tmp) + ] + `appOL` instrs (OpReg arg) (OpReg tmp) `appOL` toOL + [ LOCK (CMPXCHG format (OpReg tmp) (OpAddr amode)) + , JXX NE lbl1 + -- See Note [Introducing cfg edges inside basic blocks] + -- why this basic block is required. + , JXX ALWAYS lbl2 + , NEWBLOCK lbl2 + ], + lbl2) + format = intFormat width + +-- | Count trailing zeroes +genCtz :: BlockId -> Width -> LocalReg -> CmmExpr -> NatM (InstrBlock, Maybe BlockId) +genCtz bid width dst src = do + is32Bit <- is32BitPlatform + if is32Bit && width == W64 + then genCtz64_32 bid dst src + else (,Nothing) <$> genCtzGeneric width dst src + +-- | Count trailing zeroes +-- +-- 64-bit width on 32-bit architecture +genCtz64_32 + :: BlockId + -> LocalReg + -> CmmExpr + -> NatM (InstrBlock, Maybe BlockId) +genCtz64_32 bid dst src = do + RegCode64 vcode rhi rlo <- iselExpr64 src + let dst_r = getLocalRegReg dst + lbl1 <- getBlockIdNat + lbl2 <- getBlockIdNat + tmp_r <- getNewRegNat II64 + + -- New CFG Edges: + -- bid -> lbl2 + -- bid -> lbl1 -> lbl2 + -- We also changes edges originating at bid to start at lbl2 instead. + weights <- getCfgWeights + updateCfgNat (addWeightEdge bid lbl1 110 . + addWeightEdge lbl1 lbl2 110 . + addImmediateSuccessor weights bid lbl2) + + -- The following instruction sequence corresponds to the pseudo-code + -- + -- if (src) { + -- dst = src.lo32 ? BSF(src.lo32) : (BSF(src.hi32) + 32); + -- } else { + -- dst = 64; + -- } + let instrs = vcode `appOL` toOL + ([ MOV II32 (OpReg rhi) (OpReg tmp_r) + , OR II32 (OpReg rlo) (OpReg tmp_r) + , MOV II32 (OpImm (ImmInt 64)) (OpReg dst_r) + , JXX EQQ lbl2 + , JXX ALWAYS lbl1 + + , NEWBLOCK lbl1 + , BSF II32 (OpReg rhi) dst_r + , ADD II32 (OpImm (ImmInt 32)) (OpReg dst_r) + , BSF II32 (OpReg rlo) tmp_r + , CMOV NE II32 (OpReg tmp_r) dst_r + , JXX ALWAYS lbl2 + + , NEWBLOCK lbl2 + ]) + return (instrs, Just lbl2) + +-- | Count trailing zeroes +-- +-- Generic case (width <= word size) +genCtzGeneric :: Width -> LocalReg -> CmmExpr -> NatM InstrBlock +genCtzGeneric width dst src = do + code_src <- getAnyReg src + config <- getConfig + let bw = widthInBits width + let dst_r = getLocalRegReg dst + if ncgBmiVersion config >= Just BMI2 + then do + src_r <- getNewRegNat (intFormat width) + let instrs = appOL (code_src src_r) $ case width of + W8 -> toOL + [ OR II32 (OpImm (ImmInteger 0xFFFFFF00)) (OpReg src_r) + , TZCNT II32 (OpReg src_r) dst_r + ] + W16 -> toOL + [ TZCNT II16 (OpReg src_r) dst_r + , MOVZxL II16 (OpReg dst_r) (OpReg dst_r) + ] + _ -> unitOL $ TZCNT (intFormat width) (OpReg src_r) dst_r + return instrs + else do + -- The following insn sequence makes sure 'ctz 0' has a defined value. + -- starting with Haswell, one could use the TZCNT insn instead. + let format = if width == W8 then II16 else intFormat width + src_r <- getNewRegNat format + tmp_r <- getNewRegNat format + let instrs = code_src src_r `appOL` toOL + ([ MOVZxL II8 (OpReg src_r) (OpReg src_r) | width == W8 ] ++ + [ BSF format (OpReg src_r) tmp_r + , MOV II32 (OpImm (ImmInt bw)) (OpReg dst_r) + , CMOV NE format (OpReg tmp_r) dst_r + ]) -- NB: We don't need to zero-extend the result for the + -- W8/W16 cases because the 'MOV' insn already + -- took care of implicitly clearing the upper bits + return instrs + + + +-- | Copy memory +-- +-- Unroll memcpy calls if the number of bytes to copy isn't too large (cf +-- ncgInlineThresholdMemcpy). Otherwise, call C's memcpy. +genMemCpy + :: BlockId + -> Int + -> CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM InstrBlock +genMemCpy bid align dst src arg_n = do + + let libc_memcpy = genLibCCall bid (fsLit "memcpy") [] [dst,src,arg_n] + + case arg_n of + CmmLit (CmmInt n _) -> do + -- try to inline it + mcode <- genMemCpyInlineMaybe align dst src n + -- if it didn't inline, call the C function + case mcode of + Nothing -> libc_memcpy + Just c -> pure c + + -- not a literal size argument: call the C function + _ -> libc_memcpy + + + +genMemCpyInlineMaybe + :: Int + -> CmmExpr + -> CmmExpr + -> Integer + -> NatM (Maybe InstrBlock) +genMemCpyInlineMaybe align dst src n = do + config <- getConfig + let + platform = ncgPlatform config + maxAlignment = wordAlignment platform + -- only machine word wide MOVs are supported + effectiveAlignment = min (alignmentOf align) maxAlignment + format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment + + + -- The size of each move, in bytes. + let sizeBytes :: Integer + sizeBytes = fromIntegral (formatInBytes format) + + -- The number of instructions we will generate (approx). We need 2 + -- instructions per move. + let insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes) + + go :: Reg -> Reg -> Reg -> Integer -> OrdList Instr + go dst src tmp i + | i >= sizeBytes = + unitOL (MOV format (OpAddr src_addr) (OpReg tmp)) `appOL` + unitOL (MOV format (OpReg tmp) (OpAddr dst_addr)) `appOL` + go dst src tmp (i - sizeBytes) + -- Deal with remaining bytes. + | i >= 4 = -- Will never happen on 32-bit + unitOL (MOV II32 (OpAddr src_addr) (OpReg tmp)) `appOL` + unitOL (MOV II32 (OpReg tmp) (OpAddr dst_addr)) `appOL` + go dst src tmp (i - 4) + | i >= 2 = + unitOL (MOVZxL II16 (OpAddr src_addr) (OpReg tmp)) `appOL` + unitOL (MOV II16 (OpReg tmp) (OpAddr dst_addr)) `appOL` + go dst src tmp (i - 2) + | i >= 1 = + unitOL (MOVZxL II8 (OpAddr src_addr) (OpReg tmp)) `appOL` + unitOL (MOV II8 (OpReg tmp) (OpAddr dst_addr)) `appOL` + go dst src tmp (i - 1) + | otherwise = nilOL + where + src_addr = AddrBaseIndex (EABaseReg src) EAIndexNone + (ImmInteger (n - i)) + + dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone + (ImmInteger (n - i)) + + if insns > fromIntegral (ncgInlineThresholdMemcpy config) + then pure Nothing + else do + code_dst <- getAnyReg dst + dst_r <- getNewRegNat format + code_src <- getAnyReg src + src_r <- getNewRegNat format + tmp_r <- getNewRegNat format + pure $ Just $ code_dst dst_r `appOL` code_src src_r `appOL` + go dst_r src_r tmp_r (fromInteger n) + +-- | Set memory to the given byte +-- +-- Unroll memset calls if the number of bytes to copy isn't too large (cf +-- ncgInlineThresholdMemset). Otherwise, call C's memset. +genMemSet + :: BlockId + -> Int + -> CmmExpr + -> CmmExpr + -> CmmExpr + -> NatM InstrBlock +genMemSet bid align dst arg_c arg_n = do + + let libc_memset = genLibCCall bid (fsLit "memset") [] [dst,arg_c,arg_n] + + case (arg_c,arg_n) of + (CmmLit (CmmInt c _), CmmLit (CmmInt n _)) -> do + -- try to inline it + mcode <- genMemSetInlineMaybe align dst c n + -- if it didn't inline, call the C function + case mcode of + Nothing -> libc_memset + Just c -> pure c + + -- not literal size arguments: call the C function + _ -> libc_memset + +genMemSetInlineMaybe + :: Int + -> CmmExpr + -> Integer + -> Integer + -> NatM (Maybe InstrBlock) +genMemSetInlineMaybe align dst c n = do + config <- getConfig + let + platform = ncgPlatform config + maxAlignment = wordAlignment platform -- only machine word wide MOVs are supported + effectiveAlignment = min (alignmentOf align) maxAlignment + format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment + c2 = c `shiftL` 8 .|. c + c4 = c2 `shiftL` 16 .|. c2 + c8 = c4 `shiftL` 32 .|. c4 + + -- The number of instructions we will generate (approx). We need 1 + -- instructions per move. + insns = (n + sizeBytes - 1) `div` sizeBytes + + -- The size of each move, in bytes. + sizeBytes :: Integer + sizeBytes = fromIntegral (formatInBytes format) + + -- Depending on size returns the widest MOV instruction and its + -- width. + gen4 :: AddrMode -> Integer -> (InstrBlock, Integer) + gen4 addr size + | size >= 4 = + (unitOL (MOV II32 (OpImm (ImmInteger c4)) (OpAddr addr)), 4) + | size >= 2 = + (unitOL (MOV II16 (OpImm (ImmInteger c2)) (OpAddr addr)), 2) + | size >= 1 = + (unitOL (MOV II8 (OpImm (ImmInteger c)) (OpAddr addr)), 1) + | otherwise = (nilOL, 0) + + -- Generates a 64-bit wide MOV instruction from REG to MEM. + gen8 :: AddrMode -> Reg -> InstrBlock + gen8 addr reg8byte = + unitOL (MOV format (OpReg reg8byte) (OpAddr addr)) + + -- Unrolls memset when the widest MOV is <= 4 bytes. + go4 :: Reg -> Integer -> InstrBlock + go4 dst left = + if left <= 0 then nilOL + else curMov `appOL` go4 dst (left - curWidth) + where + possibleWidth = min left sizeBytes + dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone (ImmInteger (n - left)) + (curMov, curWidth) = gen4 dst_addr possibleWidth + + -- Unrolls memset when the widest MOV is 8 bytes (thus another Reg + -- argument). Falls back to go4 when all 8 byte moves are + -- exhausted. + go8 :: Reg -> Reg -> Integer -> InstrBlock + go8 dst reg8byte left = + if possibleWidth >= 8 then + let curMov = gen8 dst_addr reg8byte + in curMov `appOL` go8 dst reg8byte (left - 8) + else go4 dst left + where + possibleWidth = min left sizeBytes dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone (ImmInteger (n - left)) if fromInteger insns > ncgInlineThresholdMemset config diff --git a/GHC/CmmToAsm/X86/Instr.hs b/GHC/CmmToAsm/X86/Instr.hs --- a/GHC/CmmToAsm/X86/Instr.hs +++ b/GHC/CmmToAsm/X86/Instr.hs @@ -115,12 +115,9 @@ -- | X86 scalar move instruction. -- - -- The format is the format the destination is written to. For an XMM - -- register, using a scalar format means that we don't care about the - -- upper bits, while using a vector format means that we care about the - -- upper bits, even though we are only writing to the lower bits. - -- - -- See also Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear. + -- When used at a vector format, only moves the lower 64 bits of data; + -- the rest of the data in the destination may either be zeroed or + -- preserved, depending on the specific format and operands. | MOV Format Operand Operand -- N.B. Due to AT&T assembler quirks, when used with 'II64' -- 'Format' immediate source and memory target operand, the source @@ -224,7 +221,7 @@ -- are Operand Reg. -- SSE2 floating-point division: - | FDIV Format Operand Operand -- divisor, dividend(dst) + | FDIV Format Operand Reg -- divisor, dividend(dst) -- use CMP for comparisons. ucomiss and ucomisd instructions -- compare single/double prec floating point respectively. @@ -295,8 +292,12 @@ -- NOTE: Instructions follow the AT&T syntax -- Constructors and deconstructors | VBROADCAST Format Operand Reg + | VPBROADCAST Format Format Operand Reg -- scalar format, vector format, source, destination | VEXTRACT Format Imm Reg Operand | INSERTPS Format Imm Operand Reg + | VINSERTPS Format Imm Operand Reg Reg + | PINSR Format Format Imm Operand Reg -- scalar format, vector format, offset, scalar src, vector + | PEXTR Format Format Imm Reg Operand -- scalar format, vector format, offset, vector src, scalar dst -- move operations @@ -312,35 +313,73 @@ | MOVDQU Format Operand Operand -- | AVX unaligned move of integer vectors | VMOVDQU Format Operand Operand + -- | Alias for VMOVSS/VMOVSD, used to merge two vectors + | VMOV_MERGE Format Reg Reg Reg -- logic operations | PXOR Format Operand Reg | VPXOR Format Reg Reg Reg + | PAND Format Operand Reg + | PANDN Format Operand Reg + | POR Format Operand Reg -- Arithmetic | VADD Format Operand Reg Reg | VSUB Format Operand Reg Reg | VMUL Format Operand Reg Reg | VDIV Format Operand Reg Reg + | PADD Format Operand Reg + | PSUB Format Operand Reg + | PMULL Format Operand Reg + | PMULUDQ Format Operand Reg + -- SIMD compare + | PCMPGT Format Operand Reg + -- Shuffle | SHUF Format Imm Operand Reg | VSHUF Format Imm Operand Reg Reg + | PSHUFB Format Operand Reg + | PSHUFLW Format Imm Operand Reg + | PSHUFHW Format Imm Operand Reg | PSHUFD Format Imm Operand Reg | VPSHUFD Format Imm Operand Reg + | BLEND Format Imm Operand Reg + | VBLEND Format Imm Operand Reg Reg + | PBLENDW Format Imm Operand Reg -- | Move two 32-bit floats from the high part of an xmm register -- to the low part of another xmm register. + -- + -- If the format is a vector format, the destination register is treated as the second source. + -- If the format is FF32 or FF64, the destination register is not treated as a source. | MOVHLPS Format Reg Reg + | VMOVHLPS Format Reg Reg Reg + | MOVLHPS Format Reg Reg + | VMOVLHPS Format Reg Reg Reg | UNPCKL Format Operand Reg + | VUNPCKL Format Operand Reg Reg + | UNPCKH Format Operand Reg + | VUNPCKH Format Operand Reg Reg | PUNPCKLQDQ Format Operand Reg + | PUNPCKLDQ Format Operand Reg + | PUNPCKLWD Format Operand Reg + | PUNPCKLBW Format Operand Reg + | PUNPCKHQDQ Format Operand Reg + | PUNPCKHDQ Format Operand Reg + | PUNPCKHWD Format Operand Reg + | PUNPCKHBW Format Operand Reg + | PACKUSWB Format Operand Reg -- Shift - | PSLLDQ Format Operand Reg - | PSRLDQ Format Operand Reg + | PSLL Format Operand Reg + | PSLLDQ Format Imm Reg + | PSRL Format Operand Reg + | PSRLDQ Format Imm Reg + | PALIGNR Format Imm Operand Reg -- min/max - | MINMAX MinOrMax MinMaxType Format Operand Operand + | MINMAX MinOrMax MinMaxType Format Operand Reg | VMINMAX MinOrMax MinMaxType Format Operand Reg Reg data PrefetchVariant = NTA | Lvl0 | Lvl1 | Lvl2 @@ -367,27 +406,18 @@ regUsageOfInstr :: Platform -> Instr -> RegUsage regUsageOfInstr platform instr = case instr of - - -- Recall that MOV is always a scalar move instruction, but when the destination - -- is an XMM register, we make the distinction between: - -- - -- - a scalar format, meaning that from now on we no longer care about the top bits - -- of the register, and - -- - a vector format, meaning that we still care about what's in the high bits. - -- - -- See Note [Allocated register formats] in GHC.CmmToAsm.Reg.Linear. - MOV dst_fmt src dst + MOV fmt src dst -- MOVSS/MOVSD preserve the upper half of vector registers, -- but only for reg-2-reg moves - | VecFormat _ sFmt <- dst_fmt + | VecFormat _ sFmt <- fmt , isFloatScalarFormat sFmt , OpReg {} <- src , OpReg {} <- dst - -> usageRM dst_fmt src dst + -> usageRM fmt src dst -- other MOV instructions zero any remaining upper part of the destination -- (largely to avoid partial register stalls) | otherwise - -> usageRW dst_fmt src dst + -> usageRW fmt src dst MOVD fmt1 fmt2 src dst -> -- NB: MOVD and MOVQ always zero any remaining upper part of destination, -- so the destination is "written" not "modified". @@ -403,7 +433,7 @@ IMUL fmt src dst -> usageRM fmt src dst -- Result of IMULB will be in just in %ax - IMUL2 II8 src -> mkRU (mk II8 eax:use_R II8 src []) [mk II16 eax] + IMUL2 II8 src -> mkRU (mk II8 eax:use_R II8 src []) [mk II8 eax] -- Result of IMUL for wider values, will be split between %dx/%edx/%rdx and -- %ax/%eax/%rax. IMUL2 fmt src -> mkRU (mk fmt eax:use_R fmt src []) [mk fmt eax,mk fmt edx] @@ -460,7 +490,7 @@ CVTTSD2SIQ fmt src dst -> mkRU (use_R FF64 src []) [mk fmt dst] CVTSI2SS fmt src dst -> mkRU (use_R fmt src []) [mk FF32 dst] CVTSI2SD fmt src dst -> mkRU (use_R fmt src []) [mk FF64 dst] - FDIV fmt src dst -> usageRM fmt src dst + FDIV fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] SQRT fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst] FETCHGOT reg -> mkRU [] [mk addrFmt reg] @@ -492,6 +522,7 @@ -- vector instructions VBROADCAST fmt src dst -> mkRU (use_R fmt src []) [mk fmt dst] + VPBROADCAST sFmt vFmt src dst -> mkRU (use_R sFmt src []) [mk vFmt dst] VEXTRACT fmt _off src dst -> usageRW fmt (OpReg src) dst INSERTPS fmt (ImmInt off) src dst -> mkRU ((use_R fmt src []) ++ [mk fmt dst | not doesNotReadDst]) [mk fmt dst] @@ -504,6 +535,12 @@ where pos = ( off `shiftR` 4 ) .&. 0b11 INSERTPS fmt _off src dst -> mkRU ((use_R fmt src []) ++ [mk fmt dst]) [mk fmt dst] + VINSERTPS fmt _imm src2 src1 dst + -> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst] + PINSR sFmt vFmt _off src dst + -> mkRU (use_R sFmt src [mk vFmt dst]) [mk vFmt dst] + PEXTR sFmt vFmt _off src dst + -> usageRW' vFmt sFmt (OpReg src) dst VMOVU fmt src dst -> usageRW fmt src dst MOVU fmt src dst -> usageRW fmt src dst @@ -511,6 +548,7 @@ MOVH fmt src dst -> usageRM fmt src dst MOVDQU fmt src dst -> usageRW fmt src dst VMOVDQU fmt src dst -> usageRW fmt src dst + VMOV_MERGE fmt src2 src1 dst -> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst] PXOR fmt (OpReg src) dst | src == dst @@ -524,31 +562,93 @@ | otherwise -> mkRU [mk fmt s1, mk fmt s2] [mk fmt dst] + PAND fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PANDN fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + POR fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VADD fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] VSUB fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] VMUL fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] VDIV fmt s1 s2 dst -> mkRU ((use_R fmt s1 []) ++ [mk fmt s2]) [mk fmt dst] + PADD fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PSUB fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PMULL fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PMULUDQ fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PCMPGT fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + SHUF fmt _mask src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] VSHUF fmt _mask src1 src2 dst -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst] + PSHUFB fmt mask dst + -> mkRU (use_R fmt mask [mk fmt dst]) [mk fmt dst] + PSHUFLW fmt _mask src dst + -> mkRU (use_R fmt src []) [mk fmt dst] + PSHUFHW fmt _mask src dst + -> mkRU (use_R fmt src []) [mk fmt dst] PSHUFD fmt _mask src dst -> mkRU (use_R fmt src []) [mk fmt dst] VPSHUFD fmt _mask src dst -> mkRU (use_R fmt src []) [mk fmt dst] + BLEND fmt _mask src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VBLEND fmt _mask src2 src1 dst + -> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst] + PBLENDW fmt _mask src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] - PSLLDQ fmt off dst -> mkRU (use_R fmt off []) [mk fmt dst] + PSLL fmt off dst -> mkRU (use_R fmt off [mk fmt dst]) [mk fmt dst] + PSLLDQ fmt _off dst -> mkRU [mk fmt dst] [mk fmt dst] + PSRL fmt off dst -> mkRU (use_R fmt off [mk fmt dst]) [mk fmt dst] + PSRLDQ fmt _off dst -> mkRU [mk fmt dst] [mk fmt dst] + PALIGNR fmt _off src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] MOVHLPS fmt src dst - -> mkRU [mk fmt src] [mk fmt dst] + -> case fmt of + VecFormat {} -> mkRU [mk fmt src, mk fmt dst] [mk fmt dst] + -- MOVHLPS moves the high 64 bits of src to the low 64 bits of dst, + -- keeping the high 64 bits of dst intact. + -- If we only care about the lower 64 bits of the result, + -- dst is only written to, not read. + FF64 -> mkRU [mk (VecFormat 2 FmtDouble) src] [mk fmt dst] + FF32 -> mkRU [mk (VecFormat 4 FmtFloat) src] [mk fmt dst] + _ -> pprPanic "regUsage: invalid format for MOVHLPS" (ppr fmt) + VMOVHLPS fmt src2 src1 dst + -> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst] + MOVLHPS fmt src dst + -> mkRU [mk fmt src, mk fmt dst] [mk fmt dst] + VMOVLHPS fmt src2 src1 dst + -> mkRU [mk fmt src1, mk fmt src2] [mk fmt dst] UNPCKL fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VUNPCKL fmt src2 src1 dst + -> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst] + UNPCKH fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VUNPCKH fmt src2 src1 dst + -> mkRU (use_R fmt src2 [mk fmt src1]) [mk fmt dst] PUNPCKLQDQ fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKLDQ fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKLWD fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKLBW fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKHQDQ fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKHDQ fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKHWD fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PUNPCKHBW fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + PACKUSWB fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] MINMAX _ _ fmt src dst - -> usageRM fmt src dst + -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] VMINMAX _ _ fmt src1 src2 dst -> mkRU (use_R fmt src1 [mk fmt src2]) [mk fmt dst] _other -> panic "regUsage: unrecognised instr" @@ -708,7 +808,7 @@ CVTTSD2SIQ fmt src dst -> CVTTSD2SIQ fmt (patchOp src) (env dst) CVTSI2SS fmt src dst -> CVTSI2SS fmt (patchOp src) (env dst) CVTSI2SD fmt src dst -> CVTSI2SD fmt (patchOp src) (env dst) - FDIV fmt src dst -> FDIV fmt (patchOp src) (patchOp dst) + FDIV fmt src dst -> FDIV fmt (patchOp src) (env dst) SQRT fmt src dst -> SQRT fmt (patchOp src) (env dst) CALL (Left _) _ -> instr @@ -747,10 +847,18 @@ -- vector instructions VBROADCAST fmt src dst -> VBROADCAST fmt (patchOp src) (env dst) + VPBROADCAST fmt1 fmt2 src dst + -> VPBROADCAST fmt1 fmt2 (patchOp src) (env dst) VEXTRACT fmt off src dst -> VEXTRACT fmt off (env src) (patchOp dst) INSERTPS fmt off src dst -> INSERTPS fmt off (patchOp src) (env dst) + VINSERTPS fmt off src2 src1 dst + -> VINSERTPS fmt off (patchOp src2) (env src1) (env dst) + PINSR fmt1 fmt2 off src dst + -> PINSR fmt1 fmt2 off (patchOp src) (env dst) + PEXTR fmt1 fmt2 off src dst + -> PEXTR fmt1 fmt2 off (env src) (patchOp dst) VMOVU fmt src dst -> VMOVU fmt (patchOp src) (patchOp dst) MOVU fmt src dst -> MOVU fmt (patchOp src) (patchOp dst) @@ -758,38 +866,94 @@ MOVH fmt src dst -> MOVH fmt (patchOp src) (patchOp dst) MOVDQU fmt src dst -> MOVDQU fmt (patchOp src) (patchOp dst) VMOVDQU fmt src dst -> VMOVDQU fmt (patchOp src) (patchOp dst) + VMOV_MERGE fmt src2 src1 dst -> VMOV_MERGE fmt (env src2) (env src1) (env dst) PXOR fmt src dst -> PXOR fmt (patchOp src) (env dst) VPXOR fmt s1 s2 dst -> VPXOR fmt (env s1) (env s2) (env dst) + PAND fmt src dst -> PAND fmt (patchOp src) (env dst) + PANDN fmt src dst -> PANDN fmt (patchOp src) (env dst) + POR fmt src dst -> POR fmt (patchOp src) (env dst) VADD fmt s1 s2 dst -> VADD fmt (patchOp s1) (env s2) (env dst) VSUB fmt s1 s2 dst -> VSUB fmt (patchOp s1) (env s2) (env dst) VMUL fmt s1 s2 dst -> VMUL fmt (patchOp s1) (env s2) (env dst) VDIV fmt s1 s2 dst -> VDIV fmt (patchOp s1) (env s2) (env dst) + PADD fmt src dst -> PADD fmt (patchOp src) (env dst) + PSUB fmt src dst -> PSUB fmt (patchOp src) (env dst) + PMULL fmt src dst -> PMULL fmt (patchOp src) (env dst) + PMULUDQ fmt src dst -> PMULUDQ fmt (patchOp src) (env dst) + PCMPGT fmt src dst -> PCMPGT fmt (patchOp src) (env dst) + SHUF fmt off src dst -> SHUF fmt off (patchOp src) (env dst) VSHUF fmt off src1 src2 dst -> VSHUF fmt off (patchOp src1) (env src2) (env dst) + PSHUFB fmt mask dst + -> PSHUFB fmt (patchOp mask) (env dst) + PSHUFLW fmt off src dst + -> PSHUFLW fmt off (patchOp src) (env dst) + PSHUFHW fmt off src dst + -> PSHUFHW fmt off (patchOp src) (env dst) PSHUFD fmt off src dst -> PSHUFD fmt off (patchOp src) (env dst) VPSHUFD fmt off src dst -> VPSHUFD fmt off (patchOp src) (env dst) + BLEND fmt mask src dst + -> BLEND fmt mask (patchOp src) (env dst) + VBLEND fmt mask src2 src1 dst + -> VBLEND fmt mask (patchOp src2) (env src1) (env dst) + PBLENDW fmt mask src dst + -> PBLENDW fmt mask (patchOp src) (env dst) + PSLL fmt off dst + -> PSLL fmt (patchOp off) (env dst) PSLLDQ fmt off dst - -> PSLLDQ fmt (patchOp off) (env dst) + -> PSLLDQ fmt off (env dst) + PSRL fmt off dst + -> PSRL fmt (patchOp off) (env dst) PSRLDQ fmt off dst - -> PSRLDQ fmt (patchOp off) (env dst) + -> PSRLDQ fmt off (env dst) + PALIGNR fmt off src dst + -> PALIGNR fmt off (patchOp src) (env dst) MOVHLPS fmt src dst -> MOVHLPS fmt (env src) (env dst) + VMOVHLPS fmt src2 src1 dst + -> VMOVHLPS fmt (env src2) (env src1) (env dst) + MOVLHPS fmt src dst + -> MOVLHPS fmt (env src) (env dst) + VMOVLHPS fmt src2 src1 dst + -> VMOVLHPS fmt (env src2) (env src1) (env dst) UNPCKL fmt src dst -> UNPCKL fmt (patchOp src) (env dst) + VUNPCKL fmt src2 src1 dst + -> VUNPCKL fmt (patchOp src2) (env src1) (env dst) + UNPCKH fmt src dst + -> UNPCKH fmt (patchOp src) (env dst) + VUNPCKH fmt src2 src1 dst + -> VUNPCKH fmt (patchOp src2) (env src1) (env dst) PUNPCKLQDQ fmt src dst -> PUNPCKLQDQ fmt (patchOp src) (env dst) + PUNPCKLDQ fmt src dst + -> PUNPCKLDQ fmt (patchOp src) (env dst) + PUNPCKLWD fmt src dst + -> PUNPCKLWD fmt (patchOp src) (env dst) + PUNPCKLBW fmt src dst + -> PUNPCKLBW fmt (patchOp src) (env dst) + PUNPCKHQDQ fmt src dst + -> PUNPCKHQDQ fmt (patchOp src) (env dst) + PUNPCKHDQ fmt src dst + -> PUNPCKHDQ fmt (patchOp src) (env dst) + PUNPCKHWD fmt src dst + -> PUNPCKHWD fmt (patchOp src) (env dst) + PUNPCKHBW fmt src dst + -> PUNPCKHBW fmt (patchOp src) (env dst) + PACKUSWB fmt src dst + -> PACKUSWB fmt (patchOp src) (env dst) MINMAX minMax ty fmt src dst - -> MINMAX minMax ty fmt (patchOp src) (patchOp dst) + -> MINMAX minMax ty fmt (patchOp src) (env dst) VMINMAX minMax ty fmt src1 src2 dst -> VMINMAX minMax ty fmt (patchOp src1) (env src2) (env dst) diff --git a/GHC/CmmToAsm/X86/Ppr.hs b/GHC/CmmToAsm/X86/Ppr.hs --- a/GHC/CmmToAsm/X86/Ppr.hs +++ b/GHC/CmmToAsm/X86/Ppr.hs @@ -35,7 +35,6 @@ import GHC.Cmm.Dataflow.Label import GHC.Cmm.BlockId import GHC.Cmm.CLabel -import GHC.Cmm.InitFini import GHC.Cmm.DebugBlock (pprUnwindTable) import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes) @@ -200,12 +199,8 @@ labelInd _ = Nothing , Just ind' <- labelInd ind , alias `mayRedirectTo` ind' - -- See Note [Split sections on COFF objects] - , not $ platformOS platform == OSMinGW32 && ncgSplitSections config = pprGloblDecl (ncgPlatform config) alias $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind') - where - platform = ncgPlatform config pprDatas config (align, (CmmStaticsRaw lbl dats)) = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats) @@ -466,7 +461,7 @@ -- TODO: this is shady because it only works for certain instructions VecFormat _ FmtInt8 -> text "b" VecFormat _ FmtInt16 -> text "w" - VecFormat _ FmtInt32 -> text "l" + VecFormat _ FmtInt32 -> text "d" VecFormat _ FmtInt64 -> text "q" pprFormat_x87 :: IsLine doc => Format -> doc @@ -537,20 +532,9 @@ pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc pprSectionAlign _config (Section (OtherSection _) _) = panic "X86.Ppr.pprSectionAlign: unknown section" -pprSectionAlign config sec@(Section seg suffix) = +pprSectionAlign config sec@(Section seg _) = line (pprSectionHeader config sec) $$ - coffSplitSectionComdatKey $$ pprAlignForSection (ncgPlatform config) seg - where - platform = ncgPlatform config - -- See Note [Split sections on COFF objects] - coffSplitSectionComdatKey - | OSMinGW32 <- platformOS platform - , ncgSplitSections config - , Nothing <- isInitOrFiniSection seg - = line (pprCOFFComdatKey platform suffix <> colon) - | otherwise - = empty -- | Print appropriate alignment for the given section type. pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc @@ -931,7 +915,7 @@ -> pprFormatOp (text "mul") format op FDIV format op1 op2 - -> pprFormatOpOp (text "div") format op1 op2 + -> pprFormatOpReg (text "div") format op1 op2 FMA3 format var perm op1 op2 op3 -> let mnemo = case var of @@ -1006,8 +990,22 @@ -> pprFormatOpRegReg (text "vmul") format s1 s2 dst VDIV format s1 s2 dst -> pprFormatOpRegReg (text "vdiv") format s1 s2 dst - VBROADCAST format from to - -> pprBroadcast (text "vbroadcast") format from to + PADD format src dst + -> pprFormatOpReg (text "padd") format src dst + PSUB format src dst + -> pprFormatOpReg (text "psub") format src dst + PMULL format src dst + -> pprFormatOpReg (text "pmull") format src dst + PMULUDQ format src dst + -> pprOpReg (text "pmuludq") format src dst + PCMPGT format src dst + -> pprFormatOpReg (text "pcmpgt") format src dst + VBROADCAST format@(VecFormat _ sFmt) from to + -> pprBroadcast (text "vbroadcast") (scalarFormatFormat sFmt) format from to + VBROADCAST format _ _ + -> pprPanic "VBROADCAST: expected vector format" (ppr format) + VPBROADCAST scalarFormat format from to + -> pprBroadcast (text "vpbroadcast") scalarFormat format from to VMOVU format from to -> pprFormatOpOp (text "vmovu") format from to MOVU format from to @@ -1028,39 +1026,103 @@ VecFormat 32 FmtInt16 -> text "vmovdqu32" -- NB: not using vmovdqu16/8, as they VecFormat 64 FmtInt8 -> text "vmovdqu32" -- require the additional AVX512BW extension _ -> text "vmovdqu" + VMOV_MERGE format src2 src1 dst + -> pprRegRegReg instr format src2 src1 dst + where instr = case format of + VecFormat _ FmtFloat -> text "vmovss" + VecFormat _ FmtDouble -> text "vmovsd" + _ -> pprPanic "invalid format for VMOV_MERGE" (ppr format) PXOR format src dst -> pprPXor (text "pxor") format src dst VPXOR format s1 s2 dst -> pprXor (text "vpxor") format s1 s2 dst + PAND format src dst + -> pprOpReg (text "pand") format src dst + PANDN format src dst + -> pprOpReg (text "pandn") format src dst + POR format src dst + -> pprOpReg (text "por") format src dst VEXTRACT format offset from to -> pprFormatImmRegOp (text "vextract") format offset from to INSERTPS format offset addr dst -> pprInsert (text "insertps") format offset addr dst + VINSERTPS format offset src2 src1 dst + -> pprImmOpRegReg (text "vinsertps") format offset src2 src1 dst + PINSR scalarFormat vectorFormat offset src dst + -> pprPinsr (text "pinsr") scalarFormat vectorFormat offset src dst + PEXTR scalarFormat vectorFormat offset src dst + -> pprPextr (text "pextr") scalarFormat vectorFormat offset src dst SHUF format offset src dst -> pprShuf (text "shuf" <> pprFormat format) format offset src dst VSHUF format offset src1 src2 dst -> pprVShuf (text "vshuf" <> pprFormat format) format offset src1 src2 dst + PSHUFB format mask dst + -> pprOpReg (text "pshufb") format mask dst + PSHUFLW format offset src dst + -> pprShuf (text "pshuflw") format offset src dst + PSHUFHW format offset src dst + -> pprShuf (text "pshufhw") format offset src dst PSHUFD format offset src dst -> pprShuf (text "pshufd") format offset src dst VPSHUFD format offset src dst -> pprShuf (text "vpshufd") format offset src dst + BLEND format mask src dst + -> pprFormatImmOpReg (text "blend") format mask src dst + VBLEND format mask src2 src1 dst + -> pprFormatImmOpRegReg (text "vblend") format mask src2 src1 dst + PBLENDW format mask src dst + -> pprShuf (text "pblendw") format mask src dst + PSLL format offset dst + -> pprFormatOpReg (text "psll") format offset dst PSLLDQ format offset dst -> pprDoubleShift (text "pslldq") format offset dst + PSRL format offset dst + -> pprFormatOpReg (text "psrl") format offset dst PSRLDQ format offset dst -> pprDoubleShift (text "psrldq") format offset dst + PALIGNR format offset src dst + -> pprImmOpReg (text "palignr") format offset src dst MOVHLPS format from to -> pprOpReg (text "movhlps") format (OpReg from) to + VMOVHLPS format src2 src1 dst + -> pprRegRegReg (text "vmovhlps") format src2 src1 dst + MOVLHPS format from to + -> pprOpReg (text "movlhps") format (OpReg from) to + VMOVLHPS format src2 src1 dst + -> pprRegRegReg (text "vmovlhps") format src2 src1 dst UNPCKL format src dst -> pprFormatOpReg (text "unpckl") format src dst + VUNPCKL format src2 src1 dst + -> pprFormatOpRegReg (text "vunpckl") format src2 src1 dst + UNPCKH format src dst + -> pprFormatOpReg (text "unpckh") format src dst + VUNPCKH format src2 src1 dst + -> pprFormatOpRegReg (text "vunpckh") format src2 src1 dst PUNPCKLQDQ format from to -> pprOpReg (text "punpcklqdq") format from to + PUNPCKLDQ format from to + -> pprOpReg (text "punpckldq") format from to + PUNPCKLWD format from to + -> pprOpReg (text "punpcklwd") format from to + PUNPCKLBW format from to + -> pprOpReg (text "punpcklbw") format from to + PUNPCKHQDQ format from to + -> pprOpReg (text "punpckhqdq") format from to + PUNPCKHDQ format from to + -> pprOpReg (text "punpckhdq") format from to + PUNPCKHWD format from to + -> pprOpReg (text "punpckhwd") format from to + PUNPCKHBW format from to + -> pprOpReg (text "punpckhbw") format from to + PACKUSWB format from to + -> pprOpReg (text "packuswb") format from to MINMAX minMax ty fmt src dst - -> pprMinMax False minMax ty fmt [src, dst] + -> pprMinMax False minMax ty fmt [src, OpReg dst] VMINMAX minMax ty fmt src1 src2 dst -> pprMinMax True minMax ty fmt [src1, OpReg src2, OpReg dst] @@ -1217,6 +1279,17 @@ pprReg platform (archWordFormat (target32Bit platform)) reg2 ] + pprRegRegReg :: Line doc -> Format -> Reg -> Reg -> Reg -> doc + pprRegRegReg name format reg1 reg2 reg3 + = line $ hcat [ + pprMnemonic_ name, + pprReg platform format reg1, + comma, + pprReg platform format reg2, + comma, + pprReg platform format reg3 + ] + pprOpReg :: Line doc -> Format -> Operand -> Reg -> doc pprOpReg name format op reg = line $ hcat [ @@ -1315,16 +1388,14 @@ -- Custom pretty printers -- These instructions currently don't follow a uniform suffix pattern -- in their names, so we have custom pretty printers for them. - pprBroadcast :: Line doc -> Format -> Operand -> Reg -> doc - pprBroadcast name fmt@(VecFormat _ sFmt) op dst + pprBroadcast :: Line doc -> Format -> Format -> Operand -> Reg -> doc + pprBroadcast name scalarFormat vectorFormat op dst = line $ hcat [ - pprBroadcastMnemonic name fmt, - pprOperand platform (scalarFormatFormat sFmt) op, + pprBroadcastMnemonic name vectorFormat, + pprOperand platform scalarFormat op, comma, - pprReg platform fmt dst + pprReg platform vectorFormat dst ] - pprBroadcast _ fmt _ _ = - pprPanic "pprBroadcast: expected vector format" (ppr fmt) pprXor :: Line doc -> Format -> Reg -> Reg -> Reg -> doc pprXor name format reg1 reg2 reg3 @@ -1376,6 +1447,28 @@ pprReg platform format dst ] + pprPinsr :: Line doc -> Format -> Format -> Imm -> Operand -> Reg -> doc + pprPinsr name scalarFormat vectorFormat imm src dst + = line $ hcat [ + pprMnemonic name vectorFormat, + pprDollImm imm, + comma, + pprOperand platform scalarFormat src, + comma, + pprReg platform vectorFormat dst + ] + + pprPextr :: Line doc -> Format -> Format -> Imm -> Reg -> Operand -> doc + pprPextr name scalarFormat vectorFormat imm src dst + = line $ hcat [ + pprMnemonic name vectorFormat, + pprDollImm imm, + comma, + pprReg platform vectorFormat src, + comma, + pprOperand platform scalarFormat dst + ] + pprShuf :: Line doc -> Format -> Imm -> Operand -> Reg -> doc pprShuf name format imm1 op2 reg3 = line $ hcat [ @@ -1400,13 +1493,61 @@ pprReg platform format reg4 ] - pprDoubleShift :: Line doc -> Format -> Operand -> Reg -> doc + pprDoubleShift :: Line doc -> Format -> Imm -> Reg -> doc pprDoubleShift name format off reg = line $ hcat [ pprGenMnemonic name format, - pprOperand platform format off, + pprDollImm off, comma, pprReg platform format reg + ] + + pprImmOpReg :: Line doc -> Format -> Imm -> Operand -> Reg -> doc + pprImmOpReg name format imm1 op2 reg3 + = line $ hcat [ + pprGenMnemonic name format, + pprDollImm imm1, + comma, + pprOperand platform format op2, + comma, + pprReg platform format reg3 + ] + + pprFormatImmOpReg :: Line doc -> Format -> Imm -> Operand -> Reg -> doc + pprFormatImmOpReg name format imm1 op2 reg3 + = line $ hcat [ + pprMnemonic name format, + pprDollImm imm1, + comma, + pprOperand platform format op2, + comma, + pprReg platform format reg3 + ] + + pprImmOpRegReg :: Line doc -> Format -> Imm -> Operand -> Reg -> Reg -> doc + pprImmOpRegReg name format imm1 op2 reg3 reg4 + = line $ hcat [ + pprGenMnemonic name format, + pprDollImm imm1, + comma, + pprOperand platform format op2, + comma, + pprReg platform format reg3, + comma, + pprReg platform format reg4 + ] + + pprFormatImmOpRegReg :: Line doc -> Format -> Imm -> Operand -> Reg -> Reg -> doc + pprFormatImmOpRegReg name format imm1 op2 reg3 reg4 + = line $ hcat [ + pprMnemonic name format, + pprDollImm imm1, + comma, + pprOperand platform format op2, + comma, + pprReg platform format reg3, + comma, + pprReg platform format reg4 ] pprMinMax :: Bool -> MinOrMax -> MinMaxType -> Format -> [Operand] -> doc diff --git a/GHC/CmmToAsm/X86/RegInfo.hs b/GHC/CmmToAsm/X86/RegInfo.hs --- a/GHC/CmmToAsm/X86/RegInfo.hs +++ b/GHC/CmmToAsm/X86/RegInfo.hs @@ -68,4 +68,3 @@ -- ,"#afafaf","#b6b6b6","#bdbdbd","#c4c4c4","#cbcbcb" -- ,"#d2d2d2","#d9d9d9","#e0e0e0"] - diff --git a/GHC/CmmToC.hs b/GHC/CmmToC.hs --- a/GHC/CmmToC.hs +++ b/GHC/CmmToC.hs @@ -124,7 +124,7 @@ pprDataExterns platform lits $$ pprWordArray platform (isSecConstant section) lbl lits where - isSecConstant (Section t _) = case sectionProtection t of + isSecConstant section = case sectionProtection section of ReadOnlySection -> True WriteProtectedSection -> True _ -> False @@ -873,26 +873,10 @@ (text "MO_V_Mul") (panic $ "PprC.pprMachOp_for_C: MO_V_Mul" ++ "unsupported by the unregisterised backend") - MO_VS_Quot {} -> pprTrace "offending mop:" - (text "MO_VS_Quot") - (panic $ "PprC.pprMachOp_for_C: MO_VS_Quot" - ++ "unsupported by the unregisterised backend") - MO_VS_Rem {} -> pprTrace "offending mop:" - (text "MO_VS_Rem") - (panic $ "PprC.pprMachOp_for_C: MO_VS_Rem" - ++ "unsupported by the unregisterised backend") MO_VS_Neg {} -> pprTrace "offending mop:" (text "MO_VS_Neg") (panic $ "PprC.pprMachOp_for_C: MO_VS_Neg" ++ "unsupported by the unregisterised backend") - MO_VU_Quot {} -> pprTrace "offending mop:" - (text "MO_VU_Quot") - (panic $ "PprC.pprMachOp_for_C: MO_VU_Quot" - ++ "unsupported by the unregisterised backend") - MO_VU_Rem {} -> pprTrace "offending mop:" - (text "MO_VU_Rem") - (panic $ "PprC.pprMachOp_for_C: MO_VU_Rem" - ++ "unsupported by the unregisterised backend") MO_V_Broadcast {} -> pprTrace "offending mop:" (text "MO_V_Broadcast") (panic $ "PprC.pprMachOp_for_C: MO_V_Broadcast" @@ -1063,6 +1047,14 @@ MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported + MO_VS_Quot {} -> unsupported + MO_VS_Rem {} -> unsupported + MO_VU_Quot {} -> unsupported + MO_VU_Rem {} -> unsupported + MO_I64X2_Min -> unsupported + MO_I64X2_Max -> unsupported + MO_W64X2_Min -> unsupported + MO_W64X2_Max -> unsupported MO_Touch -> unsupported -- we could support prefetch via "__builtin_prefetch" -- Not adding it for now diff --git a/GHC/CmmToLlvm.hs b/GHC/CmmToLlvm.hs --- a/GHC/CmmToLlvm.hs +++ b/GHC/CmmToLlvm.hs @@ -271,23 +271,15 @@ -- used if we didn't provide these hints. This will generate a -- definition of the form -- - -- @llvm.compiler.used = appending global [42 x i8*] [i8* bitcast to i8*, ...] + -- @llvm.used = appending global [42 x i8*] [i8* bitcast to i8*, ...] -- -- Which is the LLVM way of protecting them against getting removed. - -- - -- We used to emit @llvm.used, but it's too strong and results in - -- SHF_GNU_RETAIN section flag in the object, which prevents linker - -- gc-sections from working properly for LLVM backend (#26770). - -- @llvm.compiler.used serves a similar purpose that protects the - -- variable from being dropped by llc/opt, but it allows linker - -- gc-sections to work. See - -- https://llvm.org/docs/LangRef.html#the-llvm-compiler-used-global-variable ivars <- getUsedVars let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr ty = LMArray (length ivars) i8Ptr usedArray = LMStaticArray (map cast ivars) ty sectName = Just $ fsLit "llvm.metadata" - lmUsedVar = LMGlobalVar (fsLit "llvm.compiler.used") ty Appending sectName Nothing Constant + lmUsedVar = LMGlobalVar (fsLit "llvm.used") ty Appending sectName Nothing Constant lmUsed = LMGlobal lmUsedVar (Just usedArray) if null ivars then return () diff --git a/GHC/CmmToLlvm/Base.hs b/GHC/CmmToLlvm/Base.hs --- a/GHC/CmmToLlvm/Base.hs +++ b/GHC/CmmToLlvm/Base.hs @@ -286,7 +286,7 @@ , envUniqMeta :: UniqFM Unique MetaId -- ^ Global metadata nodes , envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type , envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References] - , envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.compiler.used (see @cmmUsedLlvmGens@) + , envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@) -- the following get cleared for every function (see @withClearVars@) , envVarMap :: LlvmEnvMap -- ^ Local variables so far, with type diff --git a/GHC/CmmToLlvm/CodeGen.hs b/GHC/CmmToLlvm/CodeGen.hs --- a/GHC/CmmToLlvm/CodeGen.hs +++ b/GHC/CmmToLlvm/CodeGen.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs, MultiWayIf #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Handle conversion of CmmProc to LLVM code. module GHC.CmmToLlvm.CodeGen ( genLlvmProc ) where @@ -27,6 +26,7 @@ import GHC.Cmm.Dataflow.Label import GHC.Data.FastString +import GHC.Data.Maybe (expectJust) import GHC.Data.OrdList import GHC.Types.ForeignCall @@ -43,7 +43,10 @@ import Control.Monad import qualified Data.Semigroup as Semigroup +import Data.Foldable ( toList ) import Data.List ( nub ) +import qualified Data.List as List +import Data.List.NonEmpty ( NonEmpty (..), nonEmpty ) import Data.Maybe ( catMaybes ) type Atomic = Maybe MemoryOrdering @@ -55,9 +58,8 @@ -- | Top-level of the LLVM proc Code generator -- genLlvmProc :: RawCmmDecl -> LlvmM [LlvmCmmDecl] -genLlvmProc (CmmProc infos lbl live graph) = do - let blocks = toBlockListEntryFirstFalseFallthrough graph - +genLlvmProc (CmmProc infos lbl live graph) + | Just blocks <- nonEmpty $ toBlockListEntryFirstFalseFallthrough graph = do (lmblocks, lmdata) <- basicBlocksCodeGen live blocks let info = mapLookup (g_entry graph) infos proc = CmmProc info lbl live (ListGraph lmblocks) @@ -77,9 +79,8 @@ -- | Generate code for a list of blocks that make up a complete -- procedure. The first block in the list is expected to be the entry -- point. -basicBlocksCodeGen :: LiveGlobalRegUses -> [CmmBlock] +basicBlocksCodeGen :: LiveGlobalRegUses -> NonEmpty CmmBlock -> LlvmM ([LlvmBasicBlock], [LlvmCmmDecl]) -basicBlocksCodeGen _ [] = panic "no entry block!" basicBlocksCodeGen live cmmBlocks = do -- Emit the prologue -- N.B. this must be its own block to ensure that the entry block of the @@ -97,7 +98,7 @@ let ubblock = BasicBlock ubid' [Unreachable] -- Generate code - (blocks, topss) <- fmap unzip $ mapM (basicBlockCodeGen ubid) cmmBlocks + (blocks, topss) <- fmap unzip $ mapM (basicBlockCodeGen ubid) $ toList cmmBlocks -- Compose return (entryBlock : ubblock : blocks, prologueTops ++ concat topss) @@ -239,25 +240,12 @@ genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_BSwap w)) [dst] args = genCallSimpleCast w op dst args +genCall (PrimTarget op@(MO_Pdep w)) [dst] args = + genCallSimpleCast w op dst args +genCall (PrimTarget op@(MO_Pext w)) [dst] args = + genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_PopCnt w)) [dst] args = genCallSimpleCast w op dst args -{- Note [LLVM PDep/PExt intrinsics] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Since x86 PDep/PExt instructions only exist for 32/64 bit widths -we use the 32bit variant to compute the 8/16bit primops. -To do so we extend/truncate the argument/result around the -call. --} -genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do - cfg <- getConfig - if llvmCgBmiVersion cfg >= Just BMI2 - then genCallMinimumTruncationCast W32 w op dst args - else genCallSimpleCast w op dst args -genCall (PrimTarget op@(MO_Pext w)) [dst] args = do - cfg <- getConfig - if llvmCgBmiVersion cfg >= Just BMI2 - then genCallMinimumTruncationCast W32 w op dst args - else genCallSimpleCast w op dst args genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do addrVar <- exprToVarW addr @@ -455,6 +443,34 @@ genCall t@(PrimTarget (MO_SubWordC w)) [dstV, dstO] [lhs, rhs] = genCallWithOverflow t w [dstV, dstO] [lhs, rhs] +genCall (PrimTarget (MO_VS_Quot l w)) [dst] [lhs, rhs] = runStmtsDecls $ do + lhsVar <- exprToVarW lhs + rhsVar <- exprToVarW rhs + result <- doExprW (LMVector l (widthToLlvmInt w)) (LlvmOp LM_MO_SDiv lhsVar rhsVar) + (dstReg, _dstTy) <- lift $ getCmmReg (CmmLocal dst) + statement $ Store result dstReg Nothing [] + +genCall (PrimTarget (MO_VS_Rem l w)) [dst] [lhs, rhs] = runStmtsDecls $ do + lhsVar <- exprToVarW lhs + rhsVar <- exprToVarW rhs + result <- doExprW (LMVector l (widthToLlvmInt w)) (LlvmOp LM_MO_SRem lhsVar rhsVar) + (dstReg, _dstTy) <- lift $ getCmmReg (CmmLocal dst) + statement $ Store result dstReg Nothing [] + +genCall (PrimTarget (MO_VU_Quot l w)) [dst] [lhs, rhs] = runStmtsDecls $ do + lhsVar <- exprToVarW lhs + rhsVar <- exprToVarW rhs + result <- doExprW (LMVector l (widthToLlvmInt w)) (LlvmOp LM_MO_UDiv lhsVar rhsVar) + (dstReg, _dstTy) <- lift $ getCmmReg (CmmLocal dst) + statement $ Store result dstReg Nothing [] + +genCall (PrimTarget (MO_VU_Rem l w)) [dst] [lhs, rhs] = runStmtsDecls $ do + lhsVar <- exprToVarW lhs + rhsVar <- exprToVarW rhs + result <- doExprW (LMVector l (widthToLlvmInt w)) (LlvmOp LM_MO_URem lhsVar rhsVar) + (dstReg, _dstTy) <- lift $ getCmmReg (CmmLocal dst) + statement $ Store result dstReg Nothing [] + -- Handle all other foreign calls and prim ops. genCall target res args = do platform <- getPlatform @@ -625,15 +641,8 @@ -- from i32 to i8 explicitly as LLVM is strict about types. genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual] -> LlvmM StmtData -genCallSimpleCast w = genCallMinimumTruncationCast w w - --- Given the minimum machine bit-width to use and the logical bit-width of the --- value range, perform a type-cast truncation and extension before and after the --- specified operation, respectively. -genCallMinimumTruncationCast :: Width -> Width -> CallishMachOp -> CmmFormal - -> [CmmActual] -> LlvmM StmtData -genCallMinimumTruncationCast minW specW op dst args = do - let width = widthToLlvmInt $ max minW specW +genCallSimpleCast specW op dst args = do + let width = widthToLlvmInt specW argsW = const width <$> args dstType = cmmToLlvmType $ localRegType dst signage = cmmPrimOpRetValSignage op @@ -936,10 +945,9 @@ W256 -> fsLit "llvm.cttz.i256" W512 -> fsLit "llvm.cttz.i512" MO_Pdep w - -- See Note [LLVM PDep/PExt intrinsics] | isBmi2Enabled -> case w of - W8 -> fsLit "llvm.x86.bmi.pdep.32" - W16 -> fsLit "llvm.x86.bmi.pdep.32" + W8 -> fsLit "llvm.x86.bmi.pdep.8" + W16 -> fsLit "llvm.x86.bmi.pdep.16" W32 -> fsLit "llvm.x86.bmi.pdep.32" W64 -> fsLit "llvm.x86.bmi.pdep.64" W128 -> fsLit "llvm.x86.bmi.pdep.128" @@ -955,9 +963,8 @@ W512 -> fsLit "hs_pdep512" MO_Pext w | isBmi2Enabled -> case w of - -- See Note [LLVM PDep/PExt intrinsics] - W8 -> fsLit "llvm.x86.bmi.pext.32" - W16 -> fsLit "llvm.x86.bmi.pext.32" + W8 -> fsLit "llvm.x86.bmi.pext.8" + W16 -> fsLit "llvm.x86.bmi.pext.16" W32 -> fsLit "llvm.x86.bmi.pext.32" W64 -> fsLit "llvm.x86.bmi.pext.64" W128 -> fsLit "llvm.x86.bmi.pext.128" @@ -1024,6 +1031,15 @@ -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported + MO_VS_Quot {} -> unsupported + MO_VS_Rem {} -> unsupported + MO_VU_Quot {} -> unsupported + MO_VU_Rem {} -> unsupported + MO_I64X2_Min -> unsupported + MO_I64X2_Max -> unsupported + MO_W64X2_Min -> unsupported + MO_W64X2_Max -> unsupported + MO_ReleaseFence -> unsupported MO_AcquireFence -> unsupported MO_SeqCstFence -> unsupported @@ -1536,13 +1552,9 @@ MO_V_Sub _ _ -> panicOp MO_V_Mul _ _ -> panicOp - MO_VS_Quot _ _ -> panicOp - MO_VS_Rem _ _ -> panicOp MO_VS_Min _ _ -> panicOp MO_VS_Max _ _ -> panicOp - MO_VU_Quot _ _ -> panicOp - MO_VU_Rem _ _ -> panicOp MO_VU_Min _ _ -> panicOp MO_VU_Max _ _ -> panicOp @@ -1720,12 +1732,6 @@ MO_V_Sub l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Sub MO_V_Mul l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_Mul - MO_VS_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SDiv - MO_VS_Rem l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_SRem - - MO_VU_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_UDiv - MO_VU_Rem l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_URem - MO_VF_Add l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FAdd MO_VF_Sub l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FSub MO_VF_Mul l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FMul @@ -2139,10 +2145,17 @@ -- ] in return (mkIntLit width i, nilOL, []) -genLit _ (CmmFloat r w) - = return (LMLitVar $ LMFloatLit (fromRational r) (widthToLlvmFloat w), +genLit _ (CmmFloat r W32) + = return (LMLitVar $ LMFloatLit (widenFp (fromRational r :: Float)) (widthToLlvmFloat W32), nilOL, []) +genLit _ (CmmFloat r W64) + = return (LMLitVar $ LMFloatLit (fromRational r :: Double) (widthToLlvmFloat W64), + nilOL, []) + +genLit _ (CmmFloat _r _w) + = panic "genLit (CmmLit:CmmFloat), unsupported float lit" + genLit opt (CmmVec ls) = do llvmLits <- mapM toLlvmLit ls return (LMLitVar $ LMVectorLit llvmLits, nilOL, []) @@ -2219,7 +2232,7 @@ -- question is never written. Therefore we skip it where we can to -- save a few lines in the output and hopefully speed compilation up a -- bit. -funPrologue :: LiveGlobalRegUses -> [CmmBlock] -> LlvmM StmtData +funPrologue :: LiveGlobalRegUses -> NonEmpty CmmBlock -> LlvmM StmtData funPrologue live cmmBlocks = do platform <- getPlatform @@ -2265,7 +2278,7 @@ return (concatOL stmtss `snocOL` jumpToEntry, []) where - entryBlk : _ = cmmBlocks + entryBlk :| _ = cmmBlocks jumpToEntry = Branch $ blockIdToLlvm (entryLabel entryBlk) -- | Function epilogue. Load STG variables to use as argument for call. @@ -2378,9 +2391,8 @@ -- | Returns TBAA meta data by unique getTBAAMeta :: Unique -> LlvmM [MetaAnnot] -getTBAAMeta u = do - mi <- getUniqMeta u - return [MetaAnnot tbaa (MetaNode i) | let Just i = mi] +getTBAAMeta u = + List.singleton . MetaAnnot tbaa . MetaNode . expectJust <$> getUniqMeta u -- | Returns TBAA meta data for given register getTBAARegMeta :: GlobalReg -> LlvmM [MetaAnnot] diff --git a/GHC/CmmToLlvm/Data.hs b/GHC/CmmToLlvm/Data.hs --- a/GHC/CmmToLlvm/Data.hs +++ b/GHC/CmmToLlvm/Data.hs @@ -10,6 +10,7 @@ import GHC.Prelude import GHC.Llvm +import GHC.Llvm.Types (widenFp) import GHC.CmmToLlvm.Base import GHC.CmmToLlvm.Config @@ -74,7 +75,7 @@ IsFiniArray -> fsLit "llvm.global_dtors" in genGlobalLabelArray var clbls -genLlvmData (sec@(Section t _), CmmStaticsRaw lbl xs) = do +genLlvmData (sec, CmmStaticsRaw lbl xs) = do label <- strCLabel_llvm lbl static <- mapM genData xs lmsec <- llvmSection sec @@ -91,7 +92,7 @@ then Just 2 else Just 1 Section Data _ -> Just $ platformWordSizeInBytes platform _ -> Nothing - const = if sectionProtection t == ReadOnlySection + const = if sectionProtection sec == ReadOnlySection then Constant else Global varDef = LMGlobalVar label tyAlias link lmsec align const globDef = LMGlobal varDef struct @@ -193,8 +194,14 @@ genStaticLit (CmmInt i w) = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w)) -genStaticLit (CmmFloat r w) - = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w)) +genStaticLit (CmmFloat r W32) + = return $ LMStaticLit (LMFloatLit (widenFp (fromRational r :: Float)) (widthToLlvmFloat W32)) + +genStaticLit (CmmFloat r W64) + = return $ LMStaticLit (LMFloatLit (fromRational r :: Double) (widthToLlvmFloat W64)) + +genStaticLit (CmmFloat _r _w) + = panic "genStaticLit (CmmLit:CmmFloat), unsupported float lit" genStaticLit (CmmVec ls) = do sls <- mapM toLlvmLit ls diff --git a/GHC/CmmToLlvm/Version/Bounds.hs b/GHC/CmmToLlvm/Version/Bounds.hs --- a/GHC/CmmToLlvm/Version/Bounds.hs +++ b/GHC/CmmToLlvm/Version/Bounds.hs @@ -16,4 +16,4 @@ -- | The (not-inclusive) upper bound bound on the LLVM Version that is currently supported. supportedLlvmVersionUpperBound :: LlvmVersion -supportedLlvmVersionUpperBound = LlvmVersion (20 NE.:| []) +supportedLlvmVersionUpperBound = LlvmVersion (21 NE.:| []) diff --git a/GHC/Core.hs b/GHC/Core.hs --- a/GHC/Core.hs +++ b/GHC/Core.hs @@ -14,9 +14,10 @@ -- * In/Out type synonyms InId, InBind, InExpr, InAlt, InArg, InType, InKind, - InBndr, InVar, InCoercion, InTyVar, InCoVar, + InBndr, InVar, InCoercion, InTyVar, InCoVar, InTyCoVar, OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind, - OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, MOutCoercion, + OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, + OutTyCoVar, MOutCoercion, -- ** 'Expr' construction mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams, @@ -38,11 +39,11 @@ isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates - bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, + bindersOf, bindersOfBinds, rhssOfBind, rhssOfBinds, rhssOfAlts, foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, - collectArgs, stripNArgs, collectArgsTicks, flattenBinds, + collectArgs, collectValArgs, stripNArgs, collectArgsTicks, flattenBinds, collectFunSimple, exprToType, @@ -59,7 +60,7 @@ unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk, -- ** Predicates and deconstruction on 'Unfolding' - unfoldingTemplate, expandUnfolding_maybe, + expandUnfolding_maybe, maybeUnfoldingTemplate, otherCons, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, @@ -115,8 +116,12 @@ import Data.Data hiding (TyCon) import Data.Int +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as NE import Data.Word +import Control.DeepSeq + infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps` -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys) @@ -1029,6 +1034,73 @@ operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for ideas how to fix this. +Note [Strict fields in Core] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In Core, evaluating a data constructor worker evaluates its strict fields. + +In other words, let's say we have the following data type + + data T a b = MkT !a b + +Now if `xs` reduces to `error "boom"`, then `MkT xs b` will throw that error. +Consequently, it is sound to seq the field before the call to the constructor, +e.g., with `case xs of xs' { __DEFAULT -> MkT xs' b }`. +Let's call this transformation "field eval insertion". + +Note in particular that the data constructor application `MkT xs b` above is +*not* a value, unless `xs` is! + +This has pervasive effect on the Core pipeline: + +(SFC1) `exprIsHNF`/`exprIsConLike`/`exprOkForSpeculation` need to assert that the + strict arguments of a DataCon worker are values/ok-for-spec themselves. + +(SFC2) `exprIsConApp_maybe` inserts field evals in the `FloatBind`s it returns, so + that the Simplifier, Constant-folding, the pattern-match checker, etc. all + see the inserted field evals when they match on strict workers. + + For example, + exprIsConApp_maybe (MkT e1 e2) + = Just ([FloatCase e1 x], MkT, [x,e2]) + Meaning that (MkT e1 e2) is indeed a data constructor application, but if + you want to decompose it (which is the purpose of exprIsConApp_maybe) you + must evaluate e1 first. + In case of case-of-known constructor, we get the rewrite + case MkT e1 e2 of MkT xs' b' -> b' + ==> + case e1 of xs' { __DEFAULT -> e2 } + which crucially retains the eval on e1. + +(SFC3) The demand signature of a data constructor is strict in strict field + position and lazy in non-strict fields. Likewise the demand *transformer* + of a DataCon worker can stricten up demands on strict field args. + See Note [Demand transformer for data constructors]. + +(SFC4) In the absence of `-fpedantic-bottoms`, it is still possible that some seqs + are ultimately dropped or delayed due to eta-expansion. + See Note [Dealing with bottom]. + +Strict field semantics is exploited and lowered in STG during EPT enforcement; +see Note [EPT enforcement lowers strict constructor worker semantics] for the +connection. + +It might be tempting to think that strict fields could be implemented in terms +of unlifted fields. However, unlifted fields behave differently when the data +constructor is partially applied; see Note [exprIsHNF for function applications] +for an example. + +Historical Note: +The delightfully simple description of strict field semantics is the result of +a long saga (#20749, the bits about strict data constructors in #21497, #22475), +where we tried a more lenient (but actually not) semantics first that would +allow both strict and lazy implementations of DataCon workers. This was favoured +because the "pervasive effect" throughout the compiler was deemed too large +(when it really turned out to be quite modest). +Alas, this semantics would require us to implement `exprIsHNF` in *exactly* the +same way as above, otherwise the analysis would not be conservative wrt. the +lenient semantics (which includes the strict one). It is also much harder to +explain and maintain, as it turned out. + ************************************************************************ * * In/Out type synonyms @@ -1097,11 +1169,9 @@ -- -- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically -- -chooseOrphanAnchor local_names - | isEmptyNameSet local_names = IsOrphan - | otherwise = NotOrphan (minimum occs) - where - occs = map nameOccName $ nonDetEltsUniqSet local_names +chooseOrphanAnchor local_names = case nonEmpty $ nonDetEltsUniqSet local_names of + Nothing -> IsOrphan + Just local_names -> NotOrphan (minimum (NE.map nameOccName local_names)) -- It's OK to use nonDetEltsUFM here, see comments above instance Binary IsOrphan where @@ -1117,6 +1187,10 @@ n <- get bh return $ NotOrphan n +instance NFData IsOrphan where + rnf IsOrphan = () + rnf (NotOrphan n) = rnf n + {- Note [Orphans] ~~~~~~~~~~~~~~ @@ -1267,7 +1341,7 @@ -- | The number of arguments the 'ru_fn' must be applied -- to before the rule can match on it -ruleArity :: CoreRule -> Int +ruleArity :: CoreRule -> FullArgCount ruleArity (BuiltinRule {ru_nargs = n}) = n ruleArity (Rule {ru_args = args}) = length args @@ -1287,7 +1361,8 @@ ruleIdName = ru_fn isLocalRule :: CoreRule -> Bool -isLocalRule = ru_local +isLocalRule (BuiltinRule {}) = False +isLocalRule (Rule { ru_local = is_local }) = is_local -- | Set the 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side setRuleIdName :: Name -> CoreRule -> CoreRule @@ -1513,10 +1588,6 @@ mkOtherCon :: [AltCon] -> Unfolding mkOtherCon = OtherCon --- | Retrieves the template of an unfolding: panics if none is known -unfoldingTemplate :: Unfolding -> CoreExpr -unfoldingTemplate = uf_tmpl - -- | Retrieves the template of an unfolding if possible -- maybeUnfoldingTemplate is used mainly when specialising, and we do -- want to specialise DFuns, so it's important to return a template @@ -2083,6 +2154,11 @@ rhssOfBind (NonRec _ rhs) = [rhs] rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs] +rhssOfBinds :: [Bind b] -> [Expr b] +rhssOfBinds [] = [] +rhssOfBinds (NonRec _ rhs : bs) = rhs : rhssOfBinds bs +rhssOfBinds (Rec pairs : bs) = map snd pairs ++ rhssOfBinds bs + rhssOfAlts :: [Alt b] -> [Expr b] rhssOfAlts alts = [e | Alt _ _ e <- alts] @@ -2156,6 +2232,17 @@ = go expr [] where go (App f a) as = go f (a:as) + go e as = (e, as) + +-- | Takes a nested application expression and returns the function +-- being applied and the arguments to which it is applied +collectValArgs :: Expr b -> (Expr b, [Arg b]) +collectValArgs expr + = go expr [] + where + go (App f a) as + | isValArg a = go f (a:as) + | otherwise = go f as go e as = (e, as) -- | Takes a nested application expression and returns the function diff --git a/GHC/Core/Class.hs b/GHC/Core/Class.hs --- a/GHC/Core/Class.hs +++ b/GHC/Core/Class.hs @@ -18,7 +18,12 @@ classKey, className, classATs, classATItems, classTyCon, classMethods, classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta, classHasSCs, classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, - classHasFds, isAbstractClass, + classHasFds, + + -- Predicates + -- NB: other isXXlass predicates are defined in GHC.Core.Predicate + -- to avoid module loops + isAbstractClass ) where import GHC.Prelude @@ -26,6 +31,7 @@ import {-# SOURCE #-} GHC.Core.TyCon ( TyCon ) import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, PredType ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType ) +import GHC.Hs.Extension (GhcRn) import GHC.Types.Var import GHC.Types.Name import GHC.Types.Basic @@ -35,7 +41,7 @@ import GHC.Types.SrcLoc import GHC.Types.Var.Set import GHC.Utils.Outputable -import GHC.Data.BooleanFormula (BooleanFormula, mkTrue) +import Language.Haskell.Syntax.BooleanFormula ( BooleanFormula, mkTrue ) import qualified Data.Data as Data @@ -131,7 +137,7 @@ -- Note [Type-checking default assoc decls] in GHC.Tc.TyCl. } -type ClassMinimalDef = BooleanFormula Name -- Required methods +type ClassMinimalDef = BooleanFormula GhcRn -- Required methods data ClassBody = AbstractClass diff --git a/GHC/Core/Coercion.hs b/GHC/Core/Coercion.hs --- a/GHC/Core/Coercion.hs +++ b/GHC/Core/Coercion.hs @@ -41,18 +41,15 @@ mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, - mkNakedForAllCo, mkForAllCo, mkHomoForAllCos, - mkPhantomCo, + mkNakedForAllCo, mkForAllCo, mkForAllVisCos, mkHomoForAllCos, + mkPhantomCo, mkAxiomCo, mkHoleCo, mkUnivCo, mkSubCo, mkProofIrrelCo, - downgradeRole, mkAxiomCo, + downgradeRole, mkGReflRightCo, mkGReflLeftCo, mkCoherenceLeftCo, mkCoherenceRightCo, mkKindCo, castCoercionKind, castCoercionKind1, castCoercionKind2, - mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, - mkNomPrimEqPred, - -- ** Decomposition instNewTyCon_maybe, @@ -96,9 +93,10 @@ liftCoSubst, liftCoSubstTyVar, liftCoSubstWith, liftCoSubstWithEx, emptyLiftingContext, extendLiftingContext, extendLiftingContextAndInScope, liftCoSubstVarBndrUsing, isMappedByLC, extendLiftingContextCvSubst, + updateLCSubst, mkSubstLiftingContext, liftingContextSubst, zapLiftingContext, - substForAllCoBndrUsingLC, lcLookupCoVar, lcInScopeSet, + lcLookupCoVar, lcInScopeSet, LiftCoEnv, LiftingContext(..), liftEnvSubstLeft, liftEnvSubstRight, substRightCo, substLeftCo, swapLiftCoEnv, lcSubstLeft, lcSubstRight, @@ -123,8 +121,7 @@ multToCo, mkRuntimeRepCo, - hasCoercionHoleTy, hasCoercionHoleCo, hasThisCoercionHoleTy, - + hasCoercionHole, setCoHoleType ) where @@ -140,6 +137,7 @@ import GHC.Core.TyCo.Tidy import GHC.Core.TyCo.Compare import GHC.Core.Type +import GHC.Core.Predicate( mkNomEqPred, mkReprEqPred ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Core.Coercion.Axiom @@ -168,6 +166,7 @@ import Data.Function ( on ) import Data.Char( isDigit ) import qualified Data.Monoid as Monoid +import Data.List.NonEmpty ( NonEmpty (..) ) import Control.DeepSeq {- @@ -250,14 +249,14 @@ ppr_co_ax_branch :: (TidyEnv -> Type -> SDoc) -> TyCon -> CoAxBranch -> SDoc ppr_co_ax_branch ppr_rhs fam_tc branch - = foldr1 (flip hangNotEmpty 2) - [ pprUserForAll (mkForAllTyBinders Inferred bndrs') + = foldr1 (flip hangNotEmpty 2) $ + pprUserForAll (mkForAllTyBinders Inferred bndrs') :| -- See Note [Printing foralls in type family instances] in GHC.Iface.Type - , pp_lhs <+> ppr_rhs tidy_env ee_rhs - , vcat [ text "-- Defined" <+> pp_loc + (pp_lhs <+> ppr_rhs tidy_env ee_rhs) : + ( vcat [ text "-- Defined" <+> pp_loc , ppUnless (null incomps) $ whenPprDebug $ - text "-- Incomps:" <+> vcat (map (pprCoAxBranch fam_tc) incomps) ] - ] + text "-- Incomps:" <+> vcat (map (pprCoAxBranch fam_tc) incomps) ] ) : + [] where incomps = coAxBranchIncomps branch loc = coAxBranchSpan branch @@ -950,6 +949,15 @@ | otherwise = mkForAllCo_NoRefl v visL visR kind_co co +-- mkForAllVisCos [tv{vis}] constructs a cast +-- forall tv. res ~R# forall tv{vis} res`. +-- See Note [Required foralls in Core] in GHC.Core.TyCo.Rep +mkForAllVisCos :: HasDebugCallStack => [ForAllTyBinder] -> Coercion -> Coercion +mkForAllVisCos bndrs orig_co = foldr go orig_co bndrs + where + go (Bndr tv vis) + = mkForAllCo tv coreTyLamForAllTyFlag vis (mkNomReflCo (varType tv)) + -- | Make a Coercion quantified over a type/coercion variable; -- the variable has the same kind and visibility in both sides of the coercion mkHomoForAllCos :: [ForAllTyBinder] -> Coercion -> Coercion @@ -1742,7 +1750,7 @@ = mkFunCoNoFTF role mult arg_co res_co where arg_co = mkReflCo role (varType id) - mult = multToCo (varMult id) + mult = multToCo (idMult id) -- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2 -- The first coercion might be lifted or unlifted; thus the ~? above @@ -2015,20 +2023,20 @@ -- Also maps coercion variables to ProofIrrelCos. -- like liftCoSubstWith, but allows for existentially-bound types as well -liftCoSubstWithEx :: Role -- desired role for output coercion - -> [TyVar] -- universally quantified tyvars +liftCoSubstWithEx :: [TyVar] -- universally quantified tyvars -> [Coercion] -- coercions to substitute for those -> [TyCoVar] -- existentially quantified tycovars -> [Type] -- types and coercions to be bound to ex vars - -> (Type -> Coercion, [Type]) -- (lifting function, converted ex args) -liftCoSubstWithEx role univs omegas exs rhos - = let theta = mkLiftingContext (zipEqual "liftCoSubstWithExU" univs omegas) - psi = extendLiftingContextEx theta (zipEqual "liftCoSubstWithExX" exs rhos) - in (ty_co_subst psi role, substTys (lcSubstRight psi) (mkTyCoVarTys exs)) + -> (Type -> CoercionR, [Type]) -- (lifting function, converted ex args) + -- Returned coercion has Representational role +liftCoSubstWithEx univs omegas exs rhos + = let theta = mkLiftingContext (zipEqual univs omegas) + psi = extendLiftingContextEx theta (zipEqual exs rhos) + in (ty_co_subst psi Representational, substTys (lcSubstRight psi) (mkTyCoVarTys exs)) liftCoSubstWith :: Role -> [TyCoVar] -> [Coercion] -> Type -> Coercion liftCoSubstWith r tvs cos ty - = liftCoSubst r (mkLiftingContext $ zipEqual "liftCoSubstWith" tvs cos) ty + = liftCoSubst r (mkLiftingContext $ zipEqual tvs cos) ty -- | @liftCoSubst role lc ty@ produces a coercion (at role @role@) -- that coerces between @lc_left(ty)@ and @lc_right(ty)@, where @@ -2129,15 +2137,11 @@ zapLiftingContext :: LiftingContext -> LiftingContext zapLiftingContext (LC subst _) = LC (zapSubst subst) emptyVarEnv --- | Like 'substForAllCoBndr', but works on a lifting context -substForAllCoBndrUsingLC :: SwapFlag - -> (Coercion -> Coercion) - -> LiftingContext -> TyCoVar -> Coercion - -> (LiftingContext, TyCoVar, Coercion) -substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co - = (LC subst' lc_env, tv', co') +updateLCSubst :: LiftingContext -> (Subst -> (Subst, a)) -> (LiftingContext, a) +-- Lift a Subst-update function over LiftingContext +updateLCSubst (LC subst lc_env) upd = (LC subst' lc_env, res) where - (subst', tv', co') = substForAllCoBndrUsing sym sco subst tv co + (subst', res) = upd subst -- | The \"lifting\" operation which substitutes coercions for type -- variables in a type to produce a coercion. @@ -2155,7 +2159,7 @@ go r ty | Just ty' <- coreView ty = go r ty' go Phantom ty = lift_phantom ty - go r (TyVarTy tv) = expectJust "ty_co_subst bad roles" $ + go r (TyVarTy tv) = expectJust $ liftCoSubstTyVar lc r tv go r (AppTy ty1 ty2) = mkAppCo (go r ty1) (go Nominal ty2) go r (TyConApp tc tys) = mkTyConAppCo r tc (zipWith go (tyConRoleListX r tc) tys) @@ -2285,7 +2289,7 @@ stuff = fun lc old_kind eta = view_co stuff k1 = coercionLKind eta - new_var = uniqAway (getSubstInScope subst) (setVarType old_var k1) + new_var = uniqAway (substInScopeSet subst) (setVarType old_var k1) lifted = mkGReflRightCo Nominal (TyVarTy new_var) eta -- :: new_var ~ new_var |> eta @@ -2305,7 +2309,7 @@ stuff = fun lc old_kind eta = view_co stuff k1 = coercionLKind eta - new_var = uniqAway (getSubstInScope subst) (setVarType old_var k1) + new_var = uniqAway (substInScopeSet subst) (setVarType old_var k1) -- old_var :: s1 ~r s2 -- eta :: (s1' ~r s2') ~N (t1 ~r t2) @@ -2389,7 +2393,7 @@ -- | Get the 'InScopeSet' from a 'LiftingContext' lcInScopeSet :: LiftingContext -> InScopeSet -lcInScopeSet (LC subst _) = getSubstInScope subst +lcInScopeSet (LC subst _) = substInScopeSet subst {- %************************************************************************ @@ -2667,45 +2671,14 @@ -- | Makes a coercion type from two types: the types whose equality -- is proven by the relevant 'Coercion' mkCoercionType :: Role -> Type -> Type -> Type -mkCoercionType Nominal = mkPrimEqPred -mkCoercionType Representational = mkReprPrimEqPred +mkCoercionType Nominal = mkNomEqPred +mkCoercionType Representational = mkReprEqPred mkCoercionType Phantom = \ty1 ty2 -> let ki1 = typeKind ty1 ki2 = typeKind ty2 in TyConApp eqPhantPrimTyCon [ki1, ki2, ty1, ty2] --- | Creates a primitive nominal type equality predicate. --- t1 ~# t2 --- Invariant: the types are not Coercions -mkPrimEqPred :: Type -> Type -> Type -mkPrimEqPred ty1 ty2 - = mkTyConApp eqPrimTyCon [k1, k2, ty1, ty2] - where - k1 = typeKind ty1 - k2 = typeKind ty2 - --- | Creates a primitive representational type equality predicate. --- t1 ~R# t2 --- Invariant: the types are not Coercions -mkReprPrimEqPred :: Type -> Type -> Type -mkReprPrimEqPred ty1 ty2 - = mkTyConApp eqReprPrimTyCon [k1, k2, ty1, ty2] - where - k1 = typeKind ty1 - k2 = typeKind ty2 - --- | Makes a lifted equality predicate at the given role -mkPrimEqPredRole :: Role -> Type -> Type -> PredType -mkPrimEqPredRole Nominal = mkPrimEqPred -mkPrimEqPredRole Representational = mkReprPrimEqPred -mkPrimEqPredRole Phantom = panic "mkPrimEqPredRole phantom" - --- | Creates a primitive nominal type equality predicate with an explicit --- (but homogeneous) kind: (~#) k k ty1 ty2 -mkNomPrimEqPred :: Kind -> Type -> Type -> Type -mkNomPrimEqPred k ty1 ty2 = mkTyConApp eqPrimTyCon [k, k, ty1, ty2] - -- | Assuming that two types are the same, ignoring coercions, find -- a nominal coercion between the types. This is useful when optimizing -- transitivity over coercion applications, where splitting two @@ -2813,39 +2786,22 @@ -} has_co_hole_ty :: Type -> Monoid.Any -has_co_hole_co :: Coercion -> Monoid.Any -(has_co_hole_ty, _, has_co_hole_co, _) +(has_co_hole_ty, _, _, _) = foldTyCo folder () where folder = TyCoFolder { tcf_view = noView , tcf_tyvar = const2 (Monoid.Any False) , tcf_covar = const2 (Monoid.Any False) - , tcf_hole = \_ hole -> Monoid.Any (isHeteroKindCoHole hole) + , tcf_hole = \_ _ -> Monoid.Any True , tcf_tycobinder = const2 } --- | Is there a hetero-kind coercion hole in this type? --- (That is, a coercion hole with ch_hetero_kind=True.) --- See wrinkle (EIK2) of Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality -hasCoercionHoleTy :: Type -> Bool -hasCoercionHoleTy = Monoid.getAny . has_co_hole_ty - --- | Is there a hetero-kind coercion hole in this coercion? -hasCoercionHoleCo :: Coercion -> Bool -hasCoercionHoleCo = Monoid.getAny . has_co_hole_co - -hasThisCoercionHoleTy :: Type -> CoercionHole -> Bool -hasThisCoercionHoleTy ty hole = Monoid.getAny (f ty) - where - (f, _, _, _) = foldTyCo folder () - - folder = TyCoFolder { tcf_view = noView - , tcf_tyvar = const2 (Monoid.Any False) - , tcf_covar = const2 (Monoid.Any False) - , tcf_hole = \ _ h -> Monoid.Any (getUnique h == getUnique hole) - , tcf_tycobinder = const2 - } +-- | Is there a coercion hole in this type? +-- See wrinkle (DE6) of Note [Defaulting equalities] in GHC.Tc.Solver.Default +hasCoercionHole :: Type -> Bool +hasCoercionHole = Monoid.getAny . has_co_hole_ty -- | Set the type of a 'CoercionHole' setCoHoleType :: CoercionHole -> Type -> CoercionHole setCoHoleType h t = setCoHoleCoVar h (setVarType (coHoleCoVar h) t) + diff --git a/GHC/Core/Coercion/Axiom.hs b/GHC/Core/Coercion/Axiom.hs --- a/GHC/Core/Coercion/Axiom.hs +++ b/GHC/Core/Coercion/Axiom.hs @@ -58,6 +58,7 @@ import qualified Data.Data as Data import Data.Array import Data.List ( mapAccumL ) +import Control.DeepSeq {- Note [Coercion axiom branches] @@ -558,6 +559,11 @@ 2 -> return Representational 3 -> return Phantom _ -> panic ("get Role " ++ show tag) + +instance NFData Role where + rnf Nominal = () + rnf Representational = () + rnf Phantom = () {- ************************************************************************ diff --git a/GHC/Core/Coercion/Opt.hs b/GHC/Core/Coercion/Opt.hs --- a/GHC/Core/Coercion/Opt.hs +++ b/GHC/Core/Coercion/Opt.hs @@ -208,10 +208,12 @@ in warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co) "optCoercion: reflexive but not refl" details $ --- assertPpr (substTyUnchecked env in_ty1 `eqType` out_ty1 && --- substTyUnchecked env in_ty2 `eqType` out_ty2 && --- in_role == out_role) --- (hang (text "optCoercion changed types!") 2 details) $ + -- The coercion optimiser should usually optimise + -- co:ty~ty --> Refl ty + -- But given a silly `newtype N = MkN N`, the axiom has type (N ~ N), + -- and so that can trigger this warning (e.g. test str002). + -- Maybe we should optimise that coercion to (Refl N), but it + -- just doesn't seem worth the bother out_co | otherwise @@ -356,12 +358,12 @@ (opt_co4 env sym False Nominal co2) opt_co4' env sym rep r (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR - , fco_kind = k_co, fco_body = co }) - = case optForAllCoBndr env sym tv k_co of - (env', tv', k_co') -> mkForAllCo tv' visL' visR' k_co' $ - opt_co4 env' sym rep r co + , fco_kind = k_co, fco_body = co }) + = mkForAllCo tv' visL' visR' k_co' $ + opt_co4 env' sym rep r co -- Use the "mk" functions to check for nested Refls where + !(env', tv', k_co') = optForAllCoBndr env sym tv k_co !(visL', visR') = swapSym sym (visL, visR) opt_co4' env sym rep r (FunCo _r afl afr cow co1 co2) @@ -687,7 +689,7 @@ ------------- opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] -opt_transList is = zipWithEqual "opt_transList" (opt_trans is) +opt_transList is = zipWithEqual (opt_trans is) -- The input lists must have identical length. opt_trans :: HasDebugCallStack => InScopeSet -> NormalCo -> NormalCo -> NormalCo @@ -1113,7 +1115,7 @@ :: Equal (Id Int) (Id Bool) ~ False which is bogus! This is because the type system isn't smart enough to know -that (Id Int) and (Id Bool) are Surely Apart, as they're headed by type +that (Id Int) and (Id Bool) are SurelyApart, as they're headed by type families. At the time of writing, I (Richard Eisenberg) couldn't think of a way of detecting this any more efficient than just building the optimised coercion and checking. @@ -1399,10 +1401,68 @@ -} +{- Note [Optimising ForAllCo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If sym=NotSwapped, optimising ForAllCo is relatively easy: + opt env (ForAllCo tcv kco bodyco) + = ForAllCo tcv' (opt env kco) (opt env' bodyco) + where + (env', tcv') = substBndr env tcv + +Just apply the substitution to the kind of the binder, deal with +shadowing etc, and recurse. Remember in (ForAllCo tcv kco bodyco) + varKind tcv = coercionLKind kco + +But if sym=Swapped, things are trickier. Here is an identity that helps: + Sym (ForAllCo (tv:k1) (kco:k1~k2) bodyco) + = ForAllCo (tv:k2) (Sym kco : k2~k1) + (Sym (bodyco[tv:->tv:k2 |> Sym kco])) + +* We re-type tv:k1 to become tv:k2. +* We push Sym into kco +* We push Sym into bodyco +* BUT we must /also/ remember to replace all occurrences of + of tv:k1 in bodyco by (tv:k2 |> Sym kco) + This mirrors what happens in the typing rule for ForAllCo + See Note [ForAllCo] in GHC.Core.TyCo.Rep + +-} optForAllCoBndr :: LiftingContext -> SwapFlag - -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion) -optForAllCoBndr env sym - = substForAllCoBndrUsingLC sym (opt_co4 env sym False Nominal) env + -> TyCoVar -> Coercion + -> (LiftingContext, TyCoVar, Coercion) +-- See Note [Optimising ForAllCo] +optForAllCoBndr env sym tcv kco + = (env', tcv', kco') + where + kco' = opt_co4 env sym False Nominal kco -- Push sym into kco + (env', tcv') = updateLCSubst env upd_subst + + upd_subst :: Subst -> (Subst, TyCoVar) + upd_subst subst + | isTyVar tcv = upd_subst_tv subst + | otherwise = upd_subst_cv subst + + upd_subst_tv subst + | notSwapped sym || isReflCo kco' = (subst1, tv1) + | otherwise = (subst2, tv2) + where + -- subst1,tv1: apply the substitution to the binder and its kind + -- NB: varKind tv = coercionLKind kco + (subst1, tv1) = substTyVarBndr subst tcv + -- In the Swapped case, we re-kind the type variable, AND + -- override the substitution for the original variable to the + -- re-kinded one, suitably casted + tv2 = tv1 `setTyVarKind` coercionLKind kco' + subst2 = (extendTvSubst subst1 tcv (mkTyVarTy tv2 `CastTy` kco')) + `extendSubstInScope` tv2 + + upd_subst_cv subst -- ToDo: probably not right yet + | notSwapped sym || isReflCo kco' = (subst1, cv1) + | otherwise = (subst2, cv2) + where + (subst1, cv1) = substCoVarBndr subst tcv + cv2 = cv1 `setTyVarKind` coercionLKind kco' + subst2 = subst1 `extendSubstInScope` cv2 {- ********************************************************************** diff --git a/GHC/Core/ConLike.hs b/GHC/Core/ConLike.hs --- a/GHC/Core/ConLike.hs +++ b/GHC/Core/ConLike.hs @@ -12,6 +12,7 @@ , conLikeConLikeName , isVanillaConLike , conLikeArity + , conLikeVisArity , conLikeFieldLabels , conLikeConInfo , conLikeInstOrigArgTys @@ -23,7 +24,6 @@ , conLikeFullSig , conLikeResTy , conLikeFieldType - , conLikesWithFields , conLikeIsInfix , conLikeHasBuilder ) where @@ -48,7 +48,6 @@ import Data.Maybe( isJust ) import qualified Data.Data as Data -import qualified Data.List as List {- ************************************************************************ @@ -114,11 +113,16 @@ gunfold _ _ = error "gunfold" dataTypeOf _ = mkNoRepType "ConLike" --- | Number of arguments +-- | Number of value arguments conLikeArity :: ConLike -> Arity conLikeArity (RealDataCon data_con) = dataConSourceArity data_con conLikeArity (PatSynCon pat_syn) = patSynArity pat_syn +-- | Number of visible arguments +conLikeVisArity :: ConLike -> VisArity +conLikeVisArity (RealDataCon data_con) = dataConVisArity data_con +conLikeVisArity (PatSynCon pat_syn) = patSynVisArity pat_syn + -- | Names of fields used for selectors conLikeFieldLabels :: ConLike -> [FieldLabel] conLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con @@ -149,10 +153,11 @@ -- followed by the existentially quantified type variables. For data -- constructors, the situation is slightly more complicated—see -- @Note [DataCon user type variable binders]@ in "GHC.Core.DataCon". -conLikeUserTyVarBinders :: ConLike -> [InvisTVBinder] +conLikeUserTyVarBinders :: ConLike -> [TyVarBinder] conLikeUserTyVarBinders (RealDataCon data_con) = dataConUserTyVarBinders data_con conLikeUserTyVarBinders (PatSynCon pat_syn) = + tyVarSpecToBinders $ patSynUnivTyVarBinders pat_syn ++ patSynExTyVarBinders pat_syn -- The order here is because of the order in `GHC.Tc.TyCl.PatSyn`. @@ -230,15 +235,6 @@ conLikeFieldType :: ConLike -> FieldLabelString -> Type conLikeFieldType (PatSynCon ps) label = patSynFieldType ps label conLikeFieldType (RealDataCon dc) label = dataConFieldType dc label - - --- | The ConLikes that have *all* the given fields -conLikesWithFields :: [ConLike] -> [FieldLabelString] - -> ( [ConLike] -- ConLikes containing the fields - , [ConLike] ) -- ConLikes not containing the fields -conLikesWithFields con_likes lbls = List.partition has_flds con_likes - where has_flds dc = all (has_fld dc) lbls - has_fld dc lbl = any (\ fl -> flLabel fl == lbl) (conLikeFieldLabels dc) conLikeIsInfix :: ConLike -> Bool conLikeIsInfix (RealDataCon dc) = dataConIsInfix dc diff --git a/GHC/Core/DataCon.hs b/GHC/Core/DataCon.hs --- a/GHC/Core/DataCon.hs +++ b/GHC/Core/DataCon.hs @@ -12,7 +12,7 @@ -- * Main data types DataCon, DataConRep(..), SrcStrictness(..), SrcUnpackedness(..), - HsSrcBang(..), HsBang(..), HsImplBang(..), + HsSrcBang(..), HsImplBang(..), StrictnessMark(..), ConTag, DataConEnv, @@ -25,7 +25,7 @@ FieldLabel(..), flLabel, FieldLabelString, -- ** Type construction - mkHsSrcBang, mkDataCon, fIRST_TAG, + mkDataCon, fIRST_TAG, -- ** Type deconstruction dataConRepType, dataConInstSig, dataConFullSig, @@ -45,22 +45,24 @@ dataConInstUnivs, dataConFieldLabels, dataConFieldType, dataConFieldType_maybe, dataConSrcBangs, - dataConSourceArity, dataConRepArity, + dataConSourceArity, dataConVisArity, dataConRepArity, dataConIsInfix, dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitTyThings, - dataConRepStrictness, dataConImplBangs, dataConBoxer, + dataConRepStrictness, + dataConImplBangs, dataConBoxer, splitDataProductType_maybe, -- ** Predicates on DataCons isNullarySrcDataCon, isNullaryRepDataCon, + isLazyDataConRep, isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, - isUnboxedSumDataCon, isCovertGadtDataCon, + isUnboxedSumDataCon, isCovertGadtDataCon, isUnaryClassDataCon, isVanillaDataCon, isNewDataCon, isTypeDataCon, classDataCon, dataConCannotMatch, - dataConUserTyVarsNeedWrapper, checkDataConTyVars, - isBanged, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, + dataConUserTyVarBindersNeedWrapper, checkDataConTyVars, + isBanged, isUnpacked, isMarkedStrict, cbvFromStrictMark, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, -- ** Promotion related functions @@ -78,7 +80,7 @@ import GHC.Core.Unify import GHC.Core.TyCon import GHC.Core.TyCo.Subst -import GHC.Core.TyCo.Compare( eqType ) +import GHC.Core.TyCo.Compare( eqType, eqForAllVis ) import GHC.Core.Multiplicity import {-# SOURCE #-} GHC.Types.TyThing import GHC.Types.FieldLabel @@ -110,6 +112,7 @@ import qualified Data.Data as Data import Data.Char import Data.List( find ) +import Control.DeepSeq {- Note [Data constructor representation] @@ -460,7 +463,7 @@ -- with the set of dcUnivTyVars whose tyvars do not appear in dcEqSpec -- So dcUserTyVarBinders is a subset of (dcUnivTyVars ++ dcExTyCoVars) -- See Note [DataCon user type variable binders] - dcUserTyVarBinders :: [InvisTVBinder], + dcUserTyVarBinders :: [TyVarBinder], dcEqSpec :: [EqSpec], -- Equalities derived from the result type, -- _as written by the programmer_. @@ -519,6 +522,18 @@ -- Matches 1-1 with dcOrigArgTys -- Hence length = dataConSourceArity dataCon + dcImplBangs :: [HsImplBang], + -- The actual decisions made (including failures) + -- about the original arguments; 1-1 with orig_arg_tys + -- See Note [Bangs on data constructor arguments] + + dcStricts :: [StrictnessMark], + -- One mark for every field of the DataCon worker; + -- if it's empty, then all fields are lazy, + -- otherwise 1-1 with dataConRepArgTys. + -- See also Note [Strict fields in Core] in GHC.Core + -- for the effect on the strictness signature + dcFields :: [FieldLabel], -- Field labels for this constructor, in the -- same order as the dcOrigArgTys; @@ -565,22 +580,8 @@ } -{- Note [TyVarBinders in DataCons] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For the TyVarBinders in a DataCon and PatSyn, -each argument flag is either Inferred or Specified, never Required. -Lifting this restriction is tracked at #18389 (DataCon) and #23704 (PatSyn). - -Why do we need the TyVarBinders, rather than just the TyVars? So that -we can construct the right type for the DataCon with its foralls -attributed the correct visibility. That in turn governs whether you -can use visible type application at a call of the data constructor. - -See also [DataCon user type variable binders] for an extended discussion on the -order in which TyVarBinders appear in a DataCon. - -Note [Existential coercion variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Existential coercion variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For now (Aug 2018) we can't write coercion quantifications in source Haskell, but we can in Core. Consider having: @@ -641,25 +642,42 @@ A DataCon has two different sets of type variables: * dcUserTyVarBinders, for the type variables binders in the order in which they - originally arose in the user-written type signature. + originally arose in the user-written type signature, and with user-specified + visibilities. - They are the forall'd binders of the data con /wrapper/, which the user calls. - - Their order *does* matter for TypeApplications, so they are full TyVarBinders, - complete with visibilities. + - With RequiredTypeArguments, some of the foralls may be visible, e.g. + MkT :: forall a b. forall c -> (a, b, c) -> T a b c + so the binders are full TyVarBinders, complete with visibilities. + - Even if we only consider invisible foralls, the order and specificity of + binders matter for TypeApplications. + * dcUnivTyVars and dcExTyCoVars, for the "true underlying" (i.e. of the data con worker) universal type variable and existential type/coercion variables, respectively. - They (i.e. univ ++ ex) are the forall'd variables of the data con /worker/ - - Their order is irrelevant for the purposes of TypeApplications, - and as a consequence, they do not come equipped with visibilities - (that is, they are TyVars/TyCoVars instead of ForAllTyBinders). + - They do not come equipped with visibilities: + dcUnivTyVars :: [TyVar] -- not [TyVarBinder] + dcExTyCoVars :: [TyCoVar] -- not [ForAllTyBinder] + Instead, we treat them as having the Specified (coreTyLamForAllTyFlag) + visibility. For example: + wrapper type: forall {a} b. forall c -> ... + worker type: forall a b c. ... + This is a design choice. Reasons: + * Workers are never called by the user. They are part of the Core + language where visibilities don't matter as much. + * Consistency with type lambdas in Core. As Note [Required foralls in Core] + in GHC.Core.TyCo.Rep explains, (/\a. e) :: (forall a. e_ty), and we need + a coercion to cast it to (forall a -> e_ty). + As a consequence, we may need to adjust visibilities with a cast in the + wrapper. See Note [Flag cast in data con wrappers]. -Often (dcUnivTyVars ++ dcExTyCoVars) = dcUserTyVarBinders; but they may differ -for two reasons, coming next: +Often (dcUnivTyVars ++ dcExTyCoVars) = binderVars dcUserTyVarBinders; but they +may differ for two reasons, coming next: --- Reason (R1): Order of quantification in GADT syntax --- @@ -821,13 +839,6 @@ -- after unboxing and flattening, -- and *including* all evidence args - , dcr_stricts :: [StrictnessMark] -- 1-1 with dcr_arg_tys - -- See also Note [Data-con worker strictness] - - , dcr_bangs :: [HsImplBang] -- The actual decisions made (including failures) - -- about the original arguments; 1-1 with orig_arg_tys - -- See Note [Bangs on data constructor arguments] - } type DataConEnv a = UniqFM DataCon a -- Keyed by DataCon @@ -839,14 +850,16 @@ -- Bangs on data constructor arguments as written by the user, including the -- source code for exact-printing. -- --- In the AST, the SourceText is deconstructed and hidden inside --- 'Language.Haskell.Syntax.Extension.XBangTy' extension point. +-- @(HsSrcBang _ SrcUnpack SrcLazy)@ and +-- @(HsSrcBang _ SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we +-- emit a warning (in checkValidDataCon) and treat it like +-- @(HsSrcBang _ NoSrcUnpack SrcLazy)@ +-- +-- In the AST, the @SourceText@ is hidden inside the extension point +-- 'Language.Haskell.Syntax.Extension.XConDeclField'. data HsSrcBang - = HsSrcBang SourceText HsBang -- See Note [Pragma source text] in "GHC.Types.SourceText" - --- | Make a 'HsSrcBang' from all parts -mkHsSrcBang :: SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang -mkHsSrcBang stext u s = HsSrcBang stext (HsBang u s) + = HsSrcBang SourceText SrcUnpackedness SrcStrictness -- See Note [Pragma source text] in "GHC.Types.SourceText" + deriving Data.Data -- | Haskell Implementation Bang -- @@ -889,49 +902,14 @@ eqSpecPair (EqSpec tv ty) = (tv, ty) eqSpecPreds :: [EqSpec] -> ThetaType -eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty +eqSpecPreds spec = [ mkNomEqPred (mkTyVarTy tv) ty | EqSpec tv ty <- spec ] instance Outputable EqSpec where ppr (EqSpec tv ty) = ppr (tv, ty) -{- Note [Data-con worker strictness] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Notice that we do *not* say the worker Id is strict even if the data -constructor is declared strict - e.g. data T = MkT ![Int] Bool -Even though most often the evals are done by the *wrapper* $WMkT, there are -situations in which tag inference will re-insert evals around the worker. -So for all intents and purposes the *worker* MkT is strict, too! - -Unfortunately, if we exposed accurate strictness of DataCon workers, we'd -see the following transformation: - - f xs = case xs of xs' { __DEFAULT -> ... case MkT xs b of x { __DEFAULT -> [x] } } -- DmdAnal: Strict in xs - ==> { drop-seq, binder swap on xs' } - f xs = case MkT xs b of x { __DEFAULT -> [x] } -- DmdAnal: Still strict in xs - ==> { case-to-let } - f xs = let x = MkT xs' b in [x] -- DmdAnal: No longer strict in xs! - -I.e., we are ironically losing strictness in `xs` by dropping the eval on `xs` -and then doing case-to-let. The issue is that `exprIsHNF` currently says that -every DataCon worker app is a value. The implicit assumption is that surrounding -evals will have evaluated strict fields like `xs` before! But now that we had -just dropped the eval on `xs`, that assumption is no longer valid. - -Long story short: By keeping the demand signature lazy, the Simplifier will not -drop the eval on `xs` and using `exprIsHNF` to decide case-to-let and others -remains sound. - -Similarly, during demand analysis in dmdTransformDataConSig, we bump up the -field demand with `C_01`, *not* `C_11`, because the latter exposes too much -strictness that will drop the eval on `xs` above. - -This issue is discussed at length in -"Failed idea: no wrappers for strict data constructors" in #21497 and #22475. - -Note [Bangs on data constructor arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Bangs on data constructor arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data T = MkT !Int {-# UNPACK #-} !Int Bool @@ -957,8 +935,8 @@ the flag settings in the importing module. Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make -* The dcr_bangs field of the dcRep field records the [HsImplBang] - If T was defined in this module, Without -O the dcr_bangs might be +* The dcImplBangs field records the [HsImplBang] + If T was defined in this module, Without -O the dcImplBangs might be [HsStrict _, HsStrict _, HsLazy] With -O it might be [HsStrict _, HsUnpack _, HsLazy] @@ -967,6 +945,20 @@ With -XStrictData it might be [HsStrict _, HsUnpack _, HsStrict _] +* Core passes will often need to know whether the DataCon worker or wrapper in + an application is strict in some (lifted) field or not. This is tracked in the + demand signature attached to a DataCon's worker resp. wrapper Id. + + So if you've got a DataCon dc, you can get the demand signature by + `idDmdSig (dataConWorkId dc)` and make out strict args by testing with + `isStrictDmd`. Similarly, `idDmdSig <$> dataConWrapId_maybe dc` gives + you the demand signature of the wrapper, if it exists. + + These demand signatures are set in GHC.Types.Id.Make.mkDataConWorkId, + computed from the single source of truth `dataConRepStrictness`, which is + generated from `dcStricts`. + Note that `dataConRepStrictness` lines up 1-1 with `idDmdSig (dataConWorkId dc)`. + Note [Detecting useless UNPACK pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want to issue a warning when there's an UNPACK pragma in the source code, @@ -1002,7 +994,6 @@ The boolean flag is used only for this warning. See #11270 for motivation. - ************************************************************************ * * \subsection{Instances} @@ -1034,10 +1025,7 @@ dataTypeOf _ = mkNoRepType "DataCon" instance Outputable HsSrcBang where - ppr (HsSrcBang _source_text bang) = ppr bang - -instance Outputable HsBang where - ppr (HsBang prag mark) = ppr prag <+> ppr mark + ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark instance Outputable HsImplBang where ppr HsLazy = text "Lazy" @@ -1093,6 +1081,16 @@ 1 -> return SrcUnpack _ -> return NoSrcUnpack +instance NFData SrcStrictness where + rnf SrcLazy = () + rnf SrcStrict = () + rnf NoSrcStrict = () + +instance NFData SrcUnpackedness where + rnf SrcNoUnpack = () + rnf SrcUnpack = () + rnf NoSrcUnpack = () + -- | Compare strictness annotations eqHsBang :: HsImplBang -> HsImplBang -> Bool eqHsBang HsLazy HsLazy = True @@ -1107,6 +1105,11 @@ isBanged (HsStrict {}) = True isBanged HsLazy = False +isUnpacked :: HsImplBang -> Bool +isUnpacked (HsUnpack {}) = True +isUnpacked (HsStrict {}) = False +isUnpacked HsLazy = False + isSrcStrict :: SrcStrictness -> Bool isSrcStrict SrcStrict = True isSrcStrict _ = False @@ -1132,19 +1135,19 @@ -- | Build a new data constructor mkDataCon :: Name - -> Bool -- ^ Is the constructor declared infix? - -> TyConRepName -- ^ TyConRepName for the promoted TyCon - -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user - -> [FieldLabel] -- ^ Field labels for the constructor, - -- if it is a record, otherwise empty - -> [TyVar] -- ^ Universals. - -> [TyCoVar] -- ^ Existentials. + -> Bool -- ^ Is the constructor declared infix? + -> TyConRepName -- ^ TyConRepName for the promoted TyCon + -> [HsSrcBang] -- ^ Strictness/unpack annotations, from user + -> [HsImplBang] -- ^ Strictness/unpack annotations, as inferred by the compiler + -> [StrictnessMark] -- ^ Strictness marks for the DataCon worker's fields in Core + -> [FieldLabel] -- ^ Field labels for the constructor, + -- if it is a record, otherwise empty + -> [TyVar] -- ^ Universals. + -> [TyCoVar] -- ^ Existentials. -> ConcreteTyVars -- ^ TyVars which must be instantiated with -- concrete types - -> [InvisTVBinder] -- ^ User-written 'TyVarBinder's. - -- These must be Inferred/Specified. - -- See @Note [TyVarBinders in DataCons]@ + -> [TyVarBinder] -- ^ User-written 'TyVarBinder's -> [EqSpec] -- ^ GADT equalities -> KnotTied ThetaType -- ^ Theta-type occurring before the arguments proper -> [KnotTied (Scaled Type)] -- ^ Original argument types @@ -1160,7 +1163,9 @@ -- Can get the tag from the TyCon mkDataCon name declared_infix prom_info - arg_stricts -- Must match orig_arg_tys 1-1 + arg_stricts -- Must match orig_arg_tys 1-1 + impl_bangs -- Must match orig_arg_tys 1-1 + str_marks -- Must be empty or match dataConRepArgTys 1-1 fields univ_tvs ex_tvs conc_tvs user_tvbs eq_spec theta @@ -1177,6 +1182,8 @@ = con where is_vanilla = null ex_tvs && null eq_spec && null theta + str_marks' | not $ any isMarkedStrict str_marks = [] + | otherwise = str_marks con = MkData {dcName = name, dcUnique = nameUnique name, dcVanilla = is_vanilla, dcInfix = declared_infix, @@ -1189,7 +1196,8 @@ dcStupidTheta = stupid_theta, dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty, dcRepTyCon = rep_tycon, - dcSrcBangs = arg_stricts, + dcSrcBangs = arg_stricts, dcImplBangs = impl_bangs, + dcStricts = str_marks', dcFields = fields, dcTag = tag, dcRepType = rep_ty, dcWorkId = work_id, dcRep = rep, @@ -1218,8 +1226,8 @@ -- Hence using mkScaledFunctionTys. -- See Note [Promoted data constructors] in GHC.Core.TyCon - prom_tv_bndrs = [ mkNamedTyConBinder (Invisible spec) tv - | Bndr tv spec <- user_tvbs ] + prom_tv_bndrs = [ mkNamedTyConBinder vis tv + | Bndr tv vis <- user_tvbs ] fresh_names = freshNames (map getName user_tvbs) -- fresh_names: make sure that the "anonymous" tyvars don't @@ -1316,9 +1324,9 @@ dataConUserTyVars (MkData { dcUserTyVarBinders = tvbs }) = binderVars tvbs -- See Note [DataCon user type variable binders] --- | 'InvisTVBinder's for the type variables of the constructor, in the order the +-- | 'TyVarBinder's for the type variables of the constructor, in the order the -- user wrote them -dataConUserTyVarBinders :: DataCon -> [InvisTVBinder] +dataConUserTyVarBinders :: DataCon -> [TyVarBinder] dataConUserTyVarBinders = dcUserTyVarBinders -- | Dependent (kind-level) equalities in a constructor. @@ -1405,10 +1413,18 @@ dataConSrcBangs :: DataCon -> [HsSrcBang] dataConSrcBangs = dcSrcBangs --- | Source-level arity of the data constructor +-- | Number of value arguments of the data constructor dataConSourceArity :: DataCon -> Arity dataConSourceArity (MkData { dcSourceArity = arity }) = arity +-- | Number of visible arguments of the data constructor +dataConVisArity :: DataCon -> VisArity +dataConVisArity (MkData { dcUserTyVarBinders = tvbs, dcSourceArity = arity }) + = n_of_required_ty_args + n_of_val_args + where + n_of_val_args = arity + n_of_required_ty_args = count isVisibleForAllTyBinder tvbs + -- | Gives the number of value arguments (including zero-width coercions) -- stored by the given `DataCon`'s worker in its Core representation. This may -- differ from the number of arguments that appear in the source code; see also @@ -1432,20 +1448,25 @@ isNullaryRepDataCon :: DataCon -> Bool isNullaryRepDataCon dc = dataConRepArity dc == 0 +isLazyDataConRep :: DataCon -> Bool +-- ^ True <==> All fields are lazy +isLazyDataConRep dc = null (dcStricts dc) + dataConRepStrictness :: DataCon -> [StrictnessMark] --- ^ Give the demands on the arguments of a --- Core constructor application (Con dc args) -dataConRepStrictness dc = case dcRep dc of - NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc] - DCR { dcr_stricts = strs } -> strs +-- ^ Give the demands on the runtime arguments of a Core DataCon worker +-- application. +-- The length of the list matches `dataConRepArgTys` (e.g., the number +-- of runtime arguments). +dataConRepStrictness dc + | isLazyDataConRep dc + = replicate (dataConRepArity dc) NotMarkedStrict + | otherwise + = dcStricts dc dataConImplBangs :: DataCon -> [HsImplBang] -- The implementation decisions about the strictness/unpack of each -- source program argument to the data constructor -dataConImplBangs dc - = case dcRep dc of - NoDataConRep -> replicate (dcSourceArity dc) HsLazy - DCR { dcr_bangs = bangs } -> bangs +dataConImplBangs dc = dcImplBangs dc dataConBoxer :: DataCon -> Maybe DataConBoxer dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer @@ -1562,7 +1583,7 @@ dcOtherTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty, dcStupidTheta = stupid_theta }) - = mkInvisForAllTys user_tvbs $ + = mkForAllTys user_tvbs $ mkInvisFunTys (stupid_theta ++ theta) $ mkScaledFunTys arg_tys $ res_ty @@ -1574,7 +1595,7 @@ dcOtherTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty, dcStupidTheta = stupid_theta }) - = mkInvisForAllTys user_tvbs $ + = mkForAllTys user_tvbs $ mkInvisFunTys (stupid_theta ++ theta) $ mkScaledFunTys arg_tys' $ res_ty @@ -1771,10 +1792,15 @@ && not (isTyVarTy ty) -- See Note [isCovertGadtDataCon] for -- an example where 'ty' is a tyvar +isUnaryClassDataCon :: DataCon -> Bool +isUnaryClassDataCon dc = isUnaryClassTyCon (dataConTyCon dc) + {- Note [isCovertGadtDataCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (isCovertGadtDataCon K) returns True if K is a GADT data constructor, but -does not /look/ like it. Consider (#21447) +does not /look/ like it. It is used only to help in error message printing. + +Consider (#21447) type T :: TYPE r -> Type data T a where { MkT :: b -> T b } Here MkT doesn't look GADT-like, but it is. If we make the kind applications @@ -1892,21 +1918,53 @@ wrapper_vars = dataConUserTyVars dc -dataConUserTyVarsNeedWrapper :: DataCon -> Bool --- Check whether the worker and wapper have the same type variables --- in the same order. If not, we need a wrapper to swizzle them. +dataConUserTyVarBindersNeedWrapper :: DataCon -> Bool +-- Check whether the worker and wrapper have the same type variables +-- in the same order and with the same visibility. If not, we need a +-- wrapper to swizzle them. -- See Note [DataCon user type variable binders], as well as -- Note [Data con wrappers and GADT syntax] for an explanation of what -- mkDataConRep is doing with this function. -dataConUserTyVarsNeedWrapper dc@(MkData { dcUnivTyVars = univ_tvs - , dcExTyCoVars = ex_tvs - , dcEqSpec = eq_spec }) +dataConUserTyVarBindersNeedWrapper (MkData { dcUnivTyVars = univ_tvs + , dcExTyCoVars = ex_tvs + , dcUserTyVarBinders = user_tvbs + , dcEqSpec = eq_spec }) = assert (null eq_spec || answer) -- all GADTs should say "yes" here answer where - answer = (univ_tvs ++ ex_tvs) /= dataConUserTyVars dc - -- Worker tyvars Wrapper tyvars + answer = need_reorder || need_flag_cast + need_reorder = (univ_tvs ++ ex_tvs) /= binderVars user_tvbs + need_flag_cast = any (not . eqForAllVis coreTyLamForAllTyFlag) + (binderFlags user_tvbs) + -- See Note [Flag cast in data con wrappers] +{- Note [Flag cast in data con wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the data declaration + + data G a where + MkG :: forall a -> a -> G a + +The user-facing type of MkG has a 'Required' forall. Workers, on the other hand, +always use 'Specified' foralls (coreTyLamForAllTyFlag). So we need a wrapper: + + wrapper type: forall a -> a -> G a + worker type: forall a. a -> G a + +Concretely, it looks like this: + + $WMkG = /\a. \(x:a). MkG a x |> co + +where 'co' is a coercion constructed by GHC.Core.Coercion.mkForAllVisCos. +The cast is added by the call to mkCoreTyLams in GHC.Types.Id.Make.mkDataConRep. + +In general, wrappers may use 'Inferred', 'Specified', or 'Required' foralls. +However, we do /not/ need a cast to convert 'Inferred' to 'Specified' because they are +'eqType'-equal. Only a 'Required' forall necessitates a cast in the wrapper. + +See Note [ForAllTy and type equality], Note [Comparing visibility], +and Note [Required foralls in Core]. +-} {- %************************************************************************ diff --git a/GHC/Core/DataCon.hs-boot b/GHC/Core/DataCon.hs-boot --- a/GHC/Core/DataCon.hs-boot +++ b/GHC/Core/DataCon.hs-boot @@ -1,7 +1,7 @@ module GHC.Core.DataCon where import GHC.Prelude -import {-# SOURCE #-} GHC.Types.Var( Id, TyVar, TyCoVar, InvisTVBinder ) +import {-# SOURCE #-} GHC.Types.Var( Id, TyVar, TyCoVar, TyVarBinder ) import {-# SOURCE #-} GHC.Types.Name( Name, NamedThing ) import {-# SOURCE #-} GHC.Core.TyCon( TyCon ) import GHC.Types.FieldLabel ( FieldLabel ) @@ -19,7 +19,7 @@ dataConTyCon :: DataCon -> TyCon dataConExTyCoVars :: DataCon -> [TyCoVar] dataConUserTyVars :: DataCon -> [TyVar] -dataConUserTyVarBinders :: DataCon -> [InvisTVBinder] +dataConUserTyVarBinders :: DataCon -> [TyVarBinder] dataConSourceArity :: DataCon -> Arity dataConFieldLabels :: DataCon -> [FieldLabel] dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] diff --git a/GHC/Core/FVs.hs b/GHC/Core/FVs.hs --- a/GHC/Core/FVs.hs +++ b/GHC/Core/FVs.hs @@ -36,7 +36,7 @@ ruleLhsFreeIds, ruleLhsFreeIdsList, ruleRhsFreeVars, rulesRhsFreeIds, - exprFVs, + exprFVs, exprLocalFVs, addBndrFV, addBndrsFV, -- * Orphan names orphNamesOfType, orphNamesOfTypes, orphNamesOfAxiomLHS, @@ -96,23 +96,23 @@ -- | Find all locally-defined free Ids or type variables in an expression -- returning a non-deterministic set. exprFreeVars :: CoreExpr -> VarSet -exprFreeVars = fvVarSet . exprFVs +exprFreeVars = fvVarSet . exprLocalFVs -- | Find all locally-defined free Ids or type variables in an expression -- returning a composable FV computation. See Note [FV naming conventions] in "GHC.Utils.FV" -- for why export it. -exprFVs :: CoreExpr -> FV -exprFVs = filterFV isLocalVar . expr_fvs +exprLocalFVs :: CoreExpr -> FV +exprLocalFVs = filterFV isLocalVar . exprFVs -- | Find all locally-defined free Ids or type variables in an expression -- returning a deterministic set. exprFreeVarsDSet :: CoreExpr -> DVarSet -exprFreeVarsDSet = fvDVarSet . exprFVs +exprFreeVarsDSet = fvDVarSet . exprLocalFVs -- | Find all locally-defined free Ids or type variables in an expression -- returning a deterministically ordered list. exprFreeVarsList :: CoreExpr -> [Var] -exprFreeVarsList = fvVarList . exprFVs +exprFreeVarsList = fvVarList . exprLocalFVs -- | Find all locally-defined free Ids in an expression exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids @@ -144,68 +144,65 @@ -- | Find all locally-defined free Ids or type variables in several expressions -- returning a non-deterministic set. exprsFreeVars :: [CoreExpr] -> VarSet -exprsFreeVars = fvVarSet . exprsFVs +exprsFreeVars = fvVarSet . exprsLocalFVs -- | Find all locally-defined free Ids or type variables in several expressions -- returning a composable FV computation. See Note [FV naming conventions] in "GHC.Utils.FV" -- for why export it. -exprsFVs :: [CoreExpr] -> FV -exprsFVs exprs = mapUnionFV exprFVs exprs +exprsLocalFVs :: [CoreExpr] -> FV +exprsLocalFVs exprs = mapUnionFV exprLocalFVs exprs -- | Find all locally-defined free Ids or type variables in several expressions -- returning a deterministically ordered list. exprsFreeVarsList :: [CoreExpr] -> [Var] -exprsFreeVarsList = fvVarList . exprsFVs +exprsFreeVarsList = fvVarList . exprsLocalFVs -- | Find all locally defined free Ids in a binding group bindFreeVars :: CoreBind -> VarSet bindFreeVars (NonRec b r) = fvVarSet $ filterFV isLocalVar $ rhs_fvs (b,r) bindFreeVars (Rec prs) = fvVarSet $ filterFV isLocalVar $ - addBndrs (map fst prs) + addBndrsFV (map fst prs) (mapUnionFV rhs_fvs prs) -- | Finds free variables in an expression selected by a predicate exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting -> CoreExpr -> VarSet -exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e +exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ exprFVs e -- | Finds free variables in an expression selected by a predicate -- returning a deterministically ordered list. exprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting -> CoreExpr -> [Var] -exprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ expr_fvs e +exprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ exprFVs e -- | Finds free variables in an expression selected by a predicate -- returning a deterministic set. exprSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting -> CoreExpr -> DVarSet -exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ expr_fvs e +exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ exprFVs e -- | Finds free variables in several expressions selected by a predicate exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> VarSet -exprsSomeFreeVars fv_cand es = - fvVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs es +exprsSomeFreeVars fv_cand es = fvVarSet $ filterFV fv_cand $ mapUnionFV exprFVs es -- | Finds free variables in several expressions selected by a predicate -- returning a deterministically ordered list. exprsSomeFreeVarsList :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> [Var] -exprsSomeFreeVarsList fv_cand es = - fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es +exprsSomeFreeVarsList fv_cand es = fvVarList $ filterFV fv_cand $ mapUnionFV exprFVs es -- | Finds free variables in several expressions selected by a predicate -- returning a deterministic set. exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting -> [CoreExpr] -> DVarSet -exprsSomeFreeVarsDSet fv_cand e = - fvDVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs e +exprsSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ mapUnionFV exprFVs e -- Comment about obsolete code -- We used to gather the free variables the RULES at a variable occurrence @@ -235,59 +232,59 @@ -- | otherwise = set -- SLPJ Feb06 -addBndr :: CoreBndr -> FV -> FV -addBndr bndr fv fv_cand in_scope acc +addBndrFV :: CoreBndr -> FV -> FV +addBndrFV bndr fv fv_cand in_scope acc = (varTypeTyCoFVs bndr `unionFV` -- Include type variables in the binder's type -- (not just Ids; coercion variables too!) FV.delFV bndr fv) fv_cand in_scope acc -addBndrs :: [CoreBndr] -> FV -> FV -addBndrs bndrs fv = foldr addBndr fv bndrs +addBndrsFV :: [CoreBndr] -> FV -> FV +addBndrsFV bndrs fv = foldr addBndrFV fv bndrs -expr_fvs :: CoreExpr -> FV -expr_fvs (Type ty) fv_cand in_scope acc = +exprsFVs :: [CoreExpr] -> FV +exprsFVs exprs = mapUnionFV exprFVs exprs + +exprFVs :: CoreExpr -> FV +exprFVs (Type ty) fv_cand in_scope acc = tyCoFVsOfType ty fv_cand in_scope acc -expr_fvs (Coercion co) fv_cand in_scope acc = +exprFVs (Coercion co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc -expr_fvs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc -expr_fvs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc -expr_fvs (Tick t expr) fv_cand in_scope acc = - (tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc -expr_fvs (App fun arg) fv_cand in_scope acc = - (expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc -expr_fvs (Lam bndr body) fv_cand in_scope acc = - addBndr bndr (expr_fvs body) fv_cand in_scope acc -expr_fvs (Cast expr co) fv_cand in_scope acc = - (expr_fvs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc +exprFVs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc +exprFVs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc +exprFVs (Tick t expr) fv_cand in_scope acc = + (tickish_fvs t `unionFV` exprFVs expr) fv_cand in_scope acc +exprFVs (App fun arg) fv_cand in_scope acc = + (exprFVs fun `unionFV` exprFVs arg) fv_cand in_scope acc +exprFVs (Lam bndr body) fv_cand in_scope acc = + addBndrFV bndr (exprFVs body) fv_cand in_scope acc +exprFVs (Cast expr co) fv_cand in_scope acc = + (exprFVs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc -expr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc - = (expr_fvs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndr bndr +exprFVs (Case scrut bndr ty alts) fv_cand in_scope acc + = (exprFVs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndrFV bndr (mapUnionFV alt_fvs alts)) fv_cand in_scope acc where - alt_fvs (Alt _ bndrs rhs) = addBndrs bndrs (expr_fvs rhs) + alt_fvs (Alt _ bndrs rhs) = addBndrsFV bndrs (exprFVs rhs) -expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc - = (rhs_fvs (bndr, rhs) `unionFV` addBndr bndr (expr_fvs body)) +exprFVs (Let (NonRec bndr rhs) body) fv_cand in_scope acc + = (rhs_fvs (bndr, rhs) `unionFV` addBndrFV bndr (exprFVs body)) fv_cand in_scope acc -expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc - = addBndrs (map fst pairs) - (mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body) +exprFVs (Let (Rec pairs) body) fv_cand in_scope acc + = addBndrsFV (map fst pairs) + (mapUnionFV rhs_fvs pairs `unionFV` exprFVs body) fv_cand in_scope acc --------- rhs_fvs :: (Id, CoreExpr) -> FV -rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV` +rhs_fvs (bndr, rhs) = exprFVs rhs `unionFV` bndrRuleAndUnfoldingFVs bndr -- Treat any RULES as extra RHSs of the binding --------- -exprs_fvs :: [CoreExpr] -> FV -exprs_fvs exprs = mapUnionFV expr_fvs exprs - tickish_fvs :: CoreTickish -> FV -tickish_fvs (Breakpoint _ _ ids _) = FV.mkFVs ids +tickish_fvs (Breakpoint _ _ ids) = FV.mkFVs ids tickish_fvs _ = emptyFV {- ********************************************************************** @@ -434,7 +431,7 @@ -- See Note [Rule free var hack] , ru_bndrs = bndrs , ru_rhs = rhs, ru_args = args }) - = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs exprs) + = filterFV isLocalVar $ addBndrsFV bndrs (exprsFVs exprs) where exprs = case from of LhsOnly -> args @@ -653,9 +650,9 @@ = case unf of CoreUnfolding { uf_tmpl = rhs, uf_src = src } | isStableSource src - -> Just (filterFV isLocalVar $ expr_fvs rhs) + -> Just (exprLocalFVs rhs) DFunUnfolding { df_bndrs = bndrs, df_args = args } - -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprs_fvs args) + -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprsFVs args) -- DFuns are top level, so no fvs from types of bndrs _other -> Nothing @@ -702,7 +699,7 @@ | isLocalVar v = (aFreeVar v `unionFVs` ty_fvs `unionFVs` mult_vars, AnnVar v) | otherwise = (emptyDVarSet, AnnVar v) where - mult_vars = tyCoVarsOfTypeDSet (varMult v) + mult_vars = tyCoVarsOfTypeDSet (idMult v) ty_fvs = dVarTypeTyCoVars v -- See Note [The FVAnn invariant] @@ -759,8 +756,8 @@ , AnnTick tickish expr2 ) where expr2 = go expr - tickishFVs (Breakpoint _ _ ids _) = mkDVarSet ids - tickishFVs _ = emptyDVarSet + tickishFVs (Breakpoint _ _ ids) = mkDVarSet ids + tickishFVs _ = emptyDVarSet go (Type ty) = (tyCoVarsOfTypeDSet ty, AnnType ty) go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co) diff --git a/GHC/Core/FamInstEnv.hs b/GHC/Core/FamInstEnv.hs --- a/GHC/Core/FamInstEnv.hs +++ b/GHC/Core/FamInstEnv.hs @@ -42,6 +42,7 @@ import GHC.Core.Unify import GHC.Core.Type as Type import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.Tidy import GHC.Core.TyCo.Compare( eqType, eqTypes ) import GHC.Core.TyCon import GHC.Core.Coercion @@ -247,10 +248,10 @@ ppr_tc_sort = case flavor of SynFamilyInst -> text "type" DataFamilyInst tycon - | isDataTyCon tycon -> text "data" - | isNewTyCon tycon -> text "newtype" - | isAbstractTyCon tycon -> text "data" - | otherwise -> text "WEIRD" <+> ppr tycon + | isBoxedDataTyCon tycon -> text "data" + | isNewTyCon tycon -> text "newtype" + | isAbstractTyCon tycon -> text "data" + | otherwise -> text "WEIRD" <+> ppr tycon debug_stuff = vcat [ text "Coercion axiom:" <+> ppr ax , text "Tvs:" <+> ppr tvs @@ -487,8 +488,8 @@ apart(target, pattern) = not (unify(flatten(target), pattern)) where flatten (implemented in flattenTys, below) converts all type-family -applications into fresh variables. (See -Note [Flattening type-family applications when matching instances] in GHC.Core.Unify.) +applications into fresh variables. (See Note [Apartness and type families] +in GHC.Core.Unify.) Note [Compatibility] ~~~~~~~~~~~~~~~~~~~~ @@ -512,11 +513,11 @@ only when we can be sure that 'a' is not Int. To achieve this, after finding a possible match within the equations, we have to -go back to all previous equations and check that, under the -substitution induced by the match, other branches are surely apart. (See -Note [Apartness].) This is similar to what happens with class -instance selection, when we need to guarantee that there is only a match and -no unifiers. The exact algorithm is different here because the +go back to all previous equations and check that, under the substitution induced +by the match, other branches are surely apart, using `tcUnifyTysFG`. (See +Note [Apartness and type families] in GHC.Core.Unify.) This is similar to what +happens with class instance selection, when we need to guarantee that there is +only a match and no unifiers. The exact algorithm is different here because the potentially-overlapping group is closed. As another example, consider this: @@ -579,7 +580,7 @@ compatibleBranches :: CoAxBranch -> CoAxBranch -> Bool compatibleBranches (CoAxBranch { cab_lhs = lhs1, cab_rhs = rhs1 }) (CoAxBranch { cab_lhs = lhs2, cab_rhs = rhs2 }) - = case tcUnifyTysFG alwaysBindFun commonlhs1 commonlhs2 of + = case tcUnifyTysFG alwaysBindFam alwaysBindTv commonlhs1 commonlhs2 of -- Here we need the cab_tvs of the two branches to be disinct. -- See Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom. SurelyApart -> True @@ -610,7 +611,8 @@ -- See Note [Verifying injectivity annotation], case 1. = let getInjArgs = filterByList injectivity in_scope = mkInScopeSetList (tvs1 ++ tvs2) - in case tcUnifyTyWithTFs True in_scope rhs1 rhs2 of -- True = two-way pre-unification + in case tcUnifyTyForInjectivity True in_scope rhs1 rhs2 of + -- True = two-way pre-unification Nothing -> InjectivityAccepted -- RHS are different, so equations are injective. -- This is case 1A from Note [Verifying injectivity annotation] @@ -1228,22 +1230,16 @@ -> Maybe (BranchIndex, [Type], [Coercion]) go (index, branch) other = let (CoAxBranch { cab_tvs = tpl_tvs, cab_cvs = tpl_cvs - , cab_lhs = tpl_lhs - , cab_incomps = incomps }) = branch - in_scope = mkInScopeSet (unionVarSets $ - map (tyCoVarsOfTypes . coAxBranchLHS) incomps) - -- See Note [Flattening type-family applications when matching instances] - -- in GHC.Core.Unify - flattened_target = flattenTys in_scope target_tys + , cab_lhs = tpl_lhs }) = branch in case tcMatchTys tpl_lhs target_tys of - Just subst -- matching worked. now, check for apartness. - | apartnessCheck flattened_target branch - -> -- matching worked & we're apart from all incompatible branches. + Just subst -- Matching worked. now, check for apartness. + | apartnessCheck target_tys branch + -> -- Matching worked & we're apart from all incompatible branches. -- success assert (all (isJust . lookupCoVar subst) tpl_cvs) $ Just (index, substTyVars subst tpl_tvs, substCoVars subst tpl_cvs) - -- failure. keep looking + -- Failure. keep looking _ -> other -- | Do an apartness check, as described in the "Closed Type Families" paper @@ -1251,15 +1247,12 @@ -- ('CoAxBranch') of a closed type family can be used to reduce a certain target -- type family application. apartnessCheck :: [Type] - -- ^ /flattened/ target arguments. Make sure they're flattened! See - -- Note [Flattening type-family applications when matching instances] - -- in GHC.Core.Unify. - -> CoAxBranch -- ^ the candidate equation we wish to use + -> CoAxBranch -- ^ The candidate equation we wish to use -- Precondition: this matches the target -> Bool -- ^ True <=> equation can fire -apartnessCheck flattened_target (CoAxBranch { cab_incomps = incomps }) +apartnessCheck target (CoAxBranch { cab_incomps = incomps }) = all (isSurelyApart - . tcUnifyTysFG alwaysBindFun flattened_target + . tcUnifyTysFG alwaysBindFam alwaysBindTv target . coAxBranchLHS) incomps where isSurelyApart SurelyApart = True @@ -1343,7 +1336,7 @@ -- * newtypes -- returning an appropriate Representational coercion. Specifically, if -- topNormaliseType_maybe env ty = Just (co, ty') --- then +-- then postconditions: -- (a) co :: ty ~R ty' -- (b) ty' is not a newtype, and is not a type-family or data-family redex -- diff --git a/GHC/Core/InstEnv.hs b/GHC/Core/InstEnv.hs --- a/GHC/Core/InstEnv.hs +++ b/GHC/Core/InstEnv.hs @@ -174,7 +174,7 @@ Reason for freshness: we use unification when checking for overlap etc, and that requires the tyvars to be distinct. -The invariant is checked by the ASSERT in lookupInstEnv'. +The invariant is checked by the ASSERT in instEnvMatchesAndUnifiers. Note [Proper-match fields] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -947,11 +947,8 @@ * That info is recorded in the `cir_is_coherent` field of `OneInst`, and thence transferred to the `ep_is_coherent` field of the `EvBind` for the dictionary. -* `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into - (nospec f d) if `d` is incoherent. It has to do a dependency analysis to - determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. - +* In the desugarer we exploit this info: + see Note [Desugaring non-canonical evidence] in GHC.HsToCore.Expr. See also Note [nospecId magic] in GHC.Types.Id.Make. @@ -1247,10 +1244,14 @@ -- Unification will break badly if the variables overlap -- They shouldn't because we allocate separate uniques for them -- See Note [Template tyvars are fresh] - case tcUnifyTysFG instanceBindFun tpl_tys tys of + case tcUnifyTysFG alwaysBindFam instanceBindFun tpl_tys tys of + -- alwaysBindFam: the family-application can't be in the instance head, + -- but it certainly can be in the Wanted constraint we are matching! + -- -- We consider MaybeApart to be a case where the instance might -- apply in the future. This covers an instance like C Int and -- a target like [W] C (F a), where F is a type family. + -- See (ATF1) in Note [Apartness and type families] in GHC.Core.Unify SurelyApart -> check_unifiers items -- See Note [Infinitary substitution in lookup] MaybeApart MARInfinite _ -> check_unifiers items @@ -1670,14 +1671,14 @@ ************************************************************************ -} -instanceBindFun :: BindFun -instanceBindFun tv _rhs_ty | isOverlappableTyVar tv = Apart +instanceBindFun :: BindTvFun +instanceBindFun tv _rhs_ty | isOverlappableTyVar tv = DontBindMe | otherwise = BindMe - -- Note [Binding when looking up instances] + -- Note [Super skolems: binding when looking up instances] {- -Note [Binding when looking up instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Super skolems: binding when looking up instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When looking up in the instance environment, or family-instance environment, we are careful about multiple matches, as described above in Note [Overlapping instances] @@ -1693,9 +1694,9 @@ f :: T -> Int f (MkT x) = op [x,x] The op [x,x] means we need (Foo [a]). This `a` will never be instantiated, and -so it is a super skolem. (See the use of tcInstSuperSkolTyVarsX in +so it is a "super skolem". (See the use of tcInstSuperSkolTyVarsX in GHC.Tc.Gen.Pat.tcDataConPat.) Super skolems respond True to -isOverlappableTyVar, and the use of Apart in instanceBindFun, above, means +isOverlappableTyVar, and the use of DontBindMe in instanceBindFun, above, means that these will be treated as fresh constants in the unification algorithm during instance lookup. Without this treatment, GHC would complain, saying that the choice of instance depended on the instantiation of 'a'; but of diff --git a/GHC/Core/LateCC/OverloadedCalls.hs b/GHC/Core/LateCC/OverloadedCalls.hs --- a/GHC/Core/LateCC/OverloadedCalls.hs +++ b/GHC/Core/LateCC/OverloadedCalls.hs @@ -25,7 +25,6 @@ import GHC.Types.SrcLoc import GHC.Types.Tickish import GHC.Types.Var -import GHC.Utils.Outputable type OverloadedCallsCCState = Strict.Maybe SrcSpan @@ -103,7 +102,7 @@ -- check if any of the arguments v1 ... vN are dictionaries. let (f, xs) = collectArgs app - resultTy = applyTypeToArgs empty (exprType f) xs + resultTy = applyTypeToArgs (exprType f) xs -- Recursively process the arguments first for no particular reason args <- mapM processExpr xs diff --git a/GHC/Core/LateCC/TopLevelBinds.hs b/GHC/Core/LateCC/TopLevelBinds.hs --- a/GHC/Core/LateCC/TopLevelBinds.hs +++ b/GHC/Core/LateCC/TopLevelBinds.hs diff --git a/GHC/Core/Lint.hs b/GHC/Core/Lint.hs --- a/GHC/Core/Lint.hs +++ b/GHC/Core/Lint.hs @@ -82,3780 +82,3860 @@ import GHC.Builtin.Names import GHC.Builtin.Types.Prim -import GHC.Builtin.Types ( multiplicityTy ) - -import GHC.Data.Bag -import GHC.Data.List.SetOps - -import GHC.Utils.Monad -import GHC.Utils.Outputable as Outputable -import GHC.Utils.Panic -import GHC.Utils.Constants (debugIsOn) -import GHC.Utils.Misc -import GHC.Utils.Error -import qualified GHC.Utils.Error as Err -import GHC.Utils.Logger - -import Control.Monad -import Data.Foldable ( for_, toList ) -import Data.List.NonEmpty ( NonEmpty(..), groupWith ) -import Data.List ( partition ) -import Data.Maybe -import Data.IntMap.Strict ( IntMap ) -import qualified Data.IntMap.Strict as IntMap ( lookup, keys, empty, fromList ) -import GHC.Data.Pair -import GHC.Base (oneShot) -import GHC.Data.Unboxed - -{- -Note [Core Lint guarantee] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -Core Lint is the type-checker for Core. Using it, we get the following guarantee: - -If all of: -1. Core Lint passes, -2. there are no unsafe coercions (i.e. unsafeEqualityProof), -3. all plugin-supplied coercions (i.e. PluginProv) are valid, and -4. all case-matches are complete -then running the compiled program will not seg-fault, assuming no bugs downstream -(e.g. in the code generator). This guarantee is quite powerful, in that it allows us -to decouple the safety of the resulting program from the type inference algorithm. - -However, do note point (4) above. Core Lint does not check for incomplete case-matches; -see Note [Case expression invariants] in GHC.Core, invariant (4). As explained there, -an incomplete case-match might slip by Core Lint and cause trouble at runtime. - -Note [GHC Formalism] -~~~~~~~~~~~~~~~~~~~~ -This file implements the type-checking algorithm for System FC, the "official" -name of the Core language. Type safety of FC is heart of the claim that -executables produced by GHC do not have segmentation faults. Thus, it is -useful to be able to reason about System FC independently of reading the code. -To this purpose, there is a document core-spec.pdf built in docs/core-spec that -contains a formalism of the types and functions dealt with here. If you change -just about anything in this file or you change other types/functions throughout -the Core language (all signposted to this note), you should update that -formalism. See docs/core-spec/README for more info about how to do so. - -Note [check vs lint] -~~~~~~~~~~~~~~~~~~~~ -This file implements both a type checking algorithm and also general sanity -checking. For example, the "sanity checking" checks for TyConApp on the left -of an AppTy, which should never happen. These sanity checks don't really -affect any notion of type soundness. Yet, it is convenient to do the sanity -checks at the same time as the type checks. So, we use the following naming -convention: - -- Functions that begin with 'lint'... are involved in type checking. These - functions might also do some sanity checking. - -- Functions that begin with 'check'... are *not* involved in type checking. - They exist only for sanity checking. - -Issues surrounding variable naming, shadowing, and such are considered *not* -to be part of type checking, as the formalism omits these details. - -Summary of checks -~~~~~~~~~~~~~~~~~ -Checks that a set of core bindings is well-formed. The PprStyle and String -just control what we print in the event of an error. The Bool value -indicates whether we have done any specialisation yet (in which case we do -some extra checks). - -We check for - (a) type errors - (b) Out-of-scope type variables - (c) Out-of-scope local variables - (d) Ill-kinded types - (e) Incorrect unsafe coercions - -If we have done specialisation the we check that there are - (a) No top-level bindings of primitive (unboxed type) - -Note [Linting function types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -All saturated applications of funTyCon are represented with the FunTy constructor. -See Note [Function type constructors and FunTy] in GHC.Builtin.Types.Prim - - We check this invariant in lintType. - -Note [Linting type lets] -~~~~~~~~~~~~~~~~~~~~~~~~ -In the desugarer, it's very very convenient to be able to say (in effect) - let a = Type Bool in - let x::a = True in -That is, use a type let. See Note [Core type and coercion invariant] in "GHC.Core". -One place it is used is in mkWwBodies; see Note [Join points and beta-redexes] -in GHC.Core.Opt.WorkWrap.Utils. (Maybe there are other "clients" of this feature; I'm not sure). - -* Hence when linting we need to remember that a=Int, else we - might reject a correct program. So we carry a type substitution (in - this example [a -> Bool]) and apply this substitution before - comparing types. In effect, in Lint, type equality is always - equality-modulo-le-subst. This is in the le_subst field of - LintEnv. But nota bene: - - (SI1) The le_subst substitution is applied to types and coercions only - - (SI2) The result of that substitution is used only to check for type - equality, to check well-typed-ness, /but is then discarded/. - The result of substitution does not outlive the CoreLint pass. - - (SI3) The InScopeSet of le_subst includes only TyVar and CoVar binders. - -* The function - lintInTy :: Type -> LintM (Type, Kind) - returns a substituted type. - -* When we encounter a binder (like x::a) we must apply the substitution - to the type of the binding variable. lintBinders does this. - -* Clearly we need to clone tyvar binders as we go. - -* But take care (#17590)! We must also clone CoVar binders: - let a = TYPE (ty |> cv) - in \cv -> blah - blindly substituting for `a` might capture `cv`. - -* Alas, when cloning a coercion variable we might choose a unique - that happens to clash with an inner Id, thus - \cv_66 -> let wild_X7 = blah in blah - We decide to clone `cv_66` because it's already in scope. Fine, - choose a new unique. Aha, X7 looks good. So we check the lambda - body with le_subst of [cv_66 :-> cv_X7] - - This is all fine, even though we use the same unique as wild_X7. - As (SI2) says, we do /not/ return a new lambda - (\cv_X7 -> let wild_X7 = blah in ...) - We simply use the le_subst substitution in types/coercions only, when - checking for equality. - -* We still need to check that Id occurrences are bound by some - enclosing binding. We do /not/ use the InScopeSet for the le_subst - for this purpose -- it contains only TyCoVars. Instead we have a separate - le_ids for the in-scope Id binders. - -Sigh. We might want to explore getting rid of type-let! - -Note [Bad unsafe coercion] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -For discussion see https://gitlab.haskell.org/ghc/ghc/wikis/bad-unsafe-coercions -Linter introduces additional rules that checks improper coercion between -different types, called bad coercions. Following coercions are forbidden: - - (a) coercions between boxed and unboxed values; - (b) coercions between unlifted values of the different sizes, here - active size is checked, i.e. size of the actual value but not - the space allocated for value; - (c) coercions between floating and integral boxed values, this check - is not yet supported for unboxed tuples, as no semantics were - specified for that; - (d) coercions from / to vector type - (e) If types are unboxed tuples then tuple (# A_1,..,A_n #) can be - coerced to (# B_1,..,B_m #) if n=m and for each pair A_i, B_i rules - (a-e) holds. - -Note [Join points] -~~~~~~~~~~~~~~~~~~ -We check the rules listed in Note [Invariants on join points] in GHC.Core. The -only one that causes any difficulty is the first: All occurrences must be tail -calls. To this end, along with the in-scope set, we remember in le_joins the -subset of in-scope Ids that are valid join ids. For example: - - join j x = ... in - case e of - A -> jump j y -- good - B -> case (jump j z) of -- BAD - C -> join h = jump j w in ... -- good - D -> let x = jump j v in ... -- BAD - -A join point remains valid in case branches, so when checking the A -branch, j is still valid. When we check the scrutinee of the inner -case, however, we set le_joins to empty, and catch the -error. Similarly, join points can occur free in RHSes of other join -points but not the RHSes of value bindings (thunks and functions). - -Note [Avoiding compiler perf traps when constructing error messages.] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's quite common to put error messages into a where clause when it might -be triggered by multiple branches. E.g. - - checkThing x y z = - case x of - X -> unless (correctX x) $ failWithL errMsg - Y -> unless (correctY y) $ failWithL errMsg - where - errMsg = text "My error involving:" $$ ppr x <+> ppr y - -However ghc will compile this to: - - checkThink x y z = - let errMsg = text "My error involving:" $$ ppr x <+> ppr y - in case x of - X -> unless (correctX x) $ failWithL errMsg - Y -> unless (correctY y) $ failWithL errMsg - -Putting the allocation of errMsg into the common non-error path. -One way to work around this is to turn errMsg into a function: - - checkThink x y z = - case x of - X -> unless (correctX x) $ failWithL (errMsg x y) - Y -> unless (correctY y) $ failWithL (errMsg x y) - where - errMsg x y = text "My error involving:" $$ ppr x <+> ppr y - -This way `errMsg` is a static function and it being defined in the common -path does not result in allocation in the hot path. This can be surprisingly -impactful. Changing `lint_app` reduced allocations for one test program I was -looking at by ~4%. - -Note [MCInfo for Lint] -~~~~~~~~~~~~~~~~~~~~~~ -When printing a Lint message, use the MCInfo severity so that the -message is printed on stderr rather than stdout (#13342). - -************************************************************************ -* * - Beginning and ending passes -* * -************************************************************************ --} - --- | Configuration for boilerplate operations at the end of a --- compilation pass producing Core. -data EndPassConfig = EndPassConfig - { ep_dumpCoreSizes :: !Bool - -- ^ Whether core bindings should be dumped with the size of what they - -- are binding (i.e. the size of the RHS of the binding). - - , ep_lintPassResult :: !(Maybe LintPassResultConfig) - -- ^ Whether we should lint the result of this pass. - - , ep_namePprCtx :: !NamePprCtx - - , ep_dumpFlag :: !(Maybe DumpFlag) - - , ep_prettyPass :: !SDoc - - , ep_passDetails :: !SDoc - } - -endPassIO :: Logger - -> EndPassConfig - -> CoreProgram -> [CoreRule] - -> IO () --- Used by the IO-is CorePrep too -endPassIO logger cfg binds rules - = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_namePprCtx cfg) mb_flag - (renderWithContext defaultSDocContext (ep_prettyPass cfg)) - (ep_passDetails cfg) binds rules - ; for_ (ep_lintPassResult cfg) $ \lp_cfg -> - lintPassResult logger lp_cfg binds - } - where - mb_flag = case ep_dumpFlag cfg of - Just flag | logHasDumpFlag logger flag -> Just flag - | logHasDumpFlag logger Opt_D_verbose_core2core -> Just flag - _ -> Nothing - -dumpPassResult :: Logger - -> Bool -- dump core sizes? - -> NamePprCtx - -> Maybe DumpFlag -- Just df => show details in a file whose - -- name is specified by df - -> String -- Header - -> SDoc -- Extra info to appear after header - -> CoreProgram -> [CoreRule] - -> IO () -dumpPassResult logger dump_core_sizes name_ppr_ctx mb_flag hdr extra_info binds rules - = do { forM_ mb_flag $ \flag -> do - logDumpFile logger (mkDumpStyle name_ppr_ctx) flag hdr FormatCore dump_doc - - -- Report result size - -- This has the side effect of forcing the intermediate to be evaluated - -- if it's not already forced by a -ddump flag. - ; Err.debugTraceMsg logger 2 size_doc - } - - where - size_doc = sep [text "Result size of" <+> text hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] - - dump_doc = vcat [ nest 2 extra_info - , size_doc - , blankLine - , if dump_core_sizes - then pprCoreBindingsWithSize binds - else pprCoreBindings binds - , ppUnless (null rules) pp_rules ] - pp_rules = vcat [ blankLine - , text "------ Local rules for imported ids --------" - , pprRules rules ] - -{- -************************************************************************ -* * - Top-level interfaces -* * -************************************************************************ --} - -data LintPassResultConfig = LintPassResultConfig - { lpr_diagOpts :: !DiagOpts - , lpr_platform :: !Platform - , lpr_makeLintFlags :: !LintFlags - , lpr_showLintWarnings :: !Bool - , lpr_passPpr :: !SDoc - , lpr_localsInScope :: ![Var] - } - -lintPassResult :: Logger -> LintPassResultConfig - -> CoreProgram -> IO () -lintPassResult logger cfg binds - = do { let warns_and_errs = lintCoreBindings' - (LintConfig - { l_diagOpts = lpr_diagOpts cfg - , l_platform = lpr_platform cfg - , l_flags = lpr_makeLintFlags cfg - , l_vars = lpr_localsInScope cfg - }) - binds - ; Err.showPass logger $ - "Core Linted result of " ++ - renderWithContext defaultSDocContext (lpr_passPpr cfg) - ; displayLintResults logger - (lpr_showLintWarnings cfg) (lpr_passPpr cfg) - (pprCoreBindings binds) warns_and_errs - } - -displayLintResults :: Logger - -> Bool -- ^ If 'True', display linter warnings. - -- If 'False', ignore linter warnings. - -> SDoc -- ^ The source of the linted program - -> SDoc -- ^ The linted program, pretty-printed - -> WarnsAndErrs - -> IO () -displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) - | not (isEmptyBag errs) - = do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] - $ withPprStyle defaultDumpStyle - (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs - , text "*** Offending Program ***" - , pp_pgm - , text "*** End of Offense ***" ]) - ; Err.ghcExit logger 1 } - - | not (isEmptyBag warns) - , log_enable_debug (logFlags logger) - , display_warnings - = logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] - $ withPprStyle defaultDumpStyle - (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns)) - - | otherwise = return () - -lint_banner :: String -> SDoc -> SDoc -lint_banner string pass = text "*** Core Lint" <+> text string - <+> text ": in result of" <+> pass - <+> text "***" - --- | Type-check a 'CoreProgram'. See Note [Core Lint guarantee]. -lintCoreBindings' :: LintConfig -> CoreProgram -> WarnsAndErrs --- Returns (warnings, errors) --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintCoreBindings' cfg binds - = initL cfg $ - addLoc TopLevelBindings $ - do { -- Check that all top-level binders are distinct - -- We do not allow [NonRec x=1, NonRec y=x, NonRec x=2] - -- because of glomming; see Note [Glomming] in GHC.Core.Opt.OccurAnal - checkL (null dups) (dupVars dups) - - -- Check for External top level binders with the same M.n name - ; checkL (null ext_dups) (dupExtVars ext_dups) - - -- Typecheck the bindings - ; lintRecBindings TopLevel all_pairs $ \_ -> - return () } - where - all_pairs = flattenBinds binds - -- Put all the top-level binders in scope at the start - -- This is because rewrite rules can bring something - -- into use 'unexpectedly'; see Note [Glomming] in "GHC.Core.Opt.OccurAnal" - binders = map fst all_pairs - - (_, dups) = removeDups compare binders - - -- ext_dups checks for names with different uniques - -- but the same External name M.n. We don't - -- allow this at top level: - -- M.n{r3} = ... - -- M.n{r29} = ... - -- because they both get the same linker symbol - ext_dups = snd $ removeDupsOn ord_ext $ - filter isExternalName $ map Var.varName binders - ord_ext n = (nameModule n, nameOccName n) - -{- -************************************************************************ -* * -\subsection[lintUnfolding]{lintUnfolding} -* * -************************************************************************ - -Note [Linting Unfoldings from Interfaces] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We use this to check all top-level unfoldings that come in from interfaces -(it is very painful to catch errors otherwise). - -We do not need to call lintUnfolding on unfoldings that are nested within -top-level unfoldings; they are linted when we lint the top-level unfolding; -hence the `TopLevelFlag` on `tcPragExpr` in GHC.IfaceToCore. - --} - -lintUnfolding :: Bool -- ^ True <=> is a compulsory unfolding - -> LintConfig - -> SrcLoc - -> CoreExpr - -> Maybe (Bag SDoc) -- Nothing => OK - -lintUnfolding is_compulsory cfg locn expr - | isEmptyBag errs = Nothing - | otherwise = Just errs - where - (_warns, errs) = initL cfg $ - if is_compulsory - -- See Note [Checking for representation polymorphism] - then noFixedRuntimeRepChecks linter - else linter - linter = addLoc (ImportedUnfolding locn) $ - lintCoreExpr expr - -lintExpr :: LintConfig - -> CoreExpr - -> Maybe (Bag SDoc) -- Nothing => OK - -lintExpr cfg expr - | isEmptyBag errs = Nothing - | otherwise = Just errs - where - (_warns, errs) = initL cfg linter - linter = addLoc TopLevelBindings $ - lintCoreExpr expr - -{- -************************************************************************ -* * -\subsection[lintCoreBinding]{lintCoreBinding} -* * -************************************************************************ - -Check a core binding, returning the list of variables bound. --} - --- Returns a UsageEnv because this function is called in lintCoreExpr for --- Let - -lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] - -> ([LintedId] -> LintM a) -> LintM (a, [UsageEnv]) -lintRecBindings top_lvl pairs thing_inside - = lintIdBndrs top_lvl bndrs $ \ bndrs' -> - do { ues <- zipWithM lint_pair bndrs' rhss - ; a <- thing_inside bndrs' - ; return (a, ues) } - where - (bndrs, rhss) = unzip pairs - lint_pair bndr' rhs - = addLoc (RhsOf bndr') $ - do { (rhs_ty, ue) <- lintRhs bndr' rhs -- Check the rhs - ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty - ; return ue } - -lintLetBody :: LintLocInfo -> [LintedId] -> CoreExpr -> LintM (LintedType, UsageEnv) -lintLetBody loc bndrs body - = do { (body_ty, body_ue) <- addLoc loc (lintCoreExpr body) - ; mapM_ (lintJoinBndrType body_ty) bndrs - ; return (body_ty, body_ue) } - -lintLetBind :: TopLevelFlag -> RecFlag -> LintedId - -> CoreExpr -> LintedType -> LintM () --- Binder's type, and the RHS, have already been linted --- This function checks other invariants -lintLetBind top_lvl rec_flag binder rhs rhs_ty - = do { let binder_ty = idType binder - ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) - - -- If the binding is for a CoVar, the RHS should be (Coercion co) - -- See Note [Core type and coercion invariant] in GHC.Core - ; checkL (not (isCoVar binder) || isCoArg rhs) - (mkLetErr binder rhs) - - -- Check the let-can-float invariant - -- See Note [Core let-can-float invariant] in GHC.Core - ; checkL ( isJoinId binder - || mightBeLiftedType binder_ty - || (isNonRec rec_flag && exprOkForSpeculation rhs) - || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed - || exprIsTickedString rhs) - (badBndrTyMsg binder (text "unlifted")) - - -- Check that if the binder is at the top level and has type Addr#, - -- that it is a string literal. - -- See Note [Core top-level string literals]. - ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) - || exprIsTickedString rhs) - (mkTopNonLitStrMsg binder) - - ; flags <- getLintFlags - - -- Check that a join-point binder has a valid type - -- NB: lintIdBinder has checked that it is not top-level bound - ; case idJoinPointHood binder of - NotJoinPoint -> return () - JoinPoint arity -> checkL (isValidJoinPointType arity binder_ty) - (mkInvalidJoinPointMsg binder binder_ty) - - ; when (lf_check_inline_loop_breakers flags - && isStableUnfolding (realIdUnfolding binder) - && isStrongLoopBreaker (idOccInfo binder) - && isInlinePragma (idInlinePragma binder)) - (addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder)) - -- Only non-rule loop breakers inhibit inlining - - -- We used to check that the dmdTypeDepth of a demand signature never - -- exceeds idArity, but that is an unnecessary complication, see - -- Note [idArity varies independently of dmdTypeDepth] in GHC.Core.Opt.DmdAnal - - -- Check that the binder's arity is within the bounds imposed by the type - -- and the strictness signature. See Note [Arity invariants for bindings] - -- and Note [Trimming arity] - - ; checkL (typeArity (idType binder) >= idArity binder) - (text "idArity" <+> ppr (idArity binder) <+> - text "exceeds typeArity" <+> - ppr (typeArity (idType binder)) <> colon <+> - ppr binder) - - -- See Note [idArity varies independently of dmdTypeDepth] - -- in GHC.Core.Opt.DmdAnal - ; case splitDmdSig (idDmdSig binder) of - (demands, result_info) | isDeadEndDiv result_info -> - if (demands `lengthAtLeast` idArity binder) - then return () - else pprTrace "Hack alert: lintLetBind #24623" - (ppr (idArity binder) $$ ppr (idDmdSig binder)) $ - return () --- checkL (demands `lengthAtLeast` idArity binder) --- (text "idArity" <+> ppr (idArity binder) <+> --- text "exceeds arity imposed by the strictness signature" <+> --- ppr (idDmdSig binder) <> colon <+> --- ppr binder) - - _ -> return () - - ; addLoc (RuleOf binder) $ mapM_ (lintCoreRule binder binder_ty) (idCoreRules binder) - - ; addLoc (UnfoldingOf binder) $ - lintIdUnfolding binder binder_ty (idUnfolding binder) - ; return () } - - -- We should check the unfolding, if any, but this is tricky because - -- the unfolding is a SimplifiableCoreExpr. Give up for now. - --- | Checks the RHS of bindings. It only differs from 'lintCoreExpr' --- in that it doesn't reject occurrences of the function 'makeStatic' when they --- appear at the top level and @lf_check_static_ptrs == AllowAtTopLevel@, and --- for join points, it skips the outer lambdas that take arguments to the --- join point. --- --- See Note [Checking StaticPtrs]. -lintRhs :: Id -> CoreExpr -> LintM (LintedType, UsageEnv) --- NB: the Id can be Linted or not -- it's only used for --- its OccInfo and join-pointer-hood -lintRhs bndr rhs - | JoinPoint arity <- idJoinPointHood bndr - = lintJoinLams arity (Just bndr) rhs - | AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr) - = lintJoinLams arity Nothing rhs - --- Allow applications of the data constructor @StaticPtr@ at the top --- but produce errors otherwise. -lintRhs _bndr rhs = fmap lf_check_static_ptrs getLintFlags >>= go - where - -- Allow occurrences of 'makeStatic' at the top-level but produce errors - -- otherwise. - go :: StaticPtrCheck -> LintM (OutType, UsageEnv) - go AllowAtTopLevel - | (binders0, rhs') <- collectTyBinders rhs - , Just (fun, t, info, e) <- collectMakeStaticArgs rhs' - = markAllJoinsBad $ - foldr - -- imitate @lintCoreExpr (Lam ...)@ - lintLambda - -- imitate @lintCoreExpr (App ...)@ - (do fun_ty_ue <- lintCoreExpr fun - lintCoreArgs fun_ty_ue [Type t, info, e] - ) - binders0 - go _ = markAllJoinsBad $ lintCoreExpr rhs - --- | Lint the RHS of a join point with expected join arity of @n@ (see Note --- [Join points] in "GHC.Core"). -lintJoinLams :: JoinArity -> Maybe Id -> CoreExpr -> LintM (LintedType, UsageEnv) -lintJoinLams join_arity enforce rhs - = go join_arity rhs - where - go 0 expr = lintCoreExpr expr - go n (Lam var body) = lintLambda var $ go (n-1) body - go n expr | Just bndr <- enforce -- Join point with too few RHS lambdas - = failWithL $ mkBadJoinArityMsg bndr join_arity n rhs - | otherwise -- Future join point, not yet eta-expanded - = markAllJoinsBad $ lintCoreExpr expr - -- Body of lambda is not a tail position - -lintIdUnfolding :: Id -> Type -> Unfolding -> LintM () -lintIdUnfolding bndr bndr_ty uf - | isStableUnfolding uf - , Just rhs <- maybeUnfoldingTemplate uf - = do { ty <- fst <$> (if isCompulsoryUnfolding uf - then noFixedRuntimeRepChecks $ lintRhs bndr rhs - -- ^^^^^^^^^^^^^^^^^^^^^^^ - -- See Note [Checking for representation polymorphism] - else lintRhs bndr rhs) - ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text "unfolding") ty) } -lintIdUnfolding _ _ _ - = return () -- Do not Lint unstable unfoldings, because that leads - -- to exponential behaviour; c.f. GHC.Core.FVs.idUnfoldingVars - -{- Note [Checking for INLINE loop breakers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very suspicious if a strong loop breaker is marked INLINE. - -However, the desugarer generates instance methods with INLINE pragmas -that form a mutually recursive group. Only after a round of -simplification are they unravelled. So we suppress the test for -the desugarer. Here is an example: - instance Eq T where - t1 == t2 = blah - t1 /= t2 = not (t1 == t2) - {-# INLINE (/=) #-} - -This will generate something like - -- From the class decl for Eq - data Eq a = EqDict (a->a->Bool) (a->a->Bool) - eq_sel :: Eq a -> (a->a->Bool) - eq_sel (EqDict eq _) = eq - - -- From the instance Eq T - $ceq :: T -> T -> Bool - $ceq = blah - - Rec { $dfEqT :: Eq T {-# DFunId #-} - $dfEqT = EqDict $ceq $cnoteq - - $cnoteq :: T -> T -> Bool {-# INLINE #-} - $cnoteq x y = not (eq_sel $dfEqT x y) } - -Notice that - -* `$dfEqT` and `$cnotEq` are mutually recursive. - -* We do not want `$dfEqT` to be the loop breaker: it's a DFunId, and - we want to let it "cancel" with "eq_sel" (see Note [ClassOp/DFun - selection] in GHC.Tc.TyCl.Instance, which it can't do if it's a loop - breaker. - -So we make `$cnoteq` into the loop breaker. That means it can't -inline, despite the INLINE pragma. That's what gives rise to the -warning, which is perfectly appropriate for, say - Rec { {-# INLINE f #-} f = \x -> ...f.... } -We can't inline a recursive function -- it's a loop breaker. - -But now we can optimise `eq_sel $dfEqT` to `$ceq`, so we get - Rec { - $dfEqT :: Eq T {-# DFunId #-} - $dfEqT = EqDict $ceq $cnoteq - - $cnoteq :: T -> T -> Bool {-# INLINE #-} - $cnoteq x y = not ($ceq x y) } - -and now the dependencies of the Rec have gone, and we can split it up to give - NonRec { $dfEqT :: Eq T {-# DFunId #-} - $dfEqT = EqDict $ceq $cnoteq } - - NonRec { $cnoteq :: T -> T -> Bool {-# INLINE #-} - $cnoteq x y = not ($ceq x y) } - -Now $cnoteq is not a loop breaker any more, so the INLINE pragma can -take effect -- the warning turned out to be temporary. - -To stop excessive warnings, this warning for INLINE loop breakers is -switched off when linting the result of the desugarer. See -lf_check_inline_loop_breakers in GHC.Core.Lint. - - -Note [Checking for representation polymorphism] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We ordinarily want to check for bad representation polymorphism. See -Note [Representation polymorphism invariants] in GHC.Core. However, we do *not* -want to do this in a compulsory unfolding. Compulsory unfoldings arise -only internally, for things like newtype wrappers, dictionaries, and -(notably) unsafeCoerce#. These might legitimately be representation-polymorphic; -indeed representation-polymorphic unfoldings are a primary reason for the -very existence of compulsory unfoldings (we can't compile code for -the original, representation-polymorphic, binding). - -It is vitally important that we do representation polymorphism checks *after* -performing the unfolding, but not beforehand. This is all safe because -we will check any unfolding after it has been unfolded; checking the -unfolding beforehand is merely an optimization, and one that actively -hurts us here. - -Note [Linting of runRW#] -~~~~~~~~~~~~~~~~~~~~~~~~ -runRW# has some very special behavior (see Note [runRW magic] in -GHC.CoreToStg.Prep) which CoreLint must accommodate, by allowing -join points in its argument. For example, this is fine: - - join j x = ... - in runRW# (\s. case v of - A -> j 3 - B -> j 4) - -Usually those calls to the join point 'j' would not be valid tail calls, -because they occur in a function argument. But in the case of runRW# -they are fine, because runRW# (\s.e) behaves operationally just like e. -(runRW# is ultimately inlined in GHC.CoreToStg.Prep.) - -In the case that the continuation is /not/ a lambda we simply disable this -special behaviour. For example, this is /not/ fine: - - join j = ... - in runRW# @r @ty (jump j) - -Note [Coercions in terms] -~~~~~~~~~~~~~~~~~~~~~~~~~ -The expression (Type ty) can occur only as the argument of an application, -or the RHS of a non-recursive Let. But what about (Coercion co)? - -Currently it appears in ghc-prim:GHC.Types.coercible_sel, a WiredInId whose -definition is: - coercible_sel :: Coercible a b => (a ~R# b) - coercible_sel d = case d of - MkCoercibleDict (co :: a ~# b) -> Coercion co - -So this function has a (Coercion co) in the alternative of a case. - -Richard says (!11908): it shouldn't appear outside of arguments, but we've been -loose about this. coercible_sel is some thin ice. Really we should be unpacking -Coercible using case, not a selector. I recall looking into this a few years -back and coming to the conclusion that the fix was worse than the disease. Don't -remember the details, but could probably recover it if we want to revisit. - -So Lint current accepts (Coercion co) in arbitrary places. There is no harm in -that: it really is a value, albeit a zero-bit value. - -************************************************************************ -* * -\subsection[lintCoreExpr]{lintCoreExpr} -* * -************************************************************************ --} - --- Linted things: substitution applied, and type is linted -type LintedType = Type -type LintedKind = Kind -type LintedCoercion = Coercion -type LintedTyCoVar = TyCoVar -type LintedId = Id - --- | Lint an expression cast through the given coercion, returning the type --- resulting from the cast. -lintCastExpr :: CoreExpr -> LintedType -> Coercion -> LintM LintedType -lintCastExpr expr expr_ty co - = do { co' <- lintCoercion co - ; let (Pair from_ty to_ty, role) = coercionKindRole co' - ; checkValueType to_ty $ - text "target of cast" <+> quotes (ppr co') - ; lintRole co' Representational role - ; ensureEqTys from_ty expr_ty (mkCastErr expr co' from_ty expr_ty) - ; return to_ty } - -lintCoreExpr :: CoreExpr -> LintM (LintedType, UsageEnv) --- The returned type has the substitution from the monad --- already applied to it: --- lintCoreExpr e subst = exprType (subst e) --- --- The returned "type" can be a kind, if the expression is (Type ty) - --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] - -lintCoreExpr (Var var) - = do - var_pair@(var_ty, _) <- lintIdOcc var 0 - -- See Note [Linting representation-polymorphic builtins] - checkRepPolyBuiltin (Var var) [] var_ty - --checkDataToTagPrimOpTyCon (Var var) [] - return var_pair - -lintCoreExpr (Lit lit) - = return (literalType lit, zeroUE) - -lintCoreExpr (Cast expr co) - = do (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr) - -- markAllJoinsBad: see Note [Join points and casts] - to_ty <- lintCastExpr expr expr_ty co - return (to_ty, ue) - -lintCoreExpr (Tick tickish expr) - = do case tickish of - Breakpoint _ _ ids _ -> forM_ ids $ \id -> do - checkDeadIdOcc id - lookupIdInScope id - _ -> return () - markAllJoinsBadIf block_joins $ lintCoreExpr expr - where - block_joins = not (tickish `tickishScopesLike` SoftScope) - -- TODO Consider whether this is the correct rule. It is consistent with - -- the simplifier's behaviour - cost-centre-scoped ticks become part of - -- the continuation, and thus they behave like part of an evaluation - -- context, but soft-scoped and non-scoped ticks simply wrap the result - -- (see Simplify.simplTick). - -lintCoreExpr (Let (NonRec tv (Type ty)) body) - | isTyVar tv - = -- See Note [Linting type lets] - do { ty' <- lintType ty - ; lintTyBndr tv $ \ tv' -> - do { addLoc (RhsOf tv) $ lintTyKind tv' ty' - -- Now extend the substitution so we - -- take advantage of it in the body - ; extendTvSubstL tv ty' $ - addLoc (BodyOfLet tv) $ - lintCoreExpr body } } - -lintCoreExpr (Let (NonRec bndr rhs) body) - | isId bndr - = do { -- First Lint the RHS, before bringing the binder into scope - (rhs_ty, let_ue) <- lintRhs bndr rhs - - -- See Note [Multiplicity of let binders] in Var - -- Now lint the binder - ; lintBinder LetBind bndr $ \bndr' -> - do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty - ; addAliasUE bndr let_ue (lintLetBody (BodyOfLet bndr') [bndr'] body) } } - - | otherwise - = failWithL (mkLetErr bndr rhs) -- Not quite accurate - -lintCoreExpr e@(Let (Rec pairs) body) - = do { -- Check that the list of pairs is non-empty - checkL (not (null pairs)) (emptyRec e) - - -- Check that there are no duplicated binders - ; let (_, dups) = removeDups compare bndrs - ; checkL (null dups) (dupVars dups) - - -- Check that either all the binders are joins, or none - ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ - mkInconsistentRecMsg bndrs - - -- See Note [Multiplicity of let binders] in Var - ; ((body_type, body_ue), ues) <- - lintRecBindings NotTopLevel pairs $ \ bndrs' -> - lintLetBody (BodyOfLetRec bndrs') bndrs' body - ; return (body_type, body_ue `addUE` scaleUE ManyTy (foldr1 addUE ues)) } - where - bndrs = map fst pairs - -lintCoreExpr e@(App _ _) - | Var fun <- fun - , fun `hasKey` runRWKey - -- N.B. we may have an over-saturated application of the form: - -- runRW (\s -> \x -> ...) y - , ty_arg1 : ty_arg2 : arg3 : rest <- args - = do { fun_pair1 <- lintCoreArg (idType fun, zeroUE) ty_arg1 - ; (fun_ty2, ue2) <- lintCoreArg fun_pair1 ty_arg2 - -- See Note [Linting of runRW#] - ; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv) - lintRunRWCont expr@(Lam _ _) = - lintJoinLams 1 (Just fun) expr - lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other - -- TODO: Look through ticks? - ; (arg3_ty, ue3) <- lintRunRWCont arg3 - ; app_ty <- lintValApp arg3 fun_ty2 arg3_ty ue2 ue3 - ; lintCoreArgs app_ty rest } - - | otherwise - = do { fun_pair <- lintCoreFun fun (length args) - ; app_pair@(app_ty, _) <- lintCoreArgs fun_pair args - - -- See Note [Linting representation-polymorphic builtins] - ; checkRepPolyBuiltin fun args app_ty - ; --checkDataToTagPrimOpTyCon fun args - - ; return app_pair} - where - skipTick t = case collectFunSimple e of - (Var v) -> etaExpansionTick v t - _ -> tickishFloatable t - (fun, args, _source_ticks) = collectArgsTicks skipTick e - -- We must look through source ticks to avoid #21152, for example: - -- - -- reallyUnsafePtrEquality - -- = \ @a -> - -- (src reallyUnsafePtrEquality#) - -- @Lifted @a @Lifted @a - -- - -- To do this, we use `collectArgsTicks tickishFloatable` to match - -- the eta expansion behaviour, as per Note [Eta expansion and source notes] - -- in GHC.Core.Opt.Arity. - -- Sadly this was not quite enough. So we now also accept things that CorePrep will allow. - -- See Note [Ticks and mandatory eta expansion] - -lintCoreExpr (Lam var expr) - = markAllJoinsBad $ - lintLambda var $ lintCoreExpr expr - -lintCoreExpr (Case scrut var alt_ty alts) - = lintCaseExpr scrut var alt_ty alts - --- This case can't happen; linting types in expressions gets routed through --- lintCoreArgs -lintCoreExpr (Type ty) - = failWithL (text "Type found as expression" <+> ppr ty) - -lintCoreExpr (Coercion co) - -- See Note [Coercions in terms] - = do { co' <- addLoc (InCo co) $ - lintCoercion co - ; return (coercionType co', zeroUE) } - ----------------------- -lintIdOcc :: Var -> Int -- Number of arguments (type or value) being passed - -> LintM (LintedType, UsageEnv) -- returns type of the *variable* -lintIdOcc var nargs - = addLoc (OccOf var) $ - do { checkL (isNonCoVarId var) - (text "Non term variable" <+> ppr var) - -- See GHC.Core Note [Variable occurrences in Core] - - -- Check that the type of the occurrence is the same - -- as the type of the binding site. The inScopeIds are - -- /un-substituted/, so this checks that the occurrence type - -- is identical to the binder type. - -- This makes things much easier for things like: - -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... - -- The "::Maybe a" on the occurrence is referring to the /outer/ a. - -- If we compared /substituted/ types we'd risk comparing - -- (Maybe a) from the binding site with bogus (Maybe a1) from - -- the occurrence site. Comparing un-substituted types finesses - -- this altogether - ; (bndr, linted_bndr_ty) <- lookupIdInScope var - ; let occ_ty = idType var - bndr_ty = idType bndr - ; ensureEqTys occ_ty bndr_ty $ - mkBndrOccTypeMismatchMsg bndr var bndr_ty occ_ty - - -- Check for a nested occurrence of the StaticPtr constructor. - -- See Note [Checking StaticPtrs]. - ; lf <- getLintFlags - ; when (nargs /= 0 && lf_check_static_ptrs lf /= AllowAnywhere) $ - checkL (idName var /= makeStaticName) $ - text "Found makeStatic nested in an expression" - - ; checkDeadIdOcc var - ; checkJoinOcc var nargs - ; case isDataConId_maybe var of - Nothing -> return () - Just dc -> checkTypeDataConOcc "expression" dc - - ; usage <- varCallSiteUsage var - - ; return (linted_bndr_ty, usage) } - -lintCoreFun :: CoreExpr - -> Int -- Number of arguments (type or val) being passed - -> LintM (LintedType, UsageEnv) -- Returns type of the *function* -lintCoreFun (Var var) nargs - = lintIdOcc var nargs - -lintCoreFun (Lam var body) nargs - -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; - -- See Note [Beta redexes] - | nargs /= 0 - = lintLambda var $ lintCoreFun body (nargs - 1) - -lintCoreFun expr nargs - = markAllJoinsBadIf (nargs /= 0) $ - -- See Note [Join points are less general than the paper] - lintCoreExpr expr ------------------- -lintLambda :: Var -> LintM (Type, UsageEnv) -> LintM (Type, UsageEnv) -lintLambda var lintBody = - addLoc (LambdaBodyOf var) $ - lintBinder LambdaBind var $ \ var' -> - do { (body_ty, ue) <- lintBody - ; ue' <- checkLinearity ue var' - ; return (mkLamType var' body_ty, ue') } ------------------- -checkDeadIdOcc :: Id -> LintM () --- Occurrences of an Id should never be dead.... --- except when we are checking a case pattern -checkDeadIdOcc id - | isDeadOcc (idOccInfo id) - = do { in_case <- inCasePat - ; checkL in_case - (text "Occurrence of a dead Id" <+> ppr id) } - | otherwise - = return () - ------------------- -lintJoinBndrType :: LintedType -- Type of the body - -> LintedId -- Possibly a join Id - -> LintM () --- Checks that the return type of a join Id matches the body --- E.g. join j x = rhs in body --- The type of 'rhs' must be the same as the type of 'body' -lintJoinBndrType body_ty bndr - | JoinPoint arity <- idJoinPointHood bndr - , let bndr_ty = idType bndr - , (bndrs, res) <- splitPiTys bndr_ty - = checkL (length bndrs >= arity - && body_ty `eqType` mkPiTys (drop arity bndrs) res) $ - hang (text "Join point returns different type than body") - 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr) - , text "Join arity:" <+> ppr arity - , text "Body type:" <+> ppr body_ty ]) - | otherwise - = return () - -checkJoinOcc :: Id -> JoinArity -> LintM () --- Check that if the occurrence is a JoinId, then so is the --- binding site, and it's a valid join Id -checkJoinOcc var n_args - | JoinPoint join_arity_occ <- idJoinPointHood var - = do { mb_join_arity_bndr <- lookupJoinId var - ; case mb_join_arity_bndr of { - NotJoinPoint -> do { join_set <- getValidJoins - ; addErrL (text "join set " <+> ppr join_set $$ - invalidJoinOcc var) } ; - - JoinPoint join_arity_bndr -> - - do { checkL (join_arity_bndr == join_arity_occ) $ - -- Arity differs at binding site and occurrence - mkJoinBndrOccMismatchMsg var join_arity_bndr join_arity_occ - - ; checkL (n_args == join_arity_occ) $ - -- Arity doesn't match #args - mkBadJumpMsg var join_arity_occ n_args } } } - - | otherwise - = return () - -checkTypeDataConOcc :: String -> DataCon -> LintM () --- Check that the Id is not a data constructor of a `type data` declaration --- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module -checkTypeDataConOcc what dc - = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ - (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) - -{- --- | Check that a use of a dataToTag# primop satisfies conditions DTT2 --- and DTT3 from Note [DataToTag overview] in GHC.Tc.Instance.Class --- --- Ignores applications not headed by dataToTag# primops. - --- Commented out because GHC.PrimopWrappers doesn't respect this condition yet. --- See wrinkle DTW7 in Note [DataToTag overview]. -checkDataToTagPrimOpTyCon - :: CoreExpr -- ^ the function (head of the application) we are checking - -> [CoreArg] -- ^ The arguments to the application - -> LintM () -checkDataToTagPrimOpTyCon (Var fun_id) args - | Just op <- isPrimOpId_maybe fun_id - , op == DataToTagSmallOp || op == DataToTagLargeOp - = case args of - Type _levity : Type dty : _rest - | Just (tc, _) <- splitTyConApp_maybe dty - , isValidDTT2TyCon tc - -> do platform <- getPlatform - let numConstrs = tyConFamilySize tc - isSmallOp = op == DataToTagSmallOp - checkL (isSmallFamily platform numConstrs == isSmallOp) $ - text "dataToTag# primop-size/tycon-family-size mismatch" - | otherwise -> failWithL $ text "dataToTagLarge# used at non-ADT type:" - <+> ppr dty - _ -> failWithL $ text "dataToTagLarge# needs two type arguments but has args:" - <+> ppr (take 2 args) - -checkDataToTagPrimOpTyCon _ _ = pure () --} - --- | Check representation-polymorphic invariants in an application of a --- built-in function or newtype constructor. --- --- See Note [Linting representation-polymorphic builtins]. -checkRepPolyBuiltin :: CoreExpr -- ^ the function (head of the application) we are checking - -> [CoreArg] -- ^ the arguments to the application - -> LintedType -- ^ the instantiated type of the overall application - -> LintM () -checkRepPolyBuiltin (Var fun_id) args app_ty - = do { do_rep_poly_checks <- lf_check_fixed_rep <$> getLintFlags - ; when (do_rep_poly_checks && hasNoBinding fun_id) $ - if - -- (2) representation-polymorphic unlifted newtypes - | Just dc <- isDataConId_maybe fun_id - , isNewDataCon dc - -> if tcHasFixedRuntimeRep $ dataConTyCon dc - then return () - else checkRepPolyNewtypeApp dc args app_ty - - -- (1) representation-polymorphic builtins - | otherwise - -> checkRepPolyBuiltinApp fun_id args - } -checkRepPolyBuiltin _ _ _ = return () - -checkRepPolyNewtypeApp :: DataCon -> [CoreArg] -> LintedType -> LintM () -checkRepPolyNewtypeApp nt args app_ty - -- If the newtype is saturated, we're OK. - | any isValArg args - = return () - -- Otherwise, check we can eta-expand. - | otherwise - = case getRuntimeArgTys app_ty of - (Scaled _ first_val_arg_ty, _):_ - | not $ typeHasFixedRuntimeRep first_val_arg_ty - -> failWithL (err_msg first_val_arg_ty) - _ -> return () - - where - - err_msg :: Type -> SDoc - err_msg bad_arg_ty - = vcat [ text "Cannot eta expand unlifted newtype constructor" <+> quotes (ppr nt) <> dot - , text "Its argument type does not have a fixed runtime representation:" - , nest 2 $ ppr_ty_ki bad_arg_ty ] - - ppr_ty_ki :: Type -> SDoc - ppr_ty_ki ty = bullet <+> ppr ty <+> dcolon <+> ppr (typeKind ty) - -checkRepPolyBuiltinApp :: Id -> [CoreArg] -> LintM () -checkRepPolyBuiltinApp fun_id args = checkL (null not_concs) err_msg - where - - conc_binder_positions :: IntMap ConcreteTvOrigin - conc_binder_positions - = concreteTyVarPositions fun_id - $ idDetailsConcreteTvs - $ idDetails fun_id - - max_pos :: Int - max_pos = - case IntMap.keys conc_binder_positions of - [] -> 0 - positions -> maximum positions - - not_concs :: [(SDoc, ConcreteTvOrigin)] - not_concs = - mapMaybe is_bad (zip [1..max_pos] (map Just args ++ repeat Nothing)) - -- NB: 1-indexed - - is_bad :: (Int, Maybe CoreArg) -> Maybe (SDoc, ConcreteTvOrigin) - is_bad (pos, mb_arg) - | Just conc_reason <- IntMap.lookup pos conc_binder_positions - , Just bad_ty <- case mb_arg of - Just (Type ki) - | isConcreteType ki - -> Nothing - | otherwise - -- Here we handle the situation in which a "must be concrete" TyVar - -- has been instantiated with a type that is not concrete. - -> Just $ quotes (ppr ki) <+> text "is not concrete." - -- We expected a type argument in this position, and got something else: panic! - Just arg -> - pprPanic "checkRepPolyBuiltinApp: expected a type in this position" $ - vcat [ text "fun_id:" <+> ppr fun_id <+> dcolon <+> ppr (idType fun_id) - , text "pos:" <+> ppr pos - , text "arg:" <+> ppr arg ] - Nothing -> - -- Here we handle the situation in which a "must be concrete" TyVar - -- has not been instantiated at all. - case conc_reason of - ConcreteFRR frr_orig -> - let ty = frr_type frr_orig - in Just $ ppr ty <+> dcolon <+> ppr (typeKind ty) - = Just (bad_ty, conc_reason) - | otherwise - = Nothing - - err_msg :: SDoc - err_msg - = vcat $ map ((bullet <+>) . ppr_not_conc) not_concs - - ppr_not_conc :: (SDoc, ConcreteTvOrigin) -> SDoc - ppr_not_conc (bad_ty, conc) = - vcat - [ ppr_conc_orig conc - , nest 2 bad_ty ] - - ppr_conc_orig :: ConcreteTvOrigin -> SDoc - ppr_conc_orig (ConcreteFRR frr_orig) = - case frr_orig of - FixedRuntimeRepOrigin { frr_context = ctxt } -> - hsep [ ppr ctxt, text "does not have a fixed runtime representation:" ] - --- | Compute the 1-indexed positions in the outer forall'd quantified type variables --- of the type in which the concrete type variables occur. --- --- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete. -concreteTyVarPositions :: Id -> ConcreteTyVars -> IntMap ConcreteTvOrigin -concreteTyVarPositions fun_id conc_tvs - | isNullUFM conc_tvs - = IntMap.empty - | otherwise - = case splitForAllTyCoVars (idType fun_id) of - ([], _) -> IntMap.empty - (tvs, _) -> - let positions = - IntMap.fromList - [ (pos, conc_orig) - | (tv, pos) <- zip tvs [1..] - , conc_orig <- maybeToList $ lookupNameEnv conc_tvs (tyVarName tv) - ] - -- Assert that we have as many positions as concrete type variables, - -- i.e. we are not missing any concreteness information. - in assertPpr (sizeUFM conc_tvs == length positions) - (vcat [ text "concreteTyVarPositions: missing concreteness information" - , text "fun_id:" <+> ppr fun_id - , text "tvs:" <+> ppr tvs - , text "Expected # of concrete tvs:" <+> ppr (sizeUFM conc_tvs) - , text " Actual # of concrete tvs:" <+> ppr (length positions) ]) - positions - --- Check that the usage of var is consistent with var itself, and pop the var --- from the usage environment (this is important because of shadowing). -checkLinearity :: UsageEnv -> Var -> LintM UsageEnv -checkLinearity body_ue lam_var = - case varMultMaybe lam_var of - Just mult -> do - let (lhs, body_ue') = popUE body_ue lam_var - err_msg = text "Linearity failure in lambda:" <+> ppr lam_var - $$ ppr lhs <+> text "⊈" <+> ppr mult - ensureSubUsage lhs mult err_msg - return body_ue' - Nothing -> return body_ue -- A type variable - -{- Note [Join points and casts] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -You might think that this should be OK: - join j x = rhs - in (case e of - A -> alt1 - B x -> (jump j x) |> co) - -You might think that, since the cast is ultimately erased, the jump to -`j` should still be OK as a join point. But no! See #21716. Suppose - - newtype Age = MkAge Int -- axAge :: Age ~ Int - f :: Int -> ... -- f strict in it's first argument - -and consider the expression - - f (join j :: Bool -> Age - j x = (rhs1 :: Age) - in case v of - Just x -> (j x |> axAge :: Int) - Nothing -> rhs2) - -Then, if the Simplifier pushes the strict call into the join points -and alternatives we'll get - - join j' x = f (rhs1 :: Age) - in case v of - Just x -> j' x |> axAge - Nothing -> f rhs2 - -Utterly bogus. `f` expects an `Int` and we are giving it an `Age`. -No no no. Casts destroy the tail-call property. Henc markAllJoinsBad -in the (Cast expr co) case of lintCoreExpr. - -Note [No alternatives lint check] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Case expressions with no alternatives are odd beasts, and it would seem -like they would worth be looking at in the linter (cf #10180). We -used to check two things: - -* exprIsHNF is false: it would *seem* to be terribly wrong if - the scrutinee was already in head normal form. - -* exprIsDeadEnd is true: we should be able to see why GHC believes the - scrutinee is diverging for sure. - -It was already known that the second test was not entirely reliable. -Unfortunately (#13990), the first test turned out not to be reliable -either. Getting the checks right turns out to be somewhat complicated. - -For example, suppose we have (comment 8) - - data T a where - TInt :: T Int - - absurdTBool :: T Bool -> a - absurdTBool v = case v of - - data Foo = Foo !(T Bool) - - absurdFoo :: Foo -> a - absurdFoo (Foo x) = absurdTBool x - -GHC initially accepts the empty case because of the GADT conditions. But then -we inline absurdTBool, getting - - absurdFoo (Foo x) = case x of - -x is in normal form (because the Foo constructor is strict) but the -case is empty. To avoid this problem, GHC would have to recognize -that matching on Foo x is already absurd, which is not so easy. - -More generally, we don't really know all the ways that GHC can -lose track of why an expression is bottom, so we shouldn't make too -much fuss when that happens. - - -Note [Beta redexes] -~~~~~~~~~~~~~~~~~~~ -Consider: - - join j @x y z = ... in - (\@x y z -> jump j @x y z) @t e1 e2 - -This is clearly ill-typed, since the jump is inside both an application and a -lambda, either of which is enough to disqualify it as a tail call (see Note -[Invariants on join points] in GHC.Core). However, strictly from a -lambda-calculus perspective, the term doesn't go wrong---after the two beta -reductions, the jump *is* a tail call and everything is fine. - -Why would we want to allow this when we have let? One reason is that a compound -beta redex (that is, one with more than one argument) has different scoping -rules: naively reducing the above example using lets will capture any free -occurrence of y in e2. More fundamentally, type lets are tricky; many passes, -such as Float Out, tacitly assume that the incoming program's type lets have -all been dealt with by the simplifier. Thus we don't want to let-bind any types -in, say, GHC.Core.Subst.simpleOptPgm, which in some circumstances can run immediately -before Float Out. - -All that said, currently GHC.Core.Subst.simpleOptPgm is the only thing using this -loophole, doing so to avoid re-traversing large functions (beta-reducing a type -lambda without introducing a type let requires a substitution). TODO: Improve -simpleOptPgm so that we can forget all this ever happened. - -************************************************************************ -* * -\subsection[lintCoreArgs]{lintCoreArgs} -* * -************************************************************************ - -The basic version of these functions checks that the argument is a -subtype of the required type, as one would expect. --} - --- Takes the functions type and arguments as argument. --- Returns the *result* of applying the function to arguments. --- e.g. f :: Int -> Bool -> Int would return `Int` as result type. -lintCoreArgs :: (LintedType, UsageEnv) -> [CoreArg] -> LintM (LintedType, UsageEnv) -lintCoreArgs (fun_ty, fun_ue) args = foldM lintCoreArg (fun_ty, fun_ue) args - -lintCoreArg :: (LintedType, UsageEnv) -> CoreArg -> LintM (LintedType, UsageEnv) - --- Type argument -lintCoreArg (fun_ty, ue) (Type arg_ty) - = do { checkL (not (isCoercionTy arg_ty)) - (text "Unnecessary coercion-to-type injection:" - <+> ppr arg_ty) - ; arg_ty' <- lintType arg_ty - ; res <- lintTyApp fun_ty arg_ty' - ; return (res, ue) } - --- Coercion argument -lintCoreArg (fun_ty, ue) (Coercion co) - = do { co' <- addLoc (InCo co) $ - lintCoercion co - ; res <- lintCoApp fun_ty co' - ; return (res, ue) } - --- Other value argument -lintCoreArg (fun_ty, fun_ue) arg - = do { (arg_ty, arg_ue) <- markAllJoinsBad $ lintCoreExpr arg - -- See Note [Representation polymorphism invariants] in GHC.Core - ; flags <- getLintFlags - - ; when (lf_check_fixed_rep flags) $ - -- Only check that 'arg_ty' has a fixed RuntimeRep - -- if 'lf_check_fixed_rep' is on. - do { checkL (typeHasFixedRuntimeRep arg_ty) - (text "Argument does not have a fixed runtime representation" - <+> ppr arg <+> dcolon - <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))) } - - ; lintValApp arg fun_ty arg_ty fun_ue arg_ue } - ------------------ -lintAltBinders :: UsageEnv - -> Var -- Case binder - -> LintedType -- Scrutinee type - -> LintedType -- Constructor type - -> [(Mult, OutVar)] -- Binders - -> LintM UsageEnv --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintAltBinders rhs_ue _case_bndr scrut_ty con_ty [] - = do { ensureEqTys con_ty scrut_ty (mkBadPatMsg con_ty scrut_ty) - ; return rhs_ue } -lintAltBinders rhs_ue case_bndr scrut_ty con_ty ((var_w, bndr):bndrs) - | isTyVar bndr - = do { con_ty' <- lintTyApp con_ty (mkTyVarTy bndr) - ; lintAltBinders rhs_ue case_bndr scrut_ty con_ty' bndrs } - | otherwise - = do { (con_ty', _) <- lintValApp (Var bndr) con_ty (idType bndr) zeroUE zeroUE - -- We can pass zeroUE to lintValApp because we ignore its usage - -- calculation and compute it in the call for checkCaseLinearity below. - ; rhs_ue' <- checkCaseLinearity rhs_ue case_bndr var_w bndr - ; lintAltBinders rhs_ue' case_bndr scrut_ty con_ty' bndrs } - --- | Implements the case rules for linearity -checkCaseLinearity :: UsageEnv -> Var -> Mult -> Var -> LintM UsageEnv -checkCaseLinearity ue case_bndr var_w bndr = do - ensureSubUsage lhs rhs err_msg - lintLinearBinder (ppr bndr) (case_bndr_w `mkMultMul` var_w) (varMult bndr) - return $ deleteUE ue bndr - where - lhs = bndr_usage `addUsage` (var_w `scaleUsage` case_bndr_usage) - rhs = case_bndr_w `mkMultMul` var_w - err_msg = (text "Linearity failure in variable:" <+> ppr bndr - $$ ppr lhs <+> text "⊈" <+> ppr rhs - $$ text "Computed by:" - <+> text "LHS:" <+> lhs_formula - <+> text "RHS:" <+> rhs_formula) - lhs_formula = ppr bndr_usage <+> text "+" - <+> parens (ppr case_bndr_usage <+> text "*" <+> ppr var_w) - rhs_formula = ppr case_bndr_w <+> text "*" <+> ppr var_w - case_bndr_w = varMult case_bndr - case_bndr_usage = lookupUE ue case_bndr - bndr_usage = lookupUE ue bndr - - - ------------------ -lintTyApp :: LintedType -> LintedType -> LintM LintedType -lintTyApp fun_ty arg_ty - | Just (tv,body_ty) <- splitForAllTyVar_maybe fun_ty - = do { lintTyKind tv arg_ty - ; in_scope <- getInScope - -- substTy needs the set of tyvars in scope to avoid generating - -- uniques that are already in scope. - -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst - ; return (substTyWithInScope in_scope [tv] [arg_ty] body_ty) } - - | otherwise - = failWithL (mkTyAppMsg fun_ty arg_ty) - ------------------ -lintCoApp :: LintedType -> LintedCoercion -> LintM LintedType -lintCoApp fun_ty co - | Just (cv,body_ty) <- splitForAllCoVar_maybe fun_ty - , let co_ty = coercionType co - cv_ty = idType cv - , cv_ty `eqType` co_ty - = do { in_scope <- getInScope - ; let init_subst = mkEmptySubst in_scope - subst = extendCvSubst init_subst cv co - ; return (substTy subst body_ty) } - - | Just (_, _, arg_ty', res_ty') <- splitFunTy_maybe fun_ty - , co_ty `eqType` arg_ty' - = return (res_ty') - - | otherwise - = failWithL (mkCoAppMsg fun_ty co) - - where - co_ty = coercionType co - ------------------ - --- | @lintValApp arg fun_ty arg_ty@ lints an application of @fun arg@ --- where @fun :: fun_ty@ and @arg :: arg_ty@, returning the type of the --- application. -lintValApp :: CoreExpr -> LintedType -> LintedType -> UsageEnv -> UsageEnv - -> LintM (LintedType, UsageEnv) -lintValApp arg fun_ty arg_ty fun_ue arg_ue - | Just (_, w, arg_ty', res_ty') <- splitFunTy_maybe fun_ty - = do { ensureEqTys arg_ty' arg_ty (mkAppMsg arg_ty' arg_ty arg) - ; let app_ue = addUE fun_ue (scaleUE w arg_ue) - ; return (res_ty', app_ue) } - | otherwise - = failWithL err2 - where - err2 = mkNonFunAppMsg fun_ty arg_ty arg - -lintTyKind :: OutTyVar -> LintedType -> LintM () --- Both args have had substitution applied - --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintTyKind tyvar arg_ty - = unless (arg_kind `eqType` tyvar_kind) $ - addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) - where - tyvar_kind = tyVarKind tyvar - arg_kind = typeKind arg_ty - -{- -************************************************************************ -* * -\subsection[lintCoreAlts]{lintCoreAlts} -* * -************************************************************************ --} - -lintCaseExpr :: CoreExpr -> Id -> Type -> [CoreAlt] -> LintM (LintedType, UsageEnv) -lintCaseExpr scrut var alt_ty alts = - do { let e = Case scrut var alt_ty alts -- Just for error messages - - -- Check the scrutinee - ; (scrut_ty, scrut_ue) <- markAllJoinsBad $ lintCoreExpr scrut - -- See Note [Join points are less general than the paper] - -- in GHC.Core - ; let scrut_mult = varMult var - - ; alt_ty <- addLoc (CaseTy scrut) $ - lintValueType alt_ty - ; var_ty <- addLoc (IdTy var) $ - lintValueType (idType var) - - -- We used to try to check whether a case expression with no - -- alternatives was legitimate, but this didn't work. - -- See Note [No alternatives lint check] for details. - - -- Check that the scrutinee is not a floating-point type - -- if there are any literal alternatives - -- See GHC.Core Note [Case expression invariants] item (5) - -- See Note [Rules for floating-point comparisons] in GHC.Core.Opt.ConstantFold - ; let isLitPat (Alt (LitAlt _) _ _) = True - isLitPat _ = False - ; checkL (not $ isFloatingPrimTy scrut_ty && any isLitPat alts) - (text "Lint warning: Scrutinising floating-point expression with literal pattern in case analysis (see #9238)." - $$ text "scrut" <+> ppr scrut) - - ; case tyConAppTyCon_maybe (idType var) of - Just tycon - | debugIsOn - , isAlgTyCon tycon - , not (isAbstractTyCon tycon) - , null (tyConDataCons tycon) - , not (exprIsDeadEnd scrut) - -> pprTrace "Lint warning: case binder's type has no constructors" (ppr var <+> ppr (idType var)) - -- This can legitimately happen for type families - $ return () - _otherwise -> return () - - -- Don't use lintIdBndr on var, because unboxed tuple is legitimate - - ; subst <- getSubst - ; ensureEqTys var_ty scrut_ty (mkScrutMsg var var_ty scrut_ty subst) - -- See GHC.Core Note [Case expression invariants] item (7) - - ; lintBinder CaseBind var $ \_ -> - do { -- Check the alternatives - ; alt_ues <- mapM (lintCoreAlt var scrut_ty scrut_mult alt_ty) alts - ; let case_ue = (scaleUE scrut_mult scrut_ue) `addUE` supUEs alt_ues - ; checkCaseAlts e scrut_ty alts - ; return (alt_ty, case_ue) } } - -checkCaseAlts :: CoreExpr -> LintedType -> [CoreAlt] -> LintM () --- a) Check that the alts are non-empty --- b1) Check that the DEFAULT comes first, if it exists --- b2) Check that the others are in increasing order --- c) Check that there's a default for infinite types --- NB: Algebraic cases are not necessarily exhaustive, because --- the simplifier correctly eliminates case that can't --- possibly match. - -checkCaseAlts e ty alts = - do { checkL (all non_deflt con_alts) (mkNonDefltMsg e) - -- See GHC.Core Note [Case expression invariants] item (2) - - ; checkL (increasing_tag con_alts) (mkNonIncreasingAltsMsg e) - -- See GHC.Core Note [Case expression invariants] item (3) - - -- For types Int#, Word# with an infinite (well, large!) number of - -- possible values, there should usually be a DEFAULT case - -- But (see Note [Empty case alternatives] in GHC.Core) it's ok to - -- have *no* case alternatives. - -- In effect, this is a kind of partial test. I suppose it's possible - -- that we might *know* that 'x' was 1 or 2, in which case - -- case x of { 1 -> e1; 2 -> e2 } - -- would be fine. - ; checkL (isJust maybe_deflt || not is_infinite_ty || null alts) - (nonExhaustiveAltsMsg e) } - where - (con_alts, maybe_deflt) = findDefault alts - - -- Check that successive alternatives have strictly increasing tags - increasing_tag (alt1 : rest@( alt2 : _)) = alt1 `ltAlt` alt2 && increasing_tag rest - increasing_tag _ = True - - non_deflt (Alt DEFAULT _ _) = False - non_deflt _ = True - - is_infinite_ty = case tyConAppTyCon_maybe ty of - Nothing -> False - Just tycon -> isPrimTyCon tycon - -lintAltExpr :: CoreExpr -> LintedType -> LintM UsageEnv -lintAltExpr expr ann_ty - = do { (actual_ty, ue) <- lintCoreExpr expr - ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) - ; return ue } - -- See GHC.Core Note [Case expression invariants] item (6) - -lintCoreAlt :: Var -- Case binder - -> LintedType -- Type of scrutinee - -> Mult -- Multiplicity of scrutinee - -> LintedType -- Type of the alternative - -> CoreAlt - -> LintM UsageEnv --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintCoreAlt case_bndr _ scrut_mult alt_ty (Alt DEFAULT args rhs) = - do { lintL (null args) (mkDefaultArgsMsg args) - ; rhs_ue <- lintAltExpr rhs alt_ty - ; let (case_bndr_usage, rhs_ue') = popUE rhs_ue case_bndr - err_msg = text "Linearity failure in the DEFAULT clause:" <+> ppr case_bndr - $$ ppr case_bndr_usage <+> text "⊈" <+> ppr scrut_mult - ; ensureSubUsage case_bndr_usage scrut_mult err_msg - ; return rhs_ue' } - -lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) - | litIsLifted lit - = failWithL integerScrutinisedMsg - | otherwise - = do { lintL (null args) (mkDefaultArgsMsg args) - ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty) - ; rhs_ue <- lintAltExpr rhs alt_ty - ; return (deleteUE rhs_ue case_bndr) -- No need for linearity checks - } - where - lit_ty = literalType lit - -lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rhs) - | isNewTyCon (dataConTyCon con) - = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) - | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty - = addLoc (CaseAlt alt) $ do - { checkTypeDataConOcc "pattern" con - ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) - - -- Instantiate the universally quantified - -- type variables of the data constructor - ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys - ; binderMult (Named _) = ManyTy - ; binderMult (Anon st _) = scaledMult st - -- See Note [Validating multiplicities in a case] - ; multiplicities = map binderMult $ fst $ splitPiTys con_payload_ty } - - -- And now bring the new binders into scope - ; lintBinders CasePatBind args $ \ args' -> do - { - rhs_ue <- lintAltExpr rhs alt_ty - ; rhs_ue' <- addLoc (CasePat alt) (lintAltBinders rhs_ue case_bndr scrut_ty con_payload_ty (zipEqual "lintCoreAlt" multiplicities args')) - ; return $ deleteUE rhs_ue' case_bndr - } - } - - | otherwise -- Scrut-ty is wrong shape - = zeroUE <$ addErrL (mkBadAltMsg scrut_ty alt) - -{- -Note [Validating multiplicities in a case] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose 'MkT :: a %m -> T m a'. -If we are validating 'case (x :: T Many a) of MkT y -> ...', -we have to substitute m := Many in the type of MkT - in particular, -y can be used Many times and that expression would still be linear in x. -We do this by looking at con_payload_ty, which is the type of the datacon -applied to the surrounding arguments. -Testcase: linear/should_compile/MultConstructor - -Data constructors containing existential tyvars will then have -Named binders, which are always multiplicity Many. -Testcase: indexed-types/should_compile/GADT1 --} - -lintLinearBinder :: SDoc -> Mult -> Mult -> LintM () -lintLinearBinder doc actual_usage described_usage - = ensureSubMult actual_usage described_usage err_msg - where - err_msg = (text "Multiplicity of variable does not agree with its context" - $$ doc - $$ ppr actual_usage - $$ text "Annotation:" <+> ppr described_usage) - -{- -************************************************************************ -* * -\subsection[lint-types]{Types} -* * -************************************************************************ --} - --- When we lint binders, we (one at a time and in order): --- 1. Lint var types or kinds (possibly substituting) --- 2. Add the binder to the in scope set, and if its a coercion var, --- we may extend the substitution to reflect its (possibly) new kind -lintBinders :: BindingSite -> [Var] -> ([Var] -> LintM a) -> LintM a -lintBinders _ [] linterF = linterF [] -lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> - lintBinders site vars $ \ vars' -> - linterF (var':vars') - --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintBinder :: BindingSite -> Var -> (Var -> LintM a) -> LintM a -lintBinder site var linterF - | isTyCoVar var = lintTyCoBndr var linterF - | otherwise = lintIdBndr NotTopLevel site var linterF - -lintTyBndr :: TyVar -> (LintedTyCoVar -> LintM a) -> LintM a -lintTyBndr = lintTyCoBndr -- We could specialise it, I guess - -lintTyCoBndr :: TyCoVar -> (LintedTyCoVar -> LintM a) -> LintM a -lintTyCoBndr tcv thing_inside - = do { subst <- getSubst - ; tcv_type' <- lintType (varType tcv) - ; let tcv' = uniqAway (getSubstInScope subst) $ - setVarType tcv tcv_type' - subst' = extendTCvSubstWithClone subst tcv tcv' - - -- See (FORALL1) and (FORALL2) in GHC.Core.Type - ; if (isTyVar tcv) - then -- Check that in (forall (a:ki). blah) we have ki:Type - lintL (isLiftedTypeKind (typeKind tcv_type')) $ - hang (text "TyVar whose kind does not have kind Type:") - 2 (ppr tcv' <+> dcolon <+> ppr tcv_type' <+> dcolon <+> ppr (typeKind tcv_type')) - else -- Check that in (forall (cv::ty). blah), - -- then ty looks like (t1 ~# t2) - lintL (isCoVarType tcv_type') $ - text "CoVar with non-coercion type:" <+> pprTyVar tcv - - ; updateSubst subst' (thing_inside tcv') } - -lintIdBndrs :: forall a. TopLevelFlag -> [Id] -> ([LintedId] -> LintM a) -> LintM a -lintIdBndrs top_lvl ids thing_inside - = go ids thing_inside - where - go :: [Id] -> ([Id] -> LintM a) -> LintM a - go [] thing_inside = thing_inside [] - go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> - go ids $ \ids' -> - thing_inside (id' : ids') - -lintIdBndr :: TopLevelFlag -> BindingSite - -> InVar -> (OutVar -> LintM a) -> LintM a --- Do substitution on the type of a binder and add the var with this --- new type to the in-scope set of the second argument --- ToDo: lint its rules -lintIdBndr top_lvl bind_site id thing_inside - = assertPpr (isId id) (ppr id) $ - do { flags <- getLintFlags - ; checkL (not (lf_check_global_ids flags) || isLocalId id) - (text "Non-local Id binder" <+> ppr id) - -- See Note [Checking for global Ids] - - -- Check that if the binder is nested, it is not marked as exported - ; checkL (not (isExportedId id) || is_top_lvl) - (mkNonTopExportedMsg id) - - -- Check that if the binder is nested, it does not have an external name - ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) - (mkNonTopExternalNameMsg id) - - -- See Note [Representation polymorphism invariants] in GHC.Core - ; lintL (isJoinId id || not (lf_check_fixed_rep flags) - || typeHasFixedRuntimeRep id_ty) $ - text "Binder does not have a fixed runtime representation:" <+> ppr id <+> dcolon <+> - parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) - - -- Check that a join-id is a not-top-level let-binding - ; when (isJoinId id) $ - checkL (not is_top_lvl && is_let_bind) $ - mkBadJoinBindMsg id - - -- Check that the Id does not have type (t1 ~# t2) or (t1 ~R# t2); - -- if so, it should be a CoVar, and checked by lintCoVarBndr - ; lintL (not (isCoVarType id_ty)) - (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) - - -- Check that the lambda binder has no value or OtherCon unfolding. - -- See #21496 - ; lintL (not (bind_site == LambdaBind && isEvaldUnfolding (idUnfolding id))) - (text "Lambda binder with value or OtherCon unfolding.") - - ; linted_ty <- addLoc (IdTy id) (lintValueType id_ty) - - ; addInScopeId id linted_ty $ - thing_inside (setIdType id linted_ty) } - where - id_ty = idType id - - is_top_lvl = isTopLevel top_lvl - is_let_bind = case bind_site of - LetBind -> True - _ -> False - -{- -%************************************************************************ -%* * - Types -%* * -%************************************************************************ --} - -lintValueType :: Type -> LintM LintedType --- Types only, not kinds --- Check the type, and apply the substitution to it --- See Note [Linting type lets] -lintValueType ty - = addLoc (InType ty) $ - do { ty' <- lintType ty - ; let sk = typeKind ty' - ; lintL (isTYPEorCONSTRAINT sk) $ - hang (text "Ill-kinded type:" <+> ppr ty) - 2 (text "has kind:" <+> ppr sk) - ; return ty' } - -checkTyCon :: TyCon -> LintM () -checkTyCon tc - = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) - -------------------- -checkTyCoVarInScope :: Subst -> TyCoVar -> LintM () -checkTyCoVarInScope subst tcv - = checkL (tcv `isInScope` subst) $ - hang (text "The type or coercion variable" <+> pprBndr LetBind tcv) - 2 (text "is out of scope") - -------------------- -lintType :: Type -> LintM LintedType - --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintType (TyVarTy tv) - | not (isTyVar tv) - = failWithL (mkBadTyVarMsg tv) - - | otherwise - = do { subst <- getSubst - ; case lookupTyVar subst tv of - Just linted_ty -> return linted_ty - - -- In GHCi we may lint an expression with a free - -- type variable. Then it won't be in the - -- substitution, but it should be in scope - Nothing -> do { checkTyCoVarInScope subst tv - ; return (TyVarTy tv) } - } - -lintType ty@(AppTy t1 t2) - | TyConApp {} <- t1 - = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty - | otherwise - = do { t1' <- lintType t1 - ; t2' <- lintType t2 - ; lint_ty_app ty (typeKind t1') [t2'] - ; return (AppTy t1' t2') } - -lintType ty@(TyConApp tc tys) - | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc - = do { report_unsat <- lf_report_unsat_syns <$> getLintFlags - ; lintTySynFamApp report_unsat ty tc tys } - - | Just {} <- tyConAppFunTy_maybe tc tys - -- We should never see a saturated application of funTyCon; such - -- applications should be represented with the FunTy constructor. - -- See Note [Linting function types] - = failWithL (hang (text "Saturated application of" <+> quotes (ppr tc)) 2 (ppr ty)) - - | otherwise -- Data types, data families, primitive types - = do { checkTyCon tc - ; tys' <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) tys' - ; return (TyConApp tc tys') } - --- arrows can related *unlifted* kinds, so this has to be separate from --- a dependent forall. -lintType ty@(FunTy af tw t1 t2) - = do { t1' <- lintType t1 - ; t2' <- lintType t2 - ; tw' <- lintType tw - ; lintArrow (text "type or kind" <+> quotes (ppr ty)) t1' t2' tw' - ; let real_af = chooseFunTyFlag t1 t2 - ; unless (real_af == af) $ addErrL $ - hang (text "Bad FunTyFlag in FunTy") - 2 (vcat [ ppr ty - , text "FunTyFlag =" <+> ppr af - , text "Computed FunTyFlag =" <+> ppr real_af ]) - ; return (FunTy af tw' t1' t2') } - -lintType ty@(ForAllTy (Bndr tcv vis) body_ty) - | not (isTyCoVar tcv) - = failWithL (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr ty) - | otherwise - = lintTyCoBndr tcv $ \tcv' -> - do { body_ty' <- lintType body_ty - ; lintForAllBody tcv' body_ty' - - ; when (isCoVar tcv) $ - lintL (tcv `elemVarSet` tyCoVarsOfType body_ty) $ - text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) - -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] - - ; return (ForAllTy (Bndr tcv' vis) body_ty') } - -lintType ty@(LitTy l) - = do { lintTyLit l; return ty } - -lintType (CastTy ty co) - = do { ty' <- lintType ty - ; co' <- lintStarCoercion co - ; let tyk = typeKind ty' - cok = coercionLKind co' - ; ensureEqTys tyk cok (mkCastTyErr ty co tyk cok) - ; return (CastTy ty' co') } - -lintType (CoercionTy co) - = do { co' <- lintCoercion co - ; return (CoercionTy co') } - ------------------ -lintForAllBody :: LintedTyCoVar -> LintedType -> LintM () --- Do the checks for the body of a forall-type -lintForAllBody tcv body_ty - = do { checkValueType body_ty (text "the body of forall:" <+> ppr body_ty) - - -- For type variables, check for skolem escape - -- See Note [Phantom type variables in kinds] in GHC.Core.Type - -- The kind of (forall cv. th) is liftedTypeKind, so no - -- need to check for skolem-escape in the CoVar case - ; let body_kind = typeKind body_ty - ; when (isTyVar tcv) $ - case occCheckExpand [tcv] body_kind of - Just {} -> return () - Nothing -> failWithL $ - hang (text "Variable escape in forall:") - 2 (vcat [ text "tyvar:" <+> ppr tcv - , text "type:" <+> ppr body_ty - , text "kind:" <+> ppr body_kind ]) - } - ------------------ -lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM LintedType --- The TyCon is a type synonym or a type family (not a data family) --- See Note [Linting type synonym applications] --- c.f. GHC.Tc.Validity.check_syn_tc_app -lintTySynFamApp report_unsat ty tc tys - | report_unsat -- Report unsaturated only if report_unsat is on - , tys `lengthLessThan` tyConArity tc - = failWithL (hang (text "Un-saturated type application") 2 (ppr ty)) - - -- Deal with type synonyms - | ExpandsSyn tenv rhs tys' <- expandSynTyCon_maybe tc tys - , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' - = do { -- Kind-check the argument types, but without reporting - -- un-saturated type families/synonyms - tys' <- setReportUnsat False (mapM lintType tys) - - ; when report_unsat $ - do { _ <- lintType expanded_ty - ; return () } - - ; lint_ty_app ty (tyConKind tc) tys' - ; return (TyConApp tc tys') } - - -- Otherwise this must be a type family - | otherwise - = do { tys' <- mapM lintType tys - ; lint_ty_app ty (tyConKind tc) tys' - ; return (TyConApp tc tys') } - ------------------ --- Confirms that a type is really TYPE r or Constraint -checkValueType :: LintedType -> SDoc -> LintM () -checkValueType ty doc - = lintL (isTYPEorCONSTRAINT kind) - (text "Non-Type-like kind when Type-like expected:" <+> ppr kind $$ - text "when checking" <+> doc) - where - kind = typeKind ty - ------------------ -lintArrow :: SDoc -> LintedType -> LintedType -> LintedType -> LintM () --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] -lintArrow what t1 t2 tw -- Eg lintArrow "type or kind `blah'" k1 k2 kw - -- or lintArrow "coercion `blah'" k1 k2 kw - = do { unless (isTYPEorCONSTRAINT k1) (report (text "argument") k1) - ; unless (isTYPEorCONSTRAINT k2) (report (text "result") k2) - ; unless (isMultiplicityTy kw) (report (text "multiplicity") kw) } - where - k1 = typeKind t1 - k2 = typeKind t2 - kw = typeKind tw - report ar k = addErrL (vcat [ hang (text "Ill-kinded" <+> ar) - 2 (text "in" <+> what) - , what <+> text "kind:" <+> ppr k ]) - ------------------ -lint_ty_app :: Type -> LintedKind -> [LintedType] -> LintM () -lint_ty_app msg_ty k tys - -- See Note [Avoiding compiler perf traps when constructing error messages.] - = lint_app (\msg_ty -> text "type" <+> quotes (ppr msg_ty)) msg_ty k tys - ----------------- -lint_co_app :: Coercion -> LintedKind -> [LintedType] -> LintM () -lint_co_app msg_ty k tys - -- See Note [Avoiding compiler perf traps when constructing error messages.] - = lint_app (\msg_ty -> text "coercion" <+> quotes (ppr msg_ty)) msg_ty k tys - ----------------- -lintTyLit :: TyLit -> LintM () -lintTyLit (NumTyLit n) - | n >= 0 = return () - | otherwise = failWithL msg - where msg = text "Negative type literal:" <+> integer n -lintTyLit (StrTyLit _) = return () -lintTyLit (CharTyLit _) = return () - -lint_app :: Outputable msg_thing => (msg_thing -> SDoc) -> msg_thing -> LintedKind -> [LintedType] -> LintM () --- (lint_app d fun_kind arg_tys) --- We have an application (f arg_ty1 .. arg_tyn), --- where f :: fun_kind - --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] --- --- Being strict in the kind here avoids quite a few pointless thunks --- reducing allocations by ~5% -lint_app mk_msg msg_type !kfn arg_tys - = do { !in_scope <- getInScope - -- We need the in_scope set to satisfy the invariant in - -- Note [The substitution invariant] in GHC.Core.TyCo.Subst - -- Forcing the in scope set eagerly here reduces allocations by up to 4%. - ; go_app in_scope kfn arg_tys - } - where - - -- We use explicit recursion instead of a fold here to avoid go_app becoming - -- an allocated function closure. This reduced allocations by up to 7% for some - -- modules. - go_app :: InScopeSet -> LintedKind -> [Type] -> LintM () - go_app !in_scope !kfn ta - | Just kfn' <- coreView kfn - = go_app in_scope kfn' ta - - go_app _in_scope _kind [] = return () - - go_app in_scope fun_kind@(FunTy _ _ kfa kfb) (ta:tas) - = do { let ka = typeKind ta - ; unless (ka `eqType` kfa) $ - addErrL (lint_app_fail_msg kfn arg_tys mk_msg msg_type (text "Fun:" <+> (ppr fun_kind $$ ppr ta <+> dcolon <+> ppr ka))) - ; go_app in_scope kfb tas } - - go_app in_scope (ForAllTy (Bndr kv _vis) kfn) (ta:tas) - = do { let kv_kind = varType kv - ka = typeKind ta - ; unless (ka `eqType` kv_kind) $ - addErrL (lint_app_fail_msg kfn arg_tys mk_msg msg_type (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ - ppr ta <+> dcolon <+> ppr ka))) - ; let kind' = substTy (extendTCvSubst (mkEmptySubst in_scope) kv ta) kfn - ; go_app in_scope kind' tas } - - go_app _ kfn ta - = failWithL (lint_app_fail_msg kfn arg_tys mk_msg msg_type (text "Not a fun:" <+> (ppr kfn $$ ppr ta))) - --- This is a top level definition to ensure we pass all variables of the error message --- explicitly and don't capture them as free variables. Otherwise this binder might --- become a thunk that get's allocated in the hot code path. --- See Note [Avoiding compiler perf traps when constructing error messages.] -lint_app_fail_msg :: (Outputable a1, Outputable a2) => a1 -> a2 -> (t -> SDoc) -> t -> SDoc -> SDoc -lint_app_fail_msg kfn arg_tys mk_msg msg_type extra = vcat [ hang (text "Kind application error in") 2 (mk_msg msg_type) - , nest 2 (text "Function kind =" <+> ppr kfn) - , nest 2 (text "Arg types =" <+> ppr arg_tys) - , extra ] -{- ********************************************************************* -* * - Linting rules -* * -********************************************************************* -} - -lintCoreRule :: OutVar -> LintedType -> CoreRule -> LintM () -lintCoreRule _ _ (BuiltinRule {}) - = return () -- Don't bother - -lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs - , ru_args = args, ru_rhs = rhs }) - = lintBinders LambdaBind bndrs $ \ _ -> - do { (lhs_ty, _) <- lintCoreArgs (fun_ty, zeroUE) args - ; (rhs_ty, _) <- case idJoinPointHood fun of - JoinPoint join_arity - -> do { checkL (args `lengthIs` join_arity) $ - mkBadJoinPointRuleMsg fun join_arity rule - -- See Note [Rules for join points] - ; lintCoreExpr rhs } - _ -> markAllJoinsBad $ lintCoreExpr rhs - ; ensureEqTys lhs_ty rhs_ty $ - (rule_doc <+> vcat [ text "lhs type:" <+> ppr lhs_ty - , text "rhs type:" <+> ppr rhs_ty - , text "fun_ty:" <+> ppr fun_ty ]) - ; let bad_bndrs = filter is_bad_bndr bndrs - - ; checkL (null bad_bndrs) - (rule_doc <+> text "unbound" <+> ppr bad_bndrs) - -- See Note [Linting rules] - } - where - rule_doc = text "Rule" <+> doubleQuotes (ftext name) <> colon - - lhs_fvs = exprsFreeVars args - rhs_fvs = exprFreeVars rhs - - is_bad_bndr :: Var -> Bool - -- See Note [Unbound RULE binders] in GHC.Core.Rules - is_bad_bndr bndr = not (bndr `elemVarSet` lhs_fvs) - && bndr `elemVarSet` rhs_fvs - && isNothing (isReflCoVar_maybe bndr) - - -{- Note [Linting rules] -~~~~~~~~~~~~~~~~~~~~~~~ -It's very bad if simplifying a rule means that one of the template -variables (ru_bndrs) that /is/ mentioned on the RHS becomes -not-mentioned in the LHS (ru_args). How can that happen? Well, in #10602, -SpecConstr stupidly constructed a rule like - - forall x,c1,c2. - f (x |> c1 |> c2) = .... - -But simplExpr collapses those coercions into one. (Indeed in #10602, -it collapsed to the identity and was removed altogether.) - -We don't have a great story for what to do here, but at least -this check will nail it. - -NB (#11643): it's possible that a variable listed in the -binders becomes not-mentioned on both LHS and RHS. Here's a silly -example: - RULE forall x y. f (g x y) = g (x+1) (y-1) -And suppose worker/wrapper decides that 'x' is Absent. Then -we'll end up with - RULE forall x y. f ($gw y) = $gw (x+1) -This seems sufficiently obscure that there isn't enough payoff to -try to trim the forall'd binder list. - -Note [Rules for join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A join point cannot be partially applied. However, the left-hand side of a rule -for a join point is effectively a *pattern*, not a piece of code, so there's an -argument to be made for allowing a situation like this: - - join $sj :: Int -> Int -> String - $sj n m = ... - j :: forall a. Eq a => a -> a -> String - {-# RULES "SPEC j" jump j @ Int $dEq = jump $sj #-} - j @a $dEq x y = ... - -Applying this rule can't turn a well-typed program into an ill-typed one, so -conceivably we could allow it. But we can always eta-expand such an -"undersaturated" rule (see 'GHC.Core.Opt.Arity.etaExpandToJoinPointRule'), and in fact -the simplifier would have to in order to deal with the RHS. So we take a -conservative view and don't allow undersaturated rules for join points. See -Note [Join points and unfoldings/rules] in "GHC.Core.Opt.OccurAnal" for further discussion. --} - -{- -************************************************************************ -* * - Linting coercions -* * -************************************************************************ --} - -{- Note [Asymptotic efficiency] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When linting coercions (and types actually) we return a linted -(substituted) coercion. Then we often have to take the coercionKind of -that returned coercion. If we get long chains, that can be asymptotically -inefficient, notably in -* TransCo -* InstCo -* SelCo (cf #9233) -* LRCo - -But the code is simple. And this is only Lint. Let's wait to see if -the bad perf bites us in practice. - -A solution would be to return the kind and role of the coercion, -as well as the linted coercion. Or perhaps even *only* the kind and role, -which is what used to happen. But that proved tricky and error prone -(#17923), so now we return the coercion. --} - - --- lints a coercion, confirming that its lh kind and its rh kind are both * --- also ensures that the role is Nominal -lintStarCoercion :: InCoercion -> LintM LintedCoercion -lintStarCoercion g - = do { g' <- lintCoercion g - ; let Pair t1 t2 = coercionKind g' - ; checkValueType t1 (text "the kind of the left type in" <+> ppr g) - ; checkValueType t2 (text "the kind of the right type in" <+> ppr g) - ; lintRole g Nominal (coercionRole g) - ; return g' } - -lintCoercion :: InCoercion -> LintM LintedCoercion --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] - -lintCoercion (CoVarCo cv) - | not (isCoVar cv) - = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) - 2 (text "With offending type:" <+> ppr (varType cv))) - - | otherwise - = do { subst <- getSubst - ; case lookupCoVar subst cv of - Just linted_co -> return linted_co ; - Nothing -> do { checkTyCoVarInScope subst cv - ; return (CoVarCo cv) } - } - - -lintCoercion (Refl ty) - = do { ty' <- lintType ty - ; return (Refl ty') } - -lintCoercion (GRefl r ty MRefl) - = do { ty' <- lintType ty - ; return (GRefl r ty' MRefl) } - -lintCoercion (GRefl r ty (MCo co)) - = do { ty' <- lintType ty - ; co' <- lintCoercion co - ; let tk = typeKind ty' - tl = coercionLKind co' - ; ensureEqTys tk tl $ - hang (text "GRefl coercion kind mis-match:" <+> ppr co) - 2 (vcat [ppr ty', ppr tk, ppr tl]) - ; lintRole co' Nominal (coercionRole co') - ; return (GRefl r ty' (MCo co')) } - -lintCoercion co@(TyConAppCo r tc cos) - | Just {} <- tyConAppFunCo_maybe r tc cos - = failWithL (hang (text "Saturated application of" <+> quotes (ppr tc)) - 2 (ppr co)) - -- All saturated TyConAppCos should be FunCos - - | Just {} <- synTyConDefn_maybe tc - = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) - - | otherwise - = do { checkTyCon tc - ; cos' <- mapM lintCoercion cos - ; let (co_kinds, co_roles) = unzip (map coercionKindRole cos') - ; lint_co_app co (tyConKind tc) (map pFst co_kinds) - ; lint_co_app co (tyConKind tc) (map pSnd co_kinds) - ; zipWithM_ (lintRole co) (tyConRoleListX r tc) co_roles - ; return (TyConAppCo r tc cos') } - -lintCoercion co@(AppCo co1 co2) - | TyConAppCo {} <- co1 - = failWithL (text "TyConAppCo to the left of AppCo:" <+> ppr co) - | Just (TyConApp {}, _) <- isReflCo_maybe co1 - = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) - | otherwise - = do { co1' <- lintCoercion co1 - ; co2' <- lintCoercion co2 - ; let (Pair lk1 rk1, r1) = coercionKindRole co1' - (Pair lk2 rk2, r2) = coercionKindRole co2' - ; lint_co_app co (typeKind lk1) [lk2] - ; lint_co_app co (typeKind rk1) [rk2] - - ; if r1 == Phantom - then lintL (r2 == Phantom || r2 == Nominal) - (text "Second argument in AppCo cannot be R:" $$ - ppr co) - else lintRole co Nominal r2 - - ; return (AppCo co1' co2') } - ----------- -lintCoercion co@(ForAllCo { fco_tcv = tcv, fco_visL = visL, fco_visR = visR - , fco_kind = kind_co, fco_body = body_co }) --- See Note [ForAllCo] in GHC.Core.TyCo.Rep, --- including the typing rule for ForAllCo - - | not (isTyCoVar tcv) - = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) - - | otherwise - = do { kind_co' <- lintStarCoercion kind_co - ; lintTyCoBndr tcv $ \tcv' -> - do { body_co' <- lintCoercion body_co - ; ensureEqTys (varType tcv') (coercionLKind kind_co') $ - text "Kind mis-match in ForallCo" <+> ppr co - - -- Assuming kind_co :: k1 ~ k2 - -- Need to check that - -- (forall (tcv:k1). lty) and - -- (forall (tcv:k2). rty[(tcv:k2) |> sym kind_co/tcv]) - -- are both well formed. Easiest way is to call lintForAllBody - -- for each; there is actually no need to do the funky substitution - ; let (Pair lty rty, body_role) = coercionKindRole body_co' - ; lintForAllBody tcv' lty - ; lintForAllBody tcv' rty - - ; when (isCoVar tcv) $ - do { lintL (visL == coreTyLamForAllTyFlag && visR == coreTyLamForAllTyFlag) $ - text "Invalid visibility flags in CoVar ForAllCo" <+> ppr co - -- See (FC7) in Note [ForAllCo] in GHC.Core.TyCo.Rep - ; lintL (almostDevoidCoVarOfCo tcv body_co) $ - text "Covar can only appear in Refl and GRefl: " <+> ppr co - -- See (FC6) in Note [ForAllCo] in GHC.Core.TyCo.Rep - } - - ; when (body_role == Nominal) $ - lintL (visL `eqForAllVis` visR) $ - text "Nominal ForAllCo has mismatched visibilities: " <+> ppr co - - ; return (co { fco_tcv = tcv', fco_kind = kind_co', fco_body = body_co' }) } } - -lintCoercion co@(FunCo { fco_role = r, fco_afl = afl, fco_afr = afr - , fco_mult = cow, fco_arg = co1, fco_res = co2 }) - = do { co1' <- lintCoercion co1 - ; co2' <- lintCoercion co2 - ; cow' <- lintCoercion cow - ; let Pair lt1 rt1 = coercionKind co1 - Pair lt2 rt2 = coercionKind co2 - Pair ltw rtw = coercionKind cow - ; lintL (afl == chooseFunTyFlag lt1 lt2) (bad_co_msg "afl") - ; lintL (afr == chooseFunTyFlag rt1 rt2) (bad_co_msg "afr") - ; lintArrow (bad_co_msg "arrowl") lt1 lt2 ltw - ; lintArrow (bad_co_msg "arrowr") rt1 rt2 rtw - ; lintRole co1 r (coercionRole co1) - ; lintRole co2 r (coercionRole co2) - ; ensureEqTys (typeKind ltw) multiplicityTy (bad_co_msg "mult-l") - ; ensureEqTys (typeKind rtw) multiplicityTy (bad_co_msg "mult-r") - ; let expected_mult_role = case r of - Phantom -> Phantom - _ -> Nominal - ; lintRole cow expected_mult_role (coercionRole cow) - ; return (co { fco_mult = cow', fco_arg = co1', fco_res = co2' }) } - where - bad_co_msg s = hang (text "Bad coercion" <+> parens (text s)) - 2 (vcat [ text "afl:" <+> ppr afl - , text "afr:" <+> ppr afr - , text "arg_co:" <+> ppr co1 - , text "res_co:" <+> ppr co2 ]) - --- See Note [Bad unsafe coercion] -lintCoercion co@(UnivCo { uco_role = r, uco_prov = prov - , uco_lty = ty1, uco_rty = ty2, uco_deps = deps }) - = do { -- Check the role. PhantomProv must have Phantom role, otherwise any role is fine - case prov of - PhantomProv -> lintRole co Phantom r - _ -> return () - - -- Check the to and from types - ; ty1' <- lintType ty1 - ; ty2' <- lintType ty2 - - ; let k1 = typeKind ty1' - k2 = typeKind ty2' - ; when (r /= Phantom && isTYPEorCONSTRAINT k1 - && isTYPEorCONSTRAINT k2) - (checkTypes ty1 ty2) - - -- Check the coercions on which this UnivCo depends - ; deps' <- mapM lintCoercion deps - - ; return (co { uco_lty = ty1', uco_rty = ty2', uco_deps = deps' }) } - where - report s = hang (text $ "Unsafe coercion: " ++ s) - 2 (vcat [ text "From:" <+> ppr ty1 - , text " To:" <+> ppr ty2]) - isUnBoxed :: PrimRep -> Bool - isUnBoxed = not . isGcPtrRep - - -- see #9122 for discussion of these checks - checkTypes t1 t2 - = do { checkWarnL fixed_rep_1 - (report "left-hand type does not have a fixed runtime representation") - ; checkWarnL fixed_rep_2 - (report "right-hand type does not have a fixed runtime representation") - ; when (fixed_rep_1 && fixed_rep_2) $ - do { checkWarnL (reps1 `equalLength` reps2) - (report "between values with different # of reps") - ; zipWithM_ validateCoercion reps1 reps2 }} - where - fixed_rep_1 = typeHasFixedRuntimeRep t1 - fixed_rep_2 = typeHasFixedRuntimeRep t2 - - -- don't look at these unless lev_poly1/2 are False - -- Otherwise, we get #13458 - reps1 = typePrimRep t1 - reps2 = typePrimRep t2 - - validateCoercion :: PrimRep -> PrimRep -> LintM () - validateCoercion rep1 rep2 - = do { platform <- getPlatform - ; checkWarnL (isUnBoxed rep1 == isUnBoxed rep2) - (report "between unboxed and boxed value") - ; checkWarnL (TyCon.primRepSizeB platform rep1 - == TyCon.primRepSizeB platform rep2) - (report "between unboxed values of different size") - ; let fl = liftM2 (==) (TyCon.primRepIsFloat rep1) - (TyCon.primRepIsFloat rep2) - ; case fl of - Nothing -> addWarnL (report "between vector types") - Just False -> addWarnL (report "between float and integral values") - _ -> return () - } - -lintCoercion (SymCo co) - = do { co' <- lintCoercion co - ; return (SymCo co') } - -lintCoercion co@(TransCo co1 co2) - = do { co1' <- lintCoercion co1 - ; co2' <- lintCoercion co2 - ; let ty1b = coercionRKind co1' - ty2a = coercionLKind co2' - ; ensureEqTys ty1b ty2a - (hang (text "Trans coercion mis-match:" <+> ppr co) - 2 (vcat [ppr (coercionKind co1'), ppr (coercionKind co2')])) - ; lintRole co (coercionRole co1) (coercionRole co2) - ; return (TransCo co1' co2') } - -lintCoercion the_co@(SelCo cs co) - = do { co' <- lintCoercion co - ; let (Pair s t, co_role) = coercionKindRole co' - - ; if -- forall (both TyVar and CoVar) - | Just _ <- splitForAllTyCoVar_maybe s - , Just _ <- splitForAllTyCoVar_maybe t - , SelForAll <- cs - , (isForAllTy_ty s && isForAllTy_ty t) - || (isForAllTy_co s && isForAllTy_co t) - -> return (SelCo cs co') - - -- function - | isFunTy s - , isFunTy t - , SelFun {} <- cs - -> return (SelCo cs co') - - -- TyCon - | Just (tc_s, tys_s) <- splitTyConApp_maybe s - , Just (tc_t, tys_t) <- splitTyConApp_maybe t - , tc_s == tc_t - , SelTyCon n r0 <- cs - , isInjectiveTyCon tc_s co_role - -- see Note [SelCo and newtypes] in GHC.Core.TyCo.Rep - , tys_s `equalLength` tys_t - , tys_s `lengthExceeds` n - -> do { lintRole the_co (tyConRole co_role tc_s n) r0 - ; return (SelCo cs co') } - - | otherwise - -> failWithL (hang (text "Bad SelCo:") - 2 (ppr the_co $$ ppr s $$ ppr t)) } - -lintCoercion the_co@(LRCo lr co) - = do { co' <- lintCoercion co - ; let Pair s t = coercionKind co' - r = coercionRole co' - ; lintRole co Nominal r - ; case (splitAppTy_maybe s, splitAppTy_maybe t) of - (Just _, Just _) -> return (LRCo lr co') - _ -> failWithL (hang (text "Bad LRCo:") - 2 (ppr the_co $$ ppr s $$ ppr t)) } - -lintCoercion (InstCo co arg) - = do { co' <- lintCoercion co - ; arg' <- lintCoercion arg - ; let Pair t1 t2 = coercionKind co' - Pair s1 s2 = coercionKind arg' - - ; lintRole arg Nominal (coercionRole arg') - - ; case (splitForAllTyVar_maybe t1, splitForAllTyVar_maybe t2) of - -- forall over tvar - { (Just (tv1,_), Just (tv2,_)) - | typeKind s1 `eqType` tyVarKind tv1 - , typeKind s2 `eqType` tyVarKind tv2 - -> return (InstCo co' arg') - | otherwise - -> failWithL (text "Kind mis-match in inst coercion1" <+> ppr co) - - ; _ -> case (splitForAllCoVar_maybe t1, splitForAllCoVar_maybe t2) of - -- forall over covar - { (Just (cv1, _), Just (cv2, _)) - | typeKind s1 `eqType` varType cv1 - , typeKind s2 `eqType` varType cv2 - , CoercionTy _ <- s1 - , CoercionTy _ <- s2 - -> return (InstCo co' arg') - | otherwise - -> failWithL (text "Kind mis-match in inst coercion2" <+> ppr co) - - ; _ -> failWithL (text "Bad argument of inst") }}} - -lintCoercion this_co@(AxiomCo ax cos) - = do { cos' <- mapM lintCoercion cos - ; let arg_kinds :: [Pair Type] = map coercionKind cos' - ; lint_roles 0 (coAxiomRuleArgRoles ax) cos' - ; lint_ax ax arg_kinds - ; return (AxiomCo ax cos') } - where - lint_ax :: CoAxiomRule -> [Pair Type] -> LintM () - lint_ax (BuiltInFamRew bif) prs - = checkL (isJust (bifrw_proves bif prs)) bad_bif - lint_ax (BuiltInFamInj bif) prs - = checkL (case prs of - [pr] -> isJust (bifinj_proves bif pr) - _ -> False) - bad_bif - lint_ax (UnbranchedAxiom ax) prs - = lintBranch this_co (coAxiomTyCon ax) (coAxiomSingleBranch ax) prs - lint_ax (BranchedAxiom ax ind) prs - = do { checkL (0 <= ind && ind < numBranches (coAxiomBranches ax)) - (bad_ax this_co (text "index out of range")) - ; lintBranch this_co (coAxiomTyCon ax) (coAxiomNthBranch ax ind) prs } - - bad_bif = bad_ax this_co (text "Proves returns Nothing") - - err :: forall a. String -> [SDoc] -> LintM a - err m xs = failWithL $ - hang (text m) 2 $ vcat (text "Rule:" <+> ppr ax : xs) - - lint_roles n (e : es) (co : cos) - | e == coercionRole co - = lint_roles (n+1) es cos - | otherwise = err "Argument roles mismatch" - [ text "In argument:" <+> int (n+1) - , text "Expected:" <+> ppr e - , text "Found:" <+> ppr (coercionRole co) ] - lint_roles _ [] [] = return () - lint_roles n [] rs = err "Too many coercion arguments" - [ text "Expected:" <+> int n - , text "Provided:" <+> int (n + length rs) ] - - lint_roles n es [] = err "Not enough coercion arguments" - [ text "Expected:" <+> int (n + length es) - , text "Provided:" <+> int n ] - - -lintCoercion (KindCo co) - = do { co' <- lintCoercion co - ; return (KindCo co') } - -lintCoercion (SubCo co') - = do { co' <- lintCoercion co' - ; lintRole co' Nominal (coercionRole co') - ; return (SubCo co') } - -lintCoercion (HoleCo h) - = do { addErrL $ text "Unfilled coercion hole:" <+> ppr h - ; lintCoercion (CoVarCo (coHoleCoVar h)) } - - -{- -Note [Conflict checking for axiom applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following type family and axiom: - -type family Equal (a :: k) (b :: k) :: Bool -type instance where - Equal a a = True - Equal a b = False --- -Equal :: forall k::*. k -> k -> Bool -axEqual :: { forall k::*. forall a::k. Equal k a a ~ True - ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } - -The coercion (axEqual[1] <*> ) :: (Equal * Int Int ~ False) - -and that all is OK. But, all is not OK: we want to use the first branch of the -axiom in this case, not the second. The problem is that the parameters of the -first branch can unify with the supplied coercions, thus meaning that the first -branch should be taken. See also Note [Apartness] in "GHC.Core.FamInstEnv". - -For more details, see the section "Branched axiom conflict checking" in -docs/core-spec, which defines the corresponding no_conflict function used by the -Co_AxiomInstCo rule in the section "Coercion typing". --} - --- | Check to make sure that an axiom application is internally consistent. --- Returns the conflicting branch, if it exists --- Note [Conflict checking for axiom applications] -lintBranch :: Coercion -> TyCon-> CoAxBranch -> [Pair Type] -> LintM () --- defined here to avoid dependencies in GHC.Core.Coercion --- If you edit this function, you may need to update the GHC formalism --- See Note [GHC Formalism] in GHC.Core.Lint -lintBranch this_co fam_tc branch arg_kinds - | CoAxBranch { cab_tvs = ktvs, cab_cvs = cvs } <- branch - = do { checkL (arg_kinds `equalLength` (ktvs ++ cvs)) $ - (bad_ax this_co (text "lengths")) - - ; subst <- getSubst - ; let empty_subst = zapSubst subst - ; _ <- foldlM check_ki (empty_subst, empty_subst) - (zip (ktvs ++ cvs) arg_kinds) - - ; case check_no_conflict flattened_target incomps of - Nothing -> return () - Just bad_branch -> failWithL $ bad_ax this_co $ - text "inconsistent with" <+> - pprCoAxBranch fam_tc bad_branch } - where - check_ki (subst_l, subst_r) (ktv, Pair s' t') - = do { let sk' = typeKind s' - tk' = typeKind t' - ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) - ktv_kind_r = substTy subst_r (tyVarKind ktv) - ; checkL (sk' `eqType` ktv_kind_l) - (bad_ax this_co (text "check_ki1" <+> vcat [ ppr this_co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) - ; checkL (tk' `eqType` ktv_kind_r) - (bad_ax this_co (text "check_ki2" <+> vcat [ ppr this_co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) - ; return (extendTCvSubst subst_l ktv s', - extendTCvSubst subst_r ktv t') } - - tvs = coAxBranchTyVars branch - cvs = coAxBranchCoVars branch - incomps = coAxBranchIncomps branch - (tys, cotys) = splitAtList tvs (map pFst arg_kinds) - co_args = map stripCoercionTy cotys - subst = zipTvSubst tvs tys `composeTCvSubst` - zipCvSubst cvs co_args - target = Type.substTys subst (coAxBranchLHS branch) - in_scope = mkInScopeSet $ - unionVarSets (map (tyCoVarsOfTypes . coAxBranchLHS) incomps) - flattened_target = flattenTys in_scope target - - check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch - check_no_conflict _ [] = Nothing - check_no_conflict flat (b@CoAxBranch { cab_lhs = lhs_incomp } : rest) - -- See Note [Apartness] in GHC.Core.FamInstEnv - | SurelyApart <- tcUnifyTysFG alwaysBindFun flat lhs_incomp - = check_no_conflict flat rest - | otherwise - = Just b - -bad_ax :: Coercion -> SDoc -> SDoc -bad_ax this_co what - = hang (text "Bad axiom application" <+> parens what) 2 (ppr this_co) - - -{- -************************************************************************ -* * - Axioms -* * -************************************************************************ --} - -lintAxioms :: Logger - -> LintConfig - -> SDoc -- ^ The source of the linted axioms - -> [CoAxiom Branched] - -> IO () -lintAxioms logger cfg what axioms = - displayLintResults logger True what (vcat $ map pprCoAxiom axioms) $ - initL cfg $ - do { mapM_ lint_axiom axioms - ; let axiom_groups = groupWith coAxiomTyCon axioms - ; mapM_ lint_axiom_group axiom_groups } - -lint_axiom :: CoAxiom Branched -> LintM () -lint_axiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches - , co_ax_role = ax_role }) - = addLoc (InAxiom ax) $ - do { mapM_ (lint_branch tc) branch_list - ; extra_checks } - where - branch_list = fromBranches branches - - extra_checks - | isNewTyCon tc - = do { CoAxBranch { cab_tvs = ax_tvs - , cab_eta_tvs = eta_tvs - , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs_tys } - <- case branch_list of - [branch] -> return branch - _ -> failWithL (text "multi-branch axiom with newtype") - - -- The LHS of the axiom is (N lhs_tys) - -- We expect it to be (N ax_tvs) - ; lintL (mkTyVarTys ax_tvs `eqTypes` lhs_tys) - (text "Newtype axiom LHS does not match newtype definition") - ; lintL (null cvs) - (text "Newtype axiom binds coercion variables") - ; lintL (null eta_tvs) -- See Note [Eta reduction for data families] - -- which is not about newtype axioms - (text "Newtype axiom has eta-tvs") - ; lintL (ax_role == Representational) - (text "Newtype axiom role not representational") - ; lintL (roles `equalLength` ax_tvs) - (text "Newtype axiom roles list is the wrong length." $$ - text "roles:" <+> sep (map ppr roles)) - ; lintL (roles == takeList roles (tyConRoles tc)) - (vcat [ text "Newtype axiom roles do not match newtype tycon's." - , text "axiom roles:" <+> sep (map ppr roles) - , text "tycon roles:" <+> sep (map ppr (tyConRoles tc)) ]) - } - - | isFamilyTyCon tc - = do { if | isTypeFamilyTyCon tc - -> lintL (ax_role == Nominal) - (text "type family axiom is not nominal") - - | isDataFamilyTyCon tc - -> lintL (ax_role == Representational) - (text "data family axiom is not representational") - - | otherwise - -> addErrL (text "A family TyCon is neither a type family nor a data family:" <+> ppr tc) - - ; mapM_ (lint_family_branch tc) branch_list } - - | otherwise - = addErrL (text "Axiom tycon is neither a newtype nor a family.") - -lint_branch :: TyCon -> CoAxBranch -> LintM () -lint_branch ax_tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs - , cab_lhs = lhs_args, cab_rhs = rhs }) - = lintBinders LambdaBind (tvs ++ cvs) $ \_ -> - do { let lhs = mkTyConApp ax_tc lhs_args - ; lhs' <- lintType lhs - ; rhs' <- lintType rhs - ; let lhs_kind = typeKind lhs' - rhs_kind = typeKind rhs' - ; lintL (not (lhs_kind `typesAreApart` rhs_kind)) $ - hang (text "Inhomogeneous axiom") - 2 (text "lhs:" <+> ppr lhs <+> dcolon <+> ppr lhs_kind $$ - text "rhs:" <+> ppr rhs <+> dcolon <+> ppr rhs_kind) } - -- Type and Constraint are not Apart, so this test allows - -- the newtype axiom for a single-method class. Indeed the - -- whole reason Type and Constraint are not Apart is to allow - -- such axioms! - --- these checks do not apply to newtype axioms -lint_family_branch :: TyCon -> CoAxBranch -> LintM () -lint_family_branch fam_tc br@(CoAxBranch { cab_tvs = tvs - , cab_eta_tvs = eta_tvs - , cab_cvs = cvs - , cab_roles = roles - , cab_lhs = lhs - , cab_incomps = incomps }) - = do { lintL (isDataFamilyTyCon fam_tc || null eta_tvs) - (text "Type family axiom has eta-tvs") - ; lintL (all (`elemVarSet` tyCoVarsOfTypes lhs) tvs) - (text "Quantified variable in family axiom unused in LHS") - ; lintL (all isTyFamFree lhs) - (text "Type family application on LHS of family axiom") - ; lintL (all (== Nominal) roles) - (text "Non-nominal role in family axiom" $$ - text "roles:" <+> sep (map ppr roles)) - ; lintL (null cvs) - (text "Coercion variables bound in family axiom") - ; forM_ incomps $ \ br' -> - lintL (not (compatibleBranches br br')) $ - hang (text "Incorrect incompatible branches:") - 2 (vcat [text "Branch:" <+> ppr br, - text "Bogus incomp:" <+> ppr br']) } - -lint_axiom_group :: NonEmpty (CoAxiom Branched) -> LintM () -lint_axiom_group (_ :| []) = return () -lint_axiom_group (ax :| axs) - = do { lintL (isOpenFamilyTyCon tc) - (text "Non-open-family with multiple axioms") - ; let all_pairs = [ (ax1, ax2) | ax1 <- all_axs - , ax2 <- all_axs ] - ; mapM_ (lint_axiom_pair tc) all_pairs } - where - all_axs = ax : axs - tc = coAxiomTyCon ax - -lint_axiom_pair :: TyCon -> (CoAxiom Branched, CoAxiom Branched) -> LintM () -lint_axiom_pair tc (ax1, ax2) - | Just br1@(CoAxBranch { cab_tvs = tvs1 - , cab_lhs = lhs1 - , cab_rhs = rhs1 }) <- coAxiomSingleBranch_maybe ax1 - , Just br2@(CoAxBranch { cab_tvs = tvs2 - , cab_lhs = lhs2 - , cab_rhs = rhs2 }) <- coAxiomSingleBranch_maybe ax2 - = lintL (compatibleBranches br1 br2) $ - vcat [ hsep [ text "Axioms", ppr ax1, text "and", ppr ax2 - , text "are incompatible" ] - , text "tvs1 =" <+> pprTyVars tvs1 - , text "lhs1 =" <+> ppr (mkTyConApp tc lhs1) - , text "rhs1 =" <+> ppr rhs1 - , text "tvs2 =" <+> pprTyVars tvs2 - , text "lhs2 =" <+> ppr (mkTyConApp tc lhs2) - , text "rhs2 =" <+> ppr rhs2 ] - - | otherwise - = addErrL (text "Open type family axiom has more than one branch: either" <+> - ppr ax1 <+> text "or" <+> ppr ax2) - -{- -************************************************************************ -* * -\subsection[lint-monad]{The Lint monad} -* * -************************************************************************ --} - --- If you edit this type, you may need to update the GHC formalism --- See Note [GHC Formalism] -data LintEnv - = LE { le_flags :: LintFlags -- Linting the result of this pass - , le_loc :: [LintLocInfo] -- Locations - - , le_subst :: Subst -- Current TyCo substitution - -- See Note [Linting type lets] - -- /Only/ substitutes for type variables; - -- but might clone CoVars - -- We also use le_subst to keep track of - -- in-scope TyVars and CoVars (but not Ids) - -- Range of the Subst is LintedType/LintedCo - - , le_ids :: VarEnv (Id, LintedType) -- In-scope Ids - -- Used to check that occurrences have an enclosing binder. - -- The Id is /pre-substitution/, used to check that - -- the occurrence has an identical type to the binder - -- The LintedType is used to return the type of the occurrence, - -- without having to lint it again. - - , le_joins :: IdSet -- Join points in scope that are valid - -- A subset of the InScopeSet in le_subst - -- See Note [Join points] - - , le_ue_aliases :: NameEnv UsageEnv -- Assigns usage environments to the - -- alias-like binders, as found in - -- non-recursive lets. - - , le_platform :: Platform -- ^ Target platform - , le_diagOpts :: DiagOpts -- ^ Target platform - } - -data LintFlags - = LF { lf_check_global_ids :: Bool -- See Note [Checking for global Ids] - , lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers] - , lf_check_static_ptrs :: StaticPtrCheck -- ^ See Note [Checking StaticPtrs] - , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications] - , lf_check_linearity :: Bool -- ^ See Note [Linting linearity] - , lf_check_fixed_rep :: Bool -- See Note [Checking for representation polymorphism] - } - --- See Note [Checking StaticPtrs] -data StaticPtrCheck - = AllowAnywhere - -- ^ Allow 'makeStatic' to occur anywhere. - | AllowAtTopLevel - -- ^ Allow 'makeStatic' calls at the top-level only. - | RejectEverywhere - -- ^ Reject any 'makeStatic' occurrence. - deriving Eq - -newtype LintM a = - LintM' { unLintM :: - LintEnv -> - WarnsAndErrs -> -- Warning and error messages so far - LResult a } -- Result and messages (if any) - - -pattern LintM :: (LintEnv -> WarnsAndErrs -> LResult a) -> LintM a --- See Note [The one-shot state monad trick] in GHC.Utils.Monad -pattern LintM m <- LintM' m - where - LintM m = LintM' (oneShot $ \env -> oneShot $ \we -> m env we) - -- LintM m = LintM' (oneShot $ oneShot m) -{-# COMPLETE LintM #-} - -instance Functor (LintM) where - fmap f (LintM m) = LintM $ \e w -> mapLResult f (m e w) - -type WarnsAndErrs = (Bag SDoc, Bag SDoc) - --- Using a unboxed tuple here reduced allocations for a lint heavy --- file by ~6%. Using MaybeUB reduced them further by another ~12%. -type LResult a = (# MaybeUB a, WarnsAndErrs #) - -pattern LResult :: MaybeUB a -> WarnsAndErrs -> LResult a -pattern LResult m w = (# m, w #) -{-# COMPLETE LResult #-} - -mapLResult :: (a1 -> a2) -> LResult a1 -> LResult a2 -mapLResult f (LResult r w) = LResult (fmapMaybeUB f r) w - --- Just for testing. -fromBoxedLResult :: (Maybe a, WarnsAndErrs) -> LResult a -fromBoxedLResult (Just x, errs) = LResult (JustUB x) errs -fromBoxedLResult (Nothing,errs) = LResult NothingUB errs - -{- Note [Checking for global Ids] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Before CoreTidy, all locally-bound Ids must be LocalIds, even -top-level ones. See Note [Exported LocalIds] and #9857. - -Note [Checking StaticPtrs] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview. - -Every occurrence of the function 'makeStatic' should be moved to the -top level by the FloatOut pass. It's vital that we don't have nested -'makeStatic' occurrences after CorePrep, because we populate the Static -Pointer Table from the top-level bindings. See SimplCore Note [Grand -plan for static forms]. - -The linter checks that no occurrence is left behind, nested within an -expression. The check is enabled only after the FloatOut, CorePrep, -and CoreTidy passes and only if the module uses the StaticPointers -language extension. Checking more often doesn't help since the condition -doesn't hold until after the first FloatOut pass. - -Note [Type substitution] -~~~~~~~~~~~~~~~~~~~~~~~~ -Why do we need a type substitution? Consider - /\(a:*). \(x:a). /\(a:*). id a x -This is ill typed, because (renaming variables) it is really - /\(a:*). \(x:a). /\(b:*). id b x -Hence, when checking an application, we can't naively compare x's type -(at its binding site) with its expected type (at a use site). So we -rename type binders as we go, maintaining a substitution. - -The same substitution also supports let-type, current expressed as - (/\(a:*). body) ty -Here we substitute 'ty' for 'a' in 'body', on the fly. - -Note [Linting type synonym applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When linting a type-synonym, or type-family, application - S ty1 .. tyn -we behave as follows (#15057, #T15664): - -* If lf_report_unsat_syns = True, and S has arity < n, - complain about an unsaturated type synonym or type family - -* Switch off lf_report_unsat_syns, and lint ty1 .. tyn. - - Reason: catch out of scope variables or other ill-kinded gubbins, - even if S discards that argument entirely. E.g. (#15012): - type FakeOut a = Int - type family TF a - type instance TF Int = FakeOut a - Here 'a' is out of scope; but if we expand FakeOut, we conceal - that out-of-scope error. - - Reason for switching off lf_report_unsat_syns: with - LiberalTypeSynonyms, GHC allows unsaturated synonyms provided they - are saturated when the type is expanded. Example - type T f = f Int - type S a = a -> a - type Z = T S - In Z's RHS, S appears unsaturated, but it is saturated when T is expanded. - -* If lf_report_unsat_syns is on, expand the synonym application and - lint the result. Reason: want to check that synonyms are saturated - when the type is expanded. - -Note [Linting linearity] -~~~~~~~~~~~~~~~~~~~~~~~~ -Lint ignores linearity unless `-dlinear-core-lint` is set. For why, see below. - -But first, "ignore linearity" specifically means two things. When ignoring linearity: -* In `ensureEqTypes`, use `eqTypeIgnoringMultiplicity` -* In `ensureSubMult`, do nothing - -But why make `-dcore-lint` ignore linearity? Because optimisation passes are -not (yet) guaranteed to maintain linearity. They should do so semantically (GHC -is careful not to duplicate computation) but it is much harder to ensure that -the statically-checkable constraints of Linear Core are maintained. The current -Linear Core is described in the wiki at: -https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation. - -Here are some examples of how the optimiser can break linearity checking. Other -examples are documented in the linear-type implementation wiki page -[https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation#core-to-core-passes] - -* EXAMPLE 1: the binder swap transformation - Consider - - data T = MkT {-# UNPACK #-} !Int - - The wrapper for MkT is - - $wMkT :: Int %1 -> T - $wMkT n = case %1 n of - I# n' -> MkT n' - - This introduces, in particular, a `case %1` (this is not actual Haskell or - Core syntax), where the `%1` means that the `case` expression consumes its - scrutinee linearly. - - Now, `case %1` interacts with the binder swap optimisation in a non-trivial - way. Take a slightly modified version of the code for $wMkT: - - case %1 x of z { - I# n' -> (x, n') - } - - Binder-swap changes this to - - case %1 x of z { - I# n' -> let x = z in (x, n') - } - - This is rejected by `-dlinear-core-lint` because 1/ n' must be used linearly - 2/ `-dlinear-core-lint` recognises a use of `z` as a use of `n'`. So it sees - two uses of n' where there should be a single one. - -* EXAMPLE 2: letrec - Some optimisations can create a letrec which uses a variable - linearly, e.g. - - letrec f True = f False - f False = x - in f True - - uses 'x' linearly, but this is not seen by the linter, which considers, - conservatively, that a letrec always has multiplicity Many (in particular - that every captured free variable must have multiplicity Many). This issue - is discussed in ticket #18694. - -* EXAMPLE 3: rewrite rules - Ignoring linearity means in particular that `a -> b` and `a %1 -> b` must be - treated the same by rewrite rules (see also Note [Rewrite rules ignore - multiplicities in FunTy] in GHC.Core.Unify). Consider - - m :: Bool -> A - m' :: (Bool -> Bool) -> A - {- RULES "ex" forall f. m (f True) = m' f -} - - f :: Bool %1 -> A - x = m (f True) - - The rule "ex" must match . So the linter must accept `m' f`. - -* EXAMPLE 4: eta-reduction - Eta-expansion can change linear functions into unrestricted functions - - f :: A %1 -> B - - g :: A %Many -> B - g = \x -> f x - - Eta-reduction undoes this and produces: - - g :: A %Many -> B - g = f - -Historical note: In the original linear-types implementation, we had tried to -make every optimisation pass produce code that passes `-dlinear-core-lint`. It -had proved very difficult. We kept finding corner case after corner -case. Furthermore, to attempt to achieve that goal we ended up restricting -transformations when `-dlinear-core-lint` couldn't typecheck the result. - -In the future, we may be able to lint the linearity of the output of -Core-to-Core passes (#19165). But this shouldn't be done at the expense of -producing efficient code. Therefore we lay the following principle. - -PRINCIPLE: The type system bends to the optimisation, not the other way around. - -There is a useful discussion at https://gitlab.haskell.org/ghc/ghc/-/issues/22123 - -Note [Linting representation-polymorphic builtins] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As described in Note [Representation-polymorphism checking built-ins], on -top of the two main representation-polymorphism invariants described in the -Note [Representation polymorphism invariants], we must perform additional -representation-polymorphism checks on builtin functions which don't have a -binding, for example to ensure that we don't run afoul of the -representation-polymorphism invariants when eta-expanding. - -There are two situations: - - 1. Builtins which have skolem type variables which must be instantiated to - concrete types, such as the RuntimeRep type argument r to the catch# primop. - - 2. Representation-polymorphic unlifted newtypes, which must always be instantiated - at a fixed runtime representation. - -For 1, consider for example 'coerce': - - coerce :: forall {r} (a :: TYPE r) (b :: TYPE r). Coercible a b => a -> b - -We store in the IdDetails of the coerce Id that the first binder, r, must always -be instantiated to a concrete type. We thus check this in Core Lint: whenever we -see an application of the form - - coerce @{rep1} ... - -we ensure that 'rep1' is concrete. This is done in the function "checkRepPolyBuiltinApp". -Moreover, not instantiating these type variables at all is also an error, as -we would again not be able to perform eta-expansion. (This is a bit more theoretical, -as in user programs the typechecker will insert these type applications when -instantiating, but it can still arise when constructing Core expressions). - -For 2, whenever we have an unlifted newtype such as - - type RR :: Type -> RuntimeRep - type family RR a - - type F :: forall (a :: Type) -> TYPE (RR a) - type family F a - - type N :: forall (a :: Type) -> TYPE (RR a) - newtype N a = MkN (F a) - -and an unsaturated occurrence - - MkN @ty -- NB: no value argument! - -we check that the (instantiated) argument type has a fixed runtime representation. -This is done in the function "checkRepPolyNewtypeApp". --} - -instance Applicative LintM where - pure x = LintM $ \ _ errs -> LResult (JustUB x) errs - --(Just x, errs) - (<*>) = ap - -instance Monad LintM where - m >>= k = LintM (\ env errs -> - let res = unLintM m env errs in - case res of - LResult (JustUB r) errs' -> unLintM (k r) env errs' - LResult NothingUB errs' -> LResult NothingUB errs' - ) - -- LError errs'-> LError errs') - -- let (res, errs') = unLintM m env errs in - -- Just r -> unLintM (k r) env errs' - -- Nothing -> (Nothing, errs')) - -instance MonadFail LintM where - fail err = failWithL (text err) - -getPlatform :: LintM Platform -getPlatform = LintM (\ e errs -> (LResult (JustUB $ le_platform e) errs)) - -data LintLocInfo - = RhsOf Id -- The variable bound - | OccOf Id -- Occurrence of id - | LambdaBodyOf Id -- The lambda-binder - | RuleOf Id -- Rules attached to a binder - | UnfoldingOf Id -- Unfolding of a binder - | BodyOfLet Id -- The let-bound variable - | BodyOfLetRec [Id] -- The binders of the let - | CaseAlt CoreAlt -- Case alternative - | CasePat CoreAlt -- The *pattern* of the case alternative - | CaseTy CoreExpr -- The type field of a case expression - -- with this scrutinee - | IdTy Id -- The type field of an Id binder - | AnExpr CoreExpr -- Some expression - | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) - | TopLevelBindings - | InType Type -- Inside a type - | InCo Coercion -- Inside a coercion - | InAxiom (CoAxiom Branched) -- Inside a CoAxiom - -data LintConfig = LintConfig - { l_diagOpts :: !DiagOpts -- ^ Diagnostics opts - , l_platform :: !Platform -- ^ Target platform - , l_flags :: !LintFlags -- ^ Linting the result of this pass - , l_vars :: ![Var] -- ^ 'Id's that should be treated as being in scope - } - -initL :: LintConfig - -> LintM a -- ^ Action to run - -> WarnsAndErrs -initL cfg m - = case unLintM m env (emptyBag, emptyBag) of - LResult (JustUB _) errs -> errs - LResult NothingUB errs@(_, e) | not (isEmptyBag e) -> errs - | otherwise -> pprPanic ("Bug in Lint: a failure occurred " ++ - "without reporting an error message") empty - where - (tcvs, ids) = partition isTyCoVar $ l_vars cfg - env = LE { le_flags = l_flags cfg - , le_subst = mkEmptySubst (mkInScopeSetList tcvs) - , le_ids = mkVarEnv [(id, (id,idType id)) | id <- ids] - , le_joins = emptyVarSet - , le_loc = [] - , le_ue_aliases = emptyNameEnv - , le_platform = l_platform cfg - , le_diagOpts = l_diagOpts cfg - } - -setReportUnsat :: Bool -> LintM a -> LintM a --- Switch off lf_report_unsat_syns -setReportUnsat ru thing_inside - = LintM $ \ env errs -> - let env' = env { le_flags = (le_flags env) { lf_report_unsat_syns = ru } } - in unLintM thing_inside env' errs - --- See Note [Checking for representation polymorphism] -noFixedRuntimeRepChecks :: LintM a -> LintM a -noFixedRuntimeRepChecks thing_inside - = LintM $ \env errs -> - let env' = env { le_flags = (le_flags env) { lf_check_fixed_rep = False } } - in unLintM thing_inside env' errs - -getLintFlags :: LintM LintFlags -getLintFlags = LintM $ \ env errs -> fromBoxedLResult (Just (le_flags env), errs) - -checkL :: Bool -> SDoc -> LintM () -checkL True _ = return () -checkL False msg = failWithL msg - --- like checkL, but relevant to type checking -lintL :: Bool -> SDoc -> LintM () -lintL = checkL - -checkWarnL :: Bool -> SDoc -> LintM () -checkWarnL True _ = return () -checkWarnL False msg = addWarnL msg - -failWithL :: SDoc -> LintM a -failWithL msg = LintM $ \ env (warns,errs) -> - fromBoxedLResult (Nothing, (warns, addMsg True env errs msg)) - -addErrL :: SDoc -> LintM () -addErrL msg = LintM $ \ env (warns,errs) -> - fromBoxedLResult (Just (), (warns, addMsg True env errs msg)) - -addWarnL :: SDoc -> LintM () -addWarnL msg = LintM $ \ env (warns,errs) -> - fromBoxedLResult (Just (), (addMsg False env warns msg, errs)) - -addMsg :: Bool -> LintEnv -> Bag SDoc -> SDoc -> Bag SDoc -addMsg is_error env msgs msg - = assertPpr (notNull loc_msgs) msg $ - msgs `snocBag` mk_msg msg - where - loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first - loc_msgs = map dumpLoc (le_loc env) - - cxt_doc = vcat [ vcat $ reverse $ map snd loc_msgs - , text "Substitution:" <+> ppr (le_subst env) ] - context | is_error = cxt_doc - | otherwise = whenPprDebug cxt_doc - -- Print voluminous info for Lint errors - -- but not for warnings - - msg_span = case [ span | (loc,_) <- loc_msgs - , let span = srcLocSpan loc - , isGoodSrcSpan span ] of - [] -> noSrcSpan - (s:_) -> s - !diag_opts = le_diagOpts env - mk_msg msg = mkLocMessage (mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) msg_span - (msg $$ context) - -addLoc :: LintLocInfo -> LintM a -> LintM a -addLoc extra_loc m - = LintM $ \ env errs -> - unLintM m (env { le_loc = extra_loc : le_loc env }) errs - -inCasePat :: LintM Bool -- A slight hack; see the unique call site -inCasePat = LintM $ \ env errs -> fromBoxedLResult (Just (is_case_pat env), errs) - where - is_case_pat (LE { le_loc = CasePat {} : _ }) = True - is_case_pat _other = False - -addInScopeId :: Id -> LintedType -> LintM a -> LintM a -addInScopeId id linted_ty m - = LintM $ \ env@(LE { le_ids = id_set, le_joins = join_set, le_ue_aliases = aliases }) errs -> - unLintM m (env { le_ids = extendVarEnv id_set id (id, linted_ty) - , le_joins = add_joins join_set - , le_ue_aliases = delFromNameEnv aliases (idName id) }) errs - -- When shadowing an alias, we need to make sure the Id is no longer - -- classified as such. E.g. in - -- let x = in case x of x { _DEFAULT -> } - -- Occurrences of 'x' in e2 shouldn't count as occurrences of e1. - where - add_joins join_set - | isJoinId id = extendVarSet join_set id -- Overwrite with new arity - | otherwise = delVarSet join_set id -- Remove any existing binding - -getInScopeIds :: LintM (VarEnv (Id,LintedType)) -getInScopeIds = LintM (\env errs -> fromBoxedLResult (Just (le_ids env), errs)) - -extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a -extendTvSubstL tv ty m - = LintM $ \ env errs -> - unLintM m (env { le_subst = Type.extendTvSubst (le_subst env) tv ty }) errs - -updateSubst :: Subst -> LintM a -> LintM a -updateSubst subst' m - = LintM $ \ env errs -> unLintM m (env { le_subst = subst' }) errs - -markAllJoinsBad :: LintM a -> LintM a -markAllJoinsBad m - = LintM $ \ env errs -> unLintM m (env { le_joins = emptyVarSet }) errs - -markAllJoinsBadIf :: Bool -> LintM a -> LintM a -markAllJoinsBadIf True m = markAllJoinsBad m -markAllJoinsBadIf False m = m - -getValidJoins :: LintM IdSet -getValidJoins = LintM (\ env errs -> fromBoxedLResult (Just (le_joins env), errs)) - -getSubst :: LintM Subst -getSubst = LintM (\ env errs -> fromBoxedLResult (Just (le_subst env), errs)) - -getUEAliases :: LintM (NameEnv UsageEnv) -getUEAliases = LintM (\ env errs -> fromBoxedLResult (Just (le_ue_aliases env), errs)) - -getInScope :: LintM InScopeSet -getInScope = LintM (\ env errs -> fromBoxedLResult (Just (getSubstInScope $ le_subst env), errs)) - -lookupIdInScope :: Id -> LintM (Id, LintedType) -lookupIdInScope id_occ - = do { in_scope_ids <- getInScopeIds - ; case lookupVarEnv in_scope_ids id_occ of - Just (id_bndr, linted_ty) - -> do { checkL (not (bad_global id_bndr)) $ global_in_scope id_bndr - ; return (id_bndr, linted_ty) } - Nothing -> do { checkL (not is_local) local_out_of_scope - ; return (id_occ, idType id_occ) } } - -- We don't bother to lint the type - -- of global (i.e. imported) Ids - where - is_local = mustHaveLocalBinding id_occ - local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ - global_in_scope id_bndr = hang (text "Occurrence is GlobalId, but binding is LocalId") - 2 $ vcat [hang (text "occurrence:") 2 $ pprBndr LetBind id_occ - ,hang (text "binder :") 2 $ pprBndr LetBind id_bndr - ] - bad_global id_bnd = isGlobalId id_occ - && isLocalId id_bnd - && not (isWiredIn id_occ) - -- 'bad_global' checks for the case where an /occurrence/ is - -- a GlobalId, but there is an enclosing binding fora a LocalId. - -- NB: the in-scope variables are mostly LocalIds, checked by lintIdBndr, - -- but GHCi adds GlobalIds from the interactive context. These - -- are fine; hence the test (isLocalId id == isLocalId v) - -- NB: when compiling Control.Exception.Base, things like absentError - -- are defined locally, but appear in expressions as (global) - -- wired-in Ids after worker/wrapper - -- So we simply disable the test in this case - -lookupJoinId :: Id -> LintM JoinPointHood --- Look up an Id which should be a join point, valid here --- If so, return its arity, if not return Nothing -lookupJoinId id - = do { join_set <- getValidJoins - ; case lookupVarSet join_set id of - Just id' -> return (idJoinPointHood id') - Nothing -> return NotJoinPoint } - -addAliasUE :: Id -> UsageEnv -> LintM a -> LintM a -addAliasUE id ue thing_inside = LintM $ \ env errs -> - let new_ue_aliases = - extendNameEnv (le_ue_aliases env) (getName id) ue - in - unLintM thing_inside (env { le_ue_aliases = new_ue_aliases }) errs - -varCallSiteUsage :: Id -> LintM UsageEnv -varCallSiteUsage id = - do m <- getUEAliases - return $ case lookupNameEnv m (getName id) of - Nothing -> singleUsageUE id - Just id_ue -> id_ue - -ensureEqTys :: LintedType -> LintedType -> SDoc -> LintM () --- check ty2 is subtype of ty1 (ie, has same structure but usage --- annotations need only be consistent, not equal) --- Assumes ty1,ty2 are have already had the substitution applied -{-# INLINE ensureEqTys #-} -- See Note [INLINE ensureEqTys] -ensureEqTys ty1 ty2 msg - = do { flags <- getLintFlags - ; lintL (eq_type flags ty1 ty2) msg } - -eq_type :: LintFlags -> Type -> Type -> Bool --- When `-dlinear-core-lint` is off, then consider `a -> b` and `a %1 -> b` to --- be equal. See Note [Linting linearity]. -eq_type flags ty1 ty2 | lf_check_linearity flags = eqType ty1 ty2 - | otherwise = eqTypeIgnoringMultiplicity ty1 ty2 - -{- Note [INLINE ensureEqTys] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -To make Lint fast, we want to avoid allocating a thunk for in - ensureEqTypes ty1 ty2 -because the test almost always succeeds, and isn't needed. -So we INLINE `ensureEqTys`. This actually make a difference of -1-2% when compiling programs with -dcore-lint. --} - -ensureSubUsage :: Usage -> Mult -> SDoc -> LintM () -ensureSubUsage Bottom _ _ = return () -ensureSubUsage Zero described_mult err_msg = ensureSubMult ManyTy described_mult err_msg -ensureSubUsage (MUsage m) described_mult err_msg = ensureSubMult m described_mult err_msg - -ensureSubMult :: Mult -> Mult -> SDoc -> LintM () -ensureSubMult actual_mult described_mult err_msg = do - flags <- getLintFlags - when (lf_check_linearity flags) $ - unless (deepSubMult actual_mult described_mult) $ - addErrL err_msg - where - -- Check for submultiplicity using the following rules: - -- 1. x*y <= z when x <= z and y <= z. - -- This rule follows from the fact that x*y = sup{x,y} for any - -- multiplicities x,y. - -- 2. x <= y*z when x <= y or x <= z. - -- This rule is not complete: when x = y*z, we cannot - -- change y*z <= y*z to y*z <= y or y*z <= z. - -- However, we eliminate products on the LHS in step 1. - -- 3. One <= x and x <= Many for any x, as checked by 'submult'. - -- 4. x <= x. - -- Otherwise, we fail. - deepSubMult :: Mult -> Mult -> Bool - deepSubMult m n - | Just (m1, m2) <- isMultMul m = deepSubMult m1 n && deepSubMult m2 n - | Just (n1, n2) <- isMultMul n = deepSubMult m n1 || deepSubMult m n2 - | Submult <- m `submult` n = True - | otherwise = m `eqType` n - -lintRole :: Outputable thing - => thing -- where the role appeared - -> Role -- expected - -> Role -- actual - -> LintM () -lintRole co r1 r2 - = lintL (r1 == r2) - (text "Role incompatibility: expected" <+> ppr r1 <> comma <+> - text "got" <+> ppr r2 $$ - text "in" <+> ppr co) - -{- -************************************************************************ -* * -\subsection{Error messages} -* * -************************************************************************ --} - -dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) - -dumpLoc (RhsOf v) - = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) - -dumpLoc (OccOf v) - = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) - -dumpLoc (LambdaBodyOf b) - = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) - -dumpLoc (RuleOf b) - = (getSrcLoc b, text "In a rule attached to" <+> pp_binder b) - -dumpLoc (UnfoldingOf b) - = (getSrcLoc b, text "In the unfolding of" <+> pp_binder b) - -dumpLoc (BodyOfLet b) - = (noSrcLoc, text "In the body of a let with binder" <+> pp_binder b) - -dumpLoc (BodyOfLetRec []) - = (noSrcLoc, text "In body of a letrec with no binders") - -dumpLoc (BodyOfLetRec bs@(b:_)) - = ( getSrcLoc b, text "In the body of a letrec with binders" <+> pp_binders bs) - -dumpLoc (AnExpr e) - = (noSrcLoc, text "In the expression:" <+> ppr e) - -dumpLoc (CaseAlt (Alt con args _)) - = (noSrcLoc, text "In a case alternative:" <+> parens (ppr con <+> pp_binders args)) - -dumpLoc (CasePat (Alt con args _)) - = (noSrcLoc, text "In the pattern of a case alternative:" <+> parens (ppr con <+> pp_binders args)) - -dumpLoc (CaseTy scrut) - = (noSrcLoc, hang (text "In the result-type of a case with scrutinee:") - 2 (ppr scrut)) - -dumpLoc (IdTy b) - = (getSrcLoc b, text "In the type of a binder:" <+> ppr b) - -dumpLoc (ImportedUnfolding locn) - = (locn, text "In an imported unfolding") -dumpLoc TopLevelBindings - = (noSrcLoc, Outputable.empty) -dumpLoc (InType ty) - = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) -dumpLoc (InCo co) - = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) -dumpLoc (InAxiom ax) - = (getSrcLoc ax, hang (text "In the coercion axiom") - 2 (pprCoAxiom ax)) - -pp_binders :: [Var] -> SDoc -pp_binders bs = sep (punctuate comma (map pp_binder bs)) - -pp_binder :: Var -> SDoc -pp_binder b | isId b = hsep [ppr b, dcolon, ppr (idType b)] - | otherwise = hsep [ppr b, dcolon, ppr (tyVarKind b)] - ------------------------------------------------------- --- Messages for case expressions - -mkDefaultArgsMsg :: [Var] -> SDoc -mkDefaultArgsMsg args - = hang (text "DEFAULT case with binders") - 4 (ppr args) - -mkCaseAltMsg :: CoreExpr -> Type -> Type -> SDoc -mkCaseAltMsg e ty1 ty2 - = hang (text "Type of case alternatives not the same as the annotation on case:") - 4 (vcat [ text "Actual type:" <+> ppr ty1, - text "Annotation on case:" <+> ppr ty2, - text "Alt Rhs:" <+> ppr e ]) - -mkScrutMsg :: Id -> Type -> Type -> Subst -> SDoc -mkScrutMsg var var_ty scrut_ty subst - = vcat [text "Result binder in case doesn't match scrutinee:" <+> ppr var, - text "Result binder type:" <+> ppr var_ty,--(idType var), - text "Scrutinee type:" <+> ppr scrut_ty, - hsep [text "Current TCv subst", ppr subst]] - -mkNonDefltMsg, mkNonIncreasingAltsMsg :: CoreExpr -> SDoc -mkNonDefltMsg e - = hang (text "Case expression with DEFAULT not at the beginning") 4 (ppr e) -mkNonIncreasingAltsMsg e - = hang (text "Case expression with badly-ordered alternatives") 4 (ppr e) - -nonExhaustiveAltsMsg :: CoreExpr -> SDoc -nonExhaustiveAltsMsg e - = hang (text "Case expression with non-exhaustive alternatives") 4 (ppr e) - -mkBadConMsg :: TyCon -> DataCon -> SDoc -mkBadConMsg tycon datacon - = vcat [ - text "In a case alternative, data constructor isn't in scrutinee type:", - text "Scrutinee type constructor:" <+> ppr tycon, - text "Data con:" <+> ppr datacon - ] - -mkBadPatMsg :: Type -> Type -> SDoc -mkBadPatMsg con_result_ty scrut_ty - = vcat [ - text "In a case alternative, pattern result type doesn't match scrutinee type:", - text "Pattern result type:" <+> ppr con_result_ty, - text "Scrutinee type:" <+> ppr scrut_ty - ] - -integerScrutinisedMsg :: SDoc -integerScrutinisedMsg - = text "In a LitAlt, the literal is lifted (probably Integer)" - -mkBadAltMsg :: Type -> CoreAlt -> SDoc -mkBadAltMsg scrut_ty alt - = vcat [ text "Data alternative when scrutinee is not a tycon application", - text "Scrutinee type:" <+> ppr scrut_ty, - text "Alternative:" <+> pprCoreAlt alt ] - -mkNewTyDataConAltMsg :: Type -> CoreAlt -> SDoc -mkNewTyDataConAltMsg scrut_ty alt - = vcat [ text "Data alternative for newtype datacon", - text "Scrutinee type:" <+> ppr scrut_ty, - text "Alternative:" <+> pprCoreAlt alt ] - - ------------------------------------------------------- --- Other error messages - -mkAppMsg :: Type -> Type -> CoreExpr -> SDoc -mkAppMsg expected_arg_ty actual_arg_ty arg - = vcat [text "Argument value doesn't match argument type:", - hang (text "Expected arg type:") 4 (ppr expected_arg_ty), - hang (text "Actual arg type:") 4 (ppr actual_arg_ty), - hang (text "Arg:") 4 (ppr arg)] - -mkNonFunAppMsg :: Type -> Type -> CoreExpr -> SDoc -mkNonFunAppMsg fun_ty arg_ty arg - = vcat [text "Non-function type in function position", - hang (text "Fun type:") 4 (ppr fun_ty), - hang (text "Arg type:") 4 (ppr arg_ty), - hang (text "Arg:") 4 (ppr arg)] - -mkLetErr :: TyVar -> CoreExpr -> SDoc -mkLetErr bndr rhs - = vcat [text "Bad `let' binding:", - hang (text "Variable:") - 4 (ppr bndr <+> dcolon <+> ppr (varType bndr)), - hang (text "Rhs:") - 4 (ppr rhs)] - -mkTyAppMsg :: Type -> Type -> SDoc -mkTyAppMsg ty arg_ty - = vcat [text "Illegal type application:", - hang (text "Function type:") - 4 (ppr ty <+> dcolon <+> ppr (typeKind ty)), - hang (text "Type argument:") - 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))] - -mkCoAppMsg :: Type -> Coercion -> SDoc -mkCoAppMsg fun_ty co - = vcat [ text "Illegal coercion application:" - , hang (text "Function type:") - 4 (ppr fun_ty) - , hang (text "Coercion argument:") - 4 (ppr co <+> dcolon <+> ppr (coercionType co))] - -emptyRec :: CoreExpr -> SDoc -emptyRec e = hang (text "Empty Rec binding:") 2 (ppr e) - -mkRhsMsg :: Id -> SDoc -> Type -> SDoc -mkRhsMsg binder what ty - = vcat - [hsep [text "The type of this binder doesn't match the type of its" <+> what <> colon, - ppr binder], - hsep [text "Binder's type:", ppr (idType binder)], - hsep [text "Rhs type:", ppr ty]] - -badBndrTyMsg :: Id -> SDoc -> SDoc -badBndrTyMsg binder what - = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder - , text "Binder's type:" <+> ppr (idType binder) ] - -mkNonTopExportedMsg :: Id -> SDoc -mkNonTopExportedMsg binder - = hsep [text "Non-top-level binder is marked as exported:", ppr binder] - -mkNonTopExternalNameMsg :: Id -> SDoc -mkNonTopExternalNameMsg binder - = hsep [text "Non-top-level binder has an external name:", ppr binder] - -mkTopNonLitStrMsg :: Id -> SDoc -mkTopNonLitStrMsg binder - = hsep [text "Top-level Addr# binder has a non-literal rhs:", ppr binder] - -mkKindErrMsg :: TyVar -> Type -> SDoc -mkKindErrMsg tyvar arg_ty - = vcat [text "Kinds don't match in type application:", - hang (text "Type variable:") - 4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)), - hang (text "Arg type:") - 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))] - -mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> SDoc -mkCastErr expr = mk_cast_err "expression" "type" (ppr expr) - -mkCastTyErr :: Type -> Coercion -> Kind -> Kind -> SDoc -mkCastTyErr ty = mk_cast_err "type" "kind" (ppr ty) - -mk_cast_err :: String -- ^ What sort of casted thing this is - -- (\"expression\" or \"type\"). - -> String -- ^ What sort of coercion is being used - -- (\"type\" or \"kind\"). - -> SDoc -- ^ The thing being casted. - -> Coercion -> Type -> Type -> SDoc -mk_cast_err thing_str co_str pp_thing co from_ty thing_ty - = vcat [from_msg <+> text "of Cast differs from" <+> co_msg - <+> text "of" <+> enclosed_msg, - from_msg <> colon <+> ppr from_ty, - text (capitalise co_str) <+> text "of" <+> enclosed_msg <> colon - <+> ppr thing_ty, - text "Actual" <+> enclosed_msg <> colon <+> pp_thing, - text "Coercion used in cast:" <+> ppr co - ] - where - co_msg, from_msg, enclosed_msg :: SDoc - co_msg = text co_str - from_msg = text "From-" <> co_msg - enclosed_msg = text "enclosed" <+> text thing_str - -mkBadTyVarMsg :: Var -> SDoc -mkBadTyVarMsg tv - = text "Non-tyvar used in TyVarTy:" - <+> ppr tv <+> dcolon <+> ppr (varType tv) - -mkBadJoinBindMsg :: Var -> SDoc -mkBadJoinBindMsg var - = vcat [ text "Bad join point binding:" <+> ppr var - , text "Join points can be bound only by a non-top-level let" ] - -mkInvalidJoinPointMsg :: Var -> Type -> SDoc -mkInvalidJoinPointMsg var ty - = hang (text "Join point has invalid type:") - 2 (ppr var <+> dcolon <+> ppr ty) - -mkBadJoinArityMsg :: Var -> Int -> Int -> CoreExpr -> SDoc -mkBadJoinArityMsg var ar n rhs - = vcat [ text "Join point has too few lambdas", - text "Join var:" <+> ppr var, - text "Join arity:" <+> ppr ar, - text "Number of lambdas:" <+> ppr (ar - n), - text "Rhs = " <+> ppr rhs - ] - -invalidJoinOcc :: Var -> SDoc -invalidJoinOcc var - = vcat [ text "Invalid occurrence of a join variable:" <+> ppr var - , text "The binder is either not a join point, or not valid here" ] - -mkBadJumpMsg :: Var -> Int -> Int -> SDoc -mkBadJumpMsg var ar nargs - = vcat [ text "Join point invoked with wrong number of arguments", - text "Join var:" <+> ppr var, - text "Join arity:" <+> ppr ar, - text "Number of arguments:" <+> int nargs ] - -mkInconsistentRecMsg :: [Var] -> SDoc -mkInconsistentRecMsg bndrs - = vcat [ text "Recursive let binders mix values and join points", - text "Binders:" <+> hsep (map ppr_with_details bndrs) ] - where - ppr_with_details bndr = ppr bndr <> ppr (idDetails bndr) - -mkJoinBndrOccMismatchMsg :: Var -> JoinArity -> JoinArity -> SDoc -mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ - = vcat [ text "Mismatch in join point arity between binder and occurrence" - , text "Var:" <+> ppr bndr - , text "Arity at binding site:" <+> ppr join_arity_bndr - , text "Arity at occurrence: " <+> ppr join_arity_occ ] - -mkBndrOccTypeMismatchMsg :: Var -> Var -> LintedType -> LintedType -> SDoc -mkBndrOccTypeMismatchMsg bndr var bndr_ty var_ty - = vcat [ text "Mismatch in type between binder and occurrence" - , text "Binder:" <+> ppr bndr <+> dcolon <+> ppr bndr_ty - , text "Occurrence:" <+> ppr var <+> dcolon <+> ppr var_ty - , text " Before subst:" <+> ppr (idType var) ] + +import GHC.Data.Bag +import GHC.Data.List.SetOps + +import GHC.Utils.Monad +import GHC.Utils.Outputable as Outputable +import GHC.Utils.Panic +import GHC.Utils.Constants (debugIsOn) +import GHC.Utils.Misc +import GHC.Utils.Error +import qualified GHC.Utils.Error as Err +import GHC.Utils.Logger + +import GHC.Data.Pair +import GHC.Base (oneShot) +import GHC.Data.Unboxed + +import Control.Monad +import Data.Foldable ( for_, toList ) +import Data.List.NonEmpty ( NonEmpty(..), groupWith, nonEmpty ) +import Data.Maybe +import Data.IntMap.Strict ( IntMap ) +import qualified Data.IntMap.Strict as IntMap ( lookup, keys, empty, fromList ) + +{- +Note [Core Lint guarantee] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Core Lint is the type-checker for Core. Using it, we get the following guarantee: + +If all of: +1. Core Lint passes, +2. there are no unsafe coercions (i.e. unsafeEqualityProof), +3. all plugin-supplied coercions (i.e. PluginProv) are valid, and +4. all case-matches are complete +then running the compiled program will not seg-fault, assuming no bugs downstream +(e.g. in the code generator). This guarantee is quite powerful, in that it allows us +to decouple the safety of the resulting program from the type inference algorithm. + +However, do note point (4) above. Core Lint does not check for incomplete case-matches; +see Note [Case expression invariants] in GHC.Core, invariant (4). As explained there, +an incomplete case-match might slip by Core Lint and cause trouble at runtime. + +Note [GHC Formalism] +~~~~~~~~~~~~~~~~~~~~ +This file implements the type-checking algorithm for System FC, the "official" +name of the Core language. Type safety of FC is heart of the claim that +executables produced by GHC do not have segmentation faults. Thus, it is +useful to be able to reason about System FC independently of reading the code. +To this purpose, there is a document core-spec.pdf built in docs/core-spec that +contains a formalism of the types and functions dealt with here. If you change +just about anything in this file or you change other types/functions throughout +the Core language (all signposted to this note), you should update that +formalism. See docs/core-spec/README for more info about how to do so. + +Note [check vs lint] +~~~~~~~~~~~~~~~~~~~~ +This file implements both a type checking algorithm and also general sanity +checking. For example, the "sanity checking" checks for TyConApp on the left +of an AppTy, which should never happen. These sanity checks don't really +affect any notion of type soundness. Yet, it is convenient to do the sanity +checks at the same time as the type checks. So, we use the following naming +convention: + +- Functions that begin with 'lint'... are involved in type checking. These + functions might also do some sanity checking. + +- Functions that begin with 'check'... are *not* involved in type checking. + They exist only for sanity checking. + +Issues surrounding variable naming, shadowing, and such are considered *not* +to be part of type checking, as the formalism omits these details. + +Summary of checks +~~~~~~~~~~~~~~~~~ +Checks that a set of core bindings is well-formed. The PprStyle and String +just control what we print in the event of an error. The Bool value +indicates whether we have done any specialisation yet (in which case we do +some extra checks). + +We check for + (a) type errors + (b) Out-of-scope type variables + (c) Out-of-scope local variables + (d) Ill-kinded types + (e) Incorrect unsafe coercions + +If we have done specialisation the we check that there are + (a) No top-level bindings of primitive (unboxed type) + +Note [Linting function types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +All saturated applications of funTyCon are represented with the FunTy constructor. +See Note [Function type constructors and FunTy] in GHC.Builtin.Types.Prim + + We check this invariant in lintType. + +Note [Linting type lets] +~~~~~~~~~~~~~~~~~~~~~~~~ +In the desugarer, it's very very convenient to be able to say (in effect) + let a = Type Bool in + let x::a = True in +That is, use a type let. See Note [Core type and coercion invariant] in "GHC.Core". +One place it is used is in mkWwBodies; see Note [Join points and beta-redexes] +in GHC.Core.Opt.WorkWrap.Utils. (Maybe there are other "clients" of this feature; I'm not sure). + +* Hence when linting we need to remember that a=Int, else we + might reject a correct program. So we carry a type substitution (in + this example [a -> Bool]) and apply this substitution before + comparing types. In effect, in Lint, type equality is always + equality-modulo-le-subst. This is in the le_subst field of + LintEnv. But nota bene: + + (SI1) The le_subst substitution is applied to types and coercions only + + (SI2) The result of that substitution is used only to check for type + equality, to check well-typed-ness, /but is then discarded/. + The result of substitution does not outlive the CoreLint pass. + + (SI3) The InScopeSet of le_subst includes only TyVar and CoVar binders. + +* The function + lintInTy :: Type -> LintM (Type, Kind) + returns a substituted type. + +* When we encounter a binder (like x::a) we must apply the substitution + to the type of the binding variable. lintBinders does this. + +* Clearly we need to clone tyvar binders as we go. + +* But take care (#17590)! We must also clone CoVar binders: + let a = TYPE (ty |> cv) + in \cv -> blah + blindly substituting for `a` might capture `cv`. + +* Alas, when cloning a coercion variable we might choose a unique + that happens to clash with an inner Id, thus + \cv_66 -> let wild_X7 = blah in blah + We decide to clone `cv_66` because it's already in scope. Fine, + choose a new unique. Aha, X7 looks good. So we check the lambda + body with le_subst of [cv_66 :-> cv_X7] + + This is all fine, even though we use the same unique as wild_X7. + As (SI2) says, we do /not/ return a new lambda + (\cv_X7 -> let wild_X7 = blah in ...) + We simply use the le_subst substitution in types/coercions only, when + checking for equality. + +* We still need to check that Id occurrences are bound by some + enclosing binding. We do /not/ use the InScopeSet for the le_subst + for this purpose -- it contains only TyCoVars. Instead we have a separate + le_ids for the in-scope Id binders. + +Sigh. We might want to explore getting rid of type-let! + +Note [Bad unsafe coercion] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +For discussion see https://gitlab.haskell.org/ghc/ghc/wikis/bad-unsafe-coercions +Linter introduces additional rules that checks improper coercion between +different types, called bad coercions. Following coercions are forbidden: + + (a) coercions between boxed and unboxed values; + (b) coercions between unlifted values of the different sizes, here + active size is checked, i.e. size of the actual value but not + the space allocated for value; + (c) coercions between floating and integral boxed values, this check + is not yet supported for unboxed tuples, as no semantics were + specified for that; + (d) coercions from / to vector type + (e) If types are unboxed tuples then tuple (# A_1,..,A_n #) can be + coerced to (# B_1,..,B_m #) if n=m and for each pair A_i, B_i rules + (a-e) holds. + +Note [Join points] +~~~~~~~~~~~~~~~~~~ +We check the rules listed in Note [Invariants on join points] in GHC.Core. The +only one that causes any difficulty is the first: All occurrences must be tail +calls. To this end, along with the in-scope set, we remember in le_joins the +subset of in-scope Ids that are valid join ids. For example: + + join j x = ... in + case e of + A -> jump j y -- good + B -> case (jump j z) of -- BAD + C -> join h = jump j w in ... -- good + D -> let x = jump j v in ... -- BAD + +A join point remains valid in case branches, so when checking the A +branch, j is still valid. When we check the scrutinee of the inner +case, however, we set le_joins to empty, and catch the +error. Similarly, join points can occur free in RHSes of other join +points but not the RHSes of value bindings (thunks and functions). + +Note [Avoiding compiler perf traps when constructing error messages.] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's quite common to put error messages into a where clause when it might +be triggered by multiple branches. E.g. + + checkThing x y z = + case x of + X -> unless (correctX x) $ failWithL errMsg + Y -> unless (correctY y) $ failWithL errMsg + where + errMsg = text "My error involving:" $$ ppr x <+> ppr y + +However ghc will compile this to: + + checkThink x y z = + let errMsg = text "My error involving:" $$ ppr x <+> ppr y + in case x of + X -> unless (correctX x) $ failWithL errMsg + Y -> unless (correctY y) $ failWithL errMsg + +Putting the allocation of errMsg into the common non-error path. +One way to work around this is to turn errMsg into a function: + + checkThink x y z = + case x of + X -> unless (correctX x) $ failWithL (errMsg x y) + Y -> unless (correctY y) $ failWithL (errMsg x y) + where + errMsg x y = text "My error involving:" $$ ppr x <+> ppr y + +This way `errMsg` is a static function and it being defined in the common +path does not result in allocation in the hot path. This can be surprisingly +impactful. Changing `lint_app` reduced allocations for one test program I was +looking at by ~4%. + +Note [MCInfo for Lint] +~~~~~~~~~~~~~~~~~~~~~~ +When printing a Lint message, use the MCInfo severity so that the +message is printed on stderr rather than stdout (#13342). + +************************************************************************ +* * + Beginning and ending passes +* * +************************************************************************ +-} + +-- | Configuration for boilerplate operations at the end of a +-- compilation pass producing Core. +data EndPassConfig = EndPassConfig + { ep_dumpCoreSizes :: !Bool + -- ^ Whether core bindings should be dumped with the size of what they + -- are binding (i.e. the size of the RHS of the binding). + + , ep_lintPassResult :: !(Maybe LintPassResultConfig) + -- ^ Whether we should lint the result of this pass. + + , ep_namePprCtx :: !NamePprCtx + + , ep_dumpFlag :: !(Maybe DumpFlag) + + , ep_prettyPass :: !SDoc + + , ep_passDetails :: !SDoc + } + +endPassIO :: Logger + -> EndPassConfig + -> CoreProgram -> [CoreRule] + -> IO () +-- Used by the IO-is CorePrep too +endPassIO logger cfg binds rules + = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_namePprCtx cfg) mb_flag + (renderWithContext defaultSDocContext (ep_prettyPass cfg)) + (ep_passDetails cfg) binds rules + ; for_ (ep_lintPassResult cfg) $ \lp_cfg -> + lintPassResult logger lp_cfg binds + } + where + mb_flag = case ep_dumpFlag cfg of + Just flag | logHasDumpFlag logger flag -> Just flag + | logHasDumpFlag logger Opt_D_verbose_core2core -> Just flag + _ -> Nothing + +dumpPassResult :: Logger + -> Bool -- dump core sizes? + -> NamePprCtx + -> Maybe DumpFlag -- Just df => show details in a file whose + -- name is specified by df + -> String -- Header + -> SDoc -- Extra info to appear after header + -> CoreProgram -> [CoreRule] + -> IO () +dumpPassResult logger dump_core_sizes name_ppr_ctx mb_flag hdr extra_info binds rules + = do { forM_ mb_flag $ \flag -> do + logDumpFile logger (mkDumpStyle name_ppr_ctx) flag hdr FormatCore dump_doc + + -- Report result size + -- This has the side effect of forcing the intermediate to be evaluated + -- if it's not already forced by a -ddump flag. + ; Err.debugTraceMsg logger 2 size_doc + } + + where + size_doc = sep [text "Result size of" <+> text hdr, nest 2 (equals <+> ppr (coreBindsStats binds))] + + dump_doc = vcat [ nest 2 extra_info + , size_doc + , blankLine + , if dump_core_sizes + then pprCoreBindingsWithSize binds + else pprCoreBindings binds + , ppUnless (null rules) pp_rules ] + pp_rules = vcat [ blankLine + , text "------ Local rules for imported ids --------" + , pprRules rules ] + +{- +************************************************************************ +* * + Top-level interfaces +* * +************************************************************************ +-} + +data LintPassResultConfig = LintPassResultConfig + { lpr_diagOpts :: !DiagOpts + , lpr_platform :: !Platform + , lpr_makeLintFlags :: !LintFlags + , lpr_showLintWarnings :: !Bool + , lpr_passPpr :: !SDoc + , lpr_localsInScope :: ![Var] + } + +lintPassResult :: Logger -> LintPassResultConfig + -> CoreProgram -> IO () +lintPassResult logger cfg binds + = do { let warns_and_errs = lintCoreBindings' + (LintConfig + { l_diagOpts = lpr_diagOpts cfg + , l_platform = lpr_platform cfg + , l_flags = lpr_makeLintFlags cfg + , l_vars = lpr_localsInScope cfg + }) + binds + ; Err.showPass logger $ + "Core Linted result of " ++ + renderWithContext defaultSDocContext (lpr_passPpr cfg) + ; displayLintResults logger + (lpr_showLintWarnings cfg) (lpr_passPpr cfg) + (pprCoreBindings binds) warns_and_errs + } + +displayLintResults :: Logger + -> Bool -- ^ If 'True', display linter warnings. + -- If 'False', ignore linter warnings. + -> SDoc -- ^ The source of the linted program + -> SDoc -- ^ The linted program, pretty-printed + -> WarnsAndErrs + -> IO () +displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) + | not (isEmptyBag errs) + = do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] + $ withPprStyle defaultDumpStyle + (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs + , text "*** Offending Program ***" + , pp_pgm + , text "*** End of Offense ***" ]) + ; Err.ghcExit logger 1 } + + | not (isEmptyBag warns) + , log_enable_debug (logFlags logger) + , display_warnings + = logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] + $ withPprStyle defaultDumpStyle + (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns)) + + | otherwise = return () + +lint_banner :: String -> SDoc -> SDoc +lint_banner string pass = text "*** Core Lint" <+> text string + <+> text ": in result of" <+> pass + <+> text "***" + +-- | Type-check a 'CoreProgram'. See Note [Core Lint guarantee]. +lintCoreBindings' :: LintConfig -> CoreProgram -> WarnsAndErrs +-- Returns (warnings, errors) +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintCoreBindings' cfg binds + = initL cfg $ + addLoc TopLevelBindings $ + do { -- Check that all top-level binders are distinct + -- We do not allow [NonRec x=1, NonRec y=x, NonRec x=2] + -- because of glomming; see Note [Glomming] in GHC.Core.Opt.OccurAnal + checkL (null dups) (dupVars dups) + + -- Check for External top level binders with the same M.n name + ; checkL (null ext_dups) (dupExtVars ext_dups) + + -- Typecheck the bindings + ; lintRecBindings TopLevel all_pairs $ \_ -> + return () } + where + all_pairs = flattenBinds binds + -- Put all the top-level binders in scope at the start + -- This is because rewrite rules can bring something + -- into use 'unexpectedly'; see Note [Glomming] in "GHC.Core.Opt.OccurAnal" + binders = map fst all_pairs + + (_, dups) = removeDups compare binders + + -- ext_dups checks for names with different uniques + -- but the same External name M.n. We don't + -- allow this at top level: + -- M.n{r3} = ... + -- M.n{r29} = ... + -- because they both get the same linker symbol + ext_dups = snd $ removeDupsOn ord_ext $ + filter isExternalName $ map Var.varName binders + ord_ext n = (nameModule n, nameOccName n) + +{- +************************************************************************ +* * +\subsection[lintUnfolding]{lintUnfolding} +* * +************************************************************************ + +Note [Linting Unfoldings from Interfaces] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We use this to check all top-level unfoldings that come in from interfaces +(it is very painful to catch errors otherwise). + +We do not need to call lintUnfolding on unfoldings that are nested within +top-level unfoldings; they are linted when we lint the top-level unfolding; +hence the `TopLevelFlag` on `tcPragExpr` in GHC.IfaceToCore. + +-} + +lintUnfolding :: Bool -- ^ True <=> is a compulsory unfolding + -> LintConfig + -> SrcLoc + -> CoreExpr + -> Maybe (Bag SDoc) -- Nothing => OK + +lintUnfolding is_compulsory cfg locn expr + | isEmptyBag errs = Nothing + | otherwise = Just errs + where + (_warns, errs) = initL cfg $ + if is_compulsory + -- See Note [Checking for representation polymorphism] + then noFixedRuntimeRepChecks linter + else linter + linter = addLoc (ImportedUnfolding locn) $ + lintCoreExpr expr + +lintExpr :: LintConfig + -> CoreExpr + -> Maybe (Bag SDoc) -- Nothing => OK + +lintExpr cfg expr + | isEmptyBag errs = Nothing + | otherwise = Just errs + where + (_warns, errs) = initL cfg linter + linter = addLoc TopLevelBindings $ + lintCoreExpr expr + +{- +************************************************************************ +* * +\subsection[lintCoreBinding]{lintCoreBinding} +* * +************************************************************************ + +Check a core binding, returning the list of variables bound. +-} + +-- Returns a UsageEnv because this function is called in lintCoreExpr for +-- Let + +lintRecBindings :: TopLevelFlag -> [(Id, CoreExpr)] + -> ([OutId] -> LintM a) -> LintM (a, [UsageEnv]) +lintRecBindings top_lvl pairs thing_inside + = lintIdBndrs top_lvl bndrs $ \ bndrs' -> + do { ues <- zipWithM lint_pair bndrs' rhss + ; a <- thing_inside bndrs' + ; return (a, ues) } + where + (bndrs, rhss) = unzip pairs + lint_pair bndr' rhs + = addLoc (RhsOf bndr') $ + do { (rhs_ty, ue) <- lintRhs bndr' rhs -- Check the rhs + ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty + ; return ue } + +lintLetBody :: LintLocInfo -> [OutId] -> CoreExpr -> LintM (OutType, UsageEnv) +lintLetBody loc bndrs body + = do { (body_ty, body_ue) <- addLoc loc (lintCoreExpr body) + ; mapM_ (lintJoinBndrType body_ty) bndrs + ; return (body_ty, body_ue) } + +lintLetBind :: TopLevelFlag -> RecFlag -> OutId + -> CoreExpr -> OutType -> LintM () +-- Binder's type, and the RHS, have already been linted +-- This function checks other invariants +lintLetBind top_lvl rec_flag binder rhs rhs_ty + = do { let binder_ty = idType binder + ; ensureEqTys binder_ty rhs_ty (mkRhsMsg binder (text "RHS") rhs_ty) + + -- If the binding is for a CoVar, the RHS should be (Coercion co) + -- See Note [Core type and coercion invariant] in GHC.Core + ; checkL (not (isCoVar binder) || isCoArg rhs) + (mkLetErr binder rhs) + + -- Check the let-can-float invariant + -- See Note [Core let-can-float invariant] in GHC.Core + ; checkL ( isJoinId binder + || mightBeLiftedType binder_ty + || (isNonRec rec_flag && exprOkForSpeculation rhs) + || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed + || exprIsTickedString rhs) + (badBndrTyMsg binder (text "unlifted")) + + -- Check that if the binder is at the top level and has type Addr#, + -- that it is a string literal. + -- See Note [Core top-level string literals]. + ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy) + || exprIsTickedString rhs) + (mkTopNonLitStrMsg binder) + + ; flags <- getLintFlags + + -- Check that a join-point binder has a valid type + -- NB: lintIdBinder has checked that it is not top-level bound + ; case idJoinPointHood binder of + NotJoinPoint -> return () + JoinPoint arity -> checkL (isValidJoinPointType arity binder_ty) + (mkInvalidJoinPointMsg binder binder_ty) + + ; when (lf_check_inline_loop_breakers flags + && isStableUnfolding (realIdUnfolding binder) + && isStrongLoopBreaker (idOccInfo binder) + && isInlinePragma (idInlinePragma binder)) + (addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder)) + -- Only non-rule loop breakers inhibit inlining + + -- We used to check that the dmdTypeDepth of a demand signature never + -- exceeds idArity, but that is an unnecessary complication, see + -- Note [idArity varies independently of dmdTypeDepth] in GHC.Core.Opt.DmdAnal + + -- Check that the binder's arity is within the bounds imposed by the type + -- and the strictness signature. See Note [Arity invariants for bindings] + -- and Note [Trimming arity] + + ; checkL (typeArity (idType binder) >= idArity binder) + (text "idArity" <+> ppr (idArity binder) <+> + text "exceeds typeArity" <+> + ppr (typeArity (idType binder)) <> colon <+> + ppr binder) + + -- See Note [idArity varies independently of dmdTypeDepth] + -- in GHC.Core.Opt.DmdAnal + ; case splitDmdSig (idDmdSig binder) of + (demands, result_info) | isDeadEndDiv result_info -> + if (demands `lengthAtLeast` idArity binder) + then return () + else pprTrace "Hack alert: lintLetBind #24623" + (ppr (idArity binder) $$ ppr (idDmdSig binder)) $ + return () +-- checkL (demands `lengthAtLeast` idArity binder) +-- (text "idArity" <+> ppr (idArity binder) <+> +-- text "exceeds arity imposed by the strictness signature" <+> +-- ppr (idDmdSig binder) <> colon <+> +-- ppr binder) + + _ -> return () + + ; addLoc (RuleOf binder) $ mapM_ (lintCoreRule binder binder_ty) (idCoreRules binder) + + ; addLoc (UnfoldingOf binder) $ + lintIdUnfolding binder binder_ty (idUnfolding binder) + ; return () } + + -- We should check the unfolding, if any, but this is tricky because + -- the unfolding is a SimplifiableCoreExpr. Give up for now. + +-- | Checks the RHS of bindings. It only differs from 'lintCoreExpr' +-- in that it doesn't reject occurrences of the function 'makeStatic' when they +-- appear at the top level and @lf_check_static_ptrs == AllowAtTopLevel@, and +-- for join points, it skips the outer lambdas that take arguments to the +-- join point. +-- +-- See Note [Checking StaticPtrs]. +lintRhs :: Id -> CoreExpr -> LintM (OutType, UsageEnv) +-- NB: the Id can be Linted or not -- it's only used for +-- its OccInfo and join-pointer-hood +lintRhs bndr rhs + | JoinPoint arity <- idJoinPointHood bndr + = lintJoinLams arity (Just bndr) rhs + | AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr) + = lintJoinLams arity Nothing rhs + +-- Allow applications of the data constructor @StaticPtr@ at the top +-- but produce errors otherwise. +lintRhs _bndr rhs = fmap lf_check_static_ptrs getLintFlags >>= go + where + -- Allow occurrences of 'makeStatic' at the top-level but produce errors + -- otherwise. + go :: StaticPtrCheck -> LintM (OutType, UsageEnv) + go AllowAtTopLevel + | (binders0, rhs') <- collectTyBinders rhs + , Just (fun, t, info, e) <- collectMakeStaticArgs rhs' + = markAllJoinsBad $ + foldr + -- imitate @lintCoreExpr (Lam ...)@ + lintLambda + -- imitate @lintCoreExpr (App ...)@ + (do fun_ty_ue <- lintCoreExpr fun + lintCoreArgs fun_ty_ue [Type t, info, e] + ) + binders0 + go _ = markAllJoinsBad $ lintCoreExpr rhs + +-- | Lint the RHS of a join point with expected join arity of @n@ (see Note +-- [Join points] in "GHC.Core"). +lintJoinLams :: JoinArity -> Maybe Id -> CoreExpr -> LintM (OutType, UsageEnv) +lintJoinLams join_arity enforce rhs + = go join_arity rhs + where + go 0 expr = lintCoreExpr expr + go n (Lam var body) = lintLambda var $ go (n-1) body + go n expr | Just bndr <- enforce -- Join point with too few RHS lambdas + = failWithL $ mkBadJoinArityMsg bndr join_arity n rhs + | otherwise -- Future join point, not yet eta-expanded + = markAllJoinsBad $ lintCoreExpr expr + -- Body of lambda is not a tail position + +lintIdUnfolding :: Id -> Type -> Unfolding -> LintM () +lintIdUnfolding bndr bndr_ty uf + | isStableUnfolding uf + , Just rhs <- maybeUnfoldingTemplate uf + = do { ty <- fst <$> (if isCompulsoryUnfolding uf + then noFixedRuntimeRepChecks $ lintRhs bndr rhs + -- ^^^^^^^^^^^^^^^^^^^^^^^ + -- See Note [Checking for representation polymorphism] + else lintRhs bndr rhs) + ; ensureEqTys bndr_ty ty (mkRhsMsg bndr (text "unfolding") ty) } +lintIdUnfolding _ _ _ + = return () -- Do not Lint unstable unfoldings, because that leads + -- to exponential behaviour; c.f. GHC.Core.FVs.idUnfoldingVars + +{- Note [Checking for INLINE loop breakers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very suspicious if a strong loop breaker is marked INLINE. + +However, the desugarer generates instance methods with INLINE pragmas +that form a mutually recursive group. Only after a round of +simplification are they unravelled. So we suppress the test for +the desugarer. Here is an example: + instance Eq T where + t1 == t2 = blah + t1 /= t2 = not (t1 == t2) + {-# INLINE (/=) #-} + +This will generate something like + -- From the class decl for Eq + data Eq a = EqDict (a->a->Bool) (a->a->Bool) + eq_sel :: Eq a -> (a->a->Bool) + eq_sel (EqDict eq _) = eq + + -- From the instance Eq T + $ceq :: T -> T -> Bool + $ceq = blah + + Rec { $dfEqT :: Eq T {-# DFunId #-} + $dfEqT = EqDict $ceq $cnoteq + + $cnoteq :: T -> T -> Bool {-# INLINE #-} + $cnoteq x y = not (eq_sel $dfEqT x y) } + +Notice that + +* `$dfEqT` and `$cnotEq` are mutually recursive. + +* We do not want `$dfEqT` to be the loop breaker: it's a DFunId, and + we want to let it "cancel" with "eq_sel" (see Note [ClassOp/DFun + selection] in GHC.Tc.TyCl.Instance, which it can't do if it's a loop + breaker. + +So we make `$cnoteq` into the loop breaker. That means it can't +inline, despite the INLINE pragma. That's what gives rise to the +warning, which is perfectly appropriate for, say + Rec { {-# INLINE f #-} f = \x -> ...f.... } +We can't inline a recursive function -- it's a loop breaker. + +But now we can optimise `eq_sel $dfEqT` to `$ceq`, so we get + Rec { + $dfEqT :: Eq T {-# DFunId #-} + $dfEqT = EqDict $ceq $cnoteq + + $cnoteq :: T -> T -> Bool {-# INLINE #-} + $cnoteq x y = not ($ceq x y) } + +and now the dependencies of the Rec have gone, and we can split it up to give + NonRec { $dfEqT :: Eq T {-# DFunId #-} + $dfEqT = EqDict $ceq $cnoteq } + + NonRec { $cnoteq :: T -> T -> Bool {-# INLINE #-} + $cnoteq x y = not ($ceq x y) } + +Now $cnoteq is not a loop breaker any more, so the INLINE pragma can +take effect -- the warning turned out to be temporary. + +To stop excessive warnings, this warning for INLINE loop breakers is +switched off when linting the result of the desugarer. See +lf_check_inline_loop_breakers in GHC.Core.Lint. + + +Note [Checking for representation polymorphism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We ordinarily want to check for bad representation polymorphism. See +Note [Representation polymorphism invariants] in GHC.Core. However, we do *not* +want to do this in a compulsory unfolding. Compulsory unfoldings arise +only internally, for things like newtype wrappers, dictionaries, and +(notably) unsafeCoerce#. These might legitimately be representation-polymorphic; +indeed representation-polymorphic unfoldings are a primary reason for the +very existence of compulsory unfoldings (we can't compile code for +the original, representation-polymorphic, binding). + +It is vitally important that we do representation polymorphism checks *after* +performing the unfolding, but not beforehand. This is all safe because +we will check any unfolding after it has been unfolded; checking the +unfolding beforehand is merely an optimization, and one that actively +hurts us here. + +Note [Linting of runRW#] +~~~~~~~~~~~~~~~~~~~~~~~~ +runRW# has some very special behavior (see Note [runRW magic] in +GHC.CoreToStg.Prep) which CoreLint must accommodate, by allowing +join points in its argument. For example, this is fine: + + join j x = ... + in runRW# (\s. case v of + A -> j 3 + B -> j 4) + +Usually those calls to the join point 'j' would not be valid tail calls, +because they occur in a function argument. But in the case of runRW# +they are fine, because runRW# (\s.e) behaves operationally just like e. +(runRW# is ultimately inlined in GHC.CoreToStg.Prep.) + +In the case that the continuation is /not/ a lambda we simply disable this +special behaviour. For example, this is /not/ fine: + + join j = ... + in runRW# @r @ty (jump j) + +Note [Coercions in terms] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The expression (Type ty) can occur only as the argument of an application, +or the RHS of a non-recursive Let. But what about (Coercion co)? + +Currently it appears in ghc-prim:GHC.Types.coercible_sel, a WiredInId whose +definition is: + coercible_sel :: Coercible a b => (a ~R# b) + coercible_sel d = case d of + MkCoercibleDict (co :: a ~# b) -> Coercion co + +So this function has a (Coercion co) in the alternative of a case. + +Richard says (!11908): it shouldn't appear outside of arguments, but we've been +loose about this. coercible_sel is some thin ice. Really we should be unpacking +Coercible using case, not a selector. I recall looking into this a few years +back and coming to the conclusion that the fix was worse than the disease. Don't +remember the details, but could probably recover it if we want to revisit. + +So Lint current accepts (Coercion co) in arbitrary places. There is no harm in +that: it really is a value, albeit a zero-bit value. + +************************************************************************ +* * +\subsection[lintCoreExpr]{lintCoreExpr} +* * +************************************************************************ +-} + +lintCoreExpr :: InExpr -> LintM (OutType, UsageEnv) +-- The returned type has the substitution from the monad +-- already applied to it: +-- lintCoreExpr e subst = exprType (subst e) +-- +-- The returned "type" can be a kind, if the expression is (Type ty) + +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] + +lintCoreExpr (Var var) + = do { var_pair@(var_ty, _) <- lintIdOcc var 0 + -- See Note [Linting representation-polymorphic builtins] + ; checkRepPolyBuiltin (Var var) [] var_ty + --checkDataToTagPrimOpTyCon (Var var) [] + ; return var_pair } + +lintCoreExpr (Lit lit) + = return (literalType lit, zeroUE) + +lintCoreExpr (Cast expr co) + = do { (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr) + -- markAllJoinsBad: see Note [Join points and casts] + + ; lintCoercion co + ; lintRole co Representational (coercionRole co) + ; Pair from_ty to_ty <- substCoKindM co + ; checkValueType (typeKind to_ty) $ + text "target of cast" <+> quotes (ppr co) + ; ensureEqTys from_ty expr_ty (mkCastErr expr co from_ty expr_ty) + ; return (to_ty, ue) } + +lintCoreExpr (Tick tickish expr) + = do { case tickish of + Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0 + _ -> return () + ; markAllJoinsBadIf block_joins $ lintCoreExpr expr } + where + block_joins = not (tickish `tickishScopesLike` SoftScope) + -- TODO Consider whether this is the correct rule. It is consistent with + -- the simplifier's behaviour - cost-centre-scoped ticks become part of + -- the continuation, and thus they behave like part of an evaluation + -- context, but soft-scoped and non-scoped ticks simply wrap the result + -- (see Simplify.simplTick). + +lintCoreExpr (Let (NonRec tv (Type ty)) body) + | isTyVar tv + = -- See Note [Linting type lets] + do { ty' <- lintTypeAndSubst ty + ; lintTyCoBndr tv $ \ tv' -> + do { addLoc (RhsOf tv) $ lintTyKind tv' ty' + -- Now extend the substitution so we + -- take advantage of it in the body + ; extendTvSubstL tv ty' $ + addLoc (BodyOfLet tv) $ + lintCoreExpr body } } + +lintCoreExpr (Let (NonRec bndr rhs) body) + | isId bndr + = do { -- First Lint the RHS, before bringing the binder into scope + (rhs_ty, let_ue) <- lintRhs bndr rhs + + -- See Note [Multiplicity of let binders] in Var + -- Now lint the binder + ; lintBinder LetBind bndr $ \bndr' -> + do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty + ; addAliasUE bndr' let_ue $ + lintLetBody (BodyOfLet bndr') [bndr'] body } } + + | otherwise + = failWithL (mkLetErr bndr rhs) -- Not quite accurate + +lintCoreExpr e@(Let (Rec pairs) body) + = do { -- Check that the list of pairs is non-empty + checkL (not (null pairs)) (emptyRec e) + + -- Check that there are no duplicated binders + ; let (_, dups) = removeDups compare bndrs + ; checkL (null dups) (dupVars dups) + + -- Check that either all the binders are joins, or none + ; checkL (all isJoinId bndrs || all (not . isJoinId) bndrs) $ + mkInconsistentRecMsg bndrs + + -- See Note [Multiplicity of let binders] in Var + ; ((body_type, body_ue), ues) <- + lintRecBindings NotTopLevel pairs $ \ bndrs' -> + lintLetBody (BodyOfLetRec bndrs') bndrs' body + ; return (body_type, body_ue `addUE` scaleUE ManyTy (foldr1WithDefault zeroUE addUE ues)) } + where + bndrs = map fst pairs + +lintCoreExpr e@(App _ _) + | Var fun <- fun + , fun `hasKey` runRWKey + -- See Note [Linting of runRW#] + -- N.B. we may have an over-saturated application of the form: + -- runRW (\s -> \x -> ...) y + , ty_arg1 : ty_arg2 : cont_arg : rest <- args + = do { let lint_rw_cont :: CoreArg -> Mult -> UsageEnv -> LintM (OutType, UsageEnv) + lint_rw_cont expr@(Lam _ _) mult fun_ue + = do { (arg_ty, arg_ue) <- lintJoinLams 1 (Just fun) expr + ; let app_ue = addUE fun_ue (scaleUE mult arg_ue) + ; return (arg_ty, app_ue) } + + lint_rw_cont expr mult ue + = lintValArg expr mult ue + -- TODO: Look through ticks? + + ; runrw_pr <- lintApp (text "runRW# expression") + lintTyArg lint_rw_cont + (idType fun) [ty_arg1,ty_arg2,cont_arg] zeroUE + ; lintCoreArgs runrw_pr rest } + + | otherwise + = do { fun_pair <- lintCoreFun fun (length args) + ; app_pair@(app_ty, _) <- lintCoreArgs fun_pair args + + -- See Note [Linting representation-polymorphic builtins] + ; checkRepPolyBuiltin fun args app_ty + ; --checkDataToTagPrimOpTyCon fun args + + ; return app_pair} + where + skipTick t = case collectFunSimple e of + (Var v) -> etaExpansionTick v t + _ -> tickishFloatable t + (fun, args, _source_ticks) = collectArgsTicks skipTick e + -- We must look through source ticks to avoid #21152, for example: + -- + -- reallyUnsafePtrEquality + -- = \ @a -> + -- (src reallyUnsafePtrEquality#) + -- @Lifted @a @Lifted @a + -- + -- To do this, we use `collectArgsTicks tickishFloatable` to match + -- the eta expansion behaviour, as per Note [Eta expansion and source notes] + -- in GHC.Core.Opt.Arity. + -- Sadly this was not quite enough. So we now also accept things that CorePrep will allow. + -- See Note [Ticks and mandatory eta expansion] + +lintCoreExpr (Lam var expr) + = markAllJoinsBad $ + lintLambda var $ lintCoreExpr expr + +lintCoreExpr (Case scrut var alt_ty alts) + = lintCaseExpr scrut var alt_ty alts + +-- This case can't happen; linting types in expressions gets routed through lintTyArg +lintCoreExpr (Type ty) + = failWithL (text "Type found as expression" <+> ppr ty) + +lintCoreExpr (Coercion co) + -- See Note [Coercions in terms] + = do { addLoc (InCo co) $ lintCoercion co + ; ty <- substTyM (coercionType co) + ; return (ty, zeroUE) } + +---------------------- +lintIdOcc :: InId -> Int -- Number of arguments (type or value) being passed + -> LintM (OutType, UsageEnv) -- returns type of the *variable* +lintIdOcc in_id nargs + = addLoc (OccOf in_id) $ + do { checkL (isNonCoVarId in_id) + (text "Non term variable" <+> ppr in_id) + -- See GHC.Core Note [Variable occurrences in Core] + + -- Check that the type of the occurrence is the same + -- as the type of the binding site. The inScopeIds are + -- /un-substituted/, so this checks that the occurrence type + -- is identical to the binder type. + -- This makes things much easier for things like: + -- /\a. \(x::Maybe a). /\a. ...(x::Maybe a)... + -- The "::Maybe a" on the occurrence is referring to the /outer/ a. + -- If we compared /substituted/ types we'd risk comparing + -- (Maybe a) from the binding site with bogus (Maybe a1) from + -- the occurrence site. Comparing un-substituted types finesses + -- this altogether + ; out_ty <- lintVarOcc in_id + + -- Check for a nested occurrence of the StaticPtr constructor. + -- See Note [Checking StaticPtrs]. + ; lf <- getLintFlags + ; when (nargs /= 0 && lf_check_static_ptrs lf /= AllowAnywhere) $ + checkL (idName in_id /= makeStaticName) $ + text "Found makeStatic nested in an expression" + + ; checkDeadIdOcc in_id + + ; case isDataConId_maybe in_id of + Nothing -> return () + Just dc -> checkTypeDataConOcc "expression" dc + + ; checkJoinOcc in_id nargs + ; usage <- varCallSiteUsage in_id + + ; return (out_ty, usage) } + + + +lintCoreFun :: CoreExpr + -> Int -- Number of arguments (type or val) being passed + -> LintM (OutType, UsageEnv) -- Returns type of the *function* +lintCoreFun (Var var) nargs + = lintIdOcc var nargs + +lintCoreFun (Lam var body) nargs + -- Act like lintCoreExpr of Lam, but *don't* call markAllJoinsBad; + -- See Note [Beta redexes] + | nargs /= 0 + = lintLambda var $ lintCoreFun body (nargs - 1) + +lintCoreFun expr nargs + = markAllJoinsBadIf (nargs /= 0) $ + -- See Note [Join points are less general than the paper] + lintCoreExpr expr +------------------ +lintLambda :: Var -> LintM (Type, UsageEnv) -> LintM (Type, UsageEnv) +lintLambda var lintBody = + addLoc (LambdaBodyOf var) $ + lintBinder LambdaBind var $ \ var' -> + do { (body_ty, ue) <- lintBody + ; ue' <- checkLinearity ue var' + ; return (mkLamType var' body_ty, ue') } +------------------ +checkDeadIdOcc :: Id -> LintM () +-- Occurrences of an Id should never be dead.... +-- except when we are checking a case pattern +checkDeadIdOcc id + | isDeadOcc (idOccInfo id) + = do { in_case <- inCasePat + ; checkL in_case + (text "Occurrence of a dead Id" <+> ppr id) } + | otherwise + = return () + +------------------ +lintJoinBndrType :: OutType -- Type of the body + -> OutId -- Possibly a join Id + -> LintM () +-- Checks that the return type of a join Id matches the body +-- E.g. join j x = rhs in body +-- The type of 'rhs' must be the same as the type of 'body' +lintJoinBndrType body_ty bndr + | JoinPoint arity <- idJoinPointHood bndr + , let bndr_ty = idType bndr + , (bndrs, res) <- splitPiTys bndr_ty + = checkL (length bndrs >= arity + && body_ty `eqType` mkPiTys (drop arity bndrs) res) $ + hang (text "Join point returns different type than body") + 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr) + , text "Join arity:" <+> ppr arity + , text "Body type:" <+> ppr body_ty ]) + | otherwise + = return () + +checkJoinOcc :: Id -> JoinArity -> LintM () +-- Check that if the occurrence is a JoinId, then so is the +-- binding site, and it's a valid join Id +checkJoinOcc var n_args + | JoinPoint join_arity_occ <- idJoinPointHood var + = do { mb_join_arity_bndr <- lookupJoinId var + ; case mb_join_arity_bndr of { + NotJoinPoint -> do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; + + JoinPoint join_arity_bndr -> + + do { checkL (join_arity_bndr == join_arity_occ) $ + -- Arity differs at binding site and occurrence + mkJoinBndrOccMismatchMsg var join_arity_bndr join_arity_occ + + ; checkL (n_args == join_arity_occ) $ + -- Arity doesn't match #args + mkBadJumpMsg var join_arity_occ n_args } } } + + | otherwise + = return () + +checkTypeDataConOcc :: String -> DataCon -> LintM () +-- Check that the Id is not a data constructor of a `type data` declaration +-- Invariant (I1) of Note [Type data declarations] in GHC.Rename.Module +checkTypeDataConOcc what dc + = checkL (not (isTypeDataTyCon (dataConTyCon dc))) $ + (text "type data constructor found in a" <+> text what <> colon <+> ppr dc) + +{- +-- | Check that a use of a dataToTag# primop satisfies conditions DTT2 +-- and DTT3 from Note [DataToTag overview] in GHC.Tc.Instance.Class +-- +-- Ignores applications not headed by dataToTag# primops. + +-- Commented out because GHC.PrimopWrappers doesn't respect this condition yet. +-- See wrinkle DTW7 in Note [DataToTag overview]. +checkDataToTagPrimOpTyCon + :: CoreExpr -- ^ the function (head of the application) we are checking + -> [CoreArg] -- ^ The arguments to the application + -> LintM () +checkDataToTagPrimOpTyCon (Var fun_id) args + | Just op <- isPrimOpId_maybe fun_id + , op == DataToTagSmallOp || op == DataToTagLargeOp + = case args of + Type _levity : Type dty : _rest + | Just (tc, _) <- splitTyConApp_maybe dty + , isValidDTT2TyCon tc + -> do platform <- getPlatform + let numConstrs = tyConFamilySize tc + isSmallOp = op == DataToTagSmallOp + checkL (isSmallFamily platform numConstrs == isSmallOp) $ + text "dataToTag# primop-size/tycon-family-size mismatch" + | otherwise -> failWithL $ text "dataToTagLarge# used at non-ADT type:" + <+> ppr dty + _ -> failWithL $ text "dataToTagLarge# needs two type arguments but has args:" + <+> ppr (take 2 args) + +checkDataToTagPrimOpTyCon _ _ = pure () +-} + +-- | Check representation-polymorphic invariants in an application of a +-- built-in function or newtype constructor. +-- +-- See Note [Linting representation-polymorphic builtins]. +checkRepPolyBuiltin :: CoreExpr -- ^ the function (head of the application) we are checking + -> [CoreArg] -- ^ the arguments to the application + -> OutType -- ^ the instantiated type of the overall application + -> LintM () +checkRepPolyBuiltin (Var fun_id) args app_ty + = do { do_rep_poly_checks <- lf_check_fixed_rep <$> getLintFlags + ; when (do_rep_poly_checks && hasNoBinding fun_id) $ + if + -- (2) representation-polymorphic unlifted newtypes + | Just dc <- isDataConId_maybe fun_id + , isNewDataCon dc + -> if tcHasFixedRuntimeRep $ dataConTyCon dc + then return () + else checkRepPolyNewtypeApp dc args app_ty + + -- (1) representation-polymorphic builtins + | otherwise + -> checkRepPolyBuiltinApp fun_id args + } +checkRepPolyBuiltin _ _ _ = return () + +checkRepPolyNewtypeApp :: DataCon -> [CoreArg] -> OutType -> LintM () +checkRepPolyNewtypeApp nt args app_ty + -- If the newtype is saturated, we're OK. + | any isValArg args + = return () + -- Otherwise, check we can eta-expand. + | otherwise + = case getRuntimeArgTys app_ty of + (Scaled _ first_val_arg_ty, _):_ + | not $ typeHasFixedRuntimeRep first_val_arg_ty + -> failWithL (err_msg first_val_arg_ty) + _ -> return () + + where + + err_msg :: Type -> SDoc + err_msg bad_arg_ty + = vcat [ text "Cannot eta expand unlifted newtype constructor" <+> quotes (ppr nt) <> dot + , text "Its argument type does not have a fixed runtime representation:" + , nest 2 $ ppr_ty_ki bad_arg_ty ] + + ppr_ty_ki :: Type -> SDoc + ppr_ty_ki ty = bullet <+> ppr ty <+> dcolon <+> ppr (typeKind ty) + +checkRepPolyBuiltinApp :: Id -> [CoreArg] -> LintM () +checkRepPolyBuiltinApp fun_id args = checkL (null not_concs) err_msg + where + + conc_binder_positions :: IntMap ConcreteTvOrigin + conc_binder_positions + = concreteTyVarPositions fun_id + $ idDetailsConcreteTvs + $ idDetails fun_id + + max_pos :: Int + max_pos = + case nonEmpty $ IntMap.keys conc_binder_positions of + Nothing -> 0 + Just positions -> maximum positions + + not_concs :: [(SDoc, ConcreteTvOrigin)] + not_concs = + mapMaybe is_bad (zip [1..max_pos] (map Just args ++ repeat Nothing)) + -- NB: 1-indexed + + is_bad :: (Int, Maybe CoreArg) -> Maybe (SDoc, ConcreteTvOrigin) + is_bad (pos, mb_arg) + | Just conc_reason <- IntMap.lookup pos conc_binder_positions + , Just bad_ty <- case mb_arg of + Just (Type ki) + | isConcreteType ki + -> Nothing + | otherwise + -- Here we handle the situation in which a "must be concrete" TyVar + -- has been instantiated with a type that is not concrete. + -> Just $ quotes (ppr ki) <+> text "is not concrete." + -- We expected a type argument in this position, and got something else: panic! + Just arg -> + pprPanic "checkRepPolyBuiltinApp: expected a type in this position" $ + vcat [ text "fun_id:" <+> ppr fun_id <+> dcolon <+> ppr (idType fun_id) + , text "pos:" <+> ppr pos + , text "arg:" <+> ppr arg ] + Nothing -> + -- Here we handle the situation in which a "must be concrete" TyVar + -- has not been instantiated at all. + case conc_reason of + ConcreteFRR frr_orig -> + let ty = frr_type frr_orig + in Just $ ppr ty <+> dcolon <+> ppr (typeKind ty) + = Just (bad_ty, conc_reason) + | otherwise + = Nothing + + err_msg :: SDoc + err_msg + = vcat $ map ((bullet <+>) . ppr_not_conc) not_concs + + ppr_not_conc :: (SDoc, ConcreteTvOrigin) -> SDoc + ppr_not_conc (bad_ty, conc) = + vcat + [ ppr_conc_orig conc + , nest 2 bad_ty ] + + ppr_conc_orig :: ConcreteTvOrigin -> SDoc + ppr_conc_orig (ConcreteFRR frr_orig) = + case frr_orig of + FixedRuntimeRepOrigin { frr_context = ctxt } -> + hsep [ ppr ctxt, text "does not have a fixed runtime representation:" ] + +-- | Compute the 1-indexed positions in the outer forall'd quantified type variables +-- of the type in which the concrete type variables occur. +-- +-- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete. +concreteTyVarPositions :: Id -> ConcreteTyVars -> IntMap ConcreteTvOrigin +concreteTyVarPositions fun_id conc_tvs + | isNullUFM conc_tvs + = IntMap.empty + | otherwise + = case splitForAllTyCoVars (idType fun_id) of + ([], _) -> IntMap.empty + (tvs, _) -> + let positions = + IntMap.fromList + [ (pos, conc_orig) + | (tv, pos) <- zip tvs [1..] + , conc_orig <- maybeToList $ lookupNameEnv conc_tvs (tyVarName tv) + ] + -- Assert that we have as many positions as concrete type variables, + -- i.e. we are not missing any concreteness information. + in assertPpr (sizeUFM conc_tvs == length positions) + (vcat [ text "concreteTyVarPositions: missing concreteness information" + , text "fun_id:" <+> ppr fun_id + , text "tvs:" <+> ppr tvs + , text "Expected # of concrete tvs:" <+> ppr (sizeUFM conc_tvs) + , text " Actual # of concrete tvs:" <+> ppr (length positions) ]) + positions + +-- Check that the usage of var is consistent with var itself, and pop the var +-- from the usage environment (this is important because of shadowing). +checkLinearity :: UsageEnv -> OutVar -> LintM UsageEnv +checkLinearity body_ue lam_var = + case varMultMaybe lam_var of + Just mult -> do + let (lhs, body_ue') = popUE body_ue lam_var + err_msg = vcat [ text "Linearity failure in lambda:" <+> ppr lam_var + , ppr lhs <+> text "⊈" <+> ppr mult + , ppr body_ue ] + ensureSubUsage lhs mult err_msg + return body_ue' + Nothing -> return body_ue -- A type variable + +{- Note [Join points and casts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +You might think that this should be OK: + join j x = rhs + in (case e of + A -> alt1 + B x -> (jump j x) |> co) + +You might think that, since the cast is ultimately erased, the jump to +`j` should still be OK as a join point. But no! See #21716. Suppose + + newtype Age = MkAge Int -- axAge :: Age ~ Int + f :: Int -> ... -- f strict in it's first argument + +and consider the expression + + f (join j :: Bool -> Age + j x = (rhs1 :: Age) + in case v of + Just x -> (j x |> axAge :: Int) + Nothing -> rhs2) + +Then, if the Simplifier pushes the strict call into the join points +and alternatives we'll get + + join j' x = f (rhs1 :: Age) + in case v of + Just x -> j' x |> axAge + Nothing -> f rhs2 + +Utterly bogus. `f` expects an `Int` and we are giving it an `Age`. +No no no. Casts destroy the tail-call property. Henc markAllJoinsBad +in the (Cast expr co) case of lintCoreExpr. + +Note [No alternatives lint check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Case expressions with no alternatives are odd beasts, and it would seem +like they would worth be looking at in the linter (cf #10180). We +used to check two things: + +* exprIsHNF is false: it would *seem* to be terribly wrong if + the scrutinee was already in head normal form. + +* exprIsDeadEnd is true: we should be able to see why GHC believes the + scrutinee is diverging for sure. + +It was already known that the second test was not entirely reliable. +Unfortunately (#13990), the first test turned out not to be reliable +either. Getting the checks right turns out to be somewhat complicated. + +For example, suppose we have (comment 8) + + data T a where + TInt :: T Int + + absurdTBool :: T Bool -> a + absurdTBool v = case v of + + data Foo = Foo !(T Bool) + + absurdFoo :: Foo -> a + absurdFoo (Foo x) = absurdTBool x + +GHC initially accepts the empty case because of the GADT conditions. But then +we inline absurdTBool, getting + + absurdFoo (Foo x) = case x of + +x is in normal form (because the Foo constructor is strict) but the +case is empty. To avoid this problem, GHC would have to recognize +that matching on Foo x is already absurd, which is not so easy. + +More generally, we don't really know all the ways that GHC can +lose track of why an expression is bottom, so we shouldn't make too +much fuss when that happens. + + +Note [Beta redexes] +~~~~~~~~~~~~~~~~~~~ +Consider: + + join j @x y z = ... in + (\@x y z -> jump j @x y z) @t e1 e2 + +This is clearly ill-typed, since the jump is inside both an application and a +lambda, either of which is enough to disqualify it as a tail call (see Note +[Invariants on join points] in GHC.Core). However, strictly from a +lambda-calculus perspective, the term doesn't go wrong---after the two beta +reductions, the jump *is* a tail call and everything is fine. + +Why would we want to allow this when we have let? One reason is that a compound +beta redex (that is, one with more than one argument) has different scoping +rules: naively reducing the above example using lets will capture any free +occurrence of y in e2. More fundamentally, type lets are tricky; many passes, +such as Float Out, tacitly assume that the incoming program's type lets have +all been dealt with by the simplifier. Thus we don't want to let-bind any types +in, say, GHC.Core.Subst.simpleOptPgm, which in some circumstances can run immediately +before Float Out. + +All that said, currently GHC.Core.Subst.simpleOptPgm is the only thing using this +loophole, doing so to avoid re-traversing large functions (beta-reducing a type +lambda without introducing a type let requires a substitution). TODO: Improve +simpleOptPgm so that we can forget all this ever happened. + +************************************************************************ +* * +\subsection[lintCoreArgs]{lintCoreArgs} +* * +************************************************************************ + +The basic version of these functions checks that the argument is a +subtype of the required type, as one would expect. +-} + +-- Takes the functions type and arguments as argument. +-- Returns the *result* of applying the function to arguments. +-- e.g. f :: Int -> Bool -> Int would return `Int` as result type. +lintCoreArgs :: (OutType, UsageEnv) -> [InExpr] -> LintM (OutType, UsageEnv) +lintCoreArgs (fun_ty, fun_ue) args + = lintApp (text "expression") + lintTyArg lintValArg fun_ty args fun_ue + +lintTyArg :: InExpr -> LintM OutType + +-- Type argument +lintTyArg (Type arg_ty) + = do { checkL (not (isCoercionTy arg_ty)) + (text "Unnecessary coercion-to-type injection:" + <+> ppr arg_ty) + ; lintTypeAndSubst arg_ty } +lintTyArg arg + = failWithL (hang (text "Expected type argument but found") 2 (ppr arg)) + +lintValArg :: InExpr -> Mult -> UsageEnv -> LintM (OutType, UsageEnv) +lintValArg arg mult fun_ue + = do { (arg_ty, arg_ue) <- markAllJoinsBad $ lintCoreExpr arg + -- See Note [Representation polymorphism invariants] in GHC.Core + + ; flags <- getLintFlags + ; when (lf_check_fixed_rep flags) $ + -- Only check that 'arg_ty' has a fixed RuntimeRep + -- if 'lf_check_fixed_rep' is on. + do { checkL (typeHasFixedRuntimeRep arg_ty) + (text "Argument does not have a fixed runtime representation" + <+> ppr arg <+> dcolon + <+> parens (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))) } + + ; let app_ue = addUE fun_ue (scaleUE mult arg_ue) + ; return (arg_ty, app_ue) } + +----------------- +lintAltBinders :: UsageEnv + -> Var -- Case binder + -> OutType -- Scrutinee type + -> OutType -- Constructor type + -> [(Mult, OutVar)] -- Binders + -> LintM UsageEnv +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintAltBinders rhs_ue _case_bndr scrut_ty con_ty [] + = do { ensureEqTys con_ty scrut_ty (mkBadPatMsg con_ty scrut_ty) + ; return rhs_ue } +lintAltBinders rhs_ue case_bndr scrut_ty con_ty ((var_w, bndr):bndrs) + | isTyVar bndr + = do { con_ty' <- lintTyApp con_ty (mkTyVarTy bndr) + ; lintAltBinders rhs_ue case_bndr scrut_ty con_ty' bndrs } + | otherwise + = do { (con_ty', _) <- lintValApp (Var bndr) con_ty (idType bndr) zeroUE zeroUE + -- We can pass zeroUE to lintValApp because we ignore its usage + -- calculation and compute it in the call for checkCaseLinearity below. + ; rhs_ue' <- checkCaseLinearity rhs_ue case_bndr var_w bndr + ; lintAltBinders rhs_ue' case_bndr scrut_ty con_ty' bndrs } + +-- | Implements the case rules for linearity +checkCaseLinearity :: UsageEnv -> Var -> Mult -> Var -> LintM UsageEnv +checkCaseLinearity ue case_bndr var_w bndr = do + ensureSubUsage lhs rhs err_msg + lintLinearBinder (ppr bndr) (case_bndr_w `mkMultMul` var_w) (idMult bndr) + return $ deleteUE ue bndr + where + lhs = bndr_usage `addUsage` (var_w `scaleUsage` case_bndr_usage) + rhs = case_bndr_w `mkMultMul` var_w + err_msg = (text "Linearity failure in variable:" <+> ppr bndr + $$ ppr lhs <+> text "⊈" <+> ppr rhs + $$ text "Computed by:" + <+> text "LHS:" <+> lhs_formula + <+> text "RHS:" <+> rhs_formula) + lhs_formula = ppr bndr_usage <+> text "+" + <+> parens (ppr case_bndr_usage <+> text "*" <+> ppr var_w) + rhs_formula = ppr case_bndr_w <+> text "*" <+> ppr var_w + case_bndr_w = idMult case_bndr + case_bndr_usage = lookupUE ue case_bndr + bndr_usage = lookupUE ue bndr + + + +----------------- +lintTyApp :: OutType -> OutType -> LintM OutType +lintTyApp fun_ty arg_ty + | Just (tv,body_ty) <- splitForAllTyVar_maybe fun_ty + = do { lintTyKind tv arg_ty + ; in_scope <- getInScope + -- substTy needs the set of tyvars in scope to avoid generating + -- uniques that are already in scope. + -- See Note [The substitution invariant] in GHC.Core.TyCo.Subst + ; return (substTyWithInScope in_scope [tv] [arg_ty] body_ty) } + + | otherwise + = failWithL (mkTyAppMsg fun_ty arg_ty) + +----------------- + +-- | @lintValApp arg fun_ty arg_ty@ lints an application of @fun arg@ +-- where @fun :: fun_ty@ and @arg :: arg_ty@, returning the type of the +-- application. +lintValApp :: CoreExpr -> OutType -> OutType -> UsageEnv -> UsageEnv + -> LintM (OutType, UsageEnv) +lintValApp arg fun_ty arg_ty fun_ue arg_ue + | Just (_, w, arg_ty', res_ty') <- splitFunTy_maybe fun_ty + = do { ensureEqTys arg_ty' arg_ty (mkAppMsg arg_ty' arg_ty arg) + ; let app_ue = addUE fun_ue (scaleUE w arg_ue) + ; return (res_ty', app_ue) } + | otherwise + = failWithL err2 + where + err2 = mkNonFunAppMsg fun_ty arg_ty arg + +lintTyKind :: OutTyVar -> OutType -> LintM () +-- Both args have had substitution applied + +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintTyKind tyvar arg_ty + = unless (arg_kind `eqType` tyvar_kind) $ + addErrL (mkKindErrMsg tyvar arg_ty $$ (text "Linted Arg kind:" <+> ppr arg_kind)) + where + tyvar_kind = tyVarKind tyvar + arg_kind = typeKind arg_ty + +{- +************************************************************************ +* * +\subsection[lintCoreAlts]{lintCoreAlts} +* * +************************************************************************ +-} + +lintCaseExpr :: CoreExpr -> InId -> InType -> [CoreAlt] -> LintM (OutType, UsageEnv) +lintCaseExpr scrut case_bndr alt_ty alts + = do { let e = Case scrut case_bndr alt_ty alts -- Just for error messages + + -- Check the scrutinee + ; (scrut_ty', scrut_ue) <- markAllJoinsBad $ lintCoreExpr scrut + -- See Note [Join points are less general than the paper] + -- in GHC.Core + + ; alt_ty' <- addLoc (CaseTy scrut) $ lintValueType alt_ty + + ; checkCaseAlts e scrut scrut_ty' alts + + -- Lint the case-binder. Must do this after linting the scrutinee + -- because the case-binder isn't in scope in the scrutineex + ; lintBinder CaseBind case_bndr $ \case_bndr' -> + -- Don't use lintIdBndr on case_bndr, because unboxed tuple is legitimate + + do { let case_bndr_ty' = idType case_bndr' + scrut_mult = idMult case_bndr' + + ; ensureEqTys case_bndr_ty' scrut_ty' (mkScrutMsg case_bndr case_bndr_ty' scrut_ty') + -- See GHC.Core Note [Case expression invariants] item (7) + + ; -- Check the alternatives + ; alt_ues <- mapM (lintCoreAlt case_bndr' scrut_ty' scrut_mult alt_ty') alts + ; let case_ue = (scaleUE scrut_mult scrut_ue) `addUE` supUEs alt_ues + ; return (alt_ty', case_ue) } } + +checkCaseAlts :: InExpr -> InExpr -> OutType -> [CoreAlt] -> LintM () +-- a) Check that the alts are non-empty +-- b1) Check that the DEFAULT comes first, if it exists +-- b2) Check that the others are in increasing order +-- c) Check that there's a default for infinite types +-- d) Check that the scrutinee is not a floating-point type +-- if there are any literal alternatives +-- e) Check if the scrutinee type has no constructors +-- +-- We used to try to check whether a case expression with no +-- alternatives was legitimate, but this didn't work. +-- See Note [No alternatives lint check] for details. +-- +-- NB: Algebraic cases are not necessarily exhaustive, because +-- the simplifier correctly eliminates case that can't +-- possibly match. +checkCaseAlts e scrut scrut_ty alts + = do { checkL (all non_deflt con_alts) (mkNonDefltMsg e) + -- See GHC.Core Note [Case expression invariants] item (2) + + ; checkL (increasing_tag con_alts) (mkNonIncreasingAltsMsg e) + -- See GHC.Core Note [Case expression invariants] item (3) + + -- For types Int#, Word# with an infinite (well, large!) number of + -- possible values, there should usually be a DEFAULT case + -- But (see Note [Empty case alternatives] in GHC.Core) it's ok to + -- have *no* case alternatives. + -- In effect, this is a kind of partial test. I suppose it's possible + -- that we might *know* that 'x' was 1 or 2, in which case + -- case x of { 1 -> e1; 2 -> e2 } + -- would be fine. + ; checkL (isJust maybe_deflt || not is_infinite_ty || null alts) + (nonExhaustiveAltsMsg e) + + -- Check that the scrutinee is not a floating-point type + -- if there are any literal alternatives + -- See GHC.Core Note [Case expression invariants] item (5) + -- See Note [Rules for floating-point comparisons] in GHC.Core.Opt.ConstantFold + ; checkL (not $ isFloatingPrimTy scrut_ty && any is_lit_alt alts) + (text "Lint warning: Scrutinising floating-point expression with literal pattern in case analysis (see #9238)." + $$ text "scrut" <+> ppr scrut) + + -- Check if scrutinee type has no constructors + -- Just a trace message for now + ; case tyConAppTyCon_maybe scrut_ty of + Just tycon + | debugIsOn + , isAlgTyCon tycon + , not (isAbstractTyCon tycon) + , null (tyConDataCons tycon) + , not (exprIsDeadEnd scrut) + -> pprTrace "Lint warning: case scrutinee type has no constructors" + (ppr scrut_ty) + -- This can legitimately happen for type families + $ return () + _otherwise -> return () + } + where + (con_alts, maybe_deflt) = findDefault alts + + -- Check that successive alternatives have strictly increasing tags + increasing_tag (alt1 : rest@( alt2 : _)) = alt1 `ltAlt` alt2 && increasing_tag rest + increasing_tag _ = True + + non_deflt (Alt DEFAULT _ _) = False + non_deflt _ = True + + is_lit_alt (Alt (LitAlt _) _ _) = True + is_lit_alt _ = False + + is_infinite_ty = case tyConAppTyCon_maybe scrut_ty of + Nothing -> False + Just tycon -> isPrimTyCon tycon + +lintAltExpr :: CoreExpr -> OutType -> LintM UsageEnv +lintAltExpr expr ann_ty + = do { (actual_ty, ue) <- lintCoreExpr expr + ; ensureEqTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) + ; return ue } + -- See GHC.Core Note [Case expression invariants] item (6) + +lintCoreAlt :: OutId -- Case binder + -> OutType -- Type of scrutinee + -> Mult -- Multiplicity of scrutinee + -> OutType -- Type of the alternative + -> CoreAlt + -> LintM UsageEnv +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintCoreAlt case_bndr _ scrut_mult alt_ty (Alt DEFAULT args rhs) = + do { lintL (null args) (mkDefaultArgsMsg args) + ; rhs_ue <- lintAltExpr rhs alt_ty + ; let (case_bndr_usage, rhs_ue') = popUE rhs_ue case_bndr + err_msg = vcat [ text "Linearity failure in the DEFAULT clause:" <+> ppr case_bndr + , ppr case_bndr_usage <+> text "⊈" <+> ppr scrut_mult ] + ; ensureSubUsage case_bndr_usage scrut_mult err_msg + ; return rhs_ue' } + +lintCoreAlt case_bndr scrut_ty _ alt_ty (Alt (LitAlt lit) args rhs) + | litIsLifted lit + = failWithL integerScrutinisedMsg + | otherwise + = do { lintL (null args) (mkDefaultArgsMsg args) + ; ensureEqTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty) + ; rhs_ue <- lintAltExpr rhs alt_ty + ; return (deleteUE rhs_ue case_bndr) -- No need for linearity checks + } + where + lit_ty = literalType lit + +lintCoreAlt case_bndr scrut_ty _scrut_mult alt_ty alt@(Alt (DataAlt con) args rhs) + | isNewTyCon (dataConTyCon con) + = zeroUE <$ addErrL (mkNewTyDataConAltMsg scrut_ty alt) + | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty + = addLoc (CaseAlt alt) $ do + { checkTypeDataConOcc "pattern" con + ; lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) + + -- Instantiate the universally quantified + -- type variables of the data constructor + ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys + ; binderMult (Named _) = ManyTy + ; binderMult (Anon st _) = scaledMult st + -- See Note [Validating multiplicities in a case] + ; multiplicities = map binderMult $ fst $ splitPiTys con_payload_ty } + + -- And now bring the new binders into scope + ; lintBinders CasePatBind args $ \ args' -> do + { rhs_ue <- lintAltExpr rhs alt_ty + ; rhs_ue' <- addLoc (CasePat alt) $ + lintAltBinders rhs_ue case_bndr scrut_ty con_payload_ty + (zipEqual multiplicities args') + ; return $ deleteUE rhs_ue' case_bndr + } + } + + | otherwise -- Scrut-ty is wrong shape + = zeroUE <$ addErrL (mkBadAltMsg scrut_ty alt) + +{- +Note [Validating multiplicities in a case] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose 'MkT :: a %m -> T m a'. +If we are validating 'case (x :: T Many a) of MkT y -> ...', +we have to substitute m := Many in the type of MkT - in particular, +y can be used Many times and that expression would still be linear in x. +We do this by looking at con_payload_ty, which is the type of the datacon +applied to the surrounding arguments. +Testcase: linear/should_compile/MultConstructor + +Data constructors containing existential tyvars will then have +Named binders, which are always multiplicity Many. +Testcase: indexed-types/should_compile/GADT1 +-} + +lintLinearBinder :: SDoc -> Mult -> Mult -> LintM () +lintLinearBinder doc actual_usage described_usage + = ensureSubMult actual_usage described_usage err_msg + where + err_msg = (text "Multiplicity of variable does not agree with its context" + $$ doc + $$ ppr actual_usage + $$ text "Annotation:" <+> ppr described_usage) + +{- +************************************************************************ +* * +\subsection[lint-types]{Types} +* * +************************************************************************ +-} + +-- When we lint binders, we (one at a time and in order): +-- 1. Lint var types or kinds (possibly substituting) +-- 2. Add the binder to the in scope set, and if its a coercion var, +-- we may extend the substitution to reflect its (possibly) new kind +lintBinders :: HasDebugCallStack => BindingSite -> [InVar] -> ([OutVar] -> LintM a) -> LintM a +lintBinders _ [] linterF = linterF [] +lintBinders site (var:vars) linterF = lintBinder site var $ \var' -> + lintBinders site vars $ \ vars' -> + linterF (var':vars') + +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintBinder :: HasDebugCallStack => BindingSite -> InVar -> (OutVar -> LintM a) -> LintM a +lintBinder site var linterF + | isTyCoVar var = lintTyCoBndr var linterF + | otherwise = lintIdBndr NotTopLevel site var linterF + +lintTyCoBndr :: HasDebugCallStack => TyCoVar -> (OutTyCoVar -> LintM a) -> LintM a +lintTyCoBndr tcv thing_inside + = do { tcv_type' <- lintTypeAndSubst (varType tcv) + ; let tcv_kind' = typeKind tcv_type' + + -- See (FORALL1) and (FORALL2) in GHC.Core.Type + ; if (isTyVar tcv) + then -- Check that in (forall (a:ki). blah) we have ki:Type + lintL (isLiftedTypeKind tcv_kind') $ + hang (text "TyVar whose kind does not have kind Type:") + 2 (ppr tcv <+> dcolon <+> ppr tcv_type' <+> dcolon <+> ppr tcv_kind') + else -- Check that in (forall (cv::ty). blah), + -- then ty looks like (t1 ~# t2) + lintL (isCoVarType tcv_type') $ + text "CoVar with non-coercion type:" <+> pprTyVar tcv + + ; addInScopeTyCoVar tcv tcv_type' thing_inside } + +lintIdBndrs :: forall a. TopLevelFlag -> [InId] -> ([OutId] -> LintM a) -> LintM a +lintIdBndrs top_lvl ids thing_inside + = go ids thing_inside + where + go :: [Id] -> ([Id] -> LintM a) -> LintM a + go [] thing_inside = thing_inside [] + go (id:ids) thing_inside = lintIdBndr top_lvl LetBind id $ \id' -> + go ids $ \ids' -> + thing_inside (id' : ids') + +lintIdBndr :: TopLevelFlag -> BindingSite + -> InVar -> (OutVar -> LintM a) -> LintM a +-- Do substitution on the type of a binder and add the var with this +-- new type to the in-scope set of the second argument +-- ToDo: lint its rules +lintIdBndr top_lvl bind_site id thing_inside + = assertPpr (isId id) (ppr id) $ + do { flags <- getLintFlags + ; checkL (not (lf_check_global_ids flags) || isLocalId id) + (text "Non-local Id binder" <+> ppr id) + -- See Note [Checking for global Ids] + + -- Check that if the binder is nested, it is not marked as exported + ; checkL (not (isExportedId id) || is_top_lvl) + (mkNonTopExportedMsg id) + + -- Check that if the binder is nested, it does not have an external name + ; checkL (not (isExternalName (Var.varName id)) || is_top_lvl) + (mkNonTopExternalNameMsg id) + + -- See Note [Representation polymorphism invariants] in GHC.Core + ; lintL (isJoinId id || not (lf_check_fixed_rep flags) + || typeHasFixedRuntimeRep id_ty) $ + text "Binder does not have a fixed runtime representation:" <+> ppr id <+> dcolon <+> + parens (ppr id_ty <+> dcolon <+> ppr (typeKind id_ty)) + + -- Check that a join-id is a not-top-level let-binding + ; when (isJoinId id) $ + checkL (not is_top_lvl && is_let_bind) $ + mkBadJoinBindMsg id + + -- Check that the Id does not have type (t1 ~# t2) or (t1 ~R# t2); + -- if so, it should be a CoVar, and checked by lintCoVarBndr + ; lintL (not (isCoVarType id_ty)) + (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty) + + -- Check that the lambda binder has no value or OtherCon unfolding. + -- See #21496 + ; lintL (not (bind_site == LambdaBind && isEvaldUnfolding (idUnfolding id))) + (text "Lambda binder with value or OtherCon unfolding.") + + ; out_ty <- addLoc (IdTy id) (lintValueType id_ty) + + ; addInScopeId id out_ty thing_inside } + where + id_ty = idType id + + is_top_lvl = isTopLevel top_lvl + is_let_bind = case bind_site of + LetBind -> True + _ -> False + +{- +%************************************************************************ +%* * + Types +%* * +%************************************************************************ +-} + +{- Note [Linting types and coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Notice that + lintType :: InType -> LintM () + lintCoercion :: InCoercion -> LintM () +Neither returns anything. + +If you need the kind of the type, then do `typeKind` and then apply +the ambient substitution using `substTyM`. Note that the substitution +empty unless there is shadowing or type-lets; and if the substitution is +empty, the `substTyM` is a no-op. + +It is better to take the kind and then substitute, rather than substitute +and then take the kind, becaues the kind is usually smaller. + +Note: you might wonder if we should apply the same logic to expressions. +Why do we have + lintExpr :: InExpr -> LintM OutType +Partly inertia; but also taking the type of an expresison involve looking +down a deep chain of let's, whereas that is not true of taking the kind +of a type. It'd be worth an experiment though. + +Historical note: in the olden days we had + lintType :: InType -> LintM OutType +but that burned a huge amount of allocation building an OutType that was +often discarded, or used only to get its kind. + +I also experimented with + lintType :: InType -> LintM OutKind +but that too was slower. It is also much simpler to return ()! If we +return the kind we have to duplicate the logic in `typeKind`; and it is +much worse for coercions. +-} + +lintValueType :: Type -> LintM OutType +-- Types only, not kinds +-- Check the type, and apply the substitution to it +-- See Note [Linting type lets] +lintValueType ty + = addLoc (InType ty) $ + do { ty' <- lintTypeAndSubst ty + ; let sk = typeKind ty' + ; lintL (isTYPEorCONSTRAINT sk) $ + hang (text "Ill-kinded type:" <+> ppr ty) + 2 (text "has kind:" <+> ppr sk) + ; return ty' } + +checkTyCon :: TyCon -> LintM () +checkTyCon tc + = checkL (not (isTcTyCon tc)) (text "Found TcTyCon:" <+> ppr tc) + +------------------- +lintTypeAndSubst :: InType -> LintM OutType +lintTypeAndSubst ty = do { lintType ty; substTyM ty } + -- In GHCi we may lint an expression with a free + -- type variable. Then it won't be in the + -- substitution, but it should be in scope + +lintType :: InType -> LintM () +-- See Note [Linting types and coercions] +-- +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintType (TyVarTy tv) + | not (isTyVar tv) + = failWithL (mkBadTyVarMsg tv) + + | otherwise + = do { _ <- lintVarOcc tv + ; return () } + +lintType ty@(AppTy t1 t2) + | TyConApp {} <- t1 + = failWithL $ text "TyConApp to the left of AppTy:" <+> ppr ty + | otherwise + = do { let (fun_ty, arg_tys) = collect t1 [t2] + ; lintType fun_ty + ; fun_kind <- substTyM (typeKind fun_ty) + ; lint_ty_app ty fun_kind arg_tys } + where + collect (AppTy f a) as = collect f (a:as) + collect fun as = (fun, as) + +lintType ty@(TyConApp tc tys) + | isTypeSynonymTyCon tc || isTypeFamilyTyCon tc + = do { report_unsat <- lf_report_unsat_syns <$> getLintFlags + ; lintTySynFamApp report_unsat ty tc tys } + + | Just {} <- tyConAppFunTy_maybe tc tys + -- We should never see a saturated application of funTyCon; such + -- applications should be represented with the FunTy constructor. + -- See Note [Linting function types] + = failWithL (hang (text "Saturated application of" <+> quotes (ppr tc)) 2 (ppr ty)) + + | otherwise -- Data types, data families, primitive types + = do { checkTyCon tc + ; lint_ty_app ty (tyConKind tc) tys } + +-- arrows can related *unlifted* kinds, so this has to be separate from +-- a dependent forall. +lintType ty@(FunTy af tw t1 t2) + = do { lintType t1 + ; lintType t2 + ; lintType tw + ; lintArrow (text "type or kind" <+> quotes (ppr ty)) af t1 t2 tw } + +lintType ty@(ForAllTy {}) + = go [] ty + where + go :: [OutTyCoVar] -> InType -> LintM () + -- Loop, collecting the forall-binders + go tcvs ty@(ForAllTy (Bndr tcv _) body_ty) + | not (isTyCoVar tcv) + = failWithL (text "Non-TyVar or Non-CoVar bound in type:" <+> ppr ty) + + | otherwise + = lintTyCoBndr tcv $ \tcv' -> + do { -- See GHC.Core.TyCo.Rep Note [Unused coercion variable in ForAllTy] + -- Suspicious because it works on InTyCoVar; c.f. ForAllCo + when (isCoVar tcv) $ + lintL (anyFreeVarsOfType (== tcv) body_ty) $ + text "Covar does not occur in the body:" <+> (ppr tcv $$ ppr body_ty) + + ; go (tcv' : tcvs) body_ty } + + go tcvs body_ty + = do { lintType body_ty + ; lintForAllBody tcvs body_ty } + +lintType (CastTy ty co) + = do { lintType ty + ; ty_kind <- substTyM (typeKind ty) + ; co_lk <- lintStarCoercion co + ; ensureEqTys ty_kind co_lk (mkCastTyErr ty co ty_kind co_lk) } + +lintType (LitTy l) = lintTyLit l +lintType (CoercionTy co) = lintCoercion co + +----------------- +lintForAllBody :: [OutTyCoVar] -> InType -> LintM () +-- Do the checks for the body of a forall-type +lintForAllBody tcvs body_ty + = do { -- For type variables, check for skolem escape + -- See Note [Phantom type variables in kinds] in GHC.Core.Type + -- The kind of (forall cv. th) is liftedTypeKind, so no + -- need to check for skolem-escape in the CoVar case + body_kind <- substTyM (typeKind body_ty) + ; case occCheckExpand tcvs body_kind of + Just {} -> return () + Nothing -> failWithL $ + hang (text "Variable escape in forall:") + 2 (vcat [ text "tycovars (reversed):" <+> ppr tcvs + , text "type:" <+> ppr body_ty + , text "kind:" <+> ppr body_kind ]) + ; checkValueType body_kind (text "the body of forall:" <+> ppr body_ty) } + +----------------- +lintTySynFamApp :: Bool -> InType -> TyCon -> [InType] -> LintM () +-- The TyCon is a type synonym or a type family (not a data family) +-- See Note [Linting type synonym applications] +-- c.f. GHC.Tc.Validity.check_syn_tc_app +lintTySynFamApp report_unsat ty tc tys + | report_unsat -- Report unsaturated only if report_unsat is on + , tys `lengthLessThan` tyConArity tc + = failWithL (hang (text "Un-saturated type application") 2 (ppr ty)) + + -- Deal with type synonyms + | ExpandsSyn tenv rhs tys' <- expandSynTyCon_maybe tc tys + , let expanded_ty = mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys' + = do { when report_unsat $ do { _ <- lintType expanded_ty + ; return () } + + ; -- Kind-check the argument types, but without reporting + -- un-saturated type families/synonyms + ; setReportUnsat False $ + lint_ty_app ty (tyConKind tc) tys } + + -- Otherwise this must be a type family + | otherwise + = lint_ty_app ty (tyConKind tc) tys + +----------------- +-- Confirms that a kind is really TYPE r or Constraint +checkValueType :: OutKind -> SDoc -> LintM () +checkValueType kind doc + = lintL (isTYPEorCONSTRAINT kind) + (text "Non-Type-like kind when Type-like expected:" <+> ppr kind $$ + text "when checking" <+> doc) + +----------------- +lintArrow :: SDoc -> FunTyFlag -> InType -> InType -> InType -> LintM () +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] +lintArrow what af t1 t2 tw -- Eg lintArrow "type or kind `blah'" k1 k2 kw + -- or lintArrow "coercion `blah'" k1 k2 kw + = do { k1 <- substTyM (typeKind t1) + ; k2 <- substTyM (typeKind t2) + ; kw <- substTyM (typeKind tw) + ; unless (isTYPEorCONSTRAINT k1) (report (text "argument") t1 k1) + ; unless (isTYPEorCONSTRAINT k2) (report (text "result") t2 k2) + ; unless (isMultiplicityTy kw) (report (text "multiplicity") tw kw) + + ; let real_af = chooseFunTyFlag t1 t2 + ; unless (real_af == af) $ addErrL $ + hang (text "Bad FunTyFlag") + 2 (vcat [ text "FunTyFlag =" <+> ppr af + , text "Computed FunTyFlag =" <+> ppr real_af + , text "in" <+> what ]) } + where + report ar t k = addErrL (hang (text "Ill-kinded" <+> ar) + 2 (vcat [ ppr t <+> dcolon <+> ppr k + , text "in" <+> what ])) + +----------------- +lintTyLit :: TyLit -> LintM () +lintTyLit (NumTyLit n) + | n >= 0 = return () + | otherwise = failWithL msg + where msg = text "Negative type literal:" <+> integer n +lintTyLit (StrTyLit _) = return () +lintTyLit (CharTyLit _) = return () + +----------------- +lint_ty_app :: InType -> OutKind -> [InType] -> LintM () +lint_ty_app ty = lint_tyco_app (text "type" <+> quotes (ppr ty)) + +lint_co_app :: HasDebugCallStack => Coercion -> OutKind -> [InType] -> LintM () +lint_co_app co = lint_tyco_app (text "coercion" <+> quotes (ppr co)) + +lint_tyco_app :: SDoc -> OutKind -> [InType] -> LintM () +lint_tyco_app msg fun_kind arg_tys + -- See Note [Avoiding compiler perf traps when constructing error messages.] + = do { _ <- lintApp msg (\ty -> do { lintType ty; substTyM ty }) + (\ty _ _ -> do { lintType ty; ki <- substTyM (typeKind ty); return (ki,()) }) + fun_kind arg_tys () + ; return () } + +---------------- +lintApp :: forall in_a acc. Outputable in_a => + SDoc + -> (in_a -> LintM OutType) -- Lint the thing and return its value + -> (in_a -> Mult -> acc -> LintM (OutKind, acc)) -- Lint the thing and return its type + -> OutType + -> [in_a] -- The arguments, always "In" things + -> acc -- Used (only) for UsageEnv in /term/ applications + -> LintM (OutType,acc) +-- lintApp is a performance-critical function, which deals with multiple +-- applications such as (/\a./\b./\c. expr) @ta @tb @tc +-- When returning the type of this expression we want to avoid substituting a:=ta, +-- and /then/ substituting b:=tb, etc. That's quadratic, and can be a huge +-- perf hole. So we gather all the arguments [in_a], and then gather the +-- substitution incrementally in the `go` loop. +-- +-- lintApp is used: +-- * for term applications (lintCoreArgs) +-- * for type applications (lint_ty_app) +-- * for coercion application (lint_co_app) +-- To deal with these cases `lintApp` has two higher order arguments; +-- but we specialise it for each call site (by inlining) +{-# INLINE lintApp #-} -- INLINE: very few call sites; + -- not recursive; specialised at its call sites + +lintApp msg lint_forall_arg lint_arrow_arg !orig_fun_ty all_args acc + = do { !in_scope <- getInScope + -- We need the in_scope set to satisfy the invariant in + -- Note [The substitution invariant] in GHC.Core.TyCo.Subst + -- Forcing the in scope set eagerly here reduces allocations by up to 4%. + + ; let init_subst = mkEmptySubst in_scope + + go :: Subst -> OutType -> acc -> [in_a] -> LintM (OutType, acc) + -- The Subst applies (only) to the fun_ty + -- c.f. GHC.Core.Type.piResultTys, which has a similar loop + + go subst fun_ty acc [] + = return (substTy subst fun_ty, acc) + + go subst (ForAllTy (Bndr tv _vis) body_ty) acc (arg:args) + = do { arg' <- lint_forall_arg arg + ; let tv_kind = substTy subst (varType tv) + karg' = typeKind arg' + subst' = extendTCvSubst subst tv arg' + ; ensureEqTys karg' tv_kind $ + lint_app_fail_msg msg orig_fun_ty all_args + (hang (text "Forall:" <+> (ppr tv $$ ppr tv_kind)) + 2 (ppr arg' <+> dcolon <+> ppr karg')) + ; go subst' body_ty acc args } + + go subst fun_ty@(FunTy _ mult exp_arg_ty res_ty) acc (arg:args) + = do { (arg_ty, acc') <- lint_arrow_arg arg (substTy subst mult) acc + ; ensureEqTys (substTy subst exp_arg_ty) arg_ty $ + lint_app_fail_msg msg orig_fun_ty all_args + (hang (text "Fun:" <+> ppr fun_ty) + 2 (vcat [ text "exp_arg_ty:" <+> ppr exp_arg_ty + , text "arg:" <+> ppr arg <+> dcolon <+> ppr arg_ty ])) + ; go subst res_ty acc' args } + + go subst fun_ty acc args + | Just fun_ty' <- coreView fun_ty + = go subst fun_ty' acc args + + | not (isEmptyTCvSubst subst) -- See Note [Care with kind instantiation] + = go init_subst (substTy subst fun_ty) acc args + + | otherwise + = failWithL (lint_app_fail_msg msg orig_fun_ty all_args + (text "Not a fun:" <+> (ppr fun_ty $$ ppr args))) + + ; go init_subst orig_fun_ty acc all_args } + +-- This is a top level definition to ensure we pass all variables of the error message +-- explicitly and don't capture them as free variables. Otherwise this binder might +-- become a thunk that get's allocated in the hot code path. +-- See Note [Avoiding compiler perf traps when constructing error messages.] +lint_app_fail_msg :: (Outputable a2) => SDoc -> OutType -> a2 -> SDoc -> SDoc +lint_app_fail_msg msg kfn arg_tys extra + = vcat [ hang (text "Application error in") 2 msg + , nest 2 (text "Function type =" <+> ppr kfn) + , nest 2 (text "Args =" <+> ppr arg_tys) + , extra ] + +{- ********************************************************************* +* * + Linting rules +* * +********************************************************************* -} + +lintCoreRule :: OutVar -> OutType -> CoreRule -> LintM () +lintCoreRule _ _ (BuiltinRule {}) + = return () -- Don't bother + +lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs + , ru_args = args, ru_rhs = rhs }) + = lintBinders LambdaBind bndrs $ \ _ -> + do { (lhs_ty, _) <- lintCoreArgs (fun_ty, zeroUE) args + ; (rhs_ty, _) <- case idJoinPointHood fun of + JoinPoint join_arity + -> do { checkL (args `lengthIs` join_arity) $ + mkBadJoinPointRuleMsg fun join_arity rule + -- See Note [Rules for join points] + ; lintCoreExpr rhs } + _ -> markAllJoinsBad $ lintCoreExpr rhs + ; ensureEqTys lhs_ty rhs_ty $ + (rule_doc <+> vcat [ text "lhs type:" <+> ppr lhs_ty + , text "rhs type:" <+> ppr rhs_ty + , text "fun_ty:" <+> ppr fun_ty ]) + ; let bad_bndrs = filter is_bad_bndr bndrs + + ; checkL (null bad_bndrs) + (rule_doc <+> text "unbound" <+> ppr bad_bndrs) + -- See Note [Linting rules] + } + where + rule_doc = text "Rule" <+> doubleQuotes (ftext name) <> colon + + lhs_fvs = exprsFreeVars args + rhs_fvs = exprFreeVars rhs + + is_bad_bndr :: Var -> Bool + -- See Note [Unbound RULE binders] in GHC.Core.Rules + is_bad_bndr bndr = not (bndr `elemVarSet` lhs_fvs) + && bndr `elemVarSet` rhs_fvs + && isNothing (isReflCoVar_maybe bndr) + + +{- Note [Linting rules] +~~~~~~~~~~~~~~~~~~~~~~~ +It's very bad if simplifying a rule means that one of the template +variables (ru_bndrs) that /is/ mentioned on the RHS becomes +not-mentioned in the LHS (ru_args). How can that happen? Well, in #10602, +SpecConstr stupidly constructed a rule like + + forall x,c1,c2. + f (x |> c1 |> c2) = .... + +But simplExpr collapses those coercions into one. (Indeed in #10602, +it collapsed to the identity and was removed altogether.) + +We don't have a great story for what to do here, but at least +this check will nail it. + +NB (#11643): it's possible that a variable listed in the +binders becomes not-mentioned on both LHS and RHS. Here's a silly +example: + RULE forall x y. f (g x y) = g (x+1) (y-1) +And suppose worker/wrapper decides that 'x' is Absent. Then +we'll end up with + RULE forall x y. f ($gw y) = $gw (x+1) +This seems sufficiently obscure that there isn't enough payoff to +try to trim the forall'd binder list. + +Note [Rules for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A join point cannot be partially applied. However, the left-hand side of a rule +for a join point is effectively a *pattern*, not a piece of code, so there's an +argument to be made for allowing a situation like this: + + join $sj :: Int -> Int -> String + $sj n m = ... + j :: forall a. Eq a => a -> a -> String + {-# RULES "SPEC j" jump j @ Int $dEq = jump $sj #-} + j @a $dEq x y = ... + +Applying this rule can't turn a well-typed program into an ill-typed one, so +conceivably we could allow it. But we can always eta-expand such an +"undersaturated" rule (see 'GHC.Core.Opt.Arity.etaExpandToJoinPointRule'), and in fact +the simplifier would have to in order to deal with the RHS. So we take a +conservative view and don't allow undersaturated rules for join points. See +Note [Join points and unfoldings/rules] in "GHC.Core.Opt.OccurAnal" for further discussion. +-} + +{- +************************************************************************ +* * + Linting coercions +* * +************************************************************************ +-} + +{- Note [Asymptotic efficiency] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting coercions (and types actually) we return a linted +(substituted) coercion. Then we often have to take the coercionKind of +that returned coercion. If we get long chains, that can be asymptotically +inefficient, notably in +* TransCo +* InstCo +* SelCo (cf #9233) +* LRCo + +But the code is simple. And this is only Lint. Let's wait to see if +the bad perf bites us in practice. + +A solution would be to return the kind and role of the coercion, +as well as the linted coercion. Or perhaps even *only* the kind and role, +which is what used to happen. But that proved tricky and error prone +(#17923), so now we return the coercion. +-} + + +-- lintStarCoercion lints a coercion, confirming that its lh kind and +-- its rh kind are both *; also ensures that the role is Nominal +-- Returns the lh kind +lintStarCoercion :: InCoercion -> LintM OutType +lintStarCoercion g + = do { lintCoercion g + ; Pair t1 t2 <- substCoKindM g + ; checkValueType (typeKind t1) (text "the kind of the left type in" <+> ppr g) + ; checkValueType (typeKind t2) (text "the kind of the right type in" <+> ppr g) + ; lintRole g Nominal (coercionRole g) + ; return t1 } + +substCoKindM :: InCoercion -> LintM (Pair OutType) +substCoKindM co + = do { let !(Pair lk rk) = coercionKind co + ; lk' <- substTyM lk + ; rk' <- substTyM rk + ; return (Pair lk' rk') } + +lintCoercion :: HasDebugCallStack => InCoercion -> LintM () +-- See Note [Linting types and coercions] +-- +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] + +lintCoercion (CoVarCo cv) + | not (isCoVar cv) + = failWithL (hang (text "Bad CoVarCo:" <+> ppr cv) + 2 (text "With offending type:" <+> ppr (varType cv))) + + | otherwise -- C.f. lintType (TyVarTy tv), which has better docs + = do { _ <- lintVarOcc cv; return () } + +lintCoercion (Refl ty) = lintType ty +lintCoercion (GRefl _r ty MRefl) = lintType ty + +lintCoercion (GRefl _r ty (MCo co)) + = do { lintType ty + ; lintCoercion co + ; tk <- substTyM (typeKind ty) + ; tl <- substTyM (coercionLKind co) + ; ensureEqTys tk tl $ + hang (text "GRefl coercion kind mis-match:" <+> ppr co) + 2 (vcat [ppr ty, ppr tk, ppr tl]) + ; lintRole co Nominal (coercionRole co) } + +lintCoercion co@(TyConAppCo r tc cos) + | Just {} <- tyConAppFunCo_maybe r tc cos + = failWithL (hang (text "Saturated application of" <+> quotes (ppr tc)) + 2 (ppr co)) + -- All saturated TyConAppCos should be FunCos + + | Just {} <- synTyConDefn_maybe tc + = failWithL (text "Synonym in TyConAppCo:" <+> ppr co) + + | otherwise + = do { checkTyCon tc + ; mapM_ lintCoercion cos + ; let tc_kind = tyConKind tc + ; lint_co_app co tc_kind (map coercionLKind cos) + ; lint_co_app co tc_kind (map coercionRKind cos) + ; zipWithM_ (lintRole co) (tyConRoleListX r tc) (map coercionRole cos) } + + +lintCoercion co@(AppCo co1 co2) + | TyConAppCo {} <- co1 + = failWithL (text "TyConAppCo to the left of AppCo:" <+> ppr co) + | Just (TyConApp {}, _) <- isReflCo_maybe co1 + = failWithL (text "Refl (TyConApp ...) to the left of AppCo:" <+> ppr co) + | otherwise + = do { lintCoercion co1 + ; lintCoercion co2 + ; let !(Pair lt1 rt1) = coercionKind co1 + ; lk1 <- substTyM (typeKind lt1) + ; rk1 <- substTyM (typeKind rt1) + ; lint_co_app co lk1 [coercionLKind co2] + ; lint_co_app co rk1 [coercionRKind co2] + + ; let r2 = coercionRole co2 + ; if coercionRole co1 == Phantom + then lintL (r2 == Phantom || r2 == Nominal) + (text "Second argument in AppCo cannot be R:" $$ + ppr co) + else lintRole co Nominal r2 } + +---------- +lintCoercion co@(ForAllCo {}) +-- See Note [ForAllCo] in GHC.Core.TyCo.Rep for the typing rule for ForAllCo + = do { _ <- go [] co; return () } + where + go :: [OutTyCoVar] -- Binders in reverse order + -> InCoercion -> LintM Role + go tcvs co@(ForAllCo { fco_tcv = tcv, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = body_co }) + | not (isTyCoVar tcv) + = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) + + | otherwise + = do { lk <- lintStarCoercion kind_co + ; lintTyCoBndr tcv $ \tcv' -> + do { ensureEqTys (varType tcv') lk $ + text "Kind mis-match in ForallCo" <+> ppr co + + -- I'm not very sure about this part, because it traverses body_co + -- but at least it's on a cold path (a ForallCo for a CoVar) + -- Also it works on InTyCoVar and InCoercion, which is suspect + ; when (isCoVar tcv) $ + do { lintL (visL == coreTyLamForAllTyFlag && visR == coreTyLamForAllTyFlag) $ + text "Invalid visibility flags in CoVar ForAllCo" <+> ppr co + -- See (FC7) in Note [ForAllCo] in GHC.Core.TyCo.Rep + ; lintL (almostDevoidCoVarOfCo tcv body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co } + -- See (FC6) in Note [ForAllCo] in GHC.Core.TyCo.Rep + + ; role <- go (tcv':tcvs) body_co + + ; when (role == Nominal) $ + lintL (visL `eqForAllVis` visR) $ + text "Nominal ForAllCo has mismatched visibilities: " <+> ppr co + + ; return role } } + + go tcvs body_co + = do { lintCoercion body_co + + -- Need to check that + -- (forall (tcv:k1). lty) and + -- (forall (tcv:k2). rty[(tcv:k2) |> sym kind_co/tcv]) + -- are both well formed, including the skolem escape check. + -- Easiest way is to call lintForAllBody for each + ; let Pair lty rty = coercionKind body_co + ; lintForAllBody tcvs lty + ; lintForAllBody tcvs rty + + ; return (coercionRole body_co) } + + +lintCoercion (FunCo { fco_role = r, fco_afl = afl, fco_afr = afr + , fco_mult = cow, fco_arg = co1, fco_res = co2 }) + = do { lintCoercion co1 + ; lintCoercion co2 + ; lintCoercion cow + ; let Pair lt1 rt1 = coercionKind co1 + Pair lt2 rt2 = coercionKind co2 + Pair ltw rtw = coercionKind cow + ; lintArrow (bad_co_msg "arrowl") afl lt1 lt2 ltw + ; lintArrow (bad_co_msg "arrowr") afr rt1 rt2 rtw + ; lintRole co1 r (coercionRole co1) + ; lintRole co2 r (coercionRole co2) + ; let expected_mult_role = case r of + Phantom -> Phantom + _ -> Nominal + ; lintRole cow expected_mult_role (coercionRole cow) } + where + bad_co_msg s = hang (text "Bad coercion" <+> parens (text s)) + 2 (vcat [ text "afl:" <+> ppr afl + , text "afr:" <+> ppr afr + , text "arg_co:" <+> ppr co1 + , text "res_co:" <+> ppr co2 ]) + +-- See Note [Bad unsafe coercion] +lintCoercion co@(UnivCo { uco_role = r, uco_prov = prov + , uco_lty = ty1, uco_rty = ty2, uco_deps = deps }) + = do { -- Check the role. PhantomProv must have Phantom role, otherwise any role is fine + case prov of + PhantomProv -> lintRole co Phantom r + _ -> return () + + -- Check the to and from types + ; lintType ty1 + ; lintType ty2 + ; tk1 <- substTyM (typeKind ty1) + ; tk2 <- substTyM (typeKind ty2) + + ; when (r /= Phantom && isTYPEorCONSTRAINT tk1 && isTYPEorCONSTRAINT tk2) + (checkTypes ty1 ty2) + + -- Check the coercions on which this UnivCo depends + ; mapM_ lintCoercion deps } + where + report s = hang (text $ "Unsafe coercion: " ++ s) + 2 (vcat [ text "From:" <+> ppr ty1 + , text " To:" <+> ppr ty2]) + isUnBoxed :: PrimRep -> Bool + isUnBoxed = not . isGcPtrRep + + -- see #9122 for discussion of these checks + checkTypes t1 t2 + = do { checkWarnL fixed_rep_1 + (report "left-hand type does not have a fixed runtime representation") + ; checkWarnL fixed_rep_2 + (report "right-hand type does not have a fixed runtime representation") + ; when (fixed_rep_1 && fixed_rep_2) $ + do { checkWarnL (reps1 `equalLength` reps2) + (report "between values with different # of reps") + ; zipWithM_ validateCoercion reps1 reps2 }} + where + fixed_rep_1 = typeHasFixedRuntimeRep t1 + fixed_rep_2 = typeHasFixedRuntimeRep t2 + + -- don't look at these unless lev_poly1/2 are False + -- Otherwise, we get #13458 + reps1 = typePrimRep t1 + reps2 = typePrimRep t2 + + validateCoercion :: PrimRep -> PrimRep -> LintM () + validateCoercion rep1 rep2 + = do { platform <- getPlatform + ; checkWarnL (isUnBoxed rep1 == isUnBoxed rep2) + (report "between unboxed and boxed value") + ; checkWarnL (TyCon.primRepSizeB platform rep1 + == TyCon.primRepSizeB platform rep2) + (report "between unboxed values of different size") + ; let fl = liftM2 (==) (TyCon.primRepIsFloat rep1) + (TyCon.primRepIsFloat rep2) + ; case fl of + Nothing -> addWarnL (report "between vector types") + Just False -> addWarnL (report "between float and integral values") + _ -> return () + } + +lintCoercion (SymCo co) = lintCoercion co + +lintCoercion co@(TransCo co1 co2) + = do { lintCoercion co1 + ; lintCoercion co2 + ; rk1 <- substTyM (coercionRKind co1) + ; lk2 <- substTyM (coercionLKind co2) + ; ensureEqTys rk1 lk2 + (hang (text "Trans coercion mis-match:" <+> ppr co) + 2 (vcat [ppr (coercionKind co1), ppr (coercionKind co2)])) + ; lintRole co (coercionRole co1) (coercionRole co2) } + +lintCoercion the_co@(SelCo cs co) + = do { lintCoercion co + ; Pair s t <- substCoKindM co + + ; if -- forall (both TyVar and CoVar) + | Just _ <- splitForAllTyCoVar_maybe s + , Just _ <- splitForAllTyCoVar_maybe t + , SelForAll <- cs + , (isForAllTy_ty s && isForAllTy_ty t) + || (isForAllTy_co s && isForAllTy_co t) + -> return () + + -- function + | isFunTy s + , isFunTy t + , SelFun {} <- cs + -> return () + + -- TyCon + | Just (tc_s, tys_s) <- splitTyConApp_maybe s + , Just (tc_t, tys_t) <- splitTyConApp_maybe t + , tc_s == tc_t + , SelTyCon n r0 <- cs + , let co_role = coercionRole co + , isInjectiveTyCon tc_s co_role + -- see Note [SelCo and newtypes] in GHC.Core.TyCo.Rep + , tys_s `equalLength` tys_t + , tys_s `lengthExceeds` n + -> do { lintRole the_co (tyConRole co_role tc_s n) r0 + ; return () } + + | otherwise + -> failWithL (hang (text "Bad SelCo:") + 2 (ppr the_co $$ ppr s $$ ppr t)) } + +lintCoercion the_co@(LRCo _lr co) + = do { lintCoercion co + ; Pair s t <- substCoKindM co + ; lintRole co Nominal (coercionRole co) + ; case (splitAppTy_maybe s, splitAppTy_maybe t) of + (Just {}, Just {}) -> return () + _ -> failWithL (hang (text "Bad LRCo:") + 2 (ppr the_co $$ ppr s $$ ppr t)) } + + +lintCoercion orig_co@(InstCo co arg) + = go co [arg] + where + go (InstCo co arg) args = do { lintCoercion arg; go co (arg:args) } + go co args = do { lintCoercion co + ; let Pair lty rty = coercionKind co + ; lty' <- substTyM lty + ; rty' <- substTyM rty + ; in_scope <- getInScope + ; let subst = mkEmptySubst in_scope + ; go_args (subst, lty') (subst,rty') args } + + ------------- + go_args :: (Subst, OutType) -> (Subst,OutType) -> [InCoercion] + -> LintM () + go_args _ _ [] + = return () + go_args lty rty (arg:args) + = do { (lty1, rty1) <- go_arg lty rty arg + ; go_args lty1 rty1 args } + + ------------- + go_arg :: (Subst, OutType) -> (Subst,OutType) -> InCoercion + -> LintM ((Subst,OutType), (Subst,OutType)) + go_arg (lsubst,lty) (rsubst,rty) arg + = do { lintRole arg Nominal (coercionRole arg) + ; Pair arg_lty arg_rty <- substCoKindM arg + + ; case (splitForAllTyCoVar_maybe lty, splitForAllTyCoVar_maybe rty) of + -- forall over tvar + (Just (ltv,lty1), Just (rtv,rty1)) + | typeKind arg_lty `eqType` substTy lsubst (tyVarKind ltv) + , typeKind arg_rty `eqType` substTy rsubst (tyVarKind rtv) + -> return ( (extendTCvSubst lsubst ltv arg_lty, lty1) + , (extendTCvSubst rsubst rtv arg_rty, rty1) ) + | otherwise + -> failWithL (hang (text "Kind mis-match in inst coercion") + 2 (vcat [ text "arg" <+> ppr arg + , text "lty" <+> ppr lty <+> dcolon <+> ppr (typeKind lty) + , text "rty" <+> ppr rty <+> dcolon <+> ppr (typeKind rty) + , text "arg_lty" <+> ppr arg_lty <+> dcolon <+> ppr (typeKind arg_lty) + , text "arg_rty" <+> ppr arg_rty <+> dcolon <+> ppr (typeKind arg_rty) + , text "ltv" <+> ppr ltv <+> dcolon <+> ppr (tyVarKind ltv) + , text "rtv" <+> ppr rtv <+> dcolon <+> ppr (tyVarKind rtv) ])) + + _ -> failWithL (text "Bad argument of inst" <+> ppr orig_co) } + +lintCoercion this_co@(AxiomCo ax cos) + = do { mapM_ lintCoercion cos + ; lint_roles 0 (coAxiomRuleArgRoles ax) cos + ; prs <- mapM substCoKindM cos + ; lint_ax ax prs } + + where + lint_ax :: CoAxiomRule -> [Pair OutType] -> LintM () + lint_ax (BuiltInFamRew bif) prs + = checkL (isJust (bifrw_proves bif prs)) bad_bif + lint_ax (BuiltInFamInj bif) prs + = checkL (case prs of + [pr] -> isJust (bifinj_proves bif pr) + _ -> False) + bad_bif + lint_ax (UnbranchedAxiom ax) prs + = lintBranch this_co (coAxiomTyCon ax) (coAxiomSingleBranch ax) prs + lint_ax (BranchedAxiom ax ind) prs + = do { checkL (0 <= ind && ind < numBranches (coAxiomBranches ax)) + (bad_ax this_co (text "index out of range")) + ; lintBranch this_co (coAxiomTyCon ax) (coAxiomNthBranch ax ind) prs } + + bad_bif = bad_ax this_co (text "Proves returns Nothing") + + err :: forall a. String -> [SDoc] -> LintM a + err m xs = failWithL $ + hang (text m) 2 $ vcat (text "Rule:" <+> ppr ax : xs) + + lint_roles n (e : es) (co:cos) + | e == coercionRole co + = lint_roles (n+1) es cos + | otherwise = err "Argument roles mismatch" + [ text "In argument:" <+> int (n+1) + , text "Expected:" <+> ppr e + , text "Found:" <+> ppr (coercionRole co) ] + lint_roles _ [] [] = return () + lint_roles n [] rs = err "Too many coercion arguments" + [ text "Expected:" <+> int n + , text "Provided:" <+> int (n + length rs) ] + + lint_roles n es [] = err "Not enough coercion arguments" + [ text "Expected:" <+> int (n + length es) + , text "Provided:" <+> int n ] + +lintCoercion (KindCo co) = lintCoercion co + +lintCoercion (SubCo co) + = do { lintCoercion co + ; lintRole co Nominal (coercionRole co) } + +lintCoercion (HoleCo h) + = failWithL (text "Unfilled coercion hole:" <+> ppr h) + +{- +Note [Conflict checking for axiom applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following type family and axiom: + +type family Equal (a :: k) (b :: k) :: Bool +type instance where + Equal a a = True + Equal a b = False +-- +Equal :: forall k::*. k -> k -> Bool +axEqual :: { forall k::*. forall a::k. Equal k a a ~ True + ; forall k::*. forall a::k. forall b::k. Equal k a b ~ False } + +The coercion (axEqual[1] <*> ) :: (Equal * Int Int ~ False) + +and that all is OK. But, all is not OK: we want to use the first branch of the +axiom in this case, not the second. The problem is that the parameters of the +first branch can unify with the supplied coercions, thus meaning that the first +branch should be taken. See also Note [Apartness] in "GHC.Core.FamInstEnv". + +For more details, see the section "Branched axiom conflict checking" in +docs/core-spec, which defines the corresponding no_conflict function used by the +Co_AxiomInstCo rule in the section "Coercion typing". +-} + +-- | Check to make sure that an axiom application is internally consistent. +-- Returns the conflicting branch, if it exists +-- Note [Conflict checking for axiom applications] +lintBranch :: Coercion -> TyCon-> CoAxBranch -> [Pair Type] -> LintM () +-- defined here to avoid dependencies in GHC.Core.Coercion +-- If you edit this function, you may need to update the GHC formalism +-- See Note [GHC Formalism] in GHC.Core.Lint +lintBranch this_co fam_tc branch arg_kinds + | CoAxBranch { cab_tvs = ktvs, cab_cvs = cvs } <- branch + = do { checkL (arg_kinds `equalLength` (ktvs ++ cvs)) $ + (bad_ax this_co (text "lengths")) + + ; subst <- getSubst + ; let empty_subst = zapSubst subst + ; _ <- foldlM check_ki (empty_subst, empty_subst) + (zip (ktvs ++ cvs) arg_kinds) + + ; case check_no_conflict target incomps of + Nothing -> return () + Just bad_branch -> failWithL $ bad_ax this_co $ + text "inconsistent with" <+> + pprCoAxBranch fam_tc bad_branch } + where + check_ki (subst_l, subst_r) (ktv, Pair s' t') + = do { let sk' = typeKind s' + tk' = typeKind t' + ; let ktv_kind_l = substTy subst_l (tyVarKind ktv) + ktv_kind_r = substTy subst_r (tyVarKind ktv) + ; checkL (sk' `eqType` ktv_kind_l) + (bad_ax this_co (text "check_ki1" <+> vcat [ ppr this_co, ppr sk', ppr ktv, ppr ktv_kind_l ] )) + ; checkL (tk' `eqType` ktv_kind_r) + (bad_ax this_co (text "check_ki2" <+> vcat [ ppr this_co, ppr tk', ppr ktv, ppr ktv_kind_r ] )) + ; return (extendTCvSubst subst_l ktv s', + extendTCvSubst subst_r ktv t') } + + tvs = coAxBranchTyVars branch + cvs = coAxBranchCoVars branch + incomps = coAxBranchIncomps branch + (tys, cotys) = splitAtList tvs (map pFst arg_kinds) + co_args = map stripCoercionTy cotys + subst = zipTvSubst tvs tys `composeTCvSubst` + zipCvSubst cvs co_args + target = Type.substTys subst (coAxBranchLHS branch) + + check_no_conflict :: [Type] -> [CoAxBranch] -> Maybe CoAxBranch + check_no_conflict _ [] = Nothing + check_no_conflict flat (b@CoAxBranch { cab_lhs = lhs_incomp } : rest) + -- See Note [Apartness] in GHC.Core.FamInstEnv + | SurelyApart <- tcUnifyTysFG alwaysBindFam alwaysBindTv flat lhs_incomp + = check_no_conflict flat rest + | otherwise + = Just b + +bad_ax :: Coercion -> SDoc -> SDoc +bad_ax this_co what + = hang (text "Bad axiom application" <+> parens what) 2 (ppr this_co) + + +{- +************************************************************************ +* * + Axioms +* * +************************************************************************ +-} + +lintAxioms :: Logger + -> LintConfig + -> SDoc -- ^ The source of the linted axioms + -> [CoAxiom Branched] + -> IO () +lintAxioms logger cfg what axioms = + displayLintResults logger True what (vcat $ map pprCoAxiom axioms) $ + initL cfg $ + do { mapM_ lint_axiom axioms + ; let axiom_groups = groupWith coAxiomTyCon axioms + ; mapM_ lint_axiom_group axiom_groups } + +lint_axiom :: CoAxiom Branched -> LintM () +lint_axiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches + , co_ax_role = ax_role }) + = addLoc (InAxiom ax) $ + do { mapM_ (lint_branch tc) branch_list + ; extra_checks } + where + branch_list = fromBranches branches + + extra_checks + | isNewTyCon tc + = do { CoAxBranch { cab_tvs = ax_tvs + , cab_eta_tvs = eta_tvs + , cab_cvs = cvs + , cab_roles = roles + , cab_lhs = lhs_tys } + <- case branch_list of + [branch] -> return branch + _ -> failWithL (text "multi-branch axiom with newtype") + + -- The LHS of the axiom is (N lhs_tys) + -- We expect it to be (N ax_tvs) + ; lintL (mkTyVarTys ax_tvs `eqTypes` lhs_tys) + (text "Newtype axiom LHS does not match newtype definition") + ; lintL (null cvs) + (text "Newtype axiom binds coercion variables") + ; lintL (null eta_tvs) -- See Note [Eta reduction for data families] + -- which is not about newtype axioms + (text "Newtype axiom has eta-tvs") + ; lintL (ax_role == Representational) + (text "Newtype axiom role not representational") + ; lintL (roles `equalLength` ax_tvs) + (text "Newtype axiom roles list is the wrong length." $$ + text "roles:" <+> sep (map ppr roles)) + ; lintL (roles == takeList roles (tyConRoles tc)) + (vcat [ text "Newtype axiom roles do not match newtype tycon's." + , text "axiom roles:" <+> sep (map ppr roles) + , text "tycon roles:" <+> sep (map ppr (tyConRoles tc)) ]) + } + + | isFamilyTyCon tc + = do { if | isTypeFamilyTyCon tc + -> lintL (ax_role == Nominal) + (text "type family axiom is not nominal") + + | isDataFamilyTyCon tc + -> lintL (ax_role == Representational) + (text "data family axiom is not representational") + + | otherwise + -> addErrL (text "A family TyCon is neither a type family nor a data family:" <+> ppr tc) + + ; mapM_ (lint_family_branch tc) branch_list } + + | otherwise + = addErrL (text "Axiom tycon is neither a newtype nor a family.") + +lint_branch :: TyCon -> CoAxBranch -> LintM () +lint_branch ax_tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs + , cab_lhs = lhs_args, cab_rhs = rhs }) + = lintBinders LambdaBind (tvs ++ cvs) $ \_ -> + do { let lhs = mkTyConApp ax_tc lhs_args + ; lintType lhs + ; lintType rhs + ; lhs_kind <- substTyM (typeKind lhs) + ; rhs_kind <- substTyM (typeKind rhs) + ; lintL (not (lhs_kind `typesAreApart` rhs_kind)) $ + hang (text "Inhomogeneous axiom") + 2 (text "lhs:" <+> ppr lhs <+> dcolon <+> ppr lhs_kind $$ + text "rhs:" <+> ppr rhs <+> dcolon <+> ppr rhs_kind) } + -- Type and Constraint are not Apart, so this test allows + -- the newtype axiom for a single-method class. Indeed the + -- whole reason Type and Constraint are not Apart is to allow + -- such axioms! + +-- these checks do not apply to newtype axioms +lint_family_branch :: TyCon -> CoAxBranch -> LintM () +lint_family_branch fam_tc br@(CoAxBranch { cab_tvs = tvs + , cab_eta_tvs = eta_tvs + , cab_cvs = cvs + , cab_roles = roles + , cab_lhs = lhs + , cab_incomps = incomps }) + = do { lintL (isDataFamilyTyCon fam_tc || null eta_tvs) + (text "Type family axiom has eta-tvs") + ; lintL (all (`elemVarSet` tyCoVarsOfTypes lhs) tvs) + (text "Quantified variable in family axiom unused in LHS") + ; lintL (all isTyFamFree lhs) + (text "Type family application on LHS of family axiom") + ; lintL (all (== Nominal) roles) + (text "Non-nominal role in family axiom" $$ + text "roles:" <+> sep (map ppr roles)) + ; lintL (null cvs) + (text "Coercion variables bound in family axiom") + ; forM_ incomps $ \ br' -> + lintL (not (compatibleBranches br br')) $ + hang (text "Incorrect incompatible branches:") + 2 (vcat [text "Branch:" <+> ppr br, + text "Bogus incomp:" <+> ppr br']) } + +lint_axiom_group :: NonEmpty (CoAxiom Branched) -> LintM () +lint_axiom_group (_ :| []) = return () +lint_axiom_group (ax :| axs) + = do { lintL (isOpenFamilyTyCon tc) + (text "Non-open-family with multiple axioms") + ; let all_pairs = [ (ax1, ax2) | ax1 <- all_axs + , ax2 <- all_axs ] + ; mapM_ (lint_axiom_pair tc) all_pairs } + where + all_axs = ax : axs + tc = coAxiomTyCon ax + +lint_axiom_pair :: TyCon -> (CoAxiom Branched, CoAxiom Branched) -> LintM () +lint_axiom_pair tc (ax1, ax2) + | Just br1@(CoAxBranch { cab_tvs = tvs1 + , cab_lhs = lhs1 + , cab_rhs = rhs1 }) <- coAxiomSingleBranch_maybe ax1 + , Just br2@(CoAxBranch { cab_tvs = tvs2 + , cab_lhs = lhs2 + , cab_rhs = rhs2 }) <- coAxiomSingleBranch_maybe ax2 + = lintL (compatibleBranches br1 br2) $ + vcat [ hsep [ text "Axioms", ppr ax1, text "and", ppr ax2 + , text "are incompatible" ] + , text "tvs1 =" <+> pprTyVars tvs1 + , text "lhs1 =" <+> ppr (mkTyConApp tc lhs1) + , text "rhs1 =" <+> ppr rhs1 + , text "tvs2 =" <+> pprTyVars tvs2 + , text "lhs2 =" <+> ppr (mkTyConApp tc lhs2) + , text "rhs2 =" <+> ppr rhs2 ] + + | otherwise + = addErrL (text "Open type family axiom has more than one branch: either" <+> + ppr ax1 <+> text "or" <+> ppr ax2) + +{- +************************************************************************ +* * +\subsection[lint-monad]{The Lint monad} +* * +************************************************************************ +-} + +-- If you edit this type, you may need to update the GHC formalism +-- See Note [GHC Formalism] +data LintEnv + = LE { le_flags :: LintFlags -- Linting the result of this pass + , le_loc :: [LintLocInfo] -- Locations + + , le_subst :: Subst + -- Current substitution, for TyCoVars only. + -- Non-CoVar Ids don't appear in here, not even in the InScopeSet + -- Used for (a) cloning to avoid shadowing of TyCoVars, + -- so that eqType works ok + -- (b) substituting for let-bound tyvars, when we have + -- (let @a = Int -> Int in ...) + + , le_in_vars :: VarEnv (InVar, OutType) + -- Maps an InVar (i.e. its unique) to its binding InVar + -- and to its OutType + -- /All/ in-scope variables are here (term variables, + -- type variables, and coercion variables) + -- Used at an occurrence of the InVar + + , le_joins :: IdSet -- Join points in scope that are valid + -- A subset of the InScopeSet in le_subst + -- See Note [Join points] + + , le_ue_aliases :: NameEnv UsageEnv + -- See Note [Linting linearity] + -- Assigns usage environments to the alias-like binders, + -- as found in non-recursive lets. + -- Domain is OutIds + + , le_platform :: Platform -- ^ Target platform + , le_diagOpts :: DiagOpts -- ^ Target platform + } + +data LintFlags + = LF { lf_check_global_ids :: Bool -- See Note [Checking for global Ids] + , lf_check_inline_loop_breakers :: Bool -- See Note [Checking for INLINE loop breakers] + , lf_check_static_ptrs :: StaticPtrCheck -- ^ See Note [Checking StaticPtrs] + , lf_report_unsat_syns :: Bool -- ^ See Note [Linting type synonym applications] + , lf_check_linearity :: Bool -- ^ See Note [Linting linearity] + , lf_check_fixed_rep :: Bool -- See Note [Checking for representation polymorphism] + } + +-- See Note [Checking StaticPtrs] +data StaticPtrCheck + = AllowAnywhere + -- ^ Allow 'makeStatic' to occur anywhere. + | AllowAtTopLevel + -- ^ Allow 'makeStatic' calls at the top-level only. + | RejectEverywhere + -- ^ Reject any 'makeStatic' occurrence. + deriving Eq + +newtype LintM a = + LintM' { unLintM :: + LintEnv -> + WarnsAndErrs -> -- Warning and error messages so far + LResult a } -- Result and messages (if any) + + +pattern LintM :: (LintEnv -> WarnsAndErrs -> LResult a) -> LintM a +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +pattern LintM m <- LintM' m + where + LintM m = LintM' (oneShot $ \env -> oneShot $ \we -> m env we) + -- LintM m = LintM' (oneShot $ oneShot m) +{-# COMPLETE LintM #-} + +instance Functor (LintM) where + fmap f (LintM m) = LintM $ \e w -> mapLResult f (m e w) + +type WarnsAndErrs = (Bag SDoc, Bag SDoc) + +-- Using a unboxed tuple here reduced allocations for a lint heavy +-- file by ~6%. Using MaybeUB reduced them further by another ~12%. +-- +-- Warning: if you don't inline the matcher for JustUB etc, Lint becomes +-- /tremendously/ inefficient, and compiling GHC.Tc.Errors.Types (which +-- contains gigantic types) is very very slow indeed. Conclusion: make +-- sure unfoldings are expose in GHC.Data.Unboxed, and that you compile +-- Lint.hs with optimistation on. +type LResult a = (# MaybeUB a, WarnsAndErrs #) + +pattern LResult :: MaybeUB a -> WarnsAndErrs -> LResult a +pattern LResult m w = (# m, w #) +{-# COMPLETE LResult #-} + +mapLResult :: (a1 -> a2) -> LResult a1 -> LResult a2 +mapLResult f (LResult r w) = LResult (fmapMaybeUB f r) w + +-- Just for testing. +fromBoxedLResult :: (Maybe a, WarnsAndErrs) -> LResult a +fromBoxedLResult (Just x, errs) = LResult (JustUB x) errs +fromBoxedLResult (Nothing,errs) = LResult NothingUB errs + +{- Note [Checking for global Ids] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before CoreTidy, all locally-bound Ids must be LocalIds, even +top-level ones. See Note [Exported LocalIds] and #9857. + +Note [Checking StaticPtrs] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview. + +Every occurrence of the function 'makeStatic' should be moved to the +top level by the FloatOut pass. It's vital that we don't have nested +'makeStatic' occurrences after CorePrep, because we populate the Static +Pointer Table from the top-level bindings. See SimplCore Note [Grand +plan for static forms]. + +The linter checks that no occurrence is left behind, nested within an +expression. The check is enabled only after the FloatOut, CorePrep, +and CoreTidy passes and only if the module uses the StaticPointers +language extension. Checking more often doesn't help since the condition +doesn't hold until after the first FloatOut pass. + +Note [Type substitution] +~~~~~~~~~~~~~~~~~~~~~~~~ +Why do we need a type substitution? Consider + /\(a:*). \(x:a). /\(a:*). id a x +This is ill typed, because (renaming variables) it is really + /\(a:*). \(x:a). /\(b:*). id b x +Hence, when checking an application, we can't naively compare x's type +(at its binding site) with its expected type (at a use site). So we +rename type binders as we go, maintaining a substitution. + +The same substitution also supports let-type, current expressed as + (/\(a:*). body) ty +Here we substitute 'ty' for 'a' in 'body', on the fly. + +Note [Linting type synonym applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When linting a type-synonym, or type-family, application + S ty1 .. tyn +we behave as follows (#15057, #T15664): + +* If lf_report_unsat_syns = True, and S has arity < n, + complain about an unsaturated type synonym or type family + +* Switch off lf_report_unsat_syns, and lint ty1 .. tyn. + + Reason: catch out of scope variables or other ill-kinded gubbins, + even if S discards that argument entirely. E.g. (#15012): + type FakeOut a = Int + type family TF a + type instance TF Int = FakeOut a + Here 'a' is out of scope; but if we expand FakeOut, we conceal + that out-of-scope error. + + Reason for switching off lf_report_unsat_syns: with + LiberalTypeSynonyms, GHC allows unsaturated synonyms provided they + are saturated when the type is expanded. Example + type T f = f Int + type S a = a -> a + type Z = T S + In Z's RHS, S appears unsaturated, but it is saturated when T is expanded. + +* If lf_report_unsat_syns is on, expand the synonym application and + lint the result. Reason: want to check that synonyms are saturated + when the type is expanded. + +Note [Linting linearity] +~~~~~~~~~~~~~~~~~~~~~~~~ +Lint ignores linearity unless `-dlinear-core-lint` is set. For why, see below. + +* When do we /check linearity/ in Lint? That is, when is `-dlinear-core-lint` + lint set? Answer: we check linearity in the output of the desugarer, shortly + after type checking. + +* When so we /not/ check linearity in Lint? On all passes after desugaring. Why? + Because optimisation passes are not (yet) guaranteed to maintain linearity. + They should do so semantically (GHC is careful not to duplicate computation) + but it is much harder to ensure that the statically-checkable constraints of + Linear Core are maintained. See examples below. + +The current Linear Core is described in the wiki at: +https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation. + +Concretely, "ignore linearity in Lint" specifically means two things: +* In `ensureEqTypes`, use `eqTypeIgnoringMultiplicity` +* In `ensureSubMult`, do nothing + +Here are some examples of how the optimiser can break linearity checking. Other +examples are documented in the linear-type implementation wiki page +[https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation#core-to-core-passes] + +* EXAMPLE 1: the binder swap transformation + Consider + + data T = MkT {-# UNPACK #-} !Int + + The wrapper for MkT is + + $wMkT :: Int %1 -> T + $wMkT n = case %1 n of + I# n' -> MkT n' + + This introduces, in particular, a `case %1` (this is not actual Haskell or + Core syntax), where the `%1` means that the `case` expression consumes its + scrutinee linearly. + + Now, `case %1` interacts with the binder swap optimisation in a non-trivial + way. Take a slightly modified version of the code for $wMkT: + + case %1 x of z { + I# n' -> (x, n') + } + + Binder-swap changes this to + + case %1 x of z { + I# n' -> let x = z in (x, n') + } + + This is rejected by `-dlinear-core-lint` because 1/ n' must be used linearly + 2/ `-dlinear-core-lint` recognises a use of `z` as a use of `n'`. So it sees + two uses of n' where there should be a single one. + +* EXAMPLE 2: letrec + Some optimisations can create a letrec which uses a variable + linearly, e.g. + + letrec f True = f False + f False = x + in f True + + uses 'x' linearly, but this is not seen by the linter, which considers, + conservatively, that a letrec always has multiplicity Many (in particular + that every captured free variable must have multiplicity Many). This issue + is discussed in ticket #18694. + +* EXAMPLE 3: rewrite rules + Ignoring linearity means in particular that `a -> b` and `a %1 -> b` must be + treated the same by rewrite rules (see also Note [Rewrite rules ignore + multiplicities in FunTy] in GHC.Core.Unify). Consider + + m :: Bool -> A + m' :: (Bool -> Bool) -> A + {- RULES "ex" forall f. m (f True) = m' f -} + + f :: Bool %1 -> A + x = m (f True) + + The rule "ex" must match . So the linter must accept `m' f`. + +* EXAMPLE 4: eta-reduction + Eta-expansion can change linear functions into unrestricted functions + + f :: A %1 -> B + + g :: A %Many -> B + g = \x -> f x + + Eta-reduction undoes this and produces: + + g :: A %Many -> B + g = f + +Historical note: In the original linear-types implementation, we had tried to +make every optimisation pass produce code that passes `-dlinear-core-lint`. It +had proved very difficult. We kept finding corner case after corner +case. Furthermore, to attempt to achieve that goal we ended up restricting +transformations when `-dlinear-core-lint` couldn't typecheck the result. + +In the future, we may be able to lint the linearity of the output of +Core-to-Core passes (#19165). But this shouldn't be done at the expense of +producing efficient code. Therefore we lay the following principle. + +PRINCIPLE: The type system bends to the optimisation, not the other way around. + +There is a useful discussion at https://gitlab.haskell.org/ghc/ghc/-/issues/22123 + +Note [Linting representation-polymorphic builtins] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As described in Note [Representation-polymorphism checking built-ins], on +top of the two main representation-polymorphism invariants described in the +Note [Representation polymorphism invariants], we must perform additional +representation-polymorphism checks on builtin functions which don't have a +binding, for example to ensure that we don't run afoul of the +representation-polymorphism invariants when eta-expanding. + +There are two situations: + + 1. Builtins which have skolem type variables which must be instantiated to + concrete types, such as the RuntimeRep type argument r to the catch# primop. + + 2. Representation-polymorphic unlifted newtypes, which must always be instantiated + at a fixed runtime representation. + +For 1, consider for example 'coerce': + + coerce :: forall {r} (a :: TYPE r) (b :: TYPE r). Coercible a b => a -> b + +We store in the IdDetails of the coerce Id that the first binder, r, must always +be instantiated to a concrete type. We thus check this in Core Lint: whenever we +see an application of the form + + coerce @{rep1} ... + +we ensure that 'rep1' is concrete. This is done in the function "checkRepPolyBuiltinApp". +Moreover, not instantiating these type variables at all is also an error, as +we would again not be able to perform eta-expansion. (This is a bit more theoretical, +as in user programs the typechecker will insert these type applications when +instantiating, but it can still arise when constructing Core expressions). + +For 2, whenever we have an unlifted newtype such as + + type RR :: Type -> RuntimeRep + type family RR a + + type F :: forall (a :: Type) -> TYPE (RR a) + type family F a + + type N :: forall (a :: Type) -> TYPE (RR a) + newtype N a = MkN (F a) + +and an unsaturated occurrence + + MkN @ty -- NB: no value argument! + +we check that the (instantiated) argument type has a fixed runtime representation. +This is done in the function "checkRepPolyNewtypeApp". +-} + +instance Applicative LintM where + pure x = LintM $ \ _ errs -> LResult (JustUB x) errs + --(Just x, errs) + (<*>) = ap + +instance Monad LintM where + m >>= k = LintM (\ env errs -> + let res = unLintM m env errs in + case res of + LResult (JustUB r) errs' -> unLintM (k r) env errs' + LResult NothingUB errs' -> LResult NothingUB errs' + ) + -- LError errs'-> LError errs') + -- let (res, errs') = unLintM m env errs in + -- Just r -> unLintM (k r) env errs' + -- Nothing -> (Nothing, errs')) + +instance MonadFail LintM where + fail err = failWithL (text err) + +getPlatform :: LintM Platform +getPlatform = LintM (\ e errs -> (LResult (JustUB $ le_platform e) errs)) + +data LintLocInfo + = RhsOf Id -- The variable bound + | OccOf Id -- Occurrence of id + | LambdaBodyOf Id -- The lambda-binder + | RuleOf Id -- Rules attached to a binder + | UnfoldingOf Id -- Unfolding of a binder + | BodyOfLet Id -- The let-bound variable + | BodyOfLetRec [Id] -- The binders of the let + | CaseAlt CoreAlt -- Case alternative + | CasePat CoreAlt -- The *pattern* of the case alternative + | CaseTy CoreExpr -- The type field of a case expression + -- with this scrutinee + | IdTy Id -- The type field of an Id binder + | AnExpr CoreExpr -- Some expression + | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which) + | TopLevelBindings + | InType Type -- Inside a type + | InCo Coercion -- Inside a coercion + | InAxiom (CoAxiom Branched) -- Inside a CoAxiom + +data LintConfig = LintConfig + { l_diagOpts :: !DiagOpts -- ^ Diagnostics opts + , l_platform :: !Platform -- ^ Target platform + , l_flags :: !LintFlags -- ^ Linting the result of this pass + , l_vars :: ![Var] -- ^ 'Id's that should be treated as being in scope + } + +initL :: LintConfig + -> LintM a -- ^ Action to run + -> WarnsAndErrs +initL cfg m + = case unLintM m env (emptyBag, emptyBag) of + LResult (JustUB _) errs -> errs + LResult NothingUB errs@(_, e) | not (isEmptyBag e) -> errs + | otherwise -> pprPanic ("Bug in Lint: a failure occurred " ++ + "without reporting an error message") empty + where + vars = l_vars cfg + env = LE { le_flags = l_flags cfg + , le_subst = mkEmptySubst (mkInScopeSetList vars) + , le_in_vars = mkVarEnv [ (v,(v, varType v)) | v <- vars ] + , le_joins = emptyVarSet + , le_loc = [] + , le_ue_aliases = emptyNameEnv + , le_platform = l_platform cfg + , le_diagOpts = l_diagOpts cfg + } + +setReportUnsat :: Bool -> LintM a -> LintM a +-- Switch off lf_report_unsat_syns +setReportUnsat ru thing_inside + = LintM $ \ env errs -> + let env' = env { le_flags = (le_flags env) { lf_report_unsat_syns = ru } } + in unLintM thing_inside env' errs + +-- See Note [Checking for representation polymorphism] +noFixedRuntimeRepChecks :: LintM a -> LintM a +noFixedRuntimeRepChecks thing_inside + = LintM $ \env errs -> + let env' = env { le_flags = (le_flags env) { lf_check_fixed_rep = False } } + in unLintM thing_inside env' errs + +getLintFlags :: LintM LintFlags +getLintFlags = LintM $ \ env errs -> fromBoxedLResult (Just (le_flags env), errs) + +checkL :: Bool -> SDoc -> LintM () +checkL True _ = return () +checkL False msg = failWithL msg + +-- like checkL, but relevant to type checking +lintL :: Bool -> SDoc -> LintM () +lintL = checkL + +checkWarnL :: Bool -> SDoc -> LintM () +checkWarnL True _ = return () +checkWarnL False msg = addWarnL msg + +failWithL :: SDoc -> LintM a +failWithL msg = LintM $ \ env (warns,errs) -> + fromBoxedLResult (Nothing, (warns, addMsg True env errs msg)) + +addErrL :: SDoc -> LintM () +addErrL msg = LintM $ \ env (warns,errs) -> + fromBoxedLResult (Just (), (warns, addMsg True env errs msg)) + +addWarnL :: SDoc -> LintM () +addWarnL msg = LintM $ \ env (warns,errs) -> + fromBoxedLResult (Just (), (addMsg True env warns msg, errs)) + +addMsg :: Bool -> LintEnv -> Bag SDoc -> SDoc -> Bag SDoc +addMsg show_context env msgs msg + = assertPpr (notNull loc_msgs) msg $ + msgs `snocBag` mk_msg msg + where + loc_msgs :: [(SrcLoc, SDoc)] -- Innermost first + loc_msgs = map dumpLoc (le_loc env) + + cxt_doc = vcat [ vcat $ reverse $ map snd loc_msgs + , text "Substitution:" <+> ppr (le_subst env) ] + + context | show_context = cxt_doc + | otherwise = whenPprDebug cxt_doc + -- Print voluminous info for Lint errors + -- but not for warnings + + msg_span = case [ span | (loc,_) <- loc_msgs + , let span = srcLocSpan loc + , isGoodSrcSpan span ] of + [] -> noSrcSpan + (s:_) -> s + !diag_opts = le_diagOpts env + mk_msg msg = mkLocMessage (mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) msg_span + (msg $$ context) + +addLoc :: LintLocInfo -> LintM a -> LintM a +addLoc extra_loc m + = LintM $ \ env errs -> + unLintM m (env { le_loc = extra_loc : le_loc env }) errs + +inCasePat :: LintM Bool -- A slight hack; see the unique call site +inCasePat = LintM $ \ env errs -> fromBoxedLResult (Just (is_case_pat env), errs) + where + is_case_pat (LE { le_loc = CasePat {} : _ }) = True + is_case_pat _other = False + +addInScopeId :: InId -> OutType -> (OutId -> LintM a) -> LintM a +-- Unlike addInScopeTyCoVar, this function does no cloning; Ids never get cloned +addInScopeId in_id out_ty thing_inside + = LintM $ \ env errs -> + let !(out_id, env') = add env + in unLintM (thing_inside out_id) env' errs + + where + add env@(LE { le_in_vars = id_vars, le_joins = join_set + , le_ue_aliases = aliases, le_subst = subst }) + = (out_id, env1) + where + env1 = env { le_in_vars = in_vars', le_joins = join_set', le_ue_aliases = aliases' } + + in_vars' = extendVarEnv id_vars in_id (in_id, out_ty) + aliases' = delFromNameEnv aliases (idName in_id) + -- aliases': when shadowing an alias, we need to make sure the + -- Id is no longer classified as such. E.g. + -- let x = in case x of x { _DEFAULT -> } + -- Occurrences of 'x' in e2 shouldn't count as occurrences of e1. + + -- A very tiny optimisation, not sure if it's really worth it + -- Short-cut when the substitution is a no-op + out_id | isEmptyTCvSubst subst = in_id + | otherwise = setIdType in_id out_ty + + join_set' + | isJoinId out_id = extendVarSet join_set in_id -- Overwrite with new arity + | otherwise = delVarSet join_set in_id -- Remove any existing binding + +addInScopeTyCoVar :: InTyCoVar -> OutType -> (OutTyCoVar -> LintM a) -> LintM a +-- This function clones to avoid shadowing of TyCoVars +addInScopeTyCoVar tcv tcv_type thing_inside + = LintM $ \ env@(LE { le_in_vars = in_vars, le_subst = subst }) errs -> + let (tcv', subst') = subst_bndr subst + env' = env { le_in_vars = extendVarEnv in_vars tcv (tcv, tcv_type) + , le_subst = subst' } + in unLintM (thing_inside tcv') env' errs + where + subst_bndr subst + | isEmptyTCvSubst subst -- No change in kind + , not (tcv `elemInScopeSet` in_scope) -- Not already in scope + = -- Do not extend the substitution, just the in-scope set + (if (varType tcv `eqType` tcv_type) then (\x->x) else + pprTrace "addInScopeTyCoVar" ( + vcat [ text "tcv" <+> ppr tcv <+> dcolon <+> ppr (varType tcv) + , text "tcv_type" <+> ppr tcv_type ])) $ + (tcv, subst `extendSubstInScope` tcv) + + -- Clone, and extend the substitution + | let tcv' = uniqAway in_scope (setVarType tcv tcv_type) + = (tcv', extendTCvSubstWithClone subst tcv tcv') + where + in_scope = substInScopeSet subst + +getInVarEnv :: LintM (VarEnv (InId, OutType)) +getInVarEnv = LintM (\env errs -> fromBoxedLResult (Just (le_in_vars env), errs)) + +extendTvSubstL :: TyVar -> Type -> LintM a -> LintM a +extendTvSubstL tv ty m + = LintM $ \ env errs -> + unLintM m (env { le_subst = Type.extendTvSubst (le_subst env) tv ty }) errs + +markAllJoinsBad :: LintM a -> LintM a +markAllJoinsBad m + = LintM $ \ env errs -> unLintM m (env { le_joins = emptyVarSet }) errs + +markAllJoinsBadIf :: Bool -> LintM a -> LintM a +markAllJoinsBadIf True m = markAllJoinsBad m +markAllJoinsBadIf False m = m + +getValidJoins :: LintM IdSet +getValidJoins = LintM (\ env errs -> fromBoxedLResult (Just (le_joins env), errs)) + +getSubst :: LintM Subst +getSubst = LintM (\ env errs -> fromBoxedLResult (Just (le_subst env), errs)) + +substTyM :: InType -> LintM OutType +-- Apply the substitution to the type +-- The substitution is often empty, in which case it is a no-op +substTyM ty + = do { subst <- getSubst + ; return (substTy subst ty) } + +getUEAliases :: LintM (NameEnv UsageEnv) +getUEAliases = LintM (\ env errs -> fromBoxedLResult (Just (le_ue_aliases env), errs)) + +getInScope :: LintM InScopeSet +getInScope = LintM (\ env errs -> fromBoxedLResult (Just (substInScopeSet $ le_subst env), errs)) + +lintVarOcc :: InVar -> LintM OutType +-- Used at an occurrence of a variable: term variables, type variables, and coercion variables +-- Checks two things: +-- a) that it is in scope +-- b) that the InType at the ocurrences matches the InType at the binding site +lintVarOcc v_occ + = do { in_var_env <- getInVarEnv + ; case lookupVarEnv in_var_env v_occ of + Nothing | isGlobalId v_occ -> return (idType v_occ) + | otherwise -> failWithL (text pp_what <+> quotes (ppr v_occ) + <+> text "is out of scope") + Just (v_bndr, out_ty) -> do { check_bad_global v_bndr + ; ensureEqTys occ_ty bndr_ty $ -- Compares InTypes + mkBndrOccTypeMismatchMsg v_occ bndr_ty occ_ty + ; return out_ty } + where + occ_ty = varType v_occ + bndr_ty = varType v_bndr } + where + pp_what | isTyVar v_occ = "The type variable" + | isCoVar v_occ = "The coercion variable" + | otherwise = "The value variable" + + -- 'check_bad_global' checks for the case where an /occurrence/ is + -- a GlobalId, but there is an enclosing binding fora a LocalId. + -- NB: the in-scope variables are mostly LocalIds, checked by lintIdBndr, + -- but GHCi adds GlobalIds from the interactive context. These + -- are fine; hence the test (isLocalId id == isLocalId v) + -- NB: when compiling Control.Exception.Base, things like absentError + -- are defined locally, but appear in expressions as (global) + -- wired-in Ids after worker/wrapper + -- So we simply disable the test in this case + check_bad_global v_bndr + | isGlobalId v_occ + , isLocalId v_bndr + , not (isWiredIn v_occ) + = failWithL $ hang (text "Occurrence is GlobalId, but binding is LocalId") + 2 (vcat [ hang (text "occurrence:") 2 $ pprBndr LetBind v_occ + , hang (text "binder :") 2 $ pprBndr LetBind v_bndr ]) + | otherwise + = return () + +lookupJoinId :: Id -> LintM JoinPointHood +-- Look up an Id which should be a join point, valid here +-- If so, return its arity, if not return Nothing +lookupJoinId id + = do { join_set <- getValidJoins + ; case lookupVarSet join_set id of + Just id' -> return (idJoinPointHood id') + Nothing -> return NotJoinPoint } + +addAliasUE :: OutId -> UsageEnv -> LintM a -> LintM a +addAliasUE id ue thing_inside = LintM $ \ env errs -> + let new_ue_aliases = + extendNameEnv (le_ue_aliases env) (getName id) ue + in + unLintM thing_inside (env { le_ue_aliases = new_ue_aliases }) errs + +varCallSiteUsage :: OutId -> LintM UsageEnv +varCallSiteUsage id = + do m <- getUEAliases + return $ case lookupNameEnv m (getName id) of + Nothing -> singleUsageUE id + Just id_ue -> id_ue + +ensureEqTys :: OutType -> OutType -> SDoc -> LintM () +-- check ty2 is subtype of ty1 (ie, has same structure but usage +-- annotations need only be consistent, not equal) +-- Assumes ty1,ty2 are have already had the substitution applied +{-# INLINE ensureEqTys #-} -- See Note [INLINE ensureEqTys] +ensureEqTys ty1 ty2 msg + = do { flags <- getLintFlags + ; lintL (eq_type flags ty1 ty2) msg } + +eq_type :: LintFlags -> Type -> Type -> Bool +-- When `-dlinear-core-lint` is off, then consider `a -> b` and `a %1 -> b` to +-- be equal. See Note [Linting linearity]. +eq_type flags ty1 ty2 | lf_check_linearity flags = eqType ty1 ty2 + | otherwise = eqTypeIgnoringMultiplicity ty1 ty2 + +{- Note [INLINE ensureEqTys] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To make Lint fast, we want to avoid allocating a thunk for in + ensureEqTypes ty1 ty2 +because the test almost always succeeds, and isn't needed. +So we INLINE `ensureEqTys`. This actually make a difference of +1-2% when compiling programs with -dcore-lint. +-} + +ensureSubUsage :: Usage -> Mult -> SDoc -> LintM () +ensureSubUsage Bottom _ _ = return () +ensureSubUsage Zero described_mult err_msg = ensureSubMult ManyTy described_mult err_msg +ensureSubUsage (MUsage m) described_mult err_msg = ensureSubMult m described_mult err_msg + +ensureSubMult :: Mult -> Mult -> SDoc -> LintM () +ensureSubMult actual_mult described_mult err_msg = do + flags <- getLintFlags + when (lf_check_linearity flags) $ + unless (deepSubMult actual_mult described_mult) $ + addErrL err_msg + where + -- Check for submultiplicity using the following rules: + -- 1. x*y <= z when x <= z and y <= z. + -- This rule follows from the fact that x*y = sup{x,y} for any + -- multiplicities x,y. + -- 2. x <= y*z when x <= y or x <= z. + -- This rule is not complete: when x = y*z, we cannot + -- change y*z <= y*z to y*z <= y or y*z <= z. + -- However, we eliminate products on the LHS in step 1. + -- 3. One <= x and x <= Many for any x, as checked by 'submult'. + -- 4. x <= x. + -- Otherwise, we fail. + deepSubMult :: Mult -> Mult -> Bool + deepSubMult m n + | Just (m1, m2) <- isMultMul m = deepSubMult m1 n && deepSubMult m2 n + | Just (n1, n2) <- isMultMul n = deepSubMult m n1 || deepSubMult m n2 + | Submult <- m `submult` n = True + | otherwise = m `eqType` n + +lintRole :: Outputable thing + => thing -- where the role appeared + -> Role -- expected + -> Role -- actual + -> LintM () +lintRole co r1 r2 + = lintL (r1 == r2) + (text "Role incompatibility: expected" <+> ppr r1 <> comma <+> + text "got" <+> ppr r2 $$ + text "in" <+> ppr co) + +{- +************************************************************************ +* * +\subsection{Error messages} +* * +************************************************************************ +-} + +dumpLoc :: LintLocInfo -> (SrcLoc, SDoc) + +dumpLoc (RhsOf v) + = (getSrcLoc v, text "In the RHS of" <+> pp_binders [v]) + +dumpLoc (OccOf v) + = (getSrcLoc v, text "In an occurrence of" <+> pp_binder v) + +dumpLoc (LambdaBodyOf b) + = (getSrcLoc b, text "In the body of lambda with binder" <+> pp_binder b) + +dumpLoc (RuleOf b) + = (getSrcLoc b, text "In a rule attached to" <+> pp_binder b) + +dumpLoc (UnfoldingOf b) + = (getSrcLoc b, text "In the unfolding of" <+> pp_binder b) + +dumpLoc (BodyOfLet b) + = (noSrcLoc, text "In the body of a let with binder" <+> pp_binder b) + +dumpLoc (BodyOfLetRec []) + = (noSrcLoc, text "In body of a letrec with no binders") + +dumpLoc (BodyOfLetRec bs@(b:_)) + = ( getSrcLoc b, text "In the body of a letrec with binders" <+> pp_binders bs) + +dumpLoc (AnExpr e) + = (noSrcLoc, text "In the expression:" <+> ppr e) + +dumpLoc (CaseAlt (Alt con args _)) + = (noSrcLoc, text "In a case alternative:" <+> parens (ppr con <+> pp_binders args)) + +dumpLoc (CasePat (Alt con args _)) + = (noSrcLoc, text "In the pattern of a case alternative:" <+> parens (ppr con <+> pp_binders args)) + +dumpLoc (CaseTy scrut) + = (noSrcLoc, hang (text "In the result-type of a case with scrutinee:") + 2 (ppr scrut)) + +dumpLoc (IdTy b) + = (getSrcLoc b, text "In the type of a binder:" <+> ppr b) + +dumpLoc (ImportedUnfolding locn) + = (locn, text "In an imported unfolding") +dumpLoc TopLevelBindings + = (noSrcLoc, Outputable.empty) +dumpLoc (InType ty) + = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) +dumpLoc (InCo co) + = (noSrcLoc, text "In the coercion" <+> quotes (ppr co)) +dumpLoc (InAxiom ax) + = (getSrcLoc ax, hang (text "In the coercion axiom") + 2 (pprCoAxiom ax)) + +pp_binders :: [Var] -> SDoc +pp_binders bs = sep (punctuate comma (map pp_binder bs)) + +pp_binder :: Var -> SDoc +pp_binder b | isId b = hsep [ppr b, dcolon, ppr (idType b)] + | otherwise = hsep [ppr b, dcolon, ppr (tyVarKind b)] + +------------------------------------------------------ +-- Messages for case expressions + +mkDefaultArgsMsg :: [Var] -> SDoc +mkDefaultArgsMsg args + = hang (text "DEFAULT case with binders") + 4 (ppr args) + +mkCaseAltMsg :: CoreExpr -> Type -> Type -> SDoc +mkCaseAltMsg e ty1 ty2 + = hang (text "Type of case alternatives not the same as the annotation on case:") + 4 (vcat [ text "Actual type:" <+> ppr ty1, + text "Annotation on case:" <+> ppr ty2, + text "Alt Rhs:" <+> ppr e ]) + +mkScrutMsg :: Id -> Type -> Type -> SDoc +mkScrutMsg var var_ty scrut_ty + = vcat [text "Result binder in case doesn't match scrutinee:" <+> ppr var, + text "Result binder type:" <+> ppr var_ty,--(idType var), + text "Scrutinee type:" <+> ppr scrut_ty] + +mkNonDefltMsg, mkNonIncreasingAltsMsg :: CoreExpr -> SDoc +mkNonDefltMsg e + = hang (text "Case expression with DEFAULT not at the beginning") 4 (ppr e) +mkNonIncreasingAltsMsg e + = hang (text "Case expression with badly-ordered alternatives") 4 (ppr e) + +nonExhaustiveAltsMsg :: CoreExpr -> SDoc +nonExhaustiveAltsMsg e + = hang (text "Case expression with non-exhaustive alternatives") 4 (ppr e) + +mkBadConMsg :: TyCon -> DataCon -> SDoc +mkBadConMsg tycon datacon + = vcat [ + text "In a case alternative, data constructor isn't in scrutinee type:", + text "Scrutinee type constructor:" <+> ppr tycon, + text "Data con:" <+> ppr datacon + ] + +mkBadPatMsg :: Type -> Type -> SDoc +mkBadPatMsg con_result_ty scrut_ty + = vcat [ + text "In a case alternative, pattern result type doesn't match scrutinee type:", + text "Pattern result type:" <+> ppr con_result_ty, + text "Scrutinee type:" <+> ppr scrut_ty + ] + +integerScrutinisedMsg :: SDoc +integerScrutinisedMsg + = text "In a LitAlt, the literal is lifted (probably Integer)" + +mkBadAltMsg :: Type -> CoreAlt -> SDoc +mkBadAltMsg scrut_ty alt + = vcat [ text "Data alternative when scrutinee is not a tycon application", + text "Scrutinee type:" <+> ppr scrut_ty, + text "Alternative:" <+> pprCoreAlt alt ] + +mkNewTyDataConAltMsg :: Type -> CoreAlt -> SDoc +mkNewTyDataConAltMsg scrut_ty alt + = vcat [ text "Data alternative for newtype datacon", + text "Scrutinee type:" <+> ppr scrut_ty, + text "Alternative:" <+> pprCoreAlt alt ] + + +------------------------------------------------------ +-- Other error messages + +mkAppMsg :: Type -> Type -> CoreExpr -> SDoc +mkAppMsg expected_arg_ty actual_arg_ty arg + = vcat [text "Argument value doesn't match argument type:", + hang (text "Expected arg type:") 4 (ppr expected_arg_ty), + hang (text "Actual arg type:") 4 (ppr actual_arg_ty), + hang (text "Arg:") 4 (ppr arg)] + +mkNonFunAppMsg :: Type -> Type -> CoreExpr -> SDoc +mkNonFunAppMsg fun_ty arg_ty arg + = vcat [text "Non-function type in function position", + hang (text "Fun type:") 4 (ppr fun_ty), + hang (text "Arg type:") 4 (ppr arg_ty), + hang (text "Arg:") 4 (ppr arg)] + +mkLetErr :: TyVar -> CoreExpr -> SDoc +mkLetErr bndr rhs + = vcat [text "Bad `let' binding:", + hang (text "Variable:") + 4 (ppr bndr <+> dcolon <+> ppr (varType bndr)), + hang (text "Rhs:") + 4 (ppr rhs)] + +mkTyAppMsg :: OutType -> Type -> SDoc +mkTyAppMsg ty arg_ty + = vcat [text "Illegal type application:", + hang (text "Function type:") + 4 (ppr ty <+> dcolon <+> ppr (typeKind ty)), + hang (text "Type argument:") + 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))] + +emptyRec :: CoreExpr -> SDoc +emptyRec e = hang (text "Empty Rec binding:") 2 (ppr e) + +mkRhsMsg :: Id -> SDoc -> Type -> SDoc +mkRhsMsg binder what ty + = vcat + [hsep [text "The type of this binder doesn't match the type of its" <+> what <> colon, + ppr binder], + hsep [text "Binder's type:", ppr (idType binder)], + hsep [text "Rhs type:", ppr ty]] + +badBndrTyMsg :: Id -> SDoc -> SDoc +badBndrTyMsg binder what + = vcat [ text "The type of this binder is" <+> what <> colon <+> ppr binder + , text "Binder's type:" <+> ppr (idType binder) ] + +mkNonTopExportedMsg :: Id -> SDoc +mkNonTopExportedMsg binder + = hsep [text "Non-top-level binder is marked as exported:", ppr binder] + +mkNonTopExternalNameMsg :: Id -> SDoc +mkNonTopExternalNameMsg binder + = hsep [text "Non-top-level binder has an external name:", ppr binder] + +mkTopNonLitStrMsg :: Id -> SDoc +mkTopNonLitStrMsg binder + = hsep [text "Top-level Addr# binder has a non-literal rhs:", ppr binder] + +mkKindErrMsg :: TyVar -> Type -> SDoc +mkKindErrMsg tyvar arg_ty + = vcat [text "Kinds don't match in type application:", + hang (text "Type variable:") + 4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)), + hang (text "Arg type:") + 4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))] + +mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> SDoc +mkCastErr expr = mk_cast_err "expression" "type" (ppr expr) + +mkCastTyErr :: Type -> Coercion -> Kind -> Kind -> SDoc +mkCastTyErr ty = mk_cast_err "type" "kind" (ppr ty) + +mk_cast_err :: String -- ^ What sort of casted thing this is + -- (\"expression\" or \"type\"). + -> String -- ^ What sort of coercion is being used + -- (\"type\" or \"kind\"). + -> SDoc -- ^ The thing being casted. + -> Coercion -> Type -> Type -> SDoc +mk_cast_err thing_str co_str pp_thing co from_ty thing_ty + = vcat [from_msg <+> text "of Cast differs from" <+> co_msg + <+> text "of" <+> enclosed_msg, + from_msg <> colon <+> ppr from_ty, + text (capitalise co_str) <+> text "of" <+> enclosed_msg <> colon + <+> ppr thing_ty, + text "Actual" <+> enclosed_msg <> colon <+> pp_thing, + text "Coercion used in cast:" <+> ppr co + ] + where + co_msg, from_msg, enclosed_msg :: SDoc + co_msg = text co_str + from_msg = text "From-" <> co_msg + enclosed_msg = text "enclosed" <+> text thing_str + +mkBadTyVarMsg :: Var -> SDoc +mkBadTyVarMsg tv + = text "Non-tyvar used in TyVarTy:" + <+> ppr tv <+> dcolon <+> ppr (varType tv) + +mkBadJoinBindMsg :: Var -> SDoc +mkBadJoinBindMsg var + = vcat [ text "Bad join point binding:" <+> ppr var + , text "Join points can be bound only by a non-top-level let" ] + +mkInvalidJoinPointMsg :: Var -> Type -> SDoc +mkInvalidJoinPointMsg var ty + = hang (text "Join point has invalid type:") + 2 (ppr var <+> dcolon <+> ppr ty) + +mkBadJoinArityMsg :: Var -> Int -> Int -> CoreExpr -> SDoc +mkBadJoinArityMsg var ar n rhs + = vcat [ text "Join point has too few lambdas", + text "Join var:" <+> ppr var, + text "Join arity:" <+> ppr ar, + text "Number of lambdas:" <+> ppr (ar - n), + text "Rhs = " <+> ppr rhs + ] + +invalidJoinOcc :: Var -> SDoc +invalidJoinOcc var + = vcat [ text "Invalid occurrence of a join variable:" <+> ppr var + , text "The binder is either not a join point, or not valid here" ] + +mkBadJumpMsg :: Var -> Int -> Int -> SDoc +mkBadJumpMsg var ar nargs + = vcat [ text "Join point invoked with wrong number of arguments", + text "Join var:" <+> ppr var, + text "Join arity:" <+> ppr ar, + text "Number of arguments:" <+> int nargs ] + +mkInconsistentRecMsg :: [Var] -> SDoc +mkInconsistentRecMsg bndrs + = vcat [ text "Recursive let binders mix values and join points", + text "Binders:" <+> hsep (map ppr_with_details bndrs) ] + where + ppr_with_details bndr = ppr bndr <> ppr (idDetails bndr) + +mkJoinBndrOccMismatchMsg :: Var -> JoinArity -> JoinArity -> SDoc +mkJoinBndrOccMismatchMsg bndr join_arity_bndr join_arity_occ + = vcat [ text "Mismatch in join point arity between binder and occurrence" + , text "Var:" <+> ppr bndr + , text "Arity at binding site:" <+> ppr join_arity_bndr + , text "Arity at occurrence: " <+> ppr join_arity_occ ] + +mkBndrOccTypeMismatchMsg :: InVar -> InType -> InType -> SDoc +mkBndrOccTypeMismatchMsg var bndr_ty occ_ty + = vcat [ text "Mismatch in type between binder and occurrence" + , text "Binder: " <+> ppr var <+> dcolon <+> ppr bndr_ty + , text "Occurrence:" <+> ppr var <+> dcolon <+> ppr occ_ty ] mkBadJoinPointRuleMsg :: JoinId -> JoinArity -> CoreRule -> SDoc mkBadJoinPointRuleMsg bndr join_arity rule diff --git a/GHC/Core/Make.hs b/GHC/Core/Make.hs --- a/GHC/Core/Make.hs +++ b/GHC/Core/Make.hs @@ -1,11 +1,10 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Handy functions for creating much Core syntax module GHC.Core.Make ( -- * Constructing normal syntax mkCoreLet, mkCoreLets, - mkCoreApp, mkCoreApps, mkCoreConApps, - mkCoreLams, mkWildCase, mkIfThenElse, + mkCoreApp, mkCoreApps, mkCoreConApps, mkCoreConWrapApps, + mkCoreLams, mkCoreTyLams, + mkWildCase, mkIfThenElse, mkWildValBinder, mkSingleAltCase, sortQuantVars, castBottomExpr, @@ -65,12 +64,12 @@ import GHC.Types.Unique.Supply import GHC.Core -import GHC.Core.Utils ( exprType, mkSingleAltCase, bindNonRec ) +import GHC.Core.Utils ( exprType, mkSingleAltCase, bindNonRec, mkCast ) import GHC.Core.Type -import GHC.Core.Predicate ( isCoVarType ) +import GHC.Core.Predicate ( scopedSort, isEqPred ) import GHC.Core.TyCo.Compare ( eqType ) -import GHC.Core.Coercion ( isCoVar ) -import GHC.Core.DataCon ( DataCon, dataConWorkId ) +import GHC.Core.Coercion ( isCoVar, mkRepReflCo, mkForAllVisCos ) +import GHC.Core.DataCon ( DataCon, dataConWorkId, dataConWrapId ) import GHC.Core.Multiplicity import GHC.Builtin.Types @@ -83,8 +82,10 @@ import GHC.Settings.Constants( mAX_TUPLE_SIZE ) import GHC.Data.FastString +import GHC.Data.Maybe ( expectJust ) import Data.List ( partition ) +import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Char ( ord ) infixl 4 `mkCoreApp`, `mkCoreApps` @@ -122,6 +123,14 @@ mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr mkCoreLams = mkLams +-- | Create a type lambda (/\a b c. e) and apply a cast to fix up visibilities +-- if needed. See Note [Required foralls in Core] +mkCoreTyLams :: [TyVarBinder] -> CoreExpr -> CoreExpr +mkCoreTyLams binders body = mkCast lam co + where + lam = mkCoreLams (binderVars binders) body + co = mkForAllVisCos binders (mkRepReflCo (exprType body)) + -- | Bind a list of binding groups over an expression. The leftmost binding -- group becomes the outermost group in the resulting expression mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr @@ -133,6 +142,13 @@ mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr mkCoreConApps con args = mkCoreApps (Var (dataConWorkId con)) args +-- | A variant of 'mkCoreConApps' constructs an expression which represents the +-- application of a number of expressions to that of a data constructor +-- expression using the wrapper, not the worker, of the data constructor. The +-- leftmost expression in the list is applied first +mkCoreConWrapApps :: DataCon -> [CoreExpr] -> CoreExpr +mkCoreConWrapApps con args = mkCoreApps (Var (dataConWrapId con)) args + -- | Construct an expression which represents the application of a number of -- expressions to another. The leftmost expression in the list is applied first mkCoreApps :: CoreExpr -- ^ function @@ -224,12 +240,12 @@ mkLitRubbish ty | not (noFreeVarsOfType rep) = Nothing -- Satisfy INVARIANT 1 - | isCoVarType ty + | isEqPred ty = Nothing -- Satisfy INVARIANT 2 | otherwise = Just (Lit (LitRubbish torc rep) `mkTyApps` [ty]) where - Just (torc, rep) = sORTKind_maybe (typeKind ty) + (torc, rep) = expectJust $ sORTKind_maybe (typeKind ty) {- ************************************************************************ @@ -609,8 +625,13 @@ where tpl_tys = [mkBoxedTupleTy (map idType gp) | gp <- vars_s] tpl_vs = mkTemplateLocals tpl_tys - [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkBigTupleSelector" tpl_vs vars_s, - the_var `elem` gp ] + (tpl_v, group) = case + [ (tpl,gp) + | (tpl,gp) <- zipEqual tpl_vs vars_s + , the_var `elem` gp + ] of + [x] -> x + _ -> panic "mkBigTupleSelector" -- ^ 'mkBigTupleSelectorSolo' is like 'mkBigTupleSelector' -- but one-tuples are NOT flattened (see Note [Flattening one-tuples]) mkBigTupleSelectorSolo vars the_var scrut_var scrut @@ -1277,7 +1298,7 @@ mkRuntimeErrorTy torc = mkSpecForAllTys [runtimeRep1TyVar, tyvar] $ mkFunctionType ManyTy addrPrimTy (mkTyVarTy tyvar) where - (tyvar:_) = mkTemplateTyVars [kind] + tyvar:|_ = expectNonEmpty $ mkTemplateTyVars [kind] kind = case torc of TypeLike -> mkTYPEapp runtimeRep1Ty ConstraintLike -> mkCONSTRAINTapp runtimeRep1Ty diff --git a/GHC/Core/Map/Expr.hs b/GHC/Core/Map/Expr.hs --- a/GHC/Core/Map/Expr.hs +++ b/GHC/Core/Map/Expr.hs @@ -122,6 +122,7 @@ alterTM k f (CoreMap m) = CoreMap (alterTM (deBruijnize k) f m) foldTM k (CoreMap m) = foldTM k m filterTM f (CoreMap m) = CoreMap (filterTM f m) + mapMaybeTM f (CoreMap m) = CoreMap (mapMaybeTM f m) -- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@. The extended -- key makes it suitable for recursive traversal, since it can track binders, @@ -197,11 +198,10 @@ eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where - go (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod) + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) = lid == rid && D env1 lids == D env2 rids && lext == rext - && lmod == rmod go l r = l == r -- Compares for equality, modulo alpha @@ -271,6 +271,7 @@ alterTM = xtE foldTM = fdE filterTM = ftE + mapMaybeTM = mpE -------------------------- ftE :: (a->Bool) -> CoreMapX a -> CoreMapX a @@ -287,6 +288,20 @@ , cm_letr = fmap (fmap (filterTM f)) cletr, cm_case = fmap (filterTM f) ccase , cm_ecase = fmap (filterTM f) cecase, cm_tick = fmap (filterTM f) ctick } +mpE :: (a -> Maybe b) -> CoreMapX a -> CoreMapX b +mpE f (CM { cm_var = cvar, cm_lit = clit + , cm_co = cco, cm_type = ctype + , cm_cast = ccast , cm_app = capp + , cm_lam = clam, cm_letn = cletn + , cm_letr = cletr, cm_case = ccase + , cm_ecase = cecase, cm_tick = ctick }) + = CM { cm_var = mapMaybeTM f cvar, cm_lit = mapMaybeTM f clit + , cm_co = mapMaybeTM f cco, cm_type = mapMaybeTM f ctype + , cm_cast = fmap (mapMaybeTM f) ccast, cm_app = fmap (mapMaybeTM f) capp + , cm_lam = fmap (mapMaybeTM f) clam, cm_letn = fmap (fmap (mapMaybeTM f)) cletn + , cm_letr = fmap (fmap (mapMaybeTM f)) cletr, cm_case = fmap (mapMaybeTM f) ccase + , cm_ecase = fmap (mapMaybeTM f) cecase, cm_tick = fmap (mapMaybeTM f) ctick } + -------------------------- lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a lookupCoreMap cm e = lookupTM e cm @@ -409,6 +424,7 @@ alterTM = xtA emptyCME foldTM = fdA filterTM = ftA + mapMaybeTM = mpA instance Eq (DeBruijn CoreAlt) where D env1 a1 == D env2 a2 = go a1 a2 where @@ -446,3 +462,9 @@ fdA k m = foldTM k (am_deflt m) . foldTM (foldTM k) (am_data m) . foldTM (foldTM k) (am_lit m) + +mpA :: (a -> Maybe b) -> AltMap a -> AltMap b +mpA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit }) + = AM { am_deflt = mapMaybeTM f adeflt + , am_data = fmap (mapMaybeTM f) adata + , am_lit = fmap (mapMaybeTM f) alit } diff --git a/GHC/Core/Map/Type.hs b/GHC/Core/Map/Type.hs --- a/GHC/Core/Map/Type.hs +++ b/GHC/Core/Map/Type.hs @@ -47,7 +47,7 @@ import GHC.Types.Name.Env import GHC.Types.Var import GHC.Types.Var.Env -import GHC.Types.Unique.DFM +import GHC.Types.Unique.FM import GHC.Utils.Outputable import GHC.Utils.Panic @@ -96,6 +96,7 @@ alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m) foldTM k (CoercionMap m) = foldTM k m filterTM f (CoercionMap m) = CoercionMap (filterTM f m) + mapMaybeTM f (CoercionMap m) = CoercionMap (mapMaybeTM f m) type CoercionMapG = GenMap CoercionMapX newtype CoercionMapX a = CoercionMapX (TypeMapX a) @@ -112,6 +113,7 @@ alterTM = xtC foldTM f (CoercionMapX core_tm) = foldTM f core_tm filterTM f (CoercionMapX core_tm) = CoercionMapX (filterTM f core_tm) + mapMaybeTM f (CoercionMapX core_tm) = CoercionMapX (mapMaybeTM f core_tm) instance Eq (DeBruijn Coercion) where D env1 co1 == D env2 co2 @@ -189,6 +191,7 @@ alterTM = xtT foldTM = fdT filterTM = filterT + mapMaybeTM = mpT instance Eq (DeBruijn Type) where (==) = eqDeBruijnType @@ -364,14 +367,14 @@ ------------------------ data TyLitMap a = TLM { tlm_number :: Map.Map Integer a - , tlm_string :: UniqDFM FastString a + , tlm_string :: UniqFM FastString a , tlm_char :: Map.Map Char a } -- TODO(22292): derive instance Functor TyLitMap where fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM - { tlm_number = Map.map f tn, tlm_string = mapUDFM f ts, tlm_char = Map.map f tc } + { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } instance TrieMap TyLitMap where type Key TyLitMap = TyLit @@ -380,33 +383,38 @@ alterTM = xtTyLit foldTM = foldTyLit filterTM = filterTyLit + mapMaybeTM = mpTyLit emptyTyLitMap :: TyLitMap a -emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUDFM, tlm_char = Map.empty } +emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty } lkTyLit :: TyLit -> TyLitMap a -> Maybe a lkTyLit l = case l of NumTyLit n -> tlm_number >.> Map.lookup n - StrTyLit n -> tlm_string >.> (`lookupUDFM` n) + StrTyLit n -> tlm_string >.> (`lookupUFM` n) CharTyLit n -> tlm_char >.> Map.lookup n xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a xtTyLit l f m = case l of NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) } - StrTyLit n -> m { tlm_string = alterUDFM f (tlm_string m) n } + StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n } CharTyLit n -> m { tlm_char = Map.alter f n (tlm_char m) } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (foldUDFM l) (tlm_string m) +foldTyLit l m = flip (nonDetFoldUFM l) (tlm_string m) . flip (Map.foldr l) (tlm_number m) . flip (Map.foldr l) (tlm_char m) filterTyLit :: (a -> Bool) -> TyLitMap a -> TyLitMap a filterTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.filter f tn, tlm_string = filterUDFM f ts, tlm_char = Map.filter f tc } + = TLM { tlm_number = Map.filter f tn, tlm_string = filterUFM f ts, tlm_char = Map.filter f tc } +mpTyLit :: (a -> Maybe b) -> TyLitMap a -> TyLitMap b +mpTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) + = TLM { tlm_number = Map.mapMaybe f tn, tlm_string = mapMaybeUFM f ts, tlm_char = Map.mapMaybe f tc } + ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a@. If you are a client, this -- is the type you want. The keys in this map may have different kinds. @@ -435,6 +443,7 @@ alterTM k f m = xtTT (deBruijnize k) f m foldTM k (TypeMap m) = foldTM (foldTM k) m filterTM f (TypeMap m) = TypeMap (fmap (filterTM f) m) + mapMaybeTM f (TypeMap m) = TypeMap (fmap (mapMaybeTM f) m) foldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b foldTypeMap k z m = foldTM k m z @@ -479,6 +488,7 @@ alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m) foldTM f (LooseTypeMap m) = foldTM f m filterTM f (LooseTypeMap m) = LooseTypeMap (filterTM f m) + mapMaybeTM f (LooseTypeMap m) = LooseTypeMap (mapMaybeTM f m) {- ************************************************************************ @@ -558,10 +568,13 @@ alterTM = xtBndr emptyCME foldTM = fdBndrMap filterTM = ftBndrMap + mapMaybeTM = mpBndrMap fdBndrMap :: (a -> b -> b) -> BndrMap a -> b -> b fdBndrMap f (BndrMap tm) = foldTM (foldTM f) tm +mpBndrMap :: (a -> Maybe b) -> BndrMap a -> BndrMap b +mpBndrMap f (BndrMap tm) = BndrMap (fmap (mapMaybeTM f) tm) -- We need to use 'BndrMap' for 'Coercion', 'CoreExpr' AND 'Type', since all -- of these data types have binding forms. @@ -594,6 +607,7 @@ alterTM = xtVar emptyCME foldTM = fdVar filterTM = ftVar + mapMaybeTM = mpVar lkVar :: CmEnv -> Var -> VarMap a -> Maybe a lkVar env v @@ -619,9 +633,24 @@ ftVar f (VM { vm_bvar = bv, vm_fvar = fv }) = VM { vm_bvar = filterTM f bv, vm_fvar = filterTM f fv } +mpVar :: (a -> Maybe b) -> VarMap a -> VarMap b +mpVar f (VM { vm_bvar = bv, vm_fvar = fv }) + = VM { vm_bvar = mapMaybeTM f bv, vm_fvar = mapMaybeTM f fv } + ------------------------------------------------- lkDNamed :: NamedThing n => n -> DNameEnv a -> Maybe a lkDNamed n env = lookupDNameEnv env (getName n) xtDNamed :: NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a xtDNamed tc f m = alterDNameEnv f m (getName tc) + +mpT :: (a -> Maybe b) -> TypeMapX a -> TypeMapX b +mpT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon + , tm_forall = tforall, tm_tylit = tlit + , tm_coerce = tcoerce }) + = TM { tm_var = mapMaybeTM f tvar + , tm_app = fmap (mapMaybeTM f) tapp + , tm_tycon = mapMaybeTM f ttycon + , tm_forall = fmap (mapMaybeTM f) tforall + , tm_tylit = mapMaybeTM f tlit + , tm_coerce = tcoerce >>= f } diff --git a/GHC/Core/Opt/Arity.hs b/GHC/Core/Opt/Arity.hs --- a/GHC/Core/Opt/Arity.hs +++ b/GHC/Core/Opt/Arity.hs @@ -7,6 +7,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} -- | Arity and eta expansion module GHC.Core.Opt.Arity @@ -52,9 +53,9 @@ import GHC.Core.FVs import GHC.Core.Utils import GHC.Core.DataCon -import GHC.Core.TyCon ( tyConArity ) +import GHC.Core.TyCon ( TyCon, tyConArity, isInjectiveTyCon ) import GHC.Core.TyCon.RecWalk ( initRecTc, checkRecTc ) -import GHC.Core.Predicate ( isDictTy, isEvVar, isCallStackPredTy, isCallStackTy ) +import GHC.Core.Predicate ( isDictTy, isEvId, isCallStackPredTy, isCallStackTy ) import GHC.Core.Multiplicity -- We have two sorts of substitution: @@ -87,6 +88,8 @@ import GHC.Utils.Panic import GHC.Utils.Misc +import Data.List.NonEmpty ( nonEmpty ) +import qualified Data.List.NonEmpty as NE import Data.Maybe( isJust ) {- @@ -1533,7 +1536,7 @@ -- See Note [Eta expanding through dictionaries] -- See Note [Eta expanding through CallStacks] - cheap_fun e = exprIsCheapX (myIsCheapApp sigs) e + cheap_fun e = exprIsCheapX (myIsCheapApp sigs) False e -- | A version of 'isCheapApp' that considers results from arity analysis. -- See Note [Arity analysis] for what's in the signature environment and why @@ -1599,23 +1602,22 @@ -- f x y = case x of { (a,b) -> e } -- The difference is observable using 'seq' -- -arityType env (Case scrut bndr _ alts) - | exprIsDeadEnd scrut || null alts - = botArityType -- Do not eta expand. See (1) in Note [Dealing with bottom] - - | not (pedanticBottoms env) -- See (2) in Note [Dealing with bottom] - , myExprIsCheap env scrut (Just (idType bndr)) - = alts_type +arityType env (Case scrut bndr _ altList) + | not $ exprIsDeadEnd scrut, Just alts <- nonEmpty altList + = let env' = delInScope env bndr + arity_type_alt (Alt _con bndrs rhs) = arityType (delInScopeList env' bndrs) rhs + alts_type = foldr1 (andArityType env) (NE.map arity_type_alt alts) + in if + | not (pedanticBottoms env) -- See (2) in Note [Dealing with bottom] + , myExprIsCheap env scrut (Just (idType bndr)) + -> alts_type - | exprOkForSpeculation scrut - = alts_type + | exprOkForSpeculation scrut + -> alts_type - | otherwise -- In the remaining cases we may not push - = addWork alts_type -- evaluation of the scrutinee in - where - env' = delInScope env bndr - arity_type_alt (Alt _con bndrs rhs) = arityType (delInScopeList env' bndrs) rhs - alts_type = foldr1 (andArityType env) (map arity_type_alt alts) + | otherwise -- In the remaining cases we may not push + -> addWork alts_type -- evaluation of the scrutinee in + | otherwise = botArityType -- Do not eta expand. See (1) in Note [Dealing with bottom] arityType env (Let (NonRec b rhs) e) = -- See Note [arityType for non-recursive let-bindings] @@ -2258,7 +2260,7 @@ -- If e :: ty -- then etaInfoApp e eis :: etaInfoApp ty eis etaInfoAppTy ty (EI bs mco) - = applyTypeToArgs (text "etaInfoAppTy") ty1 (map varToCoreExpr bs) + = applyTypeToArgs ty1 (map varToCoreExpr bs) where ty1 = case mco of MRefl -> ty @@ -2304,7 +2306,7 @@ go _ [] subst _ ----------- Done! No more expansion needed - = (getSubstInScope subst, EI [] MRefl) + = (substInScopeSet subst, EI [] MRefl) go n oss@(one_shot:oss1) subst ty ----------- Forall types (forall a. ty) @@ -2351,7 +2353,7 @@ -- but its type isn't a function, or a binder -- does not have a fixed runtime representation = warnPprTrace True "mkEtaWW" ((ppr orig_oss <+> ppr orig_ty) $$ ppr_orig_expr) - (getSubstInScope subst, EI [] MRefl) + (substInScopeSet subst, EI [] MRefl) -- This *can* legitimately happen: -- e.g. coerce Int (\x. x) Essentially the programmer is -- playing fast and loose with types (Happy does this a lot). @@ -2789,7 +2791,7 @@ arity = idArity fun --------------- - ok_lam v = isTyVar v || isEvVar v + ok_lam v = isTyVar v || isEvId v -- See Note [Eta reduction makes sense], point (2) --------------- @@ -3020,14 +3022,14 @@ | otherwise = Nothing -pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercion +pushCoDataCon :: DataCon -> [CoreExpr] -> MCoercionR -> Maybe (DataCon , [Type] -- Universal type args , [CoreExpr]) -- All other args incl existentials -- Implement the KPush reduction rule as described in "Down with kinds" -- The transformation applies iff we have -- (C e1 ... en) `cast` co --- where co :: (T t1 .. tn) ~ to_ty +-- where co :: (T t1 .. tn) ~ (T s1 .. sn) -- The left-hand one must be a T, because exprIsConApp returned True -- but the right-hand one might not be. (Though it usually will.) pushCoDataCon dc dc_args MRefl = Just $! (push_dc_refl dc dc_args) @@ -3039,7 +3041,7 @@ where !(univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) dc_args -push_dc_gen :: DataCon -> [CoreExpr] -> Coercion -> Pair Type +push_dc_gen :: DataCon -> [CoreExpr] -> CoercionR -> Pair Type -> Maybe (DataCon, [Type], [CoreExpr]) push_dc_gen dc dc_args co (Pair from_ty to_ty) | from_ty `eqType` to_ty -- try cheap test first @@ -3052,44 +3054,54 @@ -- where S is a type function. In fact, exprIsConApp -- will probably not be called in such circumstances, -- but there's nothing wrong with it + = Just (push_data_con to_tc to_tc_arg_tys dc dc_args co Representational) - = let - tc_arity = tyConArity to_tc - dc_univ_tyvars = dataConUnivTyVars dc - dc_ex_tcvars = dataConExTyCoVars dc - arg_tys = dataConRepArgTys dc + | otherwise + = Nothing - non_univ_args = dropList dc_univ_tyvars dc_args - (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args - -- Make the "Psi" from the paper - omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc) - (psi_subst, to_ex_arg_tys) - = liftCoSubstWithEx Representational - dc_univ_tyvars - omegas - dc_ex_tcvars - (map exprToType ex_args) +push_data_con :: TyCon -> [Type] -> DataCon -> [CoreExpr] + -> CoercionR -> Role -- Coercion and its role + -> (DataCon, [Type], [CoreExpr]) +push_data_con to_tc to_tc_arg_tys dc dc_args co role + = assertPpr (eqType from_ty dc_app_ty) dump_doc $ + assertPpr (equalLength val_args arg_tys) dump_doc $ + assertPpr (role == coercionRole co) dump_doc $ + assertPpr (isInjectiveTyCon to_tc role) dump_doc $ + -- isInjectiveTyCon: see (UCM9) in Note [Unary class magic] + -- in GHC.Core.TyCon + (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + where + Pair from_ty to_ty = coercionKind co + tc_arity = tyConArity to_tc + dc_univ_tyvars = dataConUnivTyVars dc + dc_ex_tcvars = dataConExTyCoVars dc + arg_tys = dataConRepArgTys dc - -- Cast the value arguments (which include dictionaries) - new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args - cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) + dc_app_ty = mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) - to_ex_args = map Type to_ex_arg_tys + non_univ_args = dropList dc_univ_tyvars dc_args + (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args - dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars, - ppr arg_tys, ppr dc_args, - ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc - , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] - in - assertPpr (eqType from_ty (mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args))) dump_doc $ - assertPpr (equalLength val_args arg_tys) dump_doc $ - Just (dc, to_tc_arg_tys, to_ex_args ++ new_val_args) + -- Make the "Psi" from the paper + omegas = decomposeCo tc_arity co (tyConRolesX role to_tc) + (psi_subst, to_ex_arg_tys) + = liftCoSubstWithEx dc_univ_tyvars + omegas + dc_ex_tcvars + (map exprToType ex_args) - | otherwise - = Nothing + -- Cast the value arguments (which include dictionaries) + new_val_args = zipWith cast_arg (map scaledThing arg_tys) val_args + cast_arg arg_ty arg = mkCast arg (psi_subst arg_ty) + to_ex_args = map Type to_ex_arg_tys + dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tcvars + , ppr arg_tys, ppr dc_args + , ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc + , ppr $ mkTyConApp to_tc (map exprToType $ takeList dc_univ_tyvars dc_args) ] + collectBindersPushingCo :: CoreExpr -> ([Var], CoreExpr) -- Collect lambda binders, pushing coercions inside if possible -- E.g. (\x.e) |> g g :: -> blah @@ -3145,15 +3157,12 @@ | otherwise = (reverse bs, mkCast (Lam b e) co) -{- - -Note [collectBindersPushingCo] +{- Note [collectBindersPushingCo] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We just look for coercions of form % w -> blah (and similarly for foralls) to keep this function simple. We could do more elaborate stuff, but it'd involve substitution etc. - -} {- ********************************************************************* @@ -3246,7 +3255,7 @@ = (subst', eta_id') where Scaled mult' ty' = Type.substScaledTyUnchecked subst ty - eta_id' = uniqAway (getSubstInScope subst) $ + eta_id' = uniqAway (substInScopeSet subst) $ mkSysLocalOrCoVar (fsLit "eta") (mkBuiltinUnique n) mult' ty' -- "OrCoVar" since this can be used to eta-expand -- coercion abstractions diff --git a/GHC/Core/Opt/CSE.hs b/GHC/Core/Opt/CSE.hs --- a/GHC/Core/Opt/CSE.hs +++ b/GHC/Core/Opt/CSE.hs @@ -638,6 +638,9 @@ doing this if there are no RULES; and other things being equal it delays optimisation to delay inlining (#17409) +* There can be a subtle order-dependency, as described in #25526; + it may matter whether we end up with f=g or g=f. + ---- Historical note --- diff --git a/GHC/Core/Opt/CallArity.hs b/GHC/Core/Opt/CallArity.hs --- a/GHC/Core/Opt/CallArity.hs +++ b/GHC/Core/Opt/CallArity.hs @@ -23,6 +23,7 @@ import GHC.Utils.Misc import Control.Arrow ( first, second ) +import Data.List.NonEmpty ( NonEmpty (..) ) {- @@ -696,7 +697,7 @@ -- See Note [Trimming arity] trimArity :: Id -> Arity -> Arity -trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig] +trimArity v a = minimum (a :| max_arity_by_type : max_arity_by_strsig : []) where max_arity_by_type = typeArity (idType v) max_arity_by_strsig diff --git a/GHC/Core/Opt/CallerCC/Types.hs b/GHC/Core/Opt/CallerCC/Types.hs --- a/GHC/Core/Opt/CallerCC/Types.hs +++ b/GHC/Core/Opt/CallerCC/Types.hs @@ -19,6 +19,7 @@ import GHC.Utils.Panic import qualified GHC.Utils.Binary as B import Data.Char +import Control.DeepSeq import Language.Haskell.Syntax.Module.Name @@ -33,6 +34,11 @@ ppr (PWildcard rest) = char '*' <> ppr rest ppr PEnd = Outputable.empty +instance NFData NamePattern where + rnf (PChar c n) = rnf c `seq` rnf n + rnf (PWildcard np) = rnf np + rnf PEnd = () + instance B.Binary NamePattern where get bh = do tag <- B.get bh @@ -75,6 +81,9 @@ = CallerCcFilter { ccfModuleName :: Maybe ModuleName , ccfFuncName :: NamePattern } + +instance NFData CallerCcFilter where + rnf (CallerCcFilter mn n) = rnf mn `seq` rnf n instance Outputable CallerCcFilter where ppr ccf = diff --git a/GHC/Core/Opt/ConstantFold.hs b/GHC/Core/Opt/ConstantFold.hs --- a/GHC/Core/Opt/ConstantFold.hs +++ b/GHC/Core/Opt/ConstantFold.hs @@ -20,7 +20,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} -- | Constant Folder module GHC.Core.Opt.ConstantFold @@ -55,7 +55,7 @@ import GHC.Core.Type import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon - ( TyCon, tyConDataCons_maybe, tyConDataCons, tyConFamilySize + ( TyCon, tyConDataCons_maybe, tyConDataCons, tyConSingleDataCon, tyConFamilySize , isEnumerationTyCon, isValidDTT2TyCon, isNewTyCon ) import GHC.Core.Map.Expr ( eqCoreExpr ) @@ -69,7 +69,6 @@ import GHC.Cmm.Type ( Width(..) ) import GHC.Data.FastString -import GHC.Data.Maybe ( orElse ) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -1997,6 +1996,14 @@ generate calls in derived instances of Enum. So we compromise: a rewrite rule rewrites a bad instance of tagToEnum# to an error call, and emits a warning. + +We also do something similar if we can see that the argument of tagToEnum is out +of bounds, e.g. `tagToEnum# 99# :: Bool`. +Replacing this with an error expression is better for two reasons: +* It allow us to eliminate more dead code in cases like `case tagToEnum# 99# :: Bool of ...` +* Should we actually end up executing the relevant code at runtime the user will + see a meaningful error message, instead of a segfault or incorrect result. +See #25976. -} tagToEnumRule :: RuleM CoreExpr @@ -2008,9 +2015,13 @@ Just (tycon, tc_args) | isEnumerationTyCon tycon -> do let tag = fromInteger i correct_tag dc = (dataConTagZ dc) == tag - (dc:rest) <- return $ filter correct_tag (tyConDataCons_maybe tycon `orElse` []) - massert (null rest) - return $ mkTyApps (Var (dataConWorkId dc)) tc_args + Just dataCons <- pure $ tyConDataCons_maybe tycon + case filter correct_tag dataCons of + (dc:rest) -> do + massert (null rest) + pure $ mkTyApps (Var (dataConWorkId dc)) tc_args + -- Literal is out of range, e.g. tagToEnum @Bool #4 + [] -> pure $ mkImpossibleExpr ty "tagToEnum: Argument out of range" -- See Note [tagToEnum#] _ -> warnPprTrace True "tagToEnum# on non-enumeration type" (ppr ty) $ @@ -2059,7 +2070,7 @@ ; fn <- getFunction ; let (_, ue) = splitForAllTyCoVars (idType fn) tc = tyConAppTyCon ue -- tycon: UnsafeEquality - (dc:_) = tyConDataCons tc -- data con: UnsafeRefl + dc = tyConSingleDataCon tc -- data con: UnsafeRefl -- UnsafeRefl :: forall (r :: RuntimeRep) (a :: TYPE r). -- UnsafeEquality r a a ; return (mkTyApps (Var (dataConWrapId dc)) [rep, t1]) } @@ -2635,6 +2646,13 @@ -------------------------------------------------------- -- Note [Constant folding through nested expressions] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- GHC has some support for constant folding through nested expressions (i.e. +-- when constants are not only arguments of the considered App node but to one +-- of its own argument (an App node too), see examples below). +-- +-- For performance reason, this optimization is only enabled with -O1 and above. +-- As with all optimizations, it can also be independently enabled with its own +-- command-line flag too: -fnum-constant-folding (grep Opt_NumConstantFolding). -- -- We use rewrites rules to perform constant folding. It means that we don't -- have a global view of the expression we are trying to optimise. As a diff --git a/GHC/Core/Opt/CprAnal.hs b/GHC/Core/Opt/CprAnal.hs --- a/GHC/Core/Opt/CprAnal.hs +++ b/GHC/Core/Opt/CprAnal.hs @@ -213,7 +213,7 @@ -> (CprType, CoreExpr) -- ^ the updated expression and its 'CprType' cprAnal env e = -- pprTraceWith "cprAnal" (\res -> ppr (fst (res)) $$ ppr e) $ - cprAnal' env e + cprAnal' env e cprAnal' _ (Lit lit) = (topCprType, Lit lit) cprAnal' _ (Type ty) = (topCprType, Type ty) -- Doesn't happen, in fact @@ -289,7 +289,7 @@ -> extendSigEnvAllSame env ids sig ForeachField field_cprs | let sigs = zipWith (mkCprSig . idArity) ids field_cprs - -> extendSigEnvList env (zipEqual "cprAnalAlt" ids sigs) + -> extendSigEnvList env (zipEqual ids sigs) | otherwise = extendSigEnvAllSame env ids topCprSig (rhs_ty, rhs') = cprAnal env_alt rhs @@ -304,9 +304,16 @@ -- See Note [Nested CPR] exprTerminates :: CoreExpr -> TermFlag +-- ^ A /very/ simple termination analysis. exprTerminates e - | exprIsHNF e = Terminates -- A /very/ simple termination analysis. - | otherwise = MightDiverge + | exprIsHNF e = Terminates + | exprOkForSpeculation e = Terminates + | otherwise = MightDiverge + -- Annoyingly, we have to check both for HNF and ok-for-spec. + -- * `I# (x# *# 2#)` is ok-for-spec, but not in HNF. Still worth CPR'ing! + -- * `lvl` is an HNF if its unfolding is evaluated + -- (perhaps `lvl = I# 0#` at top-level). But, tiresomely, it is never + -- ok-for-spec due to Note [exprOkForSpeculation and evaluated variables]. cprAnalApp :: AnalEnv -> CoreExpr -> [(CprType, CoreArg)] -> (CprType, CoreExpr) -- Main function that takes care of /nested/ CPR. See Note [Nested CPR] @@ -347,7 +354,7 @@ | isLocalId id = assertPpr (isDataStructure id) (ppr id) topCprType -- See Note [CPR for DataCon wrappers] - | isDataConWrapId id, let rhs = uf_tmpl (realIdUnfolding id) + | Just rhs <- dataConWrapUnfolding_maybe id = fst $ cprAnalApp env rhs args -- DataCon worker | Just con <- isDataConWorkId_maybe id @@ -369,14 +376,16 @@ -- | Get a (possibly nested) 'CprType' for an application of a 'DataCon' worker, -- given a saturated number of 'CprType's for its field expressions. -- Implements the Nested part of Note [Nested CPR]. -cprTransformDataConWork :: AnalEnv -> DataCon -> [(CprType, CoreArg)] -> CprType +cprTransformDataConWork :: AnalEnv -> DataCon + -> [(CprType, CoreArg)] -- Info about /value/ arguments + -> CprType cprTransformDataConWork env con args | null (dataConExTyCoVars con) -- No existentials , wkr_arity <= mAX_CPR_SIZE -- See Note [Trimming to mAX_CPR_SIZE] , args `lengthIs` wkr_arity , ae_rec_dc env con /= DefinitelyRecursive -- See Note [CPR for recursive data constructors] - -- , pprTrace "cprTransformDataConWork" (ppr con <+> ppr wkr_arity <+> ppr args) True - = CprType 0 (ConCpr (dataConTag con) (strictZipWith extract_nested_cpr args wkr_str_marks)) + = -- pprTraceWith "cprTransformDataConWork" (\r -> ppr con <+> ppr wkr_arity <+> ppr args <+> ppr r) $ + CprType 0 (ConCpr (dataConTag con) (strictZipWith extract_nested_cpr args wkr_str_marks)) | otherwise = topCprType where @@ -532,7 +541,8 @@ | isDataStructure id -- Data structure => no code => no need to analyse rhs = (id, rhs, env) | otherwise - = (id `setIdCprSig` sig', rhs', env') + = -- pprTrace "cprAnalBind" (ppr id <+> ppr sig <+> ppr sig') + (id `setIdCprSig` sig', rhs', env') where (rhs_ty, rhs') = cprAnal env rhs -- possibly trim thunk CPR info diff --git a/GHC/Core/Opt/DmdAnal.hs b/GHC/Core/Opt/DmdAnal.hs --- a/GHC/Core/Opt/DmdAnal.hs +++ b/GHC/Core/Opt/DmdAnal.hs @@ -23,7 +23,6 @@ import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type -import GHC.Core.Predicate( isEqualityClass, isCTupleClass ) import GHC.Core.FVs ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds ) import GHC.Core.Coercion ( Coercion ) import GHC.Core.TyCo.FVs ( coVarsOfCos ) @@ -555,7 +554,9 @@ WithDmdType res_ty (Case scrut' case_bndr' ty [Alt alt_con bndrs' rhs']) where want_precise_field_dmds (DataAlt dc) - | Nothing <- tyConSingleAlgDataCon_maybe $ dataConTyCon dc + | let tc = dataConTyCon dc + , assertPpr (not (isNewTyCon tc)) (ppr dc) True -- DataAlt is never newtype + , Nothing <- tyConSingleDataCon_maybe $ dataConTyCon dc = False -- Not a product type, even though this is the -- only remaining possible data constructor | DefinitelyRecursive <- ae_rec_dc env dc @@ -835,6 +836,10 @@ from 'topDiv' to 'conDiv', leading to bugs, performance regressions and complexity that didn't justify the single fixed testcase T13380c. +You might think that we should check for side-effects rather than just for +precise exceptions. Right you are! See Note [Side-effects and strictness] +for why we unfortunately do not. + Note [Demand analysis for recursive data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ T11545 features a single-product, recursive data type @@ -1015,7 +1020,7 @@ = -- pprTraceWith "dmdTransform:DataCon" (\ty -> ppr con $$ ppr sd $$ ppr ty) $ dmdTransformDataConSig (dataConRepStrictness con) sd -- See Note [DmdAnal for DataCon wrappers] - | isDataConWrapId var, let rhs = uf_tmpl (realIdUnfolding var) + | Just rhs <- dataConWrapUnfolding_maybe var , WithDmdType dmd_ty _rhs' <- dmdAnal env sd rhs = dmd_ty -- Dictionary component selectors @@ -1162,8 +1167,8 @@ go depth ty sd | depth <= max_depth , Just (tc, tc_args, _co) <- normSplitTyConApp_maybe (ae_fam_envs env) ty - , Just dc <- tyConSingleAlgDataCon_maybe tc - , null (dataConExTyCoVars dc) -- Can't unbox results with existentials + , Just [dc] <- canUnboxTyCon tc -- tc is not a newtype + , null (dataConExTyCoVars dc) -- Can't unbox results with existentials , dataConRepArity dc <= dmd_unbox_width (ae_opts env) , Just (_, ds) <- viewProd (dataConRepArity dc) sd , arg_tys <- map scaledThing $ dataConInstArgTys dc tc_args @@ -2026,7 +2031,7 @@ -- The normal case | otherwise = -- pprTrace "finaliseArgBoxities" ( - -- vcat [text "function:" <+> ppr fn + -- vcat [text "function:" <+> ppr fn -- , text "max" <+> ppr max_wkr_args -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ @@ -2167,12 +2172,6 @@ -- isMarkedStrict: see Note [Unboxing evaluated arguments] in DmdAnal -> DontUnbox - | doNotUnbox ty - -> DontUnbox -- See Note [Do not unbox class dictionaries] - -- NB: 'ty' has not been normalised, so this will (rightly) - -- catch newtype dictionaries too. - -- NB: even for bottoming functions, don't unbox dictionaries - | DefinitelyRecursive <- ae_rec_dc env dc -- See Note [Which types are unboxed?] -- and Note [Demand analysis for recursive data constructors] @@ -2182,76 +2181,6 @@ -> DoUnbox (zip3 (dubiousDataConInstArgTys dc tc_args) (dataConRepStrictness dc) dmds) - - -doNotUnbox :: Type -> Bool --- Do not unbox class dictionaries, except equality classes and tuples --- Note [Do not unbox class dictionaries] -doNotUnbox arg_ty - = case tyConAppTyCon_maybe arg_ty of - Just tc | Just cls <- tyConClass_maybe tc - -> not (isEqualityClass cls || isCTupleClass cls) - -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] - - _ -> False - -{- Note [Do not unbox class dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never unbox class dictionaries in worker/wrapper. - -1. INLINABLE functions - If we have - f :: Ord a => [a] -> Int -> a - {-# INLINABLE f #-} - and we worker/wrapper f, we'll get a worker with an INLINABLE pragma - (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), - which can still be specialised by the type-class specialiser, something like - fw :: Ord a => [a] -> Int# -> a - - BUT if f is strict in the Ord dictionary, we might unpack it, to get - fw :: (a->a->Bool) -> [a] -> Int# -> a - and the type-class specialiser can't specialise that. An example is #6056. - - Historical note: #14955 describes how I got this fix wrong the first time. - I got aware of the issue in T5075 by the change in boxity of loop between - demand analysis runs. - -2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur - occur without INLINABLE, when we use -fexpose-all-unfoldings and - -fspecialise-aggressively to do vigorous cross-module specialisation. - -3. #18421 found that unboxing a dictionary can also make the worker less likely - to inline; the inlining heuristics seem to prefer to inline a function - applied to a dictionary over a function applied to a bunch of functions. - -TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing -a raft of higher-order functions isn't a huge win anyway -- you really want to -specialise the function. - -Wrinkle (DNB1): we /do/ want to unbox tuple dictionaries (#23398) - f :: (% Eq a, Show a %) => blah - with -fdicts-strict it is great to unbox to - $wf :: Eq a => Show a => blah - (where I have written out the currying explicitly). Now we can specialise - $wf on the Eq or Show dictionary. Nothing is lost. - - And something is gained. It is possible that `f` will look like this: - f = /\a. \d:(% Eq a, Show a %). ... f @a (% sel1 d, sel2 d %)... - where there is a recurive call to `f`, or to another function that takes the - same tuple dictionary, but where the tuple is built from the components of - `d`. The Simplier does not fix this. But if we unpacked the dictionary - we'd get - $wf = /\a. \(d1:Eq a) (d2:Show a). let d = (% d1, d2 %) - in ...f @a (% sel1 d, sel2 d %) - and all the tuple building and taking apart will disappear. - -Wrinkle (DNB2): we /do/ want to unbox equality dictionaries, - for (~), (~~), and Coercible (#23398). Their payload is a single unboxed - coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is - to make a copy of the function's RHS with a particular coercion. Unlike - normal class methods, that does not unlock any new optimisation - opportunities in the specialised RHS. --} {- ********************************************************************* * * diff --git a/GHC/Core/Opt/FloatIn.hs b/GHC/Core/Opt/FloatIn.hs --- a/GHC/Core/Opt/FloatIn.hs +++ b/GHC/Core/Opt/FloatIn.hs @@ -173,7 +173,7 @@ = wrapFloats drop_here $ mkTicks ticks $ mkApps (fiExpr platform fun_drop ann_fun) - (zipWithEqual "fiExpr" (fiExpr platform) arg_drops ann_args) + (zipWithEqual (fiExpr platform) arg_drops ann_args) -- use zipWithEqual, we should have -- length ann_args = length arg_fvs = length arg_drops where @@ -543,7 +543,7 @@ = wrapFloats drop_here1 $ wrapFloats drop_here2 $ Case (fiExpr platform scrut_drops scrut) case_bndr ty - (zipWithEqual "fiExpr" fi_alt alts_drops_s alts) + (zipWithEqual fi_alt alts_drops_s alts) -- use zipWithEqual, we should have length alts_drops_s = length alts where -- Float into the scrut and alts-considered-together just like App @@ -640,7 +640,7 @@ fi_bind to_drops pairs = [ (binder, fiRhs platform to_drop binder rhs) - | ((binder, rhs), to_drop) <- zipEqual "fi_bind" pairs to_drops ] + | ((binder, rhs), to_drop) <- zipEqual pairs to_drops ] ------------------ fiRhs :: Platform -> RevFloatInBinds -> CoreBndr -> CoreExprWithFVs -> CoreExpr @@ -821,7 +821,7 @@ | otherwise = floatIsCase bind || n_used_alts > 1 -- floatIsCase: see Note [Floating primops] - new_fork_boxes = zipWithEqual "FloatIn.sepBinds" insert_maybe + new_fork_boxes = zipWithEqual insert_maybe fork_boxes used_in_flags insert :: DropBox -> DropBox diff --git a/GHC/Core/Opt/OccurAnal.hs b/GHC/Core/Opt/OccurAnal.hs --- a/GHC/Core/Opt/OccurAnal.hs +++ b/GHC/Core/Opt/OccurAnal.hs @@ -9,9 +9,7 @@ -- many /other/ arguments the function has. Inconsistent unboxing is very -- bad for performance, so I increased the limit to allow it to unbox -- consistently. --- AK: Seems we no longer unbox OccEnv now anyway so it might be redundant. - {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -39,7 +37,6 @@ mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion -import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) @@ -67,6 +64,7 @@ import GHC.Unit.Module( Module ) import Data.List (mapAccumL) +import Data.List.NonEmpty (NonEmpty (..)) {- ************************************************************************ @@ -969,12 +967,6 @@ -> ([CoreBind] -> r -> r) -- How to combine the scope with new binds -> WithUsageDetails r -- Of the whole let(rec) --- AK: While not allocating any less inlining occAnalBind turns calls to the --- passed functions into known calls with all the benefits that brings. --- On a version of T26425 with 6k alternatives this improved compile --- by 10-20% with -O. -{-# INLINE occAnalBind #-} - occAnalBind env lvl ire (Rec pairs) thing_inside combine = addInScopeList env (map fst pairs) $ \env -> let WUD body_uds body' = thing_inside env @@ -992,7 +984,7 @@ = -- Analyse the RHS and /then/ the body let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs - rhs_uds = foldl1' orUDs rhs_uds_s -- NB: orUDs. See (W4) of + rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of -- Note [Occurrence analysis for join points] -- Now analyse the body, adding the join point @@ -1034,14 +1026,14 @@ ----------------- occAnalNonRecRhs :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> JoinPointHood -> Id -> CoreExpr - -> ([UsageDetails], Id, CoreExpr) + -> (NonEmpty UsageDetails, Id, CoreExpr) occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs | null rules, null imp_rule_infos = -- Fast path for common case of no rules. This is only worth -- 0.1% perf on average, but it's also only a line or two of code - ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) + ( adj_rhs_uds :| adj_unf_uds : [], final_bndr_no_rules, final_rhs ) | otherwise - = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) + = ( adj_rhs_uds :| adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where --------- Right hand side --------- -- For join points, set occ_encl to OccVanilla, via setTailCtxt. If we have @@ -1057,7 +1049,6 @@ -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs final_bndr_with_rules @@ -1813,7 +1804,7 @@ -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood mkLoopBreakerNodes !env lvl body_uds details_s - = WUD final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') + = WUD final_uds (zipWithEqual mk_lb_node details_s bndrs') where WUD final_uds bndrs' = tagRecBinders lvl body_uds details_s @@ -2063,18 +2054,6 @@ was a loop breaker last time round Hence the is_lb field of NodeScore - -Note [Strictness in the occurrence analyser] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -By carefully making the occurrence analyser strict in some places, we can -dramatically reduce its memory residency. Among other things we: -* Evaluate the result of `tagLamBinder` and friends, so that the binder (or its - OccInfo) does not retain the entire `UsageDetails`. Also use `strictMap` in `tagLamBinders`. -* In `combineUsageDetailsWith`, the fields of the data constructor are strict, and we use - `strictPlusVarEnv` on the maps that are bound to be needed later on to avoid thunks being - stored in the values. - -These measures reduced residency for test T26425 by a factor of at least 5x. -} {- ********************************************************************* @@ -2209,9 +2188,7 @@ go env rev_bndrs body = addInScope env rev_bndrs $ \env -> let !(WUD usage body') = occ_anal_lam_tail env body - -- See Note [Strictness in the occurrence analyser] - wrap_lam !body !bndr = let !bndr' = tagLamBinder usage bndr - in Lam bndr' body + wrap_lam body bndr = Lam (tagLamBinder usage bndr) body in WUD (usage `addLamCoVarOccs` rev_bndrs) (foldl' wrap_lam body' rev_bndrs) @@ -2523,7 +2500,7 @@ -- For a non-soft tick scope, we can inline lambdas only, so we -- abandon tail calls, and do markAllInsideLam too: usage_lam - | Breakpoint _ _ ids _ <- tickish + | Breakpoint _ _ ids <- tickish = -- Never substitute for any of the Ids in a Breakpoint addManyOccs usage_lam (mkVarSet ids) @@ -2564,8 +2541,7 @@ let alt_env = addBndrSwap scrut' bndr $ setTailCtxt env -- Kill off OccRhs WUD alts_usage alts' = do_alts alt_env alts - !tagged_bndr = tagLamBinder alts_usage bndr - -- See Note [Strictness in the occurrence analyser] + tagged_bndr = tagLamBinder alts_usage bndr in WUD alts_usage (tagged_bndr, alts') total_usage = markAllNonTail scrut_usage `andUDs` alts_usage @@ -2583,13 +2559,11 @@ do_alt !env (Alt con bndrs rhs) = addInScopeList env bndrs $ \ env -> let WUD rhs_usage rhs' = occAnal env rhs - !tagged_bndrs = tagLamBinders rhs_usage bndrs - -- See Note [Strictness in the occurrence analyser] + tagged_bndrs = tagLamBinders rhs_usage bndrs in -- See Note [Binders in case alternatives] WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) - -- TODO: Would be nice to use a strict version of mkLets here = occAnalBind env NotTopLevel noImpRuleEdges bind (\env -> occAnal env body) mkLets @@ -2670,12 +2644,10 @@ | fun `hasKey` runRWKey , [t1, t2, arg] <- args , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg - = let app_out = mkTicks ticks $ mkApps (Var fun) [t1, t2, arg'] - in WUD usage app_out + = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = let app_out = mkTicks ticks app' - in WUD all_uds app_out + = WUD all_uds (mkTicks ticks app') where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which @@ -2720,9 +2692,8 @@ -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = let app_out = mkTicks ticks app' - in WUD (markAllNonTail (fun_uds `andUDs` args_uds)) app_out - + = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) + (mkTicks ticks app') where !(WUD args_uds app') = occAnalArgs env fun' args [] !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun @@ -3356,8 +3327,8 @@ (BS5) We have to apply the occ_bs_env substitution uniformly, including to (local) rules and unfoldings. -(BS6) We must be very careful with dictionaries. - See Note [Care with binder-swap on dictionaries] +(BS6) For interest (only), + see Historical Note [Care with binder-swap on dictionaries] Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ @@ -3367,9 +3338,13 @@ equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. -Note [Care with binder-swap on dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This Note explains why we need isDictId in scrutOkForBinderSwap. +Historical Note [Care with binder-swap on dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note is now out-dated; it has been rendered irrelevant by +Note [Unary class magic] in GHC.Core.TyCon. I'm leaving it here in +case we are every tempted to return to newtype classes. + +This (historical) Note explains why we need isDictId in scrutOkForBinderSwap. Consider this tricky example (#21229, #21470): class Sing (b :: Bool) where sing :: Bool @@ -3415,6 +3390,16 @@ Hence the subtle isDictId in scrutOkForBinderSwap. +Why this Note is now outdated. Using Note [Unary class magic] in GHC.Core.TyCon +the program above becomes + h = \ @(a :: Bool) ($dSing :: Sing a) + case sing @a $dSing of (wild::Bool) + True -> f @'True $dSing + False -> f @a $dSing +so the issue of binder-swapping doesn't arise. + +End of Historical Note. + Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original @@ -3458,21 +3443,17 @@ -- If (scrutOkForBinderSwap e = DoBinderSwap v mco, then -- v = e |> mco -- See Note [Case of cast] --- See Note [Care with binder-swap on dictionaries] +-- See Historical Note [Care with binder-swap on dictionaries] -- -- We use this same function in SpecConstr, and Simplify.Iteration, -- when something binder-swap-like is happening -scrutOkForBinderSwap (Var v) = DoBinderSwap v MRefl -scrutOkForBinderSwap (Cast (Var v) co) - | not (isDictId v) = DoBinderSwap v (MCo (mkSymCo co)) - -- Cast: see Note [Case of cast] - -- isDictId: see Note [Care with binder-swap on dictionaries] - -- The isDictId rejects a Constraint/Constraint binder-swap, perhaps - -- over-conservatively. But I have never seen one, so I'm leaving - -- the code as simple as possible. Losing the binder-swap in a - -- rare case probably has very low impact. -scrutOkForBinderSwap (Tick _ e) = scrutOkForBinderSwap e -- Drop ticks -scrutOkForBinderSwap _ = NoBinderSwap +scrutOkForBinderSwap e + = case e of + Tick _ e -> scrutOkForBinderSwap e -- Drop ticks + Var v -> DoBinderSwap v MRefl + Cast (Var v) co -> DoBinderSwap v (MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + _ -> NoBinderSwap lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) -- See Note [The binder-swap substitution] @@ -3669,8 +3650,8 @@ ------------------- -- UsageDetails API -andUDs:: UsageDetails -> UsageDetails -> UsageDetails -orUDs :: UsageDetails -> UsageDetails -> UsageDetails +andUDs, orUDs + :: UsageDetails -> UsageDetails -> UsageDetails andUDs = combineUsageDetailsWith andLocalOcc orUDs = combineUsageDetailsWith orLocalOcc @@ -3785,13 +3766,10 @@ | isEmptyVarEnv env1 = uds2 | isEmptyVarEnv env2 = uds1 | otherwise - -- See Note [Strictness in the occurrence analyser] - -- Using strictPlusVarEnv here speeds up the test T26425 by about 10% by avoiding - -- intermediate thunks. - = UD { ud_env = strictPlusVarEnv_C plus_occ_info env1 env2 - , ud_z_many = strictPlusVarEnv z_many1 z_many2 + = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = plusVarEnv z_many1 z_many2 , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 - , ud_z_tail = strictPlusVarEnv z_tail1 z_tail2 } + , ud_z_tail = plusVarEnv z_tail1 z_tail2 } lookupLetOccInfo :: UsageDetails -> Id -> OccInfo -- Don't use locally-generated occ_info for exported (visible-elsewhere) @@ -3869,8 +3847,7 @@ -> [Id] -- Binders -> [IdWithOccInfo] -- Tagged binders tagLamBinders usage binders - -- See Note [Strictness in the occurrence analyser] - = strictMap (tagLamBinder usage) binders + = map (tagLamBinder usage) binders tagLamBinder :: UsageDetails -- Of scope -> Id -- Binder @@ -3879,7 +3856,6 @@ -- No-op on TyVars -- A lambda binder never has an unfolding, so no need to look for that tagLamBinder usage bndr - -- See Note [Strictness in the occurrence analyser] = setBinderOcc (markNonTail occ) bndr -- markNonTail: don't try to make an argument into a join point where diff --git a/GHC/Core/Opt/Pipeline.hs b/GHC/Core/Opt/Pipeline.hs --- a/GHC/Core/Opt/Pipeline.hs +++ b/GHC/Core/Opt/Pipeline.hs @@ -22,7 +22,7 @@ import GHC.Core import GHC.Core.Opt.CSE ( cseProgram ) -import GHC.Core.Rules ( RuleBase, mkRuleBase, ruleCheckProgram, getRules ) +import GHC.Core.Rules ( RuleBase, ruleCheckProgram, getRules ) import GHC.Core.Ppr ( pprCoreBindings ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) @@ -76,7 +76,8 @@ core2core hsc_env guts@(ModGuts { mg_module = mod , mg_loc = loc , mg_rdr_env = rdr_env }) - = do { let builtin_passes = getCoreToDo dflags hpt_rule_base extra_vars + = do { hpt_rule_base <- home_pkg_rules + ; let builtin_passes = getCoreToDo dflags hpt_rule_base extra_vars uniq_tag = 's' ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_tag mod @@ -96,11 +97,11 @@ where dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env + unit_env = hsc_unit_env hsc_env extra_vars = interactiveInScope (hsc_IC hsc_env) - home_pkg_rules = hptRules hsc_env (moduleUnitId mod) (GWIB { gwib_mod = moduleName mod - , gwib_isBoot = NotBoot }) - hpt_rule_base = mkRuleBase home_pkg_rules - name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env + home_pkg_rules = hugRulesBelow hsc_env (moduleUnitId mod) + (GWIB { gwib_mod = moduleName mod, gwib_isBoot = NotBoot }) + name_ppr_ctx = mkNamePprCtx ptc unit_env rdr_env ptc = initPromotionTickContext dflags -- mod: get the module out of the current HscEnv so we can retrieve it from the monad. -- This is very convienent for the users of the monad (e.g. plugins do not have to diff --git a/GHC/Core/Opt/SetLevels.hs b/GHC/Core/Opt/SetLevels.hs --- a/GHC/Core/Opt/SetLevels.hs +++ b/GHC/Core/Opt/SetLevels.hs @@ -91,7 +91,6 @@ import GHC.Core.Opt.Arity ( exprBotStrictness_maybe, isOneShotBndr ) import GHC.Core.FVs -- all of it import GHC.Core.Subst -import GHC.Core.TyCo.Subst( lookupTyVar ) import GHC.Core.Make ( sortQuantVars ) import GHC.Core.Type ( Type, tyCoVarsOfType , mightBeUnliftedType, closeOverKindsDSet @@ -467,8 +466,8 @@ ty' = substTyUnchecked (le_subst env) ty incd_lvl = incMinorLvl (le_ctxt_lvl env) - dest_lvl = maxFvLevel includeTyVars env scrut_fvs - -- Don't abstract over type variables, hence includeTyVars + dest_lvl = maxFvLevel (const True) env scrut_fvs + -- Don't abstract over type variables, hence const True lvl_alt alts_env (AnnAlt con bs rhs) = do { rhs' <- lvlMFE new_env True rhs @@ -615,7 +614,8 @@ = lvlExpr env e -- See Note [Case MFEs] lvlMFE env strict_ctxt ann_expr - | not float_me + | notWorthFloating expr abs_vars + || not float_me || floatTopLvlOnly env && not (isTopLvl dest_lvl) -- Only floating to the top level is allowed. || hasFreeJoin env fvs -- If there is a free join, don't float @@ -624,9 +624,6 @@ -- We can't let-bind an expression if we don't know -- how it will be represented at runtime. -- See Note [Representation polymorphism invariants] in GHC.Core - || notWorthFloating expr abs_vars - -- Test notWorhtFloating last; - -- See Note [Large free-variable sets] = -- Don't float it out lvlExpr env ann_expr @@ -699,11 +696,14 @@ -- A decision to float entails let-binding this thing, and we only do -- that if we'll escape a value lambda, or will go to the top level. + -- Never float trivial expressions; + -- notably, save_work might be true of a lone evaluated variable. float_me = saves_work || saves_alloc || is_mk_static -- See Note [Saving work] + is_hnf = exprIsHNF expr saves_work = escapes_value_lam -- (a) - && not (exprIsHNF expr) -- (b) + && not is_hnf -- (b) && not float_is_new_lam -- (c) escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env) @@ -711,7 +711,7 @@ saves_alloc = isTopLvl dest_lvl && floatConsts env && ( not strict_ctxt -- (a) - || exprIsHNF expr -- (b) + || is_hnf -- (b) || (is_bot_lam && escapes_value_lam)) -- (c) hasFreeJoin :: LevelEnv -> DVarSet -> Bool @@ -719,11 +719,8 @@ -- (In the latter case it won't be a join point any more.) -- Not treating top-level ones specially had a massive effect -- on nofib/minimax/Prog.prog -hasFreeJoin env fvs = anyDVarSet bad_join fvs - where - bad_join v = isJoinId v && - maxIn True env v tOP_LEVEL /= tOP_LEVEL - +hasFreeJoin env fvs + = not (maxFvLevel isJoinId env fvs == tOP_LEVEL) {- Note [Saving work] ~~~~~~~~~~~~~~~~~~~~~ @@ -811,7 +808,7 @@ * We don't pay an allocation cost for the floated expression; it just becomes static data. -* Floating string literal is valuable -- no point in duplicating the +* Floating string literals is valuable -- no point in duplicating the at each call site! * Floating bottoming expressions is valuable: they are always cold @@ -872,28 +869,6 @@ important in some nofib programs (gcd is an example). [SPJ note: I think this is obsolete; the flag seems always on.] -Note [Large free-variable sets] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #24471 we had something like - x1 = I# 1 - ... - x1000 = I# 1000 - foo = f x1 (f x2 (f x3 ....)) -So every sub-expression in `foo` has lots and lots of free variables. But -none of these sub-expressions float anywhere; the entire float-out pass is a -no-op. - -In lvlMFE, we want to find out quickly if the MFE is not-floatable; that is -the common case. In #24471 it turned out that we were testing `abs_vars` (a -relatively complicated calculation that takes at least O(n-free-vars) time to -compute) for every sub-expression. - -Better instead to test `float_me` early. That still involves looking at -dest_lvl, which means looking at every free variable, but the constant factor -is a lot better. - -ToDo: find a way to fix the bad asymptotic complexity. - Note [Floating join point bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Mostly we don't float join points at all -- we want them to /stay/ join points. @@ -1139,7 +1114,6 @@ either, so fusion will happen. It can be a big effect, esp in some artificial benchmarks (e.g. integer, queens), but there is no perfect answer. - -} annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig, CprSig) -> Id @@ -1156,69 +1130,133 @@ = id notWorthFloating :: CoreExpr -> [Var] -> Bool --- Returns True if the expression would be replaced by --- something bigger than it is now. For example: --- abs_vars = tvars only: return True if e is trivial, --- but False for anything bigger --- abs_vars = [x] (an Id): return True for trivial, or an application (f x) --- but False for (f x x) --- --- One big goal is that floating should be idempotent. Eg if --- we replace e with (lvl79 x y) and then run FloatOut again, don't want --- to replace (lvl79 x y) with (lvl83 x y)! - +-- See Note [notWorthFloating] notWorthFloating e abs_vars - = go e (count isId abs_vars) + = go e 0 where - go (Var {}) n = n >= 0 - go (Lit lit) n = assert (n==0) $ - litIsTrivial lit -- Note [Floating literals] - go (Type {}) _ = True - go (Coercion {}) _ = True + n_abs_vars = count isId abs_vars -- See (NWF5) + + go :: CoreExpr -> Int -> Bool + -- (go e n) return True if (e x1 .. xn) is not worth floating + -- where `e` has n trivial value arguments x1..xn + -- See (NWF4) + go (Lit lit) n = (n==0) -- See (NWF1b) + && litIsTrivial lit -- See (NWF1a) + go (Type {}) _ = True + go (Tick t e) n = not (tickishIsCode t) && go e n + go (Cast e _) n = n==0 || go e n -- See (NWF3) + go (Coercion {}) _ = True go (App e arg) n - -- See Note [Floating applications to coercions] - | not (isRuntimeArg arg) = go e n - | n==0 = False - | exprIsTrivial arg = go e (n-1) -- NB: exprIsTrivial arg = go arg 0 - | otherwise = False - go (Tick t e) n = not (tickishIsCode t) && go e n - go (Cast e _) n = go e n - go (Case e b _ as) n + | Type {} <- arg = go e n -- Just types, not coercions (NWF2) + | exprIsTrivial arg = go e (n+1) + | otherwise = n==0 && exprIsUnaryClassFun e + -- (f non-triv) is worth floating, + -- unless if is a unary class fun + go (Case e b _ as) _ + -- Do not float the `case` part of trivial cases (NWF3) + -- We'll have a look at the RHS when we get there | null as - = go e n -- See Note [Empty case is trivial] - | Just rhs <- isUnsafeEqualityCase e b as - = go rhs n -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce - go _ _ = False + = True -- See Note [Empty case is trivial] + | Just {} <- isUnsafeEqualityCase e b as + = True -- See (U2) of Note [Implementing unsafeCoerce] in base:Unsafe.Coerce + | otherwise + = False -{- -Note [Floating literals] -~~~~~~~~~~~~~~~~~~~~~~~~ -It's important to float Integer literals, so that they get shared, -rather than being allocated every time round the loop. -Hence the litIsTrivial. + go (Var v) n + | isUnaryClassId v = n==1 -- (op x) is not worth floating, but (op x y) is!! + -- See (NWF3) + | n==0 = True -- Naked variable + | n <= n_abs_vars = True -- (f a b c) is not worth floating if + | otherwise = False -- a,b,c are all abstracted; see (NWF5) -Ditto literal strings (LitString), which we'd like to float to top -level, which is now possible. + go _ _ = False -- Let etc is worth floating -Note [Floating applications to coercions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don’t float out variables applied only to type arguments, since the -extra binding would be pointless: type arguments are completely erased. -But *coercion* arguments aren’t (see Note [Coercion tokens] in -"GHC.CoreToStg" and Note [Count coercion arguments in boring contexts] in -"GHC.Core.Unfold"), so we still want to float out variables applied only to -coercion arguments. +{- Note [notWorthFloating] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +`notWorthFloating` returns True if the expression would be replaced by something +bigger than it is now. One big goal is that floating should be idempotent. Eg +if we replace e with (lvl79 x y) and then run FloatOut again, don't want to +replace (lvl79 x y) with (lvl83 x y)! +For example: + abs_vars = tvars only: return True if e is trivial, + but False for anything bigger + abs_vars = [x] (an Id): return True for trivial, or an application (f x) + but False for (f x x) -************************************************************************ -* * -\subsection{Bindings} -* * -************************************************************************ +(NWF1a) It's important to float Integer literals, so that they get shared, rather + than being allocated every time round the loop. Hence the litIsTrivial. -The binding stuff works for top level too. + Ditto literal strings (LitString), which we'd like to float to top + level, which is now possible. + +(NWF1b) You might think that a literal should never be applied to a value + (hence n=0) but actually we can get (see test T23024): + RUBBISH @(a->b) (x::a) + See Note [Rubbish literals] in GHC.Types.Literal. (Mind you, we should be + in dead code at this point!) + +(NWF2) We don’t float out variables applied only to type arguments, since the + extra binding would be pointless: type arguments are completely erased. + But *coercion* arguments aren’t (see Note [Coercion tokens] in + "GHC.CoreToStg" and Note [inlineBoringOk] in"GHC.Core.Unfold"), + so we still want to float out variables applied only to + coercion arguments. + +(NWF3) Some expressions have trivial wrappers: + - Casts (e |> co) + - Unary-class applications: + - Dictionary applications (MkC meth) + - Class-op applictions (op dict) + - Case of empty alts + - Unsafe-equality case + In all these cases we say "not worth floating", and we do so /regardless/ + of the wrapped expression. The SetLevels stuff may subsequently float the + components of the expression. + + Example: is it worth floating (f x |> co)? No! If we did we'd get + lvl = f x |> co + ...lvl.... + Then we'd do cast worker/wrapper and end up with. + lvl' = f x + ...(lvl' |> co)... + Silly! Better not to float it in the first place. If we say "no" here, + we'll subsequently say "yes" for (f x) and get + lvl = f x + ....(lvl |> co)... + which is what we want. In short: don't float trivial wrappers. + +(NWF4) The only non-trivial expression that we say "not worth floating" for + is an application + f x y z + where the number of value arguments is <= the number of abstracted Ids. + This is what makes floating idempotent. Hence counting the number of + value arguments in `go` + +(NWF5) In #24471 we had something like + x1 = I# 1 + ... + x1000 = I# 1000 + foo = f x1 (f x2 (f x3 ....)) + So every sub-expression in `foo` has lots and lots of free variables. But + none of these sub-expressions float anywhere; the entire float-out pass is a + no-op. + + So `notWorthFloating` tries to avoid evaluating `n_abs_vars`, in cases where + it obviously /is/ worth floating. (In #24471 it turned out that we were + testing `abs_vars` (a relatively complicated calculation that takes at least + O(n-free-vars) time to compute) for every sub-expression.) + + Hence testing `n_abs_vars only` at the very end. -} +{- ********************************************************************* +* * + Bindings + This binding stuff works for top level too. +* * +********************************************************************* -} + lvlBind :: LevelEnv -> CoreBindWithFVs -> LvlM (LevelledBind, LevelEnv) @@ -1569,10 +1607,10 @@ | otherwise = max_fv_id_level where - max_fv_id_level = maxFvLevel idsOnly env fvs -- Max over Ids only; the - -- tyvars will be abstracted + max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the + -- tyvars will be abstracted - as_far_as_poss = maxFvLevel' idsOnly env fvs_ty + as_far_as_poss = maxFvLevel' isId env fvs_ty -- See Note [Floating and kind casts] {- Note [Floating and kind casts] @@ -1730,47 +1768,28 @@ , le_env = add_id id_env (case_bndr, scrut_var) } extendCaseBndrEnv env _ _ = env -includeTyVars, idsOnly :: Bool -idsOnly = False -includeTyVars = True - -maxFvLevel :: Bool -> LevelEnv -> DVarSet -> Level -maxFvLevel include_tyvars env var_set - = nonDetStrictFoldDVarSet (maxIn include_tyvars env) tOP_LEVEL var_set +maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level +maxFvLevel max_me env var_set + = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set -- It's OK to use a non-deterministic fold here because maxIn commutes. -maxFvLevel' :: Bool -> LevelEnv -> TyCoVarSet -> Level +maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level -- Same but for TyCoVarSet -maxFvLevel' include_tyvars env var_set - = nonDetStrictFoldUniqSet (maxIn include_tyvars env) tOP_LEVEL var_set +maxFvLevel' max_me env var_set + = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set -- It's OK to use a non-deterministic fold here because maxIn commutes. -maxIn :: Bool -> LevelEnv -> InVar -> Level -> Level --- True <=> include tyvars -maxIn include_tyvars env@(LE { le_subst = subst, le_env = id_env }) in_var lvl - | isId in_var +maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level +maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl = case lookupVarEnv id_env in_var of - Nothing -> maxOut env in_var lvl Just (abs_vars, _) -> foldr max_out lvl abs_vars - where - max_out out_var lvl - | isTyVar out_var && not include_tyvars - = lvl - | otherwise = maxOut env out_var lvl - - | include_tyvars -- TyVars - = case lookupTyVar subst in_var of - Just ty -> nonDetStrictFoldVarSet (maxOut env) lvl (tyCoVarsOfType ty) - Nothing -> maxOut env in_var lvl - - | otherwise -- Ignore free tyvars - = lvl - -maxOut :: LevelEnv -> OutVar -> Level -> Level -maxOut (LE { le_lvl_env = lvl_env }) out_var lvl - = case lookupVarEnv lvl_env out_var of - Just lvl' -> maxLvl lvl' lvl - Nothing -> lvl + Nothing -> max_out in_var lvl + where + max_out out_var lvl + | max_me out_var = case lookupVarEnv lvl_env out_var of + Just lvl' -> maxLvl lvl' lvl + Nothing -> lvl + | otherwise = lvl -- Ignore some vars depending on max_me lookupVar :: LevelEnv -> Id -> LevelledExpr lookupVar le v = case lookupVarEnv (le_env le) v of @@ -1877,7 +1896,7 @@ cloneCaseBndrs :: LevelEnv -> Level -> [Var] -> LvlM (LevelEnv, [Var]) cloneCaseBndrs env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env }) new_lvl vs - = do { (subst', vs') <- cloneBndrs subst vs + = do { (subst', vs') <- cloneBndrsM subst vs -- N.B. We are not moving the body of the case, merely its case -- binders. Consequently we should *not* set le_ctxt_lvl. -- See Note [Setting levels when floating single-alternative cases]. @@ -1898,8 +1917,8 @@ dest_lvl vs = do { let vs1 = map zap vs ; (subst', vs2) <- case is_rec of - NonRecursive -> cloneBndrs subst vs1 - Recursive -> cloneRecIdBndrs subst vs1 + NonRecursive -> cloneBndrsM subst vs1 + Recursive -> cloneRecIdBndrsM subst vs1 ; let prs = vs `zip` vs2 env' = env { le_lvl_env = addLvls dest_lvl lvl_env vs2 diff --git a/GHC/Core/Opt/Simplify/Env.hs b/GHC/Core/Opt/Simplify/Env.hs --- a/GHC/Core/Opt/Simplify/Env.hs +++ b/GHC/Core/Opt/Simplify/Env.hs @@ -8,14 +8,13 @@ module GHC.Core.Opt.Simplify.Env ( -- * The simplifier mode - SimplMode(..), updMode, - smPedanticBottoms, smPlatform, + SimplMode(..), updMode, smPlatform, -- * Environments SimplEnv(..), pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, - seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, + seOptCoercionOpts, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, extendCvIdSubst, extendTvSubst, extendCvSubst, @@ -25,13 +24,15 @@ getSimplRules, enterRecGroupRHSs, reSimplifying, + SimplEnvIS, checkSimplEnvIS, pprBadSimplEnvIS, + -- * Substitution results SimplSR(..), mkContEx, substId, lookupRecBndr, -- * Simplifying 'Id' binders simplNonRecBndr, simplNonRecJoinBndr, simplRecBndrs, simplRecJoinBndrs, simplBinder, simplBinders, - substTy, substTyVar, getSubst, + substTy, substTyVar, getFullSubst, getTCvSubst, substCo, substCoVar, -- * Floats @@ -59,8 +60,9 @@ import GHC.Core.Rules.Config ( RuleOpts(..) ) import GHC.Core import GHC.Core.Utils +import GHC.Core.Subst( substExprSC ) import GHC.Core.Unfold -import GHC.Core.TyCo.Subst (emptyIdSubstEnv) +import GHC.Core.TyCo.Subst (emptyIdSubstEnv, mkSubst) import GHC.Core.Multiplicity( Scaled(..), mkMultMul ) import GHC.Core.Make ( mkWildValBinder, mkCoreLet ) import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo @@ -202,6 +204,19 @@ -- See Note [Inline depth] } +type SimplEnvIS = SimplEnv + -- Invariant: the substitution is empty + -- We want this SimplEnv for its InScopeSet and flags + +checkSimplEnvIS :: SimplEnvIS -> Bool +-- Check the invariant for SimplEnvIS +checkSimplEnvIS (SimplEnv { seIdSubst = id_env, seTvSubst = tv_env, seCvSubst = cv_env }) + = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env + +pprBadSimplEnvIS :: SimplEnvIS -> SDoc +-- Print a SimplEnv that fails checkSimplEnvIS +pprBadSimplEnvIS env = ppr (getFullSubst (seInScope env) env) + seArityOpts :: SimplEnv -> ArityOpts seArityOpts env = sm_arity_opts (seMode env) @@ -235,9 +250,6 @@ seOptCoercionOpts :: SimplEnv -> OptCoercionOpts seOptCoercionOpts env = sm_co_opt_opts (seMode env) -sePedanticBottoms :: SimplEnv -> Bool -sePedanticBottoms env = smPedanticBottoms (seMode env) - sePhase :: SimplEnv -> CompilerPhase sePhase env = sm_phase (seMode env) @@ -292,9 +304,6 @@ where pp_flag f s = ppUnless f (text "no") <+> s -smPedanticBottoms :: SimplMode -> Bool -smPedanticBottoms opts = ao_ped_bot (sm_arity_opts opts) - smPlatform :: SimplMode -> Platform smPlatform opts = roPlatform (sm_rule_opts opts) @@ -1265,33 +1274,47 @@ ************************************************************************ -} -getSubst :: SimplEnv -> Subst -getSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env }) - = mkTCvSubst in_scope tv_env cv_env +getTCvSubst :: SimplEnv -> Subst +getTCvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env }) + = mkSubst in_scope emptyVarEnv tv_env cv_env +getFullSubst :: InScopeSet -> SimplEnv -> Subst +getFullSubst in_scope (SimplEnv { seIdSubst = id_env, seTvSubst = tv_env, seCvSubst = cv_env }) + = mk_full_subst in_scope tv_env cv_env id_env + +mk_full_subst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> Subst +mk_full_subst in_scope tv_env cv_env id_env + = mkSubst in_scope (mapVarEnv to_expr id_env) tv_env cv_env + where + to_expr :: SimplSR -> CoreExpr + -- A tiresome impedence-matcher + to_expr (DoneEx e _) = e + to_expr (DoneId v) = Var v + to_expr (ContEx tvs cvs ids e) = GHC.Core.Subst.substExprSC (mk_full_subst in_scope tvs cvs ids) e + substTy :: HasDebugCallStack => SimplEnv -> Type -> Type -substTy env ty = Type.substTy (getSubst env) ty +substTy env ty = Type.substTy (getTCvSubst env) ty substTyVar :: SimplEnv -> TyVar -> Type -substTyVar env tv = Type.substTyVar (getSubst env) tv +substTyVar env tv = Type.substTyVar (getTCvSubst env) tv substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar) substTyVarBndr env tv - = case Type.substTyVarBndr (getSubst env) tv of + = case Type.substTyVarBndr (getTCvSubst env) tv of (Subst in_scope' _ tv_env' cv_env', tv') -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, tv') substCoVar :: SimplEnv -> CoVar -> Coercion -substCoVar env tv = Coercion.substCoVar (getSubst env) tv +substCoVar env tv = Coercion.substCoVar (getTCvSubst env) tv substCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar) substCoVarBndr env cv - = case Coercion.substCoVarBndr (getSubst env) cv of + = case Coercion.substCoVarBndr (getTCvSubst env) cv of (Subst in_scope' _ tv_env' cv_env', cv') -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, cv') substCo :: SimplEnv -> Coercion -> Coercion -substCo env co = Coercion.substCo (getSubst env) co +substCo env co = Coercion.substCo (getTCvSubst env) co ------------------ substIdType :: SimplEnv -> Id -> Id @@ -1307,4 +1330,4 @@ no_free_vars = noFreeVarsOfType old_ty && noFreeVarsOfType old_w subst = Subst in_scope emptyIdSubstEnv tv_env cv_env old_ty = idType id - old_w = varMult id + old_w = idMult id diff --git a/GHC/Core/Opt/Simplify/Iteration.hs b/GHC/Core/Opt/Simplify/Iteration.hs --- a/GHC/Core/Opt/Simplify/Iteration.hs +++ b/GHC/Core/Opt/Simplify/Iteration.hs @@ -8,7 +8,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules ) where import GHC.Prelude @@ -31,9 +30,6 @@ import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon - ( DataCon, dataConWorkId, dataConRepStrictness - , dataConRepArgTys, isUnboxedTupleDataCon - , StrictnessMark (..), dataConWrapId_maybe ) import GHC.Core.Opt.Stats ( Tick(..) ) import GHC.Core.Ppr ( pprCoreExpr ) import GHC.Core.Unfold @@ -72,6 +68,7 @@ import GHC.Utils.Misc import Control.Monad +import Data.List.NonEmpty (NonEmpty (..)) {- The guts of the simplifier is in this module, but the driver loop for @@ -284,7 +281,7 @@ | Just env' <- preInlineUnconditionally env (bindContextLevel bind_cxt) old_bndr rhs env = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-} - simplTrace "SimplBindr:inline-uncond" (ppr old_bndr) $ + simplTrace "SimplBindr:inline-uncond1" (ppr old_bndr) $ do { tick (PreInlineUnconditionally old_bndr) ; return ( emptyFloats env, env' ) } @@ -474,14 +471,14 @@ Wrinkles -(CWW1) We must /not/ do cast w/w on +1. We must /not/ do cast w/w on f = g |> co otherwise it'll just keep repeating forever! You might think this is avoided because the call to tryCastWorkerWrapper is guarded by - preInlineUnconditionally, but I'm worried that a loop-breaker or an - exported Id might say False to preInlineUnconditionally. + preInlineUnconditinally, but I'm worried that a loop-breaker or an + exported Id might say False to preInlineUnonditionally. -(CWW2) We need to be careful with inline/noinline pragmas: +2. We need to be careful with inline/noinline pragmas: rec { {-# NOINLINE f #-} f = (...g...) |> co ; g = ...f... } @@ -496,15 +493,15 @@ f = $wf |> co ; g = ...f... } and that is bad: the whole point is that we want to inline that - cast! We want to transfer the pragma to $wf: + cast! We want to transfer the pagma to $wf: rec { {-# NOINLINE $wf #-} $wf = ...g... ; f = $wf |> co ; g = ...f... } c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap. -(CWW3) We should still do cast w/w even if `f` is INLINEABLE. E.g. - {- f: Stable unfolding (arity 2) = -} +3. We should still do cast w/w even if `f` is INLINEABLE. E.g. + {- f: Stable unfolding = -} f = (\xy. ) |> co Then we want to w/w to {- $wf: Stable unfolding = |> sym co -} @@ -513,43 +510,15 @@ Notice that the stable unfolding moves to the worker! Now demand analysis will work fine on $wf, whereas it has trouble with the original f. c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. - -(CWW4) We should /not/ do cast w/w for INLINE functions (hence `hasInlineUnfolding` - in `tryCastWorkerWrapper`) because they'll definitely be inlined anyway, cast - and all. + This point also applies to strong loopbreakers with INLINE pragmas, see + wrinkle (4). - Moreover, if we do cast w/w for an INLINE function with arity zero, we get +4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence + hasInlineUnfolding in tryCastWorkerWrapper, which responds False to + loop-breakers) because they'll definitely be inlined anyway, cast and + all. And if we do cast w/w for an INLINE function with arity zero, we get something really silly: we inline that "worker" right back into the wrapper! - In fact it is Much Worse than a no-op, because we have then lost the stable - unfolding --- aargh (see #26903). E.g. similar example to (CWW3) - {- g: Stable unfolding (arity 0) = -} NB arity 0! - g = (\xy. ) |> co - If we w/w to this: - {- $wg: Stable unfolding (arity 0) = |> sym co -} - $wg = \xy. - g = $wg |> co - then we'll inline $wg at the call site in `g` giving - {- $wg: Stable unfolding (arity 0) = |> sym co -} - $wg = \xy. - g = ( |> sym co) |> co - and now we'll drop `$wg` as dead and we have lost the unfolding on `g`. - (We could /also/ give the binding `g = $wf |> co` a stable unfolding. Then - things would work right; but there is also no point in doing the cast - worker/wrapper in the first place.) - - NB: you might wonder about a loop-breaker with an INLINE pragma; after all, a - loop breaker won't "definitely be inlined anyway", so arguably we should not - disable cast w/w/ for it. But a Rec group can /look/ recursive at an early - stage, and subsequently /become/ non-recursive after some simplification. - (This is common in instance decls; see Note [Checking for INLINE loop breakers] - in GHC.Core.Lint.) So the danger is that we'll permanently lose that stable - unfolding that we specifically wanted (#26903). Simple solution: disable cast - w/w for /any/ INLINE function. See the defn - of `GHC.Types.Id.Info.hasInlineUnfolding`. - - The danger is that an INLINE pragma on a genuninely-recursive function - will kill worker-wrapper. Well, so be it. They are pretty suspicious anyway; - see Note [Checking for INLINE loop breakers]. + Worse than a no-op, because we have then lost the stable unfolding. All these wrinkles are exactly like worker/wrapper for strictness analysis: f is the wrapper and must inline like crazy @@ -614,11 +583,11 @@ | BC_Let top_lvl is_rec <- bind_cxt -- Not join points , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform -- a DFunUnfolding in mk_worker_unfolding - , not (exprIsTrivial rhs) -- Not x = y |> co; see (CWW1) - , not (hasInlineUnfolding info) -- Not INLINE things: see (CWW4) - , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would - -- lose the underlying runtime representation. - -- See Note [Preserve RuntimeRep info in cast w/w] + , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 + , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4 + , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would + -- lose the underlying runtime representation. + -- See Note [Preserve RuntimeRep info in cast w/w] , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings -- See Note [OPAQUE pragma] = do { uniq <- getUniqueM @@ -665,13 +634,13 @@ `setArityInfo` work_arity -- We do /not/ want to transfer OccInfo, Rules -- Note [Preserve strictness in cast w/w] - -- and (CWW2) of Note [Cast worker/wrapper] + -- and Wrinkle 2 of Note [Cast worker/wrapper] ----------- Worker unfolding ----------- -- Stable case: if there is a stable unfolding we have to compose with (Sym co); -- the next round of simplification will do the job -- Non-stable case: use work_rhs - -- See (CWW4) of Note [Cast worker/wrapper] + -- Wrinkle 3 of Note [Cast worker/wrapper] mk_worker_unfolding top_lvl work_id work_rhs = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) @@ -830,8 +799,8 @@ makeTrivialArg env arg@(ValArg { as_arg = e, as_dmd = dmd }) = do { (floats, e') <- makeTrivial env NotTopLevel dmd (fsLit "arg") e ; return (floats, arg { as_arg = e' }) } -makeTrivialArg _ arg - = return (emptyLetFloats, arg) -- CastBy, TyArg +makeTrivialArg _ arg@(TyArg {}) + = return (emptyLetFloats, arg) makeTrivial :: HasDebugCallStack => SimplEnv -> TopLevelFlag -> Demand @@ -1190,14 +1159,14 @@ -> SimplM (SimplFloats, OutExpr) simplExprF !env e !cont -- See Note [Bangs in the Simplifier] - = {- pprTrace "simplExprF" (vcat - [ ppr e - , text "cont =" <+> ppr cont - , text "inscope =" <+> ppr (seInScope env) - , text "tvsubst =" <+> ppr (seTvSubst env) - , text "idsubst =" <+> ppr (seIdSubst env) - , text "cvsubst =" <+> ppr (seCvSubst env) - ]) $ -} + = -- pprTrace "simplExprF" (vcat + -- [ ppr e + -- , text "cont =" <+> ppr cont + -- , text "inscope =" <+> ppr (seInScope env) + -- , text "tvsubst =" <+> ppr (seTvSubst env) + -- , text "idsubst =" <+> ppr (seIdSubst env) + -- , text "cvsubst =" <+> ppr (seCvSubst env) + -- ]) $ simplExprF1 env e cont simplExprF1 :: HasDebugCallStack @@ -1210,7 +1179,7 @@ -- The (Type ty) case is handled separately by simplExpr -- and by the other callers of simplExprF -simplExprF1 env (Var v) cont = {-#SCC "simplIdF" #-} simplIdF env v cont +simplExprF1 env (Var v) cont = {-#SCC "simplInId" #-} simplInId env v cont simplExprF1 env (Lit lit) cont = {-#SCC "rebuild" #-} rebuild env (Lit lit) cont simplExprF1 env (Tick t expr) cont = {-#SCC "simplTick" #-} simplTick env t expr cont simplExprF1 env (Cast body co) cont = {-#SCC "simplCast" #-} simplCast env body co cont @@ -1283,7 +1252,8 @@ | Just env' <- preInlineUnconditionally env NotTopLevel bndr rhs env -- Because of the let-can-float invariant, it's ok to -- inline freely, or to drop the binding if it is dead. - = do { tick (PreInlineUnconditionally bndr) + = do { simplTrace "SimplBindr:inline-uncond2" (ppr bndr) $ + tick (PreInlineUnconditionally bndr) ; simplExprF env' body cont } -- Now check for a join point. It's better to do the preInlineUnconditionally @@ -1388,7 +1358,7 @@ -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env ; seqCo opt_co `seq` return opt_co } where - subst = getSubst env + subst = getTCvSubst env opts = seOptCoercionOpts env ----------------------------------- @@ -1491,8 +1461,8 @@ simplTickish env tickish - | Breakpoint ext n ids modl <- tickish - = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl + | Breakpoint ext bid ids <- tickish + = Breakpoint ext bid (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick @@ -1550,14 +1520,18 @@ -} rebuild :: SimplEnv -> OutExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) --- At this point the substitution in the SimplEnv should be irrelevant; --- only the in-scope set matters -rebuild env expr cont - = case cont of +rebuild env expr cont = rebuild_go (zapSubstEnv env) expr cont + +rebuild_go :: SimplEnvIS -> OutExpr -> SimplCont -> SimplM (SimplFloats, OutExpr) +-- SimplEnvIS: at this point the substitution in the SimplEnv is irrelevant; +-- only the in-scope set matters, plus the flags. +rebuild_go env expr cont + = assertPpr (checkSimplEnvIS env) (pprBadSimplEnvIS env) $ + case cont of Stop {} -> return (emptyFloats env, expr) - TickIt t cont -> rebuild env (mkTick t expr) cont + TickIt t cont -> rebuild_go env (mkTick t expr) cont CastIt { sc_co = co, sc_opt = opt, sc_cont = cont } - -> rebuild env (mkCast expr co') cont + -> rebuild_go env (mkCast expr co') cont -- NB: mkCast implements the (Coercion co |> g) optimisation where co' = optOutCoercion env co opt @@ -1566,20 +1540,20 @@ -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty } - -> rebuildCall env (addValArgTo fun expr fun_ty ) cont + -> rebuildCall env (addValArgTo fun expr fun_ty) cont StrictBind { sc_bndr = b, sc_body = body, sc_env = se , sc_cont = cont, sc_from = from_what } -> completeBindX (se `setInScopeFromE` env) from_what b expr body cont ApplyToTy { sc_arg_ty = ty, sc_cont = cont} - -> rebuild env (App expr (Type ty)) cont + -> rebuild_go env (App expr (Type ty)) cont ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag , sc_cont = cont, sc_hole_ty = fun_ty } -- See Note [Avoid redundant simplification] -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing se arg - ; rebuild env (App expr arg') cont } + ; rebuild_go env (App expr arg') cont } completeBindX :: SimplEnv -> FromWhat @@ -1689,7 +1663,7 @@ -} -optOutCoercion :: SimplEnv -> OutCoercion -> Bool -> OutCoercion +optOutCoercion :: SimplEnvIS -> OutCoercion -> Bool -> OutCoercion -- See Note [Avoid re-simplifying coercions] optOutCoercion env co already_optimised | already_optimised = co -- See Note [Avoid re-simplifying coercions] @@ -1731,7 +1705,6 @@ , sc_hole_ty = coercionLKind co }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) - -- (f |> co) e ===> (f (e |> co1)) |> co2 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 @@ -1740,7 +1713,7 @@ , sc_dup = dup, sc_cont = tail , sc_hole_ty = fun_ty }) | not opt -- pushCoValArg duplicates the coercion, so optimise first - = addCoerce (optOutCoercion env co opt) True cont + = addCoerce (optOutCoercion (zapSubstEnv env) co opt) True cont | Just (m_co1, m_co2) <- pushCoValArg co , fixed_rep m_co1 @@ -1778,7 +1751,8 @@ -- See Note [Representation polymorphism invariants] in GHC.Core -- test: typecheck/should_run/EtaExpandLevPoly -simplLazyArg :: SimplEnv -> DupFlag +simplLazyArg :: SimplEnvIS -- ^ Used only for its InScopeSet + -> DupFlag -> OutType -- ^ Type of the function applied to this arg -> Maybe ArgInfo -- ^ Just <=> This arg `ai` occurs in an app -- `f a1 ... an` where we have ArgInfo on @@ -1858,18 +1832,22 @@ -- It's wrong to err in either direction -- But fun_ty is an OutType, so is fully substituted - ; if | isSimplified dup -- Don't re-simplify if we've simplified it once - -- Including don't preInlineUnconditionally - -- See Note [Avoiding simplifying repeatedly] - -> completeBindX env from_what bndr arg body cont - - | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se + ; if | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se , not (needsCaseBindingL arg_levity arg) -- Ok to test arg::InExpr in needsCaseBinding because -- exprOkForSpeculation is stable under simplification - -> do { tick (PreInlineUnconditionally bndr) + , not ( isSimplified dup && -- See (SR2) in Note [Avoiding simplifying repeatedly] + not (exprIsTrivial arg) && + not (isDeadOcc (idOccInfo bndr)) ) + -> do { simplTrace "SimplBindr:inline-uncond3" (ppr bndr) $ + tick (PreInlineUnconditionally bndr) ; simplLam env' body cont } + | isSimplified dup -- Don't re-simplify if we've simplified it once + -- Including don't preInlineUnconditionally + -- See Note [Avoiding simplifying repeatedly] + -> completeBindX env from_what bndr arg body cont + | otherwise -> simplNonRecE env from_what bndr (arg, arg_se) body cont } @@ -2026,15 +2004,22 @@ * We go to some efforts to avoid unnecessarily simplifying ApplyToVal, in at least two places - In simplCast/addCoerce, where we check for isReflCo - - In rebuildCall we avoid simplifying arguments before we have to - (see Note [Trying rewrite rules]) + - We sometimes try rewrite RULES befoe simplifying arguments; + see Note [tryRules: plan (BEFORE)] -All that said /postInlineUnconditionally/ (called in `completeBind`) does -fire in the above (f BIG) situation. See Note [Post-inline for single-use -things] in Simplify.Utils. This certainly risks repeated simplification, but -in practice seems to be a small win. +Wrinkles: +(SR1) All that said /postInlineUnconditionally/ (called in `completeBind`) does + fire in the above (f BIG) situation. See Note [Post-inline for single-use + things] in Simplify.Utils. This certainly risks repeated simplification, + but in practice seems to be a small win. +(SR2) When considering preInlineUnconditionally in `simpl_lam`, if the + expression is trivial, or it is dead (the binder doesn't occur), then there + is no danger of simplifying repeatedly. But there is a benefit: it can save + a simplifier iteration. So we check for that. + + ************************************************************************ * * Join points @@ -2233,25 +2218,29 @@ We'll clone the inner \x, adding x->x' in the id_subst Then when we inline y, we must *not* replace x by x' in the inlined copy!! -Note [Fast path for data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For applications of a data constructor worker, the full glory of +Note [Fast path for lazy data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For applications of a /lazy/ data constructor worker, the full glory of rebuildCall is a waste of effort; * They never inline, obviously * They have no rewrite rules -* They are not strict (see Note [Data-con worker strictness] - in GHC.Core.DataCon) +* Lazy constructors don't need the `StrictArg` treatment. So it's fine to zoom straight to `rebuild` which just rebuilds the call in a very straightforward way. +For a data constructor worker that is strict (see Note [Strict fields in Core]) +we take the slow path, so that we'll transform + K (case x of (a,b) -> a) --> case x of (a,b) -> K a +via the StrictArg case of rebuildCall + Some programs have a /lot/ of data constructors in the source program (compiler/perf/T9961 is an example), so this fast path can be very valuable. -} -simplVar :: SimplEnv -> InVar -> SimplM OutExpr +simplInVar :: SimplEnv -> InVar -> SimplM OutExpr -- Look up an InVar in the environment -simplVar env var +simplInVar env var -- Why $! ? See Note [Bangs in the Simplifier] | isTyVar var = return $! Type $! (substTyVar env var) | isCoVar var = return $! Coercion $! (substCoVar env var) @@ -2262,10 +2251,11 @@ DoneId var1 -> return (Var var1) DoneEx e _ -> return e -simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr) -simplIdF env var cont - | isDataConWorkId var -- See Note [Fast path for data constructors] - = rebuild env (Var var) cont +simplInId :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr) +simplInId env var cont + | Just dc <- isDataConWorkId_maybe var + , isLazyDataConRep dc -- See Note [Fast path for lazy data constructors] + = rebuild zapped_env (Var var) cont | otherwise = case substId env var of ContEx tvs cvs ids e -> simplExprF env' e cont @@ -2274,113 +2264,39 @@ where env' = setSubstEnv env tvs cvs ids - DoneId var1 -> - do { rule_base <- getSimplRules - ; let cont' = trimJoinCont var1 (idJoinPointHood var1) cont - info = mkArgInfo env rule_base var1 cont' - ; rebuildCall env info cont' } + DoneId out_id -> simplOutId zapped_env out_id cont' + where + cont' = trimJoinCont out_id (idJoinPointHood out_id) cont - DoneEx e mb_join -> simplExprF env' e cont' + DoneEx e mb_join -> simplExprF zapped_env e cont' where cont' = trimJoinCont var mb_join cont - env' = zapSubstEnv env -- See Note [zapSubstEnv] - ---------------------------------------------------------- --- Dealing with a call site - -rebuildCall :: SimplEnv -> ArgInfo -> SimplCont - -> SimplM (SimplFloats, OutExpr) - ----------- Bottoming applications -------------- -rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont - -- When we run out of strictness args, it means - -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo - -- Then we want to discard the entire strict continuation. E.g. - -- * case (error "hello") of { ... } - -- * (error "Hello") arg - -- * f (error "Hello") where f is strict - -- etc - -- Then, especially in the first of these cases, we'd like to discard - -- the continuation, leaving just the bottoming expression. But the - -- type might not be right, so we may have to add a coerce. - | not (contIsTrivial cont) -- Only do this if there is a non-trivial - -- continuation to discard, else we do it - -- again and again! - = seqType cont_ty `seq` -- See Note [Avoiding space leaks in OutType] - return (emptyFloats env, castBottomExpr res cont_ty) where - res = argInfoExpr fun rev_args - cont_ty = contResultType cont - ----------- Try inlining, if ai_rewrite = TryInlining -------- --- In the TryInlining case we try inlining immediately, before simplifying --- any (more) arguments. Why? See Note [Rewrite rules and inlining]. --- --- If there are rewrite rules we'll skip this case until we have --- simplified enough args to satisfy nr_wanted==0 in the TryRules case below --- Then we'll try the rules, and if that fails, we'll do TryInlining -rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args - , ai_rewrite = TryInlining }) cont - = do { logger <- getLogger - ; let full_cont = pushSimplifiedRevArgs env rev_args cont - ; mb_inline <- tryInlining env logger fun full_cont - ; case mb_inline of - Just expr -> do { checkedTick (UnfoldingDone fun) - ; let env1 = zapSubstEnv env - ; simplExprF env1 expr full_cont } - Nothing -> rebuildCall env (info { ai_rewrite = TryNothing }) cont - } - ----------- Try rewrite RULES, if ai_rewrite = TryRules -------------- --- See Note [Rewrite rules and inlining] --- See also Note [Trying rewrite rules] -rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args - , ai_rewrite = TryRules nr_wanted rules }) cont - | nr_wanted == 0 || no_more_args - = -- We've accumulated a simplified call in - -- so try rewrite rules; see Note [RULES apply to simplified arguments] - -- See also Note [Rules for recursive functions] - do { mb_match <- tryRules env rules fun (reverse rev_args) cont - ; case mb_match of - Just (env', rhs, cont') -> simplExprF env' rhs cont' - Nothing -> rebuildCall env (info { ai_rewrite = TryInlining }) cont } - where - -- If we have run out of arguments, just try the rules; there might - -- be some with lower arity. Casts get in the way -- they aren't - -- allowed on rule LHSs - no_more_args = case cont of - ApplyToTy {} -> False - ApplyToVal {} -> False - _ -> True - ----------- Simplify type applications and casts -------------- -rebuildCall env info (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) - = rebuildCall env (addCastTo info co') cont - where - co' = optOutCoercion env co opt + zapped_env = zapSubstEnv env -- See Note [zapSubstEnv] -rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }) - = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont +--------------------------------------------------------- +simplOutId :: SimplEnvIS -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr) ----------- The runRW# rule. Do this after absorbing all arguments ------ +---------- The runRW# rule ------ -- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. -- -- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) -rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) - (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_hole_ty = fun_ty }) - | fun_id `hasKey` runRWKey - , [ TyArg { as_arg_ty = hole_ty }, TyArg {} ] <- rev_args +-- K[ runRW# @rr @hole_ty body ] --> runRW @rr' @ty' (\s. K[ body s ]) +simplOutId env fun cont + | fun `hasKey` runRWKey + , ApplyToTy { sc_cont = cont1 } <- cont + , ApplyToTy { sc_cont = cont2, sc_arg_ty = hole_ty } <- cont1 + , ApplyToVal { sc_cont = cont3, sc_arg = arg + , sc_env = arg_se, sc_hole_ty = fun_ty } <- cont2 -- Do this even if (contIsStop cont), or if seCaseCase is off. -- See Note [No eta-expansion in runRW#] = do { let arg_env = arg_se `setInScopeFromE` env - overall_res_ty = contResultType cont + overall_res_ty = contResultType cont3 -- hole_ty is the type of the current runRW# application (outer_cont, new_runrw_res_ty, inner_cont) - | seCaseCase env = (mkBoringStop overall_res_ty, overall_res_ty, cont) - | otherwise = (cont, hole_ty, mkBoringStop hole_ty) + | seCaseCase env = (mkBoringStop overall_res_ty, overall_res_ty, cont3) + | otherwise = (cont3, hole_ty, mkBoringStop hole_ty) -- Only when case-of-case is on. See GHC.Driver.Config.Core.Opt.Simplify -- Note [Case-of-case and full laziness] @@ -2407,9 +2323,76 @@ ; return (Lam s' body') } ; let rr' = getRuntimeRep new_runrw_res_ty - call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg new_runrw_res_ty, arg'] + call' = mkApps (Var fun) [mkTyArg rr', mkTyArg new_runrw_res_ty, arg'] ; rebuild env call' outer_cont } +-- Normal case for (f e1 .. en) +simplOutId env fun cont + = -- Try rewrite rules: Plan (BEFORE) in Note [When to apply rewrite rules] + do { rule_base <- getSimplRules + ; let rules_for_me = getRules rule_base fun + out_args = contOutArgs env cont :: [OutExpr] + ; mb_match <- if not (null rules_for_me) && + (isClassOpId fun || activeUnfolding (seMode env) fun) + then tryRules env rules_for_me fun out_args + else return Nothing + ; case mb_match of { + Just (rule_arity, rhs) -> simplExprF env rhs $ + dropContArgs rule_arity cont ; + Nothing -> + + -- Try inlining + do { logger <- getLogger + ; mb_inline <- tryInlining env logger fun cont + ; case mb_inline of{ + Just expr -> do { checkedTick (UnfoldingDone fun) + ; simplExprF env expr cont } ; + Nothing -> + + -- Neither worked, so just rebuild + do { let arg_info = mkArgInfo env fun rules_for_me cont + ; rebuildCall env arg_info cont + } } } } } + +--------------------------------------------------------- +-- Dealing with a call site + +rebuildCall :: SimplEnvIS -> ArgInfo -> SimplCont + -> SimplM (SimplFloats, OutExpr) +-- SimplEnvIS: at this point the substitution in the SimplEnv is irrelevant; +-- it is usually empty, and regardless should be ignored. +-- Only the in-scope set matters, plus the seMode flags + +-- Check the invariant +rebuildCall env arg_info _cont + | assertPpr (checkSimplEnvIS env) (pprBadSimplEnvIS env $$ ppr arg_info) False + = pprPanic "rebuildCall" empty + +---------- Bottoming applications -------------- +rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont + -- When we run out of strictness args, it means + -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo + -- Then we want to discard the entire strict continuation. E.g. + -- * case (error "hello") of { ... } + -- * (error "Hello") arg + -- * f (error "Hello") where f is strict + -- etc + -- Then, especially in the first of these cases, we'd like to discard + -- the continuation, leaving just the bottoming expression. But the + -- type might not be right, so we may have to add a coerce. + | not (contIsTrivial cont) -- Only do this if there is a non-trivial + -- continuation to discard, else we do it + -- again and again! + = seqType cont_ty `seq` -- See Note [Avoiding space leaks in OutType] + return (emptyFloats env, castBottomExpr res cont_ty) + where + res = argInfoExpr fun rev_args + cont_ty = contResultType cont + +---------- Simplify type applications -------------- +rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }) + = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont + ---------- Simplify value arguments -------------------- rebuildCall env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se @@ -2440,8 +2423,16 @@ ; rebuildCall env (addValArgTo fun_info arg' fun_ty) cont } ---------- No further useful info, revert to generic rebuild ------------ -rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont +rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_rules = rules }) cont + | null rules = rebuild env (argInfoExpr fun rev_args) cont + | otherwise -- Try rules again: Plan (AFTER) in Note [When to apply rewrite rules] + = do { let args = reverse rev_args + ; mb_match <- tryRules env rules fun (map argSpecArg args) + ; case mb_match of + Just (rule_arity, rhs) -> simplExprF env rhs $ + pushSimplifiedArgs env (drop rule_arity args) cont + Nothing -> rebuild env (argInfoExpr fun rev_args) cont } ----------------------------------- tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) @@ -2475,83 +2466,102 @@ text "Cont: " <+> ppr cont])] -{- Note [Trying rewrite rules] +{- Note [When to apply rewrite rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Should we apply rewrite rules before simplifying the arguments, or after? +Each is highly desirable in some cases, and in fact we do both! + + - Plan (BEFORE) selectively, in `simplOutId` + See Note [tryRules: plan (BEFORE)] + + - Plan (AFTER) always, in the finishing-up case of `rebuildCall` + See Note [tryRules: plan (AFTER)] + +Historical note. Pre-2025, GHC only did tryRules once, when it had simplified +enough arguments to saturate all the RULEs it had in hand. But alas, if a new +unrelated RULE showed up (but did not fire), it could nevertheless change the +simplifier's behaviour a bit; and that messed up deterministic compilation +(#25170). (This was particularly nasty if the rule wasn't even transitively +below the module being compiled.) Current solution: ensure that adding a new, +unrelated rule that never fires does not change the simplifier behaviour. End +of historical note. + +Note [tryRules: plan (BEFORE)] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider an application (f e1 e2 e3) where the e1,e2,e3 are not yet -simplified. We want to simplify enough arguments to allow the rules -to apply, but it's more efficient to avoid simplifying e2,e3 if e1 alone -is sufficient. Example: class ops - (+) dNumInt e2 e3 -If we rewrite ((+) dNumInt) to plusInt, we can take advantage of the -latter's strictness when simplifying e2, e3. Moreover, suppose we have - RULE f Int = \x. x True +It is sometimes desirable to apply RULES before simplifying the function +arguments. We do so in `simplOutId`. -Then given (f Int e1) we rewrite to - (\x. x True) e1 -without simplifying e1. Now we can inline x into its unique call site, -and absorb the True into it all in the same pass. If we simplified -e1 first, we couldn't do that; see Note [Avoiding simplifying repeatedly]. +We do so /selectively/ (see (BF2)), in two particular cases: -So we try to apply rules if either - (a) no_more_args: we've run out of argument that the rules can "see" - (b) nr_wanted: none of the rules wants any more arguments +* Class ops + (+) dNumInt e2 e3 + If we rewrite ((+) dNumInt) to plusInt, we can take advantage of the + latter's strictness when simplifying e2, e3. Moreover, if + (+) dNumInt e2 e3 --> (\x y -> ....) e2 e3 + Frequently `x` is used just once in the body of the (\x y -> ...). + If `e2` is un-simplified we can preInlineUnconditinally and that saves + simplifying `e2` twice. See Note [Avoiding simplifying repeatedly]. +* Specialisation RULES. In general we try to arrange that inlining is disabled + (via a pragma) if a rewrite rule should apply, so that the rule has a decent + chance to fire before we inline the function. -Note [RULES apply to simplified arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's very desirable to try RULES once the arguments have been simplified, because -doing so ensures that rule cascades work in one pass. Consider - {-# RULES g (h x) = k x - f (k x) = x #-} - ...f (g (h x))... -Then we want to rewrite (g (h x)) to (k x) and only then try f's rules. If -we match f's rules against the un-simplified RHS, it won't match. This -makes a particularly big difference when superclass selectors are involved: - op ($p1 ($p2 (df d))) -We want all this to unravel in one sweep. + But it turns out that (especially when type-class specialisation or + SpecConstr is involved) it is very helpful for the the rewrite rule to + "win" over inlining when both are active at once: see #21851, #22097. -Note [Rewrite rules and inlining] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In general we try to arrange that inlining is disabled (via a pragma) if -a rewrite rule should apply, so that the rule has a decent chance to fire -before we inline the function. + So if the Id has an unfolding, we want to try RULES before we try inlining. -But it turns out that (especially when type-class specialisation or -SpecConstr is involved) it is very helpful for the the rewrite rule to -"win" over inlining when both are active at once: see #21851, #22097. +Wrinkles: -The simplifier arranges to do this, as follows. In effect, the ai_rewrite -field of the ArgInfo record is the state of a little state-machine: +(BF1) Each un-simplified argument has its own static environment, stored + in its `ApplyToVal` nodes. So we can't just match on the un-simplified + arguments: we have to apply that static environment as a substitution + first! This is done lazily in `GHC.Core.Opt.Simplify.Utils.contOutArgs`, + so it'll be done just enough to allow the rule to match, or not. -* mkArgInfo sets the ai_rewrite field to TryRules if there are any rewrite - rules avaialable for that function. +(BF2) The "selectively" in Plan (BEFORE) is a bit ad-hoc: -* rebuildCall simplifies arguments until enough are simplified to match the - rule with greatest arity. See Note [RULES apply to simplified arguments] - and the first field of `TryRules`. + * We want Plan (BEFORE) for class ops (see above in this Note) - But no more! As soon as we have simplified enough arguments to satisfy the - maximum-arity rules, we try the rules; see Note [Trying rewrite rules]. + * But we do NOT want Plan (BEFORE) for primops, because the constant-folding + rules are quite complicated and expensive, and we don't want to try them + twice. Moreover the benefts of Plan (BEFORE), described in the Note, don't + apply to primops. -* Once we have tried rules (or immediately if there are no rules) set - ai_rewrite to TryInlining, and the Simplifier will try to inline the - function. We want to try this immediately (before simplifying any (more) - arguments). Why? Consider - f BIG where f = \x{OneOcc}. ...x... - If we inline `f` before simplifying `BIG` well use preInlineUnconditionally, - and we'll simplify BIG once, at x's occurrence, rather than twice. +Note [tryRules: plan (AFTER)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's very desirable to try RULES once the arguments have been simplified, +because doing so ensures that rule cascades work in one pass. We do this +in the finishing-up case of `rebuildCall`. -* GHC.Core.Opt.Simplify.Utils. mkRewriteCall: if there are no rules, and no - unfolding, we can skip both TryRules and TryInlining, which saves work. +Consider + {-# RULES g (h x) = k x + f (k x) = x #-} + ...f (g (h x))... +Then we want to rewrite (g (h x)) to (k x) and only then try f's rules. If +we match f's rules against the un-simplified RHS, it won't match. This +makes a particularly big difference for +* Superclass selectors + op ($p1 ($p2 (df d))) + We want all this to unravel in one sweep + +* Constant folding + +# 3# (+# 4# 5#) + We want this to happen in one pass + Note [Avoid redundant simplification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Because RULES apply to simplified arguments, there's a danger of repeatedly -simplifying already-simplified arguments. An important example is that of - (>>=) d e1 e2 -Here e1, e2 are simplified before the rule is applied, but don't really -participate in the rule firing. So we mark them as Simplified to avoid -re-simplifying them. +Because RULES often apply to simplified arguments (see Note [Plan (AFTER)]), +there's a danger of simplifying already-simplified arguments. For example, +suppose we have + RULE f (x,y) = $sf x y +and the expression + f (p,q) e1 e2 +With Plan (AFTER) by the time the rule fires, we will have already simplified e1, e2, +and we want to avoid doing so a second time. So ApplyToVal records if the argument +is already Simplified. Note [Shadowing in the Simplifier] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2601,33 +2611,19 @@ -} tryRules :: SimplEnv -> [CoreRule] - -> Id - -> [ArgSpec] -- In /normal, forward/ order - -> SimplCont - -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont)) - -tryRules env rules fn args call_cont - | null rules - = return Nothing + -> OutId -> [OutExpr] + -> SimplM (Maybe (FullArgCount, CoreExpr)) - | Just (rule, rule_rhs) <- lookupRule ropts (getUnfoldingInRuleMatch env) - (activeRule (seMode env)) fn - (argInfoAppArgs args) rules +tryRules env rules fn args + | Just (rule, rule_rhs) <- lookupRule ropts in_scope_env + act_fun fn args rules -- Fire a rule for the function = do { logger <- getLogger ; checkedTick (RuleFired (ruleName rule)) - ; let cont' = pushSimplifiedArgs zapped_env - (drop (ruleArity rule) args) - call_cont - -- (ruleArity rule) says how - -- many args the rule consumed - - occ_anald_rhs = occurAnalyseExpr rule_rhs + ; let occ_anald_rhs = occurAnalyseExpr rule_rhs -- See Note [Occurrence-analyse after rule firing] ; dump logger rule rule_rhs - ; return (Just (zapped_env, occ_anald_rhs, cont')) } - -- The occ_anald_rhs and cont' are all Out things - -- hence zapping the environment + ; return (Just (ruleArity rule, occ_anald_rhs)) } | otherwise -- No rule fires = do { logger <- getLogger @@ -2635,8 +2631,9 @@ ; return Nothing } where - ropts = seRuleOpts env - zapped_env = zapSubstEnv env -- See Note [zapSubstEnv] + ropts = seRuleOpts env :: RuleOpts + in_scope_env = getUnfoldingInRuleMatch env :: InScopeEnv + act_fun = activeRule (seMode env) :: Activation -> Bool printRuleModule rule = parens (maybe (text "BUILTIN") @@ -2648,10 +2645,9 @@ = log_rule Opt_D_dump_rule_rewrites "Rule fired" $ vcat [ text "Rule:" <+> ftext (ruleName rule) , text "Module:" <+> printRuleModule rule + , text "Full arity:" <+> ppr (ruleArity rule) , text "Before:" <+> hang (ppr fn) 2 (sep (map ppr args)) - , text "After: " <+> hang (pprCoreExpr rule_rhs) 2 - (sep $ map ppr $ drop (ruleArity rule) args) - , text "Cont: " <+> ppr call_cont ] + , text "After: " <+> pprCoreExpr rule_rhs ] | logHasDumpFlag logger Opt_D_dump_rule_firings = log_rule Opt_D_dump_rule_firings "Rule fired:" $ @@ -2683,13 +2679,23 @@ trySeqRules :: SimplEnv -> OutExpr -> InExpr -- Scrutinee and RHS -> SimplCont - -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont)) + -> SimplM (Maybe (CoreExpr, SimplCont)) -- See Note [User-defined RULES for seq] +-- `in_env` applies to `rhs :: InExpr` but not to `scrut :: OutExpr` trySeqRules in_env scrut rhs cont = do { rule_base <- getSimplRules - ; tryRules in_env (getRules rule_base seqId) seqId out_args rule_cont } + ; let seq_rules = getRules rule_base seqId + ; mb_match <- tryRules in_env seq_rules seqId out_args + ; case mb_match of + Nothing -> return Nothing + Just (rule_arity, rhs) -> return (Just (rhs, cont')) + where + cont' = pushSimplifiedArgs in_env (drop rule_arity out_arg_specs) rule_cont + } where no_cast_scrut = drop_casts scrut + + -- All these are OutTypes scrut_ty = exprType no_cast_scrut seq_id_ty = idType seqId -- forall r a (b::TYPE r). a -> b -> b res1_ty = piResultTy seq_id_ty rhs_rep -- forall a (b::TYPE rhs_rep). a -> b -> b @@ -2698,21 +2704,23 @@ res4_ty = funResultTy res3_ty -- rhs_ty -> rhs_ty rhs_ty = substTy in_env (exprType rhs) rhs_rep = getRuntimeRep rhs_ty - out_args = [ TyArg { as_arg_ty = rhs_rep + + out_args = [Type rhs_rep, Type scrut_ty, Type rhs_ty, no_cast_scrut] + -- Cheaper than (map argSpecArg out_arg_specs) + out_arg_specs = [ TyArg { as_arg_ty = rhs_rep , as_hole_ty = seq_id_ty } - , TyArg { as_arg_ty = scrut_ty - , as_hole_ty = res1_ty } - , TyArg { as_arg_ty = rhs_ty - , as_hole_ty = res2_ty } - , ValArg { as_arg = no_cast_scrut - , as_dmd = seqDmd - , as_hole_ty = res3_ty } ] + , TyArg { as_arg_ty = scrut_ty + , as_hole_ty = res1_ty } + , TyArg { as_arg_ty = rhs_ty + , as_hole_ty = res2_ty } + , ValArg { as_arg = no_cast_scrut + , as_dmd = seqDmd + , as_hole_ty = res3_ty } ] rule_cont = ApplyToVal { sc_dup = NoDup, sc_arg = rhs , sc_env = in_env, sc_cont = cont , sc_hole_ty = res4_ty } -- Lazily evaluated, so we don't do most of this - drop_casts (Cast e _) = drop_casts e drop_casts e = e @@ -3188,8 +3196,8 @@ | is_plain_seq = do { mb_rule <- trySeqRules env scrut rhs cont ; case mb_rule of - Just (env', rule_rhs, cont') -> simplExprF env' rule_rhs cont' - Nothing -> reallyRebuildCase env scrut case_bndr alts cont } + Just (rule_rhs, cont') -> simplExprF (zapSubstEnv env) rule_rhs cont' + Nothing -> reallyRebuildCase env scrut case_bndr alts cont } -------------------------------------------------- -- 3. Primop-related case-rules @@ -3240,7 +3248,7 @@ -- Note [Case-of-case and full laziness] = do { case_expr <- simplAlts env scrut case_bndr alts (mkBoringStop (contHoleType cont)) - ; rebuild env case_expr cont } + ; rebuild (zapSubstEnv env) case_expr cont } | otherwise = do { (floats, env', cont') <- mkDupableCaseCont env alts cont @@ -3490,7 +3498,7 @@ We really must record that b is already evaluated so that we don't go and re-evaluate it when constructing the result. -See Note [Data-con worker strictness] in GHC.Core.DataCon +See Note [Strict fields in Core] in GHC.Core. NB: simplLamBndrs preserves this eval info @@ -3753,7 +3761,7 @@ | exprIsTrivial scrut = return (emptyFloats env , extendIdSubst env bndr (DoneEx scrut NotJoinPoint)) -- See Note [Do not duplicate constructor applications] - | otherwise = do { dc_args <- mapM (simplVar env) bs + | otherwise = do { dc_args <- mapM (simplInVar env) bs -- dc_ty_args are already OutTypes, -- but bs are InBndrs ; let con_app = Var (dataConWorkId dc) @@ -3844,13 +3852,17 @@ -- extra let/join-floats and in-scope variables , SimplCont) -- dup_cont: duplicable continuation mkDupableCont env cont - = mkDupableContWithDmds env (repeat topDmd) cont + = mkDupableContWithDmds (zapSubstEnv env) (repeat topDmd) cont mkDupableContWithDmds - :: SimplEnv -> [Demand] -- Demands on arguments; always infinite + :: SimplEnvIS -> [Demand] -- Demands on arguments; always infinite -> SimplCont -> SimplM ( SimplFloats, SimplCont) mkDupableContWithDmds env _ cont + -- Check the invariant + | assertPpr (checkSimplEnvIS env) (pprBadSimplEnvIS env) False + = pprPanic "mkDupableContWithDmds" empty + | contIsDupable cont = return (emptyFloats env, cont) @@ -3893,7 +3905,7 @@ , thumbsUpPlanA cont = -- Use Plan A of Note [Duplicating StrictArg] -- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ - do { let (_ : dmds) = ai_dmds fun + do { let _ :| dmds = expectNonEmpty $ ai_dmds fun ; (floats1, cont') <- mkDupableContWithDmds env dmds cont -- Use the demands from the function to add the right -- demand info on any bindings we make for further args @@ -3939,7 +3951,7 @@ -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:cont_dmds) = dmds -- Never fails + do { let dmd:|cont_dmds = expectNonEmpty dmds ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg @@ -4014,7 +4026,7 @@ | otherwise = do { join_bndr <- newJoinId [arg_bndr] res_ty ; let arg_info = ArgInfo { ai_fun = join_bndr - , ai_rewrite = TryNothing, ai_args = [] + , ai_rules = [], ai_args = [] , ai_encl = False, ai_dmds = repeat topDmd , ai_discs = repeat 0 } ; return ( addJoinFloats (emptyFloats env) $ @@ -4199,17 +4211,40 @@ K g y -> blah[g,y] But now we have to make `blah` into a join point, /abstracted/ -over `g` and `y`. In contrast, if we /don't/ inline $j we -don't need a join point for `blah` and we'll get - join $j x = let g=f, y=x in blah[g,y] +over `g` and `y`. We get + join $j2 g y = blah in case v of - p1 -> $j x1 - p2 -> $j x2 - p3 -> $j x3 + p1 -> $j2 f x1 + p2 -> $j2 f x2 + p3 -> $j2 f x3 +So now we can't see that `g` is always `f` in `blah`. +In contrast, if we /don't/ inline $j we +don't need a new join point for `blah` and we'll get + join $j' x = let g=f, y=x in blah[g,y] + in case v of + p1 -> $j' x1 + p2 -> $j' x2 + p3 -> $j' x3 + This can make a /massive/ difference, because `blah` can see what `f` is, instead of lambda-abstracting over it. +If instead the RHS of the join point is a simple application that has no free +variables, as in + + case (join $j x f = K f x ) + (in case v of ) + ( p1 -> $j x1 f1 ) of + ( p2 -> $j x2 f2 ) + ( p3 -> $j x3 f3 ) + K g y -> blah[g,y] + +then no information can be gained by preserving the join point (c.f. `f` being +free in the join point above and being useful to `blah`). In this case, it's +more beneficial to inline the join point (see (DJ3)(c)) to allow further +optimisations to fire. An example where failing to do this went wrong is #25723. + Beyond this, not-inlining join points reduces duplication. In the above example, if `blah` was small enough we'd inline it, but that duplicates code, for no gain. Best just to keep not-inline the join point in the first place. @@ -4234,11 +4269,26 @@ case-of-case friendly. (DJ3) When should `uncondInlineJoin` return True? - * (exprIsTrivial rhs); this includes uses of unsafeEqualityProof etc; see + (a) (exprIsTrivial rhs); this includes uses of unsafeEqualityProof etc; see the defn of exprIsTrivial. Also nullary constructors. - * The RHS is a call ($j x y z), where the arguments are all trivial and $j + (b) The RHS is a call ($j x y z), where the arguments are all trivial and $j is a join point: there is no point in creating an indirection. + + (c) The RHS is a data constructor application (K x y z) where + + - all the args x,y,z are trivial + - the free LocalIds of `f x y z` are a subset of the join point binders + + Examples that return True + $j x y = K y (x |> co) + $j x y = x (y @Int) + Examples that return False + $j x = K y x -- y is free + $j y = f y -- f is free + + Not duplicating these join points has no benefits and blocks other important + optimisations from firing (see #25723) (DJ4) By the same token we want to use Plan B in Note [Duplicating StrictArg] when the RHS of the new join point is a data constructor application. See the diff --git a/GHC/Core/Opt/Simplify/Utils.hs b/GHC/Core/Opt/Simplify/Utils.hs --- a/GHC/Core/Opt/Simplify/Utils.hs +++ b/GHC/Core/Opt/Simplify/Utils.hs @@ -25,15 +25,15 @@ isSimplified, contIsStop, contIsDupable, contResultType, contHoleType, contHoleScaling, contIsTrivial, contArgs, contIsRhs, - countArgs, + countArgs, contOutArgs, dropContArgs, mkBoringStop, mkRhsStop, mkLazyArgStop, interestingCallContext, -- ArgInfo - ArgInfo(..), ArgSpec(..), RewriteCall(..), mkArgInfo, - addValArgTo, addCastTo, addTyArgTo, - argInfoExpr, argInfoAppArgs, - pushSimplifiedArgs, pushSimplifiedRevArgs, + ArgInfo(..), ArgSpec(..), mkArgInfo, + addValArgTo, addTyArgTo, + argInfoExpr, argSpecArg, + pushSimplifiedArgs, isStrictArgInfo, lazyArgContext, abstractFloats, @@ -55,7 +55,6 @@ import GHC.Core.TyCo.Ppr ( pprParendType ) import GHC.Core.FVs import GHC.Core.Utils -import GHC.Core.Rules( RuleEnv, getRules ) import GHC.Core.Opt.Arity import GHC.Core.Unfold import GHC.Core.Unfold.Make @@ -73,7 +72,6 @@ import GHC.Types.Demand import GHC.Types.Var.Set import GHC.Types.Basic -import GHC.Types.Name.Env import GHC.Data.OrdList ( isNilOL ) import GHC.Data.FastString ( fsLit ) @@ -83,9 +81,9 @@ import GHC.Utils.Outputable import GHC.Utils.Panic -import Control.Monad ( guard, when ) +import Control.Monad ( when ) import Data.List ( sortBy ) -import Data.Maybe +import GHC.Types.Name.Env import Data.Graph {- ********************************************************************* @@ -285,7 +283,7 @@ ppr (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) = (text "ApplyToTy" <+> pprParendType ty) $$ ppr cont ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont, sc_hole_ty = hole_ty }) - = (hang (text "ApplyToVal" <+> ppr dup <+> text "hole" <+> ppr hole_ty) + = (hang (text "ApplyToVal" <+> ppr dup <+> text "hole-ty:" <+> pprParendType hole_ty) 2 (pprParendExpr arg)) $$ ppr cont ppr (StrictBind { sc_bndr = b, sc_cont = cont }) @@ -325,11 +323,10 @@ = ArgInfo { ai_fun :: OutId, -- The function ai_args :: [ArgSpec], -- ...applied to these args (which are in *reverse* order) - - ai_rewrite :: RewriteCall, -- What transformation to try next for this call - -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration + -- NB: all these argumennts are already simplified - ai_encl :: Bool, -- Flag saying whether this function + ai_rules :: [CoreRule], -- Rules for this function + ai_encl :: Bool, -- Flag saying whether this function -- or an enclosing one has rules (recursively) -- True => be keener to inline in all args @@ -343,12 +340,6 @@ -- Always infinite } -data RewriteCall -- What rewriting to try next for this call - -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration - = TryRules FullArgCount [CoreRule] - | TryInlining - | TryNothing - data ArgSpec = ValArg { as_dmd :: Demand -- Demand placed on this argument , as_arg :: OutExpr -- Apply to this (coercion or value); c.f. ApplyToVal @@ -357,62 +348,46 @@ | TyArg { as_arg_ty :: OutType -- Apply to this type; c.f. ApplyToTy , as_hole_ty :: OutType } -- Type of the function (presumably forall a. blah) - | CastBy OutCoercion -- Cast by this; c.f. CastIt - -- Coercion is optimised - instance Outputable ArgInfo where - ppr (ArgInfo { ai_fun = fun, ai_args = args, ai_dmds = dmds }) + ppr (ArgInfo { ai_fun = fun, ai_args = args, ai_dmds = dmds, ai_rules = rules }) = text "ArgInfo" <+> braces (sep [ text "fun =" <+> ppr fun , text "dmds(first 10) =" <+> ppr (take 10 dmds) - , text "args =" <+> ppr args ]) + , text "args =" <+> ppr args + , text "rewrite =" <+> ppr rules ]) instance Outputable ArgSpec where ppr (ValArg { as_arg = arg }) = text "ValArg" <+> ppr arg ppr (TyArg { as_arg_ty = ty }) = text "TyArg" <+> ppr ty - ppr (CastBy c) = text "CastBy" <+> ppr c addValArgTo :: ArgInfo -> OutExpr -> OutType -> ArgInfo addValArgTo ai arg hole_ty - | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs, ai_rewrite = rew } <- ai + | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs } <- ai -- Pop the top demand and and discounts off , let arg_spec = ValArg { as_arg = arg, as_hole_ty = hole_ty, as_dmd = dmd } = ai { ai_args = arg_spec : ai_args ai , ai_dmds = dmds - , ai_discs = discs - , ai_rewrite = decArgCount rew } + , ai_discs = discs } | otherwise = pprPanic "addValArgTo" (ppr ai $$ ppr arg) -- There should always be enough demands and discounts addTyArgTo :: ArgInfo -> OutType -> OutType -> ArgInfo -addTyArgTo ai arg_ty hole_ty = ai { ai_args = arg_spec : ai_args ai - , ai_rewrite = decArgCount (ai_rewrite ai) } +addTyArgTo ai arg_ty hole_ty = ai { ai_args = arg_spec : ai_args ai } where arg_spec = TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty } -addCastTo :: ArgInfo -> OutCoercion -> ArgInfo -addCastTo ai co = ai { ai_args = CastBy co : ai_args ai } - isStrictArgInfo :: ArgInfo -> Bool -- True if the function is strict in the next argument isStrictArgInfo (ArgInfo { ai_dmds = dmds }) | dmd:_ <- dmds = isStrUsedDmd dmd | otherwise = False -argInfoAppArgs :: [ArgSpec] -> [OutExpr] -argInfoAppArgs [] = [] -argInfoAppArgs (CastBy {} : _) = [] -- Stop at a cast -argInfoAppArgs (ValArg { as_arg = arg } : as) = arg : argInfoAppArgs as -argInfoAppArgs (TyArg { as_arg_ty = ty } : as) = Type ty : argInfoAppArgs as - -pushSimplifiedArgs, pushSimplifiedRevArgs - :: SimplEnv - -> [ArgSpec] -- In normal, forward order for pushSimplifiedArgs, - -- in /reverse/ order for pushSimplifiedRevArgs - -> SimplCont -> SimplCont -pushSimplifiedArgs env args cont = foldr (pushSimplifiedArg env) cont args -pushSimplifiedRevArgs env args cont = foldl' (\k a -> pushSimplifiedArg env a k) cont args +pushSimplifiedArgs :: SimplEnv + -> [ArgSpec] -- In normal, forward order + -> SimplCont -> SimplCont +pushSimplifiedArgs env args cont = foldr (pushSimplifiedArg env) cont args +-- pushSimplifiedRevArgs env args cont = foldl' (\k a -> pushSimplifiedArg env a k) cont args pushSimplifiedArg :: SimplEnv -> ArgSpec -> SimplCont -> SimplCont pushSimplifiedArg _env (TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }) cont @@ -421,9 +396,11 @@ = ApplyToVal { sc_arg = arg, sc_env = env, sc_dup = Simplified -- The SubstEnv will be ignored since sc_dup=Simplified , sc_hole_ty = hole_ty, sc_cont = cont } -pushSimplifiedArg _ (CastBy c) cont - = CastIt { sc_co = c, sc_cont = cont, sc_opt = True } +argSpecArg :: ArgSpec -> OutExpr +argSpecArg (ValArg { as_arg = arg }) = arg +argSpecArg (TyArg { as_arg_ty = ty }) = Type ty + argInfoExpr :: OutId -> [ArgSpec] -> OutExpr -- NB: the [ArgSpec] is reversed so that the first arg -- in the list is the last one in the application @@ -433,29 +410,7 @@ go [] = Var fun go (ValArg { as_arg = arg } : as) = go as `App` arg go (TyArg { as_arg_ty = ty } : as) = go as `App` Type ty - go (CastBy co : as) = mkCast (go as) co -decArgCount :: RewriteCall -> RewriteCall -decArgCount (TryRules n rules) = TryRules (n-1) rules -decArgCount rew = rew - -mkRewriteCall :: Id -> RuleEnv -> RewriteCall --- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration --- We try to skip any unnecessary stages: --- No rules => skip TryRules --- No unfolding => skip TryInlining --- This skipping is "just" for efficiency. But rebuildCall is --- quite a heavy hammer, so skipping stages is a good plan. --- And it's extremely simple to do. -mkRewriteCall fun rule_env - | not (null rules) = TryRules n_required rules - | canUnfold unf = TryInlining - | otherwise = TryNothing - where - n_required = maximum (map ruleArity rules) - rules = getRules rule_env fun - unf = idUnfolding fun - {- ************************************************************************ * * @@ -593,6 +548,34 @@ -- Do *not* use short-cutting substitution here -- because we want to get as much IdInfo as possible +contOutArgs :: SimplEnv -> SimplCont -> [OutExpr] +-- Get the leading arguments from the `SimplCont`, as /OutExprs/ +contOutArgs env cont + = go cont + where + in_scope = seInScope env + + go (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) + = Type ty : go cont + + go (ApplyToVal { sc_dup = dup, sc_arg = arg, sc_env = env, sc_cont = cont }) + | isSimplified dup = arg : go cont + | otherwise = GHC.Core.Subst.substExpr (getFullSubst in_scope env) arg : go cont + -- Make sure we apply the static environment `sc_env` as a substitution + -- to get an OutExpr. See (BF1) in Note [tryRules: plan (BEFORE)] + -- in GHC.Core.Opt.Simplify.Iteration + -- NB: we use substExpr, not substExprSC: we want to get the benefit of + -- knowing what is evaluated etc, via the in-scope set + + -- No more arguments + go _ = [] + +dropContArgs :: FullArgCount -> SimplCont -> SimplCont +dropContArgs 0 cont = cont +dropContArgs n (ApplyToTy { sc_cont = cont }) = dropContArgs (n-1) cont +dropContArgs n (ApplyToVal { sc_cont = cont }) = dropContArgs (n-1) cont +dropContArgs n cont = pprPanic "dropContArgs" (ppr n $$ ppr cont) + -- | Describes how the 'SimplCont' will evaluate the hole as a 'SubDemand'. -- This can be more insightful than the limited syntactic context that -- 'SimplCont' provides, because the 'Stop' constructor might carry a useful @@ -624,29 +607,26 @@ -- and case binder dmds, see addCaseBndrDmd. No priority right now. ------------------- -mkArgInfo :: SimplEnv -> RuleEnv -> Id -> SimplCont -> ArgInfo - -mkArgInfo env rule_base fun cont +mkArgInfo :: SimplEnv -> Id -> [CoreRule] -> SimplCont -> ArgInfo +mkArgInfo env fun rules_for_fun cont | n_val_args < idArity fun -- Note [Unsaturated functions] = ArgInfo { ai_fun = fun, ai_args = [] - , ai_rewrite = fun_rewrite + , ai_rules = rules_for_fun , ai_encl = False , ai_dmds = vanilla_dmds , ai_discs = vanilla_discounts } | otherwise = ArgInfo { ai_fun = fun , ai_args = [] - , ai_rewrite = fun_rewrite + , ai_rules = rules_for_fun , ai_encl = fun_has_rules || contHasRules cont , ai_dmds = add_type_strictness (idType fun) arg_dmds , ai_discs = arg_discounts } where - n_val_args = countValArgs cont - fun_rewrite = mkRewriteCall fun rule_base - fun_has_rules = case fun_rewrite of - TryRules {} -> True - _ -> False + n_val_args = countValArgs cont + fun_has_rules = not (null rules_for_fun) + vanilla_discounts, arg_discounts :: [Int] vanilla_discounts = repeat 0 arg_discounts = case idUnfolding fun of @@ -873,7 +853,7 @@ got too much fruitless inlining, which led to regressions (#22317 is an example). A good example of a function where this 'small incentive' is important is -GHC.Num.Integer where we ended up with calls like this: +GHC.Internal.Bignum.Integer where we ended up with calls like this: case (integerSignum a b) of r -> ... but were failing to inline integerSignum, even though it always returns a single constructor, so it is very helpful to inline it. There is also an @@ -1069,7 +1049,7 @@ (a) NonTrivArg for an arg with an OtherCon [] unfolding (b) ValueArg for an arg with an OtherCon [c1,c2..] unfolding. -Reason for (a): I found (in the GHC.Num.Integer library) that I was +Reason for (a): I found (in the GHC.Internal.Bignum.Integer module) that I was inlining a pretty big function when all we knew was that its arguments were evaluated, nothing more. That in turn make the enclosing function too big to inline elsewhere. @@ -1516,6 +1496,10 @@ canInlineInLam (Lit _) = True canInlineInLam (Lam b e) = isRuntimeVar b || canInlineInLam e canInlineInLam (Tick t e) = not (tickishIsCode t) && canInlineInLam e + canInlineInLam (Var v) = case idOccInfo v of + OneOcc { occ_in_lam = IsInsideLam } -> True + ManyOccs {} -> True + _ -> False canInlineInLam _ = False -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. @@ -2472,27 +2456,7 @@ True -> True; False -> False -and similar friends. There are some tricky wrinkles: - -(EIC1) Casts. We've seen this: - case e of x { _ -> x `cast` c } - And we definitely want to eliminate this case, to give - e `cast` c -(EIC2) Ticks. Similarly - case e of x { _ -> Tick t x } - At least if the tick is 'floatable' we want to eliminate the case - to give - Tick t e - -So `check_eq` strips off enclosing casts and ticks from the RHS of the -alternative, returning a wrapper function that will rebuild them around -the scrutinee if case-elim is successful. - -(EIC3) What if there are many alternatives, all identities. If casts - are involved they must be the same cast, to make the types line up. - In principle there could be different ticks in each RHS, but we just - pick the ticks from the first alternative. (In the common case there - is only one alternative.) +and similar friends. Note [Scrutinee Constant Folding] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2686,47 +2650,45 @@ -- See Note [Eliminate Identity Case] -------------------------------------------------- -mkCase1 _mode scrut case_bndr _ (alt1 : alts) -- Identity case - | Just wrap <- identity_alt alt1 -- `wrap`: see (EIC1) and (EIC2) - , all (isJust . identity_alt) alts -- See (EIC3) in Note [Eliminate Identity Case] +mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case + | all identity_alt alts = do { tick (CaseIdentity case_bndr) - ; return (wrap scrut) } + ; return (mkTicks ticks $ re_cast scrut rhs1) } where - identity_alt :: CoreAlt -> Maybe (CoreExpr -> CoreExpr) - identity_alt (Alt con args rhs) = check_eq con args rhs + ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts' + identity_alt (Alt con args rhs) = check_eq rhs con args - check_eq :: AltCon -> [Var] -> CoreExpr -> Maybe (CoreExpr -> CoreExpr) - -- (check_eq con args e) return True if - -- e looks like (Tick (Cast (Tick (con args)))) - -- where (con args) is the LHS of the alternative - -- In that case it returns (\e. Tick (Cast (Tick e))), - -- a wrapper function that can rebuild the tick/cast stuff - -- See (EIC1) and (EIC2) in Note [Eliminate Identity Case] - check_eq alt_con args (Cast e co) -- See (EIC1) - = do { guard (not (any (`elemVarSet` tyCoVarsOfCo co) args)) - ; wrap <- check_eq alt_con args e - ; return (flip mkCast co . wrap) } - check_eq alt_con args (Tick t e) -- See (EIC2) - = do { guard (tickishFloatable t) - ; wrap <- check_eq alt_con args e - ; return (Tick t . wrap) } - check_eq alt_con args e - | is_id alt_con args e = Just (\e -> e) - | otherwise = Nothing + check_eq (Cast rhs co) con args -- See Note [RHS casts] + = not (any (`elemVarSet` tyCoVarsOfCo co) args) && check_eq rhs con args + check_eq (Tick t e) alt args + = tickishFloatable t && check_eq e alt args - is_id :: AltCon -> [Var] -> CoreExpr -> Bool - is_id _ _ (Var v) | v == case_bndr = True - is_id (LitAlt lit') _ (Lit lit) = lit == lit' - is_id (DataAlt con) args rhs - | Var v <- rhs -- Optimisation only - , null arg_tys - , null args = v == dataConWorkId con - | otherwise = cheapEqExpr' tickishFloatable rhs $ - mkConApp2 con arg_tys args - is_id _ _ _ = False + check_eq (Lit lit) (LitAlt lit') _ = lit == lit' + check_eq (Var v) _ _ | v == case_bndr = True + check_eq (Var v) (DataAlt con) args + | null arg_tys, null args = v == dataConWorkId con + -- Optimisation only + check_eq rhs (DataAlt con) args = cheapEqExpr' tickishFloatable rhs $ + mkConApp2 con arg_tys args + check_eq _ _ _ = False arg_tys = tyConAppArgs (idType case_bndr) + -- Note [RHS casts] + -- ~~~~~~~~~~~~~~~~ + -- We've seen this: + -- case e of x { _ -> x `cast` c } + -- And we definitely want to eliminate this case, to give + -- e `cast` c + -- So we throw away the cast from the RHS, and reconstruct + -- it at the other end. All the RHS casts must be the same + -- if (all identity_alt alts) holds. + -- + -- Don't worry about nested casts, because the simplifier combines them + + re_cast scrut (Cast rhs co) = Cast (re_cast scrut rhs) co + re_cast scrut _ = scrut + mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts @@ -2842,8 +2804,9 @@ isExitJoinId :: Var -> Bool isExitJoinId id = isJoinId id - && isOneOcc (idOccInfo id) - && occ_in_lam (idOccInfo id) == IsInsideLam + && case idOccInfo id of + OneOcc { occ_in_lam = IsInsideLam } -> True + _ -> False {- Note [Dead binders] diff --git a/GHC/Core/Opt/SpecConstr.hs b/GHC/Core/Opt/SpecConstr.hs --- a/GHC/Core/Opt/SpecConstr.hs +++ b/GHC/Core/Opt/SpecConstr.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE CPP, LambdaCase #-} -#if __GLASGOW_HASKELL__ < 905 -{-# LANGUAGE PatternSynonyms #-} -#endif +{-# LANGUAGE LambdaCase #-} {- ToDo [Oct 2013] ~~~~~~~~~~~~~~~ @@ -14,10 +11,6 @@ \section[SpecConstr]{Specialise over constructors} -} - - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module GHC.Core.Opt.SpecConstr( specConstrProgram, SpecConstrAnnotation(..), @@ -42,7 +35,7 @@ import GHC.Core.Class( classTyVars ) import GHC.Core.Coercion hiding( substCo ) import GHC.Core.Rules -import GHC.Core.Predicate ( typeDeterminesValue ) +import GHC.Core.Predicate ( scopedSort, typeDeterminesValue ) import GHC.Core.Type hiding ( substTy ) import GHC.Core.TyCon (TyCon, tyConName ) import GHC.Core.Multiplicity @@ -68,7 +61,7 @@ import GHC.Types.Unique.FM import GHC.Types.Unique( hasKey ) -import GHC.Data.Maybe ( orElse, catMaybes, isJust, isNothing ) +import GHC.Data.Maybe ( fromMaybe, orElse, catMaybes, isJust, isNothing ) import GHC.Data.FastString import GHC.Utils.Misc @@ -84,6 +77,7 @@ import Control.Monad import Data.List ( sortBy, partition, dropWhileEnd, mapAccumL ) +import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe( mapMaybe ) import Data.Ord( comparing ) import Data.Tuple @@ -1042,16 +1036,7 @@ scSubstId env v = lookupIdSubst (sc_subst env) v --- Solo is only defined in base starting from ghc-9.2 -#if !(MIN_VERSION_base(4, 16, 0)) -data Solo a = Solo a -#endif --- The Solo constructor was renamed to MkSolo in ghc 9.5 -#if __GLASGOW_HASKELL__ < 905 -pattern MkSolo :: a -> Solo a -pattern MkSolo a = Solo a -#endif -- The !subst ensures that we force the selection `(sc_subst env)`, which avoids -- retaining all of `env` when we only need `subst`. The `Solo` means that the @@ -1314,13 +1299,12 @@ scu_occs = plusVarEnv_C combineOcc (scu_occs u1) (scu_occs u2) } combineUsages :: [ScUsage] -> ScUsage -combineUsages [] = nullUsage -combineUsages us = foldr1 combineUsage us +combineUsages = foldr1WithDefault nullUsage combineUsage -lookupOccs :: ScUsage -> [OutVar] -> (ScUsage, [ArgOcc]) +lookupOccs :: Traversable f => ScUsage -> f OutVar -> (ScUsage, f ArgOcc) lookupOccs (SCU { scu_calls = sc_calls, scu_occs = sc_occs }) bndrs = (SCU {scu_calls = sc_calls, scu_occs = delVarEnvList sc_occs bndrs}, - [lookupVarEnv sc_occs b `orElse` NoOcc | b <- bndrs]) + fromMaybe NoOcc . lookupVarEnv sc_occs <$> bndrs) data ArgOcc = NoOcc -- Doesn't occur at all; or a type argument | UnkOcc -- Used in some unknown way @@ -1383,7 +1367,7 @@ combineOcc UnkOcc UnkOcc = UnkOcc combineOccs :: [ArgOcc] -> [ArgOcc] -> [ArgOcc] -combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys +combineOccs xs ys = zipWithEqual combineOcc xs ys setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage -- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee @@ -1490,7 +1474,7 @@ ; let all_usg = (spec_usg `combineUsage` body_usg) -- Note [spec_usg includes rhs_usg] `delCallsFor` bndrs' - bind' = Rec (concat (zipWithEqual "scExpr'" ruleInfoBinds rhs_infos specs)) + bind' = Rec (concat (zipWithEqual ruleInfoBinds rhs_infos specs)) -- zipWithEqual: length of returned [SpecInfo] -- should be the same as incoming [RhsInfo] @@ -1596,7 +1580,7 @@ = do { let (env1, bs1) = extendBndrsWith RecArg env bs (env2, bs2) = extendCaseBndrs env1 scrut' b' con bs1 ; (usg, rhs', ws) <- scExpr env2 rhs - ; let (usg', b_occ:arg_occs) = lookupOccs usg (b':bs2) + ; let (usg', b_occ:|arg_occs) = lookupOccs usg (b':|bs2) scrut_occ = case con of DataAlt dc -- See Note [Do not specialise evals] | not (single_alt && all deadArgOcc arg_occs) @@ -2465,7 +2449,7 @@ good_pats :: [CallPat] good_pats = catMaybes mb_pats - in_scope = getSubstInScope (sc_subst env) + in_scope = substInScopeSet (sc_subst env) -- Remove patterns we have already done new_pats = filterOut is_done good_pats @@ -2512,35 +2496,32 @@ partitionByWorkerSize worker_size pats = go pats [] [] where go [] small warnings = (small, warnings) - go (p:ps) small warnings - | WorkerSmallEnough <- worker_size p - = go ps (p:small) warnings - | WorkerTooLarge <- worker_size p - = go ps small warnings - | WorkerTooLargeForced name <- worker_size p - = go ps small (SpecFailForcedArgCount name : warnings) + go (p:ps) small warnings = + case worker_size p of + WorkerSmallEnough -> go ps (p:small) warnings + WorkerTooLarge -> go ps small warnings + WorkerTooLargeForced name -> go ps small (SpecFailForcedArgCount name : warnings) trim_pats :: ScEnv -> Id -> SpecInfo -> [CallPat] -> (Bool, [CallPat]) -- True <=> some patterns were discarded -- See Note [Choosing patterns] trim_pats env fn (SI { si_n_specs = done_spec_count }) pats - | sc_force env - || isNothing mb_scc - || n_remaining >= n_pats - = -- pprTrace "trim_pats: no-trim" (ppr (sc_force env) $$ ppr mb_scc $$ ppr n_remaining $$ ppr n_pats) - (False, pats) -- No need to trim + | False <- sc_force env + , Just max_specs <- mb_scc + , let n_remaining = max_specs - done_spec_count + , n_remaining < n_pats + = emit_trace max_specs n_remaining $ -- Need to trim, so keep the best ones + (True, take n_remaining sorted_pats) | otherwise - = emit_trace $ -- Need to trim, so keep the best ones - (True, take n_remaining sorted_pats) + = -- pprTrace "trim_pats: no-trim" (ppr (sc_force env) $$ ppr mb_scc $$ ppr n_remaining $$ ppr n_pats) + (False, pats) -- No need to trim where n_pats = length pats spec_count' = n_pats + done_spec_count - n_remaining = max_specs - done_spec_count mb_scc = sc_count $ sc_opts env - Just max_specs = mb_scc sorted_pats = map fst $ sortBy (comparing snd) $ @@ -2563,21 +2544,24 @@ n_cons (Lit {}) = 1 n_cons _ = 0 - emit_trace result + emit_trace max_specs n_remaining result | debugIsOn || sc_debug (sc_opts env) -- Suppress this scary message for ordinary users! #5125 = pprTrace "SpecConstr" msg result | otherwise = result - msg = vcat [ sep [ text "Function" <+> quotes (ppr fn) - , nest 2 (text "has" <+> - speakNOf spec_count' (text "call pattern") <> comma <+> - text "but the limit is" <+> int max_specs) ] - , text "Use -fspec-constr-count=n to set the bound" - , text "done_spec_count =" <+> int done_spec_count - , text "Keeping " <+> int n_remaining <> text ", out of" <+> int n_pats - , text "Discarding:" <+> ppr (drop n_remaining sorted_pats) ] - + where + msg = vcat + [ sep + [ text "Function" <+> quotes (ppr fn) + , nest 2 + ( text "has" <+> + speakNOf spec_count' (text "call pattern") <> comma <+> + text "but the limit is" <+> int max_specs ) ] + , text "Use -fspec-constr-count=n to set the bound" + , text "done_spec_count =" <+> int done_spec_count + , text "Keeping " <+> int n_remaining <> text ", out of" <+> int n_pats + , text "Discarding:" <+> ppr (drop n_remaining sorted_pats) ] callToPat :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat) -- The [Var] is the variables to quantify over in the rule @@ -2585,7 +2569,7 @@ -- over the following term variables -- The [CoreExpr] are the argument patterns for the rule callToPat env bndr_occs call@(Call fn args con_env) - = do { let in_scope = getSubstInScope (sc_subst env) + = do { let in_scope = substInScopeSet (sc_subst env) ; arg_triples <- zipWith3M (argToPat env in_scope con_env) args bndr_occs (map (const NotMarkedStrict) args) -- This zip trims the args to be no longer than @@ -2842,8 +2826,11 @@ -- but that doesn't take account of which branch of a -- case we are in, which is the whole point - | not (isLocalId v) && isCheapUnfolding unf - = isValue env (unfoldingTemplate unf) + | not (isLocalId v) + , isCheapUnfolding unf + , Just rhs <- maybeUnfoldingTemplate unf -- Succeds if isCheapUnfolding does + = isValue env rhs -- Can't use isEvaldUnfolding because + -- we want to consult the `env` where unf = idUnfolding v -- However we do want to consult the unfolding diff --git a/GHC/Core/Opt/Specialise.hs b/GHC/Core/Opt/Specialise.hs --- a/GHC/Core/Opt/Specialise.hs +++ b/GHC/Core/Opt/Specialise.hs @@ -1,3531 +1,3660 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -{- -(c) The GRASP/AQUA Project, Glasgow University, 1993-1998 - -\section[Specialise]{Stamping out overloading, and (optionally) polymorphism} --} - -module GHC.Core.Opt.Specialise ( specProgram, specUnfolding ) where - -import GHC.Prelude - -import GHC.Driver.DynFlags -import GHC.Driver.Config -import GHC.Driver.Config.Diagnostic -import GHC.Driver.Config.Core.Rules ( initRuleOpts ) - -import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) -import GHC.Core.Multiplicity -import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith ) -import GHC.Core.Predicate -import GHC.Core.Coercion( Coercion ) -import GHC.Core.Opt.Monad -import qualified GHC.Core.Subst as Core -import GHC.Core.Unfold.Make -import GHC.Core -import GHC.Core.Make ( mkLitRubbish ) -import GHC.Core.Unify ( tcMatchTy ) -import GHC.Core.Rules -import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable - , mkCast, exprType - , stripTicksTop, mkInScopeSetBndrs ) -import GHC.Core.FVs -import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList ) -import GHC.Core.Opt.Arity( collectBindersPushingCo ) --- import GHC.Core.Ppr( pprIds ) - -import GHC.Builtin.Types ( unboxedUnitTy ) - -import GHC.Data.Maybe ( maybeToList, isJust ) -import GHC.Data.Bag -import GHC.Data.OrdList -import GHC.Data.List.SetOps - -import GHC.Types.Basic -import GHC.Types.Unique.Supply -import GHC.Types.Unique.DFM -import GHC.Types.Name -import GHC.Types.Tickish -import GHC.Types.Id.Make ( voidArgId, voidPrimId ) -import GHC.Types.Var ( PiTyBinder(..), isLocalVar, isInvisibleFunArg, mkLocalVar ) -import GHC.Types.Var.Set -import GHC.Types.Var.Env -import GHC.Types.Id -import GHC.Types.Id.Info -import GHC.Types.Error - -import GHC.Utils.Error ( mkMCDiagnostic ) -import GHC.Utils.Monad ( foldlM ) -import GHC.Utils.Misc -import GHC.Utils.Outputable -import GHC.Utils.Panic - -import GHC.Unit.Module( Module ) -import GHC.Unit.Module.ModGuts -import GHC.Core.Unfold - -import Data.List( partition ) -import Data.List.NonEmpty ( NonEmpty (..) ) -import GHC.Core.Subst (substTickish) - -{- -************************************************************************ -* * -\subsection[notes-Specialise]{Implementation notes [SLPJ, Aug 18 1993]} -* * -************************************************************************ - -These notes describe how we implement specialisation to eliminate -overloading. - -The specialisation pass works on Core -syntax, complete with all the explicit dictionary application, -abstraction and construction as added by the type checker. The -existing type checker remains largely as it is. - -One important thought: the {\em types} passed to an overloaded -function, and the {\em dictionaries} passed are mutually redundant. -If the same function is applied to the same type(s) then it is sure to -be applied to the same dictionary(s)---or rather to the same {\em -values}. (The arguments might look different but they will evaluate -to the same value.) - -Second important thought: we know that we can make progress by -treating dictionary arguments as static and worth specialising on. So -we can do without binding-time analysis, and instead specialise on -dictionary arguments and no others. - -The basic idea -~~~~~~~~~~~~~~ -Suppose we have - - let f = - in - -and suppose f is overloaded. - -STEP 1: CALL-INSTANCE COLLECTION - -We traverse , accumulating all applications of f to types and -dictionaries. - -(Might there be partial applications, to just some of its types and -dictionaries? In principle yes, but in practice the type checker only -builds applications of f to all its types and dictionaries, so partial -applications could only arise as a result of transformation, and even -then I think it's unlikely. In any case, we simply don't accumulate such -partial applications.) - - -STEP 2: EQUIVALENCES - -So now we have a collection of calls to f: - f t1 t2 d1 d2 - f t3 t4 d3 d4 - ... -Notice that f may take several type arguments. To avoid ambiguity, we -say that f is called at type t1/t2 and t3/t4. - -We take equivalence classes using equality of the *types* (ignoring -the dictionary args, which as mentioned previously are redundant). - -STEP 3: SPECIALISATION - -For each equivalence class, choose a representative (f t1 t2 d1 d2), -and create a local instance of f, defined thus: - - f@t1/t2 = t1 t2 d1 d2 - -f_rhs presumably has some big lambdas and dictionary lambdas, so lots -of simplification will now result. However we don't actually *do* that -simplification. Rather, we leave it for the simplifier to do. If we -*did* do it, though, we'd get more call instances from the specialised -RHS. We can work out what they are by instantiating the call-instance -set from f's RHS with the types t1, t2. - -Add this new id to f's IdInfo, to record that f has a specialised version. - -Before doing any of this, check that f's IdInfo doesn't already -tell us about an existing instance of f at the required type/s. -(This might happen if specialisation was applied more than once, or -it might arise from user SPECIALIZE pragmas.) - -Recursion -~~~~~~~~~ -Wait a minute! What if f is recursive? Then we can't just plug in -its right-hand side, can we? - -But it's ok. The type checker *always* creates non-recursive definitions -for overloaded recursive functions. For example: - - f x = f (x+x) -- Yes I know its silly - -becomes - - f a (d::Num a) = let p = +.sel a d - in - letrec fl (y::a) = fl (p y y) - in - fl - -We still have recursion for non-overloaded functions which we -specialise, but the recursive call should get specialised to the -same recursive version. - - -Polymorphism 1 -~~~~~~~~~~~~~~ - -All this is crystal clear when the function is applied to *constant -types*; that is, types which have no type variables inside. But what if -it is applied to non-constant types? Suppose we find a call of f at type -t1/t2. There are two possibilities: - -(a) The free type variables of t1, t2 are in scope at the definition point -of f. In this case there's no problem, we proceed just as before. A common -example is as follows. Here's the Haskell: - - g y = let f x = x+x - in f y + f y - -After typechecking we have - - g a (d::Num a) (y::a) = let f b (d'::Num b) (x::b) = +.sel b d' x x - in +.sel a d (f a d y) (f a d y) - -Notice that the call to f is at type type "a"; a non-constant type. -Both calls to f are at the same type, so we can specialise to give: - - g a (d::Num a) (y::a) = let f@a (x::a) = +.sel a d x x - in +.sel a d (f@a y) (f@a y) - - -(b) The other case is when the type variables in the instance types -are *not* in scope at the definition point of f. The example we are -working with above is a good case. There are two instances of (+.sel a d), -but "a" is not in scope at the definition of +.sel. Can we do anything? -Yes, we can "common them up", a sort of limited common sub-expression deal. -This would give: - - g a (d::Num a) (y::a) = let +.sel@a = +.sel a d - f@a (x::a) = +.sel@a x x - in +.sel@a (f@a y) (f@a y) - -This can save work, and can't be spotted by the type checker, because -the two instances of +.sel weren't originally at the same type. - -Further notes on (b) - -* There are quite a few variations here. For example, the defn of - +.sel could be floated outside the \y, to attempt to gain laziness. - It certainly mustn't be floated outside the \d because the d has to - be in scope too. - -* We don't want to inline f_rhs in this case, because -that will duplicate code. Just commoning up the call is the point. - -* Nothing gets added to +.sel's IdInfo. - -* Don't bother unless the equivalence class has more than one item! - -Not clear whether this is all worth it. It is of course OK to -simply discard call-instances when passing a big lambda. - -Polymorphism 2 -- Overloading -~~~~~~~~~~~~~~ -Consider a function whose most general type is - - f :: forall a b. Ord a => [a] -> b -> b - -There is really no point in making a version of g at Int/Int and another -at Int/Bool, because it's only instantiating the type variable "a" which -buys us any efficiency. Since g is completely polymorphic in b there -ain't much point in making separate versions of g for the different -b types. - -That suggests that we should identify which of g's type variables -are constrained (like "a") and which are unconstrained (like "b"). -Then when taking equivalence classes in STEP 2, we ignore the type args -corresponding to unconstrained type variable. In STEP 3 we make -polymorphic versions. Thus: - - f@t1/ = /\b -> t1 b d1 d2 - -We do this. - - -Dictionary floating -~~~~~~~~~~~~~~~~~~~ -Consider this - - f a (d::Num a) = let g = ... - in - ...(let d1::Ord a = Num.Ord.sel a d in g a d1)... - -Here, g is only called at one type, but the dictionary isn't in scope at the -definition point for g. Usually the type checker would build a -definition for d1 which enclosed g, but the transformation system -might have moved d1's defn inward. Solution: float dictionary bindings -outwards along with call instances. - -Consider - - f x = let g p q = p==q - h r s = (r+s, g r s) - in - h x x - - -Before specialisation, leaving out type abstractions we have - - f df x = let g :: Eq a => a -> a -> Bool - g dg p q = == dg p q - h :: Num a => a -> a -> (a, Bool) - h dh r s = let deq = eqFromNum dh - in (+ dh r s, g deq r s) - in - h df x x - -After specialising h we get a specialised version of h, like this: - - h' r s = let deq = eqFromNum df - in (+ df r s, g deq r s) - -But we can't naively make an instance for g from this, because deq is not in scope -at the defn of g. Instead, we have to float out the (new) defn of deq -to widen its scope. Notice that this floating can't be done in advance -- it only -shows up when specialisation is done. - -User SPECIALIZE pragmas -~~~~~~~~~~~~~~~~~~~~~~~ -Specialisation pragmas can be digested by the type checker, and implemented -by adding extra definitions along with that of f, in the same way as before - - f@t1/t2 = t1 t2 d1 d2 - -Indeed the pragmas *have* to be dealt with by the type checker, because -only it knows how to build the dictionaries d1 and d2! For example - - g :: Ord a => [a] -> [a] - {-# SPECIALIZE f :: [Tree Int] -> [Tree Int] #-} - -Here, the specialised version of g is an application of g's rhs to the -Ord dictionary for (Tree Int), which only the type checker can conjure -up. There might not even *be* one, if (Tree Int) is not an instance of -Ord! (All the other specialisation has suitable dictionaries to hand -from actual calls.) - -Problem. The type checker doesn't have to hand a convenient , because -it is buried in a complex (as-yet-un-desugared) binding group. -Maybe we should say - - f@t1/t2 = f* t1 t2 d1 d2 - -where f* is the Id f with an IdInfo which says "inline me regardless!". -Indeed all the specialisation could be done in this way. -That in turn means that the simplifier has to be prepared to inline absolutely -any in-scope let-bound thing. - - -Again, the pragma should permit polymorphism in unconstrained variables: - - h :: Ord a => [a] -> b -> b - {-# SPECIALIZE h :: [Int] -> b -> b #-} - -We *insist* that all overloaded type variables are specialised to ground types, -(and hence there can be no context inside a SPECIALIZE pragma). -We *permit* unconstrained type variables to be specialised to - - a ground type - - or left as a polymorphic type variable -but nothing in between. So - - {-# SPECIALIZE h :: [Int] -> [c] -> [c] #-} - -is *illegal*. (It can be handled, but it adds complication, and gains the -programmer nothing.) - - -SPECIALISING INSTANCE DECLARATIONS -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - - instance Foo a => Foo [a] where - ... - {-# SPECIALIZE instance Foo [Int] #-} - -The original instance decl creates a dictionary-function -definition: - - dfun.Foo.List :: forall a. Foo a -> Foo [a] - -The SPECIALIZE pragma just makes a specialised copy, just as for -ordinary function definitions: - - dfun.Foo.List@Int :: Foo [Int] - dfun.Foo.List@Int = dfun.Foo.List Int dFooInt - -The information about what instance of the dfun exist gets added to -the dfun's IdInfo in the same way as a user-defined function too. - - -Automatic instance decl specialisation? -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Can instance decls be specialised automatically? It's tricky. -We could collect call-instance information for each dfun, but -then when we specialised their bodies we'd get new call-instances -for ordinary functions; and when we specialised their bodies, we might get -new call-instances of the dfuns, and so on. This all arises because of -the unrestricted mutual recursion between instance decls and value decls. - -Still, there's no actual problem; it just means that we may not do all -the specialisation we could theoretically do. - -Furthermore, instance decls are usually exported and used non-locally, -so we'll want to compile enough to get those specialisations done. - -Lastly, there's no such thing as a local instance decl, so we can -survive solely by spitting out *usage* information, and then reading that -back in as a pragma when next compiling the file. So for now, -we only specialise instance decls in response to pragmas. - - -SPITTING OUT USAGE INFORMATION -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -To spit out usage information we need to traverse the code collecting -call-instance information for all imported (non-prelude?) functions -and data types. Then we equivalence-class it and spit it out. - -This is done at the top-level when all the call instances which escape -must be for imported functions and data types. - -*** Not currently done *** - - -Partial specialisation by pragmas -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What about partial specialisation: - - k :: (Ord a, Eq b) => [a] -> b -> b -> [a] - {-# SPECIALIZE k :: Eq b => [Int] -> b -> b -> [a] #-} - -or even - - {-# SPECIALIZE k :: Eq b => [Int] -> [b] -> [b] -> [a] #-} - -Seems quite reasonable. Similar things could be done with instance decls: - - instance (Foo a, Foo b) => Foo (a,b) where - ... - {-# SPECIALIZE instance Foo a => Foo (a,Int) #-} - {-# SPECIALIZE instance Foo b => Foo (Int,b) #-} - -Ho hum. Things are complex enough without this. I pass. - - -Requirements for the simplifier -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The simplifier has to be able to take advantage of the specialisation. - -* When the simplifier finds an application of a polymorphic f, it looks in -f's IdInfo in case there is a suitable instance to call instead. This converts - - f t1 t2 d1 d2 ===> f_t1_t2 - -Note that the dictionaries get eaten up too! - -* Dictionary selection operations on constant dictionaries must be - short-circuited: - - +.sel Int d ===> +Int - -The obvious way to do this is in the same way as other specialised -calls: +.sel has inside it some IdInfo which tells that if it's applied -to the type Int then it should eat a dictionary and transform to +Int. - -In short, dictionary selectors need IdInfo inside them for constant -methods. - -* Exactly the same applies if a superclass dictionary is being - extracted: - - Eq.sel Int d ===> dEqInt - -* Something similar applies to dictionary construction too. Suppose -dfun.Eq.List is the function taking a dictionary for (Eq a) to -one for (Eq [a]). Then we want - - dfun.Eq.List Int d ===> dEq.List_Int - -Where does the Eq [Int] dictionary come from? It is built in -response to a SPECIALIZE pragma on the Eq [a] instance decl. - -In short, dfun Ids need IdInfo with a specialisation for each -constant instance of their instance declaration. - -All this uses a single mechanism: the SpecEnv inside an Id - - -What does the specialisation IdInfo look like? -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The SpecEnv of an Id maps a list of types (the template) to an expression - - [Type] |-> Expr - -For example, if f has this RuleInfo: - - [Int, a] -> \d:Ord Int. f' a - -it means that we can replace the call - - f Int t ===> (\d. f' t) - -This chucks one dictionary away and proceeds with the -specialised version of f, namely f'. - - -What can't be done this way? -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There is no way, post-typechecker, to get a dictionary for (say) -Eq a from a dictionary for Eq [a]. So if we find - - ==.sel [t] d - -we can't transform to - - eqList (==.sel t d') - -where - eqList :: (a->a->Bool) -> [a] -> [a] -> Bool - -Of course, we currently have no way to automatically derive -eqList, nor to connect it to the Eq [a] instance decl, but you -can imagine that it might somehow be possible. Taking advantage -of this is permanently ruled out. - -Still, this is no great hardship, because we intend to eliminate -overloading altogether anyway! - -A note about non-tyvar dictionaries -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some Ids have types like - - forall a,b,c. Eq a -> Ord [a] -> tau - -This seems curious at first, because we usually only have dictionary -args whose types are of the form (C a) where a is a type variable. -But this doesn't hold for the functions arising from instance decls, -which sometimes get arguments with types of form (C (T a)) for some -type constructor T. - -Should we specialise wrt this compound-type dictionary? We used to say -"no", saying: - "This is a heuristic judgement, as indeed is the fact that we - specialise wrt only dictionaries. We choose *not* to specialise - wrt compound dictionaries because at the moment the only place - they show up is in instance decls, where they are simply plugged - into a returned dictionary. So nothing is gained by specialising - wrt them." - -But it is simpler and more uniform to specialise wrt these dicts too; -and in future GHC is likely to support full fledged type signatures -like - f :: Eq [(a,b)] => ... - - -Note [Specialisation and overlapping instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Here is at tricky case (see a comment in MR !8916): - - module A where - class C a where - meth :: a -> String - instance {-# OVERLAPPABLE #-} C (Maybe a) where - meth _ = "Maybe" - - {-# SPECIALISE f :: Maybe a -> Bool -> String #-} - f :: C a => a -> Bool -> String - f a True = f a False - f a _ = meth a - - module B where - import A - - instance C (Maybe Int) where - meth _ = "Int" - - main = putStrLn $ f (Just 42 :: Maybe Int) True - -Running main without optimisations yields "Int", the correct answer. -Activating optimisations yields "Maybe" due to a rewrite rule in module -A generated by the SPECIALISE pragma: - - RULE "USPEC f" forall a (d :: C a). f @a d = $sf - -In B we get the call (f @(Maybe Int) (d :: C (Maybe Int))), and -that rewrites to $sf, but that isn't really right. - -Overlapping instances mean that `C (Maybe Int)` is not a singleton -type: there two distinct dictionaries that have this type. And that -spells trouble for specialistion, which really asssumes singleton -types. - -For now, we just accept this problem, but it may bite us one day. -One solution would be to decline to expose any specialisation rules -to an importing module -- but that seems a bit drastic. - - -************************************************************************ -* * -\subsubsection{The new specialiser} -* * -************************************************************************ - -Our basic game plan is this. For let(rec) bound function - f :: (C a, D c) => (a,b,c,d) -> Bool - -* Find any specialised calls of f, (f ts ds), where - ts are the type arguments t1 .. t4, and - ds are the dictionary arguments d1 .. d2. - -* Add a new definition for f1 (say): - - f1 = /\ b d -> (..body of f..) t1 b t3 d d1 d2 - - Note that we abstract over the unconstrained type arguments. - -* Add the mapping - - [t1,b,t3,d] |-> \d1 d2 -> f1 b d - - to the specialisations of f. This will be used by the - simplifier to replace calls - (f t1 t2 t3 t4) da db - by - (\d1 d1 -> f1 t2 t4) da db - - All the stuff about how many dictionaries to discard, and what types - to apply the specialised function to, are handled by the fact that the - SpecEnv contains a template for the result of the specialisation. - -We don't build *partial* specialisations for f. For example: - - f :: Eq a => a -> a -> Bool - {-# SPECIALISE f :: (Eq b, Eq c) => (b,c) -> (b,c) -> Bool #-} - -Here, little is gained by making a specialised copy of f. -There's a distinct danger that the specialised version would -first build a dictionary for (Eq b, Eq c), and then select the (==) -method from it! Even if it didn't, not a great deal is saved. - -We do, however, generate polymorphic, but not overloaded, specialisations: - - f :: Eq a => [a] -> b -> b -> b - ... SPECIALISE f :: [Int] -> b -> b -> b ... - -Hence, the invariant is this: - - *** no specialised version is overloaded *** - - -************************************************************************ -* * -\subsubsection{The exported function} -* * -************************************************************************ --} - --- | Specialise calls to type-class overloaded functions occurring in a program. -specProgram :: ModGuts -> CoreM ModGuts -specProgram guts@(ModGuts { mg_module = this_mod - , mg_rules = local_rules - , mg_binds = binds }) - = do { dflags <- getDynFlags - ; rule_env <- initRuleEnv guts - -- See Note [Fire rules in the specialiser] - - -- We need to start with a Subst that knows all the things - -- that are in scope, so that the substitution engine doesn't - -- accidentally re-use a unique that's already in use - -- Easiest thing is to do it all at once, as if all the top-level - -- decls were mutually recursive - ; let top_env = SE { se_subst = Core.mkEmptySubst $ - mkInScopeSetBndrs binds - , se_module = this_mod - , se_rules = rule_env - , se_dflags = dflags } - - go [] = return ([], emptyUDs) - go (bind:binds) = do (bind', binds', uds') <- specBind TopLevel top_env bind $ \_ -> - go binds - return (bind' ++ binds', uds') - - -- Specialise the bindings of this module - ; (binds', uds) <- runSpecM (go binds) - - ; (spec_rules, spec_binds) <- specImports top_env uds - - ; return (guts { mg_binds = spec_binds ++ binds' - , mg_rules = spec_rules ++ local_rules }) } - -{- -Note [Wrap bindings returned by specImports] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'specImports' returns a set of specialized bindings. However, these are lacking -necessary floated dictionary bindings, which are returned by -UsageDetails(ud_binds). These dictionaries need to be brought into scope with -'wrapDictBinds' before the bindings returned by 'specImports' can be used. See, -for instance, the 'specImports' call in 'specProgram'. - - -Note [Disabling cross-module specialisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Since GHC 7.10 we have performed specialisation of INLINABLE bindings living -in modules outside of the current module. This can sometimes uncover user code -which explodes in size when aggressively optimized. The --fno-cross-module-specialise option was introduced to allow users to being -bitten by such instances to revert to the pre-7.10 behavior. - -See #10491 --} - - -{- ********************************************************************* -* * - Specialising imported functions -* * -********************************************************************* -} - -{- Note [Specialising imported functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -specImports specialises imported functions, based on calls in this module. - -When -fspecialise-aggressively is on, we specialise any imported -function for which we have an unfolding. The --fspecialise-aggressively flag is usually off, because we risk lots of -orphan modules from over-vigorous specialisation. (See Note [Orphans] -in GHC.Core.) However it's not a big deal: anything non-recursive with -an unfolding-template will probably have been inlined already. - -When -fspecialise-aggressively is off, we are more selective about -specialisation (see canSpecImport): - -(1) Without -fspecialise-aggressively, do not specialise - DFunUnfoldings. Note [Do not specialise imported DFuns]. - -(2) Without -fspecialise-aggressively, specialise only imported things - that have a /user-supplied/ INLINE or INLINABLE pragma (hence - isAnyInlinePragma rather than isStableSource). - - In particular, we don't want to specialise workers created by - worker/wrapper (for functions with no pragma) because they won't - specialise usefully, and they generate quite a bit of useless code - bloat. - - Specialise even INLINE things; it hasn't inlined yet, so perhaps - it never will. Moreover it may have calls inside it that we want - to specialise - -Wrinkle (W1): If we specialise an imported Id M.foo, we make a /local/ -binding $sfoo. But specImports may further specialise $sfoo. So we end up -with RULES for both M.foo (imported) and $sfoo (local). Rules for local -Ids should be attached to the Ids themselves (see GHC.HsToCore -Note [Attach rules to local ids]); so we must partition the rules and -attach the local rules. That is done in specImports, via addRulesToId. - -Note [Glom the bindings if imported functions are specialised] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have an imported, *recursive*, INLINABLE function - f :: Eq a => a -> a - f = /\a \d x. ...(f a d)... -In the module being compiled we have - g x = f (x::Int) -Now we'll make a specialised function - f_spec :: Int -> Int - f_spec = \x -> ...(f Int dInt)... - {-# RULE f Int _ = f_spec #-} - g = \x. f Int dInt x -Note that f_spec doesn't look recursive -After rewriting with the RULE, we get - f_spec = \x -> ...(f_spec)... -BUT since f_spec was non-recursive before it'll *stay* non-recursive. -The occurrence analyser never turns a NonRec into a Rec. So we must -make sure that f_spec is recursive. Easiest thing is to make all -the specialisations for imported bindings recursive. --} - -specImports :: SpecEnv - -> UsageDetails - -> CoreM ([CoreRule], [CoreBind]) -specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls }) - | not $ gopt Opt_CrossModuleSpecialise (se_dflags top_env) - -- See Note [Disabling cross-module specialisation] - = return ([], wrapDictBinds dict_binds []) - - | otherwise - = do { let env_w_dict_bndrs = top_env `bringFloatedDictsIntoScope` dict_binds - ; (_env, spec_rules, spec_binds) <- spec_imports env_w_dict_bndrs [] dict_binds calls - - -- Make a Rec: see Note [Glom the bindings if imported functions are specialised] - -- - -- wrapDictBinds: don't forget to wrap the specialized bindings with - -- bindings for the needed dictionaries. - -- See Note [Wrap bindings returned by specImports] - -- - -- addRulesToId: see Wrinkle (W1) in Note [Specialising imported functions] - -- c.f. GHC.HsToCore.addExportFlagsAndRules - ; let (rules_for_locals, rules_for_imps) = partition isLocalRule spec_rules - local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals - final_binds - | null spec_binds = wrapDictBinds dict_binds [] - | otherwise = [Rec $ mapFst (addRulesToId local_rule_base) $ - flattenBinds $ - wrapDictBinds dict_binds $ - spec_binds] - - ; return (rules_for_imps, final_binds) - } - --- | Specialise a set of calls to imported bindings -spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in scope - ---In-scope set includes the FloatedDictBinds - -> [Id] -- Stack of imported functions being specialised - -- See Note [specImport call stack] - -> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls - -- See Note [Avoiding loops in specImports] - -> CallDetails -- Calls for imported things - -> CoreM ( SpecEnv -- Env contains the new rules - , [CoreRule] -- New rules - , [CoreBind] ) -- Specialised bindings -spec_imports env callers dict_binds calls - = do { let import_calls = dVarEnvElts calls --- ; debugTraceMsg (text "specImports {" <+> --- vcat [ text "calls:" <+> ppr import_calls --- , text "dict_binds:" <+> ppr dict_binds ]) - ; (env, rules, spec_binds) <- go env import_calls --- ; debugTraceMsg (text "End specImports }" <+> ppr import_calls) - - ; return (env, rules, spec_binds) } - where - go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind]) - go env [] = return (env, [], []) - go env (cis : other_calls) - = do { --- debugTraceMsg (text "specImport {" <+> vcat [ ppr cis --- , text "callers" <+> ppr callers --- , text "dict_binds" <+> ppr dict_binds ]) - ; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis --- ; debugTraceMsg (text "specImport }" <+> ppr cis) - - ; (env, rules2, spec_binds2) <- go env other_calls - ; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) } - -spec_import :: SpecEnv -- Passed in so that all top-level Ids are in scope - ---In-scope set includes the FloatedDictBinds - -> [Id] -- Stack of imported functions being specialised - -- See Note [specImport call stack] - -> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls - -- See Note [Avoiding loops in specImports] - -> CallInfoSet -- Imported function and calls for it - -> CoreM ( SpecEnv - , [CoreRule] -- New rules - , [CoreBind] ) -- Specialised bindings -spec_import env callers dict_binds cis@(CIS fn _) - | isIn "specImport" fn callers - = do { --- debugTraceMsg (text "specImport1-bad" <+> (ppr fn $$ text "callers" <+> ppr callers)) - ; return (env, [], []) } - -- No warning. This actually happens all the time - -- when specialising a recursive function, because - -- the RHS of the specialised function contains a recursive - -- call to the original function - - | null good_calls - = do { --- debugTraceMsg (text "specImport1-no-good" <+> (ppr cis $$ text "dict_binds" <+> ppr dict_binds)) - ; return (env, [], []) } - - | Just rhs <- canSpecImport dflags fn - = do { -- Get rules from the external package state - -- We keep doing this in case we "page-fault in" - -- more rules as we go along - ; eps_rules <- getExternalRuleBase - ; let rule_env = se_rules env `updExternalPackageRules` eps_rules - --- ; debugTraceMsg (text "specImport1" <+> vcat --- [ text "function:" <+> ppr fn --- , text "good calls:" <+> ppr good_calls --- , text "existing rules:" <+> ppr (getRules rule_env fn) --- , text "rhs:" <+> ppr rhs --- , text "dict_binds:" <+> ppr dict_binds ]) - - ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) - <- runSpecM $ specCalls True env (getRules rule_env fn) good_calls fn rhs - - ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs] - -- After the rules kick in, via fireRewriteRules, we may get recursion, - -- but we rely on a global GlomBinds to sort that out later - -- See Note [Glom the bindings if imported functions are specialised] - -- Meanwhile, though, bring the binders into scope - - new_subst = se_subst env `Core.extendSubstInScopeList` map fst spec_pairs - new_env = env { se_rules = rule_env `addLocalRules` rules1 - , se_subst = new_subst } - `bringFloatedDictsIntoScope` dict_binds1 - - -- Now specialise any cascaded calls --- ; debugTraceMsg (text "specImport 2" <+> vcat --- [ text "function:" <+> ppr fn --- , text "rules1:" <+> ppr rules1 --- , text "spec_binds1" <+> ppr spec_binds1 --- , text "dict_binds1" <+> ppr dict_binds1 --- , text "new_calls" <+> ppr new_calls ]) - - ; (env, rules2, spec_binds2) - <- spec_imports new_env (fn:callers) - (dict_binds `thenFDBs` dict_binds1) - new_calls - - ; let final_binds = wrapDictBinds dict_binds1 $ - spec_binds2 ++ spec_binds1 - - ; return (env, rules2 ++ rules1, final_binds) } - - | otherwise - = do { --- debugTraceMsg (hang (text "specImport1-missed") --- 2 (vcat [ppr cis, text "can-spec" <+> ppr (canSpecImport dflags fn)])) - ; tryWarnMissingSpecs dflags callers fn good_calls - ; return (env, [], [])} - - where - dflags = se_dflags env - good_calls = filterCalls cis dict_binds - -- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn - -- See Note [Avoiding loops in specImports] - -canSpecImport :: DynFlags -> Id -> Maybe CoreExpr -canSpecImport dflags fn - | isDataConWrapId fn - = Nothing -- Don't specialise data-con wrappers, even if they - -- have dict args; there is no benefit. - - | CoreUnfolding { uf_tmpl = rhs } <- unf - -- CoreUnfolding: see Note [Specialising imported functions] point (1). - , isAnyInlinePragma (idInlinePragma fn) - -- See Note [Specialising imported functions] point (2). - = Just rhs - - | gopt Opt_SpecialiseAggressively dflags - = maybeUnfoldingTemplate unf - -- With -fspecialise-aggressively, specialise anything - -- with an unfolding, stable or not, DFun or not - - | otherwise = Nothing - where - unf = realIdUnfolding fn -- We want to see the unfolding even for loop breakers - --- | Returns whether or not to show a missed-spec warning. --- If -Wall-missed-specializations is on, show the warning. --- Otherwise, if -Wmissed-specializations is on, only show a warning --- if there is at least one imported function being specialized, --- and if all imported functions are marked with an inline pragma --- Use the most specific warning as the reason. -tryWarnMissingSpecs :: DynFlags -> [Id] -> Id -> [CallInfo] -> CoreM () --- See Note [Warning about missed specialisations] -tryWarnMissingSpecs dflags callers fn calls_for_fn - | isClassOpId fn = return () -- See Note [Missed specialisation for ClassOps] - | wopt Opt_WarnMissedSpecs dflags - && not (null callers) - && allCallersInlined = doWarn $ WarningWithFlag Opt_WarnMissedSpecs - | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs - | otherwise = return () - where - allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers - diag_opts = initDiagOpts dflags - doWarn reason = - msg (mkMCDiagnostic diag_opts reason Nothing) - (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) - 2 (vcat [ text "when specialising" <+> quotes (ppr caller) - | caller <- callers]) - , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) - , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ]) - -{- Note [Missed specialisation for ClassOps] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #19592 I saw a number of missed specialisation warnings -which were the result of things like: - - case isJumpishInstr @X86.Instr $dInstruction_s7f8 eta3_a78C of { ... - -where isJumpishInstr is part of the Instruction class and defined like -this: - - class Instruction instr where - ... - isJumpishInstr :: instr -> Bool - ... - -isJumpishInstr is a ClassOp which will select the right method -from within the dictionary via our built in rules. See also -Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance. - -We don't give these unfoldings, and as a result the specialiser -complains. But usually this doesn't matter. The simplifier will -apply the rule and we end up with - - case isJumpishInstrImplX86 eta3_a78C of { ... - -Since isJumpishInstrImplX86 is defined for a concrete instance (given -by the dictionary) it is usually already well specialised! -Theoretically the implementation of a method could still be overloaded -over a different type class than what it's a method of. But I wasn't able -to make this go wrong, and SPJ thinks this should be fine as well. - -So I decided to remove the warnings for failed specialisations on ClassOps -alltogether as they do more harm than good. --} - -{- Note [Do not specialise imported DFuns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Ticket #18223 shows that specialising calls of DFuns is can cause a huge -and entirely unnecessary blowup in program size. Consider a call to - f @[[[[[[[[T]]]]]]]] d1 x -where df :: C a => C [a] - d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1 - d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3 - ... -Now we'll specialise f's RHS, which may give rise to calls to 'g', -also overloaded, which we will specialise, and so on. However, if -we specialise the calls to dfC[], we'll generate specialised copies of -all methods of C, at all types; and the same for C's superclasses. - -And many of these specialised functions will never be called. We are -going to call the specialised 'f', and the specialised 'g', but DFuns -group functions into a tuple, many of whose elements may never be used. - -With deeply-nested types this can lead to a simply overwhelming number -of specialisations: see #18223 for a simple example (from the wild). -I measured the number of specialisations for various numbers of calls -of `flip evalStateT ()`, and got this - - Size after one simplification - #calls #SPEC rules Terms Types - 5 56 3100 10600 - 9 108 13660 77206 - -The real tests case has 60+ calls, which blew GHC out of the water. - -Solution: don't specialise DFuns. The downside is that if we end -up with (h (dfun d)), /and/ we don't specialise 'h', then we won't -pass to 'h' a tuple of specialised functions. - -However, the flag -fspecialise-aggressively (experimental, off by default) -allows DFuns to specialise as well. - -Note [Avoiding loops in specImports] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We must take great care when specialising instance declarations -(DFuns like $fOrdList) lest we accidentally build a recursive -dictionary. See Note [Avoiding loops (DFuns)]. - -The basic strategy of Note [Avoiding loops (DFuns)] is to use filterCalls -to discard loopy specialisations. But to do that we must ensure -that the in-scope dict-binds (passed to filterCalls) contains -all the needed dictionary bindings. In particular, in the recursive -call to spec_imports in spec_import, we must include the dict-binds -from the parent. Lacking this caused #17151, a really nasty bug. - -Here is what happened. -* Class structure: - Source is a superclass of Mut - Index is a superclass of Source - -* We started with these dict binds - dSource = $fSourcePix @Int $fIndexInt - dIndex = sc_sel dSource - dMut = $fMutPix @Int dIndex - and these calls to specialise - $fMutPix @Int dIndex - $fSourcePix @Int $fIndexInt - -* We specialised the call ($fMutPix @Int dIndex) - ==> new call ($fSourcePix @Int dIndex) - (because Source is a superclass of Mut) - -* We specialised ($fSourcePix @Int dIndex) - ==> produces specialised dict $s$fSourcePix, - a record with dIndex as a field - plus RULE forall d. ($fSourcePix @Int d) = $s$fSourcePix - *** This is the bogus step *** - -* Now we decide not to specialise the call - $fSourcePix @Int $fIndexInt - because we alredy have a RULE that matches it - -* Finally the simplifer rewrites - dSource = $fSourcePix @Int $fIndexInt - ==> dSource = $s$fSourcePix - -Disaster. Now we have - -Rewrite dSource's RHS to $s$fSourcePix Disaster - dSource = $s$fSourcePix - dIndex = sc_sel dSource - $s$fSourcePix = MkSource dIndex ... - -Solution: filterCalls should have stopped the bogus step, -by seeing that dIndex transitively uses $fSourcePix. But -it can only do that if it sees all the dict_binds. Wow. - --------------- -Here's another example (#13429). Suppose we have - class Monoid v => C v a where ... - -We start with a call - f @ [Integer] @ Integer $fC[]Integer - -Specialising call to 'f' gives dict bindings - $dMonoid_1 :: Monoid [Integer] - $dMonoid_1 = M.$p1C @ [Integer] $fC[]Integer - - $dC_1 :: C [Integer] (Node [Integer] Integer) - $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 - -...plus a recursive call to - f @ [Integer] @ (Node [Integer] Integer) $dC_1 - -Specialising that call gives - $dMonoid_2 :: Monoid [Integer] - $dMonoid_2 = M.$p1C @ [Integer] $dC_1 - - $dC_2 :: C [Integer] (Node [Integer] Integer) - $dC_2 = M.$fCvNode @ [Integer] $dMonoid_2 - -Now we have two calls to the imported function - M.$fCvNode :: Monoid v => C v a - M.$fCvNode @v @a m = C m some_fun - -But we must /not/ use the call (M.$fCvNode @ [Integer] $dMonoid_2) -for specialisation, else we get: - - $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 - $dMonoid_2 = M.$p1C @ [Integer] $dC_1 - $s$fCvNode = C $dMonoid_2 ... - RULE M.$fCvNode [Integer] _ _ = $s$fCvNode - -Now use the rule to rewrite the call in the RHS of $dC_1 -and we get a loop! - - -Note [specImport call stack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When specialising an imports function 'f', we may get new calls -of an imported function 'g', which we want to specialise in turn, -and similarly specialising 'g' might expose a new call to 'h'. - -We track the stack of enclosing functions. So when specialising 'h' we -have a specImport call stack of [g,f]. We do this for two reasons: -* Note [Warning about missed specialisations] -* Note [Avoiding recursive specialisation] - -Note [Warning about missed specialisations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose - * In module Lib, you carefully mark a function 'foo' INLINABLE - * Import Lib(foo) into another module M - * Call 'foo' at some specialised type in M -Then you jolly well expect it to be specialised in M. But what if -'foo' calls another function 'Lib.bar'. Then you'd like 'bar' to be -specialised too. But if 'bar' is not marked INLINABLE it may well -not be specialised. The warning Opt_WarnMissedSpecs warns about this. - -It's more noisy to warning about a missed specialisation opportunity -for /every/ overloaded imported function, but sometimes useful. That -is what Opt_WarnAllMissedSpecs does. - -ToDo: warn about missed opportunities for local functions. - -Note [Avoiding recursive specialisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we specialise 'f' we may find new overloaded calls to 'g', 'h' in -'f's RHS. So we want to specialise g,h. But we don't want to -specialise f any more! It's possible that f's RHS might have a -recursive yet-more-specialised call, so we'd diverge in that case. -And if the call is to the same type, one specialisation is enough. -Avoiding this recursive specialisation loop is one reason for the -'callers' stack passed to specImports and specImport. - - -************************************************************************ -* * -\subsubsection{@specExpr@: the main function} -* * -************************************************************************ --} - -data SpecEnv - = SE { se_subst :: Core.Subst - -- We carry a substitution down: - -- a) we must clone any binding that might float outwards, - -- to avoid name clashes - -- b) we carry a type substitution to use when analysing - -- the RHS of specialised bindings (no type-let!) - - , se_module :: Module - , se_rules :: RuleEnv -- From the home package and this module - , se_dflags :: DynFlags - } - -instance Outputable SpecEnv where - ppr (SE { se_subst = subst }) - = text "SE" <+> braces (text "subst =" <+> ppr subst) - -specVar :: SpecEnv -> InId -> SpecM (OutExpr, UsageDetails) -specVar env@(SE { se_subst = Core.Subst in_scope ids _ _ }) v - | not (isLocalId v) = return (Var v, emptyUDs) - | Just e <- lookupVarEnv ids v = specExpr (zapSubst env) e -- Note (1) - | Just v' <- lookupInScope in_scope v = return (Var v', emptyUDs) - | otherwise = pprPanic "specVar" (ppr v $$ ppr in_scope) - -- c.f. GHC.Core.Subst.lookupIdSubst - -- Note (1): we recurse so we do the lookupInScope thing on any Vars in e - -- probably has little effect, but it's the right thing. - -- We need zapSubst because `e` is an OutExpr - -specExpr :: SpecEnv -> CoreExpr -> SpecM (CoreExpr, UsageDetails) - ----------------- First the easy cases -------------------- -specExpr env (Var v) = specVar env v -specExpr env (Type ty) = return (Type (substTy env ty), emptyUDs) -specExpr env (Coercion co) = return (Coercion (substCo env co), emptyUDs) -specExpr _ (Lit lit) = return (Lit lit, emptyUDs) -specExpr env (Cast e co) - = do { (e', uds) <- specExpr env e - ; return ((mkCast e' (substCo env co)), uds) } -specExpr env (Tick tickish body) - = do { (body', uds) <- specExpr env body - ; return (Tick (specTickish env tickish) body', uds) } - ----------------- Applications might generate a call instance -------------------- -specExpr env expr@(App {}) - = do { let (fun_in, args_in) = collectArgs expr - ; (args_out, uds_args) <- mapAndCombineSM (specExpr env) args_in - ; let env_args = env `bringFloatedDictsIntoScope` ud_binds uds_args - -- Some dicts may have floated out of args_in; - -- they should be in scope for fireRewriteRules (#21689) - (fun_in', args_out') = fireRewriteRules env_args fun_in args_out - ; (fun_out', uds_fun) <- specExpr env fun_in' - ; let uds_call = mkCallUDs env fun_out' args_out' - ; return (fun_out' `mkApps` args_out', uds_fun `thenUDs` uds_call `thenUDs` uds_args) } - ----------------- Lambda/case require dumping of usage details -------------------- -specExpr env e@(Lam {}) - = specLam env' bndrs' body - where - (bndrs, body) = collectBinders e - (env', bndrs') = substBndrs env bndrs - -- More efficient to collect a group of binders together all at once - -- and we don't want to split a lambda group with dumped bindings - -specExpr env (Case scrut case_bndr ty alts) - = do { (scrut', scrut_uds) <- specExpr env scrut - ; (scrut'', case_bndr', alts', alts_uds) - <- specCase env scrut' case_bndr alts --- ; pprTrace "specExpr:case" (vcat --- [ text "scrut" <+> ppr scrut, text "scrut'" <+> ppr scrut' --- , text "case_bndr'" <+> ppr case_bndr' --- , text "alts_uds" <+> ppr alts_uds --- ]) - ; return (Case scrut'' case_bndr' (substTy env ty) alts' - , scrut_uds `thenUDs` alts_uds) } - ----------------- Finally, let is the interesting case -------------------- -specExpr env (Let bind body) - = do { (binds', body', uds) <- specBind NotTopLevel env bind $ \body_env -> - -- pprTrace "specExpr:let" (ppr (se_subst body_env) $$ ppr body) $ - specExpr body_env body - -- All done - ; return (foldr Let body' binds', uds) } - --- See Note [Specialisation modulo dictionary selectors] --- Note [ClassOp/DFun selection] --- Note [Fire rules in the specialiser] -fireRewriteRules :: SpecEnv -> InExpr -> [OutExpr] -> (InExpr, [OutExpr]) -fireRewriteRules env (Var f) args - | Just (rule, expr) <- specLookupRule env f args InitialPhase (getRules (se_rules env) f) - , let rest_args = drop (ruleArity rule) args -- See Note [Extra args in the target] - zapped_subst = Core.zapSubst (se_subst env) - expr' = simpleOptExprWith defaultSimpleOpts zapped_subst expr - -- simplOptExpr needed because lookupRule returns - -- (\x y. rhs) arg1 arg2 - , (fun, args) <- collectArgs expr' - = fireRewriteRules env fun (args++rest_args) -fireRewriteRules _ fun args = (fun, args) - --------------- -specLam :: SpecEnv -> [OutBndr] -> InExpr -> SpecM (OutExpr, UsageDetails) --- The binders have been substituted, but the body has not -specLam env bndrs body - | null bndrs - = specExpr env body - | otherwise - = do { (body', uds) <- specExpr env body - ; let (free_uds, dumped_dbs) = dumpUDs bndrs uds - ; return (mkLams bndrs (wrapDictBindsE dumped_dbs body'), free_uds) } - --------------- -specTickish :: SpecEnv -> CoreTickish -> CoreTickish -specTickish (SE { se_subst = subst }) bp = substTickish subst bp - --------------- -specCase :: SpecEnv - -> OutExpr -- Scrutinee, already done - -> InId -> [InAlt] - -> SpecM ( OutExpr -- New scrutinee - , OutId - , [OutAlt] - , UsageDetails) -specCase env scrut' case_bndr [Alt con args rhs] - | -- See Note [Floating dictionaries out of cases] - interestingDict scrut' (idType case_bndr) - , not (isDeadBinder case_bndr && null sc_args') - = do { case_bndr_flt :| sc_args_flt <- mapM clone_me (case_bndr' :| sc_args') - - ; let case_bndr_flt' = case_bndr_flt `addDictUnfolding` scrut' - scrut_bind = mkDB (NonRec case_bndr_flt scrut') - - sc_args_flt' = zipWith addDictUnfolding sc_args_flt sc_rhss - sc_rhss = [ Case (Var case_bndr_flt') case_bndr' (idType sc_arg') - [Alt con args' (Var sc_arg')] - | sc_arg' <- sc_args' ] - cb_set = unitVarSet case_bndr_flt' - sc_binds = [ DB { db_bind = NonRec sc_arg_flt sc_rhs, db_fvs = cb_set } - | (sc_arg_flt, sc_rhs) <- sc_args_flt' `zip` sc_rhss ] - - flt_binds = scrut_bind : sc_binds - - -- Extend the substitution for RHS to map the *original* binders - -- to their floated versions. - mb_sc_flts :: [Maybe DictId] - mb_sc_flts = map (lookupVarEnv clone_env) args' - clone_env = zipVarEnv sc_args' sc_args_flt' - - subst_prs = (case_bndr, Var case_bndr_flt) - : [ (arg, Var sc_flt) - | (arg, Just sc_flt) <- args `zip` mb_sc_flts ] - subst' = se_subst env_rhs - `Core.extendSubstInScopeList` (case_bndr_flt' : sc_args_flt') - `Core.extendIdSubstList` subst_prs - env_rhs' = env_rhs { se_subst = subst' } - - ; (rhs', rhs_uds) <- specExpr env_rhs' rhs - ; let (free_uds, dumped_dbs) = dumpUDs (case_bndr':args') rhs_uds - all_uds = flt_binds `consDictBinds` free_uds - alt' = Alt con args' (wrapDictBindsE dumped_dbs rhs') --- ; pprTrace "specCase" (ppr case_bndr $$ ppr scrut_bind) $ - ; return (Var case_bndr_flt, case_bndr', [alt'], all_uds) } - where - (env_rhs, (case_bndr':args')) = substBndrs env (case_bndr:args) - sc_args' = filter is_flt_sc_arg args' - - clone_me bndr = do { uniq <- getUniqueM - ; return (mkUserLocalOrCoVar occ uniq wght ty loc) } - where - name = idName bndr - wght = idMult bndr - ty = idType bndr - occ = nameOccName name - loc = getSrcSpan name - - arg_set = mkVarSet args' - is_flt_sc_arg var = isId var - && not (isDeadBinder var) - && isDictTy var_ty - && tyCoVarsOfType var_ty `disjointVarSet` arg_set - where - var_ty = idType var - - -specCase env scrut case_bndr alts - = do { (alts', uds_alts) <- mapAndCombineSM spec_alt alts - ; return (scrut, case_bndr', alts', uds_alts) } - where - (env_alt, case_bndr') = substBndr env case_bndr - spec_alt (Alt con args rhs) - = do { (rhs', uds) <- specExpr env_rhs rhs - ; let (free_uds, dumped_dbs) = dumpUDs (case_bndr' : args') uds --- ; unless (isNilOL dumped_dbs) $ --- pprTrace "specAlt" (vcat --- [text "case_bndr', args" <+> (ppr case_bndr' $$ ppr args) --- ,text "dumped" <+> ppr dumped_dbs ]) return () - ; return (Alt con args' (wrapDictBindsE dumped_dbs rhs'), free_uds) } - where - (env_rhs, args') = substBndrs env_alt args - -{- Note [Fire rules in the specialiser] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this (#21851) - - module A where - f :: Num b => b -> (b, b) - f x = (x + 1, snd (f x)) - {-# SPECIALIZE f :: Int -> (Int, Int) #-} - - module B (g') where - import A - - g :: Num a => a -> a - g x = fst (f x) - {-# NOINLINE[99] g #-} - - h :: Int -> Int - h = g - -Note that `f` has the CPR property, and so will worker/wrapper. - -The call to `g` in `h` will make us specialise `g @Int`. And the specialised -version of `g` will contain the call `f @Int`; but in the subsequent run of -the Simplifier, there will be a competition between: -* The user-supplied SPECIALISE rule for `f` -* The inlining of the wrapper for `f` -In fact, the latter wins -- see Note [Rewrite rules and inlining] in -GHC.Core.Opt.Simplify.Iteration. However, it a bit fragile. - -Moreover consider (test T21851_2): - - module A - f :: (Ord a, Show b) => a -> b -> blah - {-# RULE forall b. f @Int @b = wombat #-} - - wombat :: Show b => Int -> b -> blah - wombat = blah - - module B - import A - g :: forall a. Ord a => blah - g @a = ...g...f @a @Char.... - - h = ....g @Int.... - -Now, in module B, GHC will specialise `g @Int`, which will lead to a -call `f @Int @Char`. If we immediately (in the specialiser) rewrite -that to `womabat @Char`, we have a chance to specialise `wombat`. - -Conclusion: it's treat if the Specialiser fires RULEs itself. -It's not hard to achieve: see `fireRewriteRules`. The only tricky bit is -making sure that we have a reasonably up to date EPS rule base. Currently -we load it up just once, in `initRuleEnv`, called at the beginning of -`specProgram`. - -NB: you might wonder if running rules in the specialiser (this Note) -renders Note [Rewrite rules and inlining] in the Simplifier redundant. -That is, if we run rules in the specialiser, does it matter if we make -rules "win" over inlining in the Simplifier? Yes, it does! See the -discussion in #21851. - -Note [Floating dictionaries out of cases] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - g = \d. case d of { MkD sc ... -> ...(f sc)... } -Naively we can't float d2's binding out of the case expression, -because 'sc' is bound by the case, and that in turn means we can't -specialise f, which seems a pity. - -So we invert the case, by floating out a binding -for 'sc_flt' thus: - sc_flt = case d of { MkD sc ... -> sc } -Now we can float the call instance for 'f'. Indeed this is just -what'll happen if 'sc' was originally bound with a let binding, -but case is more efficient, and necessary with equalities. So it's -good to work with both. - -You might think that this won't make any difference, because the -call instance will only get nuked by the \d. BUT if 'g' itself is -specialised, then transitively we should be able to specialise f. - -In general, given - case e of cb { MkD sc ... -> ...(f sc)... } -we transform to - let cb_flt = e - sc_flt = case cb_flt of { MkD sc ... -> sc } - in - case cb_flt of bg { MkD sc ... -> ....(f sc_flt)... } - -The "_flt" things are the floated binds; we use the current substitution -to substitute sc -> sc_flt in the RHS - -************************************************************************ -* * - Dealing with a binding -* * -************************************************************************ --} - -bringFloatedDictsIntoScope :: SpecEnv -> FloatedDictBinds -> SpecEnv -bringFloatedDictsIntoScope env (FDB { fdb_bndrs = dx_bndrs }) - = -- pprTrace "brought into scope" (ppr dx_bndrs) $ - env {se_subst=subst'} - where - subst' = se_subst env `Core.extendSubstInScopeSet` dx_bndrs - -specBind :: TopLevelFlag - -> SpecEnv -- At top-level only, this env already has the - -- top level binders in scope - -> InBind - -> (SpecEnv -> SpecM (body, UsageDetails)) -- Process the body - -> SpecM ( [OutBind] -- New bindings - , body -- Body - , UsageDetails) -- And info to pass upstream - --- Returned UsageDetails: --- No calls for binders of this bind -specBind top_lvl env (NonRec fn rhs) do_body - = do { (rhs', rhs_uds) <- specExpr env rhs - - ; (body_env1, fn1) <- case top_lvl of - TopLevel -> return (env, fn) - NotTopLevel -> cloneBndrSM env fn - - ; let fn2 | isStableUnfolding (idUnfolding fn1) = fn1 - | otherwise = fn1 `setIdUnfolding` mkSimpleUnfolding defaultUnfoldingOpts rhs' - -- Update the unfolding with the perhaps-simpler or more specialised rhs' - -- This is important: see Note [Update unfolding after specialisation] - -- And in any case cloneBndrSM discards non-Stable unfoldings - - fn3 = floatifyIdDemandInfo fn2 - -- We zap the demand info because the binding may float, - -- which would invalidate the demand info (see #17810 for example). - -- Destroying demand info is not terrible; specialisation is - -- always followed soon by demand analysis. - -- See Note [Floatifying demand info when floating] in GHC.Core.Opt.SetLevels - - body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds - `extendInScope` fn3 - -- bringFloatedDictsIntoScope: see #23567 - - ; (body', body_uds) <- do_body body_env2 - - ; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs - - ; let can_float_this_one = exprIsTopLevelBindable rhs (idType fn) - -- exprIsTopLevelBindable: see Note [Care with unlifted bindings] - (free_uds, dump_dbs, float_all) = dumpBindUDs can_float_this_one [fn4] body_uds1 - all_free_uds = free_uds `thenUDs` rhs_uds - - pairs = spec_defns ++ [(fn4, rhs')] - -- fn4 mentions the spec_defns in its rules, - -- so put the latter first - - final_binds :: [DictBind] - -- See Note [From non-recursive to recursive] - final_binds | not (isNilOL dump_dbs) - , not (null spec_defns) - = [recWithDumpedDicts pairs dump_dbs] - | otherwise - = [mkDB $ NonRec b r | (b,r) <- pairs] - ++ fromOL dump_dbs - - - ; if float_all then - -- Rather than discard the calls mentioning the bound variables - -- we float this (dictionary) binding along with the others - return ([], body', all_free_uds `snocDictBinds` final_binds) - else - -- No call in final_uds mentions bound variables, - -- so we can just leave the binding here - return (map db_bind final_binds, body', all_free_uds) } - - -specBind top_lvl env (Rec pairs) do_body - -- Note [Specialising a recursive group] - = do { let (bndrs,rhss) = unzip pairs - - ; (rec_env, bndrs1) <- case top_lvl of - TopLevel -> return (env, bndrs) - NotTopLevel -> cloneRecBndrsSM env bndrs - - ; (rhss', rhs_uds) <- mapAndCombineSM (specExpr rec_env) rhss - ; (body', body_uds) <- do_body rec_env - - ; let scope_uds = body_uds `thenUDs` rhs_uds - -- Includes binds and calls arising from rhss - - ; (bndrs2, spec_defns2, uds2) <- specDefns rec_env scope_uds (bndrs1 `zip` rhss) - -- bndrs2 is like bndrs1, but with RULES added - - ; (bndrs3, spec_defns3, uds3) - <- if null spec_defns2 -- Common case: no specialisation - then return (bndrs2, [], uds2) - else do { -- Specialisation occurred; do it again - (bndrs3, spec_defns3, uds3) - <- specDefns rec_env uds2 (bndrs2 `zip` rhss) - ; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) } - - ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs True bndrs1 uds3 - final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss') - dumped_dbs - - ; if float_all then - return ([], body', final_uds `snocDictBind` final_bind) - else - return ([db_bind final_bind], body', final_uds) } - - ---------------------------- -specDefns :: SpecEnv - -> UsageDetails -- Info on how it is used in its scope - -> [(OutId,InExpr)] -- The things being bound and their un-processed RHS - -> SpecM ([OutId], -- Original Ids with RULES added - [(OutId,OutExpr)], -- Extra, specialised bindings - UsageDetails) -- Stuff to fling upwards from the specialised versions - --- Specialise a list of bindings (the contents of a Rec), but flowing usages --- upwards binding by binding. Example: { f = ...g ...; g = ...f .... } --- Then if the input CallDetails has a specialised call for 'g', whose specialisation --- in turn generates a specialised call for 'f', we catch that in this one sweep. --- But not vice versa (it's a fixpoint problem). - -specDefns _env uds [] - = return ([], [], uds) -specDefns env uds ((bndr,rhs):pairs) - = do { (bndrs1, spec_defns1, uds1) <- specDefns env uds pairs - ; (bndr1, spec_defns2, uds2) <- specDefn env uds1 bndr rhs - ; return (bndr1 : bndrs1, spec_defns1 ++ spec_defns2, uds2) } - ---------------------------- -specDefn :: SpecEnv - -> UsageDetails -- Info on how it is used in its scope - -> OutId -> InExpr -- The thing being bound and its un-processed RHS - -> SpecM (Id, -- Original Id with added RULES - [(Id,CoreExpr)], -- Extra, specialised bindings - UsageDetails) -- Stuff to fling upwards from the specialised versions - -specDefn env body_uds fn rhs - = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds - rules_for_me = idCoreRules fn - -- Bring into scope the binders from the floated dicts - env_w_dict_bndrs = bringFloatedDictsIntoScope env (ud_binds body_uds) - - ; (rules, spec_defns, spec_uds) <- specCalls False env_w_dict_bndrs - rules_for_me calls_for_me fn rhs - - ; return ( fn `addIdSpecialisations` rules - , spec_defns - , body_uds_without_me `thenUDs` spec_uds) } - -- It's important that the `thenUDs` is this way - -- round, because body_uds_without_me may bind - -- dictionaries that are used in calls_for_me passed - -- to specDefn. So the dictionary bindings in - -- spec_uds may mention dictionaries bound in - -- body_uds_without_me - ---------------------------- -specCalls :: Bool -- True => specialising imported fn - -- False => specialising local fn - -> SpecEnv - -> [CoreRule] -- Existing RULES for the fn - -> [CallInfo] - -> OutId -> InExpr - -> SpecM SpecInfo -- New rules, specialised bindings, and usage details - --- This function checks existing rules, and does not create --- duplicate ones. So the caller does not need to do this filtering. --- See 'already_covered' - -type SpecInfo = ( [CoreRule] -- Specialisation rules - , [(Id,CoreExpr)] -- Specialised definition - , UsageDetails ) -- Usage details from specialised RHSs - -specCalls spec_imp env existing_rules calls_for_me fn rhs - -- The first case is the interesting one - | notNull calls_for_me -- And there are some calls to specialise - && not (isNeverActive (idInlineActivation fn)) - -- Don't specialise NOINLINE things - -- See Note [Auto-specialisation and RULES] - -- - -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. - -- Since OPAQUE things are always never-active (see - -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for - -- OPAQUE things. - --- && not (certainlyWillInline (idUnfolding fn)) -- And it's not small --- See Note [Inline specialisations] for why we do not --- switch off specialisation for inline functions - - = -- pprTrace "specCalls: some" (vcat - -- [ text "function" <+> ppr fn - -- , text "calls:" <+> ppr calls_for_me - -- , text "subst" <+> ppr (se_subst env) ]) $ - foldlM spec_call ([], [], emptyUDs) calls_for_me - - | otherwise -- No calls or RHS doesn't fit our preconceptions - = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me && not (isClassOpId fn)) - "Missed specialisation opportunity for" (ppr fn $$ trace_doc) $ - -- isClassOpId: class-op Ids never inline; we specialise them - -- through fireRewriteRules. So don't complain about missed opportunities - -- Note [Specialisation shape] - -- pprTrace "specCalls: none" (ppr fn <+> ppr calls_for_me) $ - return ([], [], emptyUDs) - where - trace_doc = sep [ ppr rhs_bndrs, ppr (idInlineActivation fn) ] - - fn_type = idType fn - fn_arity = idArity fn - fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here - inl_prag = idInlinePragma fn - inl_act = inlinePragmaActivation inl_prag - is_local = isLocalId fn - is_dfun = isDFunId fn - dflags = se_dflags env - this_mod = se_module env - -- Figure out whether the function has an INLINE pragma - -- See Note [Inline specialisations] - - (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs - -- See Note [Account for casts in binding] - - already_covered :: SpecEnv -> [CoreRule] -> [CoreExpr] -> Bool - already_covered env new_rules args -- Note [Specialisations already covered] - = isJust (specLookupRule env fn args (beginPhase inl_act) - (new_rules ++ existing_rules)) - -- Rules: we look both in the new_rules (generated by this invocation - -- of specCalls), and in existing_rules (passed in to specCalls) - -- inl_act: is the activation we are going to put in the new SPEC - -- rule; so we want to see if it is covered by another rule with - -- that same activation. - - ---------------------------------------------------------- - -- Specialise to one particular call pattern - spec_call :: SpecInfo -- Accumulating parameter - -> CallInfo -- Call instance - -> SpecM SpecInfo - spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) _ci@(CI { ci_key = call_args }) - = -- See Note [Specialising Calls] - do { let all_call_args | is_dfun = saturating_call_args -- See Note [Specialising DFuns] - | otherwise = call_args - saturating_call_args = call_args ++ map mk_extra_dfun_arg (dropList call_args rhs_bndrs) - mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType - | otherwise = UnspecArg - - ; ( useful, rhs_env2, leftover_bndrs - , rule_bndrs, rule_lhs_args - , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args - --- ; pprTrace "spec_call" (vcat --- [ text "fun: " <+> ppr fn --- , text "call info: " <+> ppr _ci --- , text "useful: " <+> ppr useful --- , text "rule_bndrs:" <+> ppr rule_bndrs --- , text "lhs_args: " <+> ppr rule_lhs_args --- , text "spec_bndrs1:" <+> ppr spec_bndrs1 --- , text "leftover_bndrs:" <+> pprIds leftover_bndrs --- , text "spec_args: " <+> ppr spec_args --- , text "dx_binds: " <+> ppr dx_binds --- , text "rhs_bndrs" <+> ppr rhs_bndrs --- , text "rhs_body" <+> ppr rhs_body --- , text "rhs_env2: " <+> ppr (se_subst rhs_env2) --- , ppr dx_binds ]) $ --- return () - - ; if not useful -- No useful specialisation - || already_covered rhs_env2 rules_acc rule_lhs_args - then return spec_acc - else - do { -- Run the specialiser on the specialised RHS - -- The "1" suffix is before we maybe add the void arg - ; (rhs_body', rhs_uds) <- specExpr rhs_env2 rhs_body - -- Add the { d1' = dx1; d2' = dx2 } usage stuff - -- to the rhs_uds; see Note [Specialising Calls] - ; let rhs_uds_w_dx = dx_binds `consDictBinds` rhs_uds - spec_rhs_bndrs = spec_bndrs1 ++ leftover_bndrs - (spec_uds, dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds_w_dx - spec_rhs1 = mkLams spec_rhs_bndrs $ - wrapDictBindsE dumped_dbs rhs_body' - - spec_fn_ty1 = exprType spec_rhs1 - - -- Maybe add a void arg to the specialised function, - -- to avoid unlifted bindings - -- See Note [Specialisations Must Be Lifted] - -- C.f. GHC.Core.Opt.WorkWrap.Utils.needsVoidWorkerArg - add_void_arg = isUnliftedType spec_fn_ty1 && not (isJoinId fn) - (spec_bndrs, spec_rhs, spec_fn_ty) - | add_void_arg = ( voidPrimId : spec_bndrs1 - , Lam voidArgId spec_rhs1 - , mkVisFunTyMany unboxedUnitTy spec_fn_ty1) - | otherwise = (spec_bndrs1, spec_rhs1, spec_fn_ty1) - - join_arity_decr = length rule_lhs_args - length spec_bndrs - - -------------------------------------- - -- Add a suitable unfolding; see Note [Inline specialisations] - -- The wrap_unf_body applies the original unfolding to the specialised - -- arguments, not forgetting to wrap the dx_binds around the outside (#22358) - simpl_opts = initSimpleOpts dflags - wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds - spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body - rule_lhs_args fn_unf - - -------------------------------------- - -- Adding arity information just propagates it a bit faster - -- See Note [Arity decrease] in GHC.Core.Opt.Simplify - -- Copy InlinePragma information from the parent Id. - -- So if f has INLINE[1] so does spec_fn - arity_decr = count isValArg rule_lhs_args - count isId spec_bndrs - - spec_inl_prag - | not is_local -- See Note [Specialising imported functions] - , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal - = neverInlinePragma - | otherwise - = inl_prag - - spec_fn_info - = vanillaIdInfo `setArityInfo` max 0 (fn_arity - arity_decr) - `setInlinePragInfo` spec_inl_prag - `setUnfoldingInfo` spec_unf - - -- Compute the IdDetails of the specialise Id - -- See Note [Transfer IdDetails during specialisation] - spec_fn_details - = case idDetails fn of - JoinId join_arity _ -> JoinId (join_arity - join_arity_decr) Nothing - DFunId is_nt -> DFunId is_nt - _ -> VanillaId - - ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty spec_fn_details spec_fn_info - ; let - -- The rule to put in the function's specialisation is: - -- forall x @b d1' d2'. - -- f x @T1 @b @T2 d1' d2' = f1 x @b - -- See Note [Specialising Calls] - herald | spec_imp = -- Specialising imported fn - text "SPEC/" <> ppr this_mod - | otherwise = -- Specialising local fn - text "SPEC" - - spec_rule = mkSpecRule dflags this_mod True inl_act - herald fn rule_bndrs rule_lhs_args - (mkVarApps (Var spec_fn) spec_bndrs) - - spec_f_w_arity = spec_fn - - _rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type - , ppr spec_fn <+> dcolon <+> ppr spec_fn_ty - , ppr rhs_bndrs, ppr call_args - , ppr spec_rule - ] - - ; -- pprTrace "spec_call: rule" _rule_trace_doc - return ( spec_rule : rules_acc - , (spec_f_w_arity, spec_rhs) : pairs_acc - , spec_uds `thenUDs` uds_acc - ) } } - --- Convenience function for invoking lookupRule from Specialise --- The SpecEnv's InScopeSet should include all the Vars in the [CoreExpr] -specLookupRule :: SpecEnv -> Id -> [CoreExpr] - -> CompilerPhase -- Look up rules as if we were in this phase - -> [CoreRule] -> Maybe (CoreRule, CoreExpr) -specLookupRule env fn args phase rules - = lookupRule ropts in_scope_env is_active fn args rules - where - dflags = se_dflags env - in_scope = getSubstInScope (se_subst env) - in_scope_env = ISE in_scope (whenActiveUnfoldingFun is_active) - ropts = initRuleOpts dflags - is_active = isActive phase - -{- Note [Specialising DFuns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -DFuns have a special sort of unfolding (DFunUnfolding), and it is -hard to specialise a DFunUnfolding to give another DFunUnfolding -unless the DFun is fully applied (#18120). So, in the case of DFunIds -we simply extend the CallKey with trailing UnspecTypes/UnspecArgs, -so that we'll generate a rule that completely saturates the DFun. - -There is an ASSERT that checks this, in the DFunUnfolding case of -GHC.Core.Unfold.Make.specUnfolding. - -Note [Transfer IdDetails during specialisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When specialising a function, `newSpecIdSM` comes up with a fresh Id the -specialised RHS will be bound to. It is critical that we get the `IdDetails` of -the specialised Id correct: - -* JoinId: We want the specialised Id to be a join point, too. But - we have to carefully adjust the arity - -* DFunId: It is crucial that we also make the new Id a DFunId. - - First, because it obviously /is/ a DFun, having a DFunUnfolding and - all that; see Note [Specialising DFuns] - - - Second, DFuns get very delicate special treatment in the demand analyser; - see GHC.Core.Opt.DmdAnal.enterDFun. If the specialised function isn't - also a DFunId, this special treatment doesn't happen, so the demand - analyser makes a too-strict DFun, and we get an infinite loop. See Note - [Do not strictify a DFun's parameter dictionaries] in GHC.Core.Opt.DmdAnal. - #22549 describes the loop, and (lower down) a case where a /specialised/ - DFun caused a loop. - -* WorkerLikeId: Introduced by WW, so after Specialise. Nevertheless, they come - up when specialising imports. We must keep them as VanillaIds because WW - will detect them as WorkerLikeIds again. That is, unless specialisation - allows unboxing of all previous CBV args, in which case sticking to - VanillaIds was the only correct choice to begin with. - -* RecSelId, DataCon*Id, ClassOpId, PrimOpId, FCallId, CoVarId, TickBoxId: - Never specialised. - -Note [Specialisation Must Preserve Sharing] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider a function: - - f :: forall a. Eq a => a -> blah - f = - if expensive - then f1 - else f2 - -As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' -at 'Int', eg: - - $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) - - RULE "SPEC f" - forall (d :: Eq Int). - f Int _ = $sfIntf - -We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! - -To avoid this, we only generate specialisations for functions whose arity is -enough to bind all of the arguments we need to specialise. This ensures our -specialised functions don't do any work before receiving all of their dicts, -and thus avoids the 'f' case above. - -Note [Specialisations Must Be Lifted] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider a function 'f': - - f = forall a. Eq a => Array# a - -used like - - case x of - True -> ...f @Int dEqInt... - False -> 0 - -Naively, we might generate an (expensive) specialisation - - $sfInt :: Array# Int - -even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to -the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to -preserve laziness. - -Note [Care with unlifted bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#22998) - f x = let x::ByteArray# = - n::Natural = NB x - in wombat @192827 (n |> co) -where - co :: Natural ~ KnownNat 192827 - wombat :: forall (n:Nat). KnownNat n => blah - -Left to itself, the specialiser would float the bindings for `x` and `n` to top -level, so we can specialise `wombat`. But we can't have a top-level ByteArray# -(see Note [Core letrec invariant] in GHC.Core). Boo. - -This is pretty exotic, so we take a simple way out: in specBind (the NonRec -case) do not float the binding itself unless it satisfies exprIsTopLevelBindable. -This is conservative: maybe the RHS of `x` has a free var that would stop it -floating to top level anyway; but that is hard to spot (since we don't know what -the non-top-level in-scope binders are) and rare (since the binding must satisfy -Note [Core let-can-float invariant] in GHC.Core). - -Arguably we'd be better off if we had left that `x` in the RHS of `n`, thus - f x = let n::Natural = let x::ByteArray# = in - NB x - in wombat @192827 (n |> co) -Now we could float `n` happily. But that's in conflict with exposing the `NB` -data constructor in the body of the `let`, so I'm leaving this unresolved. - -Another case came up in #26682, where the binding had an unlifted sum type -(# Word# | ByteArray# #), itself arising from an UNPACK pragma. Test case -T26682. - -Note [Specialising Calls] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have a function with a complicated type: - - f :: forall a b c. Int -> Eq a => Show b => c -> Blah - f @a @b @c i dEqA dShowA x = blah - -and suppose it is called at: - - f 7 @T1 @T2 @T3 dEqT1 ($dfShow dShowT2) t3 - -This call is described as a 'CallInfo' whose 'ci_key' is: - - [ SpecType T1, SpecType T2, UnspecType, UnspecArg, SpecDict dEqT1 - , SpecDict ($dfShow dShowT2), UnspecArg ] - -Why are 'a' and 'b' identified as 'SpecType', while 'c' is 'UnspecType'? -Because we must specialise the function on type variables that appear -free in its *dictionary* arguments; but not on type variables that do not -appear in any dictionaries, i.e. are fully polymorphic. - -Because this call has dictionaries applied, we'd like to specialise -the call on any type argument that appears free in those dictionaries. -In this case, those are [a :-> T1, b :-> T2]. - -We also need to substitute the dictionary binders with their -specialised dictionaries. The simplest substitution would be -[dEqA :-> dEqT1, dShowA :-> $dfShow dShowT2], but this duplicates -work, since `$dfShow dShowT2` is a function application. Therefore, we -also want to *float the dictionary out* (via bindAuxiliaryDict), -creating a new dict binding - - dShow1 = $dfShow dShowT2 - -and the substitution [dEqA :-> dEqT1, dShowA :-> dShow1]. - -With the substitutions in hand, we can generate a specialised function: - - $sf :: forall c. Int -> c -> Blah - $sf = SUBST[a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowA :-> dShow1] (\@c i x -> blah) - -Note that the substitution is applied to the whole thing. This is -convenient, but just slightly fragile. Notably: - * There had better be no name clashes in a/b/c - -We must construct a rewrite rule: - - RULE "SPEC f @T1 @T2 _" - forall (@c :: Type) (i :: Int) (d1 :: Eq T1) (d2 :: Show T2). - f @T1 @T2 @c i d1 d2 = $sf @c i - -In the rule, d1 and d2 are just wildcards, not used in the RHS. Note -additionally that 'x' isn't captured by this rule --- we bind only -enough etas in order to capture all of the *specialised* arguments. - -Note [Drop dead args from specialisations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When specialising a function, it’s possible some of the arguments may -actually be dead. For example, consider: - - f :: forall a. () -> Show a => a -> String - f x y = show y ++ "!" - -We might generate the following CallInfo for `f @Int`: - - [SpecType Int, UnspecArg, SpecDict $dShowInt, UnspecArg] - -Normally we’d include both the x and y arguments in the -specialisation, since we’re not specialising on either of them. But -that’s silly, since x is actually unused! So we might as well drop it -in the specialisation: - - $sf :: Int -> String - $sf y = show y ++ "!" - - {-# RULE "SPEC f @Int" forall x. f @Int x $dShow = $sf #-} - -This doesn’t save us much, since the arg would be removed later by -worker/wrapper, anyway, but it’s easy to do. - -Wrinkles - -* Note that we only drop dead arguments if: - 1. We don’t specialise on them. - 2. They come before an argument we do specialise on. - Doing the latter would require eta-expanding the RULE, which could - make it match less often, so it’s not worth it. Doing the former could - be more useful --- it would stop us from generating pointless - specialisations --- but it’s more involved to implement and unclear if - it actually provides much benefit in practice. - -* If the function has a stable unfolding, specHeader has to come up with - arguments to pass to that stable unfolding, when building the stable - unfolding of the specialised function: this is the last field in specHeader's - big result tuple. - - The right thing to do is to produce a LitRubbish; it should rapidly - disappear. Rather like GHC.Core.Opt.WorkWrap.Utils.mk_absent_let. - -Note [Specialisation modulo dictionary selectors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #19644, we discovered that the ClassOp/DFun rules from -Note [ClassOp/DFun selection] inhibit transitive specialisation. -Example, inspired by T17966: - - class C a where - m :: Show b => a -> b -> String - dummy :: a -> () -- Force a datatype dictionary representation - - instance C Int where - m a b = show a ++ show b - dummy _ = () - - f :: (C a, Show b) => a -> b -> String - f a b = m a b ++ "!" - {-# INLINABLE[0] f #-} - - main = putStrLn (f (42::Int) (True::Bool)) - -Here, we specialise `f` at `Int` and `Bool`, giving - - $dC = $fCInt - $dShow = GHC.Show.$fShowBool - $sf (a::Int) (b::Bool) = - ... (m @Int $dC @Bool $dShow a b) ... - -Here `m` is just a DictSel, so there is (apparently) nothing to specialise! -However, the next Simplifier run will expose the rewritten instance method: - - ... $fCInt_$cm @Bool $fShowBool a b ... - -where $fCInt_$cm is the instance method for `m` in `instance C Int`: - - $fCInt_$cm :: forall b. Show b => Int -> b -> String - $fCInt_$cm b d x y = show @Int $dShowInt x ++ show @b d y - -We want to specialise this! How? By doing the method-selection rewrite in -the Specialiser. Hence - -1. In the App case of 'specExpr', try to apply the ClassOp/DFun rule on the - head of the application, repeatedly, via 'fireRewriteRules'. -2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and - `$dShow` in `bindAuxiliaryDict`, so that we can exploit the unfolding - in 'fireRewriteRules' to do the ClassOp/DFun rewrite. - -NB: Without (2), (1) would be pointless, because 'lookupRule' wouldn't be able -to look into the RHS of `$dC` to see the DFun. - -Note [Zap occ info in rule binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we generate a specialisation RULE, we need to drop occurrence -info on the binders. If we don’t, things go wrong when we specialise a -function like - - f :: forall a. () -> Show a => a -> String - f x y = show y ++ "!" - -since we’ll generate a RULE like - - RULE "SPEC f @Int" forall x [Occ=Dead]. - f @Int x $dShow = $sf - -and Core Lint complains, even though x only appears on the LHS (due to -Note [Drop dead args from specialisations]). - -Why is that a Lint error? Because the arguments on the LHS of a rule -are syntactically expressions, not patterns, so Lint treats the -appearance of x as a use rather than a binding. Fortunately, the -solution is simple: we just make sure to zap the occ info before -using ids as wildcard binders in a rule. - -Note [Account for casts in binding] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f :: Eq a => a -> IO () - {-# INLINABLE f - StableUnf = (/\a \(d:Eq a) (x:a). blah) |> g - #-} - f = ... - -In f's stable unfolding we have done some modest simplification which -has pushed the cast to the outside. (I wonder if this is the Right -Thing, but it's what happens now; see GHC.Core.Opt.Simplify.Utils Note [Casts and -lambdas].) Now that stable unfolding must be specialised, so we want -to push the cast back inside. It would be terrible if the cast -defeated specialisation! Hence the use of collectBindersPushingCo. - -Note [Evidence foralls] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose (#12212) that we are specialising - f :: forall a b. (Num a, F a ~ F b) => blah -with a=b=Int. Then the RULE will be something like - RULE forall (d:Num Int) (g :: F Int ~ F Int). - f Int Int d g = f_spec -But both varToCoreExpr (when constructing the LHS args), and the -simplifier (when simplifying the LHS args), will transform to - RULE forall (d:Num Int) (g :: F Int ~ F Int). - f Int Int d = f_spec -by replacing g with Refl. So now 'g' is unbound, which results in a later -crash. So we use Refl right off the bat, and do not forall-quantify 'g': - * varToCoreExpr generates a Refl - * exprsFreeIdsList returns the Ids bound by the args, - which won't include g - -You might wonder if this will match as often, but the simplifier replaces -complicated Refl coercions with Refl pretty aggressively. - -Note [Orphans and auto-generated rules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we specialise an INLINABLE function, or when we have --fspecialise-aggressively, we auto-generate RULES that are orphans. -We don't want to warn about these, or we'd generate a lot of warnings. -Thus, we only warn about user-specified orphan rules. - -Indeed, we don't even treat the module as an orphan module if it has -auto-generated *rule* orphans. Orphan modules are read every time we -compile, so they are pretty obtrusive and slow down every compilation, -even non-optimised ones. (Reason: for type class instances it's a -type correctness issue.) But specialisation rules are strictly for -*optimisation* only so it's fine not to read the interface. - -What this means is that a SPEC rules from auto-specialisation in -module M will be used in other modules only if M.hi has been read for -some other reason, which is actually pretty likely. - -Note [From non-recursive to recursive] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Even in the non-recursive case, if any dict-binds depend on 'fn' we might -have built a recursive knot - - f a d x = - MkUD { ud_binds = NonRec d7 (MkD ..f..) - , ud_calls = ...(f T d7)... } - -The we generate - - Rec { fs x = [T/a, d7/d] - f a d x = - RULE f T _ = fs - d7 = ...f... } - -Here the recursion is only through the RULE. - -However we definitely should /not/ make the Rec in this wildly common -case: - d = ... - MkUD { ud_binds = NonRec d7 (...d...) - , ud_calls = ...(f T d7)... } - -Here we want simply to add d to the floats, giving - MkUD { ud_binds = NonRec d (...) - NonRec d7 (...d...) - , ud_calls = ...(f T d7)... } - -In general, we need only make this Rec if - - there are some specialisations (spec_binds non-empty) - - there are some dict_binds that depend on f (dump_dbs non-empty) - -Note [Avoiding loops (DFuns)] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When specialising /dictionary functions/ we must be very careful to -avoid building loops. Here is an example that bit us badly, on -several distinct occasions. - -Here is one: #3591 - class Eq a => C a - instance Eq [a] => C [a] - -This translates to - dfun :: Eq [a] -> C [a] - dfun a d = MkD a d (meth d) - - d4 :: Eq [T] = - d2 :: C [T] = dfun T d4 - d1 :: Eq [T] = $p1 d2 - d3 :: C [T] = dfun T d1 - -None of these definitions is recursive. What happened was that we -generated a specialisation: - RULE forall d. dfun T d = dT :: C [T] - dT = (MkD a d (meth d)) [T/a, d1/d] - = MkD T d1 (meth d1) - -But now we use the RULE on the RHS of d2, to get - d2 = dT = MkD d1 (meth d1) - d1 = $p1 d2 - -and now d1 is bottom! The problem is that when specialising 'dfun' we -should first dump "below" the binding all floated dictionary bindings -that mention 'dfun' itself. So d2 and d3 (and hence d1) must be -placed below 'dfun', and thus unavailable to it when specialising -'dfun'. That in turn means that the call (dfun T d1) must be -discarded. On the other hand, the call (dfun T d4) is fine, assuming -d4 doesn't mention dfun. - -Solution: - Discard all calls that mention dictionaries that depend - (directly or indirectly) on the dfun we are specialising. - This is done by 'filterCalls' - -Note [Avoiding loops (non-DFuns)] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The whole Note [Avoiding loops (DFuns)] things applies only to DFuns. -It's important /not/ to apply filterCalls to non-DFuns. For example: - - class C a where { foo,bar :: [a] -> [a] } - - instance C Int where - foo x = r_bar x - bar xs = reverse xs - - r_bar :: C a => [a] -> [a] - r_bar xs = bar (xs ++ xs) - -That translates to: - - r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs) - - Rec { $fCInt :: C Int = MkC foo_help reverse - foo_help (xs::[Int]) = r_bar Int $fCInt xs } - -The call (r_bar $fCInt) mentions $fCInt, - which mentions foo_help, - which mentions r_bar - -But we DO want to specialise r_bar at Int: - Rec { $fCInt :: C Int = MkC foo_help reverse - foo_help (xs::[Int]) = r_bar Int $fCInt xs - - r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs) - RULE r_bar Int _ = r_bar_Int - - r_bar_Int xs = bar Int $fCInt (xs ++ xs) - } - -Note that, because of its RULE, r_bar joins the recursive -group. (In this case it'll unravel a short moment later.) -See test simplCore/should_compile/T19599a. - -Another example is #19599, which looked like this: - - class (Show a, Enum a) => MyShow a where - myShow :: a -> String - - myShow_impl :: MyShow a => a -> String - - foo :: Int -> String - foo = myShow_impl @Int $fMyShowInt - - Rec { $fMyShowInt = MkMyShowD $fEnumInt $fShowInt $cmyShow - ; $cmyShow = myShow_impl @Int $fMyShowInt } - -Here, we really do want to specialise `myShow_impl @Int $fMyShowInt`. - - -Note [Specialising a recursive group] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - let rec { f x = ...g x'... - ; g y = ...f y'.... } - in f 'a' -Here we specialise 'f' at Char; but that is very likely to lead to -a specialisation of 'g' at Char. We must do the latter, else the -whole point of specialisation is lost. - -But we do not want to keep iterating to a fixpoint, because in the -presence of polymorphic recursion we might generate an infinite number -of specialisations. - -So we use the following heuristic: - * Arrange the rec block in dependency order, so far as possible - (the occurrence analyser already does this) - - * Specialise it much like a sequence of lets - - * Then go through the block a second time, feeding call-info from - the RHSs back in the bottom, as it were - -In effect, the ordering maxmimises the effectiveness of each sweep, -and we do just two sweeps. This should catch almost every case of -monomorphic recursion -- the exception could be a very knotted-up -recursion with multiple cycles tied up together. - -This plan is implemented in the Rec case of specBindItself. - -Note [Specialisations already covered] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We obviously don't want to generate two specialisations for the same -argument pattern. There are two wrinkles - -1. We do the already-covered test in specDefn, not when we generate -the CallInfo in mkCallUDs. We used to test in the latter place, but -we now iterate the specialiser somewhat, and the Id at the call site -might therefore not have all the RULES that we can see in specDefn - -2. What about two specialisations where the second is an *instance* -of the first? If the more specific one shows up first, we'll generate -specialisations for both. If the *less* specific one shows up first, -we *don't* currently generate a specialisation for the more specific -one. (See the call to lookupRule in already_covered.) Reasons: - (a) lookupRule doesn't say which matches are exact (bad reason) - (b) if the earlier specialisation is user-provided, it's - far from clear that we should auto-specialise further - -Note [Auto-specialisation and RULES] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider: - g :: Num a => a -> a - g = ... - - f :: (Int -> Int) -> Int - f w = ... - {-# RULE f g = 0 #-} - -Suppose that auto-specialisation makes a specialised version of -g::Int->Int. That version won't appear in the LHS of the RULE for f. -So if the specialisation rule fires too early, the rule for f may -never fire. - -It might be possible to add new rules, to "complete" the rewrite system. -Thus when adding - RULE forall d. g Int d = g_spec -also add - RULE f g_spec = 0 - -But that's a bit complicated. For now we ask the programmer's help, -by *copying the INLINE activation pragma* to the auto-specialised -rule. So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule -will also not be active until phase 2. And that's what programmers -should jolly well do anyway, even aside from specialisation, to ensure -that g doesn't inline too early. - -This in turn means that the RULE would never fire for a NOINLINE -thing so not much point in generating a specialisation at all. - -Note [Specialisation shape] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We only specialise a function if it has visible top-level lambdas -corresponding to its overloading. E.g. if - f :: forall a. Eq a => .... -then its body must look like - f = /\a. \d. ... - -Reason: when specialising the body for a call (f ty dexp), we want to -substitute dexp for d, and pick up specialised calls in the body of f. - -We do allow casts, however; see Note [Account for casts in binding]. - -This doesn't always work. One example I came across was this: - newtype Gen a = MkGen{ unGen :: Int -> a } - - choose :: Eq a => a -> Gen a - choose n = MkGen (\r -> n) - - oneof = choose (1::Int) - -It's a silly example, but we get - choose = /\a. g `cast` co -where choose doesn't have any dict arguments. Thus far I have not -tried to fix this (wait till there's a real example). - -Mind you, then 'choose' will be inlined (since RHS is trivial) so -it doesn't matter. This comes up with single-method classes - - class C a where { op :: a -> a } - instance C a => C [a] where .... -==> - $fCList :: C a => C [a] - $fCList = $copList |> (...coercion>...) - ....(uses of $fCList at particular types)... - -So we suppress the WARN if the rhs is trivial. - -Note [Inline specialisations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Here is what we do with the InlinePragma of the original function - - * Activation/RuleMatchInfo: both inherited from the original function - - * InlineSpec: inherit from original function - - * Unfolding: transfer a StableUnfolding iff it is UnfWhen - See GHC.Core.Unfold.Make.specUnfolding - and its Note [Specialising unfoldings] - -InlineSpec: you might wonder why we specialise INLINE functions at all. -After all they should be inlined, right? Two reasons: - - * Even INLINE functions are sometimes not inlined, when they aren't - applied to interesting arguments. But perhaps the type arguments - alone are enough to specialise (even though the args are too boring - to trigger inlining), and it's certainly better to call the - specialised version. - - * The RHS of an INLINE function might call another overloaded function, - and we'd like to generate a specialised version of that function too. - This actually happens a lot. Consider - replicateM_ :: (Monad m) => Int -> m a -> m () - {-# INLINABLE replicateM_ #-} - replicateM_ d x ma = ... - The strictness analyser may transform to - replicateM_ :: (Monad m) => Int -> m a -> m () - {-# INLINE replicateM_ #-} - replicateM_ d x ma = case x of I# x' -> $wreplicateM_ d x' ma - - $wreplicateM_ :: (Monad m) => Int# -> m a -> m () - {-# INLINABLE $wreplicateM_ #-} - $wreplicateM_ = ... - Now an importing module has a specialised call to replicateM_, say - (replicateM_ dMonadIO). We certainly want to specialise $wreplicateM_! - This particular example had a huge effect on the call to replicateM_ - in nofib/shootout/n-body. --} - -{- ********************************************************************* -* * - SpecArg, and specHeader -* * -********************************************************************* -} - --- | An argument that we might want to specialise. --- See Note [Specialising Calls] for the nitty gritty details. -data SpecArg - = - -- | Type arguments that should be specialised, due to appearing - -- free in the type of a 'SpecDict'. - SpecType Type - - -- | Type arguments that should remain polymorphic. - | UnspecType - - -- | Dictionaries that should be specialised. mkCallUDs ensures - -- that only "interesting" dictionary arguments get a SpecDict; - -- see Note [Interesting dictionary arguments] - | SpecDict DictExpr - - -- | Value arguments that should not be specialised. - | UnspecArg - -instance Outputable SpecArg where - ppr (SpecType t) = text "SpecType" <+> ppr t - ppr UnspecType = text "UnspecType" - ppr (SpecDict d) = text "SpecDict" <+> ppr d - ppr UnspecArg = text "UnspecArg" - -specArgFreeIds :: SpecArg -> IdSet -specArgFreeIds (SpecType {}) = emptyVarSet -specArgFreeIds (SpecDict dx) = exprFreeIds dx -specArgFreeIds UnspecType = emptyVarSet -specArgFreeIds UnspecArg = emptyVarSet - -specArgFreeVars :: SpecArg -> VarSet -specArgFreeVars (SpecType ty) = tyCoVarsOfType ty -specArgFreeVars (SpecDict dx) = exprFreeVars dx -specArgFreeVars UnspecType = emptyVarSet -specArgFreeVars UnspecArg = emptyVarSet - -isSpecDict :: SpecArg -> Bool -isSpecDict (SpecDict {}) = True -isSpecDict _ = False - --- | Given binders from an original function 'f', and the 'SpecArg's --- corresponding to its usage, compute everything necessary to build --- a specialisation. --- --- We will use the running example from Note [Specialising Calls]: --- --- f :: forall a b c. Int -> Eq a => Show b => c -> Blah --- f @a @b @c i dEqA dShowB x = blah --- --- Suppose we decide to specialise it at the following pattern: --- --- [ SpecType T1, SpecType T2, UnspecType, UnspecArg --- , SpecDict dEqT1, SpecDict ($dfShow dShowT2), UnspecArg ] --- --- We'd eventually like to build the RULE --- --- RULE "SPEC f @T1 @T2 _" --- forall (@c :: Type) (i :: Int) (d1 :: Eq T1) (d2 :: Show T2). --- f @T1 @T2 @c i d1 d2 = $sf @c i --- --- and the specialisation '$sf' --- --- $sf :: forall c. Int -> c -> Blah --- $sf = SUBST[a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowB :-> dShow1] (\@c i x -> blah) --- --- where dShow1 is a floated binding created by bindAuxiliaryDict. --- --- The cases for 'specHeader' below are presented in the same order as this --- running example. The result of 'specHeader' for this example is as follows: --- --- ( -- Returned arguments --- env + [a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowB :-> dShow1] --- , [x] --- --- -- RULE helpers --- , [c, i, d1, d2] --- , [T1, T2, c, i, d1, d2] --- --- -- Specialised function helpers --- , [c, i, x] --- , [dShow1 = $dfShow dShowT2] --- , [T1, T2, c, i, dEqT1, dShow1] --- ) -specHeader - :: SpecEnv - -> [InBndr] -- The binders from the original function 'f' - -> [SpecArg] -- From the CallInfo - -> SpecM ( Bool -- True <=> some useful specialisation happened - -- Not the same as any (isSpecDict args) because - -- the args might be longer than bndrs - - -- Returned arguments - , SpecEnv -- Substitution to apply to the body of 'f' - , [OutBndr] -- Leftover binders from the original function 'f' - -- that don’t have a corresponding SpecArg - - -- RULE helpers - , [OutBndr] -- Binders for the RULE - , [OutExpr] -- Args for the LHS of the rule - - -- Specialised function helpers - , [OutBndr] -- Binders for $sf - , [DictBind] -- Auxiliary dictionary bindings - , [OutExpr] -- Specialised arguments for unfolding - -- Same length as "Args for LHS of rule" - ) - --- We want to specialise on type 'T1', and so we must construct a substitution --- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding --- details. -specHeader env (bndr : bndrs) (SpecType ty : args) - = do { -- Find qvars, the type variables to add to the binders for the rule - -- Namely those free in `ty` that aren't in scope - -- See (MP2) in Note [Specialising polymorphic dictionaries] - let in_scope = Core.getSubstInScope (se_subst env) - qvars = scopedSort $ - filterOut (`elemInScopeSet` in_scope) $ - tyCoVarsOfTypeList ty - (env1, qvars') = substBndrs env qvars - ty' = substTy env1 ty - env2 = extendTvSubst env1 bndr ty' - ; (useful, env3, leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) - <- specHeader env2 bndrs args - ; pure ( useful - , env3 - , leftover_bndrs - , qvars' ++ rule_bs - , Type ty' : rule_es - , qvars' ++ bs' - , dx - , Type ty' : spec_args - ) - } - --- Next we have a type that we don't want to specialise. We need to perform --- a substitution on it (in case the type refers to 'a'). Additionally, we need --- to produce a binder, LHS argument and RHS argument for the resulting rule, --- /and/ a binder for the specialised body. -specHeader env (bndr : bndrs) (UnspecType : args) - = do { let (env', bndr') = substBndr env bndr - ; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) - <- specHeader env' bndrs args - ; pure ( useful - , env'' - , leftover_bndrs - , bndr' : rule_bs - , varToCoreExpr bndr' : rule_es - , bndr' : bs' - , dx - , varToCoreExpr bndr' : spec_args - ) - } - --- Next we want to specialise the 'Eq a' dict away. We need to construct --- a wildcard binder to match the dictionary (See Note [Specialising Calls] for --- the nitty-gritty), as a LHS rule and unfolding details. -specHeader env (bndr : bndrs) (SpecDict d : args) - | not (isDeadBinder bndr) - , allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d) - -- See Note [Weird special case for SpecDict] - = do { (env1, bndr') <- newDictBndr env bndr -- See Note [Zap occ info in rule binders] - ; let (env2, dx_bind, spec_dict) = bindAuxiliaryDict env1 bndr bndr' d - ; (_, env3, leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) - <- specHeader env2 bndrs args - ; pure ( True -- Ha! A useful specialisation! - , env3 - , leftover_bndrs - -- See Note [Evidence foralls] - , exprFreeIdsList (varToCoreExpr bndr') ++ rule_bs - , varToCoreExpr bndr' : rule_es - , bs' - , maybeToList dx_bind ++ dx - , spec_dict : spec_args - ) - } - where - in_scope = Core.getSubstInScope (se_subst env) - --- Finally, we don't want to specialise on this argument 'i': --- - It's an UnSpecArg, or --- - It's a dead dictionary --- We need to produce a binder, LHS and RHS argument for the RULE, and --- a binder for the specialised body. --- --- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is --- why 'i' doesn't appear in our RULE above. But we have no guarantee that --- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so --- this case must be here. -specHeader env (bndr : bndrs) (_ : args) - -- The "_" can be UnSpecArg, or SpecDict where the bndr is dead - = do { -- see Note [Zap occ info in rule binders] - let (env', bndr') = substBndr env (zapIdOccInfo bndr) - ; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) - <- specHeader env' bndrs args - - ; let bndr_ty = idType bndr' - - -- See Note [Drop dead args from specialisations] - -- C.f. GHC.Core.Opt.WorkWrap.Utils.mk_absent_let - (mb_spec_bndr, spec_arg) - | isDeadBinder bndr - , Just lit_expr <- mkLitRubbish bndr_ty - = (Nothing, lit_expr) - | otherwise - = (Just bndr', varToCoreExpr bndr') - - ; pure ( useful - , env'' - , leftover_bndrs - , bndr' : rule_bs - , varToCoreExpr bndr' : rule_es - , case mb_spec_bndr of - Just b' -> b' : bs' - Nothing -> bs' - , dx - , spec_arg : spec_args - ) - } - --- If we run out of binders, stop immediately --- See Note [Specialisation Must Preserve Sharing] -specHeader env [] _ = pure (False, env, [], [], [], [], [], []) - --- Return all remaining binders from the original function. These have the --- invariant that they should all correspond to unspecialised arguments, so --- it's safe to stop processing at this point. -specHeader env bndrs [] - = pure (False, env', bndrs', [], [], [], [], []) - where - (env', bndrs') = substBndrs env bndrs - - --- | Binds a dictionary argument to a fresh name, to preserve sharing -bindAuxiliaryDict - :: SpecEnv - -> InId -> OutId -> OutExpr -- Original dict binder, and the witnessing expression - -> ( SpecEnv -- Substitutes for orig_dict_id - , Maybe DictBind -- Auxiliary dict binding, if any - , OutExpr) -- Witnessing expression (always trivial) -bindAuxiliaryDict env@(SE { se_subst = subst }) - orig_dict_id fresh_dict_id dict_expr - - -- If the dictionary argument is trivial, - -- don’t bother creating a new dict binding; just substitute - | exprIsTrivial dict_expr - = let env' = env { se_subst = Core.extendSubst subst orig_dict_id dict_expr } - in -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $ - (env', Nothing, dict_expr) - - | otherwise -- Non-trivial dictionary arg; make an auxiliary binding - = let fresh_dict_id' = fresh_dict_id `addDictUnfolding` dict_expr - - dict_bind = mkDB (NonRec fresh_dict_id' dict_expr) - env' = env { se_subst = Core.extendSubst subst orig_dict_id (Var fresh_dict_id') - `Core.extendSubstInScope` fresh_dict_id' } - -- Ensure the new unfolding is in the in-scope set - in -- pprTrace "bindAuxiliaryDict:non-trivial" (ppr orig_dict_id <+> ppr fresh_dict_id') $ - (env', Just dict_bind, Var fresh_dict_id') - -addDictUnfolding :: Id -> CoreExpr -> Id --- Add unfolding for freshly-bound Ids: see Note [Make the new dictionaries interesting] --- and Note [Specialisation modulo dictionary selectors] -addDictUnfolding id rhs - = id `setIdUnfolding` mkSimpleUnfolding defaultUnfoldingOpts rhs - -{- -Note [Make the new dictionaries interesting] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Important! We're going to substitute dx_id1 for d -and we want it to look "interesting", else we won't gather *any* -consequential calls. E.g. - f d = ...g d.... -If we specialise f for a call (f (dfun dNumInt)), we'll get -a consequent call (g d') with an auxiliary definition - d' = df dNumInt -We want that consequent call to look interesting; so we add an unfolding -in the dictionary Id. --} - - -{- ********************************************************************* -* * - UsageDetails and suchlike -* * -********************************************************************* -} - -data UsageDetails - = MkUD { ud_binds :: !FloatedDictBinds - , ud_calls :: !CallDetails } - -- INVARIANT: suppose bs = fdb_bndrs ud_binds - -- Then 'calls' may *mention* 'bs', - -- but there should be no calls *for* bs - -data FloatedDictBinds -- See Note [Floated dictionary bindings] - = FDB { fdb_binds :: !(OrdList DictBind) - -- The order is important; - -- in ds1 `appOL` ds2, bindings in ds2 can depend on those in ds1 - - , fdb_bndrs :: !IdSet - } -- ^ The binders of 'fdb_binds'. - -- Caches a superset of the expression - -- `mkVarSet (bindersOfDictBinds fdb_binds))` - -- for later addition to an InScopeSet - --- | A 'DictBind' is a binding along with a cached set containing its free --- variables (both type variables and dictionaries). We need this set --- in splitDictBinds, when filtering bindings to decide which are --- captured by a binder -data DictBind = DB { db_bind :: CoreBind, db_fvs :: VarSet } - -bindersOfDictBind :: DictBind -> [Id] -bindersOfDictBind = bindersOf . db_bind - -bindersOfDictBinds :: Foldable f => f DictBind -> [Id] -bindersOfDictBinds = bindersOfBinds . foldr ((:) . db_bind) [] - -{- Note [Floated dictionary bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We float out dictionary bindings for the reasons described under -"Dictionary floating" above. But not /just/ dictionary bindings. -Consider - - f :: Eq a => blah - f a d = rhs - - $c== :: T -> T -> Bool - $c== x y = ... - - $df :: Eq T - $df = Eq $c== ... - - gurgle = ...(f @T $df)... - -We gather the call info for (f @T $df), and we don't want to drop it -when we come across the binding for $df. So we add $df to the floats -and continue. But then we have to add $c== to the floats, and so on. -These all float above the binding for 'f', and now we can -successfully specialise 'f'. - -So the DictBinds in (ud_binds :: OrdList DictBind) may contain -non-dictionary bindings too. - -Note [Specialising polymorphic dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Note June 2023: This has proved to be quite a tricky optimisation to get right -see (#23469, #23109, #21229, #23445) so it is now guarded by a flag -`-fpolymorphic-specialisation`. - - -Consider - class M a where { foo :: a -> Int } - - instance M (ST s) where ... - -- dMST :: forall s. M (ST s) - - wimwam :: forall a. M a => a -> Int - wimwam = /\a \(d::M a). body - - f :: ST s -> Int - f = /\s \(x::ST s). wimwam @(ST s) (dMST @s) dx + 1 - -We'd like to specialise wimwam at (ST s), thus - $swimwam :: forall s. ST s -> Int - $swimwam = /\s. body[ST s/a, (dMST @s)/d] - - RULE forall s (d :: M (ST s)). - wimwam @(ST s) d = $swimwam @s - -Here are the moving parts: - -(MP1) We must /not/ dump the CallInfo - CIS wimwam (CI { ci_key = [@(ST s), dMST @s] - , ci_fvs = {dMST} }) - when we come to the /\s. Instead, we simply let it continue to float - upwards. Hence ci_fvs is an IdSet, listing the /Ids/ that - are free in the call, but not the /TyVars/. Hence using specArgFreeIds - in singleCall. - - NB to be fully kosher we should explicitly quantifying the CallInfo - over 's', but we don't bother. This would matter if there was an - enclosing binding of the same 's', which I don't expect to happen. - -(MP2) When we come to specialise the call, we must remember to quantify - over 's'. That is done in the SpecType case of specHeader, where - we add 's' (called qvars) to the binders of the RULE and the specialised - function. - -(MP3) If we have f :: forall m. Monoid m => blah, and two calls - (f @(Endo b) (d :: Monoid (Endo b)) - (f @(Endo (c->c)) (d :: Monoid (Endo (c->c))) - we want to generate a specialisation only for the first. The second - is just a substitution instance of the first, with no greater specialisation. - Hence the call to `remove_dups` in `filterCalls`. - -All this arose in #13873, in the unexpected form that a SPECIALISE -pragma made the program slower! The reason was that the specialised -function $sinsertWith arising from the pragma looked rather like `f` -above, and failed to specialise a call in its body like wimwam. -Without the pragma, the original call to `insertWith` was completely -monomorpic, and specialised in one go. - -Wrinkles. - -* See Note [Weird special case for SpecDict] - -* With -XOverlappingInstances you might worry about this: - class C a where ... - instance C (Maybe Int) where ... -- $df1 :: C (Maybe Int) - instance C (Maybe a) where ... -- $df2 :: forall a. C (Maybe a) - - f :: C a => blah - f = rhs - - g = /\a. ...(f @(Maybe a) ($df2 a))... - h = ...f @(Maybe Int) $df1 - - There are two calls to f, but with different evidence. This patch will - combine them into one. But it's OK: this code will never arise unless you - use -XIncoherentInstances. Even with -XOverlappingInstances, GHC tries hard - to keep dictionaries as singleton types. But that goes out of the window - with -XIncoherentInstances -- and that is true even with ordianry type-class - specialisation (at least if any inlining has taken place). - - GHC makes very few guarantees when you use -XIncoherentInstances, and its - not worth crippling the normal case for the incoherent corner. (The best - thing might be to switch off specialisation altogether if incoherence is - involved... but incoherence is a property of an instance, not a class, so - it's a hard test to make.) - - But see Note [Specialisation and overlapping instances]. - -Note [Weird special case for SpecDict] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we are trying to specialise for this this call: - $wsplit @T (mkD @k @(a::k) :: C T) -where - mkD :: forall k (a::k). C T -is a top-level dictionary-former. This actually happened in #22459, -because of (MP1) of Note [Specialising polymorphic dictionaries]. - -How can we specialise $wsplit? We might try - - RULE "SPEC" forall (d :: C T). $wsplit @T d = $s$wsplit - -but then in the body of $s$wsplit what will we use for the dictionary -evidence? We can't use (mkD @k @(a::k)) because k and a aren't in scope. -We could zap `k` to (Any @Type) and `a` to (Any @(Any @Type)), but that -is a lot of hard work for a very strange case. - -So we simply refrain from specialising in this case; hence the guard - allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d) -in the SpecDict cased of specHeader. - -How did this strange polymorphic mkD arise in the first place? -From GHC.Core.Opt.Utils.abstractFloats, which was abstracting -over too many type variables. But that too is now fixed; -see Note [Which type variables to abstract over] in that module. --} - -instance Outputable DictBind where - ppr (DB { db_bind = bind, db_fvs = fvs }) - = text "DB" <+> braces (sep [ text "fvs: " <+> ppr fvs - , text "bind:" <+> ppr bind ]) - -instance Outputable UsageDetails where - ppr (MkUD { ud_binds = dbs, ud_calls = calls }) - = text "MkUD" <+> braces (sep (punctuate comma - [text "binds" <+> equals <+> ppr dbs, - text "calls" <+> equals <+> ppr calls])) - -instance Outputable FloatedDictBinds where - ppr (FDB { fdb_binds = binds }) = ppr binds - -emptyUDs :: UsageDetails -emptyUDs = MkUD { ud_binds = emptyFDBs, ud_calls = emptyDVarEnv } - - -emptyFDBs :: FloatedDictBinds -emptyFDBs = FDB { fdb_binds = nilOL, fdb_bndrs = emptyVarSet } - ------------------------------------------------------------- -type CallDetails = DIdEnv CallInfoSet - -- The order of specialized binds and rules depends on how we linearize - -- CallDetails, so to get determinism we must use a deterministic set here. - -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM - -data CallInfoSet = CIS Id (Bag CallInfo) - -- The list of types and dictionaries is guaranteed to - -- match the type of f - -- The Bag may contain duplicate calls (i.e. f @T and another f @T) - -- These dups are eliminated by already_covered in specCalls - -data CallInfo - = CI { ci_key :: [SpecArg] -- All arguments - , ci_fvs :: IdSet -- Free Ids of the ci_key call - -- /not/ including the main id itself, of course - -- NB: excluding tyvars: - -- See Note [Specialising polymorphic dictionaries] - } - -type DictExpr = CoreExpr - -ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet -ciSetFilter p (CIS id a) = CIS id (filterBag p a) - -instance Outputable CallInfoSet where - ppr (CIS fn map) = hang (text "CIS" <+> ppr fn) - 2 (ppr map) - -pprCallInfo :: Id -> CallInfo -> SDoc -pprCallInfo fn (CI { ci_key = key }) - = ppr fn <+> ppr key - -instance Outputable CallInfo where - ppr (CI { ci_key = key, ci_fvs = _fvs }) - = text "CI" <> braces (text "fvs" <+> ppr _fvs - $$ sep (map ppr key)) - -unionCalls :: CallDetails -> CallDetails -> CallDetails -unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 - -unionCallInfoSet :: CallInfoSet -> CallInfoSet -> CallInfoSet -unionCallInfoSet (CIS f calls1) (CIS _ calls2) = - CIS f (calls1 `unionBags` calls2) - -callDetailsFVs :: CallDetails -> VarSet -callDetailsFVs calls = - nonDetStrictFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls - -- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering - -- immediately by converting to a nondeterministic set. - -callInfoFVs :: CallInfoSet -> VarSet -callInfoFVs (CIS _ call_info) = - foldr (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info - -getTheta :: [PiTyBinder] -> [PredType] -getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiTyBinder - - ------------------------------------------------------------- -singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails -singleCall spec_env id args - = MkUD {ud_binds = emptyFDBs, - ud_calls = unitDVarEnv id $ CIS id $ - unitBag (CI { ci_key = args - , ci_fvs = call_fvs }) } - where - call_fvs = - foldr (unionVarSet . free_var_fn) emptyVarSet args - - free_var_fn = - if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) - then specArgFreeIds - else specArgFreeVars - - - - -- specArgFreeIds: we specifically look for free Ids, not TyVars - -- see (MP1) in Note [Specialising polymorphic dictionaries] - -- - -- We don't include the 'id' itself. - -mkCallUDs :: SpecEnv -> OutExpr -> [OutExpr] -> UsageDetails -mkCallUDs env fun args - | (_, Var f) <- stripTicksTop tickishFloatable fun -- See Note [Ticks on applications] - = -- pprTraceWith "mkCallUDs" (\res -> vcat [ ppr f, ppr args, ppr res ]) $ - mkCallUDs' env f args - | otherwise - = emptyUDs - -mkCallUDs' :: SpecEnv -> Id -> [OutExpr] -> UsageDetails -mkCallUDs' env f args - | wantCallsFor env f -- We want it, and... - , not (null ci_key) -- this call site has a useful specialisation - = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall env f ci_key - - | otherwise -- See also Note [Specialisations already covered] - = -- pprTrace "mkCallUDs: discarding" _trace_doc - emptyUDs - - where - _trace_doc = vcat [ppr f, ppr args, ppr ci_key] - pis = fst $ splitPiTys $ idType f - constrained_tyvars = tyCoVarsOfTypes $ getTheta pis - - ci_key :: [SpecArg] - ci_key = dropWhileEndLE (not . isSpecDict) $ - zipWith mk_spec_arg args pis - -- Drop trailing args until we get to a SpecDict - -- In this way the RULE has as few args as possible, - -- which broadens its applicability, since rules only - -- fire when saturated - - mk_spec_arg :: OutExpr -> PiTyBinder -> SpecArg - mk_spec_arg arg (Named bndr) - | binderVar bndr `elemVarSet` constrained_tyvars - = case arg of - Type ty -> SpecType ty - _ -> pprPanic "ci_key" $ ppr arg - | otherwise = UnspecType - - -- For "invisibleFunArg", which are the type-class dictionaries, - -- we decide on a case by case basis if we want to specialise - -- on this argument; if so, SpecDict, if not UnspecArg - mk_spec_arg arg (Anon pred af) - | isInvisibleFunArg af - , interestingDict arg (scaledThing pred) - -- See Note [Interesting dictionary arguments] - = SpecDict arg - - | otherwise = UnspecArg - -{- -Note [Ticks on applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Ticks such as source location annotations can sometimes make their way -onto applications (see e.g. #21697). So if we see something like - - App (Tick _ f) e - -we need to descend below the tick to find what the real function being -applied is. - -The resulting RULE also has to be able to match this annotated use -site, so we only look through ticks that RULE matching looks through -(see Note [Tick annotations in RULE matching] in GHC.Core.Rules). --} - -wantCallsFor :: SpecEnv -> Id -> Bool -wantCallsFor _env _f = True - -- We could reduce the size of the UsageDetails by being less eager - -- about collecting calls for LocalIds: there is no point for - -- ones that are lambda-bound. We can't decide this by looking at - -- the (absence of an) unfolding, because unfoldings for local - -- functions are discarded by cloneBindSM, so no local binder will - -- have an unfolding at this stage. We'd have to keep a candidate - -- set of let-binders. - -- - -- Not many lambda-bound variables have dictionary arguments, so - -- this would make little difference anyway. - -- - -- For imported Ids we could check for an unfolding, but we have to - -- do so anyway in canSpecImport, and it seems better to have it - -- all in one place. So we simply collect usage info for imported - -- overloaded functions. - -{- Note [Interesting dictionary arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this - \a.\d:Eq a. let f = ... in ...(f d)... -There really is not much point in specialising f wrt the dictionary d, -because the code for the specialised f is not improved at all, because -d is lambda-bound. We simply get junk specialisations. - -What is "interesting"? Just that it has *some* structure. But what about -variables? We look in the variable's /unfolding/. And that means -that we must be careful to ensure that dictionaries have unfoldings, - -* cloneBndrSM discards non-Stable unfoldings -* specBind updates the unfolding after specialisation - See Note [Update unfolding after specialisation] -* bindAuxiliaryDict adds an unfolding for an aux dict - see Note [Specialisation modulo dictionary selectors] -* specCase adds unfoldings for the new bindings it creates - -We accidentally lost accurate tracking of local variables for a long -time, because cloned variables didn't have unfoldings. But makes a -massive difference in a few cases, eg #5113. For nofib as a -whole it's only a small win: 2.2% improvement in allocation for ansi, -1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size. - -Note [Update unfolding after specialisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#21848) - - wombat :: Show b => Int -> b -> String - wombat a b | a>0 = wombat (a-1) b - | otherwise = show a ++ wombat a b - - class C a where - meth :: Show b => a -> b -> String - dummy :: a -> () -- Force a datatype dictionary representation - - instance C Int where - meth = wombat - dummy _ = () - - class C a => D a -- D has C as a superclass - instance D Int - - f :: (D a, Show b) => a -> b -> String - {-# INLINABLE[0] f #-} - f a b = meth a b ++ "!" ++ meth a b - -Now `f` turns into: - - f @a @b (dd :: D a) (ds :: Show b) a b - = let dc :: D a = %p1 dd -- Superclass selection - in meth @a dc .... - meth @a dc .... - -When we specialise `f`, at a=Int say, that superclass selection can -nfire (via rewiteClassOps), but that info (that 'dc' is now a -particular dictionary `C`, of type `C Int`) must be available to -the call `meth @a dc`, so that we can fire the `meth` class-op, and -thence specialise `wombat`. - -We deliver on this idea by updating the unfolding for the binder -in the NonRec case of specBind. (This is too exotic to trouble with -the Rec case.) --} - -interestingDict :: CoreExpr -> Type -> Bool --- A dictionary argument is interesting if it has *some* structure, --- see Note [Interesting dictionary arguments] --- NB: "dictionary" arguments include constraints of all sorts, --- including equality constraints; hence the Coercion case --- To make this work, we need to ensure that dictionaries have --- unfoldings in them. -interestingDict arg arg_ty - | not (typeDeterminesValue arg_ty) = False -- See Note [Type determines value] - | otherwise = go arg - where - go (Var v) = hasSomeUnfolding (idUnfolding v) - || isDataConWorkId v - go (Type _) = False - go (Coercion _) = False - go (App fn (Type _)) = go fn - go (App fn (Coercion _)) = go fn - go (Tick _ a) = go a - go (Cast e _) = go e - go _ = True - -thenUDs :: UsageDetails -> UsageDetails -> UsageDetails -thenUDs (MkUD {ud_binds = db1, ud_calls = calls1}) - (MkUD {ud_binds = db2, ud_calls = calls2}) - = MkUD { ud_binds = db1 `thenFDBs` db2 - , ud_calls = calls1 `unionCalls` calls2 } - -thenFDBs :: FloatedDictBinds -> FloatedDictBinds -> FloatedDictBinds --- Combine FloatedDictBinds --- In (dbs1 `thenFDBs` dbs2), dbs2 may mention dbs1 but not vice versa -thenFDBs (FDB { fdb_binds = dbs1, fdb_bndrs = bs1 }) - (FDB { fdb_binds = dbs2, fdb_bndrs = bs2 }) - = FDB { fdb_binds = dbs1 `appOL` dbs2 - , fdb_bndrs = bs1 `unionVarSet` bs2 } - ------------------------------ -_dictBindBndrs :: OrdList DictBind -> [Id] -_dictBindBndrs dbs = foldr ((++) . bindersOf . db_bind) [] dbs - --- | Construct a 'DictBind' from a 'CoreBind' -mkDB :: CoreBind -> DictBind -mkDB bind = DB { db_bind = bind, db_fvs = bind_fvs bind } - --- | Identify the free variables of a 'CoreBind' -bind_fvs :: CoreBind -> VarSet -bind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs) -bind_fvs (Rec prs) = rhs_fvs `delVarSetList` (map fst prs) - where - rhs_fvs = unionVarSets (map pair_fvs prs) - -pair_fvs :: (Id, CoreExpr) -> VarSet -pair_fvs (bndr, rhs) = exprSomeFreeVars interesting rhs - `unionVarSet` idFreeVars bndr - -- idFreeVars: don't forget variables mentioned in - -- the rules of the bndr. C.f. OccAnal.addRuleUsage - -- Also tyvars mentioned in its type; they may not appear - -- in the RHS - -- type T a = Int - -- x :: T a = 3 - where - interesting :: InterestingVarFun - interesting v = isLocalVar v || (isId v && isDFunId v) - -- Very important: include DFunIds /even/ if it is imported - -- Reason: See Note [Avoiding loops in specImports], the #13429 - -- example involving an imported dfun. We must know - -- whether a dictionary binding depends on an imported - -- DFun in case we try to specialise that imported DFun - --- | Flatten a set of "dumped" 'DictBind's, and some other binding --- pairs, into a single recursive binding. -recWithDumpedDicts :: [(Id,CoreExpr)] -> OrdList DictBind -> DictBind -recWithDumpedDicts pairs dbs - = DB { db_bind = Rec bindings - , db_fvs = fvs `delVarSetList` map fst bindings } - where - (bindings, fvs) = foldr add ([], emptyVarSet) - (dbs `snocOL` mkDB (Rec pairs)) - add (DB { db_bind = bind, db_fvs = fvs }) (prs_acc, fvs_acc) - = case bind of - NonRec b r -> ((b,r) : prs_acc, fvs') - Rec prs1 -> (prs1 ++ prs_acc, fvs') - where - fvs' = fvs_acc `unionVarSet` fvs - -snocDictBind :: UsageDetails -> DictBind -> UsageDetails -snocDictBind uds@MkUD{ud_binds= FDB { fdb_binds = dbs, fdb_bndrs = bs }} db - = uds { ud_binds = FDB { fdb_binds = dbs `snocOL` db - , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } } - -snocDictBinds :: UsageDetails -> [DictBind] -> UsageDetails --- Add ud_binds to the tail end of the bindings in uds -snocDictBinds uds@MkUD{ud_binds=FDB{ fdb_binds = binds, fdb_bndrs = bs }} dbs - = uds { ud_binds = FDB { fdb_binds = binds `appOL` (toOL dbs) - , fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } } - -consDictBinds :: [DictBind] -> UsageDetails -> UsageDetails -consDictBinds dbs uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs = bs}} - = uds { ud_binds = FDB{ fdb_binds = toOL dbs `appOL` binds - , fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } } - -wrapDictBinds :: FloatedDictBinds -> [CoreBind] -> [CoreBind] -wrapDictBinds (FDB { fdb_binds = dbs }) binds - = foldr add binds dbs - where - add (DB { db_bind = bind }) binds = bind : binds - -wrapDictBindsE :: OrdList DictBind -> CoreExpr -> CoreExpr -wrapDictBindsE dbs expr - = foldr add expr dbs - where - add (DB { db_bind = bind }) expr = Let bind expr - ----------------------- -dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind) --- Used at binder; just dump anything mentioning the binder -dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }) - | null bndrs = (uds, nilOL) -- Common in case alternatives - | otherwise = -- pprTrace "dumpUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs) $ - (free_uds, dump_dbs) - where - free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls } - bndr_set = mkVarSet bndrs - (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set - - -- Delete calls: - -- * For any binder in `bndrs` - -- * That mention a dictionary bound in `dump_set` - -- These variables aren't in scope "above" the binding and the `dump_dbs`, - -- so no call should mention them. (See #26682.) - free_calls = deleteCallsMentioning dump_set $ - deleteCallsFor bndrs orig_calls - -dumpBindUDs :: Bool -- Main binding can float to top - -> [CoreBndr] -> UsageDetails - -> (UsageDetails, OrdList DictBind, Bool) --- Used at a let(rec) binding. --- We return a boolean indicating whether the binding itself --- is mentioned, directly or indirectly, by any of the ud_calls; --- in that case we want to float the binding itself. --- See Note [Floated dictionary bindings] --- If the boolean is True, then the returned ud_calls can mention `bndrs`; --- if False, then returned ud_calls must not mention `bndrs` -dumpBindUDs can_float_bind bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }) - = ( MkUD { ud_binds = free_dbs, ud_calls = free_calls2 } - , dump_dbs - , can_float_bind && calls_mention_bndrs ) - where - bndr_set = mkVarSet bndrs - (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set - free_calls1 = deleteCallsFor bndrs orig_calls - calls_mention_bndrs = dump_set `intersectsVarSet` callDetailsFVs free_calls1 - free_calls2 | can_float_bind = free_calls1 - | otherwise = deleteCallsMentioning dump_set free_calls1 - -callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo]) -callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls } - = -- pprTrace ("callsForMe") - -- (vcat [ppr fn, - -- text "Orig dbs =" <+> ppr (_dictBindBndrs orig_dbs), - -- text "Orig calls =" <+> ppr orig_calls, - -- text "Calls for me =" <+> ppr calls_for_me]) $ - (uds_without_me, calls_for_me) - where - uds_without_me = uds { ud_calls = delDVarEnv orig_calls fn } - calls_for_me = case lookupDVarEnv orig_calls fn of - Nothing -> [] - Just cis -> filterCalls cis orig_dbs - -- filterCalls: drop calls that (directly or indirectly) - -- refer to fn. See Note [Avoiding loops (DFuns)] - ----------------------- -filterCalls :: CallInfoSet -> FloatedDictBinds -> [CallInfo] --- Remove dominated calls (Note [Specialising polymorphic dictionaries]) --- and loopy DFuns (Note [Avoiding loops (DFuns)]) -filterCalls (CIS fn call_bag) (FDB { fdb_binds = dbs }) - | isDFunId fn -- Note [Avoiding loops (DFuns)] applies only to DFuns - = filter ok_call de_dupd_calls - | otherwise -- Do not apply it to non-DFuns - = de_dupd_calls -- See Note [Avoiding loops (non-DFuns)] - where - de_dupd_calls = remove_dups call_bag - - dump_set = foldl' go (unitVarSet fn) dbs - -- This dump-set could also be computed by splitDictBinds - -- (_,_,dump_set) = splitDictBinds dbs {fn} - -- But this variant is shorter - - go so_far (DB { db_bind = bind, db_fvs = fvs }) - | fvs `intersectsVarSet` so_far - = extendVarSetList so_far (bindersOf bind) - | otherwise = so_far - - ok_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` dump_set - -remove_dups :: Bag CallInfo -> [CallInfo] --- Calls involving more generic instances beat more specific ones. --- See (MP3) in Note [Specialising polymorphic dictionaries] -remove_dups calls = foldr add [] calls - where - add :: CallInfo -> [CallInfo] -> [CallInfo] - add ci [] = [ci] - add ci1 (ci2:cis) | ci2 `beats_or_same` ci1 = ci2:cis - | ci1 `beats_or_same` ci2 = ci1:cis - | otherwise = ci2 : add ci1 cis - -beats_or_same :: CallInfo -> CallInfo -> Bool -beats_or_same (CI { ci_key = args1 }) (CI { ci_key = args2 }) - = go args1 args2 - where - go [] _ = True - go (arg1:args1) (arg2:args2) = go_arg arg1 arg2 && go args1 args2 - go (_:_) [] = False - - go_arg (SpecType ty1) (SpecType ty2) = isJust (tcMatchTy ty1 ty2) - go_arg UnspecType UnspecType = True - go_arg (SpecDict {}) (SpecDict {}) = True - go_arg UnspecArg UnspecArg = True - go_arg _ _ = False - ----------------------- -splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet) --- splitDictBinds dbs bndrs returns --- (free_dbs, dump_dbs, dump_set) --- where --- * dump_dbs depends, transitively on bndrs --- * free_dbs does not depend on bndrs --- * dump_set = bndrs `union` bndrs(dump_dbs) -splitDictBinds (FDB { fdb_binds = dbs, fdb_bndrs = bs }) bndr_set - = (FDB { fdb_binds = free_dbs - , fdb_bndrs = bs `minusVarSet` dump_set } - , dump_dbs, dump_set) - where - (free_dbs, dump_dbs, dump_set) - = foldl' split_db (nilOL, nilOL, bndr_set) dbs - -- Important that it's foldl' not foldr; - -- we're accumulating the set of dumped ids in dump_set - - split_db (free_dbs, dump_dbs, dump_idset) db - | DB { db_bind = bind, db_fvs = fvs } <- db - , dump_idset `intersectsVarSet` fvs -- Dump it - = (free_dbs, dump_dbs `snocOL` db, - extendVarSetList dump_idset (bindersOf bind)) - - | otherwise -- Don't dump it - = (free_dbs `snocOL` db, dump_dbs, dump_idset) - - ----------------------- -deleteCallsMentioning :: VarSet -> CallDetails -> CallDetails --- Remove calls mentioning any Id in bndrs --- NB: The call is allowed to mention TyVars in bndrs --- Note [Specialising polymorphic dictionaries] --- ci_fvs are just the free /Ids/ -deleteCallsMentioning bndrs calls - = mapDVarEnv (ciSetFilter keep_call) calls - where - keep_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` bndrs - -deleteCallsFor :: [Id] -> CallDetails -> CallDetails --- Remove calls *for* bndrs -deleteCallsFor bndrs calls = delDVarEnvList calls bndrs - -{- -************************************************************************ -* * -\subsubsection{Boring helper functions} -* * -************************************************************************ --} - -type SpecM a = UniqSM a - -runSpecM :: SpecM a -> CoreM a -runSpecM thing_inside - = do { us <- getUniqueSupplyM - ; return (initUs_ us thing_inside) } - -mapAndCombineSM :: (a -> SpecM (b, UsageDetails)) -> [a] -> SpecM ([b], UsageDetails) -mapAndCombineSM _ [] = return ([], emptyUDs) -mapAndCombineSM f (x:xs) = do (y, uds1) <- f x - (ys, uds2) <- mapAndCombineSM f xs - return (y:ys, uds1 `thenUDs` uds2) - -extendTvSubst :: SpecEnv -> TyVar -> Type -> SpecEnv -extendTvSubst env tv ty - = env { se_subst = Core.extendTvSubst (se_subst env) tv ty } - -extendInScope :: SpecEnv -> OutId -> SpecEnv -extendInScope env@(SE { se_subst = subst }) bndr - = env { se_subst = subst `Core.extendSubstInScope` bndr } - -zapSubst :: SpecEnv -> SpecEnv -zapSubst env@(SE { se_subst = subst }) - = env { se_subst = Core.zapSubst subst } - -substTy :: SpecEnv -> Type -> Type -substTy env ty = substTyUnchecked (se_subst env) ty - -substCo :: SpecEnv -> Coercion -> Coercion -substCo env co = Core.substCo (se_subst env) co - -substBndr :: SpecEnv -> CoreBndr -> (SpecEnv, CoreBndr) -substBndr env bs = case Core.substBndr (se_subst env) bs of - (subst', bs') -> (env { se_subst = subst' }, bs') - -substBndrs :: SpecEnv -> [CoreBndr] -> (SpecEnv, [CoreBndr]) -substBndrs env bs = case Core.substBndrs (se_subst env) bs of - (subst', bs') -> (env { se_subst = subst' }, bs') - -cloneBndrSM :: SpecEnv -> Id -> SpecM (SpecEnv, Id) --- Clone the binders of the bind; return new bind with the cloned binders --- Return the substitution to use for RHSs, and the one to use for the body --- Discards non-Stable unfoldings -cloneBndrSM env@(SE { se_subst = subst }) bndr - = do { us <- getUniqueSupplyM - ; let (subst', bndr') = Core.cloneIdBndr subst us bndr - ; return (env { se_subst = subst' }, bndr') } - -cloneRecBndrsSM :: SpecEnv -> [Id] -> SpecM (SpecEnv, [Id]) -cloneRecBndrsSM env@(SE { se_subst = subst }) bndrs - = do { (subst', bndrs') <- Core.cloneRecIdBndrs subst bndrs - ; let env' = env { se_subst = subst' } - ; return (env', bndrs') } - -newDictBndr :: SpecEnv -> CoreBndr -> SpecM (SpecEnv, CoreBndr) --- Make up completely fresh binders for the dictionaries --- Their bindings are going to float outwards -newDictBndr env@(SE { se_subst = subst }) b - = do { uniq <- getUniqueM - ; let n = idName b - ty' = substTyUnchecked subst (idType b) - b' = mkUserLocal (nameOccName n) uniq ManyTy ty' (getSrcSpan n) - env' = env { se_subst = subst `Core.extendSubstInScope` b' } - ; pure (env', b') } +{-# LANGUAGE MultiWayIf #-} + +{- +(c) The GRASP/AQUA Project, Glasgow University, 1993-1998 + +\section[Specialise]{Stamping out overloading, and (optionally) polymorphism} +-} + +module GHC.Core.Opt.Specialise ( specProgram, specUnfolding ) where + +import GHC.Prelude + +import GHC.Driver.DynFlags +import GHC.Driver.Config +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Config.Core.Rules ( initRuleOpts ) + +import GHC.Core.Type hiding( substTy, substCo, extendTvSubst, zapSubst ) +import GHC.Core.SimpleOpt( defaultSimpleOpts, simpleOptExprWith, exprIsConApp_maybe ) +import GHC.Core.Predicate +import GHC.Core.Class( classMethods ) +import GHC.Core.Coercion( Coercion ) +import GHC.Core.Opt.Monad +import qualified GHC.Core.Subst as Core +import GHC.Core.Unfold.Make +import GHC.Core +import GHC.Core.Make ( mkLitRubbish ) +import GHC.Core.Unify ( tcMatchTy ) +import GHC.Core.Rules +import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable + , mkCast, exprType, exprIsHNF + , stripTicksTop, mkInScopeSetBndrs ) +import GHC.Core.FVs +import GHC.Core.Opt.Arity( collectBindersPushingCo ) + +import GHC.Builtin.Types ( unboxedUnitTy ) + +import GHC.Data.Maybe ( isJust ) +import GHC.Data.Bag +import GHC.Data.OrdList +import GHC.Data.List.SetOps + +import GHC.Types.Basic +import GHC.Types.Unique.Supply +import GHC.Types.Unique.DFM +import GHC.Types.Name +import GHC.Types.Tickish +import GHC.Types.Id.Make ( voidArgId, voidPrimId ) +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Var.Env +import GHC.Types.Id +import GHC.Types.Id.Info +import GHC.Types.Error + +import GHC.Utils.Error ( mkMCDiagnostic ) +import GHC.Utils.Monad ( foldlM ) +import GHC.Utils.Misc +import GHC.Utils.FV +import GHC.Utils.Outputable +import GHC.Utils.Panic + +import GHC.Unit.Module( Module ) +import GHC.Unit.Module.ModGuts +import GHC.Core.Unfold + +import Data.List( partition ) +import Data.List.NonEmpty ( NonEmpty (..) ) +import GHC.Core.Subst (substTickish) +import GHC.Core.TyCon (tyConClass_maybe) +import GHC.Core.DataCon (dataConTyCon) + +{- +************************************************************************ +* * +\subsection[notes-Specialise]{Implementation notes [SLPJ, Aug 18 1993]} +* * +************************************************************************ + +These notes describe how we implement specialisation to eliminate +overloading. + +The specialisation pass works on Core +syntax, complete with all the explicit dictionary application, +abstraction and construction as added by the type checker. The +existing type checker remains largely as it is. + +One important thought: the {\em types} passed to an overloaded +function, and the {\em dictionaries} passed are mutually redundant. +If the same function is applied to the same type(s) then it is sure to +be applied to the same dictionary(s)---or rather to the same {\em +values}. (The arguments might look different but they will evaluate +to the same value.) + +Second important thought: we know that we can make progress by +treating dictionary arguments as static and worth specialising on. So +we can do without binding-time analysis, and instead specialise on +dictionary arguments and no others. + +The basic idea +~~~~~~~~~~~~~~ +Suppose we have + + let f = + in + +and suppose f is overloaded. + +STEP 1: CALL-INSTANCE COLLECTION + +We traverse , accumulating all applications of f to types and +dictionaries. + +(Might there be partial applications, to just some of its types and +dictionaries? In principle yes, but in practice the type checker only +builds applications of f to all its types and dictionaries, so partial +applications could only arise as a result of transformation, and even +then I think it's unlikely. In any case, we simply don't accumulate such +partial applications.) + + +STEP 2: EQUIVALENCES + +So now we have a collection of calls to f: + f t1 t2 d1 d2 + f t3 t4 d3 d4 + ... +Notice that f may take several type arguments. To avoid ambiguity, we +say that f is called at type t1/t2 and t3/t4. + +We take equivalence classes using equality of the *types* (ignoring +the dictionary args, which as mentioned previously are redundant). + +STEP 3: SPECIALISATION + +For each equivalence class, choose a representative (f t1 t2 d1 d2), +and create a local instance of f, defined thus: + + f@t1/t2 = t1 t2 d1 d2 + +f_rhs presumably has some big lambdas and dictionary lambdas, so lots +of simplification will now result. However we don't actually *do* that +simplification. Rather, we leave it for the simplifier to do. If we +*did* do it, though, we'd get more call instances from the specialised +RHS. We can work out what they are by instantiating the call-instance +set from f's RHS with the types t1, t2. + +Add this new id to f's IdInfo, to record that f has a specialised version. + +Before doing any of this, check that f's IdInfo doesn't already +tell us about an existing instance of f at the required type/s. +(This might happen if specialisation was applied more than once, or +it might arise from user SPECIALIZE pragmas.) + +Recursion +~~~~~~~~~ +Wait a minute! What if f is recursive? Then we can't just plug in +its right-hand side, can we? + +But it's ok. The type checker *always* creates non-recursive definitions +for overloaded recursive functions. For example: + + f x = f (x+x) -- Yes I know its silly + +becomes + + f a (d::Num a) = let p = +.sel a d + in + letrec fl (y::a) = fl (p y y) + in + fl + +We still have recursion for non-overloaded functions which we +specialise, but the recursive call should get specialised to the +same recursive version. + + +Polymorphism 1 +~~~~~~~~~~~~~~ + +All this is crystal clear when the function is applied to *constant +types*; that is, types which have no type variables inside. But what if +it is applied to non-constant types? Suppose we find a call of f at type +t1/t2. There are two possibilities: + +(a) The free type variables of t1, t2 are in scope at the definition point +of f. In this case there's no problem, we proceed just as before. A common +example is as follows. Here's the Haskell: + + g y = let f x = x+x + in f y + f y + +After typechecking we have + + g a (d::Num a) (y::a) = let f b (d'::Num b) (x::b) = +.sel b d' x x + in +.sel a d (f a d y) (f a d y) + +Notice that the call to f is at type type "a"; a non-constant type. +Both calls to f are at the same type, so we can specialise to give: + + g a (d::Num a) (y::a) = let f@a (x::a) = +.sel a d x x + in +.sel a d (f@a y) (f@a y) + + +(b) The other case is when the type variables in the instance types +are *not* in scope at the definition point of f. The example we are +working with above is a good case. There are two instances of (+.sel a d), +but "a" is not in scope at the definition of +.sel. Can we do anything? +Yes, we can "common them up", a sort of limited common sub-expression deal. +This would give: + + g a (d::Num a) (y::a) = let +.sel@a = +.sel a d + f@a (x::a) = +.sel@a x x + in +.sel@a (f@a y) (f@a y) + +This can save work, and can't be spotted by the type checker, because +the two instances of +.sel weren't originally at the same type. + +Further notes on (b) + +* There are quite a few variations here. For example, the defn of + +.sel could be floated outside the \y, to attempt to gain laziness. + It certainly mustn't be floated outside the \d because the d has to + be in scope too. + +* We don't want to inline f_rhs in this case, because +that will duplicate code. Just commoning up the call is the point. + +* Nothing gets added to +.sel's IdInfo. + +* Don't bother unless the equivalence class has more than one item! + +Not clear whether this is all worth it. It is of course OK to +simply discard call-instances when passing a big lambda. + +Polymorphism 2 -- Overloading +~~~~~~~~~~~~~~ +Consider a function whose most general type is + + f :: forall a b. Ord a => [a] -> b -> b + +There is really no point in making a version of g at Int/Int and another +at Int/Bool, because it's only instantiating the type variable "a" which +buys us any efficiency. Since g is completely polymorphic in b there +ain't much point in making separate versions of g for the different +b types. + +That suggests that we should identify which of g's type variables +are constrained (like "a") and which are unconstrained (like "b"). +Then when taking equivalence classes in STEP 2, we ignore the type args +corresponding to unconstrained type variable. In STEP 3 we make +polymorphic versions. Thus: + + f@t1/ = /\b -> t1 b d1 d2 + +We do this. + + +Dictionary floating +~~~~~~~~~~~~~~~~~~~ +Consider this + + f a (d::Num a) = let g = ... + in + ...(let d1::Ord a = Num.Ord.sel a d in g a d1)... + +Here, g is only called at one type, but the dictionary isn't in scope at the +definition point for g. Usually the type checker would build a +definition for d1 which enclosed g, but the transformation system +might have moved d1's defn inward. Solution: float dictionary bindings +outwards along with call instances. + +Consider + + f x = let g p q = p==q + h r s = (r+s, g r s) + in + h x x + + +Before specialisation, leaving out type abstractions we have + + f df x = let g :: Eq a => a -> a -> Bool + g dg p q = == dg p q + h :: Num a => a -> a -> (a, Bool) + h dh r s = let deq = eqFromNum dh + in (+ dh r s, g deq r s) + in + h df x x + +After specialising h we get a specialised version of h, like this: + + h' r s = let deq = eqFromNum df + in (+ df r s, g deq r s) + +But we can't naively make an instance for g from this, because deq is not in scope +at the defn of g. Instead, we have to float out the (new) defn of deq +to widen its scope. Notice that this floating can't be done in advance -- it only +shows up when specialisation is done. + +User SPECIALIZE pragmas +~~~~~~~~~~~~~~~~~~~~~~~ +Specialisation pragmas can be digested by the type checker, and implemented +by adding extra definitions along with that of f, in the same way as before + + f@t1/t2 = t1 t2 d1 d2 + +Indeed the pragmas *have* to be dealt with by the type checker, because +only it knows how to build the dictionaries d1 and d2! For example + + g :: Ord a => [a] -> [a] + {-# SPECIALIZE f :: [Tree Int] -> [Tree Int] #-} + +Here, the specialised version of g is an application of g's rhs to the +Ord dictionary for (Tree Int), which only the type checker can conjure +up. There might not even *be* one, if (Tree Int) is not an instance of +Ord! (All the other specialisation has suitable dictionaries to hand +from actual calls.) + +Problem. The type checker doesn't have to hand a convenient , because +it is buried in a complex (as-yet-un-desugared) binding group. +Maybe we should say + + f@t1/t2 = f* t1 t2 d1 d2 + +where f* is the Id f with an IdInfo which says "inline me regardless!". +Indeed all the specialisation could be done in this way. +That in turn means that the simplifier has to be prepared to inline absolutely +any in-scope let-bound thing. + + +Again, the pragma should permit polymorphism in unconstrained variables: + + h :: Ord a => [a] -> b -> b + {-# SPECIALIZE h :: [Int] -> b -> b #-} + +We *insist* that all overloaded type variables are specialised to ground types, +(and hence there can be no context inside a SPECIALIZE pragma). +We *permit* unconstrained type variables to be specialised to + - a ground type + - or left as a polymorphic type variable +but nothing in between. So + + {-# SPECIALIZE h :: [Int] -> [c] -> [c] #-} + +is *illegal*. (It can be handled, but it adds complication, and gains the +programmer nothing.) + + +SPECIALISING INSTANCE DECLARATIONS +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + instance Foo a => Foo [a] where + ... + {-# SPECIALIZE instance Foo [Int] #-} + +The original instance decl creates a dictionary-function +definition: + + dfun.Foo.List :: forall a. Foo a -> Foo [a] + +The SPECIALIZE pragma just makes a specialised copy, just as for +ordinary function definitions: + + dfun.Foo.List@Int :: Foo [Int] + dfun.Foo.List@Int = dfun.Foo.List Int dFooInt + +The information about what instance of the dfun exist gets added to +the dfun's IdInfo in the same way as a user-defined function too. + + +Automatic instance decl specialisation? +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Can instance decls be specialised automatically? It's tricky. +We could collect call-instance information for each dfun, but +then when we specialised their bodies we'd get new call-instances +for ordinary functions; and when we specialised their bodies, we might get +new call-instances of the dfuns, and so on. This all arises because of +the unrestricted mutual recursion between instance decls and value decls. + +Still, there's no actual problem; it just means that we may not do all +the specialisation we could theoretically do. + +Furthermore, instance decls are usually exported and used non-locally, +so we'll want to compile enough to get those specialisations done. + +Lastly, there's no such thing as a local instance decl, so we can +survive solely by spitting out *usage* information, and then reading that +back in as a pragma when next compiling the file. So for now, +we only specialise instance decls in response to pragmas. + + +SPITTING OUT USAGE INFORMATION +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +To spit out usage information we need to traverse the code collecting +call-instance information for all imported (non-prelude?) functions +and data types. Then we equivalence-class it and spit it out. + +This is done at the top-level when all the call instances which escape +must be for imported functions and data types. + +*** Not currently done *** + + +Partial specialisation by pragmas +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +What about partial specialisation: + + k :: (Ord a, Eq b) => [a] -> b -> b -> [a] + {-# SPECIALIZE k :: Eq b => [Int] -> b -> b -> [a] #-} + +or even + + {-# SPECIALIZE k :: Eq b => [Int] -> [b] -> [b] -> [a] #-} + +Seems quite reasonable. Similar things could be done with instance decls: + + instance (Foo a, Foo b) => Foo (a,b) where + ... + {-# SPECIALIZE instance Foo a => Foo (a,Int) #-} + {-# SPECIALIZE instance Foo b => Foo (Int,b) #-} + +Ho hum. Things are complex enough without this. I pass. + + +Requirements for the simplifier +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The simplifier has to be able to take advantage of the specialisation. + +* When the simplifier finds an application of a polymorphic f, it looks in +f's IdInfo in case there is a suitable instance to call instead. This converts + + f t1 t2 d1 d2 ===> f_t1_t2 + +Note that the dictionaries get eaten up too! + +* Dictionary selection operations on constant dictionaries must be + short-circuited: + + +.sel Int d ===> +Int + +The obvious way to do this is in the same way as other specialised +calls: +.sel has inside it some IdInfo which tells that if it's applied +to the type Int then it should eat a dictionary and transform to +Int. + +In short, dictionary selectors need IdInfo inside them for constant +methods. + +* Exactly the same applies if a superclass dictionary is being + extracted: + + Eq.sel Int d ===> dEqInt + +* Something similar applies to dictionary construction too. Suppose +dfun.Eq.List is the function taking a dictionary for (Eq a) to +one for (Eq [a]). Then we want + + dfun.Eq.List Int d ===> dEq.List_Int + +Where does the Eq [Int] dictionary come from? It is built in +response to a SPECIALIZE pragma on the Eq [a] instance decl. + +In short, dfun Ids need IdInfo with a specialisation for each +constant instance of their instance declaration. + +All this uses a single mechanism: the SpecEnv inside an Id + + +What does the specialisation IdInfo look like? +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The SpecEnv of an Id maps a list of types (the template) to an expression + + [Type] |-> Expr + +For example, if f has this RuleInfo: + + [Int, a] -> \d:Ord Int. f' a + +it means that we can replace the call + + f Int t ===> (\d. f' t) + +This chucks one dictionary away and proceeds with the +specialised version of f, namely f'. + + +What can't be done this way? +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There is no way, post-typechecker, to get a dictionary for (say) +Eq a from a dictionary for Eq [a]. So if we find + + ==.sel [t] d + +we can't transform to + + eqList (==.sel t d') + +where + eqList :: (a->a->Bool) -> [a] -> [a] -> Bool + +Of course, we currently have no way to automatically derive +eqList, nor to connect it to the Eq [a] instance decl, but you +can imagine that it might somehow be possible. Taking advantage +of this is permanently ruled out. + +Still, this is no great hardship, because we intend to eliminate +overloading altogether anyway! + +A note about non-tyvar dictionaries +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some Ids have types like + + forall a,b,c. Eq a -> Ord [a] -> tau + +This seems curious at first, because we usually only have dictionary +args whose types are of the form (C a) where a is a type variable. +But this doesn't hold for the functions arising from instance decls, +which sometimes get arguments with types of form (C (T a)) for some +type constructor T. + +Should we specialise wrt this compound-type dictionary? We used to say +"no", saying: + "This is a heuristic judgement, as indeed is the fact that we + specialise wrt only dictionaries. We choose *not* to specialise + wrt compound dictionaries because at the moment the only place + they show up is in instance decls, where they are simply plugged + into a returned dictionary. So nothing is gained by specialising + wrt them." + +But it is simpler and more uniform to specialise wrt these dicts too; +and in future GHC is likely to support full fledged type signatures +like + f :: Eq [(a,b)] => ... + + +Note [Specialisation and overlapping instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here is at tricky case (see a comment in MR !8916): + + module A where + class C a where + meth :: a -> String + instance {-# OVERLAPPABLE #-} C (Maybe a) where + meth _ = "Maybe" + + {-# SPECIALISE f :: Maybe a -> Bool -> String #-} + f :: C a => a -> Bool -> String + f a True = f a False + f a _ = meth a + + module B where + import A + + instance C (Maybe Int) where + meth _ = "Int" + + main = putStrLn $ f (Just 42 :: Maybe Int) True + +Running main without optimisations yields "Int", the correct answer. +Activating optimisations yields "Maybe" due to a rewrite rule in module +A generated by the SPECIALISE pragma: + + RULE "USPEC f" forall a (d :: C a). f @a d = $sf + +In B we get the call (f @(Maybe Int) (d :: C (Maybe Int))), and +that rewrites to $sf, but that isn't really right. + +Overlapping instances mean that `C (Maybe Int)` is not a singleton +type: there two distinct dictionaries that have this type. And that +spells trouble for specialistion, which really asssumes singleton +types. + +For now, we just accept this problem, but it may bite us one day. +One solution would be to decline to expose any specialisation rules +to an importing module -- but that seems a bit drastic. + + +************************************************************************ +* * +\subsubsection{The new specialiser} +* * +************************************************************************ + +Our basic game plan is this. For let(rec) bound function + f :: (C a, D c) => (a,b,c,d) -> Bool + +* Find any specialised calls of f, (f ts ds), where + ts are the type arguments t1 .. t4, and + ds are the dictionary arguments d1 .. d2. + +* Add a new definition for f1 (say): + + f1 = /\ b d -> (..body of f..) t1 b t3 d d1 d2 + + Note that we abstract over the unconstrained type arguments. + +* Add the mapping + + [t1,b,t3,d] |-> \d1 d2 -> f1 b d + + to the specialisations of f. This will be used by the + simplifier to replace calls + (f t1 t2 t3 t4) da db + by + (\d1 d1 -> f1 t2 t4) da db + + All the stuff about how many dictionaries to discard, and what types + to apply the specialised function to, are handled by the fact that the + SpecEnv contains a template for the result of the specialisation. + +We don't build *partial* specialisations for f. For example: + + f :: Eq a => a -> a -> Bool + {-# SPECIALISE f :: (Eq b, Eq c) => (b,c) -> (b,c) -> Bool #-} + +Here, little is gained by making a specialised copy of f. +There's a distinct danger that the specialised version would +first build a dictionary for (Eq b, Eq c), and then select the (==) +method from it! Even if it didn't, not a great deal is saved. + +We do, however, generate polymorphic, but not overloaded, specialisations: + + f :: Eq a => [a] -> b -> b -> b + ... SPECIALISE f :: [Int] -> b -> b -> b ... + +Hence, the invariant is this: + + *** no specialised version is overloaded *** + + +************************************************************************ +* * +\subsubsection{The exported function} +* * +************************************************************************ +-} + +-- | Specialise calls to type-class overloaded functions occurring in a program. +specProgram :: ModGuts -> CoreM ModGuts +specProgram guts@(ModGuts { mg_module = this_mod + , mg_rules = local_rules + , mg_binds = binds }) + = do { dflags <- getDynFlags + ; rule_env <- initRuleEnv guts + -- See Note [Fire rules in the specialiser] + + -- We need to start with a Subst that knows all the things + -- that are in scope, so that the substitution engine doesn't + -- accidentally re-use a unique that's already in use + -- Easiest thing is to do it all at once, as if all the top-level + -- decls were mutually recursive + ; let top_env = SE { se_subst = Core.mkEmptySubst $ + mkInScopeSetBndrs binds + -- mkInScopeSetList $ + -- bindersOfBinds binds + , se_module = this_mod + , se_rules = rule_env + , se_dflags = dflags } + + go [] = return ([], emptyUDs) + go (bind:binds) = do (bind', binds', uds') <- specBind TopLevel top_env bind $ \_ -> + go binds + return (bind' ++ binds', uds') + + -- Specialise the bindings of this module + ; (binds', uds) <- runSpecM (go binds) + + ; (spec_rules, spec_binds) <- specImports top_env uds + + ; return (guts { mg_binds = spec_binds ++ binds' + , mg_rules = spec_rules ++ local_rules }) } + +{- +Note [Wrap bindings returned by specImports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +'specImports' returns a set of specialized bindings. However, these are lacking +necessary floated dictionary bindings, which are returned by +UsageDetails(ud_binds). These dictionaries need to be brought into scope with +'wrapDictBinds' before the bindings returned by 'specImports' can be used. See, +for instance, the 'specImports' call in 'specProgram'. + + +Note [Disabling cross-module specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since GHC 7.10 we have performed specialisation of INLINABLE bindings living +in modules outside of the current module. This can sometimes uncover user code +which explodes in size when aggressively optimized. The +-fno-cross-module-specialise option was introduced to allow users to being +bitten by such instances to revert to the pre-7.10 behavior. + +See #10491 +-} + + +{- ********************************************************************* +* * + Specialising imported functions +* * +********************************************************************* -} + +{- Note [Specialising imported functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +specImports specialises imported functions, based on calls in this module. + +When -fspecialise-aggressively is on, we specialise any imported +function for which we have an unfolding. The +-fspecialise-aggressively flag is usually off, because we risk lots of +orphan modules from over-vigorous specialisation. (See Note [Orphans] +in GHC.Core.) However it's not a big deal: anything non-recursive with +an unfolding-template will probably have been inlined already. + +When -fspecialise-aggressively is off, we are more selective about +specialisation (see canSpecImport): + +(1) Without -fspecialise-aggressively, do not specialise + DFunUnfoldings. Note [Do not specialise imported DFuns]. + +(2) Without -fspecialise-aggressively, specialise only imported things + that have a /user-supplied/ INLINE or INLINABLE pragma (hence + isAnyInlinePragma rather than isStableSource). + + In particular, we don't want to specialise workers created by + worker/wrapper (for functions with no pragma) because they won't + specialise usefully, and they generate quite a bit of useless code + bloat. + + Specialise even INLINE things; it hasn't inlined yet, so perhaps + it never will. Moreover it may have calls inside it that we want + to specialise + +Wrinkle (W1): If we specialise an imported Id M.foo, we make a /local/ +binding $sfoo. But specImports may further specialise $sfoo. So we end up +with RULES for both M.foo (imported) and $sfoo (local). Rules for local +Ids should be attached to the Ids themselves (see GHC.HsToCore +Note [Attach rules to local ids]); so we must partition the rules and +attach the local rules. That is done in specImports, via addRulesToId. + +Note [Glom the bindings if imported functions are specialised] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have an imported, *recursive*, INLINABLE function + f :: Eq a => a -> a + f = /\a \d x. ...(f a d)... +In the module being compiled we have + g x = f (x::Int) +Now we'll make a specialised function + f_spec :: Int -> Int + f_spec = \x -> ...(f Int dInt)... + {-# RULE f Int _ = f_spec #-} + g = \x. f Int dInt x +Note that f_spec doesn't look recursive +After rewriting with the RULE, we get + f_spec = \x -> ...(f_spec)... +BUT since f_spec was non-recursive before it'll *stay* non-recursive. +The occurrence analyser never turns a NonRec into a Rec. So we must +make sure that f_spec is recursive. Easiest thing is to make all +the specialisations for imported bindings recursive. +-} + +specImports :: SpecEnv + -> UsageDetails + -> CoreM ([CoreRule], [CoreBind]) +specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls }) + | not $ gopt Opt_CrossModuleSpecialise (se_dflags top_env) + -- See Note [Disabling cross-module specialisation] + = return ([], wrapDictBinds dict_binds []) + + | otherwise + = do { let env_w_dict_bndrs = top_env `bringFloatedDictsIntoScope` dict_binds + ; (_env, spec_rules, spec_binds) <- spec_imports env_w_dict_bndrs [] dict_binds calls + + -- Make a Rec: see Note [Glom the bindings if imported functions are specialised] + -- + -- wrapDictBinds: don't forget to wrap the specialized bindings with + -- bindings for the needed dictionaries. + -- See Note [Wrap bindings returned by specImports] + -- + -- addRulesToId: see Wrinkle (W1) in Note [Specialising imported functions] + -- c.f. GHC.HsToCore.addExportFlagsAndRules + ; let (rules_for_locals, rules_for_imps) = partition isLocalRule spec_rules + local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals + final_binds + | null spec_binds = wrapDictBinds dict_binds [] + | otherwise = [Rec $ mapFst (addRulesToId local_rule_base) $ + flattenBinds $ + wrapDictBinds dict_binds $ + spec_binds] + + ; return (rules_for_imps, final_binds) + } + +-- | Specialise a set of calls to imported bindings +spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in scope + ---In-scope set includes the FloatedDictBinds + -> [Id] -- Stack of imported functions being specialised + -- See Note [specImport call stack] + -> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls + -- See Note [Avoiding loops in specImports] + -> CallDetails -- Calls for imported things + -> CoreM ( SpecEnv -- Env contains the new rules + , [CoreRule] -- New rules + , [CoreBind] ) -- Specialised bindings +spec_imports env callers dict_binds calls + = do { let import_calls = dVarEnvElts calls +-- ; debugTraceMsg (text "specImports {" <+> +-- vcat [ text "calls:" <+> ppr import_calls +-- , text "dict_binds:" <+> ppr dict_binds ]) + ; (env, rules, spec_binds) <- go env import_calls +-- ; debugTraceMsg (text "End specImports }" <+> ppr import_calls) + + ; return (env, rules, spec_binds) } + where + go :: SpecEnv -> [CallInfoSet] -> CoreM (SpecEnv, [CoreRule], [CoreBind]) + go env [] = return (env, [], []) + go env (cis : other_calls) + = do { -- debugTraceMsg (text "specImport {" <+> ppr cis) + ; (env, rules1, spec_binds1) <- spec_import env callers dict_binds cis + ; -- debugTraceMsg (text "specImport }" <+> ppr cis) + + ; (env, rules2, spec_binds2) <- go env other_calls + ; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) } + +spec_import :: SpecEnv -- Passed in so that all top-level Ids are in scope + ---In-scope set includes the FloatedDictBinds + -> [Id] -- Stack of imported functions being specialised + -- See Note [specImport call stack] + -> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls + -- See Note [Avoiding loops in specImports] + -> CallInfoSet -- Imported function and calls for it + -> CoreM ( SpecEnv + , [CoreRule] -- New rules + , [CoreBind] ) -- Specialised bindings +spec_import env callers dict_binds cis@(CIS fn _) + | isIn "specImport" fn callers + = return (env, [], []) -- No warning. This actually happens all the time + -- when specialising a recursive function, because + -- the RHS of the specialised function contains a recursive + -- call to the original function + + | null good_calls + = return (env, [], []) + + | Just rhs <- canSpecImport dflags fn + = do { -- Get rules from the external package state + -- We keep doing this in case we "page-fault in" + -- more rules as we go along + ; eps_rules <- getExternalRuleBase + ; let rule_env = se_rules env `updExternalPackageRules` eps_rules + +-- ; debugTraceMsg (text "specImport1" <+> vcat +-- [ text "function:" <+> ppr fn +-- , text "good calls:" <+> ppr good_calls +-- , text "existing rules:" <+> ppr (getRules rule_env fn) +-- , text "rhs:" <+> ppr rhs +-- , text "dict_binds:" <+> ppr dict_binds ]) + + ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) + <- runSpecM $ specCalls True env (getRules rule_env fn) good_calls fn rhs + + ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs] + -- After the rules kick in, via fireRewriteRules, we may get recursion, + -- but we rely on a global GlomBinds to sort that out later + -- See Note [Glom the bindings if imported functions are specialised] + -- Meanwhile, though, bring the binders into scope + + new_subst = se_subst env `Core.extendSubstInScopeList` map fst spec_pairs + new_env = env { se_rules = rule_env `addLocalRules` rules1 + , se_subst = new_subst } + `bringFloatedDictsIntoScope` dict_binds1 + + -- Now specialise any cascaded calls +-- ; debugTraceMsg (text "specImport 2" <+> vcat +-- [ text "function:" <+> ppr fn +-- , text "rules1:" <+> ppr rules1 +-- , text "spec_binds1" <+> ppr spec_binds1 +-- , text "dict_binds1" <+> ppr dict_binds1 +-- , text "new_calls" <+> ppr new_calls ]) + + ; (env, rules2, spec_binds2) + <- spec_imports new_env (fn:callers) + (dict_binds `thenFDBs` dict_binds1) + new_calls + + ; let final_binds = wrapDictBinds dict_binds1 $ + spec_binds2 ++ spec_binds1 + + ; return (env, rules2 ++ rules1, final_binds) } + + | otherwise + = do { tryWarnMissingSpecs dflags callers fn good_calls + ; return (env, [], [])} + + where + dflags = se_dflags env + good_calls = filterCalls cis dict_binds + -- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn + -- See Note [Avoiding loops in specImports] + +canSpecImport :: DynFlags -> Id -> Maybe CoreExpr +canSpecImport dflags fn + | isDataConWrapId fn + = Nothing -- Don't specialise data-con wrappers, even if they + -- have dict args; there is no benefit. + + | CoreUnfolding { uf_tmpl = rhs } <- unf + -- CoreUnfolding: see Note [Specialising imported functions] point (1). + , isAnyInlinePragma (idInlinePragma fn) + -- See Note [Specialising imported functions] point (2). + = Just rhs + + | gopt Opt_SpecialiseAggressively dflags + = maybeUnfoldingTemplate unf + -- With -fspecialise-aggressively, specialise anything + -- with an unfolding, stable or not, DFun or not + + | otherwise = Nothing + where + unf = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + +-- | Returns whether or not to show a missed-spec warning. +-- If -Wall-missed-specializations is on, show the warning. +-- Otherwise, if -Wmissed-specializations is on, only show a warning +-- if there is at least one imported function being specialized, +-- and if all imported functions are marked with an inline pragma +-- Use the most specific warning as the reason. +tryWarnMissingSpecs :: DynFlags -> [Id] -> Id -> [CallInfo] -> CoreM () +-- See Note [Warning about missed specialisations] +tryWarnMissingSpecs dflags callers fn calls_for_fn + | isClassOpId fn = return () -- See Note [Missed specialisation for ClassOps] + | wopt Opt_WarnMissedSpecs dflags + && not (null callers) + && allCallersInlined = doWarn $ WarningWithFlag Opt_WarnMissedSpecs + | wopt Opt_WarnAllMissedSpecs dflags = doWarn $ WarningWithFlag Opt_WarnAllMissedSpecs + | otherwise = return () + where + allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers + diag_opts = initDiagOpts dflags + doWarn reason = + msg (mkMCDiagnostic diag_opts reason Nothing) + (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) + 2 (vcat [ text "when specialising" <+> quotes (ppr caller) + | caller <- callers]) + , whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn)) + , text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ]) + +{- Note [Missed specialisation for ClassOps] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #19592 I saw a number of missed specialisation warnings +which were the result of things like: + + case isJumpishInstr @X86.Instr $dInstruction_s7f8 eta3_a78C of { ... + +where isJumpishInstr is part of the Instruction class and defined like +this: + + class Instruction instr where + ... + isJumpishInstr :: instr -> Bool + ... + +isJumpishInstr is a ClassOp which will select the right method +from within the dictionary via our built in rules. See also +Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance. + +We don't give these unfoldings, and as a result the specialiser +complains. But usually this doesn't matter. The simplifier will +apply the rule and we end up with + + case isJumpishInstrImplX86 eta3_a78C of { ... + +Since isJumpishInstrImplX86 is defined for a concrete instance (given +by the dictionary) it is usually already well specialised! +Theoretically the implementation of a method could still be overloaded +over a different type class than what it's a method of. But I wasn't able +to make this go wrong, and SPJ thinks this should be fine as well. + +So I decided to remove the warnings for failed specialisations on ClassOps +alltogether as they do more harm than good. +-} + +{- Note [Do not specialise imported DFuns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticket #18223 shows that specialising calls of DFuns is can cause a huge +and entirely unnecessary blowup in program size. Consider a call to + f @[[[[[[[[T]]]]]]]] d1 x +where df :: C a => C [a] + d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1 + d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3 + ... +Now we'll specialise f's RHS, which may give rise to calls to 'g', +also overloaded, which we will specialise, and so on. However, if +we specialise the calls to dfC[], we'll generate specialised copies of +all methods of C, at all types; and the same for C's superclasses. + +And many of these specialised functions will never be called. We are +going to call the specialised 'f', and the specialised 'g', but DFuns +group functions into a tuple, many of whose elements may never be used. + +With deeply-nested types this can lead to a simply overwhelming number +of specialisations: see #18223 for a simple example (from the wild). +I measured the number of specialisations for various numbers of calls +of `flip evalStateT ()`, and got this + + Size after one simplification + #calls #SPEC rules Terms Types + 5 56 3100 10600 + 9 108 13660 77206 + +The real tests case has 60+ calls, which blew GHC out of the water. + +Solution: don't specialise DFuns. The downside is that if we end +up with (h (dfun d)), /and/ we don't specialise 'h', then we won't +pass to 'h' a tuple of specialised functions. + +However, the flag -fspecialise-aggressively (experimental, off by default) +allows DFuns to specialise as well. + +Note [Avoiding loops in specImports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must take great care when specialising instance declarations +(DFuns like $fOrdList) lest we accidentally build a recursive +dictionary. See Note [Avoiding loops (DFuns)]. + +The basic strategy of Note [Avoiding loops (DFuns)] is to use filterCalls +to discard loopy specialisations. But to do that we must ensure +that the in-scope dict-binds (passed to filterCalls) contains +all the needed dictionary bindings. In particular, in the recursive +call to spec_imports in spec_import, we must include the dict-binds +from the parent. Lacking this caused #17151, a really nasty bug. + +Here is what happened. +* Class structure: + Source is a superclass of Mut + Index is a superclass of Source + +* We started with these dict binds + dSource = $fSourcePix @Int $fIndexInt + dIndex = sc_sel dSource + dMut = $fMutPix @Int dIndex + and these calls to specialise + $fMutPix @Int dIndex + $fSourcePix @Int $fIndexInt + +* We specialised the call ($fMutPix @Int dIndex) + ==> new call ($fSourcePix @Int dIndex) + (because Source is a superclass of Mut) + +* We specialised ($fSourcePix @Int dIndex) + ==> produces specialised dict $s$fSourcePix, + a record with dIndex as a field + plus RULE forall d. ($fSourcePix @Int d) = $s$fSourcePix + *** This is the bogus step *** + +* Now we decide not to specialise the call + $fSourcePix @Int $fIndexInt + because we alredy have a RULE that matches it + +* Finally the simplifer rewrites + dSource = $fSourcePix @Int $fIndexInt + ==> dSource = $s$fSourcePix + +Disaster. Now we have + +Rewrite dSource's RHS to $s$fSourcePix Disaster + dSource = $s$fSourcePix + dIndex = sc_sel dSource + $s$fSourcePix = MkSource dIndex ... + +Solution: filterCalls should have stopped the bogus step, +by seeing that dIndex transitively uses $fSourcePix. But +it can only do that if it sees all the dict_binds. Wow. + +-------------- +Here's another example (#13429). Suppose we have + class Monoid v => C v a where ... + +We start with a call + f @ [Integer] @ Integer $fC[]Integer + +Specialising call to 'f' gives dict bindings + $dMonoid_1 :: Monoid [Integer] + $dMonoid_1 = M.$p1C @ [Integer] $fC[]Integer + + $dC_1 :: C [Integer] (Node [Integer] Integer) + $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 + +...plus a recursive call to + f @ [Integer] @ (Node [Integer] Integer) $dC_1 + +Specialising that call gives + $dMonoid_2 :: Monoid [Integer] + $dMonoid_2 = M.$p1C @ [Integer] $dC_1 + + $dC_2 :: C [Integer] (Node [Integer] Integer) + $dC_2 = M.$fCvNode @ [Integer] $dMonoid_2 + +Now we have two calls to the imported function + M.$fCvNode :: Monoid v => C v a + M.$fCvNode @v @a m = C m some_fun + +But we must /not/ use the call (M.$fCvNode @ [Integer] $dMonoid_2) +for specialisation, else we get: + + $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 + $dMonoid_2 = M.$p1C @ [Integer] $dC_1 + $s$fCvNode = C $dMonoid_2 ... + RULE M.$fCvNode [Integer] _ _ = $s$fCvNode + +Now use the rule to rewrite the call in the RHS of $dC_1 +and we get a loop! + + +Note [specImport call stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising an imports function 'f', we may get new calls +of an imported function 'g', which we want to specialise in turn, +and similarly specialising 'g' might expose a new call to 'h'. + +We track the stack of enclosing functions. So when specialising 'h' we +have a specImport call stack of [g,f]. We do this for two reasons: +* Note [Warning about missed specialisations] +* Note [Avoiding recursive specialisation] + +Note [Warning about missed specialisations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose + * In module Lib, you carefully mark a function 'foo' INLINABLE + * Import Lib(foo) into another module M + * Call 'foo' at some specialised type in M +Then you jolly well expect it to be specialised in M. But what if +'foo' calls another function 'Lib.bar'. Then you'd like 'bar' to be +specialised too. But if 'bar' is not marked INLINABLE it may well +not be specialised. The warning Opt_WarnMissedSpecs warns about this. + +It's more noisy to warning about a missed specialisation opportunity +for /every/ overloaded imported function, but sometimes useful. That +is what Opt_WarnAllMissedSpecs does. + +ToDo: warn about missed opportunities for local functions. + +Note [Avoiding recursive specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we specialise 'f' we may find new overloaded calls to 'g', 'h' in +'f's RHS. So we want to specialise g,h. But we don't want to +specialise f any more! It's possible that f's RHS might have a +recursive yet-more-specialised call, so we'd diverge in that case. +And if the call is to the same type, one specialisation is enough. +Avoiding this recursive specialisation loop is one reason for the +'callers' stack passed to specImports and specImport. + + +************************************************************************ +* * +\subsubsection{@specExpr@: the main function} +* * +************************************************************************ +-} + +data SpecEnv + = SE { se_subst :: Core.Subst + -- We carry a substitution down: + -- a) we must clone any binding that might float outwards, + -- to avoid name clashes + -- b) we carry a type substitution to use when analysing + -- the RHS of specialised bindings (no type-let!) + + , se_module :: Module + , se_rules :: RuleEnv -- From the home package and this module + , se_dflags :: DynFlags + } + +instance Outputable SpecEnv where + ppr (SE { se_subst = subst }) + = text "SE" <+> braces (text "subst =" <+> ppr subst) + +specVar :: SpecEnv -> InId -> SpecM (OutExpr, UsageDetails) +specVar env@(SE { se_subst = Core.Subst in_scope ids _ _ }) v + | not (isLocalId v) = return (Var v, emptyUDs) + | Just e <- lookupVarEnv ids v = specExpr (zapSubst env) e -- Note (1) + | Just v' <- lookupInScope in_scope v = return (Var v', emptyUDs) + | otherwise = pprPanic "specVar" (ppr v $$ ppr in_scope) + -- c.f. GHC.Core.Subst.lookupIdSubst + -- Note (1): we recurse so we do the lookupInScope thing on any Vars in e + -- probably has little effect, but it's the right thing. + -- We need zapSubst because `e` is an OutExpr + +specExpr :: SpecEnv -> CoreExpr -> SpecM (CoreExpr, UsageDetails) + +---------------- First the easy cases -------------------- +specExpr env (Var v) = specVar env v +specExpr env (Type ty) = return (Type (substTy env ty), emptyUDs) +specExpr env (Coercion co) = return (Coercion (substCo env co), emptyUDs) +specExpr _ (Lit lit) = return (Lit lit, emptyUDs) +specExpr env (Cast e co) + = do { (e', uds) <- specExpr env e + ; return ((mkCast e' (substCo env co)), uds) } +specExpr env (Tick tickish body) + = do { (body', uds) <- specExpr env body + ; return (Tick (specTickish env tickish) body', uds) } + +---------------- Applications might generate a call instance -------------------- +specExpr env expr@(App {}) + = do { let (fun_in, args_in) = collectArgs expr + ; (fun_out, uds_fun) <- specExpr env fun_in + ; (args_out, uds_args) <- mapAndCombineSM (specExpr env) args_in + ; let uds_app = uds_fun `thenUDs` uds_args + env_args = zapSubst env `bringFloatedDictsIntoScope` ud_binds uds_app + -- zapSubst: we have now fully applied the substitution + -- bringFloatedDictsIntoScope: some dicts may have floated out of + -- args_in; they should be in scope for fireRewriteRules (#21689) + + -- Try firing rewrite rules + -- See Note [Fire rules in the specialiser] + ; let (fun_out', args_out') = fireRewriteRules env_args fun_out args_out + + -- Make a call record, and return + ; let uds_call = mkCallUDs env fun_out' args_out' + ; return (fun_out' `mkApps` args_out', uds_app `thenUDs` uds_call) } + +---------------- Lambda/case require dumping of usage details -------------------- +specExpr env e@(Lam {}) + = specLam env' bndrs' body + where + (bndrs, body) = collectBinders e + (env', bndrs') = substBndrs env bndrs + -- More efficient to collect a group of binders together all at once + -- and we don't want to split a lambda group with dumped bindings + +specExpr env (Case scrut case_bndr ty alts) + = do { (scrut', scrut_uds) <- specExpr env scrut + ; (scrut'', case_bndr', alts', alts_uds) + <- specCase env scrut' case_bndr alts +-- ; pprTrace "specExpr:case" (vcat +-- [ text "scrut" <+> ppr scrut, text "scrut'" <+> ppr scrut' +-- , text "case_bndr'" <+> ppr case_bndr' +-- , text "alts_uds" <+> ppr alts_uds +-- ]) + ; return (Case scrut'' case_bndr' (substTy env ty) alts' + , scrut_uds `thenUDs` alts_uds) } + +---------------- Finally, let is the interesting case -------------------- +specExpr env (Let bind body) + = do { (binds', body', uds) <- specBind NotTopLevel env bind $ \body_env -> + -- pprTrace "specExpr:let" (ppr (se_subst body_env) $$ ppr body) $ + specExpr body_env body + -- All done + ; return (foldr Let body' binds', uds) } + +-- See Note [Specialisation modulo dictionary selectors] +-- Note [ClassOp/DFun selection] +-- Note [Fire rules in the specialiser] +fireRewriteRules :: SpecEnv -- Substitution is already zapped + -> OutExpr -> [OutExpr] -> (OutExpr, [OutExpr]) +fireRewriteRules env (Var f) args + | let rules = getRules (se_rules env) f + , Just (rule, expr) <- specLookupRule env f args activeInInitialPhase rules + , let rest_args = drop (ruleArity rule) args -- See Note [Extra args in the target] + zapped_subst = se_subst env -- Just needed for the InScopeSet + expr' = simpleOptExprWith defaultSimpleOpts zapped_subst (mkApps expr rest_args) + -- simplOptExpr needed because lookupRule returns + -- (\x y. rhs) arg1 arg2 + , (fun', args') <- collectArgs expr' + = fireRewriteRules env fun' args' +fireRewriteRules _ fun args = (fun, args) + +-------------- +specLam :: SpecEnv -> [OutBndr] -> InExpr -> SpecM (OutExpr, UsageDetails) +-- The binders have been substituted, but the body has not +specLam env bndrs body + | null bndrs + = specExpr env body + | otherwise + = do { (body', uds) <- specExpr env body + ; let (free_uds, dumped_dbs) = dumpUDs bndrs uds + ; return (mkLams bndrs (wrapDictBindsE dumped_dbs body'), free_uds) } + +-------------- +specTickish :: SpecEnv -> CoreTickish -> CoreTickish +specTickish (SE { se_subst = subst }) bp = substTickish subst bp + +-------------- +specCase :: SpecEnv + -> OutExpr -- Scrutinee, already done + -> InId -> [InAlt] + -> SpecM ( OutExpr -- New scrutinee + , OutId + , [OutAlt] + , UsageDetails) +specCase env scrut' case_bndr [Alt con args rhs] + | -- See Note [Floating dictionaries out of cases] + isDictTy (idType case_bndr) + , interestingDict env scrut' + , not (isDeadBinder case_bndr && null sc_args') + = do { case_bndr_flt :| sc_args_flt <- mapM clone_me (case_bndr' :| sc_args') + + ; let case_bndr_flt' = case_bndr_flt `addDictUnfolding` scrut' + scrut_bind = mkDB (NonRec case_bndr_flt scrut') + + sc_args_flt' = zipWith addDictUnfolding sc_args_flt sc_rhss + sc_rhss = [ Case (Var case_bndr_flt') case_bndr' (idType sc_arg') + [Alt con args' (Var sc_arg')] + | sc_arg' <- sc_args' ] + cb_set = unitVarSet case_bndr_flt' + sc_binds = [ DB { db_bind = NonRec sc_arg_flt sc_rhs, db_fvs = cb_set } + | (sc_arg_flt, sc_rhs) <- sc_args_flt' `zip` sc_rhss ] + + flt_binds = scrut_bind : sc_binds + + -- Extend the substitution for RHS to map the *original* binders + -- to their floated versions. + mb_sc_flts :: [Maybe DictId] + mb_sc_flts = map (lookupVarEnv clone_env) args' + clone_env = zipVarEnv sc_args' sc_args_flt' + + subst_prs = (case_bndr, Var case_bndr_flt) + : [ (arg, Var sc_flt) + | (arg, Just sc_flt) <- args `zip` mb_sc_flts ] + subst' = se_subst env_rhs + `Core.extendSubstInScopeList` (case_bndr_flt' : sc_args_flt') + `Core.extendIdSubstList` subst_prs + env_rhs' = env_rhs { se_subst = subst' } + + ; (rhs', rhs_uds) <- specExpr env_rhs' rhs + ; let (free_uds, dumped_dbs) = dumpUDs (case_bndr':args') rhs_uds + all_uds = flt_binds `consDictBinds` free_uds + alt' = Alt con args' (wrapDictBindsE dumped_dbs rhs') +-- ; pprTrace "specCase" (ppr case_bndr $$ ppr scrut_bind) $ + ; return (Var case_bndr_flt, case_bndr', [alt'], all_uds) } + where + (env_rhs, (case_bndr':|args')) = substBndrs env (case_bndr:|args) + sc_args' = filter is_flt_sc_arg args' + + clone_me bndr = do { uniq <- getUniqueM + ; return (mkUserLocalOrCoVar occ uniq wght ty loc) } + where + name = idName bndr + wght = idMult bndr + ty = idType bndr + occ = nameOccName name + loc = getSrcSpan name + + arg_set = mkVarSet args' + is_flt_sc_arg var = isId var + && not (isDeadBinder var) + && isDictTy var_ty + && tyCoVarsOfType var_ty `disjointVarSet` arg_set + where + var_ty = idType var + +specCase env scrut case_bndr alts + = do { (alts', uds_alts) <- mapAndCombineSM spec_alt alts + ; return (scrut, case_bndr', alts', uds_alts) } + where + (env_alt, case_bndr') = substBndr env case_bndr + spec_alt (Alt con args rhs) + = do { (rhs', uds) <- specExpr env_rhs rhs + ; let (free_uds, dumped_dbs) = dumpUDs (case_bndr' : args') uds +-- ; unless (isNilOL dumped_dbs) $ +-- pprTrace "specAlt" (vcat +-- [text "case_bndr', args" <+> (ppr case_bndr' $$ ppr args) +-- ,text "dumped" <+> ppr dumped_dbs ]) return () + ; return (Alt con args' (wrapDictBindsE dumped_dbs rhs'), free_uds) } + where + (env_rhs, args') = substBndrs env_alt args + + +{- Note [Fire rules in the specialiser] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (#21851) + + module A where + f :: Num b => b -> (b, b) + f x = (x + 1, snd (f x)) + {-# SPECIALIZE f :: Int -> (Int, Int) #-} + + module B (g') where + import A + + g :: Num a => a -> a + g x = fst (f x) + {-# NOINLINE[99] g #-} + + h :: Int -> Int + h = g + +Note that `f` has the CPR property, and so will worker/wrapper. + +The call to `g` in `h` will make us specialise `g @Int`. And the specialised +version of `g` will contain the call `f @Int`; but in the subsequent run of +the Simplifier, there will be a competition between: + * The user-supplied SPECIALISE rule for `f` + * The inlining of the wrapper for `f` +In fact, the latter wins -- see Note [tryRules: plan (BEFORE)] +GHC.Core.Opt.Simplify.Iteration. However, it a bit fragile. + +Moreover consider (test T21851_2): + + module A + f :: (Ord a, Show b) => a -> b -> blah + {-# RULE forall b. f @Int @b = wombat #-} + + wombat :: Show b => Int -> b -> blah + wombat = blah + + module B + import A + g :: forall a. Ord a => blah + g @a = ...g...f @a @Char.... + + h = ....g @Int.... + +Now, in module B, GHC will specialise `g @Int`, which will lead to a +call `f @Int @Char`. If we immediately (in the specialiser) rewrite +that to `womabat @Char`, we have a chance to specialise `wombat`. + +Conclusion: it's treat if the Specialiser fires RULEs itself. +It's not hard to achieve: see `fireRewriteRules`. The only tricky bit is +making sure that we have a reasonably up to date EPS rule base. Currently +we load it up just once, in `initRuleEnv`, called at the beginning of +`specProgram`. + +NB: you might wonder if running rules in the specialiser (this Note) renders +Note [tryRules: plan (BEFORE)] in the Simplifier (partly) redundant. That is, +if we run rules in the specialiser, does it matter if we make rules "win" over +inlining in the Simplifier? Yes, it does! See the discussion in #21851. + +Note [Floating dictionaries out of cases] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + g = \d. case d of { MkD sc ... -> ...(f sc)... } +Naively we can't float d2's binding out of the case expression, +because 'sc' is bound by the case, and that in turn means we can't +specialise f, which seems a pity. + +So we invert the case, by floating out a binding +for 'sc_flt' thus: + sc_flt = case d of { MkD sc ... -> sc } +Now we can float the call instance for 'f'. Indeed this is just +what'll happen if 'sc' was originally bound with a let binding, +but case is more efficient, and necessary with equalities. So it's +good to work with both. + +You might think that this won't make any difference, because the +call instance will only get nuked by the \d. BUT if 'g' itself is +specialised, then transitively we should be able to specialise f. + +In general, given + case e of cb { MkD sc ... -> ...(f sc)... } +we transform to + let cb_flt = e + sc_flt = case cb_flt of { MkD sc ... -> sc } + in + case cb_flt of bg { MkD sc ... -> ....(f sc_flt)... } + +The "_flt" things are the floated binds; we use the current substitution +to substitute sc -> sc_flt in the RHS + +************************************************************************ +* * + Dealing with a binding +* * +************************************************************************ +-} + +bringFloatedDictsIntoScope :: SpecEnv -> FloatedDictBinds -> SpecEnv +bringFloatedDictsIntoScope env (FDB { fdb_bndrs = dx_bndrs }) + = -- pprTrace "brought into scope" (ppr dx_bndrs) $ + env {se_subst=subst'} + where + subst' = se_subst env `Core.extendSubstInScopeSet` dx_bndrs + +specBind :: TopLevelFlag + -> SpecEnv -- At top-level only, this env already has the + -- top level binders in scope + -> InBind + -> (SpecEnv -> SpecM (body, UsageDetails)) -- Process the body + -> SpecM ( [OutBind] -- New bindings + , body -- Body + , UsageDetails) -- And info to pass upstream + +-- Returned UsageDetails: +-- No calls for binders of this bind +specBind top_lvl env (NonRec fn rhs) do_body + = do { (rhs', rhs_uds) <- specExpr env rhs + + ; (body_env1, fn1) <- case top_lvl of + TopLevel -> return (env, fn) + NotTopLevel -> cloneBndrSM env fn + + ; let fn2 | isStableUnfolding (idUnfolding fn1) = fn1 + | otherwise = fn1 `setIdUnfolding` mkSimpleUnfolding defaultUnfoldingOpts rhs' + -- Update the unfolding with the perhaps-simpler or more specialised rhs' + -- This is important: see Note [Update unfolding after specialisation] + -- And in any case cloneBndrSM discards non-Stable unfoldings + + fn3 = floatifyIdDemandInfo fn2 + -- We zap the demand info because the binding may float, + -- which would invalidate the demand info (see #17810 for example). + -- Destroying demand info is not terrible; specialisation is + -- always followed soon by demand analysis. + -- See Note [Floatifying demand info when floating] in GHC.Core.Opt.SetLevels + + body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds + `extendInScope` fn3 + -- bringFloatedDictsIntoScope: see #23567 + + ; (body', body_uds) <- do_body body_env2 + + ; (fn4, spec_defns, body_uds1) <- specDefn env body_uds fn3 rhs + + ; let (free_uds, dump_dbs, float_all) = dumpBindUDs [fn4] body_uds1 + all_free_uds = free_uds `thenUDs` rhs_uds + + pairs = spec_defns ++ [(fn4, rhs')] + -- fn4 mentions the spec_defns in its rules, + -- so put the latter first + + final_binds :: [DictBind] + -- See Note [From non-recursive to recursive] + final_binds | not (isNilOL dump_dbs) + , not (null spec_defns) + = [recWithDumpedDicts pairs dump_dbs] + | otherwise + = [mkDB $ NonRec b r | (b,r) <- pairs] + ++ fromOL dump_dbs + + can_float_this_one = exprIsTopLevelBindable rhs (idType fn) + -- exprIsTopLevelBindable: see Note [Care with unlifted bindings] + + ; if float_all && can_float_this_one then + -- Rather than discard the calls mentioning the bound variables + -- we float this (dictionary) binding along with the others + return ([], body', all_free_uds `snocDictBinds` final_binds) + else + -- No call in final_uds mentions bound variables, + -- so we can just leave the binding here + return (map db_bind final_binds, body', all_free_uds) } + + +specBind top_lvl env (Rec pairs) do_body + -- Note [Specialising a recursive group] + = do { let (bndrs,rhss) = unzip pairs + + ; (rec_env, bndrs1) <- case top_lvl of + TopLevel -> return (env, bndrs) + NotTopLevel -> cloneRecBndrsSM env bndrs + + ; (rhss', rhs_uds) <- mapAndCombineSM (specExpr rec_env) rhss + ; (body', body_uds) <- do_body rec_env + + ; let scope_uds = body_uds `thenUDs` rhs_uds + -- Includes binds and calls arising from rhss + + ; (bndrs2, spec_defns2, uds2) <- specDefns rec_env scope_uds (bndrs1 `zip` rhss) + -- bndrs2 is like bndrs1, but with RULES added + + ; (bndrs3, spec_defns3, uds3) + <- if null spec_defns2 -- Common case: no specialisation + then return (bndrs2, [], uds2) + else do { -- Specialisation occurred; do it again + (bndrs3, spec_defns3, uds3) + <- specDefns rec_env uds2 (bndrs2 `zip` rhss) + ; return (bndrs3, spec_defns3 ++ spec_defns2, uds3) } + + ; let (final_uds, dumped_dbs, float_all) = dumpBindUDs bndrs1 uds3 + final_bind = recWithDumpedDicts (spec_defns3 ++ zip bndrs3 rhss') + dumped_dbs + + ; if float_all then + return ([], body', final_uds `snocDictBind` final_bind) + else + return ([db_bind final_bind], body', final_uds) } + + +--------------------------- +specDefns :: SpecEnv + -> UsageDetails -- Info on how it is used in its scope + -> [(OutId,InExpr)] -- The things being bound and their un-processed RHS + -> SpecM ([OutId], -- Original Ids with RULES added + [(OutId,OutExpr)], -- Extra, specialised bindings + UsageDetails) -- Stuff to fling upwards from the specialised versions + +-- Specialise a list of bindings (the contents of a Rec), but flowing usages +-- upwards binding by binding. Example: { f = ...g ...; g = ...f .... } +-- Then if the input CallDetails has a specialised call for 'g', whose specialisation +-- in turn generates a specialised call for 'f', we catch that in this one sweep. +-- But not vice versa (it's a fixpoint problem). + +specDefns _env uds [] + = return ([], [], uds) +specDefns env uds ((bndr,rhs):pairs) + = do { (bndrs1, spec_defns1, uds1) <- specDefns env uds pairs + ; (bndr1, spec_defns2, uds2) <- specDefn env uds1 bndr rhs + ; return (bndr1 : bndrs1, spec_defns1 ++ spec_defns2, uds2) } + +--------------------------- +specDefn :: SpecEnv + -> UsageDetails -- Info on how it is used in its scope + -> OutId -> InExpr -- The thing being bound and its un-processed RHS + -> SpecM (Id, -- Original Id with added RULES + [(Id,CoreExpr)], -- Extra, specialised bindings + UsageDetails) -- Stuff to fling upwards from the specialised versions + +specDefn env body_uds fn rhs + = do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds + rules_for_me = idCoreRules fn + -- Bring into scope the binders from the floated dicts + env_w_dict_bndrs = bringFloatedDictsIntoScope env (ud_binds body_uds) + + ; (rules, spec_defns, spec_uds) <- specCalls False env_w_dict_bndrs + rules_for_me calls_for_me fn rhs + + ; return ( fn `addIdSpecialisations` rules + , spec_defns + , body_uds_without_me `thenUDs` spec_uds) } + -- It's important that the `thenUDs` is this way + -- round, because body_uds_without_me may bind + -- dictionaries that are used in calls_for_me passed + -- to specDefn. So the dictionary bindings in + -- spec_uds may mention dictionaries bound in + -- body_uds_without_me + +--------------------------- +specCalls :: Bool -- True => specialising imported fn + -- False => specialising local fn + -> SpecEnv + -> [CoreRule] -- Existing RULES for the fn + -> [CallInfo] + -> OutId -> InExpr + -> SpecM SpecInfo -- New rules, specialised bindings, and usage details + +-- This function checks existing rules, and does not create +-- duplicate ones. So the caller does not need to do this filtering. +-- See `alreadyCovered` + +type SpecInfo = ( [CoreRule] -- Specialisation rules + , [(Id,CoreExpr)] -- Specialised definition + , UsageDetails ) -- Usage details from specialised RHSs + +specCalls spec_imp env existing_rules calls_for_me fn rhs + -- The first case is the interesting one + | notNull calls_for_me -- And there are some calls to specialise + && not (isNeverActive (idInlineActivation fn)) + -- Don't specialise NOINLINE things + -- See Note [Auto-specialisation and RULES] + -- + -- Don't specialise OPAQUE things, see Note [OPAQUE pragma]. + -- Since OPAQUE things are always never-active (see + -- GHC.Parser.PostProcess.mkOpaquePragma) this guard never fires for + -- OPAQUE things. + +-- && not (certainlyWillInline (idUnfolding fn)) -- And it's not small +-- See Note [Inline specialisations] for why we do not +-- switch off specialisation for inline functions + + = -- pprTrace "specCalls: some" (vcat + -- [ text "function" <+> ppr fn + -- , text "calls:" <+> ppr calls_for_me + -- , text "subst" <+> ppr (se_subst env) ]) $ + foldlM spec_call ([], [], emptyUDs) calls_for_me + + | otherwise -- No calls or RHS doesn't fit our preconceptions + = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me) + "Missed specialisation opportunity for" (ppr fn $$ trace_doc) $ + -- Note [Specialisation shape] + -- pprTrace "specCalls: none" (ppr fn <+> ppr calls_for_me) $ + return ([], [], emptyUDs) + where + trace_doc = sep [ ppr rhs_bndrs, ppr (idInlineActivation fn) ] + + fn_type = idType fn + fn_arity = idArity fn + fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here + inl_prag = idInlinePragma fn + inl_act = inlinePragmaActivation inl_prag + is_active = isActive (beginPhase inl_act) :: Activation -> Bool + -- is_active: inl_act is the activation we are going to put in the new + -- SPEC rule; so we want to see if it is covered by another rule with + -- that same activation. + is_local = isLocalId fn + is_dfun = isDFunId fn + dflags = se_dflags env + this_mod = se_module env + subst = se_subst env + in_scope = Core.substInScopeSet subst + -- Figure out whether the function has an INLINE pragma + -- See Note [Inline specialisations] + + (rhs_bndrs, rhs_body) = collectBindersPushingCo rhs + -- See Note [Account for casts in binding] + + -- Copy InlinePragma information from the parent Id. + -- So if f has INLINE[1] so does spec_fn + spec_inl_prag + | not is_local -- See Note [Specialising imported functions] + , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal + = neverInlinePragma + | otherwise + = inl_prag + + not_in_scope :: InterestingVarFun + not_in_scope v = isLocalVar v && not (v `elemInScopeSet` in_scope) + + ---------------------------------------------------------- + -- Specialise to one particular call pattern + spec_call :: SpecInfo -- Accumulating parameter + -> CallInfo -- Call instance + -> SpecM SpecInfo + spec_call spec_acc@(rules_acc, pairs_acc, uds_acc) _ci@(CI { ci_key = call_args }) + = -- See Note [Specialising Calls] + do { let all_call_args | is_dfun = saturating_call_args -- See Note [Specialising DFuns] + | otherwise = call_args + saturating_call_args = call_args ++ map mk_extra_dfun_arg (dropList call_args rhs_bndrs) + mk_extra_dfun_arg bndr | isTyVar bndr = UnspecType + | otherwise = UnspecArg + + -- Find qvars, the type variables to add to the binders for the rule + -- Namely those free in `ty` that aren't in scope + -- See (MP2) in Note [Specialising polymorphic dictionaries] + ; let poly_qvars = scopedSort $ fvVarList $ specArgsFVs not_in_scope call_args + subst' = subst `Core.extendSubstInScopeList` poly_qvars + -- Maybe we should clone the poly_qvars telescope? + + -- Any free Ids will have caused the call to be dropped + ; massertPpr (all isTyCoVar poly_qvars) + (ppr fn $$ ppr all_call_args $$ ppr poly_qvars) + + ; (useful, subst'', rule_bndrs, rule_lhs_args, spec_bndrs, dx_binds, spec_args) + <- specHeader subst' rhs_bndrs all_call_args + ; let all_rule_bndrs = poly_qvars ++ rule_bndrs + env' = env { se_subst = subst'' } + + -- Check for (a) usefulness and (b) not already covered + -- See (SC1) in Note [Specialisations already covered] + ; let all_rules = rules_acc ++ existing_rules + -- all_rules: we look both in the rules_acc (generated by this invocation + -- of specCalls), and in existing_rules (passed in to specCalls) + already_covered = alreadyCovered env' all_rule_bndrs fn + rule_lhs_args is_active all_rules + +{- ; pprTrace "spec_call" (vcat + [ text "fun: " <+> ppr fn + , text "call info: " <+> ppr _ci + , text "useful: " <+> ppr useful + , text "already_covered:" <+> ppr already_covered + , text "poly_qvars: " <+> ppr poly_qvars + , text "useful: " <+> ppr useful + , text "all_rule_bndrs:" <+> ppr all_rule_bndrs + , text "rule_lhs_args:" <+> ppr rule_lhs_args + , text "spec_bndrs:" <+> ppr spec_bndrs + , text "dx_binds:" <+> ppr dx_binds + , text "spec_args: " <+> ppr spec_args + , text "rhs_bndrs" <+> ppr rhs_bndrs + , text "rhs_body" <+> ppr rhs_body + , text "subst''" <+> ppr subst'' ]) $ + return () +-} + + ; if not useful -- No useful specialisation + || already_covered -- Useful, but done already + then return spec_acc + else + + -- Not useless, not already covered: make a specialised binding + do { let inner_rhs_bndrs = dropList all_call_args rhs_bndrs + (env'', inner_rhs_bndrs') = substBndrs env' inner_rhs_bndrs + + -- Run the specialiser on the specialised RHS + ; (rhs_body', rhs_uds) <- specExpr env'' rhs_body + +{- ; pprTrace "spec_call2" (vcat + [ text "fun:" <+> ppr fn + , text "rhs_body':" <+> ppr rhs_body' ]) $ + return () +-} + + -- Make the RHS of the specialised function + ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs' + (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds + (rhs_uds2, outer_dumped_dbs) = dumpUDs poly_qvars (dx_binds `consDictBinds` rhs_uds1) + -- dx_binds comes from the arguments to the call, and so can mention + -- poly_qvars but no other local binders + spec_rhs = mkLams poly_qvars $ + wrapDictBindsE outer_dumped_dbs $ + mkLams spec_rhs_bndrs $ + wrapDictBindsE inner_dumped_dbs rhs_body' + rule_rhs_args = poly_qvars ++ spec_bndrs + + -- Maybe add a void arg to the specialised function, + -- to avoid unlifted bindings + -- See Note [Specialisations Must Be Lifted] + -- C.f. GHC.Core.Opt.WorkWrap.Utils.needsVoidWorkerArg + + spec_fn_ty = exprType spec_rhs + add_void_arg = isUnliftedType spec_fn_ty && not (isJoinId fn) + (rule_rhs_args1, spec_rhs1, spec_fn_ty1) + | add_void_arg = ( voidPrimId : rule_rhs_args + , Lam voidArgId spec_rhs + , mkVisFunTyMany unboxedUnitTy spec_fn_ty ) + | otherwise = (rule_rhs_args, spec_rhs, spec_fn_ty) + + -------------------------------------- + -- Add a suitable unfolding; see Note [Inline specialisations] + -- The wrap_unf_body applies the original unfolding to the specialised + -- arguments, not forgetting to wrap the dx_binds around the outside (#22358) + simpl_opts = initSimpleOpts dflags + wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds + spec_unf = specUnfolding simpl_opts rule_rhs_args1 wrap_unf_body + rule_lhs_args fn_unf + + -------------------------------------- + -- Adding arity information just propagates it a bit faster + -- See Note [Arity decrease] in GHC.Core.Opt.Simplify + join_arity_decr = length rule_lhs_args - length rule_rhs_args1 + arity_decr = count isValArg rule_lhs_args - count isId rule_rhs_args1 + + spec_fn_info + = vanillaIdInfo `setArityInfo` max 0 (fn_arity - arity_decr) + `setInlinePragInfo` spec_inl_prag + `setUnfoldingInfo` spec_unf + + -- Compute the IdDetails of the specialise Id + -- See Note [Transfer IdDetails during specialisation] + spec_fn_details + = case idDetails fn of + JoinId join_arity _ -> JoinId (join_arity - join_arity_decr) Nothing + DFunId unary -> DFunId unary + _ -> VanillaId + + ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty1 spec_fn_details spec_fn_info + ; let + -- The rule to put in the function's specialisation is: + -- forall x @b d1' d2'. + -- f x @T1 @b @T2 d1' d2' = f1 x @b + -- See Note [Specialising Calls] + herald | spec_imp = -- Specialising imported fn + text "SPEC/" <> ppr this_mod + | otherwise = -- Specialising local fn + text "SPEC" + + spec_rule = mkSpecRule dflags this_mod True inl_act + herald fn all_rule_bndrs rule_lhs_args + (mkVarApps (Var spec_fn) rule_rhs_args1) + + _rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type + , ppr spec_fn <+> dcolon <+> ppr spec_fn_ty1 + , ppr rhs_bndrs, ppr call_args + , ppr spec_rule + , text "acc" <+> ppr rules_acc + , text "existing" <+> ppr existing_rules + ] + + ; -- pprTrace "spec_call: rule" _rule_trace_doc + return ( spec_rule : rules_acc + , (spec_fn, spec_rhs1) : pairs_acc + , rhs_uds2 `thenUDs` uds_acc + ) } } + +alreadyCovered :: SpecEnv + -> [Var] -> Id -> [CoreExpr] -- LHS of possible new rule + -> (Activation -> Bool) -- Which rules are active + -> [CoreRule] -> Bool +-- Note [Specialisations already covered] esp (SC2) +alreadyCovered env bndrs fn args is_active rules + = case specLookupRule env fn args is_active rules of + Nothing -> False + Just (rule, _) + | isAutoRule rule -> -- Discard identical rules + -- We know that (fn args) is an instance of RULE + -- Check if RULE is an instance of (fn args) + ruleLhsIsMoreSpecific in_scope bndrs args rule + | otherwise -> True -- User rules dominate + where + in_scope = substInScopeSet (se_subst env) + +-- Convenience function for invoking lookupRule from Specialise +-- The SpecEnv's InScopeSet should include all the Vars in the [CoreExpr] +specLookupRule :: HasDebugCallStack + => SpecEnv -> Id -> [CoreExpr] + -> (Activation -> Bool) -- Which rules are active + -> [CoreRule] -> Maybe (CoreRule, CoreExpr) +specLookupRule env fn args is_active rules + | null rules + = Nothing -- Saves building a few thunks in the common case + | otherwise + = lookupRule ropts in_scope_env is_active fn args rules + where + dflags = se_dflags env + in_scope = substInScopeSet (se_subst env) + in_scope_env = ISE in_scope (whenActiveUnfoldingFun is_active) + ropts = initRuleOpts dflags + +{- Note [Specialising DFuns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +DFuns have a special sort of unfolding (DFunUnfolding), and it is +hard to specialise a DFunUnfolding to give another DFunUnfolding +unless the DFun is fully applied (#18120). So, in the case of DFunIds +we simply extend the CallKey with trailing UnspecTypes/UnspecArgs, +so that we'll generate a rule that completely saturates the DFun. + +There is an ASSERT that checks this, in the DFunUnfolding case of +GHC.Core.Unfold.Make.specUnfolding. + +Note [Transfer IdDetails during specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising a function, `newSpecIdSM` comes up with a fresh Id the +specialised RHS will be bound to. It is critical that we get the `IdDetails` of +the specialised Id correct: + +* JoinId: We want the specialised Id to be a join point, too. But + we have to carefully adjust the arity + +* DFunId: It is crucial that we also make the new Id a DFunId. + - First, because it obviously /is/ a DFun, having a DFunUnfolding and + all that; see Note [Specialising DFuns] + + - Second, DFuns get very delicate special treatment in the demand analyser; + see GHC.Core.Opt.DmdAnal.enterDFun. If the specialised function isn't + also a DFunId, this special treatment doesn't happen, so the demand + analyser makes a too-strict DFun, and we get an infinite loop. See Note + [Do not strictify a DFun's parameter dictionaries] in GHC.Core.Opt.DmdAnal. + #22549 describes the loop, and (lower down) a case where a /specialised/ + DFun caused a loop. + +* WorkerLikeId: Introduced by WW, so after Specialise. Nevertheless, they come + up when specialising imports. We must keep them as VanillaIds because WW + will detect them as WorkerLikeIds again. That is, unless specialisation + allows unboxing of all previous CBV args, in which case sticking to + VanillaIds was the only correct choice to begin with. + +* RecSelId, DataCon*Id, ClassOpId, PrimOpId, FCallId, CoVarId, TickBoxId: + Never specialised. + +Note [Specialisation Must Preserve Sharing] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function: + + f :: forall a. Eq a => a -> blah + f = + if expensive + then f1 + else f2 + +As written, all calls to 'f' will share 'expensive'. But if we specialise 'f' +at 'Int', eg: + + $sfInt = SUBST[a->Int,dict->dEqInt] (if expensive then f1 else f2) + + RULE "SPEC f" + forall (d :: Eq Int). + f Int _ = $sfIntf + +We've now lost sharing between 'f' and '$sfInt' for 'expensive'. Yikes! + +To avoid this, we only generate specialisations for functions whose arity is +enough to bind all of the arguments we need to specialise. This ensures our +specialised functions don't do any work before receiving all of their dicts, +and thus avoids the 'f' case above. + +Note [Specialisations Must Be Lifted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a function 'f': + + f = forall a. Eq a => Array# a + +used like + + case x of + True -> ...f @Int dEqInt... + False -> 0 + +Naively, we might generate an (expensive) specialisation + + $sfInt :: Array# Int + +even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to +the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to +preserve laziness. + +Note [Care with unlifted bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#22998) + f x = let x::ByteArray# = + n::Natural = NB x + in wombat @192827 (n |> co) +where + co :: Natural ~ KnownNat 192827 + wombat :: forall (n:Nat). KnownNat n => blah + +Left to itself, the specialiser would float the bindings for `x` and `n` to top +level, so we can specialise `wombat`. But we can't have a top-level ByteArray# +(see Note [Core letrec invariant] in GHC.Core). Boo. + +This is pretty exotic, so we take a simple way out: in specBind (the NonRec +case) do not float the binding itself unless it satisfies exprIsTopLevelBindable. +This is conservative: maybe the RHS of `x` has a free var that would stop it +floating to top level anyway; but that is hard to spot (since we don't know what +the non-top-level in-scope binders are) and rare (since the binding must satisfy +Note [Core let-can-float invariant] in GHC.Core). + + +Note [Specialising Calls] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have a function with a complicated type: + + f :: forall a b c. Int -> Eq a => Show b => c -> Blah + f @a @b @c i dEqA dShowA x = blah + +and suppose it is called at: + + f @T1 @T2 @T3 7 dEqT1 ($dfShow dShowT2) t3 + +This call is described as a 'CallInfo' whose 'ci_key' is: + + [ SpecType T1, SpecType T2, UnspecType + , UnspecArg + , SpecDict dEqT1 + , SpecDict ($dfShow dShowT2) + , UnspecArg ] + +Why are 'a' and 'b' identified as 'SpecType', while 'c' is 'UnspecType'? +Because we must specialise the function on type variables that appear +free in its *dictionary* arguments; but not on type variables that do not +appear in any dictionaries, i.e. are fully polymorphic. + +Because this call has dictionaries applied, we'd like to specialise +the call on any type argument that appears free in those dictionaries. +In this case, those are [a :-> T1, b :-> T2]. + +We also need to substitute the dictionary binders with their +specialised dictionaries. The simplest substitution would be +[dEqA :-> dEqT1, dShowA :-> $dfShow dShowT2], but this duplicates +work, since `$dfShow dShowT2` is a function application. Therefore, we +also want to *float the dictionary out* (via bindAuxiliaryDict), +creating a new dict binding + + dShow1 = $dfShow dShowT2 + +and the substitution [dEqA :-> dEqT1, dShowA :-> dShow1]. + +With the substitutions in hand, we can generate a specialised function: + + $sf :: forall c. Int -> c -> Blah + $sf = SUBST[a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowA :-> dShow1] (\@c i x -> blah) + +Note that the substitution is applied to the whole thing. This is +convenient, but just slightly fragile. Notably: + * There had better be no name clashes in a/b/c + +We must construct a rewrite rule: + + RULE "SPEC f @T1 @T2 _" + forall (@c :: Type) (i :: Int) (d1 :: Eq T1) (d2 :: Show T2). + f @T1 @T2 @c i d1 d2 = $sf @c i + +In the rule, d1 and d2 are just wildcards, not used in the RHS. Note +additionally that 'x' isn't captured by this rule --- we bind only +enough etas in order to capture all of the *specialised* arguments. + +Note [Drop dead args from specialisations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising a function, it’s possible some of the arguments may +actually be dead. For example, consider: + + f :: forall a. () -> Show a => a -> String + f x y = show y ++ "!" + +We might generate the following CallInfo for `f @Int`: + + [SpecType Int, UnspecArg, SpecDict $dShowInt, UnspecArg] + +Normally we’d include both the x and y arguments in the +specialisation, since we’re not specialising on either of them. But +that’s silly, since x is actually unused! So we might as well drop it +in the specialisation: + + $sf :: Int -> String + $sf y = show y ++ "!" + + {-# RULE "SPEC f @Int" forall x. f @Int x $dShow = $sf #-} + +This doesn’t save us much, since the arg would be removed later by +worker/wrapper, anyway, but it’s easy to do. + +Wrinkles + +* Note that we only drop dead arguments if: + 1. We don’t specialise on them. + 2. They come before an argument we do specialise on. + Doing the latter would require eta-expanding the RULE, which could + make it match less often, so it’s not worth it. Doing the former could + be more useful --- it would stop us from generating pointless + specialisations --- but it’s more involved to implement and unclear if + it actually provides much benefit in practice. + +* If the function has a stable unfolding, specHeader has to come up with + arguments to pass to that stable unfolding, when building the stable + unfolding of the specialised function: this is the last field in specHeader's + big result tuple. + + The right thing to do is to produce a LitRubbish; it should rapidly + disappear. Rather like GHC.Core.Opt.WorkWrap.Utils.mk_absent_let. + +Note [Specialisation modulo dictionary selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #19644, we discovered that the ClassOp/DFun rules from +Note [ClassOp/DFun selection] inhibit transitive specialisation. +Example, inspired by T17966: + + class C a where + m :: Show b => a -> b -> String + dummy :: a -> () -- Force a datatype dictionary representation + + instance C Int where + m a b = show a ++ show b + dummy _ = () + + f :: (C a, Show b) => a -> b -> String + f a b = m a b ++ "!" + {-# INLINABLE[0] f #-} + + main = putStrLn (f (42::Int) (True::Bool)) + +Here, we specialise `f` at `Int` and `Bool`, giving + + $dC = $fCInt + $dShow = GHC.Show.$fShowBool + $sf (a::Int) (b::Bool) = + ... (m @Int $dC @Bool $dShow a b) ... + +Here `m` is just a DictSel, so there is (apparently) nothing to specialise! +However, the next Simplifier run will expose the rewritten instance method: + + ... $fCInt_$cm @Bool $fShowBool a b ... + +where $fCInt_$cm is the instance method for `m` in `instance C Int`: + + $fCInt_$cm :: forall b. Show b => Int -> b -> String + $fCInt_$cm b d x y = show @Int $dShowInt x ++ show @b d y + +We want to specialise this! How? By doing the method-selection rewrite in +the Specialiser. Hence + +1. In the App case of 'specExpr', try to apply the ClassOp/DFun rule on the + head of the application, repeatedly, via 'fireRewriteRules'. +2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and + `$dShow` in `bindAuxiliaryDict`, so that we can exploit the unfolding + in 'fireRewriteRules' to do the ClassOp/DFun rewrite. + +NB: Without (2), (1) would be pointless, because 'lookupRule' wouldn't be able +to look into the RHS of `$dC` to see the DFun. + +Note [Zap occ info in rule binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we generate a specialisation RULE, we need to drop occurrence +info on the binders. If we don’t, things go wrong when we specialise a +function like + + f :: forall a. () -> Show a => a -> String + f x y = show y ++ "!" + +since we’ll generate a RULE like + + RULE "SPEC f @Int" forall x [Occ=Dead]. + f @Int x $dShow = $sf + +and Core Lint complains, even though x only appears on the LHS (due to +Note [Drop dead args from specialisations]). + +Why is that a Lint error? Because the arguments on the LHS of a rule +are syntactically expressions, not patterns, so Lint treats the +appearance of x as a use rather than a binding. Fortunately, the +solution is simple: we just make sure to zap the occ info before +using ids as wildcard binders in a rule. + +Note [Account for casts in binding] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f :: Eq a => a -> IO () + {-# INLINABLE f + StableUnf = (/\a \(d:Eq a) (x:a). blah) |> g + #-} + f = ... + +In f's stable unfolding we have done some modest simplification which +has pushed the cast to the outside. (I wonder if this is the Right +Thing, but it's what happens now; see GHC.Core.Opt.Simplify.Utils Note [Casts and +lambdas].) Now that stable unfolding must be specialised, so we want +to push the cast back inside. It would be terrible if the cast +defeated specialisation! Hence the use of collectBindersPushingCo. + +Note [Evidence foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose (#12212) that we are specialising + f :: forall a b. (Num a, F a ~# F b) => blah +with a=b=Int. Then the RULE will be something like + RULE forall (d:Num Int) (g :: F Int ~# F Int). + f Int Int d g = f_spec +where that `g` is really (Coercion (CoVar g)), since `g` is a +coercion variable and can't appear as (Var g). + +But both varToCoreExpr (when constructing the LHS args), and the +simplifier (when simplifying the LHS args), will transform to + RULE forall (d:Num Int) (g :: F Int ~ F Int). + f Int Int d = f_spec +by replacing g with Refl. So now 'g' is unbound, which results in a later +crash. So we use Refl right off the bat, and do not forall-quantify 'g': + * varToCoreExpr generates a (Coercion Refl) + * exprsFreeIdsList returns the Ids bound by the args, + which won't include g + +You might wonder if this will match as often, but the simplifier replaces +complicated Refl coercions with Refl pretty aggressively. + +Note [Orphans and auto-generated rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we specialise an INLINABLE function, or when we have +-fspecialise-aggressively, we auto-generate RULES that are orphans. +We don't want to warn about these, or we'd generate a lot of warnings. +Thus, we only warn about user-specified orphan rules. + +Indeed, we don't even treat the module as an orphan module if it has +auto-generated *rule* orphans. Orphan modules are read every time we +compile, so they are pretty obtrusive and slow down every compilation, +even non-optimised ones. (Reason: for type class instances it's a +type correctness issue.) But specialisation rules are strictly for +*optimisation* only so it's fine not to read the interface. + +What this means is that a SPEC rules from auto-specialisation in +module M will be used in other modules only if M.hi has been read for +some other reason, which is actually pretty likely. + +Note [From non-recursive to recursive] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Even in the non-recursive case, if any dict-binds depend on 'fn' we might +have built a recursive knot + + f a d x = + MkUD { ud_binds = NonRec d7 (MkD ..f..) + , ud_calls = ...(f T d7)... } + +The we generate + + Rec { fs x = [T/a, d7/d] + f a d x = + RULE f T _ = fs + d7 = ...f... } + +Here the recursion is only through the RULE. + +However we definitely should /not/ make the Rec in this wildly common +case: + d = ... + MkUD { ud_binds = NonRec d7 (...d...) + , ud_calls = ...(f T d7)... } + +Here we want simply to add d to the floats, giving + MkUD { ud_binds = NonRec d (...) + NonRec d7 (...d...) + , ud_calls = ...(f T d7)... } + +In general, we need only make this Rec if + - there are some specialisations (spec_binds non-empty) + - there are some dict_binds that depend on f (dump_dbs non-empty) + +Note [Avoiding loops (DFuns)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising /dictionary functions/ we must be very careful to +avoid building loops. Here is an example that bit us badly, on +several distinct occasions. + +Here is one: #3591 + class Eq a => C a + instance Eq [a] => C [a] + +This translates to + dfun :: Eq [a] -> C [a] + dfun a d = MkD a d (meth d) + + d4 :: Eq [T] = + d2 :: C [T] = dfun T d4 + d1 :: Eq [T] = $p1 d2 + d3 :: C [T] = dfun T d1 + +None of these definitions is recursive. What happened was that we +generated a specialisation: + RULE forall d. dfun T d = dT :: C [T] + dT = (MkD a d (meth d)) [T/a, d1/d] + = MkD T d1 (meth d1) + +But now we use the RULE on the RHS of d2, to get + d2 = dT = MkD d1 (meth d1) + d1 = $p1 d2 + +and now d1 is bottom! The problem is that when specialising 'dfun' we +should first dump "below" the binding all floated dictionary bindings +that mention 'dfun' itself. So d2 and d3 (and hence d1) must be +placed below 'dfun', and thus unavailable to it when specialising +'dfun'. That in turn means that the call (dfun T d1) must be +discarded. On the other hand, the call (dfun T d4) is fine, assuming +d4 doesn't mention dfun. + +Solution: + Discard all calls that mention dictionaries that depend + (directly or indirectly) on the dfun we are specialising. + This is done by 'filterCalls' + +Note [Avoiding loops (non-DFuns)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The whole Note [Avoiding loops (DFuns)] things applies only to DFuns. +It's important /not/ to apply filterCalls to non-DFuns. For example: + + class C a where { foo,bar :: [a] -> [a] } + + instance C Int where + foo x = r_bar x + bar xs = reverse xs + + r_bar :: C a => [a] -> [a] + r_bar xs = bar (xs ++ xs) + +That translates to: + + r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs) + + Rec { $fCInt :: C Int = MkC foo_help reverse + foo_help (xs::[Int]) = r_bar Int $fCInt xs } + +The call (r_bar $fCInt) mentions $fCInt, + which mentions foo_help, + which mentions r_bar + +But we DO want to specialise r_bar at Int: + Rec { $fCInt :: C Int = MkC foo_help reverse + foo_help (xs::[Int]) = r_bar Int $fCInt xs + + r_bar a (c::C a) (xs::[a]) = bar a d (xs ++ xs) + RULE r_bar Int _ = r_bar_Int + + r_bar_Int xs = bar Int $fCInt (xs ++ xs) + } + +Note that, because of its RULE, r_bar joins the recursive +group. (In this case it'll unravel a short moment later.) +See test simplCore/should_compile/T19599a. + +Another example is #19599, which looked like this: + + class (Show a, Enum a) => MyShow a where + myShow :: a -> String + + myShow_impl :: MyShow a => a -> String + + foo :: Int -> String + foo = myShow_impl @Int $fMyShowInt + + Rec { $fMyShowInt = MkMyShowD $fEnumInt $fShowInt $cmyShow + ; $cmyShow = myShow_impl @Int $fMyShowInt } + +Here, we really do want to specialise `myShow_impl @Int $fMyShowInt`. + + +Note [Specialising a recursive group] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + let rec { f x = ...g x'... + ; g y = ...f y'.... } + in f 'a' +Here we specialise 'f' at Char; but that is very likely to lead to +a specialisation of 'g' at Char. We must do the latter, else the +whole point of specialisation is lost. + +But we do not want to keep iterating to a fixpoint, because in the +presence of polymorphic recursion we might generate an infinite number +of specialisations. + +So we use the following heuristic: + * Arrange the rec block in dependency order, so far as possible + (the occurrence analyser already does this) + + * Specialise it much like a sequence of lets + + * Then go through the block a second time, feeding call-info from + the RHSs back in the bottom, as it were + +In effect, the ordering maxmimises the effectiveness of each sweep, +and we do just two sweeps. This should catch almost every case of +monomorphic recursion -- the exception could be a very knotted-up +recursion with multiple cycles tied up together. + +This plan is implemented in the Rec case of specBindItself. + +Note [Specialisations already covered] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We obviously don't want to generate two specialisations for the same +argument pattern. Wrinkles + +(SC1) We do the already-covered test in specDefn, not when we generate + the CallInfo in mkCallUDs. We used to test in the latter place, but + we now iterate the specialiser somewhat, and the Id at the call site + might therefore not have all the RULES that we can see in specDefn + +(SC2) What about two specialisations where the second is an *instance* + of the first? It's a bit arbitrary, but here's what we do: + * If the existing one is user-specified, via a SPECIALISE pragma, we + suppress the further specialisation. + * If the existing one is auto-generated, we generate a second RULE + for the more specialised version. + The latter is important because we don't want the accidental order + of calls to determine what specialisations we generate. + +(SC3) Annoyingly, we /also/ eliminate duplicates in `filterCalls`. + See (MP3) in Note [Specialising polymorphic dictionaries] + +Note [Auto-specialisation and RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider: + g :: Num a => a -> a + g = ... + + f :: (Int -> Int) -> Int + f w = ... + {-# RULE f g = 0 #-} + +Suppose that auto-specialisation makes a specialised version of +g::Int->Int. That version won't appear in the LHS of the RULE for f. +So if the specialisation rule fires too early, the rule for f may +never fire. + +It might be possible to add new rules, to "complete" the rewrite system. +Thus when adding + RULE forall d. g Int d = g_spec +also add + RULE f g_spec = 0 + +But that's a bit complicated. For now we ask the programmer's help, +by *copying the INLINE activation pragma* to the auto-specialised +rule. So if g says {-# NOINLINE[2] g #-}, then the auto-spec rule +will also not be active until phase 2. And that's what programmers +should jolly well do anyway, even aside from specialisation, to ensure +that g doesn't inline too early. + +This in turn means that the RULE would never fire for a NOINLINE +thing so not much point in generating a specialisation at all. + +Note [Specialisation shape] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We only specialise a function if it has visible top-level lambdas +corresponding to its overloading. E.g. if + f :: forall a. Eq a => .... +then its body must look like + f = /\a. \d. ... + +Reason: when specialising the body for a call (f ty dexp), we want to +substitute dexp for d, and pick up specialised calls in the body of f. + +We do allow casts, however; see Note [Account for casts in binding]. + +This doesn't always work. One example I came across was this: + newtype Gen a = MkGen{ unGen :: Int -> a } + + choose :: Eq a => a -> Gen a + choose n = MkGen (\r -> n) + + oneof = choose (1::Int) + +It's a silly example, but we get + choose = /\a. g `cast` co +where choose doesn't have any dict arguments. Thus far I have not +tried to fix this (wait till there's a real example). + +Mind you, then 'choose' will be inlined (since RHS is trivial) so +it doesn't matter. This comes up with single-method classes + + class C a where { op :: a -> a } + instance C a => C [a] where .... +==> + $fCList :: C a => C [a] + $fCList = $copList |> (...coercion>...) + ....(uses of $fCList at particular types)... + +So we suppress the WARN if the rhs is trivial. + +Note [Inline specialisations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here is what we do with the InlinePragma of the original function + + * Activation/RuleMatchInfo: both inherited from the original function + + * InlineSpec: inherit from original function + + * Unfolding: transfer a StableUnfolding iff it is UnfWhen + See GHC.Core.Unfold.Make.specUnfolding + and its Note [Specialising unfoldings] + +InlineSpec: you might wonder why we specialise INLINE functions at all. +After all they should be inlined, right? Two reasons: + + * Even INLINE functions are sometimes not inlined, when they aren't + applied to interesting arguments. But perhaps the type arguments + alone are enough to specialise (even though the args are too boring + to trigger inlining), and it's certainly better to call the + specialised version. + + * The RHS of an INLINE function might call another overloaded function, + and we'd like to generate a specialised version of that function too. + This actually happens a lot. Consider + replicateM_ :: (Monad m) => Int -> m a -> m () + {-# INLINABLE replicateM_ #-} + replicateM_ d x ma = ... + The strictness analyser may transform to + replicateM_ :: (Monad m) => Int -> m a -> m () + {-# INLINE replicateM_ #-} + replicateM_ d x ma = case x of I# x' -> $wreplicateM_ d x' ma + + $wreplicateM_ :: (Monad m) => Int# -> m a -> m () + {-# INLINABLE $wreplicateM_ #-} + $wreplicateM_ = ... + Now an importing module has a specialised call to replicateM_, say + (replicateM_ dMonadIO). We certainly want to specialise $wreplicateM_! + This particular example had a huge effect on the call to replicateM_ + in nofib/shootout/n-body. +-} + +{- ********************************************************************* +* * + SpecArg, and specHeader +* * +********************************************************************* -} + +-- | An argument that we might want to specialise. +-- See Note [Specialising Calls] for the nitty gritty details. +data SpecArg + = + -- | Type arguments that should be specialised, due to appearing + -- free in the type of a 'SpecDict'. + SpecType Type + + -- | Type arguments that should remain polymorphic. + | UnspecType + + -- | Dictionaries that should be specialised. mkCallUDs ensures + -- that only "interesting" dictionary arguments get a SpecDict; + -- see Note [Interesting dictionary arguments] + | SpecDict DictExpr + + -- | Value arguments that should not be specialised. + | UnspecArg + +instance Outputable SpecArg where + ppr (SpecType t) = text "SpecType" <+> ppr t + ppr (SpecDict d) = text "SpecDict" <+> ppr d + ppr UnspecType = text "UnspecType" + ppr UnspecArg = text "UnspecArg" + +specArgsFVs :: InterestingVarFun -> [SpecArg] -> FV +-- Find the free vars of the SpecArgs that are not already in scope +specArgsFVs interesting args + = filterFV interesting $ + foldr (unionFV . get) emptyFV args + where + get :: SpecArg -> FV + get (SpecType ty) = tyCoFVsOfType ty + get (SpecDict dx) = exprFVs dx + get UnspecType = emptyFV + get UnspecArg = emptyFV + +isSpecDict :: SpecArg -> Bool +isSpecDict (SpecDict {}) = True +isSpecDict _ = False + +-- | Given binders from an original function 'f', and the 'SpecArg's +-- corresponding to its usage, compute everything necessary to build +-- a specialisation. +-- +-- We will use the running example from Note [Specialising Calls]: +-- +-- f :: forall a b c. Int -> Eq a => Show b => c -> Blah +-- f @a @b @c i dEqA dShowB x = blah +-- +-- Suppose we decide to specialise it at the following pattern: +-- +-- [ SpecType T1, SpecType T2, UnspecType, UnspecArg +-- , SpecDict dEqT1, SpecDict ($dfShow dShowT2), UnspecArg ] +-- +-- We'd eventually like to build the RULE +-- +-- RULE "SPEC f @T1 @T2 _" +-- forall (@c :: Type) (i :: Int) (d1 :: Eq T1) (d2 :: Show T2). +-- f @T1 @T2 @c i d1 d2 = $sf @c i +-- +-- and the specialisation '$sf' +-- +-- $sf :: forall c. Int -> c -> Blah +-- $sf = SUBST[a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowB :-> dShow1] (\@c i x -> blah) +-- +-- where dShow1 is a floated binding created by bindAuxiliaryDict. +-- +-- The cases for 'specHeader' below are presented in the same order as this +-- running example. The result of 'specHeader' for this example is as follows: +-- +-- ( -- Returned arguments +-- env + [a :-> T1, b :-> T2, dEqA :-> dEqT1, dShowB :-> dShow1] +-- , [x] +-- +-- -- RULE helpers +-- , [c, i, d1, d2] +-- , [T1, T2, c, i, d1, d2] +-- +-- -- Specialised function helpers +-- , [c, i, x] +-- , [dShow1 = $dfShow dShowT2] +-- , [T1, T2, c, i, dEqT1, dShow1] +-- ) +specHeader + :: Core.Subst -- This substitution applies to the [InBndr] + -> [InBndr] -- Binders from the original function `f` + -> [SpecArg] -- From the CallInfo + -> SpecM ( Bool -- True <=> some useful specialisation happened + -- Not the same as any (isSpecDict args) because + -- the args might be longer than bndrs + + , Core.Subst -- Apply this to the body + + -- RULE helpers + -- `RULE forall rule_bndrs. f rule_es = $sf spec_bndrs` + , [OutBndr] -- rule_bndrs: Binders for the RULE + , [OutExpr] -- rule_es: Args for the LHS of the rule + + -- Specialised function helpers + -- `$sf = \spec_bndrs. let { dx_binds } in spec_arg` + , [OutBndr] -- spec_bndrs: Binders for $sf, and args for the RHS + -- of the RULE. Subset of rule_bndrs. + , [DictBind] -- dx_binds: Auxiliary dictionary bindings + , [OutExpr] -- spec_args: Specialised arguments for unfolding + -- Same length as "Args for LHS of rule" + ) + +-- If we run out of binders, stop immediately +-- See Note [Specialisation Must Preserve Sharing] +specHeader subst [] _ = pure (False, subst, [], [], [], [], []) +specHeader subst _ [] = pure (False, subst, [], [], [], [], []) + +-- We want to specialise on type 'T1', and so we must construct a substitution +-- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding +-- details. +specHeader subst (bndr:bndrs) (SpecType ty : args) + = do { let subst1 = Core.extendTvSubst subst bndr ty + ; (useful, subst2, rule_bs, rule_args, spec_bs, dx, spec_args) + <- specHeader subst1 bndrs args + ; pure ( useful, subst2 + , rule_bs, Type ty : rule_args + , spec_bs, dx, Type ty : spec_args ) } + +-- Next we have a type that we don't want to specialise. We need to perform +-- a substitution on it (in case the type refers to 'a'). Additionally, we need +-- to produce a binder, LHS argument and RHS argument for the resulting rule, +-- /and/ a binder for the specialised body. +specHeader subst (bndr:bndrs) (UnspecType : args) + = do { let (subst1, bndr') = Core.substBndr subst bndr + ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) + <- specHeader subst1 bndrs args + ; let ty_e' = Type (mkTyVarTy bndr') + ; pure ( useful, subst2 + , bndr' : rule_bs, ty_e' : rule_es + , bndr' : spec_bs, dx, ty_e' : spec_args ) } + +specHeader subst (bndr:bndrs) (_ : args) + | isDeadBinder bndr + , let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) + , Just rubbish_lit <- mkLitRubbish (idType bndr') + = -- See Note [Drop dead args from specialisations] + do { (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + ; pure ( useful, subst2 + , bndr' : rule_bs, Var bndr' : rule_es + , spec_bs, dx, rubbish_lit : spec_args ) } + +-- Next we want to specialise the 'Eq a' dict away. We need to construct +-- a wildcard binder to match the dictionary (See Note [Specialising Calls] for +-- the nitty-gritty), as a LHS rule and unfolding details. +specHeader subst (bndr:bndrs) (SpecDict dict_arg : args) + = do { -- Make up a fresh binder to use in the RULE + -- It might turn into a dict binding (via bindAuxiliaryDict) which we + -- then float, so we use cloneIdBndr to get a completely fresh binder + us <- getUniqueSupplyM + ; let (subst1, bndr') = Core.cloneIdBndr subst us (zapIdOccInfo bndr) + -- zapIdOccInfo: see Note [Zap occ info in rule binders] + + -- Extend the substitution to map bndr :-> dict_arg, for use in the RHS + ; let (subst2, dx_bind, spec_dict) = bindAuxiliaryDict subst1 bndr bndr' dict_arg + + ; (_, subst3, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst2 bndrs args + + ; let dx' = case dx_bind of { Nothing -> dx; Just d -> d : dx } + ; pure ( True, subst3 -- Ha! A useful specialisation! + , bndr' : rule_bs, Var bndr' : rule_es + , spec_bs, dx', spec_dict : spec_args ) } + +-- Finally, we don't want to specialise on this argument 'i': +-- We need to produce a binder, LHS and RHS argument for the RULE, and +-- a binder for the specialised body. +-- +-- NB: Calls to 'specHeader' will trim off any trailing 'UnspecArg's, which is +-- why 'i' doesn't appear in our RULE above. But we have no guarantee that +-- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so +-- this case must be here. +specHeader subst (bndr:bndrs) (UnspecArg : args) + = do { let (subst1, bndr') = Core.substBndr subst (zapIdOccInfo bndr) + -- zapIdOccInfo: see Note [Zap occ info in rule binders] + ; (useful, subst2, rule_bs, rule_es, spec_bs, dx, spec_args) <- specHeader subst1 bndrs args + + ; let dummy_arg = varToCoreExpr bndr' + -- dummy_arg is usually just (Var bndr), + -- but if bndr :: t1 ~# t2, it'll be (Coercion (CoVar bndr)) + -- or even Coercion Refl (if t1=t2) + -- See Note [Evidence foralls] + bndrs = exprFreeIdsList dummy_arg + + ; pure ( useful, subst2 + , bndrs ++ rule_bs, dummy_arg : rule_es + , bndrs ++ spec_bs, dx, dummy_arg : spec_args ) } + + +-- | Binds a dictionary argument to a fresh name, to preserve sharing +bindAuxiliaryDict + :: Subst + -> InId -> OutId -> OutExpr -- Original dict binder, and the witnessing expression + -> ( Subst -- Substitutes for orig_dict_id + , Maybe DictBind -- Auxiliary dict binding, if any + , OutExpr) -- Witnessing expression (always trivial) +bindAuxiliaryDict subst orig_dict_id fresh_dict_id dict_arg + + -- If the dictionary argument is trivial, + -- don’t bother creating a new dict binding; just substitute + | exprIsTrivial dict_arg + , let subst' = Core.extendSubst subst orig_dict_id dict_arg + = -- pprTrace "bindAuxiliaryDict:trivial" (ppr orig_dict_id <+> ppr dict_id) $ + (subst', Nothing, dict_arg) + + | otherwise -- Non-trivial dictionary arg; make an auxiliary binding + , let fresh_dict_id' = fresh_dict_id `addDictUnfolding` dict_arg + + dict_bind = mkDB (NonRec fresh_dict_id' dict_arg) + subst' = Core.extendSubst subst orig_dict_id (Var fresh_dict_id') + `Core.extendSubstInScope` fresh_dict_id' + -- Ensure the new unfolding is in the in-scope set + = -- pprTrace "bindAuxiliaryDict:non-trivial" (ppr orig_dict_id <+> ppr fresh_dict_id') $ + (subst', Just dict_bind, Var fresh_dict_id') + +addDictUnfolding :: Id -> CoreExpr -> Id +-- Add unfolding for freshly-bound Ids: see Note [Make the new dictionaries interesting] +-- and Note [Specialisation modulo dictionary selectors] +addDictUnfolding id rhs + = id `setIdUnfolding` mkSimpleUnfolding defaultUnfoldingOpts rhs + +{- +Note [Make the new dictionaries interesting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Important! We're going to substitute dx_id1 for d +and we want it to look "interesting", else we won't gather *any* +consequential calls. E.g. + f d = ...g d.... +If we specialise f for a call (f (dfun dNumInt)), we'll get +a consequent call (g d') with an auxiliary definition + d' = df dNumInt +We want that consequent call to look interesting; so we add an unfolding +in the dictionary Id. +-} + + +{- ********************************************************************* +* * + UsageDetails and suchlike +* * +********************************************************************* -} + +data UsageDetails + = MkUD { ud_binds :: !FloatedDictBinds + , ud_calls :: !CallDetails } + -- INVARIANT: suppose bs = fdb_bndrs ud_binds + -- Then 'calls' may *mention* 'bs', + -- but there should be no calls *for* bs + +data FloatedDictBinds -- See Note [Floated dictionary bindings] + = FDB { fdb_binds :: !(OrdList DictBind) + -- The order is important; + -- in ds1 `appOL` ds2, bindings in ds2 can depend on those in ds1 + + , fdb_bndrs :: !IdSet + } -- ^ The binders of 'fdb_binds'. + -- Caches a superset of the expression + -- `mkVarSet (bindersOfDictBinds fdb_binds))` + -- for later addition to an InScopeSet + +-- | A 'DictBind' is a binding along with a cached set containing its free +-- variables (both type variables and dictionaries). We need this set +-- in splitDictBinds, when filtering bindings to decide which are +-- captured by a binder +data DictBind = DB { db_bind :: CoreBind, db_fvs :: VarSet } + +bindersOfDictBind :: DictBind -> [Id] +bindersOfDictBind = bindersOf . db_bind + +bindersOfDictBinds :: Foldable f => f DictBind -> [Id] +bindersOfDictBinds = bindersOfBinds . foldr ((:) . db_bind) [] + +{- Note [Floated dictionary bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We float out dictionary bindings for the reasons described under +"Dictionary floating" above. But not /just/ dictionary bindings. +Consider + + f :: Eq a => blah + f a d = rhs + + $c== :: T -> T -> Bool + $c== x y = ... + + $df :: Eq T + $df = Eq $c== ... + + gurgle = ...(f @T $df)... + +We gather the call info for (f @T $df), and we don't want to drop it +when we come across the binding for $df. So we add $df to the floats +and continue. But then we have to add $c== to the floats, and so on. +These all float above the binding for 'f', and now we can +successfully specialise 'f'. + +So the DictBinds in (ud_binds :: OrdList DictBind) may contain +non-dictionary bindings too. + +Note [Specialising polymorphic dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note June 2023: This has proved to be quite a tricky optimisation to get right +see (#23469, #23109, #21229, #23445) so it is now guarded by a flag +`-fpolymorphic-specialisation`. + +Consider + class M a where { foo :: a -> Int } + + instance M (ST s) where ... + -- dMST :: forall s. M (ST s) + + wimwam :: forall a. M a => a -> Int + wimwam = /\a \(d::M a). body + + f :: ST s -> Int + f = /\s \(x::ST s). wimwam @(ST s) (dMST @s) dx + 1 + +We'd like to specialise wimwam at (ST s), thus + $swimwam :: forall s. ST s -> Int + $swimwam = /\s. body[ST s/a, (dMST @s)/d] + + RULE forall s (d :: M (ST s)). + wimwam @(ST s) d = $swimwam @s + +Here are the moving parts: + +(MP1) We must /not/ dump the CallInfo + CIS wimwam (CI { ci_key = [@(ST s), dMST @s] + , ci_fvs = {dMST} }) + when we come to the /\s. Instead, we simply let it continue to float + upwards. Hence ci_fvs is an IdSet, listing the /Ids/ that + are free in the call, but not the /TyVars/. Hence using specArgFreeIds + in singleCall. + + NB to be fully kosher we should explicitly quantifying the CallInfo + over 's', but we don't bother. This would matter if there was an + enclosing binding of the same 's', which I don't expect to happen. + +(MP2) When we come to specialise the call, we must remember to quantify + over 's'. That is done in the SpecType case of specHeader, where + we add 's' (called qvars) to the binders of the RULE and the specialised + function. + +(MP3) If we have f :: forall m. Monoid m => blah, and two calls + (f @(Endo b) (d1 :: Monoid (Endo b)) + (f @(Endo (c->c)) (d2 :: Monoid (Endo (c->c))) + we want to generate a specialisation only for the first. The second + is just a substitution instance of the first, with no greater specialisation. + Hence the use of `removeDupCalls` in `filterCalls`. + + You might wonder if `d2` might be more specialised than `d1`; but no. + This `removeDupCalls` thing is at the definition site of `f`, and both `d1` + and `d2` are in scope. So `d1` is simply more polymorphic than `d2`, but + is just as specialised. + + This distinction is sadly lost once we build a RULE, so `alreadyCovered` + can't be so clever. E.g if we have an existing RULE + forall @a (d1:Ord Int) (d2: Eq a). f @a @Int d1 d2 = ... + and a putative new rule + forall (d1:Ord Int) (d2: Eq Int). f @Int @Int d1 d2 = ... + we /don't/ want the existing rule to subsume the new one. + + So we sadly put up with having two rather different places where we + eliminate duplicates: `alreadyCovered` and `removeDupCalls`. + +All this arose in #13873, in the unexpected form that a SPECIALISE +pragma made the program slower! The reason was that the specialised +function $sinsertWith arising from the pragma looked rather like `f` +above, and failed to specialise a call in its body like wimwam. +Without the pragma, the original call to `insertWith` was completely +monomorpic, and specialised in one go. + +Wrinkles. + +* See Note [Weird special case for SpecDict] + +* With -XOverlappingInstances you might worry about this: + class C a where ... + instance C (Maybe Int) where ... -- $df1 :: C (Maybe Int) + instance C (Maybe a) where ... -- $df2 :: forall a. C (Maybe a) + + f :: C a => blah + f = rhs + + g = /\a. ...(f @(Maybe a) ($df2 a))... + h = ...f @(Maybe Int) $df1 + + There are two calls to f, but with different evidence. This patch will + combine them into one. But it's OK: this code will never arise unless you + use -XIncoherentInstances. Even with -XOverlappingInstances, GHC tries hard + to keep dictionaries as singleton types. But that goes out of the window + with -XIncoherentInstances -- and that is true even with ordianry type-class + specialisation (at least if any inlining has taken place). + + GHC makes very few guarantees when you use -XIncoherentInstances, and its + not worth crippling the normal case for the incoherent corner. (The best + thing might be to switch off specialisation altogether if incoherence is + involved... but incoherence is a property of an instance, not a class, so + it's a hard test to make.) + + But see Note [Specialisation and overlapping instances]. + +Note [Weird special case for SpecDict] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we are trying to specialise for this this call: + $wsplit @T (mkD @k @(a::k) :: C T) +where + mkD :: forall k (a::k). C T +is a top-level dictionary-former. This actually happened in #22459, +because of (MP1) of Note [Specialising polymorphic dictionaries]. + +How can we specialise $wsplit? We might try + + RULE "SPEC" forall (d :: C T). $wsplit @T d = $s$wsplit + +but then in the body of $s$wsplit what will we use for the dictionary +evidence? We can't use (mkD @k @(a::k)) because k and a aren't in scope. +We could zap `k` to (Any @Type) and `a` to (Any @(Any @Type)), but that +is a lot of hard work for a very strange case. + +So we simply refrain from specialising in this case; hence the guard + allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d) +in the SpecDict cased of specHeader. + +How did this strange polymorphic mkD arise in the first place? +From GHC.Core.Opt.Utils.abstractFloats, which was abstracting +over too many type variables. But that too is now fixed; +see Note [Which type variables to abstract over] in that module. +-} + +instance Outputable DictBind where + ppr (DB { db_bind = bind, db_fvs = fvs }) + = text "DB" <+> braces (sep [ text "fvs: " <+> ppr fvs + , text "bind:" <+> ppr bind ]) + +instance Outputable UsageDetails where + ppr (MkUD { ud_binds = dbs, ud_calls = calls }) + = text "MkUD" <+> braces (sep (punctuate comma + [text "binds" <+> equals <+> ppr dbs, + text "calls" <+> equals <+> ppr calls])) + +instance Outputable FloatedDictBinds where + ppr (FDB { fdb_binds = binds }) = ppr binds + +emptyUDs :: UsageDetails +emptyUDs = MkUD { ud_binds = emptyFDBs, ud_calls = emptyDVarEnv } + + +emptyFDBs :: FloatedDictBinds +emptyFDBs = FDB { fdb_binds = nilOL, fdb_bndrs = emptyVarSet } + +------------------------------------------------------------ +type CallDetails = DIdEnv CallInfoSet + -- The order of specialized binds and rules depends on how we linearize + -- CallDetails, so to get determinism we must use a deterministic set here. + -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM + +data CallInfoSet = CIS Id (Bag CallInfo) + -- The list of types and dictionaries is guaranteed to + -- match the type of f + -- The Bag may contain duplicate calls (i.e. f @T and another f @T) + -- These dups are eliminated by alreadyCovered in specCalls + +data CallInfo + = CI { ci_key :: [SpecArg] -- Arguments of the call + -- See Note [The (CI-KEY) invariant] + + , ci_fvs :: IdSet -- Free Ids of the ci_key call + -- /not/ including the main id itself, of course + -- NB: excluding tyvars: + -- See Note [Specialising polymorphic dictionaries] + } + +{- Note [The (CI-KEY) invariant] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Invariant (CI-KEY): + In the `ci_key :: [SpecArg]` field of `CallInfo`, + * The list is non-empty + * The least element is always a `SpecDict` + +In this way the RULE has as few args as possible, which broadens its +applicability, since rules only fire when saturated. +-} + +type DictExpr = CoreExpr + +ciSetFilter :: (CallInfo -> Bool) -> CallInfoSet -> CallInfoSet +ciSetFilter p (CIS id a) = CIS id (filterBag p a) + +instance Outputable CallInfoSet where + ppr (CIS fn map) = hang (text "CIS" <+> ppr fn) + 2 (ppr map) + +pprCallInfo :: Id -> CallInfo -> SDoc +pprCallInfo fn (CI { ci_key = key }) + = ppr fn <+> ppr key + +instance Outputable CallInfo where + ppr (CI { ci_key = key, ci_fvs = _fvs }) + = text "CI" <> braces (sep (map ppr key)) + +unionCalls :: CallDetails -> CallDetails -> CallDetails +unionCalls c1 c2 = plusDVarEnv_C unionCallInfoSet c1 c2 + +unionCallInfoSet :: CallInfoSet -> CallInfoSet -> CallInfoSet +unionCallInfoSet (CIS f calls1) (CIS _ calls2) = + CIS f (calls1 `unionBags` calls2) + +callDetailsFVs :: CallDetails -> VarSet +callDetailsFVs calls = + nonDetStrictFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls + -- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering + -- immediately by converting to a nondeterministic set. + +callInfoFVs :: CallInfoSet -> VarSet +callInfoFVs (CIS _ call_info) = + foldr (\(CI { ci_fvs = fv }) vs -> unionVarSet fv vs) emptyVarSet call_info + +getTheta :: [PiTyBinder] -> [PredType] +getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiTyBinder + + +------------------------------------------------------------ +singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails +singleCall spec_env id args + = MkUD {ud_binds = emptyFDBs, + ud_calls = unitDVarEnv id $ CIS id $ + unitBag (CI { ci_key = args + , ci_fvs = fvVarSet call_fvs }) } + where + poly_spec = gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) + + -- With -fpolymorphic-specialisation, keep just local /Ids/ + -- Otherwise, keep /all/ free vars including TyVars + -- See (MP1) in Note [Specialising polymorphic dictionaries] + -- But NB: we don't include the 'id' itself. + call_fvs | poly_spec = specArgsFVs isLocalId args + | otherwise = specArgsFVs isLocalVar args + +mkCallUDs :: SpecEnv -> OutExpr -> [OutExpr] -> UsageDetails +mkCallUDs env fun args + | (_, Var f) <- stripTicksTop tickishFloatable fun -- See Note [Ticks on applications] + = -- pprTraceWith "mkCallUDs" (\res -> vcat [ ppr f, ppr args, ppr res ]) $ + mkCallUDs' env f args + | otherwise + = emptyUDs + +mkCallUDs' :: SpecEnv -> Id -> [OutExpr] -> UsageDetails +mkCallUDs' env f args + | wantCallsFor env f -- We want it, and... + , not (null ci_key) -- this call site has a useful specialisation + = -- pprTrace "mkCallUDs: keeping" _trace_doc + singleCall env f ci_key + + | otherwise -- See also Note [Specialisations already covered] + = -- pprTrace "mkCallUDs: discarding" _trace_doc + emptyUDs + + where + _trace_doc = vcat [ppr f, ppr args, ppr ci_key] + pis = fst $ splitPiTys $ idType f + constrained_tyvars = tyCoVarsOfTypes $ getTheta pis + + ci_key :: [SpecArg] + ci_key = dropWhileEndLE (not . isSpecDict) $ + zipWith mk_spec_arg args pis + -- Establish (CI-KEY): drop trailing args until we get to a SpecDict + + mk_spec_arg :: OutExpr -> PiTyBinder -> SpecArg + mk_spec_arg (Type ty) (Named bndr) + | binderVar bndr `elemVarSet` constrained_tyvars + = SpecType ty + | otherwise + = UnspecType + mk_spec_arg non_type_arg (Named bndr) + = pprPanic "ci_key" $ (ppr non_type_arg $$ ppr bndr) + + -- For "invisibleFunArg", which are the type-class dictionaries, + -- we decide on a case by case basis if we want to specialise + -- on this argument; if so, SpecDict, if not UnspecArg + mk_spec_arg arg (Anon _pred af) + | isInvisibleFunArg af + , interestingDict env arg + -- See Note [Interesting dictionary arguments] + = SpecDict arg + + | otherwise = UnspecArg + +wantCallsFor :: SpecEnv -> Id -> Bool +-- See Note [wantCallsFor] +wantCallsFor _env f + = case idDetails f of + RecSelId {} -> False + DataConWorkId {} -> False + DataConWrapId {} -> False + ClassOpId {} -> False + PrimOpId {} -> False + FCallId {} -> False + TickBoxOpId {} -> False + CoVarId {} -> False + + DFunId {} -> True + VanillaId {} -> True + JoinId {} -> True + WorkerLikeId {} -> True + RepPolyId {} -> True + +interestingDict :: SpecEnv -> CoreExpr -> Bool +-- This is a subtle and important function +-- See Note [Interesting dictionary arguments] +interestingDict env (Var v) -- See (ID3) and (ID5) + | Just rhs <- maybeUnfoldingTemplate (idUnfolding v) + -- Might fail for loop breaker dicts but that seems fine. + = interestingDict env rhs + +interestingDict env arg -- Main Plan: use exprIsConApp_maybe + | Cast inner_arg _ <- arg -- See (ID5) + = if | isConstraintKind $ typeKind $ exprType inner_arg + -- If coercions were always homo-kinded, we'd know + -- that this would be the only case + -> interestingDict env inner_arg + + -- Check for an implicit parameter at the top + | Just (cls,_) <- getClassPredTys_maybe arg_ty + , isIPClass cls -- See (ID5) + -> False + + -- Otherwise we are unwrapping a unary type class + | otherwise + -> exprIsHNF arg -- See (ID7) + + | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg + , Just cls <- tyConClass_maybe (dataConTyCon data_con) + , definitely_not_ip_like -- See (ID4) + = if null (classMethods cls) -- See (ID6) + then any (interestingDict env) args + else True + + | otherwise + = not (exprIsTrivial arg) && definitely_not_ip_like -- See (ID8) + where + arg_ty = exprType arg + definitely_not_ip_like = not (couldBeIPLike arg_ty) + in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding + +{- Note [Ticks on applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticks such as source location annotations can sometimes make their way +onto applications (see e.g. #21697). So if we see something like + + App (Tick _ f) e + +we need to descend below the tick to find what the real function being +applied is. + +The resulting RULE also has to be able to match this annotated use +site, so we only look through ticks that RULE matching looks through +(see Note [Tick annotations in RULE matching] in GHC.Core.Rules). + +Note [wantCallsFor] +~~~~~~~~~~~~~~~~~~~ +`wantCallsFor env f` says whether the Specialiser should collect calls for +function `f`; other thing being equal, the fewer calls we collect the better. It +is False for things we can't specialise: + +* ClassOpId: never inline and we don't have a defn to specialise; we specialise + them through fireRewriteRules. +* PrimOpId: are never overloaded +* Data constructors: we never specialise them + +We could reduce the size of the UsageDetails by being less eager about +collecting calls for some LocalIds: there is no point for ones that are +lambda-bound. We can't decide this by looking at the (absence of an) unfolding, +because unfoldings for local functions are discarded by cloneBindSM, so no local +binder will have an unfolding at this stage. We'd have to keep a candidate set +of let-binders. + +Not many lambda-bound variables have dictionary arguments, so this would make +little difference anyway. + +For imported Ids we could check for an unfolding, but we have to do so anyway in +canSpecImport, and it seems better to have it all in one place. So we simply +collect usage info for imported overloaded functions. + +Note [Interesting dictionary arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this + \a.\d:Eq a. let f = ... in ...(f d)... +There really is not much point in specialising f wrt the dictionary d, +because the code for the specialised f is not improved at all, because +d is lambda-bound. We simply get junk specialisations. + +What is "interesting"? Our Main Plan is to use `exprIsConApp_maybe` to see +if the argument is a dictionary constructor applied to some arguments, in which +case we can clearly specialise. But there are wrinkles: + +(ID1) Note that we look at the argument /term/, not its /type/. Suppose the + argument is + (% d1, d2 %) |> co + where co :: (% Eq [a], Show [a] %) ~ F Int a, and `F` is a type family. + Then its type (F Int a) looks very un-informative, but the term is super + helpful. See #19747 (where missing this point caused a 70x slow down) + and #7785. + +(ID2) Note that the Main Plan works fine for an argument that is a DFun call, + e.g. $fOrdList $dOrdInt + because `exprIsConApp_maybe` cleverly deals with DFunId applications. Good! + +(ID3) For variables, we look in the variable's /unfolding/. And that means + that we must be careful to ensure that dictionaries /have/ unfoldings: + * cloneBndrSM discards non-Stable unfoldings + * specBind updates the unfolding after specialisation + See Note [Update unfolding after specialisation] + * bindAuxiliaryDict adds an unfolding for an aux dict + see Note [Specialisation modulo dictionary selectors] + * specCase adds unfoldings for the new bindings it creates + + We accidentally lost accurate tracking of local variables for a long + time, because cloned variables didn't have unfoldings. But makes a + massive difference in a few cases, eg #5113. For nofib as a + whole it's only a small win: 2.2% improvement in allocation for ansi, + 1.2% for bspt, but mostly 0.0! Average 0.1% increase in binary size. + +(ID4) We must be very careful not to specialise on a "dictionary" that is, or contains + an implicit parameter, because implicit parameters are emphatically not singleton + types. See #25999: + useImplicit :: (?i :: Int) => Int + useImplicit = ?i + 1 + + foo = let ?i = 1 in (useImplicit, let ?i = 2 in useImplicit) + Both calls to `useImplicit` are at type `?i::Int`, but they pass different values. + We must not specialise on implicit parameters! Hence the call to `couldBeIPLike` + in `definitely_not_ip_like`. + +(ID5) Suppose the argument is (e |> co). Can we rely on `exprIsConApp_maybe` to deal + with the coercion. No! That only works if (co :: C t1 ~ C t2) with the same type + constructor at the top of both sides. But see the example in (ID1), where that + is not true. For the same reason, we can't rely on `exprIsConApp_maybe` to look + through unfoldings (because there might be a cast inside), hence dealing with + expandable unfoldings in `interestingDict` directly. + + For the same reasons as in (ID4), we must take care to not allow an implicit + parameter to sneak through, so we must not unwrap the newtype cast for the + unary IP class; hence the `isIPClass` call. (We don't need to call + `couldBeIPLike`, as implicit parameters hidden behind a type family are + detected by the recursive call to `interestingDict` on the argument inside the + cast.) + +(ID6) The Main Plan says that it's worth specialising if the argument is an application + of a dictionary contructor. But what if the dictionary has no methods? Then we + gain nothing by specialising, unless the /superclasses/ are interesting. A case + in point is constraint tuples (% d1, .., dn %); a constraint N-tuple is a class + with N superclasses and no methods. + +(ID7) A unary (single-method) class is currently represented by (meth |> co). We + will unwrap the cast (see (ID5)) and then want to reply "yes" if the method + has any struture. We rather arbitrarily use `exprIsHNF` for this. (We plan a + new story for unary classes, see #23109, and this special case will become + irrelevant.) + +(ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a + non-trivial argument as interesting. In T19695 we have this: + askParams :: Monad m => blah + mhelper :: MonadIO m => blah + mhelper (d:MonadIO m) = ...(askParams @m ($p1 d)).... + where `$p1` is the superclass selector for `MonadIO`. Now, if `mhelper` is + specialised at `Handler` we'll get this call in the specialised `$smhelper`: + askParams @Handler ($p1 $fMonadIOHandler) + and we /definitely/ want to specialise that, even though the argument isn't + visibly a dictionary application. In fact the specialiser fires the superclass + selector rule (see Note [Fire rules in the specialiser]), so we get + askParams @Handler ($cp1MonadIO $fMonadIOIO) + but it /still/ doesn't look like a dictionary application. + + Conclusion: we optimistically assume that any non-trivial argument is worth + specialising on. + + So why do the `exprIsConApp_maybe` and `Cast` stuff? Because we want to look + under type-family casts (ID1) and constraint tuples (ID6). + +Note [Update unfolding after specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#21848) + + wombat :: Show b => Int -> b -> String + wombat a b | a>0 = wombat (a-1) b + | otherwise = show a ++ wombat a b + + class C a where + meth :: Show b => a -> b -> String + dummy :: a -> () -- Force a datatype dictionary representation + + instance C Int where + meth = wombat + dummy _ = () + + class C a => D a -- D has C as a superclass + instance D Int + + f :: (D a, Show b) => a -> b -> String + {-# INLINABLE[0] f #-} + f a b = meth a b ++ "!" ++ meth a b + +Now `f` turns into: + + f @a @b (dd :: D a) (ds :: Show b) a b + + = let dc :: D a = %p1 dd -- Superclass selection + in meth @a dc .... + meth @a dc .... + +When we specialise `f`, at a=Int say, that superclass selection can +fire (via rewiteClassOps), but that info (that 'dc' is now a +particular dictionary `C`, of type `C Int`) must be available to +the call `meth @a dc`, so that we can fire the `meth` class-op, and +thence specialise `wombat`. + +We deliver on this idea by updating the unfolding for the binder +in the NonRec case of specBind. (This is too exotic to trouble with +the Rec case.) +-} + +thenUDs :: UsageDetails -> UsageDetails -> UsageDetails +thenUDs (MkUD {ud_binds = db1, ud_calls = calls1}) + (MkUD {ud_binds = db2, ud_calls = calls2}) + = MkUD { ud_binds = db1 `thenFDBs` db2 + , ud_calls = calls1 `unionCalls` calls2 } + +thenFDBs :: FloatedDictBinds -> FloatedDictBinds -> FloatedDictBinds +-- Combine FloatedDictBinds +-- In (dbs1 `thenFDBs` dbs2), dbs2 may mention dbs1 but not vice versa +thenFDBs (FDB { fdb_binds = dbs1, fdb_bndrs = bs1 }) + (FDB { fdb_binds = dbs2, fdb_bndrs = bs2 }) + = FDB { fdb_binds = dbs1 `appOL` dbs2 + , fdb_bndrs = bs1 `unionVarSet` bs2 } + +----------------------------- +_dictBindBndrs :: OrdList DictBind -> [Id] +_dictBindBndrs dbs = foldr ((++) . bindersOf . db_bind) [] dbs + +-- | Construct a 'DictBind' from a 'CoreBind' +mkDB :: CoreBind -> DictBind +mkDB bind = DB { db_bind = bind, db_fvs = bind_fvs bind } + +-- | Identify the free variables of a 'CoreBind' +bind_fvs :: CoreBind -> VarSet +bind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs) +bind_fvs (Rec prs) = rhs_fvs `delVarSetList` (map fst prs) + where + rhs_fvs = unionVarSets (map pair_fvs prs) + +pair_fvs :: (Id, CoreExpr) -> VarSet +pair_fvs (bndr, rhs) = exprSomeFreeVars interesting rhs + `unionVarSet` idFreeVars bndr + -- idFreeVars: don't forget variables mentioned in + -- the rules of the bndr. C.f. OccAnal.addRuleUsage + -- Also tyvars mentioned in its type; they may not appear + -- in the RHS + -- type T a = Int + -- x :: T a = 3 + where + interesting :: InterestingVarFun + interesting v = isLocalVar v || (isId v && isDFunId v) + -- Very important: include DFunIds /even/ if it is imported + -- Reason: See Note [Avoiding loops in specImports], the #13429 + -- example involving an imported dfun. We must know + -- whether a dictionary binding depends on an imported + -- DFun in case we try to specialise that imported DFun + +-- | Flatten a set of "dumped" 'DictBind's, and some other binding +-- pairs, into a single recursive binding. +recWithDumpedDicts :: [(Id,CoreExpr)] -> OrdList DictBind -> DictBind +recWithDumpedDicts pairs dbs + = DB { db_bind = Rec bindings + , db_fvs = fvs `delVarSetList` map fst bindings } + where + (bindings, fvs) = foldr add ([], emptyVarSet) + (dbs `snocOL` mkDB (Rec pairs)) + add (DB { db_bind = bind, db_fvs = fvs }) (prs_acc, fvs_acc) + = case bind of + NonRec b r -> ((b,r) : prs_acc, fvs') + Rec prs1 -> (prs1 ++ prs_acc, fvs') + where + fvs' = fvs_acc `unionVarSet` fvs + +snocDictBind :: UsageDetails -> DictBind -> UsageDetails +snocDictBind uds@MkUD{ud_binds= FDB { fdb_binds = dbs, fdb_bndrs = bs }} db + = uds { ud_binds = FDB { fdb_binds = dbs `snocOL` db + , fdb_bndrs = bs `extendVarSetList` bindersOfDictBind db } } + +snocDictBinds :: UsageDetails -> [DictBind] -> UsageDetails +-- Add ud_binds to the tail end of the bindings in uds +snocDictBinds uds@MkUD{ud_binds=FDB{ fdb_binds = binds, fdb_bndrs = bs }} dbs + = uds { ud_binds = FDB { fdb_binds = binds `appOL` (toOL dbs) + , fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } } + +consDictBinds :: [DictBind] -> UsageDetails -> UsageDetails +consDictBinds dbs uds@MkUD{ud_binds=FDB{fdb_binds = binds, fdb_bndrs = bs}} + = uds { ud_binds = FDB{ fdb_binds = toOL dbs `appOL` binds + , fdb_bndrs = bs `extendVarSetList` bindersOfDictBinds dbs } } + +wrapDictBinds :: FloatedDictBinds -> [CoreBind] -> [CoreBind] +wrapDictBinds (FDB { fdb_binds = dbs }) binds + = foldr add binds dbs + where + add (DB { db_bind = bind }) binds = bind : binds + +wrapDictBindsE :: OrdList DictBind -> CoreExpr -> CoreExpr +wrapDictBindsE dbs expr + = foldr add expr dbs + where + add (DB { db_bind = bind }) expr = Let bind expr + +---------------------- +dumpUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind) +-- Used at a lambda or case binder; just dump anything mentioning the binder +dumpUDs bndrs uds@(MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }) + | null bndrs = (uds, nilOL) -- Common in case alternatives + | otherwise = -- pprTrace "dumpUDs" (vcat + -- [ text "bndrs" <+> ppr bndrs + -- , text "uds" <+> ppr uds + -- , text "free_uds" <+> ppr free_uds + -- , text "dump-dbs" <+> ppr dump_dbs ]) $ + (free_uds, dump_dbs) + where + free_uds = uds { ud_binds = free_dbs, ud_calls = free_calls } + bndr_set = mkVarSet bndrs + (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set + free_calls = deleteCallsMentioning dump_set $ -- Drop calls mentioning bndr_set on the floor + deleteCallsFor bndrs orig_calls -- Discard calls for bndr_set; there should be + -- no calls for any of the dicts in dump_dbs + +dumpBindUDs :: [CoreBndr] -> UsageDetails -> (UsageDetails, OrdList DictBind, Bool) +-- Used at a let(rec) binding. +-- We return a boolean indicating whether the binding itself is mentioned, +-- directly or indirectly, by any of the ud_calls; in that case we want to +-- float the binding itself; +-- See Note [Floated dictionary bindings] +dumpBindUDs bndrs (MkUD { ud_binds = orig_dbs, ud_calls = orig_calls }) + = -- pprTrace "dumpBindUDs" (ppr bndrs $$ ppr free_uds $$ ppr dump_dbs $$ ppr float_all) $ + (free_uds, dump_dbs, float_all) + where + free_uds = MkUD { ud_binds = free_dbs, ud_calls = free_calls } + bndr_set = mkVarSet bndrs + (free_dbs, dump_dbs, dump_set) = splitDictBinds orig_dbs bndr_set + free_calls = deleteCallsFor bndrs orig_calls + float_all = dump_set `intersectsVarSet` callDetailsFVs free_calls + +callsForMe :: Id -> UsageDetails -> (UsageDetails, [CallInfo]) +callsForMe fn uds@MkUD { ud_binds = orig_dbs, ud_calls = orig_calls } + = -- pprTrace ("callsForMe") + -- (vcat [ppr fn, + -- text "Orig dbs =" <+> ppr (_dictBindBndrs orig_dbs), + -- text "Orig calls =" <+> ppr orig_calls, + -- text "Calls for me =" <+> ppr calls_for_me]) $ + (uds_without_me, calls_for_me) + where + uds_without_me = uds { ud_calls = delDVarEnv orig_calls fn } + calls_for_me = case lookupDVarEnv orig_calls fn of + Nothing -> [] + Just cis -> filterCalls cis orig_dbs + +---------------------- +filterCalls :: CallInfoSet -> FloatedDictBinds -> [CallInfo] +-- Remove +-- (a) dominated calls: (MP3) in Note [Specialising polymorphic dictionaries] +-- (b) loopy DFuns: Note [Avoiding loops (DFuns)] +filterCalls (CIS fn call_bag) (FDB { fdb_binds = dbs }) + | isDFunId fn = filter ok_call de_dupd_calls -- Deals with (b) + | otherwise = de_dupd_calls + where + de_dupd_calls = removeDupCalls call_bag -- Deals with (a) + + dump_set = foldl' go (unitVarSet fn) dbs + -- This dump-set could also be computed by splitDictBinds + -- (_,_,dump_set) = splitDictBinds dbs {fn} + -- But this variant is shorter + + go so_far (DB { db_bind = bind, db_fvs = fvs }) + | fvs `intersectsVarSet` so_far + = extendVarSetList so_far (bindersOf bind) + | otherwise = so_far + + ok_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` dump_set + +removeDupCalls :: Bag CallInfo -> [CallInfo] +-- Calls involving more generic instances beat more specific ones. +-- See (MP3) in Note [Specialising polymorphic dictionaries] +removeDupCalls calls = foldr add [] calls + where + add :: CallInfo -> [CallInfo] -> [CallInfo] + add ci [] = [ci] + add ci1 (ci2:cis) | ci2 `beats_or_same` ci1 = ci2:cis + | ci1 `beats_or_same` ci2 = ci1:cis + | otherwise = ci2 : add ci1 cis + +beats_or_same :: CallInfo -> CallInfo -> Bool +-- (beats_or_same ci1 ci2) is True if specialising on ci1 subsumes ci2 +-- That is: ci1's types are less specialised than ci2 +-- ci1 specialises on the same dict args as ci2 +beats_or_same (CI { ci_key = args1 }) (CI { ci_key = args2 }) + = go args1 args2 + where + go [] [] = True + go (arg1:args1) (arg2:args2) = go_arg arg1 arg2 && go args1 args2 + + -- If one or the other runs dry, the other must still have a SpecDict + -- because of the (CI-KEY) invariant. So neither subsumes the other; + -- one is more specialised (faster code) but the other is more generally + -- applicable. + go _ _ = False + + go_arg (SpecType ty1) (SpecType ty2) = isJust (tcMatchTy ty1 ty2) + go_arg (SpecDict {}) (SpecDict {}) = True + go_arg UnspecType UnspecType = True + go_arg UnspecArg UnspecArg = True + go_arg _ _ = False + +---------------------- +splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet) +-- splitDictBinds dbs bndrs returns +-- (free_dbs, dump_dbs, dump_set) +-- where +-- * dump_dbs depends, transitively on bndrs +-- * free_dbs does not depend on bndrs +-- * dump_set = bndrs `union` bndrs(dump_dbs) +splitDictBinds (FDB { fdb_binds = dbs, fdb_bndrs = bs }) bndr_set + = (FDB { fdb_binds = free_dbs + , fdb_bndrs = bs `minusVarSet` dump_set } + , dump_dbs, dump_set) + where + (free_dbs, dump_dbs, dump_set) + = foldl' split_db (nilOL, nilOL, bndr_set) dbs + -- Important that it's foldl' not foldr; + -- we're accumulating the set of dumped ids in dump_set + + split_db (free_dbs, dump_dbs, dump_idset) db + | DB { db_bind = bind, db_fvs = fvs } <- db + , dump_idset `intersectsVarSet` fvs -- Dump it + = (free_dbs, dump_dbs `snocOL` db, + extendVarSetList dump_idset (bindersOf bind)) + + | otherwise -- Don't dump it + = (free_dbs `snocOL` db, dump_dbs, dump_idset) + + +---------------------- +deleteCallsMentioning :: VarSet -> CallDetails -> CallDetails +-- Remove calls mentioning any Id in bndrs +-- NB: The call is allowed to mention TyVars in bndrs +-- Note [Specialising polymorphic dictionaries] +-- ci_fvs are just the free /Ids/ +deleteCallsMentioning bndrs calls + = mapDVarEnv (ciSetFilter keep_call) calls + where + keep_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` bndrs + +deleteCallsFor :: [Id] -> CallDetails -> CallDetails +-- Remove calls *for* bndrs +deleteCallsFor bndrs calls = delDVarEnvList calls bndrs + +{- +************************************************************************ +* * +\subsubsection{Boring helper functions} +* * +************************************************************************ +-} + +type SpecM a = UniqSM a + +runSpecM :: SpecM a -> CoreM a +runSpecM thing_inside + = do { us <- getUniqueSupplyM + ; return (initUs_ us thing_inside) } + +mapAndCombineSM :: (a -> SpecM (b, UsageDetails)) -> [a] -> SpecM ([b], UsageDetails) +mapAndCombineSM _ [] = return ([], emptyUDs) +mapAndCombineSM f (x:xs) = do (y, uds1) <- f x + (ys, uds2) <- mapAndCombineSM f xs + return (y:ys, uds1 `thenUDs` uds2) + +-- extendTvSubst :: SpecEnv -> TyVar -> Type -> SpecEnv +-- extendTvSubst env tv ty +-- = env { se_subst = Core.extendTvSubst (se_subst env) tv ty } + +extendInScope :: SpecEnv -> OutId -> SpecEnv +extendInScope env@(SE { se_subst = subst }) bndr + = env { se_subst = subst `Core.extendSubstInScope` bndr } + +zapSubst :: SpecEnv -> SpecEnv +zapSubst env@(SE { se_subst = subst }) + = env { se_subst = Core.zapSubst subst } + +substTy :: SpecEnv -> Type -> Type +substTy env ty = substTyUnchecked (se_subst env) ty + +substCo :: SpecEnv -> Coercion -> Coercion +substCo env co = Core.substCo (se_subst env) co + +substBndr :: SpecEnv -> CoreBndr -> (SpecEnv, CoreBndr) +substBndr env bs = case Core.substBndr (se_subst env) bs of + (subst', bs') -> (env { se_subst = subst' }, bs') + +substBndrs :: Traversable f => SpecEnv -> f CoreBndr -> (SpecEnv, f CoreBndr) +substBndrs env bs = case Core.substBndrs (se_subst env) bs of + (subst', bs') -> (env { se_subst = subst' }, bs') + +cloneBndrSM :: SpecEnv -> Id -> SpecM (SpecEnv, Id) +-- Clone the binders of the bind; return new bind with the cloned binders +-- Return the substitution to use for RHSs, and the one to use for the body +-- Discards non-Stable unfoldings +cloneBndrSM env@(SE { se_subst = subst }) bndr + = do { us <- getUniqueSupplyM + ; let (subst', bndr') = Core.cloneIdBndr subst us bndr + ; return (env { se_subst = subst' }, bndr') } + +cloneRecBndrsSM :: SpecEnv -> [Id] -> SpecM (SpecEnv, [Id]) +cloneRecBndrsSM env@(SE { se_subst = subst }) bndrs + = do { (subst', bndrs') <- Core.cloneRecIdBndrsM subst bndrs + ; let env' = env { se_subst = subst' } + ; return (env', bndrs') } newSpecIdSM :: Name -> Type -> IdDetails -> IdInfo -> SpecM Id -- Give the new Id a similar occurrence name to the old one diff --git a/GHC/Core/Opt/StaticArgs.hs b/GHC/Core/Opt/StaticArgs.hs --- a/GHC/Core/Opt/StaticArgs.hs +++ b/GHC/Core/Opt/StaticArgs.hs @@ -111,7 +111,7 @@ let (binders, rhss) = unzip pairs rhss_SATed <- mapM (\e -> satTopLevelExpr e interesting_ids) rhss let (rhss', sat_info_rhss') = unzip rhss_SATed - return (Rec (zipEqual "satBind" binders rhss'), mergeIdSATInfos sat_info_rhss') + return (Rec (zipEqual binders rhss'), mergeIdSATInfos sat_info_rhss') data App = VarApp Id | TypeApp Type | CoApp Coercion data Staticness a = Static a | NotStatic diff --git a/GHC/Core/Opt/WorkWrap.hs b/GHC/Core/Opt/WorkWrap.hs --- a/GHC/Core/Opt/WorkWrap.hs +++ b/GHC/Core/Opt/WorkWrap.hs @@ -176,9 +176,8 @@ mischief.) Notice that we refrain from w/w'ing an INLINE function even if it is -in a recursive group. It might not be the loop breaker. (We used to -test for loop-breaker-hood, but see (CWW4) in Note [Cast worker/wrapper] -in GHC.Core.Opt.Simplify.Iteration.) +in a recursive group. It might not be the loop breaker. (We could +test for loop-breaker-hood, but I'm not sure that ever matters.) Note [Worker/wrapper for INLINABLE functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/Core/Opt/WorkWrap/Utils.hs b/GHC/Core/Opt/WorkWrap/Utils.hs --- a/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/GHC/Core/Opt/WorkWrap/Utils.hs @@ -16,6 +16,7 @@ , mkAbsentFiller , isWorkerSmallEnough, dubiousDataConInstArgTys , boringSplit, usefulSplit, workWrapArity + , canUnboxType, canUnboxTyCon ) where @@ -32,6 +33,7 @@ import GHC.Core.Predicate( isDictTy ) import GHC.Core.Reduction import GHC.Core.FamInstEnv +import GHC.Core.Predicate( isEqualityClass ) import GHC.Core.TyCon import GHC.Core.TyCon.Set import GHC.Core.TyCon.RecWalk @@ -218,7 +220,7 @@ ; let args_free_tcvs = tyCoVarsOfTypes (res_ty : map varType arg_vars) empty_subst = mkEmptySubst (mkInScopeSet args_free_tcvs) zapped_arg_vars = map zap_var arg_vars - ; (subst, cloned_arg_vars) <- cloneBndrs empty_subst zapped_arg_vars + ; (subst, cloned_arg_vars) <- cloneBndrsM empty_subst zapped_arg_vars ; let res_ty' = substTyUnchecked subst res_ty init_str_marks = map (const NotMarkedStrict) cloned_arg_vars @@ -611,7 +613,7 @@ -- 's' will be 'Demand' or 'Cpr'. data DataConPatContext s = DataConPatContext - { dcpc_dc :: !DataCon + { dcpc_dc :: !DataCon -- INVARIANT: canUnboxTyCon is true of this DataCon's tycon , dcpc_tc_args :: ![Type] , dcpc_co :: !Coercion , dcpc_args :: ![s] @@ -664,7 +666,7 @@ -- From here we are strict and not absent | Just (tc, tc_args, co) <- normSplitTyConApp_maybe fam_envs ty - , Just dc <- tyConSingleAlgDataCon_maybe tc + , Just [dc] <- canUnboxTyCon tc -- tc is never a newtype , let arity = dataConRepArity dc , Just (Unboxed, dmds) <- viewProd arity sd -- See Note [Boxity analysis] , dmds `lengthIs` dataConRepArity dc @@ -682,7 +684,7 @@ canUnboxResult fam_envs ty cpr | Just (con_tag, arg_cprs) <- asConCpr cpr , Just (tc, tc_args, co) <- normSplitTyConApp_maybe fam_envs ty - , Just dcs <- tyConAlgDataCons_maybe tc <|> open_body_ty_warning + , Just dcs <- canUnboxTyCon tc <|> open_body_ty_warning , dcs `lengthAtLeast` con_tag -- This might not be true if we import the -- type constructor via a .hs-boot file (#8743) , let dc = dcs `getNth` (con_tag - fIRST_TAG) @@ -702,8 +704,101 @@ -- See Note [non-algebraic or open body type warning] open_body_ty_warning = warnPprTrace True "canUnboxResult: non-algebraic or open body type" (ppr ty) Nothing -{- Note [Which types are unboxed?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +canUnboxType :: HasDebugCallStack => Type -> Maybe [DataCon] +canUnboxType arg_ty = case tyConAppTyCon_maybe arg_ty of + Just tc -> canUnboxTyCon tc + Nothing -> Nothing + +canUnboxTyCon :: HasDebugCallStack => TyCon -> Maybe [DataCon] +-- True for +-- boxed algebraic datatypes +-- unboxed tuples and sums +-- +-- False for +-- class dictionaries, except equality classes and tuples +-- See Note [Do not unbox class dictionaries] +-- +-- Precondition: tc is not a newtype +canUnboxTyCon tc + | Just cls <- tyConClass_maybe tc + , not (isEqualityClass cls) + = Nothing -- See (DNB2) and (DNB1) in Note [Do not unbox class dictionaries] + + | otherwise + = assertPpr (not (isNewTyCon tc)) (ppr tc) $ -- Check precondition + tyConDataCons_maybe tc + +{- Note [Do not unbox class dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never unbox class dictionaries in worker/wrapper. + +1. INLINABLE functions + If we have + f :: Ord a => [a] -> Int -> a + {-# INLINABLE f #-} + and we worker/wrapper f, we'll get a worker with an INLINABLE pragma + (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap), + which can still be specialised by the type-class specialiser, something like + fw :: Ord a => [a] -> Int# -> a + + BUT if f is strict in the Ord dictionary, we might unpack it, to get + fw :: (a->a->Bool) -> [a] -> Int# -> a + and the type-class specialiser can't specialise that. An example is #6056. + + Historical note: #14955 describes how I got this fix wrong the first time. + I got aware of the issue in T5075 by the change in boxity of loop between + demand analysis runs. + +2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur + occur without INLINABLE, when we use -fexpose-all-unfoldings and + -fspecialise-aggressively to do vigorous cross-module specialisation. + +3. #18421 found that unboxing a dictionary can also make the worker less likely + to inline; the inlining heuristics seem to prefer to inline a function + applied to a dictionary over a function applied to a bunch of functions. + +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing +a raft of higher-order functions isn't a huge win anyway -- you really want to +specialise the function. + +Wrinkle (DNB1): we /do not/ to unbox tuple dictionaries either. We used to + have a special case to unbox tuple dictionaries (#23398), but it ultimately + turned out to be a very bad idea (see !19747#note_626297). In summary: + + - If w/w unboxes tuple dictionaries we get things like + case d of CTuple2 d1 d2 -> blah + rather than + let { d1 = sc_sel1 d; d2 = sc_sel2 d } in blah + The latter works much better with the specialiser: when `d` is instantiated + to some useful dictionary the `sc_sel1 d` selection can fire. + + - The attempt to deal with unpacking dictionaries with `case` led to + significant extra complexity in the type-class specialiser (#26158) that is + rendered unnecessary if we only take do superclass selection with superclass + selectors, never with `case` expressions. + + Even with that extra complexity, specialisation was /still/ sometimes worse, + and sometimes /tremendously/ worse (a factor of 70x); see #19747. + + - Suppose f :: forall a. (% Eq a, Show a %) => blah + The specialiser is perfectly capable of specialising a call like + f @Int (% dEqInt, dShowInt %) + so the tuple doesn't get in the way. + + - It's simpler and more uniform. There is nothing special about constraint + tuples; anyone can write class (C1 a, C2 a) => D a where {} + +Wrinkle (DNB2): we /do/ want to unbox equality dictionaries, + for (~), (~~), and Coercible (#23398). Their payload is a single unboxed + coercion. We never want to specialise on `(t1 ~ t2)`. All that would do is + to make a copy of the function's RHS with a particular coercion. Unlike + normal class methods, that does not unlock any new optimisation + opportunities in the specialised RHS. + +Note [Which types are unboxed?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Worker/wrapper will unbox 1. A strict data type argument, that @@ -835,7 +930,7 @@ before calling the partially applied function. But this would be neither a small nor simple change so we stick with A) and a flag for B) for now. -See also Note [Tag Inference] and Note [CBV Function Ids] +See also Note [EPT enforcement] and Note [CBV Function Ids] Note [Worker/wrapper for strict arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -861,7 +956,7 @@ The worker `$wf` is a CBV function (see `Note [CBV Function Ids]` in GHC.Types.Id.Info) and the code generator guarantees that every -call to `$wf` has a properly tagged argument (see `GHC.Stg.InferTags.Rewrite`). +call to `$wf` has a properly tagged argument (see `GHC.Stg.EnforceEpt.Rewrite`). Is this a win? Not always: * It can cause slight codesize increases. This is since we push evals to every @@ -984,7 +1079,7 @@ -- don't end up in lambda binders of the worker. -- See Note [Never put `OtherCon` unfoldings on lambda binders] arg_ids' = map zapIdUnfolding $ - zipWithEqual "unbox_one_arg" setIdDemandInfo arg_ids ds + zipWithEqual setIdDemandInfo arg_ids ds unbox_fn = mkUnpackCase (Var arg_var) co (idMult arg_var) dc (ex_tvs' ++ arg_ids') @@ -1352,7 +1447,8 @@ | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args = go rec_tc rhs - | Just con <- tyConSingleAlgDataCon_maybe tc + | not (isNewTyCon tc) + , Just con <- tyConSingleDataCon_maybe tc , Just rec_tc <- if isTupleTyCon tc then Just rec_tc else checkRecTc rec_tc tc diff --git a/GHC/Core/PatSyn.hs b/GHC/Core/PatSyn.hs --- a/GHC/Core/PatSyn.hs +++ b/GHC/Core/PatSyn.hs @@ -12,7 +12,8 @@ PatSyn, PatSynMatcher, PatSynBuilder, mkPatSyn, -- ** Type deconstruction - patSynName, patSynArity, patSynIsInfix, patSynResultType, + patSynName, patSynArity, patSynVisArity, + patSynIsInfix, patSynResultType, isVanillaPatSyn, patSynArgs, patSynMatcher, patSynBuilder, @@ -421,6 +422,13 @@ -- | Arity of the pattern synonym patSynArity :: PatSyn -> Arity patSynArity = psArity + +-- | Number of visible arguments of the pattern synonym +patSynVisArity :: PatSyn -> VisArity +patSynVisArity ps = n_of_required_ty_args + n_of_val_args + where + n_of_val_args = psArity ps + n_of_required_ty_args = 0 -- no visible forall in pattern synonyms yet (#23704) -- | Is this a \'vanilla\' pattern synonym (no existentials, no provided constraints)? isVanillaPatSyn :: PatSyn -> Bool diff --git a/GHC/Core/Ppr.hs b/GHC/Core/Ppr.hs --- a/GHC/Core/Ppr.hs +++ b/GHC/Core/Ppr.hs @@ -694,10 +694,10 @@ ppr modl, comma, ppr ix, text ">"] - ppr (Breakpoint _ext ix vars modl) = + ppr (Breakpoint _ext bid vars) = hcat [text "break<", - ppr modl, comma, - ppr ix, + ppr (bi_tick_mod bid), comma, + ppr (bi_tick_index bid), text ">", parens (hcat (punctuate comma (map ppr vars)))] ppr (ProfNote { profNoteCC = cc, diff --git a/GHC/Core/Predicate.hs b/GHC/Core/Predicate.hs --- a/GHC/Core/Predicate.hs +++ b/GHC/Core/Predicate.hs @@ -8,50 +8,117 @@ module GHC.Core.Predicate ( Pred(..), classifyPredType, - isPredTy, isEvVarType, + isPredTy, isSimplePredTy, -- Equality predicates EqRel(..), eqRelRole, - isEqPrimPred, isNomEqPred, isReprEqPrimPred, isEqPred, isCoVarType, + isEqPred, isReprEqPred, isEqClassPred, isCoVarType, getEqPredTys, getEqPredTys_maybe, getEqPredRole, - predTypeEqRel, - mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole, - mkNomPrimEqPred, + predTypeEqRel, pprPredType, + mkNomEqPred, mkReprEqPred, mkEqPred, mkEqPredRole, -- Class predicates mkClassPred, isDictTy, typeDeterminesValue, - isClassPred, isEqualityClass, isCTupleClass, + isClassPred, isEqualityClass, isCTupleClass, isUnaryClass, getClassPredTys, getClassPredTys_maybe, classMethodTy, classMethodInstTy, -- Implicit parameters - isIPLikePred, mentionsIP, isIPTyCon, isIPClass, + couldBeIPLike, mightMentionIP, isIPTyCon, isIPClass, decomposeIPPred, isCallStackTy, isCallStackPred, isCallStackPredTy, isExceptionContextPred, isExceptionContextTy, isIPPred_maybe, -- Evidence variables - DictId, isEvVar, isDictId + DictId, isEvId, isDictId, + -- * Well-scoped free variables + scopedSort, tyCoVarsOfTypeWellScoped, + tyCoVarsOfTypesWellScoped, + + -- Equality left-hand sides + CanEqLHS(..), canEqLHS_maybe, canTyFamEqLHS_maybe, + canEqLHSKind, canEqLHSType, eqCanEqLHS + ) where import GHC.Prelude import GHC.Core.Type import GHC.Core.Class +import GHC.Core.TyCo.Compare( tcEqTyConApps ) +import GHC.Core.TyCo.FVs( tyCoVarsOfTypeList, tyCoVarsOfTypesList ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk +import GHC.Types.Name( getOccName ) import GHC.Types.Var -import GHC.Core.Coercion +import GHC.Types.Var.Set import GHC.Core.Multiplicity ( scaledThing ) import GHC.Builtin.Names +import GHC.Builtin.Types.Prim( eqPrimTyCon, eqReprPrimTyCon ) import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Data.FastString + +{- ********************************************************************* +* * +* Pred and PredType * +* * +********************************************************************* -} + +{- Note [Types for coercions, predicates, and evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A "predicate" or "predicate type", + type synonym `PredType` + returns True to `isPredTy` +is any type of kind (CONSTRAINT r) for some `r`. + + (a) A "class predicate" (aka dictionary type) is the type of a (boxed) + type-class dictionary + Test: isDictTy + Binders: DictIds + Kind: Constraint + Examples: (Eq a), and (a ~ b) + + (b) An "equality predicate" is a primitive, unboxed equalities + Test: isEqPred + Binders: CoVars (can appear in coercions) + Kind: CONSTRAINT (TupleRep []) + Examples: (t1 ~# t2) or (t1 ~R# t2) + + (c) A "simple predicate type" is either a class predicate or an equality predicate + Test: isSimplePredTy + Kind: Constraint or CONSTRAINT (TupleRep []) + Examples: all coercion types and dictionary types + + (d) A "forall-predicate" is the type of a possibly-polymorphic function + returning a predicate; e.g. + forall a. Eq a => Eq [a] + + (e) An "irred predicate" is any other type of kind (CONSTRAINT r), + typically something like `c` or `c Int`, for some suitably-kinded `c` + + +* Predicates are classified by `classifyPredType`. + +* Equality types and dictionary types are mutually exclusive. + +* Predicates are the things solved by the constraint solver; and + /evidence terms/ witness those solutions. An /evidence variable/ + (or EvId) has a type that is a PredType. + +* Generally speaking, the /type/ of a predicate determines its /value/; + that is, predicates are singleton types. The big exception is implicit + parameters. See Note [Type determines value] + +* In a FunTy { ft_af = af }, where af = FTF_C_T or FTF_C_C, + the argument type is always a Predicate type. +-} + -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. data Pred @@ -75,43 +142,136 @@ -- as ClassPred, as if we had a tuple class with two superclasses -- class (c1, c2) => CTuple2 c1 c2 -classifyPredType :: PredType -> Pred -classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of - Just (tc, [_, _, ty1, ty2]) - | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2 - | tc `hasKey` eqPrimTyConKey -> EqPred NomEq ty1 ty2 +classifyPredType :: HasDebugCallStack => PredType -> Pred +-- Precondition: the argument is a predicate type, with kind (CONSTRAINT _) +classifyPredType ev_ty + = assertPpr (isPredTy ev_ty) (ppr ev_ty) $ + case splitTyConApp_maybe ev_ty of + Just (tc, [_, _, ty1, ty2]) + | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2 + | tc `hasKey` eqPrimTyConKey -> EqPred NomEq ty1 ty2 - Just (tc, tys) - | Just clas <- tyConClass_maybe tc - -> ClassPred clas tys + Just (tc, tys) + | Just clas <- tyConClass_maybe tc + -> ClassPred clas tys - _ | (tvs, rho) <- splitForAllTyCoVars ev_ty - , (theta, pred) <- splitFunTys rho - , not (null tvs && null theta) - -> ForAllPred tvs (map scaledThing theta) pred + _ | (tvs, rho) <- splitForAllTyCoVars ev_ty + , (theta, pred) <- splitFunTys rho + , not (null tvs && null theta) + -> ForAllPred tvs (map scaledThing theta) pred - | otherwise - -> IrredPred ev_ty + | otherwise + -> IrredPred ev_ty --- --------------------- Dictionary types --------------------------------- +isSimplePredTy :: HasDebugCallStack => Type -> Bool +-- Return True for (t1 ~# t2) regardless of role, and (C tys) +-- /Not/ true of quantified-predicate type like (forall a. Eq a => Eq [a]) +-- Precondition: expects a type that classifies values (i.e. not a type constructor) +-- See Note [Types for coercions, predicates, and evidence] +isSimplePredTy ty + = case tyConAppTyCon_maybe ty of + Nothing -> False + Just tc -> isClassTyCon tc || + tc `hasKey` eqPrimTyConKey || + tc `hasKey` eqReprPrimTyConKey +isPredTy :: Type -> Bool +-- True of all types of kind (CONSTRAINT r) for some `r` +-- See Note [Types for coercions, predicates, and evidence] +-- +-- In particular it is True of +-- - the constraints handled by the constraint solver, +-- including quantified constraints +-- - dictionary functions (forall a. Eq a => Eq [a]) +isPredTy ty = case typeTypeOrConstraint ty of + TypeLike -> False + ConstraintLike -> True + +typeDeterminesValue :: PredType -> Bool +-- ^ Is the type *guaranteed* to determine the value? +-- Might say No even if the type does determine the value. +-- See Note [Type determines value] +typeDeterminesValue ty = isDictTy ty && not (couldBeIPLike ty) + + +{- +Note [Evidence for quantified constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The superclass mechanism in GHC.Tc.Solver.Dict.makeSuperClasses risks +taking a quantified constraint like + (forall a. C a => a ~ b) +and generate superclass evidence + (forall a. C a => a ~# b) + +This is a funny thing: neither isPredTy nor isCoVarType are true +of it. So we are careful not to generate it in the first place: +see Note [Equality superclasses in quantified constraints] +in GHC.Tc.Solver.Dict. +-} + +-- --------------------- Equality predicates --------------------------------- + +-- | Does this type classify a core (unlifted) Coercion? +-- At either role nominal or representational +-- (t1 ~# t2) or (t1 ~R# t2) +-- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep" +isEqPred :: PredType -> Bool +-- True of (s ~# t) (s ~R# t) +-- NB: but NOT true of (s ~ t) or (s ~~ t) or (Coecible s t) +isEqPred ty + | Just tc <- tyConAppTyCon_maybe ty + = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey + | otherwise + = False + +isCoVarType :: Type -> Bool +-- Just a synonym for isEqPred +isCoVarType = isEqPred + +isReprEqPred :: PredType -> Bool +-- True of (s ~R# t) +isReprEqPred ty + | Just tc <- tyConAppTyCon_maybe ty + = tc `hasKey` eqReprPrimTyConKey + | otherwise + = False + +-- --------------------- Class predicates --------------------------------- + mkClassPred :: Class -> [Type] -> PredType mkClassPred clas tys = mkTyConApp (classTyCon clas) tys +isClassPred :: PredType -> Bool +isClassPred ty = case tyConAppTyCon_maybe ty of + Just tc -> isClassTyCon tc + _ -> False + isDictTy :: Type -> Bool --- True of dictionaries (Eq a) and --- dictionary functions (forall a. Eq a => Eq [a]) --- See Note [Type determines value] --- See #24370 (and the isDictId call in GHC.HsToCore.Binds.decomposeRuleLhs) --- for why it's important to catch dictionary bindings -isDictTy ty = isClassPred pred - where - (_, pred) = splitInvisPiTys ty +isDictTy = isClassPred -typeDeterminesValue :: Type -> Bool --- See Note [Type determines value] -typeDeterminesValue ty = isDictTy ty && not (isIPLikePred ty) +isEqClassPred :: PredType -> Bool +isEqClassPred ty -- True of (s ~ t) and (s ~~ t) + -- ToDo: should we check saturation? + | Just tc <- tyConAppTyCon_maybe ty + , Just cls <- tyConClass_maybe tc + = isEqualityClass cls + | otherwise + = False +isEqualityClass :: Class -> Bool +-- True of (~), (~~), and Coercible +-- These all have a single primitive-equality superclass, either (~N# or ~R#) +isEqualityClass cls + = cls `hasKey` heqTyConKey + || cls `hasKey` eqTyConKey + || cls `hasKey` coercibleTyConKey + +isCTupleClass :: Class -> Bool +isCTupleClass cls = isTupleTyCon (classTyCon cls) + +isUnaryClass :: Class -> Bool +isUnaryClass cls = isUnaryClassTyCon (classTyCon cls) + getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type]) getClassPredTys ty = case getClassPredTys_maybe ty of Just (clas, tys) -> (clas, tys) @@ -153,6 +313,10 @@ purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. + +It's also not always possible to infer that a type determines the value +if type families are in play. See #19747 for one such example. + -} -- --------------------- Equality predicates --------------------------------- @@ -170,6 +334,37 @@ eqRelRole NomEq = Nominal eqRelRole ReprEq = Representational +-- | Creates a primitive nominal type equality predicate. +-- t1 ~# t2 +-- Invariant: the types are not Coercions +mkNomEqPred :: Type -> Type -> Type +mkNomEqPred ty1 ty2 + = mkTyConApp eqPrimTyCon [k1, k2, ty1, ty2] + where + k1 = typeKind ty1 + k2 = typeKind ty2 + +-- | Creates a primitive representational type equality predicate. +-- t1 ~R# t2 +-- Invariant: the types are not Coercions +mkReprEqPred :: Type -> Type -> Type +mkReprEqPred ty1 ty2 + = mkTyConApp eqReprPrimTyCon [k1, k2, ty1, ty2] + where + k1 = typeKind ty1 + k2 = typeKind ty2 + +-- | Makes a lifted equality predicate at the given role +mkEqPred :: EqRel -> Type -> Type -> PredType +mkEqPred NomEq = mkNomEqPred +mkEqPred ReprEq = mkReprEqPred + +-- | Makes a lifted equality predicate at the given role +mkEqPredRole :: Role -> Type -> Type -> PredType +mkEqPredRole Nominal = mkNomEqPred +mkEqPredRole Representational = mkReprEqPred +mkEqPredRole Phantom = panic "mkEqPred phantom" + getEqPredTys :: PredType -> (Type, Type) getEqPredTys ty = case splitTyConApp_maybe ty of @@ -195,90 +390,19 @@ -- Returns NomEq for dictionary predicates, etc predTypeEqRel :: PredType -> EqRel predTypeEqRel ty - | isReprEqPrimPred ty = ReprEq - | otherwise = NomEq - -{------------------------------------------- -Predicates on PredType ---------------------------------------------} - -{- -Note [Evidence for quantified constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The superclass mechanism in GHC.Tc.Solver.Dict.makeSuperClasses risks -taking a quantified constraint like - (forall a. C a => a ~ b) -and generate superclass evidence - (forall a. C a => a ~# b) - -This is a funny thing: neither isPredTy nor isCoVarType are true -of it. So we are careful not to generate it in the first place: -see Note [Equality superclasses in quantified constraints] -in GHC.Tc.Solver.Dict. --} - --- | Does this type classify a core (unlifted) Coercion? --- At either role nominal or representational --- (t1 ~# t2) or (t1 ~R# t2) --- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep" -isCoVarType :: Type -> Bool - -- ToDo: should we check saturation? -isCoVarType ty = isEqPrimPred ty - -isEvVarType :: Type -> Bool --- True of (a) predicates, of kind Constraint, such as (Eq t), and (s ~ t) --- (b) coercion types, such as (s ~# t) or (s ~R# t) --- See Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep --- See Note [Evidence for quantified constraints] -isEvVarType ty = isCoVarType ty || isPredTy ty - -isEqPrimPred :: PredType -> Bool --- True of (s ~# t) (s ~R# t) -isEqPrimPred ty - | Just tc <- tyConAppTyCon_maybe ty - = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey - | otherwise - = False - -isReprEqPrimPred :: PredType -> Bool -isReprEqPrimPred ty - | Just tc <- tyConAppTyCon_maybe ty - = tc `hasKey` eqReprPrimTyConKey - | otherwise - = False - -isNomEqPred :: PredType -> Bool --- A nominal equality, primitive or not (s ~# t), (s ~ t), or (s ~~ t) -isNomEqPred ty - | Just tc <- tyConAppTyCon_maybe ty - = tc `hasKey` eqPrimTyConKey || tc `hasKey` heqTyConKey || tc `hasKey` eqTyConKey - | otherwise - = False - -isClassPred :: PredType -> Bool -isClassPred ty = case tyConAppTyCon_maybe ty of - Just tc -> isClassTyCon tc - _ -> False - -isEqPred :: PredType -> Bool -isEqPred ty -- True of (s ~ t) and (s ~~ t) - -- ToDo: should we check saturation? - | Just tc <- tyConAppTyCon_maybe ty - , Just cls <- tyConClass_maybe tc - = isEqualityClass cls - | otherwise - = False - -isEqualityClass :: Class -> Bool --- True of (~), (~~), and Coercible --- These all have a single primitive-equality superclass, either (~N# or ~R#) -isEqualityClass cls - = cls `hasKey` heqTyConKey - || cls `hasKey` eqTyConKey - || cls `hasKey` coercibleTyConKey + | isReprEqPred ty = ReprEq + | otherwise = NomEq -isCTupleClass :: Class -> Bool -isCTupleClass cls = isTupleTyCon (classTyCon cls) +pprPredType :: PredType -> SDoc +-- Special case for (t1 ~# t2) and (t1 ~R# t2) +pprPredType pred + = case classifyPredType pred of + EqPred eq_rel t1 t2 -> sep [ ppr t1, ppr (getOccName eq_tc) <+> ppr t2 ] + where + eq_tc = case eq_rel of + NomEq -> eqPrimTyCon + ReprEq -> eqReprPrimTyCon + _ -> ppr pred {- ********************************************************************* * * @@ -286,6 +410,8 @@ * * ********************************************************************* -} +-- --------------------- Nomal implicit-parameter predicates --------------- + isIPTyCon :: TyCon -> Bool isIPTyCon tc = tc `hasKey` ipClassKey -- Class and its corresponding TyCon have the same Unique @@ -303,6 +429,18 @@ | otherwise = Nothing +-- | Take a type (IP sym ty), where IP is the built in IP class +-- and return (ip, MkIP, [sym,ty]), where +-- `ip` is the class-op for class IP +-- `MkIP` is the data constructor for class IP +decomposeIPPred :: Type -> (Id, [Type]) +decomposeIPPred ty + | Just (cls, tys) <- getClassPredTys_maybe ty + , [ip_op] <- classMethods cls + = assertPpr (isIPClass cls && isUnaryClass cls) (ppr ty) $ + (ip_op, tys) + | otherwise = pprPanic "decomposeIP" (ppr ty) + -- --------------------- ExceptionContext predicates -------------------------- -- | Is a 'PredType' an @ExceptionContext@ implicit parameter? @@ -357,44 +495,44 @@ | otherwise = False --- --------------------- isIPLike and mentionsIP -------------------------- +-- --------------------- couldBeIPLike and mightMentionIP -------------------------- -- See Note [Local implicit parameters] -isIPLikePred :: Type -> Bool +couldBeIPLike :: Type -> Bool -- Is `pred`, or any of its superclasses, an implicit parameter? -- See Note [Local implicit parameters] -isIPLikePred pred = - mentions_ip_pred initIPRecTc (const True) (const True) pred +couldBeIPLike pred + = might_mention_ip1 initIPRecTc (const True) (const True) pred -mentionsIP :: (Type -> Bool) -- ^ predicate on the string - -> (Type -> Bool) -- ^ predicate on the type - -> Class - -> [Type] -> Bool --- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if: +mightMentionIP :: (Type -> Bool) -- ^ predicate on the string + -> (Type -> Bool) -- ^ predicate on the type + -> Class + -> [Type] -> Bool +-- ^ @'mightMentionIP' str_cond ty_cond cls tys@ returns @True@ if: -- -- - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@ -- are both @True@, -- - or any superclass of @cls tys@ has this property. -- -- See Note [Local implicit parameters] -mentionsIP = mentions_ip initIPRecTc +mightMentionIP = might_mention_ip initIPRecTc -mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool -mentions_ip rec_clss str_cond ty_cond cls tys +might_mention_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool +might_mention_ip rec_clss str_cond ty_cond cls tys | Just (str_ty, ty) <- isIPPred_maybe cls tys = str_cond str_ty && ty_cond ty | otherwise - = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys) + = or [ might_mention_ip1 rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys) | sc_sel_id <- classSCSelIds cls ] -mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool -mentions_ip_pred rec_clss str_cond ty_cond ty +might_mention_ip1 :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool +might_mention_ip1 rec_clss str_cond ty_cond ty | Just (cls, tys) <- getClassPredTys_maybe ty , let tc = classTyCon cls , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss else checkRecTc rec_clss tc - = mentions_ip rec_clss' str_cond ty_cond cls tys + = might_mention_ip rec_clss' str_cond ty_cond cls tys | otherwise = False -- Includes things like (D []) where D is -- a Constraint-ranged family; #7785 @@ -407,7 +545,7 @@ See also wrinkle (SIP1) in Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. -The function isIPLikePred tells if this predicate, or any of its +The function couldBeIPLike tells if this predicate, or any of its superclasses, is an implicit parameter. Why are implicit parameters special? Unlike normal classes, we can @@ -415,7 +553,7 @@ let ?x = True in ... So in various places we must be careful not to assume that any value of the right type will do; we must carefully look for the innermost binding. -So isIPLikePred checks whether this is an implicit parameter, or has +So couldBeIPLike checks whether this is an implicit parameter, or has a superclass that is an implicit parameter. Several wrinkles @@ -456,16 +594,16 @@ think nothing does. * I'm a little concerned about type variables; such a variable might be instantiated to an implicit parameter. I don't think this - matters in the cases for which isIPLikePred is used, and it's pretty + matters in the cases for which couldBeIPLike is used, and it's pretty obscure anyway. * The superclass hunt stops when it encounters the same class again, but in principle we could have the same class, differently instantiated, and the second time it could have an implicit parameter I'm going to treat these as problems for another day. They are all exotic. -Note [Using typesAreApart when calling mentionsIP] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We call 'mentionsIP' in two situations: +Note [Using typesAreApart when calling mightMentionIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We call 'mightMentionIP' in two situations: (1) to check that a predicate does not contain any implicit parameters IP str ty, for a fixed literal str and any type ty, @@ -500,8 +638,175 @@ * * ********************************************************************* -} -isEvVar :: Var -> Bool -isEvVar var = isEvVarType (varType var) +isEvId :: Var -> Bool +isEvId var = isPredTy (varType var) isDictId :: Id -> Bool isDictId id = isDictTy (varType id) + + +{- ********************************************************************* +* * + scopedSort + + This function lives here becuase it uses isEvId +* * +********************************************************************* -} + +{- Note [ScopedSort] +~~~~~~~~~~~~~~~~~~~~ +Consider + + foo :: Proxy a -> Proxy (b :: k) -> Proxy (a :: k2) -> () + +This function type is implicitly generalised over [a, b, k, k2]. These +variables will be Specified; that is, they will be available for visible +type application. This is because they are written in the type signature +by the user. + +However, we must ask: what order will they appear in? In cases without +dependency, this is easy: we just use the lexical left-to-right ordering +of first occurrence. With dependency, we cannot get off the hook so +easily. + +We thus state: + + * These variables appear in the order as given by ScopedSort, where + the input to ScopedSort is the left-to-right order of first occurrence. + +Note that this applies only to *implicit* quantification, without a +`forall`. If the user writes a `forall`, then we just use the order given. + +ScopedSort is defined thusly (as proposed in #15743): + * Work left-to-right through the input list, with a cursor. + * If variable v at the cursor is depended on by any earlier variable w, + move v immediately before the leftmost such w. + +INVARIANT: The prefix of variables before the cursor form a valid telescope. + +Note that ScopedSort makes sense only after type inference is done and all +types/kinds are fully settled and zonked. + +-} + +-- | Do a topological sort on a list of tyvars, +-- so that binders occur before occurrences +-- E.g. given @[ a::k, k::Type, b::k ]@ +-- it'll return a well-scoped list @[ k::Type, a::k, b::k ]@. +-- +-- This is a deterministic sorting operation +-- (that is, doesn't depend on Uniques). +-- +-- It is also meant to be stable: that is, variables should not +-- be reordered unnecessarily. This is specified in Note [ScopedSort] +-- See also Note [Ordering of implicit variables] in "GHC.Rename.HsType" + +scopedSort :: [Var] -> [Var] +scopedSort = go [] [] + where + go :: [Var] -- already sorted, in reverse order + -> [TyCoVarSet] -- each set contains all the variables which must be placed + -- before the tv corresponding to the set; they are accumulations + -- of the fvs in the sorted Var's types + + -- This list is in 1-to-1 correspondence with the sorted Vars + -- INVARIANT: + -- all (\tl -> all (`subVarSet` head tl) (tail tl)) (tails fv_list) + -- That is, each set in the list is a superset of all later sets. + + -> [Var] -- yet to be sorted + -> [Var] + go acc _fv_list [] = reverse acc + go acc fv_list (tv:tvs) + = go acc' fv_list' tvs + where + (acc', fv_list') = insert tv acc fv_list + + insert :: Var -- var to insert + -> [Var] -- sorted list, in reverse order + -> [TyCoVarSet] -- list of fvs, as above + -> ([Var], [TyCoVarSet]) -- augmented lists + -- Generally we put the new Var at the front of the accumulating list + -- (leading to a stable sort) unless there is are reason to put it later. + insert v [] [] = ([v], [tyCoVarsOfType (varType v)]) + insert v (a:as) (fvs:fvss) + | (isTyVar v && isId a) || -- TyVars precede Ids + (isEvId v && isId a && not (isEvId a)) || -- DictIds precede non-DictIds + (v `elemVarSet` fvs) + -- (a) put Ids after TyVars, and (b) respect dependencies + , (as', fvss') <- insert v as fvss + = (a:as', fvs `unionVarSet` fv_v : fvss') + + | otherwise -- Put `v` at the front + = (v:a:as, fvs `unionVarSet` fv_v : fvs : fvss) + where + fv_v = tyCoVarsOfType (varType v) + + -- lists not in correspondence + insert _ _ _ = panic "scopedSort" + +-- | Get the free vars of a type in scoped order +tyCoVarsOfTypeWellScoped :: Type -> [TyVar] +tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList + +-- | Get the free vars of types in scoped order +tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] +tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList + + +{- ********************************************************************* +* * +* Equality left-hand sides +* * +********************************************************************* -} + +-- | A 'CanEqLHS' is a type that can appear on the left of a canonical +-- equality: a type variable or /exactly-saturated/ type family application. +data CanEqLHS + = TyVarLHS TyVar + | TyFamLHS TyCon -- ^ TyCon of the family + [Type] -- ^ Arguments, /exactly saturating/ the family + +instance Outputable CanEqLHS where + ppr (TyVarLHS tv) = ppr tv + ppr (TyFamLHS fam_tc fam_args) = ppr (mkTyConApp fam_tc fam_args) + +----------------------------------- +-- | Is a type a canonical LHS? That is, is it a tyvar or an exactly-saturated +-- type family application? +-- Does not look through type synonyms. +canEqLHS_maybe :: Type -> Maybe CanEqLHS +canEqLHS_maybe xi + | Just tv <- getTyVar_maybe xi + = Just $ TyVarLHS tv + + | otherwise + = canTyFamEqLHS_maybe xi + +canTyFamEqLHS_maybe :: Type -> Maybe CanEqLHS +canTyFamEqLHS_maybe xi + | Just (tc, args) <- tcSplitTyConApp_maybe xi + , isTypeFamilyTyCon tc + , args `lengthIs` tyConArity tc + = Just $ TyFamLHS tc args + + | otherwise + = Nothing + +-- | Convert a 'CanEqLHS' back into a 'Type' +canEqLHSType :: CanEqLHS -> Type +canEqLHSType (TyVarLHS tv) = mkTyVarTy tv +canEqLHSType (TyFamLHS fam_tc fam_args) = mkTyConApp fam_tc fam_args + +-- | Retrieve the kind of a 'CanEqLHS' +canEqLHSKind :: CanEqLHS -> Kind +canEqLHSKind (TyVarLHS tv) = tyVarKind tv +canEqLHSKind (TyFamLHS fam_tc fam_args) = piResultTys (tyConKind fam_tc) fam_args + +-- | Are two 'CanEqLHS's equal? +eqCanEqLHS :: CanEqLHS -> CanEqLHS -> Bool +eqCanEqLHS (TyVarLHS tv1) (TyVarLHS tv2) = tv1 == tv2 +eqCanEqLHS (TyFamLHS fam_tc1 fam_args1) (TyFamLHS fam_tc2 fam_args2) + = tcEqTyConApps fam_tc1 fam_args1 fam_tc2 fam_args2 +eqCanEqLHS _ _ = False + diff --git a/GHC/Core/Rules.hs b/GHC/Core/Rules.hs --- a/GHC/Core/Rules.hs +++ b/GHC/Core/Rules.hs @@ -9,7 +9,7 @@ -- The 'CoreRule' datatype itself is declared elsewhere. module GHC.Core.Rules ( -- ** Looking up rules - lookupRule, matchExprs, + lookupRule, matchExprs, ruleLhsIsMoreSpecific, -- ** RuleBase, RuleEnv RuleBase, RuleEnv(..), mkRuleEnv, emptyRuleEnv, @@ -30,7 +30,8 @@ rulesOfBinds, getRules, pprRulesForUser, -- * Making rules - mkRule, mkSpecRule, roughTopNames + mkRule, mkSpecRule, roughTopNames, + ruleIsOrphan ) where @@ -484,6 +485,10 @@ ruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin } = notOrphan orph || origin `elemModuleSet` vis_orphs +ruleIsOrphan :: CoreRule -> Bool +ruleIsOrphan (BuiltinRule {}) = False +ruleIsOrphan (Rule { ru_orphan = orph }) = isOrphan orph + {- Note [Where rules are found] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The rules for an Id come from two places: @@ -538,7 +543,8 @@ -- supplied rules to this instance of an application in a given -- context, returning the rule applied and the resulting expression if -- successful. -lookupRule :: RuleOpts -> InScopeEnv +lookupRule :: HasDebugCallStack + => RuleOpts -> InScopeEnv -> (Activation -> Bool) -- When rule is active -> Id -- Function head -> [CoreExpr] -- Args @@ -568,7 +574,7 @@ = go ((r,mkTicks ticks e):ms) rs | otherwise = -- pprTrace "match failed" (ppr r $$ ppr args $$ - -- ppr [ (arg_id, unfoldingTemplate unf) + -- ppr [ (arg_id, maybeUnfoldingTemplate unf) -- | Var arg_id <- args -- , let unf = idUnfolding arg_id -- , isCheapUnfolding unf] ) @@ -582,8 +588,8 @@ findBest _ _ (rule,ans) [] = (rule,ans) findBest in_scope target (rule1,ans1) ((rule2,ans2):prs) - | isMoreSpecific in_scope rule1 rule2 = findBest in_scope target (rule1,ans1) prs - | isMoreSpecific in_scope rule2 rule1 = findBest in_scope target (rule2,ans2) prs + | ruleIsMoreSpecific in_scope rule1 rule2 = findBest in_scope target (rule1,ans1) prs + | ruleIsMoreSpecific in_scope rule2 rule1 = findBest in_scope target (rule2,ans2) prs | debugIsOn = let pp_rule rule = ifPprDebug (ppr rule) (doubleQuotes (ftext (ruleName rule))) @@ -598,15 +604,25 @@ where (fn,args) = target -isMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool --- The call (rule1 `isMoreSpecific` rule2) +ruleIsMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool +-- The call (rule1 `ruleIsMoreSpecific` rule2) -- sees if rule2 can be instantiated to look like rule1 --- See Note [isMoreSpecific] -isMoreSpecific _ (BuiltinRule {}) _ = False -isMoreSpecific _ (Rule {}) (BuiltinRule {}) = True -isMoreSpecific in_scope (Rule { ru_bndrs = bndrs1, ru_args = args1 }) - (Rule { ru_bndrs = bndrs2, ru_args = args2 }) - = isJust (matchExprs in_scope_env bndrs2 args2 args1) +-- See Note [ruleIsMoreSpecific] +ruleIsMoreSpecific in_scope rule1 rule2 + = case rule1 of + BuiltinRule {} -> False + Rule { ru_bndrs = bndrs1, ru_args = args1 } + -> ruleLhsIsMoreSpecific in_scope bndrs1 args1 rule2 + +ruleLhsIsMoreSpecific :: InScopeSet + -> [Var] -> [CoreExpr] -- LHS of a possible new rule + -> CoreRule -- An existing rule + -> Bool -- New one is more specific +ruleLhsIsMoreSpecific in_scope bndrs1 args1 rule2 + = case rule2 of + BuiltinRule {} -> True + Rule { ru_bndrs = bndrs2, ru_args = args2 } + -> isJust (matchExprs in_scope_env bndrs2 args2 args1) where full_in_scope = in_scope `extendInScopeSetList` bndrs1 in_scope_env = ISE full_in_scope noUnfoldingFun @@ -615,9 +631,9 @@ noBlackList :: Activation -> Bool noBlackList _ = False -- Nothing is black listed -{- Note [isMoreSpecific] +{- Note [ruleIsMoreSpecific] ~~~~~~~~~~~~~~~~~~~~~~~~ -The call (rule1 `isMoreSpecific` rule2) +The call (rule1 `ruleIsMoreSpecific` rule2) sees if rule2 can be instantiated to look like rule1. Wrinkle: @@ -660,7 +676,8 @@ -} ------------------------------------ -matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) +matchRule :: HasDebugCallStack + => RuleOpts -> InScopeEnv -> (Activation -> Bool) -> Id -> [CoreExpr] -> [Maybe Name] -> CoreRule -> Maybe CoreExpr @@ -705,7 +722,8 @@ --------------------------------------- -matchN :: InScopeEnv +matchN :: HasDebugCallStack + => InScopeEnv -> RuleName -> [Var] -> [CoreExpr] -> [CoreExpr] -> CoreExpr -- ^ Target; can have more elements than the template -> Maybe CoreExpr @@ -724,7 +742,8 @@ ; return (bind_wrapper $ mkLams tmpl_vars rhs `mkApps` matched_es) } -matchExprs :: InScopeEnv -> [Var] -> [CoreExpr] -> [CoreExpr] +matchExprs :: HasDebugCallStack + => InScopeEnv -> [Var] -> [CoreExpr] -> [CoreExpr] -> Maybe (BindWrapper, [CoreExpr]) -- 1-1 with the [Var] matchExprs (ISE in_scope id_unf) tmpl_vars tmpl_es target_es = do { rule_subst <- match_exprs init_menv emptyRuleSubst tmpl_es target_es @@ -780,7 +799,8 @@ , text "Actual args:" <+> ppr target_es ] ---------------------- -match_exprs :: RuleMatchEnv -> RuleSubst +match_exprs :: HasDebugCallStack + => RuleMatchEnv -> RuleSubst -> [CoreExpr] -- Templates -> [CoreExpr] -- Targets -> Maybe RuleSubst @@ -820,7 +840,7 @@ The rule looks like forall (a::*) (d::Eq Char) (x :: Foo a Char). - f (Foo a Char) d x = True + f @(Foo a Char) d x = True Matching the rule won't bind 'a', and legitimately so. We fudge by pretending that 'a' is bound to (Any :: *). @@ -996,17 +1016,17 @@ variable. And SpecConstr no longer does so: see Note [SpecConstr and casts] in SpecConstr. -It is, however, OK for a cast to appear in a template. For example - newtype N a = MkN (a,a) -- Axiom ax:N a :: (a,a) ~R N a - f :: N a -> bah - RULE forall b x:b y:b. f @b ((x,y) |> (axN @b)) = ... - -When matching we can just move these casts to the other side: - match (tmpl |> co) tgt --> match tmpl (tgt |> sym co) -See matchTemplateCast. - Wrinkles: +(CT0) It is, however, OK for a cast to appear in a template provided the cast mentions + none of the template variables. For example + newtype N a = MkN (a,a) -- Axiom ax:N a :: (a,a) ~R N a + f :: N a -> bah + RULE forall b x:b y:b. f @b ((x,y) |> (axN @b)) = ... + When matching we can just move these casts to the other side: + match (tmpl |> co) tgt --> match tmpl (tgt |> sym co) + See matchTemplateCast. + (CT1) We need to be careful about scoping, and to match left-to-right, so that we know the substitution [a :-> b] before we meet (co :: (a,a) ~R N a), and so we can apply that substitition @@ -1041,7 +1061,8 @@ -} ---------------------- -match :: RuleMatchEnv +match :: HasDebugCallStack + => RuleMatchEnv -> RuleSubst -- Substitution applies to template only -> CoreExpr -- Template -> CoreExpr -- Target @@ -1277,7 +1298,7 @@ f (\(MkT @b (d::Num b) (x::b)) -> h @b d x) = ... where the HOP is (h @b d x). In principle this might be possible, but it seems fragile; e.g. we would still need to insist that the (invisible) - @b was a type variable. And since `h` gets a polymoprhic type, that + @b was a type variable. And since `h` gets a polymorphic type, that type would have to be declared by the programmer. Maybe one day. But for now, we insist (in `arg_as_lcl_var`)that a HOP @@ -1491,11 +1512,12 @@ filterFV (`elemVarSet` rv_tmpls renv) $ -- Check that the coercion does not tyCoFVsOfCo substed_co -- mention any of the template variables = -- This is the good path - -- See Note [Casts in the template] + -- See Note [Casts in the template] wrinkle (CT0) match renv subst e1 e2 (checkReflexiveMCo (mkTransMCoL mco (mkSymCo substed_co))) | otherwise = -- This is the Deeply Suspicious Path + -- See Note [Casts in the template] do { let co2 = case mco of MRefl -> mkRepReflCo (exprType e2) MCo co2 -> co2 @@ -1577,7 +1599,8 @@ not_captured fv = not (inRnEnvR rn_env fv) ------------------------------------------ -match_var :: RuleMatchEnv +match_var :: HasDebugCallStack + => RuleMatchEnv -> RuleSubst -> Var -- Template -> CoreExpr -- Target @@ -1613,7 +1636,8 @@ -- template x, so we must rename first! ------------------------------------------ -match_tmpl_var :: RuleMatchEnv +match_tmpl_var :: HasDebugCallStack + => RuleMatchEnv -> RuleSubst -> Var -- Template -> CoreExpr -- Target diff --git a/GHC/Core/Rules/Config.hs b/GHC/Core/Rules/Config.hs --- a/GHC/Core/Rules/Config.hs +++ b/GHC/Core/Rules/Config.hs @@ -5,9 +5,15 @@ -- | Rule options data RuleOpts = RuleOpts - { roPlatform :: !Platform -- ^ Target platform - , roNumConstantFolding :: !Bool -- ^ Enable more advanced numeric constant folding - , roExcessRationalPrecision :: !Bool -- ^ Cut down precision of Rational values to that of Float/Double if disabled - , roBignumRules :: !Bool -- ^ Enable rules for bignums + { roPlatform :: !Platform + -- ^ Target platform + , roNumConstantFolding :: !Bool + -- ^ Enable constant folding through nested expressions. + -- + -- See Note [Constant folding through nested expressions] in GHC.Core.Opt.ConstantFold + , roExcessRationalPrecision :: !Bool + -- ^ Cut down precision of Rational values to that of Float/Double if disabled + , roBignumRules :: !Bool + -- ^ Enable rules for bignums } diff --git a/GHC/Core/SimpleOpt.hs b/GHC/Core/SimpleOpt.hs --- a/GHC/Core/SimpleOpt.hs +++ b/GHC/Core/SimpleOpt.hs @@ -8,7 +8,7 @@ SimpleOpts (..), defaultSimpleOpts, -- ** Simple expression optimiser - simpleOptPgm, simpleOptExpr, simpleOptExprWith, + simpleOptPgm, simpleOptExpr, simpleOptExprNoInline, simpleOptExprWith, -- ** Join points joinPointBinding_maybe, joinPointBindings_maybe, @@ -89,6 +89,24 @@ expression. In fact, the simple optimiser is a good example of this little dance in action; the full Simplifier is a lot more complicated. +Note [The InScopeSet for simpleOptExpr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Care must be taken to remove unfoldings from `Var`s collected by exprFreeVars +before using them to construct an in-scope set hence `zapIdUnfolding` in `init_subst`. +Consider calling `simpleOptExpr` on an expression like + +``` + case x of (a,b) -> (x,a) +``` + +* One of those two occurrences of x has an unfolding (the one in (x,a), with +unfolding x = (a,b)) and the other does not. (Inside a case GHC adds +unfolding-info to the scrutinee's Id.) +* But exprFreeVars just builds a set, so it's a bit random which occurrence is collected. +* Then simpleOptExpr replaces each occurrence of x with the one in the in-scope set. +* Bad bad bad: then the x in case x of ... may be replaced with a version that has an unfolding. + +See ticket #25790 -} -- | Simple optimiser options @@ -96,6 +114,8 @@ { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options , so_eta_red :: !Bool -- ^ Eta reduction on? + , so_inline :: !Bool -- ^ False <=> do no inlining whatsoever, + -- even for trivial or used-once things } -- | Default options for the Simple optimiser. @@ -104,6 +124,7 @@ { so_uf_opts = defaultUnfoldingOpts , so_co_opts = OptCoercionOpts { optCoercionEnabled = False } , so_eta_red = False + , so_inline = True } simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr @@ -135,17 +156,23 @@ = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr) simpleOptExprWith opts init_subst expr where - init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr)) - -- It's potentially important to make a proper in-scope set - -- Consider let x = ..y.. in \y. ...x... - -- Then we should remember to clone y before substituting - -- for x. It's very unlikely to occur, because we probably - -- won't *be* substituting for x if it occurs inside a - -- lambda. - -- + init_subst = mkEmptySubst (mkInScopeSet (mapVarSet zapIdUnfolding (exprFreeVars expr))) + -- zapIdUnfolding: see Note [The InScopeSet for simpleOptExpr] + -- It's a bit painful to call exprFreeVars, because it makes -- three passes instead of two (occ-anal, and go) +simpleOptExprNoInline :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr +-- A variant of simpleOptExpr, but without +-- occurrence analysis or inlining of any kind. +-- Result: we don't inline evidence bindings, which is useful for the specialiser +simpleOptExprNoInline opts expr + = simple_opt_expr init_env expr + where + init_opts = opts { so_inline = False } + init_env = (emptyEnv init_opts) { soe_subst = init_subst } + init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr)) + simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> InExpr -> OutExpr -- See Note [The simple optimiser] simpleOptExprWith opts subst expr @@ -219,7 +246,7 @@ = env { soe_inl = emptyVarEnv, soe_subst = zapSubst subst } soeInScope :: SimpleOptEnv -> InScopeSet -soeInScope (SOE { soe_subst = subst }) = getSubstInScope subst +soeInScope (SOE { soe_subst = subst }) = substInScopeSet subst soeSetInScope :: InScopeSet -> SimpleOptEnv -> SimpleOptEnv soeSetInScope in_scope env2@(SOE { soe_subst = subst2 }) @@ -246,7 +273,7 @@ where rec_ids = soe_rec_ids env subst = soe_subst env - in_scope = getSubstInScope subst + in_scope = substInScopeSet subst in_scope_env = ISE in_scope alwaysActiveUnfoldingFun --------------- @@ -277,7 +304,7 @@ _ -> foldr wrapLet (simple_opt_expr env' rhs) mb_prs where (env', mb_prs) = mapAccumL (simple_out_bind NotTopLevel) env $ - zipEqual "simpleOptExpr" bs es + zipEqual bs es -- See Note [Getting the map/coerce RULE to work] | isDeadBinder b @@ -339,10 +366,12 @@ = simple_app (soeSetInScope (soeInScope env) env') e as | let unf = idUnfolding v - , isCompulsoryUnfolding (idUnfolding v) + , isCompulsoryUnfolding unf , isAlwaysActive (idInlineActivation v) -- See Note [Unfold compulsory unfoldings in RULE LHSs] - = simple_app (soeZapSubst env) (unfoldingTemplate unf) as + , Just rhs <- maybeUnfoldingTemplate unf + -- Always succeeds if isCompulsoryUnfolding does + = simple_app (soeZapSubst env) rhs as | otherwise , let out_fn = lookupIdSubst (soe_subst env) v @@ -453,7 +482,7 @@ -- (simple_bind_pair subst in_var out_rhs) -- either extends subst with (in_var -> out_rhs) -- or returns Nothing -simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) +simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opts }) in_bndr mb_out_bndr clo@(rhs_env, in_rhs) top_level | Type ty <- in_rhs -- let a::* = TYPE ty in @@ -479,7 +508,7 @@ stable_unf = isStableUnfolding (idUnfolding in_bndr) active = isAlwaysActive (idInlineActivation in_bndr) occ = idOccInfo in_bndr - in_scope = getSubstInScope subst + in_scope = substInScopeSet subst out_rhs | JoinPoint join_arity <- idJoinPointHood in_bndr = simple_join_rhs join_arity @@ -495,6 +524,7 @@ pre_inline_unconditionally :: Bool pre_inline_unconditionally + | not (so_inline opts) = False -- Not if so_inline is False | isExportedId in_bndr = False | stable_unf = False | not active = False -- Note [Inline prag in simplOpt] @@ -546,13 +576,14 @@ -> InId -> Maybe OutId -> OutExpr -> OccInfo -> Bool -> Bool -> TopLevelFlag -> (SimpleOptEnv, Maybe (OutVar, OutExpr)) -simple_out_bind_pair env in_bndr mb_out_bndr out_rhs +simple_out_bind_pair env@(SOE { soe_subst = subst, soe_opts = opts }) + in_bndr mb_out_bndr out_rhs occ_info active stable_unf top_level | assertPpr (isNonCoVarId in_bndr) (ppr in_bndr) -- Type and coercion bindings are caught earlier -- See Note [Core type and coercion invariant] post_inline_unconditionally - = ( env' { soe_subst = extendIdSubst (soe_subst env) in_bndr out_rhs } + = ( env' { soe_subst = extendIdSubst subst in_bndr out_rhs } , Nothing) | otherwise @@ -565,6 +596,7 @@ post_inline_unconditionally :: Bool post_inline_unconditionally + | not (so_inline opts) = False -- Not if so_inline is False | isExportedId in_bndr = False -- Note [Exported Ids and trivial RHSs] | stable_unf = False -- Note [Stable unfoldings and postInlineUnconditionally] | not active = False -- in GHC.Core.Opt.Simplify.Utils @@ -837,7 +869,7 @@ (MC1) We must compulsorily unfold MkAge to a cast. See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make -(MC2) We must compulsorily unfolding coerce on the rule LHS, yielding +(MC2) We must compulsorily unfold coerce on the rule LHS, yielding forall a b (dict :: Coercible * a b). map @a @b (\(x :: a) -> case dict of MkCoercible (co :: a ~R# b) -> x |> co) = ... @@ -854,7 +886,6 @@ Unfortunately, this still abstracts over a Coercible dictionary. We really want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce, which transforms the above to - Desugar) forall a b (co :: a ~R# b). let dict = MkCoercible @* @a @b co in @@ -879,7 +910,7 @@ (MC4) The map/coerce rule is the only compelling reason for having a RULE that quantifies over a coercion variable, something that is otherwise Very Deeply - Suspicous. See Note [Casts in the template] in GHC.Core.Rules. Ugh! + Suspicious. See Note [Casts in the template] in GHC.Core.Rules. Ugh! This is all a fair amount of special-purpose hackery, but it's for a good cause. And it won't hurt other RULES and such that it comes across. @@ -1284,11 +1315,8 @@ -- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec -- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] } -- simplifier produces case exp of a { DEFAULT -> exp[x/a] } - = let arg' = subst_expr subst arg - bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type) - float = FloatCase arg' bndr DEFAULT [] - subst' = subst_extend_in_scope subst bndr - in go subst' (float:floats) fun (CC (Var bndr : args) mco) + , (subst', float, bndr) <- case_bind subst arg arg_type + = go subst' (float:floats) fun (CC (Var bndr : args) mco) | otherwise = go subst floats fun (CC (subst_expr subst arg : args) mco) @@ -1322,7 +1350,7 @@ scrut' = subst_expr subst scrut go (Right sub) floats (Var v) cont - = go (Left (getSubstInScope sub)) + = go (Left (substInScopeSet sub)) floats (lookupIdSubst sub v) cont @@ -1331,15 +1359,16 @@ | Just con <- isDataConWorkId_maybe fun , count isValArg args == idArity fun - = succeedWith in_scope floats $ - pushCoDataCon con args mco + , (in_scope', seq_floats, args') <- mkFieldSeqFloats in_scope con args + -- mkFieldSeqFloats: See (SFC2) in Note [Strict fields in Core] + = succeedWith in_scope' (seq_floats ++ floats) $ + pushCoDataCon con args' mco -- Look through data constructor wrappers: they inline late (See Note -- [Activation for data constructor wrappers]) but we want to do -- case-of-known-constructor optimisation eagerly (see Note -- [exprIsConApp_maybe on data constructors with wrappers]). - | isDataConWrapId fun - , let rhs = uf_tmpl (realIdUnfolding fun) + | Just rhs <- dataConWrapUnfolding_maybe fun = go (Left in_scope) floats rhs cont -- Look through dictionary functions; see Note [Unfolding DFuns] @@ -1394,7 +1423,7 @@ -- The Left case is wildly dominant subst_in_scope (Left in_scope) = in_scope - subst_in_scope (Right s) = getSubstInScope s + subst_in_scope (Right s) = substInScopeSet s subst_extend_in_scope (Left in_scope) v = Left (in_scope `extendInScopeSet` v) subst_extend_in_scope (Right s) v = Right (s `extendSubstInScope` v) @@ -1418,6 +1447,38 @@ extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e) extend (Right s) v e = Right (extendSubst s v e) + case_bind :: Either InScopeSet Subst -> CoreExpr -> Type -> (Either InScopeSet Subst, FloatBind, Id) + case_bind subst expr expr_ty = (subst', float, bndr) + where + bndr = setCaseBndrEvald MarkedStrict $ + uniqAway (subst_in_scope subst) $ + mkWildValBinder ManyTy expr_ty + subst' = subst_extend_in_scope subst bndr + expr' = subst_expr subst expr + float = FloatCase expr' bndr DEFAULT [] + + mkFieldSeqFloats :: InScopeSet -> DataCon -> [CoreExpr] -> (InScopeSet, [FloatBind], [CoreExpr]) + -- See Note [Strict fields in Core] for what a field seq is and (SFC2) for + -- why we insert them + mkFieldSeqFloats in_scope dc args + | isLazyDataConRep dc + = (in_scope, [], args) + | otherwise + = (in_scope', floats', ty_args ++ val_args') + where + (ty_args, val_args) = splitAtList (dataConUnivAndExTyCoVars dc) args + (in_scope', floats', val_args') = foldr do_one (in_scope, [], []) $ zipEqual str_marks val_args + str_marks = dataConRepStrictness dc + do_one (str, arg) (in_scope,floats,args) + | NotMarkedStrict <- str = no_seq + | exprIsHNF arg = no_seq + | otherwise = (in_scope', float:floats, Var bndr:args) + where + no_seq = (in_scope, floats, arg:args) + (in_scope', float, bndr) = + case case_bind (Left in_scope) arg (exprType arg) of + (Left in_scope', float, bndr) -> (in_scope', float, bndr) + (right, _, _) -> pprPanic "case_bind did not preserve Left" (ppr in_scope $$ ppr arg $$ ppr right) -- See Note [exprIsConApp_maybe on literal strings] dealWithStringLiteral :: Var -> BS.ByteString -> MCoercion diff --git a/GHC/Core/Subst.hs b/GHC/Core/Subst.hs --- a/GHC/Core/Subst.hs +++ b/GHC/Core/Subst.hs @@ -24,13 +24,14 @@ extendIdSubstWithClone, extendSubst, extendSubstList, extendSubstWithVar, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, - isInScope, setInScope, getSubstInScope, + isInScope, setInScope, substInScopeSet, extendTvSubst, extendCvSubst, delBndr, delBndrs, zapSubst, -- ** Substituting and cloning binders substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr, cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs, + cloneBndrsM, cloneRecIdBndrsM, ) where @@ -162,12 +163,14 @@ -- | Add a substitution appropriate to the thing being substituted -- (whether an expression, type, or coercion). See also -- 'extendIdSubst', 'extendTvSubst', 'extendCvSubst' -extendSubst :: Subst -> Var -> CoreArg -> Subst +extendSubst :: HasDebugCallStack => Subst -> Var -> CoreArg -> Subst extendSubst subst var arg = case arg of - Type ty -> assert (isTyVar var) $ extendTvSubst subst var ty - Coercion co -> assert (isCoVar var) $ extendCvSubst subst var co - _ -> assert (isId var) $ extendIdSubst subst var arg + Type ty -> assertPpr (isTyVar var) doc $ extendTvSubst subst var ty + Coercion co -> assertPpr (isCoVar var) doc $ extendCvSubst subst var co + _ -> assertPpr (isId var) doc $ extendIdSubst subst var arg + where + doc = ppr var <+> text ":=" <+> ppr arg extendSubstWithVar :: Subst -> Var -> Var -> Subst extendSubstWithVar subst v1 v2 @@ -238,8 +241,7 @@ -- their canonical representatives in the in-scope set substExprSC subst orig_expr | isEmptySubst subst = orig_expr - | otherwise = -- pprTrace "enter subst-expr" (doc $$ ppr orig_expr) $ - substExpr subst orig_expr + | otherwise = substExpr subst orig_expr -- | substExpr applies a substitution to an entire 'CoreExpr'. Remember, -- you may only apply the substitution /once/: @@ -418,25 +420,32 @@ cloneIdBndrs subst us ids = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us) -cloneBndrs :: MonadUnique m => Subst -> [Var] -> m (Subst, [Var]) +cloneBndrs :: Subst -> UniqSupply -> [Var] -> (Subst, [Var]) -- Works for all kinds of variables (typically case binders) -- not just Ids -cloneBndrs subst vs - = do us <- getUniquesM - pure $ mapAccumL (\subst (v, u) -> cloneBndr subst u v) subst (vs `zip` us) +cloneBndrs subst us vs + = mapAccumL (\subst (v, u) -> cloneBndr subst u v) subst (vs `zip` uniqsFromSupply us) +cloneBndrsM :: MonadUnique m => Subst -> [Var] -> m (Subst, [Var]) +-- Works for all kinds of variables (typically case binders) +-- not just Ids +cloneBndrsM subst vs = cloneBndrs subst `flip` vs <$> getUniqueSupplyM + cloneBndr :: Subst -> Unique -> Var -> (Subst, Var) cloneBndr subst uniq v | isTyVar v = cloneTyVarBndr subst v uniq | otherwise = clone_id subst subst (v,uniq) -- Works for coercion variables too -- | Clone a mutually recursive group of 'Id's -cloneRecIdBndrs :: MonadUnique m => Subst -> [Id] -> m (Subst, [Id]) -cloneRecIdBndrs subst ids - = do us <- getUniquesM - let (subst', ids') = mapAccumL (clone_id subst') subst (ids `zip` us) - pure (subst', ids') +cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id]) +cloneRecIdBndrs subst us ids = + let x@(subst', _) = mapAccumL (clone_id subst') subst (ids `zip` uniqsFromSupply us) + in x +-- | Clone a mutually recursive group of 'Id's +cloneRecIdBndrsM :: MonadUnique m => Subst -> [Id] -> m (Subst, [Id]) +cloneRecIdBndrsM subst ids = cloneRecIdBndrs subst `flip` ids <$> getUniqueSupplyM + -- Just like substIdBndr, except that it always makes a new unique -- It is given the unique to use -- Discards non-Stable unfoldings @@ -482,7 +491,7 @@ -- in a Note in the id's type itself where old_ty = idType id - old_w = varMult id + old_w = idMult id ------------------ -- | Substitute into some 'IdInfo' with regard to the supplied new 'Id'. @@ -590,13 +599,13 @@ = tyCoFVsOfCo fv_co (const True) emptyVarSet $! acc | otherwise , let fv_expr = lookupIdSubst subst fv - = exprFVs fv_expr (const True) emptyVarSet $! acc + = exprLocalFVs fv_expr (const True) emptyVarSet $! acc ------------------ -- | Drop free vars from the breakpoint if they have a non-variable substitution. substTickish :: Subst -> CoreTickish -> CoreTickish -substTickish subst (Breakpoint ext n ids modl) - = Breakpoint ext n (mapMaybe do_one ids) modl +substTickish subst (Breakpoint ext bid ids) + = Breakpoint ext bid (mapMaybe do_one ids) where do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst diff --git a/GHC/Core/Tidy.hs b/GHC/Core/Tidy.hs --- a/GHC/Core/Tidy.hs +++ b/GHC/Core/Tidy.hs @@ -16,12 +16,12 @@ import GHC.Core import GHC.Core.Type - +import GHC.Core.TyCo.Tidy import GHC.Core.Seq ( seqUnfolding ) + import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Demand ( zapDmdEnvSig, isStrUsedDmd ) -import GHC.Core.Coercion ( tidyCo ) import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Unique (getUnique) @@ -30,6 +30,7 @@ import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Types.Tickish + import GHC.Data.Maybe import GHC.Utils.Misc import Data.List (mapAccumL) @@ -234,8 +235,8 @@ ------------ Tickish -------------- tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish -tidyTickish env (Breakpoint ext ix ids modl) - = Breakpoint ext ix (map (tidyVarOcc env) ids) modl +tidyTickish env (Breakpoint ext bid ids) + = Breakpoint ext bid (map (tidyVarOcc env) ids) tidyTickish _ other_tickish = other_tickish ------------ Rules -------------- diff --git a/GHC/Core/TyCo/Compare.hs b/GHC/Core/TyCo/Compare.hs --- a/GHC/Core/TyCo/Compare.hs +++ b/GHC/Core/TyCo/Compare.hs @@ -12,7 +12,7 @@ eqVarBndrs, pickyEqType, tcEqType, tcEqKind, tcEqTypeNoKindCheck, - tcEqTyConApps, + tcEqTyConApps, tcEqTyConAppArgs, mayLookIdentical, -- * Type comparison @@ -226,12 +226,16 @@ -- are different, just checks the common prefix of arguments. tcEqTyConApps :: TyCon -> [Type] -> TyCon -> [Type] -> Bool tcEqTyConApps tc1 args1 tc2 args2 - = tc1 == tc2 && - and (zipWith tcEqTypeNoKindCheck args1 args2) + = tc1 == tc2 && tcEqTyConAppArgs args1 args2 + +tcEqTyConAppArgs :: [Type] -> [Type] -> Bool +-- Args do not have to have equal length; +-- we discard the excess of the longer one +tcEqTyConAppArgs args1 args2 + = and (zipWith tcEqTypeNoKindCheck args1 args2) -- No kind check necessary: if both arguments are well typed, then -- any difference in the kinds of later arguments would show up -- as differences in earlier (dependent) arguments - -- | Type equality on lists of types, looking through type synonyms eqTypes :: [Type] -> [Type] -> Bool diff --git a/GHC/Core/TyCo/FVs.hs b/GHC/Core/TyCo/FVs.hs --- a/GHC/Core/TyCo/FVs.hs +++ b/GHC/Core/TyCo/FVs.hs @@ -40,10 +40,6 @@ -- * Occurrence-check expansion occCheckExpand, - -- * Well-scoped free variables - scopedSort, tyCoVarsOfTypeWellScoped, - tyCoVarsOfTypesWellScoped, - -- * Closing over kinds closeOverKindsDSet, closeOverKindsList, closeOverKinds, @@ -72,7 +68,6 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Utils.Misc -import GHC.Utils.Panic import GHC.Data.Pair import Data.Semigroup @@ -988,107 +983,6 @@ noFreeVarsOfCo co = not $ DM.getAny (f co) where (_, _, f, _) = foldTyCo (afvFolder (const True)) emptyVarSet - -{- ********************************************************************* -* * - scopedSort -* * -********************************************************************* -} - -{- Note [ScopedSort] -~~~~~~~~~~~~~~~~~~~~ -Consider - - foo :: Proxy a -> Proxy (b :: k) -> Proxy (a :: k2) -> () - -This function type is implicitly generalised over [a, b, k, k2]. These -variables will be Specified; that is, they will be available for visible -type application. This is because they are written in the type signature -by the user. - -However, we must ask: what order will they appear in? In cases without -dependency, this is easy: we just use the lexical left-to-right ordering -of first occurrence. With dependency, we cannot get off the hook so -easily. - -We thus state: - - * These variables appear in the order as given by ScopedSort, where - the input to ScopedSort is the left-to-right order of first occurrence. - -Note that this applies only to *implicit* quantification, without a -`forall`. If the user writes a `forall`, then we just use the order given. - -ScopedSort is defined thusly (as proposed in #15743): - * Work left-to-right through the input list, with a cursor. - * If variable v at the cursor is depended on by any earlier variable w, - move v immediately before the leftmost such w. - -INVARIANT: The prefix of variables before the cursor form a valid telescope. - -Note that ScopedSort makes sense only after type inference is done and all -types/kinds are fully settled and zonked. - --} - --- | Do a topological sort on a list of tyvars, --- so that binders occur before occurrences --- E.g. given [ a::k, k::*, b::k ] --- it'll return a well-scoped list [ k::*, a::k, b::k ] --- --- This is a deterministic sorting operation --- (that is, doesn't depend on Uniques). --- --- It is also meant to be stable: that is, variables should not --- be reordered unnecessarily. This is specified in Note [ScopedSort] --- See also Note [Ordering of implicit variables] in "GHC.Rename.HsType" - -scopedSort :: [TyCoVar] -> [TyCoVar] -scopedSort = go [] [] - where - go :: [TyCoVar] -- already sorted, in reverse order - -> [TyCoVarSet] -- each set contains all the variables which must be placed - -- before the tv corresponding to the set; they are accumulations - -- of the fvs in the sorted tvs' kinds - - -- This list is in 1-to-1 correspondence with the sorted tyvars - -- INVARIANT: - -- all (\tl -> all (`subVarSet` head tl) (tail tl)) (tails fv_list) - -- That is, each set in the list is a superset of all later sets. - - -> [TyCoVar] -- yet to be sorted - -> [TyCoVar] - go acc _fv_list [] = reverse acc - go acc fv_list (tv:tvs) - = go acc' fv_list' tvs - where - (acc', fv_list') = insert tv acc fv_list - - insert :: TyCoVar -- var to insert - -> [TyCoVar] -- sorted list, in reverse order - -> [TyCoVarSet] -- list of fvs, as above - -> ([TyCoVar], [TyCoVarSet]) -- augmented lists - insert tv [] [] = ([tv], [tyCoVarsOfType (tyVarKind tv)]) - insert tv (a:as) (fvs:fvss) - | tv `elemVarSet` fvs - , (as', fvss') <- insert tv as fvss - = (a:as', fvs `unionVarSet` fv_tv : fvss') - - | otherwise - = (tv:a:as, fvs `unionVarSet` fv_tv : fvs : fvss) - where - fv_tv = tyCoVarsOfType (tyVarKind tv) - - -- lists not in correspondence - insert _ _ _ = panic "scopedSort" - --- | Get the free vars of a type in scoped order -tyCoVarsOfTypeWellScoped :: Type -> [TyVar] -tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList - --- | Get the free vars of types in scoped order -tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] -tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList {- ************************************************************************ diff --git a/GHC/Core/TyCo/Ppr.hs b/GHC/Core/TyCo/Ppr.hs --- a/GHC/Core/TyCo/Ppr.hs +++ b/GHC/Core/TyCo/Ppr.hs @@ -41,8 +41,11 @@ import GHC.Core.TyCo.Tidy import GHC.Core.TyCo.FVs import GHC.Core.Class -import GHC.Types.Var +import GHC.Core.Predicate( scopedSort ) import GHC.Core.Multiplicity( pprArrowWithMultiplicity ) + +import GHC.Types.Var + import GHC.Iface.Type import GHC.Types.Var.Set @@ -321,7 +324,7 @@ pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc] where (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc - user_bndrs = tyVarSpecToBinders $ dataConUserTyVarBinders dc + user_bndrs = dataConUserTyVarBinders dc forAllDoc = pprUserForAll user_bndrs thetaDoc = pprThetaArrowTy theta argsDoc = hsep (fmap pprParendType (map scaledThing arg_tys)) diff --git a/GHC/Core/TyCo/Rep.hs b/GHC/Core/TyCo/Rep.hs --- a/GHC/Core/TyCo/Rep.hs +++ b/GHC/Core/TyCo/Rep.hs @@ -37,7 +37,7 @@ -- * Coercions Coercion(..), CoSel(..), FunSel(..), UnivCoProvenance(..), - CoercionHole(..), coHoleCoVar, setCoHoleCoVar, isHeteroKindCoHole, + CoercionHole(..), coHoleCoVar, setCoHoleCoVar, CoercionN, CoercionR, CoercionP, KindCoercion, MCoercion(..), MCoercionR, MCoercionN, @@ -261,47 +261,9 @@ multiplicity argument nondependent in #20164. * Re the ft_af field: see Note [FunTyFlag] in GHC.Types.Var - See Note [Types for coercions, predicates, and evidence] - This visibility info makes no difference in Core; it matters - only when we regard the type as a Haskell source type. - -Note [Types for coercions, predicates, and evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We treat differently: - - (a) Predicate types - Test: isPredTy - Binders: DictIds - Kind: Constraint - Examples: (Eq a), and (a ~ b) - - (b) Coercion types are primitive, unboxed equalities - Test: isCoVarTy - Binders: CoVars (can appear in coercions) - Kind: TYPE (TupleRep []) - Examples: (t1 ~# t2) or (t1 ~R# t2) - - (c) Evidence types is the type of evidence manipulated by - the type constraint solver. - Test: isEvVarType - Binders: EvVars - Kind: Constraint or TYPE (TupleRep []) - Examples: all coercion types and predicate types - -Coercion types and predicate types are mutually exclusive, -but evidence types are a superset of both. - -When treated as a user type, - - - Predicates (of kind Constraint) are invisible and are - implicitly instantiated - - - Coercion types, and non-pred evidence types (i.e. not - of kind Constraint), are just regular old types, are - visible, and are not implicitly instantiated. - -In a FunTy { ft_af = af } and af = FTF_C_T or FTF_C_C, the argument -type is always a Predicate type. + See Note [Types for coercions, predicates, and evidence] in + GHC.Core.Predicate. This visibility info makes no difference in Core; + it matter only when we regard the type as a Haskell source type. Note [Weird typing rule for ForAllTy] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -983,7 +945,6 @@ ppr SelForAll = text "All" ppr (SelFun fs) = text "Fun" <> parens (ppr fs) - pprOneCharRole :: Role -> SDoc pprOneCharRole Nominal = char 'N' pprOneCharRole Representational = char 'R' @@ -994,6 +955,11 @@ ppr SelArg = text "arg" ppr SelRes = text "res" +instance NFData FunSel where + rnf SelMult = () + rnf SelArg = () + rnf SelRes = () + instance Binary CoSel where put_ bh (SelTyCon n r) = do { putByte bh 0; put_ bh n; put_ bh r } put_ bh SelForAll = putByte bh 1 @@ -1010,9 +976,9 @@ _ -> return (SelFun SelRes) } instance NFData CoSel where - rnf (SelTyCon n r) = n `seq` r `seq` () + rnf (SelTyCon n r) = rnf n `seq` rnf r `seq` () rnf SelForAll = () - rnf (SelFun fs) = fs `seq` () + rnf (SelFun fs) = rnf fs `seq` () -- | A semantically more meaningful type to represent what may or may not be a -- useful 'Coercion'. @@ -1092,19 +1058,21 @@ between ForallTys, or TyConApps, or FunTys. There are three forms, split by the CoSel field inside the SelCo: -SelTyCon, SelForAll, and SelFun. +SelTyCon, SelForAll, and SelFun. The typing rules below are directly +checked by the SelCo case of GHC.Core.Lint.lintCoercion. * SelTyCon: - co : (T s1..sn) ~r0 (T t1..tn) - T is a data type, not a newtype, nor an arrow type - r = tyConRole tc r0 i + co : (T s1..sn) ~r (T t1..tn) + T is not a saturated FunTyCon (use SelFun for that) + T is injective at role r + ri = tyConRole tc r i i < n (i is zero-indexed) ---------------------------------- - SelCo (SelTyCon i r) co : si ~r ti + SelCo (SelTyCon i ri) co : si ~ri ti - "Not a newtype": see Note [SelCo and newtypes] - "Not an arrow type": see SelFun below + "Injective at role r": see Note [SelCo and newtypes] + "Not saturated FunTyCon": see SelFun below See Note [SelCo Cached Roles] @@ -1200,11 +1168,12 @@ forall a. e_ty Note the Specified visibility of (forall a. e_ty); the Core type just isn't able to express more than one visiblity, and we pick `Specified`. See `exprType` and -`mkLamType` in GHC.Core.Utils, and `GHC.Type.Var.coreLamForAllTyFlag`. +`mkLamType` in GHC.Core.Utils, and `GHC.Type.Var.coreTyLamForAllTyFlag`. So how can we ever get a term of type (forall a -> e_ty)? Answer: /only/ via a -cast built with ForAllCo. See `GHC.Tc.Types.Evidence.mkWpForAllCast`. This does -not seem very satisfying, but it does the job. +cast built with ForAllCo. See `GHC.Core.Coercion.mkForAllVisCos`, +`GHC.Tc.Types.Evidence.mkWpForAllCast` and `GHC.Core.Make.mkCoreTyLams`. +This does not seem very satisfying, but it does the job. An alternative would be to put a visibility flag into `Lam` (a huge change), or into a `TyVar` (a more plausible change), but we leave that for the future. @@ -1220,14 +1189,15 @@ The typing rule is: - kind_co : k1 ~N k2 - tv1:k1 |- co : t1 ~r t2 + G |- kind_co : k1 ~N k2 + tv1 \not\in fv(typeKind(t1),typeKind(t2)) -- Skolem escape + G, tv1:k1 |- co : t1 ~r t2 if r=N, then vis1=vis2 ------------------------------------ - ForAllCo (tv1:k1) vis1 vis2 kind_co co - : forall (tv1:k1) . t1 + G |- ForAllCo (tv1:k1) vis1 vis2 kind_co co + : forall (tv1:k1) . t1 ~r - forall (tv1:k2) . (t2[tv1 |-> (tv1:k2) |> sym kind_co]) + forall (tv1:k2) . (t2[tv1 |-> (tv1:k2) |> sym kind_co]) Several things to note here @@ -1471,6 +1441,10 @@ Yikes! Clearly, this is terrible. The solution is simple: forbid SelCo to be used on newtypes if the internal coercion is representational. +More specifically, we use isInjectiveTyCon to determine whether +T is injective at role r: +* Newtypes and datatypes are both injective at Nominal role, but +* Newtypes are not injective at Representational role See the SelCo equation for GHC.Core.Lint.lintCoercion. This is not just some corner case discovered by a segfault somewhere; @@ -1566,9 +1540,9 @@ -- Why Ord? See Note [Ord instance of IfaceType] in GHC.Iface.Type instance Outputable UnivCoProvenance where - ppr PhantomProv = text "(phantom)" - ppr ProofIrrelProv = text "(proof irrel)" - ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) + ppr PhantomProv = text "(phantom)" + ppr (ProofIrrelProv {}) = text "(proof irrel)" + ppr (PluginProv str) = parens (text "plugin" <+> brackets (text str)) instance NFData UnivCoProvenance where rnf p = p `seq` () @@ -1679,19 +1653,11 @@ -- See Note [CoercionHoles and coercion free variables] , ch_ref :: IORef (Maybe Coercion) - - , ch_hetero_kind :: Bool - -- True <=> arises from a kind-level equality - -- See Note [Equalities with incompatible kinds] - -- in GHC.Tc.Solver.Equality, wrinkle (EIK2) } coHoleCoVar :: CoercionHole -> CoVar coHoleCoVar = ch_co_var -isHeteroKindCoHole :: CoercionHole -> Bool -isHeteroKindCoHole = ch_hetero_kind - setCoHoleCoVar :: CoercionHole -> CoVar -> CoercionHole setCoHoleCoVar h cv = h { ch_co_var = cv } @@ -1702,8 +1668,7 @@ dataTypeOf _ = mkNoRepType "CoercionHole" instance Outputable CoercionHole where - ppr (CoercionHole { ch_co_var = cv, ch_hetero_kind = hk }) - = braces (ppr cv <> ppWhen hk (text "[hk]")) + ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv) instance Uniquable CoercionHole where getUnique (CoercionHole { ch_co_var = cv }) = getUnique cv diff --git a/GHC/Core/TyCo/Subst.hs b/GHC/Core/TyCo/Subst.hs --- a/GHC/Core/TyCo/Subst.hs +++ b/GHC/Core/TyCo/Subst.hs @@ -13,9 +13,9 @@ Subst(..), TvSubstEnv, CvSubstEnv, IdSubstEnv, emptyIdSubstEnv, emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubst, emptySubst, mkEmptySubst, isEmptyTCvSubst, isEmptySubst, - mkTCvSubst, mkTvSubst, mkCvSubst, mkIdSubst, + mkSubst, mkTCvSubst, mkTvSubst, mkCvSubst, mkIdSubst, getTvSubstEnv, getIdSubstEnv, - getCvSubstEnv, getSubstInScope, setInScope, getSubstRangeTyCoFVs, + getCvSubstEnv, substInScopeSet, setInScope, getSubstRangeTyCoFVs, isInScope, elemSubst, notElemSubst, zapSubst, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, extendTCvSubst, extendTCvSubstWithClone, @@ -60,7 +60,7 @@ , mkAxiomCo, mkAppCo, mkGReflCo , mkInstCo, mkLRCo, mkTyConAppCo , mkCoercionType - , coercionKind, coercionLKind, coVarTypesRole ) + , coercionLKind, coVarTypesRole ) import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprTyVar ) import {-# SOURCE #-} GHC.Core.Ppr ( ) -- instance Outputable CoreExpr import {-# SOURCE #-} GHC.Core ( CoreExpr ) @@ -68,12 +68,10 @@ import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs -import GHC.Types.Basic( SwapFlag(..), isSwapped, pickSwap, notSwapped ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Data.Pair import GHC.Utils.Constants (debugIsOn) import GHC.Utils.Misc import GHC.Types.Unique.Supply @@ -104,9 +102,9 @@ data Subst = Subst InScopeSet -- Variables in scope (both Ids and TyVars) /after/ -- applying the substitution - IdSubstEnv -- Substitution from NcIds to CoreExprs - TvSubstEnv -- Substitution from TyVars to Types - CvSubstEnv -- Substitution from CoVars to Coercions + IdSubstEnv -- Substitution from InId to OutExpr + TvSubstEnv -- Substitution from InTyVar to OutType + CvSubstEnv -- Substitution from InCoVar to OutCoercion -- INVARIANT 1: See Note [The substitution invariant] -- This is what lets us deal with name capture properly @@ -115,7 +113,7 @@ -- see Note [Substitutions apply only once] -- -- INVARIANT 3: See Note [Extending the IdSubstEnv] in "GHC.Core.Subst" - -- and Note [Extending the TvSubstEnv and CvSubstEnv] + -- and Note [Extending the TvSubstEnv and CvSubstEnv] -- -- INVARIANT 4: See Note [Substituting types, coercions, and expressions] @@ -183,8 +181,10 @@ we use during unifications, it must not be repeatedly applied. Note [Extending the TvSubstEnv and CvSubstEnv] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See #tcvsubst_invariant# for the invariants that must hold. +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The TvSubstEnv and CvSubstEnv have a binding for each TyCoVar + - whose unique has changed, OR + - whose kind has changed This invariant allows a short-cut when the subst envs are empty: if the TvSubstEnv and CvSubstEnv are empty --- i.e. (isEmptyTCvSubst subst) @@ -207,7 +207,7 @@ * In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty Note [Substituting types, coercions, and expressions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Types and coercions are mutually recursive, and either may have variables "belonging" to the other. Thus, every time we wish to substitute in a type, we may also need to substitute in a coercion, and vice versa. @@ -271,6 +271,9 @@ isEmptyTCvSubst (Subst _ _ tv_env cv_env) = isEmptyVarEnv tv_env && isEmptyVarEnv cv_env +mkSubst :: InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst +mkSubst = Subst + mkTCvSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> Subst mkTCvSubst in_scope tvs cvs = Subst in_scope emptyIdSubstEnv tvs cvs @@ -295,8 +298,8 @@ getCvSubstEnv (Subst _ _ _ cenv) = cenv -- | Find the in-scope set: see Note [The substitution invariant] -getSubstInScope :: Subst -> InScopeSet -getSubstInScope (Subst in_scope _ _ _) = in_scope +substInScopeSet :: Subst -> InScopeSet +substInScopeSet (Subst in_scope _ _ _) = in_scope setInScope :: Subst -> InScopeSet -> Subst setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs @@ -501,7 +504,7 @@ , not (all isCoVar cvs) = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos) | otherwise - = mkVarEnv (zipEqual "zipCoEnv" cvs cos) + = mkVarEnv (zipEqual cvs cos) -- Pretty printing, for debugging only @@ -917,7 +920,7 @@ substForAllCoBndr :: Subst -> TyCoVar -> KindCoercion -> (Subst, TyCoVar, Coercion) substForAllCoBndr subst - = substForAllCoBndrUsing NotSwapped (substCo subst) subst + = substForAllCoBndrUsing (substCo subst) subst -- | Like 'substForAllCoBndr', but disables sanity checks. -- The problems that the sanity checks in substCo catch are described in @@ -927,33 +930,26 @@ substForAllCoBndrUnchecked :: Subst -> TyCoVar -> KindCoercion -> (Subst, TyCoVar, Coercion) substForAllCoBndrUnchecked subst - = substForAllCoBndrUsing NotSwapped (substCoUnchecked subst) subst + = substForAllCoBndrUsing (substCoUnchecked subst) subst -- See Note [Sym and ForAllCo] -substForAllCoBndrUsing :: SwapFlag -- Apply sym to binder? - -> (Coercion -> Coercion) -- transformation to kind co +substForAllCoBndrUsing :: (Coercion -> Coercion) -- transformation to kind co -> Subst -> TyCoVar -> KindCoercion -> (Subst, TyCoVar, KindCoercion) -substForAllCoBndrUsing sym sco subst old_var - | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var - | otherwise = substForAllCoCoVarBndrUsing sym sco subst old_var +substForAllCoBndrUsing sco subst old_var + | isTyVar old_var = substForAllCoTyVarBndrUsing sco subst old_var + | otherwise = substForAllCoCoVarBndrUsing sco subst old_var -substForAllCoTyVarBndrUsing :: SwapFlag -- Apply sym to binder? - -> (Coercion -> Coercion) -- transformation to kind co +substForAllCoTyVarBndrUsing :: (Coercion -> Coercion) -- transformation to kind co -> Subst -> TyVar -> KindCoercion -> (Subst, TyVar, KindCoercion) -substForAllCoTyVarBndrUsing sym sco (Subst in_scope idenv tenv cenv) old_var old_kind_co +substForAllCoTyVarBndrUsing sco (Subst in_scope idenv tenv cenv) old_var old_kind_co = assert (isTyVar old_var ) ( Subst (in_scope `extendInScopeSet` new_var) idenv new_env cenv , new_var, new_kind_co ) where - new_env | no_change, notSwapped sym - = delVarEnv tenv old_var - | isSwapped sym - = extendVarEnv tenv old_var $ - TyVarTy new_var `CastTy` new_kind_co - | otherwise - = extendVarEnv tenv old_var (TyVarTy new_var) + new_env | no_change = delVarEnv tenv old_var + | otherwise = extendVarEnv tenv old_var (TyVarTy new_var) no_kind_change = noFreeVarsOfCo old_kind_co no_change = no_kind_change && (new_var == old_var) @@ -969,20 +965,17 @@ new_var = uniqAway in_scope (setTyVarKind old_var new_ki1) -substForAllCoCoVarBndrUsing :: SwapFlag -- Apply sym to binder? - -> (Coercion -> Coercion) -- transformation to kind co +substForAllCoCoVarBndrUsing :: (Coercion -> Coercion) -- transformation to kind co -> Subst -> CoVar -> KindCoercion -> (Subst, CoVar, KindCoercion) -substForAllCoCoVarBndrUsing sym sco (Subst in_scope idenv tenv cenv) +substForAllCoCoVarBndrUsing sco (Subst in_scope idenv tenv cenv) old_var old_kind_co = assert (isCoVar old_var ) ( Subst (in_scope `extendInScopeSet` new_var) idenv tenv new_cenv , new_var, new_kind_co ) where - new_cenv | no_change, notSwapped sym - = delVarEnv cenv old_var - | otherwise - = extendVarEnv cenv old_var (mkCoVarCo new_var) + new_cenv | no_change = delVarEnv cenv old_var + | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var) no_kind_change = noFreeVarsOfCo old_kind_co no_change = no_kind_change && (new_var == old_var) @@ -990,10 +983,8 @@ new_kind_co | no_kind_change = old_kind_co | otherwise = sco old_kind_co - Pair h1 h2 = coercionKind new_kind_co - - new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type - new_var_type = pickSwap sym h1 h2 + new_ki1 = coercionLKind new_kind_co + new_var = uniqAway in_scope $ mkCoVar (varName old_var) new_ki1 substCoVar :: Subst -> CoVar -> Coercion substCoVar (Subst _ _ _ cenv) cv diff --git a/GHC/Core/TyCo/Tidy.hs b/GHC/Core/TyCo/Tidy.hs --- a/GHC/Core/TyCo/Tidy.hs +++ b/GHC/Core/TyCo/Tidy.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Tidying types and coercions for printing in error messages. module GHC.Core.TyCo.Tidy ( @@ -21,6 +19,7 @@ import GHC.Prelude import GHC.Data.FastString +import GHC.Core.Predicate( scopedSort ) import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs import GHC.Types.Name hiding (varName) @@ -358,7 +357,7 @@ go_cv cv = tidyTyCoVarOcc env cv - go_hole (CoercionHole cv r h) = (CoercionHole $! go_cv cv) r h + go_hole (CoercionHole cv r) = (CoercionHole $! go_cv cv) r -- Tidy even the holes; tidied types should have tidied kinds tidyCos :: TidyEnv -> [Coercion] -> [Coercion] diff --git a/GHC/Core/TyCon.hs b/GHC/Core/TyCon.hs --- a/GHC/Core/TyCon.hs +++ b/GHC/Core/TyCon.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -25,7 +24,8 @@ mkRequiredTyConBinder, mkAnonTyConBinder, mkAnonTyConBinders, tyConBinderForAllTyFlag, tyConBndrVisForAllTyFlag, isNamedTyConBinder, - isVisibleTyConBinder, isInvisibleTyConBinder, + isVisibleTyConBinder, isInvisSpecTyConBinder, isInvisibleTyConBinder, + isInferredTyConBinder, isVisibleTcbVis, isInvisSpecTcbVis, -- ** Field labels @@ -46,8 +46,9 @@ noTcTyConScopedTyVars, -- ** Predicates on TyCons - isAlgTyCon, isVanillaAlgTyCon, - isClassTyCon, isFamInstTyCon, + isAlgTyCon, isVanillaAlgTyCon, isClassTyCon, + isUnaryClassTyCon, isUnaryClassTyCon_maybe, + isFamInstTyCon, isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, isUnboxedSumTyCon, isPromotedTupleTyCon, @@ -59,7 +60,7 @@ isKindTyCon, isKindName, isLiftedTypeKindTyConName, isTauTyCon, isFamFreeTyCon, isForgetfulSynTyCon, - isDataTyCon, + isBoxedDataTyCon, isTypeDataTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, @@ -68,7 +69,7 @@ isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe, tyConInjectivityInfo, isBuiltInSynFamTyCon_maybe, - isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs, + isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe, isImplicitTyCon, isTyConWithSrcDataCons, @@ -86,8 +87,6 @@ tyConCType_maybe, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConSingleDataCon, - tyConAlgDataCons_maybe, - tyConSingleAlgDataCon_maybe, tyConFamilySize, tyConStupidTheta, tyConArity, @@ -181,6 +180,7 @@ import GHC.Utils.Misc import GHC.Types.Unique.Set import GHC.Unit.Module +import Control.DeepSeq import Language.Haskell.Syntax.Basic (FieldLabelString(..)) @@ -488,7 +488,7 @@ | tv `elemVarSet` dep_set = mkNamedTyConBinder Required tv | otherwise = mkAnonTyConBinder tv -tyConBinderForAllTyFlag :: TyConBinder -> ForAllTyFlag +tyConBinderForAllTyFlag :: VarBndr a TyConBndrVis -> ForAllTyFlag tyConBinderForAllTyFlag (Bndr _ vis) = tyConBndrVisForAllTyFlag vis tyConBndrVisForAllTyFlag :: TyConBndrVis -> ForAllTyFlag @@ -514,10 +514,22 @@ isInvisSpecTcbVis (NamedTCB Specified) = True isInvisSpecTcbVis _ = False +isInvisInferTcbVis :: TyConBndrVis -> Bool +isInvisInferTcbVis (NamedTCB Inferred) = True +isInvisInferTcbVis _ = False + +isInvisSpecTyConBinder :: VarBndr tv TyConBndrVis -> Bool +-- Works for IfaceTyConBinder too +isInvisSpecTyConBinder (Bndr _ tcb_vis) = isInvisSpecTcbVis tcb_vis + isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool -- Works for IfaceTyConBinder too isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb) +isInferredTyConBinder :: VarBndr var TyConBndrVis -> Bool +-- Works for IfaceTyConBinder too +isInferredTyConBinder (Bndr _ tcb_vis) = isInvisInferTcbVis tcb_vis + -- Build the 'tyConKind' from the binders and the result kind. -- Keep in sync with 'mkTyConKind' in GHC.Iface.Type. mkTyConKind :: [TyConBinder] -> Kind -> Kind @@ -719,7 +731,12 @@ 0 -> return AnonTCB _ -> do { vis <- get bh; return (NamedTCB vis) } } +instance NFData TyConBndrVis where + rnf AnonTCB = () + rnf (NamedTCB vis) = rnf vis + + {- ********************************************************************* * * The TyCon type @@ -1114,6 +1131,11 @@ -- in tcHasFixedRuntimeRep. } + | UnaryClassTyCon { -- See Note [Unary class magic], esp (UCM2) + -- INVARIANT: the algTcFlavour of this TyCon is ClassTyCon + data_con :: DataCon + } + mkSumTyConRhs :: [DataCon] -> AlgTyConRhs mkSumTyConRhs data_cons = SumTyCon data_cons (length data_cons) @@ -1169,11 +1191,12 @@ -- that visibility in this sense does not correspond to visibility in -- the context of any particular user program! visibleDataCons :: AlgTyConRhs -> [DataCon] -visibleDataCons (AbstractTyCon {}) = [] -visibleDataCons (DataTyCon{ data_cons = cs }) = cs -visibleDataCons (NewTyCon{ data_con = c }) = [c] -visibleDataCons (TupleTyCon{ data_con = c }) = [c] -visibleDataCons (SumTyCon{ data_cons = cs }) = cs +visibleDataCons (AbstractTyCon {}) = [] +visibleDataCons (DataTyCon{ data_cons = cs }) = cs +visibleDataCons (NewTyCon{ data_con = c }) = [c] +visibleDataCons (UnaryClassTyCon{ data_con = c }) = [c] +visibleDataCons (TupleTyCon{ data_con = c }) = [c] +visibleDataCons (SumTyCon{ data_cons = cs }) = cs -- | Describes the flavour of an algebraic type constructor. For -- classes and data families, this flavour includes a reference to @@ -1191,7 +1214,9 @@ | UnboxedSumTyCon -- | Type constructors representing a class dictionary. - -- See Note [ATyCon for classes] in "GHC.Core.TyCo.Rep" + -- See Note [ATyCon for classes] in "GHC.Types.TyThing" + -- INVARIANT: the algTcRhs is never NewTyCon; it could be + -- TupleTyCon, DataTyCon, UnaryClassTyCon | ClassTyCon Class -- INVARIANT: the classTyCon of this Class is the -- current tycon @@ -1409,6 +1434,194 @@ See also Note [Newtype eta and homogeneous axioms] in GHC.Tc.TyCl.Build. +Note [Unary class magic] +~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a class with just one method, or with no methods and one +superclass: + class UC a where { op :: a -> a } + class Eq a => UD a where {} +Such a class is called a /unary class/. + +We could represent the dictionary for a unary class with a data type: + data UC a where { MkUC :: (a->a) -> UC a } + data UD a where { MkUD :: Eq a => UD a } +But it would be more efficent to use a newtype; and for decades GHC did +exactly that, because: + + * Unary classes are surprisingly common, so it's a useful optimisation. + + * The `reflection` library uses `unsafeCoerce` to /rely/ on the fact that + a unary class is ultimately represented by its payload. We may not like + it, and I hope to ultimately eliminate the necessity for this by using + `withDict` (see Note [withDict] in GHC.Tc.Instance.Class). But meanwhile + we'd prefer not to break this usage. + +But alas, using a newtype representation (surprisingly) led multiple, subtle, +Bad Things: see Note [Representing unary classes with newtypes: bad, bad, bad]. + +This Note explains what GHC now does for unary classes. + +(UCM0) Throughout the compiler, right up to the code generator, GHC thinks that a + unary class is just like a non-unary class: + - Represented by a data type, + - with one constructor, + - which has one field + +(UCM1) Then when converting from Core to STG, in GHC.CoreToStg, we effectively + transform + - op ta tb tc dict_arg --> dict_arg + - MkUC ta tb tc meth_arg --> meth_arg + + Note that we do this transformation well /after/ generating an interface file, + so importing modules only see the data constructor. + + This late transformation has a lot in common with the treatment of + `unsafeEqualityProof`; see (U2) in Note [Implementing unsafeCoerce] + in GHC.Internal.Unsafe.Coerce. + +In this way we get the efficiency of a newtype without the bugs that we get +by exposing the newtype representation too early. + +There are a number of wrinkles + +(UCM2) The TyCon for a unary class is /not/ identified as a newtype. + Rather, it has its own AlgTyConRhs, namely `UnaryClassTyCon` + +(UCM3) Unlike non-unary classes, a value of type (C ty), where `C` is a unary + class, might be bottom, because it is represented by the method type alone. + See GHC.Core.Type.isTerminatingType. + + Similarly in exprOkForSpeculation/exprOkToDiscard/exprOkForSpecEval, + in GHC.Core.Utils. In the utility funcion `app_ok` we need a special + case for the DFunIds; they generally terminate, but not for unary classes. + +(UMC4) To avoid regressions, in Core we want to remember that + (MkUC x) is really just x + (op d) is really just d + We account for this in several places: + + - `GHC.Core.Utils.exprIsTrivial` treats the above two forms as trivial + + - `GHC.Core.Unfold.sizeExpr` (which computes the size of an expression to + guide inlining) treats (MkUC e) as the same size as `e`, and similarly + (op d). + + - `GHC.Core.Unfold.inlineBoringOK` where we want to ensure that we + always-inline (MkUC op), even into a boring context. See (IB6) + in Note [inlineBoringOk] + +(UCM5) `GHC.Core.Unfold.Make.mkDFunUnfolding` builds a `DFunUnfolding` for + non-unary classes, but just an /ordinary/ unfolding for unary classes. + instance Num a => Num [a] where { .. } -- (I1) + instance UC a => UC [a] where { op = $cop } -- (I2) + From (I1) we get + $fNumList = /\a \(d:Num a). MkNum (..) (..) (..) + -- $fNumList has a DFunUnfolding + But from (I2) we get + $fUCList = /\a (d:UC a). MkUC ($cop a d) + -- $fUCList has a regular CoreUnfolding + + Why? Because we can safely inline $fUCList without code-size blow-up. + Just one less indirection. It'd probably work ok with a DFunUnfolding; + and it'd add another case for (UCM4) to spot. + +(UCM6) In the constraint solver, when constructing evidence for a unary class + (e.g. implicit parameters, withDict) be careful to use + - the data constructor to build it: see `evDictApp`, `evUnaryDictAppE` + - the class op to take it apart: see `evUnwrapIP` + +(UCM7) You might worry about + class UC1 a where { op :: Int# } -- Single unboxed field + class (a ~# b) => UC2 a b where {} -- Unboxed equality superclass + But these are illegal: predicates are always boxed, and all classes must have + lifted fields. + +(UCM8) The data constructor for a unary class has no wrapper, just a worker. + (And the worker is turned into a cast by GHC.CoreToStg.Prep.isUnaryClassApp, + as described above.) + +(UCM9) Unary classes are treated as injective by `isInjectiveTyCon`, just like + non-unary classes (which are TupleTyCons or DataTyCons). This matters, + because of the injectivity check done by lintCoercion (SelCo cs co) + in GHC.Core.Lint. There is a similar injectivity check in + GHC.Core.Opt.Arity.pushCoDataCon. + + Generally, we want unary classes to behave like ordinary non-unary ones. + +(UCM10) When, precisely, is a class unary? It is unary iff + it has one field (superclass or method) + of boxed type + The boxed-ness important. Consider + class (a ~# b) => a ~ b where {} + which is `eqClass` in GHC.Builtin.Types. This has only one field, but it is + definitely not a unary class: it is definitely represented by an ordinary + algebraic data type with a single field of type (a ~# b). + + See `unary_class` in `GHC.Tc.TyCl.tcClassDecl1` + +(UCM11) When building evidence for classes (unary or not) and implicit parameters, + the constraint solver is careful to use functions that hide the precise + evidence construction method. Eg.g `evWrapIPE`. + +(UCM12) In an interface-file description of a Class, we record whether or not + the class is unary. In theory this field is redundant, but because its value + depends on the superclass and method fields, it's very easy to end up with + a black hole when rehydrating interface the interface file. Easiest just to + store the bit! See `ifUnary` in GHC.Iface.Synatax.IfaceClassBody. + + +Note [Representing unary classes with newtypes: bad, bad, bad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In the past we represented a unary class with a newtype, but that led to +some at least three really subtle bad consequences. + +* Problem 1: When we represented unary classes via a newtype, the + newtype axiom looked like + t1::CONSTRAINT r ~ t2::TYPE r + If TYPE and CONSTRAINT are apart, this can create unsoundness, via KindCo; + see #21623. Now we never make such a coercion, so that worry about TYPE + being apart from CONSTRAINT has gone away entirely. Hooray. + +* Problem 2: a horrible hack in GHC.Core.Opt.OccurAnal.scrutOkForBinderSwap; + see Historical Note [Care with binder-swap on dictionaries]. + Now the hack is gone. + +* Problem 3: bogus specialisation. The gory details are explained + at https://gitlab.haskell.org/ghc/ghc/-/issues/23109#note_499130 + + We had (using newtype classes) + newtype SNat a = MKSNat Natural -- axiom snCo a :: SNat a ~ Natural + class KNat a where { natSing :: SNat a } -- axiom knCo a :: KNat a ~ SNat a + and a pattern match + K @a (g : 32 ~ a+1) -> ...(foo @a (d :: KNat a))... + where K is a data constructor binding `a` as an existential. + + In the code I was looking at, after lots of inlining an simplification, we find + that (d::KNat a) is built like this: + (d1 :: KNat 32) = 32 |> sym (snCo 32) |> sym (knCo 32) + (d2 :: SNat (a+1)) = d1 |> knCo g + (d3 :: Natural) = d2 |> snCo (a+1) + (d4 :: Natural) = d3 - 1 + (d :: KNat a) = d4 |> sym (snCo a) |> sym (knCo a) + + But d3 :: Natural = 32 |> (co's involving g) :: Natural ~ Natural + and that is just Refl. So we drop all the co's, including the crucial `g`, + and just say d3 = 32; and + d :: KNat a = (32-1) |> sym (snCo a) |> sym (knCo a) + Now, we can float `d` outwards, crucially aided by polymorphic specialisation, + (Note [Specialising polymorphic dictionaries] in GHC.Core.Opt.Specialise) + and use that evidence to get an utterly bogus specialisation for the function + foo :: forall b. KNat b => blah + + Solution: don't use newtype classes. Then we get + (d1 :: KNat 32) = MkKN @32 (32 |> sym (snCo 32)) + (d2 :: SNat (a+1)) = natSing d1 |> SN g + (d3 :: Natural) = d2 |> snCo (a+1) + (d4 :: Natural) = d3 -1 + (d :: KNat a) = MkKN @a (d4 |> sym (snCo a)) + Now we don't get cancelling-out coercions. + + ************************************************************************ * * TyConRepName @@ -1542,11 +1755,7 @@ -- "GHC.Types.RepType" and Note [VoidRep] in "GHC.Types.RepType". data PrimRep -- Unpacking of sum types is only supported since 9.6.1 -#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) = BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value -#else - = BoxedRep !(Maybe Levity) -- ^ Boxed, heap value -#endif | Int8Rep -- ^ Signed, 8-bit value | Int16Rep -- ^ Signed, 16-bit value | Int32Rep -- ^ Signed, 32-bit value @@ -1986,21 +2195,26 @@ -- satisfies condition DTT2 of Note [DataToTag overview] in -- GHC.Tc.Instance.Class isValidDTT2TyCon :: TyCon -> Bool -isValidDTT2TyCon = isDataTyCon +isValidDTT2TyCon = isBoxedDataTyCon -isDataTyCon :: TyCon -> Bool +isBoxedDataTyCon :: TyCon -> Bool -- ^ Returns @True@ for data types that are /definitely/ represented by -- heap-allocated constructors. These are scrutinised by Core-level -- @case@ expressions, and they get info tables allocated for them. -- --- Generally, the function will be true for all @data@ types and false --- for @newtype@s, unboxed tuples, unboxed sums and type family --- 'TyCon's. But it is not guaranteed to return @True@ in all cases +-- Generally, the function will be +-- true for all `data` types and +-- false for newtype +-- unboxed tuples +-- unboxed sums +-- type family +-- type data +-- 'TyCon's. But it is not guaranteed to return `True` in all cases -- that it could. -- -- NB: for a data type family, only the /instance/ 'TyCon's -- get an info table. The family declaration 'TyCon' does not -isDataTyCon (TyCon { tyConDetails = details }) +isBoxedDataTyCon (TyCon { tyConDetails = details }) | AlgTyCon {algTcRhs = rhs} <- details = case rhs of TupleTyCon { tup_sort = sort } @@ -2011,8 +2225,9 @@ -- See Note [Type data declarations] in GHC.Rename.Module. DataTyCon { is_type_data = type_data } -> not type_data NewTyCon {} -> False + UnaryClassTyCon {} -> False AbstractTyCon {} -> False -- We don't know, so return False -isDataTyCon _ = False +isBoxedDataTyCon _ = False -- | Was this 'TyCon' declared as "type data"? -- See Note [Type data declarations] in GHC.Rename.Module. @@ -2029,23 +2244,34 @@ -- See also Note [Decomposing TyConApp equalities] in "GHC.Tc.Solver.Equality" isInjectiveTyCon :: TyCon -> Role -> Bool isInjectiveTyCon (TyCon { tyConDetails = details }) role - = go details role + = go details where - go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! - go (AlgTyCon {}) Nominal = True - go (AlgTyCon {algTcRhs = rhs}) Representational = isGenInjAlgRhs rhs - go (SynonymTyCon {}) _ = False + go _ | Phantom <- role = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! + + go (AlgTyCon {algTcRhs = rhs}) + | Nominal <- role = True + | Representational <- role = go_alg_rep rhs + go (FamilyTyCon { famTcFlav = DataFamilyTyCon _ }) - Nominal = True - go (FamilyTyCon { famTcInj = Injective inj }) Nominal = and inj - go (FamilyTyCon {}) _ = False - go (PrimTyCon {}) _ = True - go (PromotedDataCon {}) _ = True - go (TcTyCon {}) _ = True + | Nominal <- role = True + go (FamilyTyCon { famTcInj = Injective inj }) + | Nominal <- role = and inj + go (FamilyTyCon {}) = False - -- Reply True for TcTyCon to minimise knock on type errors - -- See (W1) in Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl + go (SynonymTyCon {}) = False + go (PrimTyCon {}) = True + go (PromotedDataCon {}) = True + go (TcTyCon {}) = True + -- Reply True for TcTyCon to minimise knock on type errors + -- See (W1) in Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] in GHC.Tc.TyCl + -- go_alg_rep used only at Representational role + go_alg_rep (TupleTyCon {}) = True + go_alg_rep (SumTyCon {}) = True + go_alg_rep (DataTyCon {}) = True + go_alg_rep (UnaryClassTyCon {}) = True -- See (UCM9) in Note [Unary class magic] + go_alg_rep (AbstractTyCon {}) = False + go_alg_rep (NewTyCon {}) = False -- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds -- (where r is the role passed in): @@ -2065,15 +2291,6 @@ -- In all other cases, injectivity implies generativity go r _ = isInjectiveTyCon tc r --- | Is this an 'AlgTyConRhs' of a 'TyCon' that is generative and injective --- with respect to representational equality? -isGenInjAlgRhs :: AlgTyConRhs -> Bool -isGenInjAlgRhs (TupleTyCon {}) = True -isGenInjAlgRhs (SumTyCon {}) = True -isGenInjAlgRhs (DataTyCon {}) = True -isGenInjAlgRhs (AbstractTyCon {}) = False -isGenInjAlgRhs (NewTyCon {}) = False - -- | Is this 'TyCon' that for a @newtype@ isNewTyCon :: TyCon -> Bool isNewTyCon (TyCon { tyConDetails = details }) @@ -2188,9 +2405,11 @@ isEnumerationTyCon (TyCon { tyConArity = arity, tyConDetails = details }) | AlgTyCon { algTcRhs = rhs } <- details = case rhs of - DataTyCon { is_enum = res } -> res - TupleTyCon {} -> arity == 0 - _ -> False + DataTyCon { is_enum = res } -> res + TupleTyCon { tup_sort = tsort } + | arity == 0 -> isBoxed (tupleSortBoxity tsort) + -- () is an enumeration, but (##) is not + _ -> False | otherwise = False -- | Is this a 'TyCon', synonym or otherwise, that defines a family? @@ -2448,6 +2667,8 @@ SumTyCon {} -> False -- only unboxed sums here + UnaryClassTyCon {} -> True -- Always boxed + NewTyCon { nt_fixed_rep = fixed_rep } -> fixed_rep -- A newtype might not have a fixed runtime representation -- with UnliftedNewtypes (#17360) @@ -2579,11 +2800,12 @@ tyConDataCons_maybe (TyCon { tyConDetails = details }) | AlgTyCon {algTcRhs = rhs} <- details = case rhs of - DataTyCon { data_cons = cons } -> Just cons - NewTyCon { data_con = con } -> Just [con] - TupleTyCon { data_con = con } -> Just [con] - SumTyCon { data_cons = cons } -> Just cons - _ -> Nothing + DataTyCon { data_cons = cons } -> Just cons + NewTyCon { data_con = con } -> Just [con] + UnaryClassTyCon { data_con = con } -> Just [con] + TupleTyCon { data_con = con } -> Just [con] + SumTyCon { data_cons = cons } -> Just cons + _ -> Nothing tyConDataCons_maybe _ = Nothing -- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ @@ -2594,11 +2816,12 @@ tyConSingleDataCon_maybe (TyCon { tyConDetails = details }) | AlgTyCon { algTcRhs = rhs } <- details = case rhs of - DataTyCon { data_cons = [c] } -> Just c - TupleTyCon { data_con = c } -> Just c - NewTyCon { data_con = c } -> Just c - _ -> Nothing - | otherwise = Nothing + DataTyCon { data_cons = [c] } -> Just c + TupleTyCon { data_con = c } -> Just c + NewTyCon { data_con = c } -> Just c + UnaryClassTyCon { data_con = c } -> Just c + _ -> Nothing + | otherwise = Nothing -- | Like 'tyConSingleDataCon_maybe', but panics if 'Nothing'. tyConSingleDataCon :: TyCon -> DataCon @@ -2607,23 +2830,6 @@ Just c -> c Nothing -> pprPanic "tyConDataCon" (ppr tc) --- | Like 'tyConSingleDataCon_maybe', but returns 'Nothing' for newtypes. -tyConSingleAlgDataCon_maybe :: TyCon -> Maybe DataCon -tyConSingleAlgDataCon_maybe tycon - | isNewTyCon tycon = Nothing - | otherwise = tyConSingleDataCon_maybe tycon - --- | Returns @Just dcs@ if the given 'TyCon' is a @data@ type, a tuple type --- or a sum type with data constructors dcs. If the 'TyCon' has more than one --- constructor, or represents a primitive or function type constructor then --- @Nothing@ is returned. --- --- Like 'tyConDataCons_maybe', but returns 'Nothing' for newtypes. -tyConAlgDataCons_maybe :: TyCon -> Maybe [DataCon] -tyConAlgDataCons_maybe tycon - | isNewTyCon tycon = Nothing - | otherwise = tyConDataCons_maybe tycon - -- | Determine the number of value constructors a 'TyCon' has. Panics if the -- 'TyCon' is not algebraic or a tuple tyConFamilySize :: TyCon -> Int @@ -2632,6 +2838,7 @@ = case rhs of DataTyCon { data_cons_size = size } -> size NewTyCon {} -> 1 + UnaryClassTyCon {} -> 1 TupleTyCon {} -> 1 SumTyCon { data_cons_size = size } -> size _ -> pprPanic "tyConFamilySize 1" (ppr tc) @@ -2721,6 +2928,22 @@ | FamilyTyCon {famTcFlav = flav} <- details = Just flav | otherwise = Nothing +isUnaryClassTyCon :: TyCon -> Bool +isUnaryClassTyCon tc@(TyCon { tyConDetails = details }) + | AlgTyCon { algTcFlavour = flav, algTcRhs = UnaryClassTyCon {} } <- details + = assertPpr (case flav of { ClassTyCon {} -> True; _ -> False }) (ppr tc) $ + True + | otherwise + = False + +isUnaryClassTyCon_maybe :: TyCon -> Maybe (Class, DataCon) +isUnaryClassTyCon_maybe (TyCon { tyConDetails = details }) + | AlgTyCon { algTcFlavour = ClassTyCon cls _ + , algTcRhs = UnaryClassTyCon { data_con = dc } } <- details + = Just (cls, dc) + | otherwise + = Nothing + -- | Is this 'TyCon' that for a class instance? isClassTyCon :: TyCon -> Bool isClassTyCon (TyCon { tyConDetails = details }) @@ -2835,11 +3058,12 @@ SumTyCon {} -> SumFlavour DataTyCon {} -> DataTypeFlavour NewTyCon {} -> NewtypeFlavour + UnaryClassTyCon {} -> ClassFlavour AbstractTyCon {} -> AbstractTypeFlavour | FamilyTyCon { famTcFlav = flav, famTcParent = parent } <- details = case flav of - DataFamilyTyCon{} -> OpenFamilyFlavour IAmData parent + DataFamilyTyCon{} -> OpenFamilyFlavour (IAmData DataType) parent OpenSynFamilyTyCon -> OpenFamilyFlavour IAmType parent ClosedSynFamilyTyCon{} -> ClosedTypeFamilyFlavour AbstractClosedSynFamilyTyCon -> ClosedTypeFamilyFlavour @@ -2860,7 +3084,7 @@ tcFlavourMustBeSaturated AbstractTypeFlavour {} = False tcFlavourMustBeSaturated BuiltInTypeFlavour = False tcFlavourMustBeSaturated PromotedDataConFlavour = False -tcFlavourMustBeSaturated (OpenFamilyFlavour td _)= case td of { IAmData -> False; IAmType -> True } +tcFlavourMustBeSaturated (OpenFamilyFlavour td _)= case td of { IAmData {} -> False; IAmType -> True } tcFlavourMustBeSaturated TypeSynonymFlavour = True tcFlavourMustBeSaturated ClosedTypeFamilyFlavour = True @@ -2908,6 +3132,10 @@ 0 -> return NotInjective _ -> do { xs <- get bh ; return (Injective xs) } } + +instance NFData Injectivity where + rnf NotInjective = () + rnf (Injective xs) = rnf xs -- | Returns whether or not this 'TyCon' is definite, or a hole -- that may be filled in at some later point. See Note [Skolem abstract data] diff --git a/GHC/Core/TyCon/Env.hs b/GHC/Core/TyCon/Env.hs --- a/GHC/Core/TyCon/Env.hs +++ b/GHC/Core/TyCon/Env.hs @@ -103,7 +103,7 @@ anyTyConEnv f x = nonDetFoldUFM ((||) . f) False x disjointTyConEnv x y = disjointUFM x y -lookupTyConEnv_NF env n = expectJust "lookupTyConEnv_NF" (lookupTyConEnv env n) +lookupTyConEnv_NF env n = expectJust (lookupTyConEnv env n) -- | Deterministic TyCon Environment -- diff --git a/GHC/Core/Type.hs b/GHC/Core/Type.hs --- a/GHC/Core/Type.hs +++ b/GHC/Core/Type.hs @@ -33,7 +33,7 @@ mkScaledFunTys, mkInvisFunTy, mkInvisFunTys, tcMkVisFunTy, tcMkScaledFunTys, tcMkInvisFunTy, - splitFunTy, splitFunTy_maybe, + splitFunTy, splitFunTy_maybe, splitVisibleFunTy_maybe, splitFunTys, funResultTy, funArgTy, funTyConAppTy_maybe, funTyFlagTyCon, tyConAppFunTy_maybe, tyConAppFunCo_maybe, @@ -55,7 +55,7 @@ splitForAllForAllTyBinders, splitForAllForAllTyBinder_maybe, splitForAllTyCoVar_maybe, splitForAllTyCoVar, splitForAllTyVar_maybe, splitForAllCoVar_maybe, - splitPiTy_maybe, splitPiTy, splitPiTys, + splitPiTy_maybe, splitPiTy, splitPiTys, collectPiTyBinders, getRuntimeArgTys, mkTyConBindersPreferAnon, mkPiTy, mkPiTys, @@ -69,8 +69,6 @@ mkCharLitTy, isCharLitTy, isLitTy, - isPredTy, - getRuntimeRep, splitRuntimeRep_maybe, kindRep_maybe, kindRep, getLevity, levityType_maybe, @@ -82,8 +80,7 @@ coAxNthLHS, stripCoercionTy, - splitInvisPiTys, splitInvisPiTysN, - invisibleTyBndrCount, + splitInvisPiTys, splitInvisPiTysN, invisibleBndrCount, filterOutInvisibleTypes, filterOutInferredTypes, partitionInvisibleTypes, partitionInvisibles, tyConForAllTyFlags, appTyForAllTyFlags, @@ -122,7 +119,7 @@ mkTYPEapp, mkTYPEapp_maybe, mkCONSTRAINTapp, mkCONSTRAINTapp_maybe, mkBoxedRepApp_maybe, mkTupleRepApp_maybe, - typeOrConstraintKind, + typeOrConstraintKind, liftedTypeOrConstraintKind, -- *** Levity and boxity sORTKind_maybe, typeTypeOrConstraint, @@ -135,7 +132,7 @@ kindBoxedRepLevity_maybe, mightBeLiftedType, mightBeUnliftedType, definitelyLiftedType, definitelyUnliftedType, - isAlgType, isDataFamilyAppType, + isAlgType, isDataFamilyApp, isSatTyFamApp, isPrimitiveType, isStrictType, isTerminatingType, isLevityTy, isLevityVar, isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy, @@ -178,10 +175,6 @@ closeOverKindsDSet, closeOverKindsList, closeOverKinds, - -- * Well-scoped lists of variables - scopedSort, tyCoVarsOfTypeWellScoped, - tyCoVarsOfTypesWellScoped, - -- * Forcing evaluation of types seqType, seqTypes, @@ -202,7 +195,7 @@ zipTCvSubst, notElemSubst, getTvSubstEnv, - zapSubst, getSubstInScope, setInScope, getSubstRangeTyCoFVs, + zapSubst, substInScopeSet, setInScope, getSubstRangeTyCoFVs, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, extendTCvSubst, extendCvSubst, extendTvSubst, extendTvSubstList, extendTvSubstAndInScope, @@ -223,20 +216,10 @@ substTyCoBndr, substTyVarToTyVar, cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar, - -- * Tidying type related things up for printing - tidyType, tidyTypes, - tidyOpenType, tidyOpenTypes, - tidyOpenTypeX, tidyOpenTypesX, - tidyVarBndr, tidyVarBndrs, - tidyFreeTyCoVars, - tidyFreeTyCoVarX, tidyFreeTyCoVarsX, - tidyTyCoVarOcc, - tidyTopType, - tidyForAllTyBinder, tidyForAllTyBinders, - -- * Kinds isTYPEorCONSTRAINT, - isConcreteType, isFixedRuntimeRepKind, + isConcreteType, + isFixedRuntimeRepKind ) where import GHC.Prelude @@ -248,7 +231,6 @@ import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Subst -import GHC.Core.TyCo.Tidy import GHC.Core.TyCo.FVs -- friends: @@ -291,6 +273,7 @@ import GHC.Data.FastString import GHC.Data.Maybe ( orElse, isJust, firstJust ) +import GHC.List (build) -- $type_classification -- #type_classification# @@ -576,11 +559,7 @@ go_co _ (HoleCo h) = pprPanic "expandTypeSynonyms hit a hole" (ppr h) - -- the "False" and "const" are to accommodate the type of - -- substForAllCoBndrUsing, which is general enough to - -- handle coercion optimization (which sometimes swaps the - -- order of a coercion) - go_cobndr subst = substForAllCoBndrUsing NotSwapped (go_co subst) subst + go_cobndr subst = substForAllCoBndrUsing (go_co subst) subst {- Notes on type synonyms ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1443,6 +1422,15 @@ | FunTy af w arg res <- coreFullView ty = Just (af, w, arg, res) | otherwise = Nothing +{-# INLINE splitVisibleFunTy_maybe #-} +splitVisibleFunTy_maybe :: Type -> Maybe (Type, Type) +-- ^ Works on visible function types only (t1 -> t2), and +-- returns t1 and t2, but not the multiplicity +splitVisibleFunTy_maybe ty + | FunTy af _ arg res <- coreFullView ty + , isVisibleFunArg af = Just (arg, res) + | otherwise = Nothing + splitFunTys :: Type -> ([Scaled Type], Type) splitFunTys ty = split [] ty ty where @@ -2047,6 +2035,18 @@ split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs split orig_ty _ bs = (reverse bs, orig_ty) +collectPiTyBinders :: Type -> [PiTyBinder] +collectPiTyBinders ty = build $ \c n -> + let + split (ForAllTy b res) = Named b `c` split res + split (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res }) + = Anon (Scaled w arg) af `c` split res + split ty | Just ty' <- coreView ty = split ty' + split _ = n + in + split ty +{-# INLINE collectPiTyBinders #-} + -- | Extracts a list of run-time arguments from a function type, -- looking through newtypes to the right of arrows. -- @@ -2088,12 +2088,12 @@ | otherwise = [] -invisibleTyBndrCount :: Type -> Int +invisibleBndrCount :: Type -> Int -- Returns the number of leading invisible forall'd binders in the type -- Includes invisible predicate arguments; e.g. for -- e.g. forall {k}. (k ~ *) => k -> k -- returns 2 not 1 -invisibleTyBndrCount ty = length (fst (splitInvisPiTys ty)) +invisibleBndrCount ty = length (fst (splitInvisPiTys ty)) -- | Like 'splitPiTys', but returns only *invisible* binders, including constraints. -- Stops at the first visible binder. @@ -2291,6 +2291,21 @@ isFamFreeTy (CastTy ty _) = isFamFreeTy ty isFamFreeTy (CoercionTy _) = False -- Not sure about this +-- | Check whether a type is a data family type +isDataFamilyApp :: Type -> Bool +isDataFamilyApp ty = case tyConAppTyCon_maybe ty of + Just tc -> isDataFamilyTyCon tc + _ -> False + +isSatTyFamApp :: Type -> Maybe (TyCon, [Type]) +-- Return the argument if we have a saturated type family application +-- Why saturated? See (ATF4) in Note [Apartness and type families] +isSatTyFamApp (TyConApp tc tys) + | isTypeFamilyTyCon tc + && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated + = Just (tc, tys) +isSatTyFamApp _ = Nothing + buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind -- ^ /result/ kind -> [Role] -> KnotTied Type -> TyCon -- This function is here because here is where we have @@ -2458,12 +2473,6 @@ isAlgTyCon tc _other -> False --- | Check whether a type is a data family type -isDataFamilyAppType :: Type -> Bool -isDataFamilyAppType ty = case tyConAppTyCon_maybe ty of - Just tc -> isDataFamilyTyCon tc - _ -> False - -- | Computes whether an argument (or let right hand side) should -- be computed strictly or lazily, based only on its type. -- Currently, it's just 'isUnliftedType'. @@ -2478,7 +2487,9 @@ -- NB: unlifted types are not terminating types! -- e.g. you can write a term (loop 1)::Int# that diverges. isTerminatingType ty = case tyConAppTyCon_maybe ty of - Just tc -> isClassTyCon tc && not (isNewTyCon tc) + Just tc -> isClassTyCon tc && not (isUnaryClassTyCon tc) + -- A non-unary class TyCon is terminating + -- See (UCM3) in Note [Unary class magic] in GHC.Core.TyCon _ -> False isPrimitiveType :: Type -> Bool @@ -2664,9 +2675,7 @@ -- No need to expand synonyms typeKind (TyConApp tc tys) = piResultTys (tyConKind tc) tys typeKind (LitTy l) = typeLiteralKind l -typeKind (FunTy { ft_af = af }) = case funTyFlagResultTypeOrConstraint af of - TypeLike -> liftedTypeKind - ConstraintLike -> constraintKind +typeKind (FunTy { ft_af = af }) = liftedTypeOrConstraintKind (funTyFlagResultTypeOrConstraint af) typeKind (TyVarTy tyvar) = tyVarKind tyvar typeKind (CastTy _ty co) = coercionRKind co typeKind (CoercionTy co) = coercionType co @@ -2698,10 +2707,10 @@ lifted_kind_from_body -- Implements (FORALL2) = case sORTKind_maybe body_kind of - Just (ConstraintLike, _) -> constraintKind - Just (TypeLike, _) -> liftedTypeKind - Nothing -> pprPanic "typeKind" (ppr body_kind) + Just (torc, _) -> liftedTypeOrConstraintKind torc + Nothing -> pprPanic "typeKind" (ppr body_kind) + --------------------------------------------- sORTKind_maybe :: Kind -> Maybe (TypeOrConstraint, Type) @@ -2740,14 +2749,6 @@ | otherwise -> pprPanic "typeOrConstraint" (ppr ty <+> dcolon <+> ppr (typeKind ty)) -isPredTy :: HasDebugCallStack => Type -> Bool --- Precondition: expects a type that classifies values --- See Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep --- Returns True for types of kind (CONSTRAINT _), False for ones of kind (TYPE _) -isPredTy ty = case typeTypeOrConstraint ty of - TypeLike -> False - ConstraintLike -> True - -- | Does this classify a type allowed to have values? Responds True to things -- like *, TYPE Lifted, TYPE IntRep, TYPE v, Constraint. isTYPEorCONSTRAINT :: Kind -> Bool @@ -2850,12 +2851,14 @@ isConcreteType :: Type -> Bool isConcreteType = isConcreteTypeWith emptyVarSet -isConcreteTypeWith :: TyVarSet -> Type -> Bool +-- | Like 'isConcreteType', but allows passing in a set of 'TyVar's that +-- should be considered concrete. +-- -- See Note [Concrete types] in GHC.Tc.Utils.Concrete. --- For this "With" version we pass in a set of TyVars to be considered --- concrete. This supports mkSynonymTyCon, which needs to test the RHS --- for concreteness, under the assumption that the binders are instantiated --- to concrete types +isConcreteTypeWith :: TyVarSet -> Type -> Bool +-- This version, with a 'TyVarSet' argument, supports 'mkSynonymTyCon', +-- which needs to test the RHS for concreteness, under the assumption that +-- the binders are instantiated to concrete types isConcreteTypeWith conc_tvs = go where go (TyVarTy tv) = isConcreteTyVar tv || tv `elemVarSet` conc_tvs @@ -2869,6 +2872,7 @@ go CastTy{} = False go CoercionTy{} = False + go_tc :: TyCon -> [Type] -> Bool go_tc tc tys | isForgetfulSynTyCon tc -- E.g. type S a = Int -- Then (S x) is concrete even if x isn't @@ -2884,7 +2888,6 @@ | otherwise -- E.g. type families = False - {- %************************************************************************ %* * @@ -3429,3 +3432,7 @@ typeOrConstraintKind :: TypeOrConstraint -> RuntimeRepType -> Kind typeOrConstraintKind TypeLike rep = mkTYPEapp rep typeOrConstraintKind ConstraintLike rep = mkCONSTRAINTapp rep + +liftedTypeOrConstraintKind :: TypeOrConstraint -> Kind +liftedTypeOrConstraintKind TypeLike = liftedTypeKind +liftedTypeOrConstraintKind ConstraintLike = constraintKind diff --git a/GHC/Core/Type.hs-boot b/GHC/Core/Type.hs-boot --- a/GHC/Core/Type.hs-boot +++ b/GHC/Core/Type.hs-boot @@ -9,31 +9,18 @@ import GHC.Types.Var( FunTyFlag, TyVar ) import GHC.Types.Basic( TypeOrConstraint ) -isPredTy :: HasDebugCallStack => Type -> Bool -isCoercionTy :: Type -> Bool -mkAppTy :: Type -> Type -> Type -mkCastTy :: Type -> Coercion -> Type -mkTyConApp :: TyCon -> [Type] -> Type -mkCoercionTy :: Coercion -> Type -piResultTy :: HasDebugCallStack => Type -> Type -> Type - -typeKind :: HasDebugCallStack => Type -> Type -typeTypeOrConstraint :: HasDebugCallStack => Type -> TypeOrConstraint - -coreView :: Type -> Maybe Type -rewriterView :: Type -> Maybe Type -isRuntimeRepTy :: Type -> Bool -isLevityTy :: Type -> Bool -isMultiplicityTy :: Type -> Bool +coreView :: Type -> Maybe Type +rewriterView :: Type -> Maybe Type +chooseFunTyFlag :: HasDebugCallStack => Type -> Type -> FunTyFlag +typeKind :: HasDebugCallStack => Type -> Type +isCoercionTy :: Type -> Bool +mkAppTy :: Type -> Type -> Type +mkCastTy :: Type -> Coercion -> Type +mkTyConApp :: TyCon -> [Type] -> Type +getLevity :: HasDebugCallStack => Type -> Type +getTyVar_maybe :: Type -> Maybe TyVar isLiftedTypeKind :: Type -> Bool -splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) -tyConAppTyCon_maybe :: Type -> Maybe TyCon -getTyVar_maybe :: Type -> Maybe TyVar - -getLevity :: HasDebugCallStack => Type -> Type - partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type]) - -chooseFunTyFlag :: HasDebugCallStack => Type -> Type -> FunTyFlag +typeTypeOrConstraint :: HasDebugCallStack => Type -> TypeOrConstraint diff --git a/GHC/Core/Unfold.hs b/GHC/Core/Unfold.hs --- a/GHC/Core/Unfold.hs +++ b/GHC/Core/Unfold.hs @@ -41,6 +41,8 @@ import GHC.Core.Utils import GHC.Core.DataCon import GHC.Core.Type +import GHC.Core.Class( Class ) +import GHC.Core.Predicate( isUnaryClass ) import GHC.Types.Id import GHC.Types.Literal @@ -52,11 +54,15 @@ import GHC.Builtin.PrimOps import GHC.Builtin.Names + import GHC.Data.Bag + import GHC.Utils.Misc import GHC.Utils.Outputable import qualified Data.ByteString as BS +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as NE -- | Unfolding options data UnfoldingOpts = UnfoldingOpts @@ -213,35 +219,122 @@ ************************************************************************ -} +{- Note [inlineBoringOk] +~~~~~~~~~~~~~~~~~~~~~~~~ +See Note [INLINE for small functions] + +The function `inlineBoringOk` returns True (boringCxtOk) if the supplied +unfolding, which looks like (\x y z. body), is such that the result of +inlining a saturated call is no bigger than `body`. Some wrinkles: + +(IB1) An important case is + - \x. (x `cast` co) + +(IB2) If `body` looks like a data constructor worker, we become keener + to inline, by ignoring the number of arguments; we just insist they + are all trivial. Reason: in a call like `f (g x y)`, if `g` unfolds + to a data construtor, we can allocate a data constructor instead of + a thunk (g x y). + + A case in point where a GADT data constructor failed to inline (#25713) + $WK = /\a \x. K @a x + We really want to inline a boring call to $WK so that we allocate + a data constructor not a thunk ($WK @ty x). + + But not for nullary constructors! We don't want to turn + f ($WRefl @ty) + into + f (Refl @ty ) + because the latter might allocate, whereas the former shares. + (You might wonder if (Refl @ty ) should allocate, but I think + that currently it does.) So for nullary constructors, `inlineBoringOk` + returns False. + +(IB3) Types and coercions do not count towards the expression size. + They are ultimately erased. + +(IB4) If there are no value arguments, `inlineBoringOk` we have to be + careful (#17182). If we have + let y = x @Int in f y y + there’s no reason not to inline y at both use sites — no work is + actually duplicated. + + But not so for coercion arguments! Unlike type arguments, which have + no runtime representation, coercion arguments *do* have a runtime + representation (albeit the zero-width VoidRep, see Note [Coercion + tokens] in "GHC.CoreToStg"). For example: + let y = g @Int in g y y + Here `co` is a value argument, and calling it twice might duplicate + work. + + Even if `g` is a data constructor, so no work is duplicated, + inlining `y` might duplicate allocation of a data constructor object + (#17787). See also (IB2). + + TL;DR: if `is_fun` is False, so we have no value arguments, we /do/ + count coercion arguments, despite (IB3). + +(IB5) You might wonder about an unfolding like (\x y z -> x (y z)), + whose body is, in some sense, just as small as (g x y z). + But `inlineBoringOk` doesn't attempt anything fancy; it just looks + for a function call with trivial arguments, Keep it simple. + +(IB6) If we have an unfolding (K op) where K is a unary-class data constructor, + we want to inline it! So that we get calls (f op), which in turn can see (in + STG land) that `op` is already evaluated and properly tagged. (If `op` isn't + trivial we will have baled out before we get to the Var case.) This made + a big difference in benchmarks for the `effectful` library; details in !10479. + + See Note [Unary class magic] in GHC/Core/TyCon. +-} + inlineBoringOk :: CoreExpr -> Bool --- See Note [INLINE for small functions] -- True => the result of inlining the expression is -- no bigger than the expression itself -- eg (\x y -> f y x) --- This is a quick and dirty version. It doesn't attempt --- to deal with (\x y z -> x (y z)) --- The really important one is (x `cast` c) +-- See Note [inlineBoringOk] inlineBoringOk e = go 0 e where + is_fun = isValFun e + go :: Int -> CoreExpr -> Bool - go credit (Lam x e) | isId x = go (credit+1) e - | otherwise = go credit e - -- See Note [Count coercion arguments in boring contexts] - go credit (App f (Type {})) = go credit f - go credit (App f a) | credit > 0 - , exprIsTrivial a = go (credit-1) f - go credit (Tick _ e) = go credit e -- dubious - go credit (Cast e _) = go credit e + -- credit = #(value lambdas) = #(value args) + go credit (Lam x e) | isRuntimeVar x = go (credit+1) e + | otherwise = go credit e -- See (IB3) + + go credit (App f (Type {})) = go credit f -- See (IB3) + go credit (App f (Coercion {})) + | is_fun = go credit f -- See (IB3) + | otherwise = go (credit-1) f -- See (IB4) + go credit (App f a) | exprIsTrivial a = go (credit-1) f + go credit (Case e b _ alts) | null alts = go credit e -- EmptyCase is like e | Just rhs <- isUnsafeEqualityCase e b alts = go credit rhs -- See Note [Inline unsafeCoerce] - go _ (Var {}) = boringCxtOk - go _ (Lit l) = litIsTrivial l && boringCxtOk - go _ _ = boringCxtNotOk + go credit (Tick _ e) = go credit e -- dubious + go credit (Cast e _) = go credit e -- See (IB3) + + -- Lit: we assume credit >= 0; literals aren't functions + go _ (Lit l) = litIsTrivial l && boringCxtOk + + go credit (Var v) | isDataConWorkId v, is_fun = boringCxtOk -- See (IB2) + | isUnaryClassId v = boringCxtOk -- See (IB6) + | credit >= 0 = boringCxtOk + | otherwise = boringCxtNotOk + + go _ _ = boringCxtNotOk + +isValFun :: CoreExpr -> Bool +-- True of functions with at least +-- one top-level value lambda +isValFun (Lam b e) | isRuntimeVar b = True + | otherwise = isValFun e +isValFun _ = False + calcUnfoldingGuidance :: UnfoldingOpts -> Bool -- Definitely a top-level, bottoming binding @@ -398,29 +491,6 @@ NB: you might think that PostInlineUnconditionally would do this but it doesn't fire for top-level things; see GHC.Core.Opt.Simplify.Utils Note [Top level and postInlineUnconditionally] - -Note [Count coercion arguments in boring contexts] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In inlineBoringOK, we ignore type arguments when deciding whether an -expression is okay to inline into boring contexts. This is good, since -if we have a definition like - - let y = x @Int in f y y - -there’s no reason not to inline y at both use sites — no work is -actually duplicated. It may seem like the same reasoning applies to -coercion arguments, and indeed, in #17182 we changed inlineBoringOK to -treat coercions the same way. - -However, this isn’t a good idea: unlike type arguments, which have -no runtime representation, coercion arguments *do* have a runtime -representation (albeit the zero-width VoidRep, see Note [Coercion tokens] -in "GHC.CoreToStg"). This caused trouble in #17787 for DataCon wrappers for -nullary GADT constructors: the wrappers would be inlined and each use of -the constructor would lead to a separate allocation instead of just -sharing the wrapper closure. - -The solution: don’t ignore coercion arguments after all. -} uncondInline :: Bool -> CoreExpr -> [Var] -> Arity -> CoreExpr -> Int -> Bool @@ -434,19 +504,57 @@ uncondInlineJoin :: [Var] -> CoreExpr -> Bool -- See Note [Duplicating join points] point (DJ3) in GHC.Core.Opt.Simplify.Iteration -uncondInlineJoin _bndrs body +uncondInlineJoin bndrs body + + -- (DJ3)(a) | exprIsTrivial body = True -- Nullary constructors, literals - | (Var v, args) <- collectArgs body - , all exprIsTrivial args - , isJoinId v -- Indirection to another join point; always inline + -- (DJ3)(b) and (DJ3)(c) combined + | indirectionOrAppWithoutFVs = True | otherwise = False + where + -- (DJ3)(b): + -- - $j1 x = $j2 y x |> co -- YES, inline indirection regardless of free vars + -- (DJ3)(c): + -- - $j1 x y = K y x |> co -- YES, inline! + -- - $j2 x = K f x -- No, don't! (because f is free) + indirectionOrAppWithoutFVs = go False body + go !seen_fv (App f a) + | Just has_fv <- go_arg a + = go (seen_fv || has_fv) f + | otherwise = False -- Not trivial + go seen_fv (Var v) + | isJoinId v = True -- Indirection to another join point; always inline + | isDataConId v = not seen_fv -- e.g. $j a b = K a b + | v `elem` bndrs = not seen_fv -- e.g. $j a b = b a + go seen_fv (Cast e _) = go seen_fv e + go seen_fv (Tick _ e) = go seen_fv e + go _ _ = False + + -- go_arg returns: + -- - `Nothing` if arg is not trivial + -- - `Just True` if arg is trivial but contains free var, literal, or constructor + -- - `Just False` if arg is trivial without free vars + go_arg (Type {}) = Just False + go_arg (Coercion {}) = Just False + go_arg (Lit l) + | litIsTrivial l = Just True -- e.g. $j x = $j2 x 7 YES, but $j x = K x 7 NO + | otherwise = Nothing + go_arg (App f a) + | isTyCoArg a = go_arg f -- e.g. $j f = K (f @a) + | otherwise = Nothing + go_arg (Cast e _) = go_arg e + go_arg (Tick _ e) = go_arg e + go_arg (Var f) = Just $! f `notElem` bndrs + go_arg _ = Nothing + + sizeExpr :: UnfoldingOpts -> Int -- Bomb out if it gets bigger than this -> [Id] -- Arguments; we're interested in which of these @@ -490,15 +598,12 @@ (size_up body `addSizeN` sum (map (size_up_alloc . fst) pairs)) pairs - size_up (Case e _ _ alts) - | null alts - = size_up e -- case e of {} never returns, so take size of scrutinee - - size_up (Case e _ _ alts) - -- Now alts is non-empty - | Just v <- is_top_arg e -- We are scrutinising an argument variable - = let - alt_sizes = map size_up_alt alts + size_up (Case e _ _ alts) = case nonEmpty alts of + Nothing -> size_up e -- case e of {} never returns, so take size of scrutinee + Just alts + | Just v <- is_top_arg e -> -- We are scrutinising an argument variable + let + alt_sizes = NE.map size_up_alt alts -- alts_size tries to compute a good discount for -- the case when we are scrutinising an argument variable @@ -525,14 +630,15 @@ -- Good to inline if an arg is scrutinised, because -- that may eliminate allocation in the caller -- And it eliminates the case itself + + | otherwise -> size_up e `addSizeNSD` + foldr (addAltSize . size_up_alt) case_size alts + where is_top_arg (Var v) | v `elem` top_args = Just v is_top_arg (Cast e _) = is_top_arg e is_top_arg _ = Nothing - - size_up (Case e _ _ alts) = size_up e `addSizeNSD` - foldr (addAltSize . size_up_alt) case_size alts where case_size | is_inline_scrut e, lengthAtMost alts 1 = sizeN (-10) @@ -597,11 +703,13 @@ size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize size_up_call fun val_args voids = case idDetails fun of - FCallId _ -> sizeN (callSize (length val_args) voids) - DataConWorkId dc -> conSize dc (length val_args) - PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId {} -> classOpSize opts top_args val_args - _ -> funSize opts top_args fun (length val_args) voids + FCallId _ -> sizeN (callSize (length val_args) voids) + DataConWorkId dc -> conSize dc (length val_args) + PrimOpId op _ -> primOpSize op (length val_args) + ClassOpId cls _ -> classOpSize opts cls top_args val_args + _ | fun `hasKey` buildIdKey -> buildSize + | fun `hasKey` augmentIdKey -> augmentSize + | otherwise -> funSize opts top_args fun (length val_args) voids ------------ size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10 @@ -666,21 +774,24 @@ -- Key point: if x |-> 4, then x must inline unconditionally -- (eg via case binding) -classOpSize :: UnfoldingOpts -> [Id] -> [CoreExpr] -> ExprSize +classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize -- See Note [Conlike is interesting] -classOpSize _ _ [] - = sizeZero -classOpSize opts top_args (arg1 : other_args) - = SizeIs size arg_discount 0 +classOpSize opts cls top_args args + | isUnaryClass cls + = sizeZero -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon + | otherwise + = case args of + [] -> sizeZero + (arg1:other_args) -> SizeIs (size other_args) (arg_discount arg1) 0 where - size = 20 + (10 * length other_args) + size other_args = 20 + (10 * length other_args) + -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function -- The actual discount is rather arbitrarily chosen - arg_discount = case arg1 of - Var dict | dict `elem` top_args - -> unitBag (dict, unfoldingDictDiscount opts) - _other -> emptyBag + arg_discount (Var dict) | dict `elem` top_args + = unitBag (dict, unfoldingDictDiscount opts) + arg_discount _ = emptyBag -- | The size of a function call callSize @@ -707,11 +818,9 @@ -- better solution? funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize --- Size for functions that are not constructors or primops +-- Size for function calls where the function is not a constructor or primops -- Note [Function applications] funSize opts top_args fun n_val_args voids - | fun `hasKey` buildIdKey = buildSize - | fun `hasKey` augmentIdKey = augmentSize | otherwise = SizeIs size arg_discount res_discount where some_val_args = n_val_args > 0 @@ -740,6 +849,8 @@ -- See Note [Unboxed tuple size and result discount] | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 + + | isUnaryClassDataCon dc = sizeZero -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 diff --git a/GHC/Core/Unfold/Make.hs b/GHC/Core/Unfold/Make.hs --- a/GHC/Core/Unfold/Make.hs +++ b/GHC/Core/Unfold/Make.hs @@ -84,6 +84,16 @@ mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding mkDFunUnfolding bndrs con ops + | isUnaryClassDataCon con + = -- See (UCM5) in Note [Unary class magic] in GHC.Core.TyCon + mkDataConUnfolding $ + mkLams bndrs $ + mkApps (Var (dataConWrapId con)) ops + -- This application will satisfy the Core invariants + -- from Note [Representation polymorphism invariants] in GHC.Core, + -- because typeclass method types are never unlifted. + + | otherwise = DFunUnfolding { df_bndrs = bndrs , df_con = con , df_args = map occurAnalyseExpr ops } @@ -97,7 +107,10 @@ where guide = UnfWhen { ug_arity = manifestArity expr , ug_unsat_ok = unSaturatedOk - , ug_boring_ok = False } + , ug_boring_ok = inlineBoringOk expr } + -- inineBoringOk; sometimes wrappers are very simple, like + -- \@a p q. K @a p q + -- and then we definitely want to inline it #25713 mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding -- Make the unfolding for the wrapper in a worker/wrapper split @@ -184,6 +197,9 @@ spec_app (mkLams old_bndrs arg) -- The beta-redexes created by spec_app will be -- simplified away by simplOptExpr + -- ToDo: this is VERY DELICATE for type args. We make + -- (\@a @b x y. TYPE ty) ty1 ty2 d1 d2 + -- and rely on it simplifying to ty[ty1/a, ty2/b] specUnfolding opts spec_bndrs spec_app rule_lhs_args (CoreUnfolding { uf_src = src, uf_tmpl = tmpl diff --git a/GHC/Core/Unify.hs b/GHC/Core/Unify.hs --- a/GHC/Core/Unify.hs +++ b/GHC/Core/Unify.hs @@ -11,2201 +11,2531 @@ tcMatchTyX_BM, ruleMatchTyKiX, -- Side-effect free unification - tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis, - tcUnifyTysFG, tcUnifyTyWithTFs, - BindFun, BindFlag(..), matchBindFun, alwaysBindFun, - UnifyResult, UnifyResultM(..), MaybeApartReason(..), - typesCantMatch, typesAreApart, - - -- Matching a type against a lifted type (coercion) - liftCoMatch, - - -- The core flattening algorithm - flattenTys, flattenTysX, - - ) where - -import GHC.Prelude - -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Name( Name, mkSysTvName, mkSystemVarName ) -import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey ) -import GHC.Core.Type hiding ( getTvSubstEnv ) -import GHC.Core.Coercion hiding ( getCvSubstEnv ) -import GHC.Core.TyCon -import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.Compare ( eqType, tcEqType ) -import GHC.Core.TyCo.FVs ( tyCoVarsOfCoList, tyCoFVsOfTypes ) -import GHC.Core.TyCo.Subst ( mkTvSubst, emptyIdSubstEnv ) -import GHC.Core.Map.Type -import GHC.Utils.FV( FV, fvVarList ) -import GHC.Utils.Misc -import GHC.Data.Pair -import GHC.Utils.Outputable -import GHC.Types.Unique -import GHC.Types.Unique.FM -import GHC.Types.Unique.Set -import GHC.Exts( oneShot ) -import GHC.Utils.Panic -import GHC.Data.FastString - -import Data.List ( mapAccumL ) -import Control.Monad -import qualified Data.Semigroup as S -import GHC.Builtin.Types.Prim (fUNTyCon) -import GHC.Core.Multiplicity - -{- - -Unification is much tricker than you might think. - -1. The substitution we generate binds the *template type variables* - which are given to us explicitly. - -2. We want to match in the presence of foralls; - e.g (forall a. t1) ~ (forall b. t2) - - That is what the RnEnv2 is for; it does the alpha-renaming - that makes it as if a and b were the same variable. - Initialising the RnEnv2, so that it can generate a fresh - binder when necessary, entails knowing the free variables of - both types. - -3. We must be careful not to bind a template type variable to a - locally bound variable. E.g. - (forall a. x) ~ (forall b. b) - where x is the template type variable. Then we do not want to - bind x to a/b! This is a kind of occurs check. - The necessary locals accumulate in the RnEnv2. - -Note [tcMatchTy vs tcMatchTyKi] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This module offers two variants of matching: with kinds and without. -The TyKi variant takes two types, of potentially different kinds, -and matches them. Along the way, it necessarily also matches their -kinds. The Ty variant instead assumes that the kinds are already -eqType and so skips matching up the kinds. - -How do you choose between them? - -1. If you know that the kinds of the two types are eqType, use - the Ty variant. It is more efficient, as it does less work. - -2. If the kinds of variables in the template type might mention type families, - use the Ty variant (and do other work to make sure the kinds - work out). These pure unification functions do a straightforward - syntactic unification and do no complex reasoning about type - families. Note that the types of the variables in instances can indeed - mention type families, so instance lookup must use the Ty variant. - - (Nothing goes terribly wrong -- no panics -- if there might be type - families in kinds in the TyKi variant. You just might get match - failure even though a reducing a type family would lead to success.) - -3. Otherwise, if you're sure that the variable kinds do not mention - type families and you're not already sure that the kind of the template - equals the kind of the target, then use the TyKi version. --} - --- | Some unification functions are parameterised by a 'BindFun', which --- says whether or not to allow a certain unification to take place. --- A 'BindFun' takes the 'TyVar' involved along with the 'Type' it will --- potentially be bound to. --- --- It is possible for the variable to actually be a coercion variable --- (Note [Matching coercion variables]), but only when one-way matching. --- In this case, the 'Type' will be a 'CoercionTy'. -type BindFun = TyCoVar -> Type -> BindFlag - --- | @tcMatchTy t1 t2@ produces a substitution (over fvs(t1)) --- @s@ such that @s(t1)@ equals @t2@. --- The returned substitution might bind coercion variables, --- if the variable is an argument to a GADT constructor. --- --- Precondition: typeKind ty1 `eqType` typeKind ty2 --- --- We don't pass in a set of "template variables" to be bound --- by the match, because tcMatchTy (and similar functions) are --- always used on top-level types, so we can bind any of the --- free variables of the LHS. --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTy :: Type -> Type -> Maybe Subst -tcMatchTy ty1 ty2 = tcMatchTys [ty1] [ty2] - -tcMatchTyX_BM :: BindFun -> Subst - -> Type -> Type -> Maybe Subst -tcMatchTyX_BM bind_me subst ty1 ty2 - = tc_match_tys_x bind_me False subst [ty1] [ty2] - --- | Like 'tcMatchTy', but allows the kinds of the types to differ, --- and thus matches them as well. --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTyKi :: Type -> Type -> Maybe Subst -tcMatchTyKi ty1 ty2 - = tc_match_tys alwaysBindFun True [ty1] [ty2] - --- | This is similar to 'tcMatchTy', but extends a substitution --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTyX :: Subst -- ^ Substitution to extend - -> Type -- ^ Template - -> Type -- ^ Target - -> Maybe Subst -tcMatchTyX subst ty1 ty2 - = tc_match_tys_x alwaysBindFun False subst [ty1] [ty2] - --- | Like 'tcMatchTy' but over a list of types. --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTys :: [Type] -- ^ Template - -> [Type] -- ^ Target - -> Maybe Subst -- ^ One-shot; in principle the template - -- variables could be free in the target -tcMatchTys tys1 tys2 - = tc_match_tys alwaysBindFun False tys1 tys2 - --- | Like 'tcMatchTyKi' but over a list of types. --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTyKis :: [Type] -- ^ Template - -> [Type] -- ^ Target - -> Maybe Subst -- ^ One-shot substitution -tcMatchTyKis tys1 tys2 - = tc_match_tys alwaysBindFun True tys1 tys2 - --- | Like 'tcMatchTys', but extending a substitution --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTysX :: Subst -- ^ Substitution to extend - -> [Type] -- ^ Template - -> [Type] -- ^ Target - -> Maybe Subst -- ^ One-shot substitution -tcMatchTysX subst tys1 tys2 - = tc_match_tys_x alwaysBindFun False subst tys1 tys2 - --- | Like 'tcMatchTyKis', but extending a substitution --- See also Note [tcMatchTy vs tcMatchTyKi] -tcMatchTyKisX :: Subst -- ^ Substitution to extend - -> [Type] -- ^ Template - -> [Type] -- ^ Target - -> Maybe Subst -- ^ One-shot substitution -tcMatchTyKisX subst tys1 tys2 - = tc_match_tys_x alwaysBindFun True subst tys1 tys2 - --- | Same as tc_match_tys_x, but starts with an empty substitution -tc_match_tys :: BindFun - -> Bool -- ^ match kinds? - -> [Type] - -> [Type] - -> Maybe Subst -tc_match_tys bind_me match_kis tys1 tys2 - = tc_match_tys_x bind_me match_kis (mkEmptySubst in_scope) tys1 tys2 - where - in_scope = mkInScopeSet (tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2) - --- | Worker for 'tcMatchTysX' and 'tcMatchTyKisX' -tc_match_tys_x :: BindFun - -> Bool -- ^ match kinds? - -> Subst - -> [Type] - -> [Type] - -> Maybe Subst -tc_match_tys_x bind_me match_kis (Subst in_scope id_env tv_env cv_env) tys1 tys2 - = case tc_unify_tys bind_me - False -- Matching, not unifying - False -- Not an injectivity check - match_kis - RespectMultiplicities - (mkRnEnv2 in_scope) tv_env cv_env tys1 tys2 of - Unifiable (tv_env', cv_env') - -> Just $ Subst in_scope id_env tv_env' cv_env' - _ -> Nothing - --- | This one is called from the expression matcher, --- which already has a MatchEnv in hand -ruleMatchTyKiX - :: TyCoVarSet -- ^ template variables - -> RnEnv2 - -> TvSubstEnv -- ^ type substitution to extend - -> Type -- ^ Template - -> Type -- ^ Target - -> Maybe TvSubstEnv -ruleMatchTyKiX tmpl_tvs rn_env tenv tmpl target --- See Note [Kind coercions in Unify] - = case tc_unify_tys (matchBindFun tmpl_tvs) False False - True -- <-- this means to match the kinds - IgnoreMultiplicities - -- See Note [Rewrite rules ignore multiplicities in FunTy] - rn_env tenv emptyCvSubstEnv [tmpl] [target] of - Unifiable (tenv', _) -> Just tenv' - _ -> Nothing - --- | Allow binding only for any variable in the set. Variables may --- be bound to any type. --- Used when doing simple matching; e.g. can we find a substitution --- --- @ --- S = [a :-> t1, b :-> t2] such that --- S( Maybe (a, b->Int ) = Maybe (Bool, Char -> Int) --- @ -matchBindFun :: TyCoVarSet -> BindFun -matchBindFun tvs tv _ty - | tv `elemVarSet` tvs = BindMe - | otherwise = Apart - --- | Allow the binding of any variable to any type -alwaysBindFun :: BindFun -alwaysBindFun _tv _ty = BindMe - -{- -************************************************************************ -* * - GADTs -* * -************************************************************************ - -Note [Pruning dead case alternatives] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider data T a where - T1 :: T Int - T2 :: T a - - newtype X = MkX Int - newtype Y = MkY Char - - type family F a - type instance F Bool = Int - -Now consider case x of { T1 -> e1; T2 -> e2 } - -The question before the house is this: if I know something about the type -of x, can I prune away the T1 alternative? - -Suppose x::T Char. It's impossible to construct a (T Char) using T1, - Answer = YES we can prune the T1 branch (clearly) - -Suppose x::T (F a), where 'a' is in scope. Then 'a' might be instantiated -to 'Bool', in which case x::T Int, so - ANSWER = NO (clearly) - -We see here that we want precisely the apartness check implemented within -tcUnifyTysFG. So that's what we do! Two types cannot match if they are surely -apart. Note that since we are simply dropping dead code, a conservative test -suffices. --} - --- | Given a list of pairs of types, are any two members of a pair surely --- apart, even after arbitrary type function evaluation and substitution? -typesCantMatch :: [(Type,Type)] -> Bool --- See Note [Pruning dead case alternatives] -typesCantMatch prs = any (uncurry typesAreApart) prs - -typesAreApart :: Type -> Type -> Bool -typesAreApart t1 t2 = case tcUnifyTysFG alwaysBindFun [t1] [t2] of - SurelyApart -> True - _ -> False -{- -************************************************************************ -* * - Unification -* * -************************************************************************ - -Note [Fine-grained unification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Do the types (x, x) and ([y], y) unify? The answer is seemingly "no" -- -no substitution to finite types makes these match. But, a substitution to -*infinite* types can unify these two types: [x |-> [[[...]]], y |-> [[[...]]] ]. -Why do we care? Consider these two type family instances: - -type instance F x x = Int -type instance F [y] y = Bool - -If we also have - -type instance Looper = [Looper] - -then the instances potentially overlap. The solution is to use unification -over infinite terms. This is possible (see [1] for lots of gory details), but -a full algorithm is a little more power than we need. Instead, we make a -conservative approximation and just omit the occurs check. - -[1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf - -tcUnifyTys considers an occurs-check problem as the same as general unification -failure. - -tcUnifyTysFG ("fine-grained") returns one of three results: success, occurs-check -failure ("MaybeApart"), or general failure ("SurelyApart"). - -See also #8162. - -It's worth noting that unification in the presence of infinite types is not -complete. This means that, sometimes, a closed type family does not reduce -when it should. See test case indexed-types/should_fail/Overlap15 for an -example. - -Note [Unification result] -~~~~~~~~~~~~~~~~~~~~~~~~~ -When unifying t1 ~ t2, we return -* Unifiable s, if s is a substitution such that s(t1) is syntactically the - same as s(t2), modulo type-synonym expansion. -* SurelyApart, if there is no substitution s such that s(t1) = s(t2), - where "=" includes type-family reductions. -* MaybeApart mar s, when we aren't sure. `mar` is a MaybeApartReason. - -Examples -* [a] ~ Maybe b: SurelyApart, because [] and Maybe can't unify -* [(a,Int)] ~ [(Bool,b)]: Unifiable -* [F Int] ~ [Bool]: MaybeApart MARTypeFamily, because F Int might reduce to Bool (the unifier - does not try this) -* a ~ Maybe a: MaybeApart MARInfinite. Not Unifiable clearly, but not SurelyApart either; consider - a := Loop - where type family Loop where Loop = Maybe Loop - -There is the possibility that two types are MaybeApart for *both* reasons: - -* (a, F Int) ~ (Maybe a, Bool) - -What reason should we use? The *only* consumer of the reason is described -in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv. The goal -there is identify which instances might match a target later (but don't -match now) -- except that we want to ignore the possibility of infinitary -substitutions. So let's examine a concrete scenario: - - class C a b c - instance C a (Maybe a) Bool - -- other instances, including one that will actually match - [W] C b b (F Int) - -Do we want the instance as a future possibility? No. The only way that -instance can match is in the presence of an infinite type (infinitely -nested Maybes). We thus say that MARInfinite takes precedence, so that -InstEnv treats this case as an infinitary substitution case; the fact -that a type family is involved is only incidental. We thus define -the Semigroup instance for MaybeApartReason to prefer MARInfinite. - -Note [The substitution in MaybeApart] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The constructor MaybeApart carries data with it, typically a TvSubstEnv. Why? -Because consider unifying these: - -(a, a, Int) ~ (b, [b], Bool) - -If we go left-to-right, we start with [a |-> b]. Then, on the middle terms, we -apply the subst we have so far and discover that we need [b |-> [b]]. Because -this fails the occurs check, we say that the types are MaybeApart (see above -Note [Fine-grained unification]). But, we can't stop there! Because if we -continue, we discover that Int is SurelyApart from Bool, and therefore the -types are apart. This has practical consequences for the ability for closed -type family applications to reduce. See test case -indexed-types/should_compile/Overlap14. - -Note [Rewrite rules ignore multiplicities in FunTy] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following (higher-order) rule: - -m :: Bool -> Bool -> Bool -{-# RULES "m" forall f. m (f True) = f #-} - -let x = m ((,) @Bool @Bool True True) - -The rewrite rule expects an `f :: Bool -> Bool`, but `(,) @Bool @Bool True :: -Bool %1 -> Bool` is linear (see Note [Data constructors are linear by default] -in GHC.Core.Multiplicity) Should the rule match? Yes! According to the -principles laid out in Note [Linting linearity] in GHC.Core.Lint, optimisation -shouldn't be constrained by linearity. - -However, when matching the template variable `f` to `(,) True`, we do check that -their types unify (see Note [Matching variable types] in GHC.Core.Rules). So -when unifying types for the sake of rule-matching, the unification algorithm -must be able to ignore multiplicities altogether. - -How is this done? - (1) The `um_arr_mult` field of `UMEnv` recordsw when we are doing rule-matching, - and hence want to ignore multiplicities. - (2) The field is set to True in by `ruleMatchTyKiX`. - (3) It is consulted when matching `FunTy` in `unify_ty`. - -Wrinkle in (3). In `unify_tc_app`, in `unify_ty`, `FunTy` is handled as if it -was a regular type constructor. In this case, and when the types being unified -are *function* arrows, but not constraint arrows, then the first argument is a -multiplicity. - -We select this situation by comparing the type constructor with fUNTyCon. In -this case, and this case only, we can safely drop the first argument (using the -tail function) and unify the rest. --} - --- | Simple unification of two types; all type variables are bindable --- Precondition: the kinds are already equal -tcUnifyTy :: Type -> Type -- All tyvars are bindable - -> Maybe Subst - -- A regular one-shot (idempotent) substitution -tcUnifyTy t1 t2 = tcUnifyTys alwaysBindFun [t1] [t2] - --- | Like 'tcUnifyTy', but also unifies the kinds -tcUnifyTyKi :: Type -> Type -> Maybe Subst -tcUnifyTyKi t1 t2 = tcUnifyTyKis alwaysBindFun [t1] [t2] - --- | Unify two types, treating type family applications as possibly unifying --- with anything and looking through injective type family applications. --- Precondition: kinds are the same -tcUnifyTyWithTFs :: Bool -- ^ True <=> do two-way unification; - -- False <=> do one-way matching. - -- See end of sec 5.2 from the paper - -> InScopeSet -- Should include the free tyvars of both Type args - -> Type -> Type -- Types to unify - -> Maybe Subst --- This algorithm is an implementation of the "Algorithm U" presented in --- the paper "Injective type families for Haskell", Figures 2 and 3. --- The code is incorporated with the standard unifier for convenience, but --- its operation should match the specification in the paper. -tcUnifyTyWithTFs twoWay in_scope t1 t2 - = case tc_unify_tys alwaysBindFun twoWay True False RespectMultiplicities - rn_env emptyTvSubstEnv emptyCvSubstEnv - [t1] [t2] of - Unifiable (tv_subst, _cv_subst) -> Just $ maybe_fix tv_subst - MaybeApart _reason (tv_subst, _cv_subst) -> Just $ maybe_fix tv_subst - -- we want to *succeed* in questionable cases. This is a - -- pre-unification algorithm. - SurelyApart -> Nothing - where - rn_env = mkRnEnv2 in_scope - - maybe_fix | twoWay = niFixSubst in_scope - | otherwise = mkTvSubst in_scope -- when matching, don't confuse - -- domain with range - ------------------ -tcUnifyTys :: BindFun - -> [Type] -> [Type] - -> Maybe Subst - -- ^ A regular one-shot (idempotent) substitution - -- that unifies the erased types. See comments - -- for 'tcUnifyTysFG' - --- The two types may have common type variables, and indeed do so in the --- second call to tcUnifyTys in GHC.Tc.Instance.FunDeps.checkClsFD -tcUnifyTys bind_fn tys1 tys2 - = case tcUnifyTysFG bind_fn tys1 tys2 of - Unifiable result -> Just result - _ -> Nothing - --- | Like 'tcUnifyTys' but also unifies the kinds -tcUnifyTyKis :: BindFun - -> [Type] -> [Type] - -> Maybe Subst -tcUnifyTyKis bind_fn tys1 tys2 - = case tcUnifyTyKisFG bind_fn tys1 tys2 of - Unifiable result -> Just result - _ -> Nothing - --- This type does double-duty. It is used in the UM (unifier monad) and to --- return the final result. See Note [Fine-grained unification] -type UnifyResult = UnifyResultM Subst - --- | See Note [Unification result] -data UnifyResultM a = Unifiable a -- the subst that unifies the types - | MaybeApart MaybeApartReason - a -- the subst has as much as we know - -- it must be part of a most general unifier - -- See Note [The substitution in MaybeApart] - | SurelyApart - deriving Functor - --- | Why are two types 'MaybeApart'? 'MARInfinite' takes precedence: --- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv --- As of Feb 2022, we never differentiate between MARTypeFamily and MARTypeVsConstraint; --- it's really only MARInfinite that's interesting here. -data MaybeApartReason - = MARTypeFamily -- ^ matching e.g. F Int ~? Bool - - | MARInfinite -- ^ matching e.g. a ~? Maybe a - - | MARTypeVsConstraint -- ^ matching Type ~? Constraint or the arrow types - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - -instance Outputable MaybeApartReason where - ppr MARTypeFamily = text "MARTypeFamily" - ppr MARInfinite = text "MARInfinite" - ppr MARTypeVsConstraint = text "MARTypeVsConstraint" - -instance Semigroup MaybeApartReason where - -- see end of Note [Unification result] for why - MARTypeFamily <> r = r - MARInfinite <> _ = MARInfinite - MARTypeVsConstraint <> r = r - -instance Applicative UnifyResultM where - pure = Unifiable - (<*>) = ap - -instance Monad UnifyResultM where - SurelyApart >>= _ = SurelyApart - MaybeApart r1 x >>= f = case f x of - Unifiable y -> MaybeApart r1 y - MaybeApart r2 y -> MaybeApart (r1 S.<> r2) y - SurelyApart -> SurelyApart - Unifiable x >>= f = f x - --- | @tcUnifyTysFG bind_tv tys1 tys2@ attempts to find a substitution @s@ (whose --- domain elements all respond 'BindMe' to @bind_tv@) such that --- @s(tys1)@ and that of @s(tys2)@ are equal, as witnessed by the returned --- Coercions. This version requires that the kinds of the types are the same, --- if you unify left-to-right. -tcUnifyTysFG :: BindFun - -> [Type] -> [Type] - -> UnifyResult -tcUnifyTysFG bind_fn tys1 tys2 - = tc_unify_tys_fg False bind_fn tys1 tys2 - -tcUnifyTyKisFG :: BindFun - -> [Type] -> [Type] - -> UnifyResult -tcUnifyTyKisFG bind_fn tys1 tys2 - = tc_unify_tys_fg True bind_fn tys1 tys2 - -tc_unify_tys_fg :: Bool - -> BindFun - -> [Type] -> [Type] - -> UnifyResult -tc_unify_tys_fg match_kis bind_fn tys1 tys2 - = do { (env, _) <- tc_unify_tys bind_fn True False match_kis RespectMultiplicities rn_env - emptyTvSubstEnv emptyCvSubstEnv - tys1 tys2 - ; return $ niFixSubst in_scope env } - where - in_scope = mkInScopeSet $ tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2 - rn_env = mkRnEnv2 in_scope - --- | This function is actually the one to call the unifier -- a little --- too general for outside clients, though. -tc_unify_tys :: BindFun - -> AmIUnifying -- ^ True <=> unify; False <=> match - -> Bool -- ^ True <=> doing an injectivity check - -> Bool -- ^ True <=> treat the kinds as well - -> MultiplicityFlag -- ^ see Note [Rewrite rules ignore multiplicities in FunTy] in GHC.Core.Unify - -> RnEnv2 - -> TvSubstEnv -- ^ substitution to extend - -> CvSubstEnv - -> [Type] -> [Type] - -> UnifyResultM (TvSubstEnv, CvSubstEnv) --- NB: It's tempting to ASSERT here that, if we're not matching kinds, then --- the kinds of the types should be the same. However, this doesn't work, --- as the types may be a dependent telescope, where later types have kinds --- that mention variables occurring earlier in the list of types. Here's an --- example (from typecheck/should_fail/T12709): --- template: [rep :: RuntimeRep, a :: TYPE rep] --- target: [LiftedRep :: RuntimeRep, Int :: TYPE LiftedRep] --- We can see that matching the first pair will make the kinds of the second --- pair equal. Yet, we still don't need a separate pass to unify the kinds --- of these types, so it's appropriate to use the Ty variant of unification. --- See also Note [tcMatchTy vs tcMatchTyKi]. -tc_unify_tys bind_fn unif inj_check match_kis match_mults rn_env tv_env cv_env tys1 tys2 - = initUM tv_env cv_env $ - do { when match_kis $ - unify_tys env kis1 kis2 - ; unify_tys env tys1 tys2 - ; (,) <$> getTvSubstEnv <*> getCvSubstEnv } - where - env = UMEnv { um_bind_fun = bind_fn - , um_skols = emptyVarSet - , um_unif = unif - , um_inj_tf = inj_check - , um_arr_mult = match_mults - , um_rn_env = rn_env } - - kis1 = map typeKind tys1 - kis2 = map typeKind tys2 - -instance Outputable a => Outputable (UnifyResultM a) where - ppr SurelyApart = text "SurelyApart" - ppr (Unifiable x) = text "Unifiable" <+> ppr x - ppr (MaybeApart r x) = text "MaybeApart" <+> ppr r <+> ppr x - -{- -************************************************************************ -* * - Non-idempotent substitution -* * -************************************************************************ - -Note [Non-idempotent substitution] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -During unification we use a TvSubstEnv/CvSubstEnv pair that is - (a) non-idempotent - (b) loop-free; ie repeatedly applying it yields a fixed point - -Note [Finding the substitution fixpoint] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Finding the fixpoint of a non-idempotent substitution arising from a -unification is much trickier than it looks, because of kinds. Consider - T k (H k (f:k)) ~ T * (g:*) -If we unify, we get the substitution - [ k -> * - , g -> H k (f:k) ] -To make it idempotent we don't want to get just - [ k -> * - , g -> H * (f:k) ] -We also want to substitute inside f's kind, to get - [ k -> * - , g -> H k (f:*) ] -If we don't do this, we may apply the substitution to something, -and get an ill-formed type, i.e. one where typeKind will fail. -This happened, for example, in #9106. - -It gets worse. In #14164 we wanted to take the fixpoint of -this substitution - [ xs_asV :-> F a_aY6 (z_aY7 :: a_aY6) - (rest_aWF :: G a_aY6 (z_aY7 :: a_aY6)) - , a_aY6 :-> a_aXQ ] - -We have to apply the substitution for a_aY6 two levels deep inside -the invocation of F! We don't have a function that recursively -applies substitutions inside the kinds of variable occurrences (and -probably rightly so). - -So, we work as follows: - - 1. Start with the current substitution (which we are - trying to fixpoint - [ xs :-> F a (z :: a) (rest :: G a (z :: a)) - , a :-> b ] - - 2. Take all the free vars of the range of the substitution: - {a, z, rest, b} - NB: the free variable finder closes over - the kinds of variable occurrences - - 3. If none are in the domain of the substitution, stop. - We have found a fixpoint. - - 4. Remove the variables that are bound by the substitution, leaving - {z, rest, b} - - 5. Do a topo-sort to put them in dependency order: - [ b :: *, z :: a, rest :: G a z ] - - 6. Apply the substitution left-to-right to the kinds of these - tyvars, extending it each time with a new binding, so we - finish up with - [ xs :-> ..as before.. - , a :-> b - , b :-> b :: * - , z :-> z :: b - , rest :-> rest :: G b (z :: b) ] - Note that rest now has the right kind - - 7. Apply this extended substitution (once) to the range of - the /original/ substitution. (Note that we do the - extended substitution would go on forever if you tried - to find its fixpoint, because it maps z to z.) - - 8. And go back to step 1 - -In Step 6 we use the free vars from Step 2 as the initial -in-scope set, because all of those variables appear in the -range of the substitution, so they must all be in the in-scope -set. But NB that the type substitution engine does not look up -variables in the in-scope set; it is used only to ensure no -shadowing. --} - -niFixSubst :: InScopeSet -> TvSubstEnv -> Subst --- Find the idempotent fixed point of the non-idempotent substitution --- This is surprisingly tricky: --- see Note [Finding the substitution fixpoint] --- ToDo: use laziness instead of iteration? -niFixSubst in_scope tenv - | not_fixpoint = niFixSubst in_scope (mapVarEnv (substTy subst) tenv) - | otherwise = subst - where - range_fvs :: FV - range_fvs = tyCoFVsOfTypes (nonDetEltsUFM tenv) - -- It's OK to use nonDetEltsUFM here because the - -- order of range_fvs, range_tvs is immaterial - - range_tvs :: [TyVar] - range_tvs = fvVarList range_fvs - - not_fixpoint = any in_domain range_tvs - in_domain tv = tv `elemVarEnv` tenv - - free_tvs = scopedSort (filterOut in_domain range_tvs) - - -- See Note [Finding the substitution fixpoint], Step 6 - subst = foldl' add_free_tv - (mkTvSubst in_scope tenv) - free_tvs - - add_free_tv :: Subst -> TyVar -> Subst - add_free_tv subst tv - = extendTvSubst subst tv (mkTyVarTy tv') - where - tv' = updateTyVarKind (substTy subst) tv - -niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet --- Apply the non-idempotent substitution to a set of type variables, --- remembering that the substitution isn't necessarily idempotent --- This is used in the occurs check, before extending the substitution -niSubstTvSet tsubst tvs - = nonDetStrictFoldUniqSet (unionVarSet . get) emptyVarSet tvs - -- It's OK to use a non-deterministic fold here because we immediately forget - -- the ordering by creating a set. - where - get tv - | Just ty <- lookupVarEnv tsubst tv - = niSubstTvSet tsubst (tyCoVarsOfType ty) - - | otherwise - = unitVarSet tv - -{- -************************************************************************ -* * - unify_ty: the main workhorse -* * -************************************************************************ - -Note [Specification of unification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The pure unifier, unify_ty, defined in this module, tries to work out -a substitution to make two types say True to eqType. NB: eqType is -itself not purely syntactic; it accounts for CastTys; -see Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep - -Unlike the "impure unifiers" in the typechecker (the eager unifier in -GHC.Tc.Utils.Unify, and the constraint solver itself in GHC.Tc.Solver.Equality), -the pure unifier does /not/ work up to ~. - -The algorithm implemented here is rather delicate, and we depend on it -to uphold certain properties. This is a summary of these required -properties. - -Notation: - θ,φ substitutions - ξ type-function-free types - τ,σ other types - τ♭ type τ, flattened - - ≡ eqType - -(U1) Soundness. - If (unify τ₁ τ₂) = Unifiable θ, then θ(τ₁) ≡ θ(τ₂). - θ is a most general unifier for τ₁ and τ₂. - -(U2) Completeness. - If (unify ξ₁ ξ₂) = SurelyApart, - then there exists no substitution θ such that θ(ξ₁) ≡ θ(ξ₂). - -These two properties are stated as Property 11 in the "Closed Type Families" -paper (POPL'14). Below, this paper is called [CTF]. - -(U3) Apartness under substitution. - If (unify ξ τ♭) = SurelyApart, then (unify ξ θ(τ)♭) = SurelyApart, - for any θ. (Property 12 from [CTF]) - -(U4) Apart types do not unify. - If (unify ξ τ♭) = SurelyApart, then there exists no θ - such that θ(ξ) = θ(τ). (Property 13 from [CTF]) - -THEOREM. Completeness w.r.t ~ - If (unify τ₁♭ τ₂♭) = SurelyApart, - then there exists no proof that (τ₁ ~ τ₂). - -PROOF. See appendix of [CTF]. - - -The unification algorithm is used for type family injectivity, as described -in the "Injective Type Families" paper (Haskell'15), called [ITF]. When run -in this mode, it has the following properties. - -(I1) If (unify σ τ) = SurelyApart, then σ and τ are not unifiable, even - after arbitrary type family reductions. Note that σ and τ are - not flattened here. - -(I2) If (unify σ τ) = MaybeApart θ, and if some - φ exists such that φ(σ) ~ φ(τ), then φ extends θ. - - -Furthermore, the RULES matching algorithm requires this property, -but only when using this algorithm for matching: - -(M1) If (match σ τ) succeeds with θ, then all matchable tyvars - in σ are bound in θ. - - Property M1 means that we must extend the substitution with, - say (a ↦ a) when appropriate during matching. - See also Note [Self-substitution when matching]. - -(M2) Completeness of matching. - If θ(σ) = τ, then (match σ τ) = Unifiable φ, - where θ is an extension of φ. - -Sadly, property M2 and I2 conflict. Consider - -type family F1 a b where - F1 Int Bool = Char - F1 Double String = Char - -Consider now two matching problems: - -P1. match (F1 a Bool) (F1 Int Bool) -P2. match (F1 a Bool) (F1 Double String) - -In case P1, we must find (a ↦ Int) to satisfy M2. -In case P2, we must /not/ find (a ↦ Double), in order to satisfy I2. (Note -that the correct mapping for I2 is (a ↦ Int). There is no way to discover -this, but we mustn't map a to anything else!) - -We thus must parameterize the algorithm over whether it's being used -for an injectivity check (refrain from looking at non-injective arguments -to type families) or not (do indeed look at those arguments). This is -implemented by the um_inj_tf field of UMEnv. - -(It's all a question of whether or not to include equation (7) from Fig. 2 -of [ITF].) - -This extra parameter is a bit fiddly, perhaps, but seemingly less so than -having two separate, almost-identical algorithms. - -Note [Self-substitution when matching] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What should happen when we're *matching* (not unifying) a1 with a1? We -should get a substitution [a1 |-> a1]. A successful match should map all -the template variables (except ones that disappear when expanding synonyms). -But when unifying, we don't want to do this, because we'll then fall into -a loop. - -This arrangement affects the code in three places: - - If we're matching a refined template variable, don't recur. Instead, just - check for equality. That is, if we know [a |-> Maybe a] and are matching - (a ~? Maybe Int), we want to just fail. - - - Skip the occurs check when matching. This comes up in two places, because - matching against variables is handled separately from matching against - full-on types. - -Note that this arrangement was provoked by a real failure, where the same -unique ended up in the template as in the target. (It was a rule firing when -compiling Data.List.NonEmpty.) - -Note [Matching coercion variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this: - - type family F a - - data G a where - MkG :: F a ~ Bool => G a - - type family Foo (x :: G a) :: F a - type instance Foo MkG = False - -We would like that to be accepted. For that to work, we need to introduce -a coercion variable on the left and then use it on the right. Accordingly, -at use sites of Foo, we need to be able to use matching to figure out the -value for the coercion. (See the desugared version: - - axFoo :: [a :: *, c :: F a ~ Bool]. Foo (MkG c) = False |> (sym c) - -) We never want this action to happen during *unification* though, when -all bets are off. - -Note [Kind coercions in Unify] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We wish to match/unify while ignoring casts. But, we can't just ignore -them completely, or we'll end up with ill-kinded substitutions. For example, -say we're matching `a` with `ty |> co`. If we just drop the cast, we'll -return [a |-> ty], but `a` and `ty` might have different kinds. We can't -just match/unify their kinds, either, because this might gratuitously -fail. After all, `co` is the witness that the kinds are the same -- they -may look nothing alike. - -So, we pass a kind coercion to the match/unify worker. This coercion witnesses -the equality between the substed kind of the left-hand type and the substed -kind of the right-hand type. Note that we do not unify kinds at the leaves -(as we did previously). We thus have - -Hence: (Unification Kind Invariant) ------------------------------------ -In the call - unify_ty ty1 ty2 kco -it must be that - subst(kco) :: subst(kind(ty1)) ~N subst(kind(ty2)) -where `subst` is the ambient substitution in the UM monad. And in the call - unify_tys tys1 tys2 -(which has no kco), after we unify any prefix of tys1,tys2, the kinds of the -head of the remaining tys1,tys2 are identical after substitution. This -implies, for example, that the kinds of the head of tys1,tys2 are identical -after substitution. - -To get this coercion, we first have to match/unify -the kinds before looking at the types. Happily, we need look only one level -up, as all kinds are guaranteed to have kind *. - -When we're working with type applications (either TyConApp or AppTy) we -need to worry about establishing INVARIANT, as the kinds of the function -& arguments aren't (necessarily) included in the kind of the result. -When unifying two TyConApps, this is easy, because the two TyCons are -the same. Their kinds are thus the same. As long as we unify left-to-right, -we'll be sure to unify types' kinds before the types themselves. (For example, -think about Proxy :: forall k. k -> *. Unifying the first args matches up -the kinds of the second args.) - -For AppTy, we must unify the kinds of the functions, but once these are -unified, we can continue unifying arguments without worrying further about -kinds. - -The interface to this module includes both "...Ty" functions and -"...TyKi" functions. The former assume that INVARIANT is already -established, either because the kinds are the same or because the -list of types being passed in are the well-typed arguments to some -type constructor (see two paragraphs above). The latter take a separate -pre-pass over the kinds to establish INVARIANT. Sometimes, it's important -not to take the second pass, as it caused #12442. - -We thought, at one point, that this was all unnecessary: why should -casts be in types in the first place? But they are sometimes. In -dependent/should_compile/KindEqualities2, we see, for example the -constraint Num (Int |> (blah ; sym blah)). We naturally want to find -a dictionary for that constraint, which requires dealing with -coercions in this manner. - -Note [Matching in the presence of casts (1)] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When matching, it is crucial that no variables from the template -end up in the range of the matching substitution (obviously!). -When unifying, that's not a constraint; instead we take the fixpoint -of the substitution at the end. - -So what should we do with this, when matching? - unify_ty (tmpl |> co) tgt kco - -Previously, wrongly, we pushed 'co' in the (horrid) accumulating -'kco' argument like this: - unify_ty (tmpl |> co) tgt kco - = unify_ty tmpl tgt (kco ; co) - -But that is obviously wrong because 'co' (from the template) ends -up in 'kco', which in turn ends up in the range of the substitution. - -This all came up in #13910. Because we match tycon arguments -left-to-right, the ambient substitution will already have a matching -substitution for any kinds; so there is an easy fix: just apply -the substitution-so-far to the coercion from the LHS. - -Note that - -* When matching, the first arg of unify_ty is always the template; - we never swap round. - -* The above argument is distressingly indirect. We seek a - better way. - -* One better way is to ensure that type patterns (the template - in the matching process) have no casts. See #14119. - -Note [Matching in the presence of casts (2)] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There is another wrinkle (#17395). Suppose (T :: forall k. k -> Type) -and we are matching - tcMatchTy (T k (a::k)) (T j (b::j)) - -Then we'll match k :-> j, as expected. But then in unify_tys -we invoke - unify_tys env (a::k) (b::j) (Refl j) - -Although we have unified k and j, it's very important that we put -(Refl j), /not/ (Refl k) as the fourth argument to unify_tys. -If we put (Refl k) we'd end up with the substitution - a :-> b |> Refl k -which is bogus because one of the template variables, k, -appears in the range of the substitution. Eek. - -Similar care is needed in unify_ty_app. - - -Note [Polykinded tycon applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose T :: forall k. Type -> K -and we are unifying - ty1: T @Type Int :: Type - ty2: T @(Type->Type) Int Int :: Type - -These two TyConApps have the same TyCon at the front but they -(legitimately) have different numbers of arguments. They -are surelyApart, so we can report that without looking any -further (see #15704). - -Note [Unifying type applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Unifying type applications is quite subtle, as we found -in #23134 and #22647, when type families are involved. - -Suppose - type family F a :: Type -> Type - type family G k :: k = r | r -> k - -and consider these examples: - -* F Int ~ F Char, where F is injective - Since F is injective, we can reduce this to Int ~ Char, - therefore SurelyApart. - -* F Int ~ F Char, where F is not injective - Without injectivity, return MaybeApart. - -* G Type ~ G (Type -> Type) Int - Even though G is injective and the arguments to G are different, - we cannot deduce apartness because the RHS is oversaturated. - For example, G might be defined as - G Type = Maybe Int - G (Type -> Type) = Maybe - So we return MaybeApart. - -* F Int Bool ~ F Int Char -- SurelyApart (since Bool is apart from Char) - F Int Bool ~ Maybe a -- MaybeApart - F Int Bool ~ a b -- MaybeApart - F Int Bool ~ Char -> Bool -- MaybeApart - An oversaturated type family can match an application, - whether it's a TyConApp, AppTy or FunTy. Decompose. - -* F Int ~ a b - We cannot decompose a saturated, or under-saturated - type family application. We return MaybeApart. - -To handle all those conditions, unify_ty goes through -the following checks in sequence, where Fn is a type family -of arity n: - -* (C1) Fn x_1 ... x_n ~ Fn y_1 .. y_n - A saturated application. - Here we can unify arguments in which Fn is injective. -* (C2) Fn x_1 ... x_n ~ anything, anything ~ Fn x_1 ... x_n - A saturated type family can match anything - we return MaybeApart. -* (C3) Fn x_1 ... x_m ~ a b, a b ~ Fn x_1 ... x_m where m > n - An oversaturated type family can be decomposed. -* (C4) Fn x_1 ... x_m ~ anything, anything ~ Fn x_1 ... x_m, where m > n - If we couldn't decompose in the previous step, we return SurelyApart. - -Afterwards, the rest of the code doesn't have to worry about type families. - -Note [Unifying type synonyms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the task of unifying two 'Type's of the form - - TyConApp tc [] ~ TyConApp tc [] - -where `tc` is a type synonym. A naive way to perform this comparison these -would first expand the synonym and then compare the resulting expansions. - -However, this is obviously wasteful and the RHS of `tc` may be large; it is -much better to rather compare the TyCons directly. Consequently, before -expanding type synonyms in type comparisons we first look for a nullary -TyConApp and simply compare the TyCons if we find one. - -Of course, if we find that the TyCons are *not* equal then we still need to -perform the expansion as their RHSs may still be unifiable. E.g - type T = S (a->a) - type S a = [a] -and consider - T Int ~ S (Int -> Int) - -We can't decompose non-nullary synonyms. E.g. - type R a = F a -- Where F is a type family -and consider - R (a->a) ~ R Int -We can't conclude that (a->) ~ Int. (There is a currently-missed opportunity -here; if we knew that R was /injective/, perhaps we could decompose.) - -We perform the nullary-type-synonym optimisation in a number of places: - - * GHC.Core.Unify.unify_ty - * GHC.Tc.Solver.Equality.can_eq_nc' - * GHC.Tc.Utils.Unify.uType - -This optimisation is especially helpful for the ubiquitous GHC.Types.Type, -since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications -whenever possible. See Note [Using synonyms to compress types] in -GHC.Core.Type for details. - -c.f. Note [Comparing type synonyms] in GHC.Core.TyCo.Compare --} - --------------- unify_ty: the main workhorse ----------- - -type AmIUnifying = Bool -- True <=> Unifying - -- False <=> Matching - -unify_ty :: UMEnv - -> Type -> Type -- Types to be unified and a co - -> CoercionN -- A coercion between their kinds - -- See Note [Kind coercions in Unify] - -> UM () --- Precondition: see (Unification Kind Invariant) --- --- See Note [Specification of unification] --- Respects newtypes, PredTypes --- See Note [Computing equality on types] in GHC.Core.Type -unify_ty _env (TyConApp tc1 []) (TyConApp tc2 []) _kco - -- See Note [Unifying type synonyms] - | tc1 == tc2 - = return () - -unify_ty env ty1 ty2 kco - -- Now handle the cases we can "look through": synonyms and casts. - | Just ty1' <- coreView ty1 = unify_ty env ty1' ty2 kco - | Just ty2' <- coreView ty2 = unify_ty env ty1 ty2' kco - | CastTy ty1' co <- ty1 = if um_unif env - then unify_ty env ty1' ty2 (co `mkTransCo` kco) - else -- See Note [Matching in the presence of casts (1)] - do { subst <- getSubst env - ; let co' = substCo subst co - ; unify_ty env ty1' ty2 (co' `mkTransCo` kco) } - | CastTy ty2' co <- ty2 = unify_ty env ty1 ty2' (kco `mkTransCo` mkSymCo co) - -unify_ty env (TyVarTy tv1) ty2 kco - = uVar env tv1 ty2 kco -unify_ty env ty1 (TyVarTy tv2) kco - | um_unif env -- If unifying, can swap args - = uVar (umSwapRn env) tv2 ty1 (mkSymCo kco) - -unify_ty env ty1 ty2 _kco - - -- Handle non-oversaturated type families first - -- See Note [Unifying type applications] - -- - -- (C1) If we have T x1 ... xn ~ T y1 ... yn, use injectivity information of T - -- Note that both sides must not be oversaturated - | Just (tc1, tys1) <- isSatTyFamApp mb_tc_app1 - , Just (tc2, tys2) <- isSatTyFamApp mb_tc_app2 - , tc1 == tc2 - = do { let inj = case tyConInjectivityInfo tc1 of - NotInjective -> repeat False - Injective bs -> bs - - (inj_tys1, noninj_tys1) = partitionByList inj tys1 - (inj_tys2, noninj_tys2) = partitionByList inj tys2 - - ; unify_tys env inj_tys1 inj_tys2 - ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] - don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } - - | Just _ <- isSatTyFamApp mb_tc_app1 -- (C2) A (not-over-saturated) type-family application - = maybeApart MARTypeFamily -- behaves like a type variable; might match - - | Just _ <- isSatTyFamApp mb_tc_app2 -- (C2) A (not-over-saturated) type-family application - -- behaves like a type variable; might unify - -- but doesn't match (as in the TyVarTy case) - = if um_unif env then maybeApart MARTypeFamily else surelyApart - - -- Handle oversaturated type families. - -- - -- They can match an application (TyConApp/FunTy/AppTy), this is handled - -- the same way as in the AppTy case below. - -- - -- If there is no application, an oversaturated type family can only - -- match a type variable or a saturated type family, - -- both of which we handled earlier. So we can say surelyApart. - | Just (tc1, _) <- mb_tc_app1 - , isTypeFamilyTyCon tc1 - = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 - , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 - -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) - | otherwise -> surelyApart -- (C4) - - | Just (tc2, _) <- mb_tc_app2 - , isTypeFamilyTyCon tc2 - = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 - , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 - -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) - | otherwise -> surelyApart -- (C4) - - -- At this point, neither tc1 nor tc2 can be a type family. - | Just (tc1, tys1) <- mb_tc_app1 - , Just (tc2, tys2) <- mb_tc_app2 - , tc1 == tc2 - = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1) - ; unify_tc_app tc1 tys1 tys2 - } - - -- TYPE and CONSTRAINT are not Apart - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - -- NB: at this point we know that the two TyCons do not match - | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1 - , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2 - , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) || - (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey) - = maybeApart MARTypeVsConstraint - -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim - -- Note [Type and Constraint are not apart] - - -- The arrow types are not Apart - -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim - -- wrinkle (W2) - -- NB1: at this point we know that the two TyCons do not match - -- NB2: In the common FunTy/FunTy case you might wonder if we want to go via - -- splitTyConApp_maybe. But yes we do: we need to look at those implied - -- kind argument in order to satisfy (Unification Kind Invariant) - | FunTy {} <- ty1 - , FunTy {} <- ty2 - = maybeApart MARTypeVsConstraint - -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim - -- Note [Type and Constraint are not apart] - - where - mb_tc_app1 = splitTyConApp_maybe ty1 - mb_tc_app2 = splitTyConApp_maybe ty2 - - unify_tc_app tc tys1 tys2 - | tc == fUNTyCon - , IgnoreMultiplicities <- um_arr_mult env - , (_mult1 : no_mult_tys1) <- tys1 - , (_mult2 : no_mult_tys2) <- tys2 - = -- We're comparing function arrow types here (not constraint arrow - -- types!), and they have at least one argument, which is the arrow's - -- multiplicity annotation. The flag `um_arr_mult` instructs us to - -- ignore multiplicities in this very case. This is a little tricky: see - -- point (3) in Note [Rewrite rules ignore multiplicities in FunTy]. - unify_tys env no_mult_tys1 no_mult_tys2 - - | otherwise - = unify_tys env tys1 tys2 - - -- Applications need a bit of care! - -- They can match FunTy and TyConApp, so use splitAppTy_maybe - -- NB: we've already dealt with type variables, - -- so if one type is an App the other one jolly well better be too -unify_ty env (AppTy ty1a ty1b) ty2 _kco - | Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 - = unify_ty_app env ty1a [ty1b] ty2a [ty2b] - -unify_ty env ty1 (AppTy ty2a ty2b) _kco - | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 - = unify_ty_app env ty1a [ty1b] ty2a [ty2b] - -unify_ty _ (LitTy x) (LitTy y) _kco | x == y = return () - -unify_ty env (ForAllTy (Bndr tv1 _) ty1) (ForAllTy (Bndr tv2 _) ty2) kco - = do { unify_ty env (varType tv1) (varType tv2) (mkNomReflCo liftedTypeKind) - ; let env' = umRnBndr2 env tv1 tv2 - ; unify_ty env' ty1 ty2 kco } - --- See Note [Matching coercion variables] -unify_ty env (CoercionTy co1) (CoercionTy co2) kco - = do { c_subst <- getCvSubstEnv - ; case co1 of - CoVarCo cv - | not (um_unif env) - , not (cv `elemVarEnv` c_subst) - , let (_, co_l, co_r) = decomposeFunCo kco - -- Because the coercion is used in a type, it should be safe to - -- ignore the multiplicity coercion. - -- cv :: t1 ~ t2 - -- co2 :: s1 ~ s2 - -- co_l :: t1 ~ s1 - -- co_r :: t2 ~ s2 - rhs_co = co_l `mkTransCo` co2 `mkTransCo` mkSymCo co_r - , BindMe <- tvBindFlag env cv (CoercionTy rhs_co) - -> do { checkRnEnv env (tyCoVarsOfCo co2) - ; extendCvEnv cv rhs_co } - _ -> return () } - -unify_ty _ _ _ _ = surelyApart - -unify_ty_app :: UMEnv -> Type -> [Type] -> Type -> [Type] -> UM () -unify_ty_app env ty1 ty1args ty2 ty2args - | Just (ty1', ty1a) <- splitAppTyNoView_maybe ty1 - , Just (ty2', ty2a) <- splitAppTyNoView_maybe ty2 - = unify_ty_app env ty1' (ty1a : ty1args) ty2' (ty2a : ty2args) - - | otherwise - = do { let ki1 = typeKind ty1 - ki2 = typeKind ty2 - -- See Note [Kind coercions in Unify] - ; unify_ty env ki1 ki2 (mkNomReflCo liftedTypeKind) - ; unify_ty env ty1 ty2 (mkNomReflCo ki2) - -- Very important: 'ki2' not 'ki1' - -- See Note [Matching in the presence of casts (2)] - ; unify_tys env ty1args ty2args } - -unify_tys :: UMEnv -> [Type] -> [Type] -> UM () --- Precondition: see (Unification Kind Invariant) -unify_tys env orig_xs orig_ys - = go orig_xs orig_ys - where - go [] [] = return () - go (x:xs) (y:ys) - -- See Note [Kind coercions in Unify] - = do { unify_ty env x y (mkNomReflCo $ typeKind y) - -- Very important: 'y' not 'x' - -- See Note [Matching in the presence of casts (2)] - ; go xs ys } - go _ _ = surelyApart - -- Possibly different saturations of a polykinded tycon - -- See Note [Polykinded tycon applications] - -isSatTyFamApp :: Maybe (TyCon, [Type]) -> Maybe (TyCon, [Type]) --- Return the argument if we have a saturated type family application --- If it is /over/ saturated then we return False. E.g. --- unify_ty (F a b) (c d) where F has arity 1 --- we definitely want to decompose that type application! (#22647) -isSatTyFamApp tapp@(Just (tc, tys)) - | isTypeFamilyTyCon tc - && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated - = tapp -isSatTyFamApp _ = Nothing - ---------------------------------- -uVar :: UMEnv - -> InTyVar -- Variable to be unified - -> Type -- with this Type - -> Coercion -- :: kind tv ~N kind ty - -> UM () - -uVar env tv1 ty kco - = do { -- Apply the ambient renaming - let tv1' = umRnOccL env tv1 - - -- Check to see whether tv1 is refined by the substitution - ; subst <- getTvSubstEnv - ; case (lookupVarEnv subst tv1') of - Just ty' | um_unif env -- Unifying, so call - -> unify_ty env ty' ty kco -- back into unify - | otherwise - -> -- Matching, we don't want to just recur here. - -- this is because the range of the subst is the target - -- type, not the template type. So, just check for - -- normal type equality. - unless ((ty' `mkCastTy` kco) `tcEqType` ty) $ - surelyApart - -- NB: it's important to use `tcEqType` instead of `eqType` here, - -- otherwise we might not reject a substitution - -- which unifies `Type` with `Constraint`, e.g. - -- a call to tc_unify_tys with arguments - -- - -- tys1 = [k,k] - -- tys2 = [Type, Constraint] - -- - -- See test cases: T11715b, T20521. - Nothing -> uUnrefined env tv1' ty ty kco } -- No, continue - -uUnrefined :: UMEnv - -> OutTyVar -- variable to be unified - -> Type -- with this Type - -> Type -- (version w/ expanded synonyms) - -> Coercion -- :: kind tv ~N kind ty - -> UM () - --- We know that tv1 isn't refined - -uUnrefined env tv1' ty2 ty2' kco - | Just ty2'' <- coreView ty2' - = uUnrefined env tv1' ty2 ty2'' kco -- Unwrap synonyms - -- This is essential, in case we have - -- type Foo a = a - -- and then unify a ~ Foo a - - | TyVarTy tv2 <- ty2' - = do { let tv2' = umRnOccR env tv2 - ; unless (tv1' == tv2' && um_unif env) $ do - -- If we are unifying a ~ a, just return immediately - -- Do not extend the substitution - -- See Note [Self-substitution when matching] - - -- Check to see whether tv2 is refined - { subst <- getTvSubstEnv - ; case lookupVarEnv subst tv2 of - { Just ty' | um_unif env -> uUnrefined env tv1' ty' ty' kco - ; _ -> - - do { -- So both are unrefined - -- Bind one or the other, depending on which is bindable - ; let rhs1 = ty2 `mkCastTy` mkSymCo kco - rhs2 = ty1 `mkCastTy` kco - b1 = tvBindFlag env tv1' rhs1 - b2 = tvBindFlag env tv2' rhs2 - ty1 = mkTyVarTy tv1' - ; case (b1, b2) of - (BindMe, _) -> bindTv env tv1' rhs1 - (_, BindMe) | um_unif env - -> bindTv (umSwapRn env) tv2 rhs2 - - _ | tv1' == tv2' -> return () - -- How could this happen? If we're only matching and if - -- we're comparing forall-bound variables. - - _ -> surelyApart - }}}} - -uUnrefined env tv1' ty2 _ kco -- ty2 is not a type variable - = case tvBindFlag env tv1' rhs of - Apart -> surelyApart - BindMe -> bindTv env tv1' rhs - where - rhs = ty2 `mkCastTy` mkSymCo kco - -bindTv :: UMEnv -> OutTyVar -> Type -> UM () --- OK, so we want to extend the substitution with tv := ty --- But first, we must do a couple of checks -bindTv env tv1 ty2 - = do { let free_tvs2 = tyCoVarsOfType ty2 - - -- Make sure tys mentions no local variables - -- E.g. (forall a. b) ~ (forall a. [a]) - -- We should not unify b := [a]! - ; checkRnEnv env free_tvs2 - - -- Occurs check, see Note [Fine-grained unification] - -- Make sure you include 'kco' (which ty2 does) #14846 - ; occurs <- occursCheck env tv1 free_tvs2 - - ; if occurs then maybeApart MARInfinite - else extendTvEnv tv1 ty2 } - -occursCheck :: UMEnv -> TyVar -> VarSet -> UM Bool -occursCheck env tv free_tvs - | um_unif env - = do { tsubst <- getTvSubstEnv - ; return (tv `elemVarSet` niSubstTvSet tsubst free_tvs) } - - | otherwise -- Matching; no occurs check - = return False -- See Note [Self-substitution when matching] - -{- -%************************************************************************ -%* * - Binding decisions -* * -************************************************************************ --} - -data BindFlag - = BindMe -- ^ A regular type variable - - | Apart -- ^ Declare that this type variable is /apart/ from the - -- type provided. That is, the type variable will never - -- be instantiated to that type. - -- See also Note [Binding when looking up instances] - -- in GHC.Core.InstEnv. - deriving Eq --- NB: It would be conceivable to have an analogue to MaybeApart here, --- but there is not yet a need. - -{- -************************************************************************ -* * - Unification monad -* * -************************************************************************ --} - -data UMEnv - = UMEnv { um_unif :: AmIUnifying - - , um_inj_tf :: Bool - -- Checking for injectivity? - -- See (end of) Note [Specification of unification] - - , um_arr_mult :: MultiplicityFlag - -- Whether to unify multiplicity arguments when unifying arrows. - -- See Note [Rewrite rules ignore multiplicities in FunTy] - - , um_rn_env :: RnEnv2 - -- Renaming InTyVars to OutTyVars; this eliminates - -- shadowing, and lines up matching foralls on the left - -- and right - - , um_skols :: TyVarSet - -- OutTyVars bound by a forall in this unification; - -- Do not bind these in the substitution! - -- See the function tvBindFlag - - , um_bind_fun :: BindFun - -- User-supplied BindFlag function, - -- for variables not in um_skols - } - -data UMState = UMState - { um_tv_env :: TvSubstEnv - , um_cv_env :: CvSubstEnv } - -newtype UM a - = UM' { unUM :: UMState -> UnifyResultM (UMState, a) } - -- See Note [The one-shot state monad trick] in GHC.Utils.Monad - -pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a --- See Note [The one-shot state monad trick] in GHC.Utils.Monad -pattern UM m <- UM' m - where - UM m = UM' (oneShot m) -{-# COMPLETE UM #-} - -instance Functor UM where - fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s)) - -instance Applicative UM where - pure a = UM (\s -> pure (s, a)) - (<*>) = ap - -instance Monad UM where - {-# INLINE (>>=) #-} - -- See Note [INLINE pragmas and (>>)] in GHC.Utils.Monad - m >>= k = UM (\state -> - do { (state', v) <- unUM m state - ; unUM (k v) state' }) - -instance MonadFail UM where - fail _ = UM (\_ -> SurelyApart) -- failed pattern match - -initUM :: TvSubstEnv -- subst to extend - -> CvSubstEnv - -> UM a -> UnifyResultM a -initUM subst_env cv_subst_env um - = case unUM um state of - Unifiable (_, subst) -> Unifiable subst - MaybeApart r (_, subst) -> MaybeApart r subst - SurelyApart -> SurelyApart - where - state = UMState { um_tv_env = subst_env - , um_cv_env = cv_subst_env } - -tvBindFlag :: UMEnv -> OutTyVar -> Type -> BindFlag -tvBindFlag env tv rhs - | tv `elemVarSet` um_skols env = Apart - | otherwise = um_bind_fun env tv rhs - -getTvSubstEnv :: UM TvSubstEnv -getTvSubstEnv = UM $ \state -> Unifiable (state, um_tv_env state) - -getCvSubstEnv :: UM CvSubstEnv -getCvSubstEnv = UM $ \state -> Unifiable (state, um_cv_env state) - -getSubst :: UMEnv -> UM Subst -getSubst env = do { tv_env <- getTvSubstEnv - ; cv_env <- getCvSubstEnv - ; let in_scope = rnInScopeSet (um_rn_env env) - ; return (mkTCvSubst in_scope tv_env cv_env) } - -extendTvEnv :: TyVar -> Type -> UM () -extendTvEnv tv ty = UM $ \state -> - Unifiable (state { um_tv_env = extendVarEnv (um_tv_env state) tv ty }, ()) - -extendCvEnv :: CoVar -> Coercion -> UM () -extendCvEnv cv co = UM $ \state -> - Unifiable (state { um_cv_env = extendVarEnv (um_cv_env state) cv co }, ()) - -umRnBndr2 :: UMEnv -> TyCoVar -> TyCoVar -> UMEnv -umRnBndr2 env v1 v2 - = env { um_rn_env = rn_env', um_skols = um_skols env `extendVarSet` v' } - where - (rn_env', v') = rnBndr2_var (um_rn_env env) v1 v2 - -checkRnEnv :: UMEnv -> VarSet -> UM () -checkRnEnv env varset - | isEmptyVarSet skol_vars = return () - | varset `disjointVarSet` skol_vars = return () - | otherwise = surelyApart - where - skol_vars = um_skols env - -- NB: That isEmptyVarSet guard is a critical optimization; - -- it means we don't have to calculate the free vars of - -- the type, often saving quite a bit of allocation. - --- | Converts any SurelyApart to a MaybeApart -don'tBeSoSure :: MaybeApartReason -> UM () -> UM () -don'tBeSoSure r um = UM $ \ state -> - case unUM um state of - SurelyApart -> MaybeApart r (state, ()) - other -> other - -umRnOccL :: UMEnv -> TyVar -> TyVar -umRnOccL env v = rnOccL (um_rn_env env) v - -umRnOccR :: UMEnv -> TyVar -> TyVar -umRnOccR env v = rnOccR (um_rn_env env) v - -umSwapRn :: UMEnv -> UMEnv -umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) } - -maybeApart :: MaybeApartReason -> UM () -maybeApart r = UM (\state -> MaybeApart r (state, ())) - -surelyApart :: UM a -surelyApart = UM (\_ -> SurelyApart) - -{- -%************************************************************************ -%* * - Matching a (lifted) type against a coercion -%* * -%************************************************************************ - -This section defines essentially an inverse to liftCoSubst. It is defined -here to avoid a dependency from Coercion on this module. - --} - -data MatchEnv = ME { me_tmpls :: TyVarSet - , me_env :: RnEnv2 } - --- | 'liftCoMatch' is sort of inverse to 'liftCoSubst'. In particular, if --- @liftCoMatch vars ty co == Just s@, then @liftCoSubst s ty == co@, --- where @==@ there means that the result of 'liftCoSubst' has the same --- type as the original co; but may be different under the hood. --- That is, it matches a type against a coercion of the same --- "shape", and returns a lifting substitution which could have been --- used to produce the given coercion from the given type. --- Note that this function is incomplete -- it might return Nothing --- when there does indeed exist a possible lifting context. --- --- This function is incomplete in that it doesn't respect the equality --- in `eqType`. That is, it's possible that this will succeed for t1 and --- fail for t2, even when t1 `eqType` t2. That's because it depends on --- there being a very similar structure between the type and the coercion. --- This incompleteness shouldn't be all that surprising, especially because --- it depends on the structure of the coercion, which is a silly thing to do. --- --- The lifting context produced doesn't have to be exacting in the roles --- of the mappings. This is because any use of the lifting context will --- also require a desired role. Thus, this algorithm prefers mapping to --- nominal coercions where it can do so. -liftCoMatch :: TyCoVarSet -> Type -> Coercion -> Maybe LiftingContext -liftCoMatch tmpls ty co - = do { cenv1 <- ty_co_match menv emptyVarEnv ki ki_co ki_ki_co ki_ki_co - ; cenv2 <- ty_co_match menv cenv1 ty co - (mkNomReflCo co_lkind) (mkNomReflCo co_rkind) - ; return (LC (mkEmptySubst in_scope) cenv2) } - where - menv = ME { me_tmpls = tmpls, me_env = mkRnEnv2 in_scope } - in_scope = mkInScopeSet (tmpls `unionVarSet` tyCoVarsOfCo co) - -- Like tcMatchTy, assume all the interesting variables - -- in ty are in tmpls - - ki = typeKind ty - ki_co = promoteCoercion co - ki_ki_co = mkNomReflCo liftedTypeKind - - Pair co_lkind co_rkind = coercionKind ki_co - --- | 'ty_co_match' does all the actual work for 'liftCoMatch'. -ty_co_match :: MatchEnv -- ^ ambient helpful info - -> LiftCoEnv -- ^ incoming subst - -> Type -- ^ ty, type to match - -> Coercion -- ^ co :: lty ~r rty, coercion to match against - -> Coercion -- ^ :: kind(lsubst(ty)) ~N kind(lty) - -> Coercion -- ^ :: kind(rsubst(ty)) ~N kind(rty) - -> Maybe LiftCoEnv - -- ^ Just env ==> liftCoSubst Nominal env ty == co, modulo roles. - -- Also: Just env ==> lsubst(ty) == lty and rsubst(ty) == rty, - -- where lsubst = lcSubstLeft(env) and rsubst = lcSubstRight(env) -ty_co_match menv subst ty co lkco rkco - | Just ty' <- coreView ty = ty_co_match menv subst ty' co lkco rkco - - -- handle Refl case: - | tyCoVarsOfType ty `isNotInDomainOf` subst - , Just (ty', _) <- isReflCo_maybe co - , ty `eqType` ty' - -- Why `eqType` and not `tcEqType`? Because this function is only used - -- during coercion optimisation, after type-checking has finished. - = Just subst - - where - isNotInDomainOf :: VarSet -> VarEnv a -> Bool - isNotInDomainOf set env - = noneSet (\v -> elemVarEnv v env) set - - noneSet :: (Var -> Bool) -> VarSet -> Bool - noneSet f = allVarSet (not . f) - -ty_co_match menv subst ty co lkco rkco - | CastTy ty' co' <- ty - -- See Note [Matching in the presence of casts (1)] - = let empty_subst = mkEmptySubst (rnInScopeSet (me_env menv)) - substed_co_l = substCo (liftEnvSubstLeft empty_subst subst) co' - substed_co_r = substCo (liftEnvSubstRight empty_subst subst) co' - in - ty_co_match menv subst ty' co (substed_co_l `mkTransCo` lkco) - (substed_co_r `mkTransCo` rkco) - - | SymCo co' <- co - = swapLiftCoEnv <$> ty_co_match menv (swapLiftCoEnv subst) ty co' rkco lkco - - -- Match a type variable against a non-refl coercion -ty_co_match menv subst (TyVarTy tv1) co lkco rkco - | Just co1' <- lookupVarEnv subst tv1' -- tv1' is already bound to co1 - = if eqCoercionX (nukeRnEnvL rn_env) co1' co - then Just subst - else Nothing -- no match since tv1 matches two different coercions - - | tv1' `elemVarSet` me_tmpls menv -- tv1' is a template var - = if any (inRnEnvR rn_env) (tyCoVarsOfCoList co) - then Nothing -- occurs check failed - else Just $ extendVarEnv subst tv1' $ - castCoercionKind co (mkSymCo lkco) (mkSymCo rkco) - - | otherwise - = Nothing - - where - rn_env = me_env menv - tv1' = rnOccL rn_env tv1 - - -- just look through SubCo's. We don't really care about roles here. -ty_co_match menv subst ty (SubCo co) lkco rkco - = ty_co_match menv subst ty co lkco rkco - -ty_co_match menv subst (AppTy ty1a ty1b) co _lkco _rkco - | Just (co2, arg2) <- splitAppCo_maybe co -- c.f. Unify.match on AppTy - = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2] -ty_co_match menv subst ty1 (AppCo co2 arg2) _lkco _rkco - | Just (ty1a, ty1b) <- splitAppTyNoView_maybe ty1 - -- yes, the one from Type, not TcType; this is for coercion optimization - = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2] - -ty_co_match menv subst (TyConApp tc1 tys) (TyConAppCo _ tc2 cos) _lkco _rkco - = ty_co_match_tc menv subst tc1 tys tc2 cos - -ty_co_match menv subst (FunTy { ft_mult = w, ft_arg = ty1, ft_res = ty2 }) - (FunCo { fco_mult = co_w, fco_arg = co1, fco_res = co2 }) _lkco _rkco - = ty_co_match_args menv subst [w, rep1, rep2, ty1, ty2] - [co_w, co1_rep, co2_rep, co1, co2] - where - rep1 = getRuntimeRep ty1 - rep2 = getRuntimeRep ty2 - co1_rep = mkRuntimeRepCo co1 - co2_rep = mkRuntimeRepCo co2 - -- NB: we include the RuntimeRep arguments in the matching; - -- not doing so caused #21205. - -ty_co_match menv subst (ForAllTy (Bndr tv1 vis1t) ty1) - (ForAllCo tv2 vis1c vis2c kind_co2 co2) - lkco rkco - | isTyVar tv1 && isTyVar tv2 - , vis1t == vis1c && vis1c == vis2c -- Is this necessary? - -- Is this visibility check necessary? @rae says: yes, I think the - -- check is necessary, if we're caring about visibility (and we are). - -- But ty_co_match is a dark and not important corner. - = do { subst1 <- ty_co_match menv subst (tyVarKind tv1) kind_co2 - ki_ki_co ki_ki_co - ; let rn_env0 = me_env menv - rn_env1 = rnBndr2 rn_env0 tv1 tv2 - menv' = menv { me_env = rn_env1 } - ; ty_co_match menv' subst1 ty1 co2 lkco rkco } - where - ki_ki_co = mkNomReflCo liftedTypeKind - --- ty_co_match menv subst (ForAllTy (Bndr cv1 _) ty1) --- (ForAllCo cv2 kind_co2 co2) --- lkco rkco --- | isCoVar cv1 && isCoVar cv2 --- We seems not to have enough information for this case --- 1. Given: --- cv1 :: (s1 :: k1) ~r (s2 :: k2) --- kind_co2 :: (s1' ~ s2') ~N (t1 ~ t2) --- eta1 = mkSelCo (SelTyCon 2 role) (downgradeRole r Nominal kind_co2) --- :: s1' ~ t1 --- eta2 = mkSelCo (SelTyCon 3 role) (downgradeRole r Nominal kind_co2) --- :: s2' ~ t2 --- Wanted: --- subst1 <- ty_co_match menv subst s1 eta1 kco1 kco2 --- subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4 --- Question: How do we get kcoi? --- 2. Given: --- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep --- rkco :: <*> --- Wanted: --- ty_co_match menv' subst2 ty1 co2 lkco' rkco' --- Question: How do we get lkco' and rkco'? - -ty_co_match _ subst (CoercionTy {}) _ _ _ - = Just subst -- don't inspect coercions - -ty_co_match menv subst ty (GRefl r t (MCo co)) lkco rkco - = ty_co_match menv subst ty (GRefl r t MRefl) lkco (rkco `mkTransCo` mkSymCo co) - -ty_co_match menv subst ty co1 lkco rkco - | Just (CastTy t co, r) <- isReflCo_maybe co1 - -- In @pushRefl@, pushing reflexive coercion inside CastTy will give us - -- t |> co ~ t ; ; t ~ t |> co - -- But transitive coercions are not helpful. Therefore we deal - -- with it here: we do recursion on the smaller reflexive coercion, - -- while propagating the correct kind coercions. - = let kco' = mkSymCo co - in ty_co_match menv subst ty (mkReflCo r t) (lkco `mkTransCo` kco') - (rkco `mkTransCo` kco') - -ty_co_match menv subst ty co lkco rkco - | Just co' <- pushRefl co = ty_co_match menv subst ty co' lkco rkco - | otherwise = Nothing - -ty_co_match_tc :: MatchEnv -> LiftCoEnv - -> TyCon -> [Type] - -> TyCon -> [Coercion] - -> Maybe LiftCoEnv -ty_co_match_tc menv subst tc1 tys1 tc2 cos2 - = do { guard (tc1 == tc2) - ; ty_co_match_args menv subst tys1 cos2 } - -ty_co_match_app :: MatchEnv -> LiftCoEnv - -> Type -> [Type] -> Coercion -> [Coercion] - -> Maybe LiftCoEnv -ty_co_match_app menv subst ty1 ty1args co2 co2args - | Just (ty1', ty1a) <- splitAppTyNoView_maybe ty1 - , Just (co2', co2a) <- splitAppCo_maybe co2 - = ty_co_match_app menv subst ty1' (ty1a : ty1args) co2' (co2a : co2args) - - | otherwise - = do { subst1 <- ty_co_match menv subst ki1 ki2 ki_ki_co ki_ki_co - ; let Pair lkco rkco = mkNomReflCo <$> coercionKind ki2 - ; subst2 <- ty_co_match menv subst1 ty1 co2 lkco rkco - ; ty_co_match_args menv subst2 ty1args co2args } - where - ki1 = typeKind ty1 - ki2 = promoteCoercion co2 - ki_ki_co = mkNomReflCo liftedTypeKind - -ty_co_match_args :: MatchEnv -> LiftCoEnv -> [Type] -> [Coercion] - -> Maybe LiftCoEnv -ty_co_match_args menv subst (ty:tys) (arg:args) - = do { let Pair lty rty = coercionKind arg - lkco = mkNomReflCo (typeKind lty) - rkco = mkNomReflCo (typeKind rty) - ; subst' <- ty_co_match menv subst ty arg lkco rkco - ; ty_co_match_args menv subst' tys args } -ty_co_match_args _ subst [] [] = Just subst -ty_co_match_args _ _ _ _ = Nothing - -pushRefl :: Coercion -> Maybe Coercion -pushRefl co = - case (isReflCo_maybe co) of - Just (AppTy ty1 ty2, Nominal) - -> Just (AppCo (mkReflCo Nominal ty1) (mkNomReflCo ty2)) - Just (FunTy af w ty1 ty2, r) - -> Just (FunCo r af af (mkReflCo r w) (mkReflCo r ty1) (mkReflCo r ty2)) - Just (TyConApp tc tys, r) - -> Just (TyConAppCo r tc (zipWith mkReflCo (tyConRoleListX r tc) tys)) - Just (ForAllTy (Bndr tv vis) ty, r) - -> Just (ForAllCo { fco_tcv = tv, fco_visL = vis, fco_visR = vis - , fco_kind = mkNomReflCo (varType tv) - , fco_body = mkReflCo r ty }) - _ -> Nothing - -{- -************************************************************************ -* * - Flattening -* * -************************************************************************ - -Note [Flattening type-family applications when matching instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As described in "Closed type families with overlapping equations" -http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf -we need to flatten core types before unifying them, when checking for "surely-apart" -against earlier equations of a closed type family. -Flattening means replacing all top-level uses of type functions with -fresh variables, *taking care to preserve sharing*. That is, the type -(Either (F a b) (F a b)) should flatten to (Either c c), never (Either -c d). - -Here is a nice example of why it's all necessary: - - type family F a b where - F Int Bool = Char - F a b = Double - type family G a -- open, no instances - -How do we reduce (F (G Float) (G Float))? The first equation clearly doesn't match, -while the second equation does. But, before reducing, we must make sure that the -target can never become (F Int Bool). Well, no matter what G Float becomes, it -certainly won't become *both* Int and Bool, so indeed we're safe reducing -(F (G Float) (G Float)) to Double. - -This is necessary not only to get more reductions (which we might be -willing to give up on), but for substitutivity. If we have (F x x), we -can see that (F x x) can reduce to Double. So, it had better be the -case that (F blah blah) can reduce to Double, no matter what (blah) -is! Flattening as done below ensures this. - -We also use this flattening operation to check for class instances. -If we have - instance C (Maybe b) - instance {-# OVERLAPPING #-} C (Maybe Bool) - [W] C (Maybe (F a)) -we want to know that the second instance might match later. So we -flatten the (F a) in the target before trying to unify with instances. -(This is done in GHC.Core.InstEnv.lookupInstEnv'.) - -The algorithm works by building up a TypeMap TyVar, mapping -type family applications to fresh variables. This mapping must -be threaded through all the function calls, as any entry in -the mapping must be propagated to all future nodes in the tree. - -The algorithm also must track the set of in-scope variables, in -order to make fresh variables as it flattens. (We are far from a -source of fresh Uniques.) See Wrinkle 2, below. - -There are wrinkles, of course: - -1. The flattening algorithm must account for the possibility - of inner `forall`s. (A `forall` seen here can happen only - because of impredicativity. However, the flattening operation - is an algorithm in Core, which is impredicative.) - Suppose we have (forall b. F b) -> (forall b. F b). Of course, - those two bs are entirely unrelated, and so we should certainly - not flatten the two calls F b to the same variable. Instead, they - must be treated separately. We thus carry a substitution that - freshens variables; we must apply this substitution (in - `coreFlattenTyFamApp`) before looking up an application in the environment. - Note that the range of the substitution contains only TyVars, never anything - else. - - For the sake of efficiency, we only apply this substitution when absolutely - necessary. Namely: - - * We do not perform the substitution at all if it is empty. - * We only need to worry about the arguments of a type family that are within - the arity of said type family, so we can get away with not applying the - substitution to any oversaturated type family arguments. - * Importantly, we do /not/ achieve this substitution by recursively - flattening the arguments, as this would be wrong. Consider `F (G a)`, - where F and G are type families. We might decide that `F (G a)` flattens - to `beta`. Later, the substitution is non-empty (but does not map `a`) and - so we flatten `G a` to `gamma` and try to flatten `F gamma`. Of course, - `F gamma` is unknown, and so we flatten it to `delta`, but it really - should have been `beta`! Argh! - - Moral of the story: instead of flattening the arguments, just substitute - them directly. - -2. There are two different reasons we might add a variable - to the in-scope set as we work: - - A. We have just invented a new flattening variable. - B. We have entered a `forall`. - - Annoying here is that in-scope variable source (A) must be - threaded through the calls. For example, consider (F b -> forall c. F c). - Suppose that, when flattening F b, we invent a fresh variable c. - Now, when we encounter (forall c. F c), we need to know c is already in - scope so that we locally rename c to c'. However, if we don't thread through - the in-scope set from one argument of (->) to the other, we won't know this - and might get very confused. - - In contrast, source (B) increases only as we go deeper, as in-scope sets - normally do. However, even here we must be careful. The TypeMap TyVar that - contains mappings from type family applications to freshened variables will - be threaded through both sides of (forall b. F b) -> (forall b. F b). We - thus must make sure that the two `b`s don't get renamed to the same b1. (If - they did, then looking up `F b1` would yield the same flatten var for - each.) So, even though `forall`-bound variables should really be in the - in-scope set only when they are in scope, we retain these variables even - outside of their scope. This ensures that, if we encounter a fresh - `forall`-bound b, we will rename it to b2, not b1. Note that keeping a - larger in-scope set than strictly necessary is always OK, as in-scope sets - are only ever used to avoid collisions. - - Sadly, the freshening substitution described in (1) really mustn't bind - variables outside of their scope: note that its domain is the *unrenamed* - variables. This means that the substitution gets "pushed down" (like a - reader monad) while the in-scope set gets threaded (like a state monad). - Because a Subst contains its own in-scope set, we don't carry a Subst; - instead, we just carry a TvSubstEnv down, tying it to the InScopeSet - traveling separately as necessary. - -3. Consider `F ty_1 ... ty_n`, where F is a type family with arity k: - - type family F ty_1 ... ty_k :: res_k - - It's tempting to just flatten `F ty_1 ... ty_n` to `alpha`, where alpha is a - flattening skolem. But we must instead flatten it to - `alpha ty_(k+1) ... ty_n`—that is, by only flattening up to the arity of the - type family. - - Why is this better? Consider the following concrete example from #16995: - - type family Param :: Type -> Type - - type family LookupParam (a :: Type) :: Type where - LookupParam (f Char) = Bool - LookupParam x = Int - - foo :: LookupParam (Param ()) - foo = 42 - - In order for `foo` to typecheck, `LookupParam (Param ())` must reduce to - `Int`. But if we flatten `Param ()` to `alpha`, then GHC can't be sure if - `alpha` is apart from `f Char`, so it won't fall through to the second - equation. But since the `Param` type family has arity 0, we can instead - flatten `Param ()` to `alpha ()`, about which GHC knows with confidence is - apart from `f Char`, permitting the second equation to be reached. - - Not only does this allow more programs to be accepted, it's also important - for correctness. Not doing this was the root cause of the Core Lint error - in #16995. - -flattenTys is defined here because of module dependencies. --} - -data FlattenEnv - = FlattenEnv { fe_type_map :: TypeMap (TyVar, TyCon, [Type]) - -- domain: exactly-saturated type family applications - -- range: (fresh variable, type family tycon, args) - , fe_in_scope :: InScopeSet } - -- See Note [Flattening type-family applications when matching instances] - -emptyFlattenEnv :: InScopeSet -> FlattenEnv -emptyFlattenEnv in_scope - = FlattenEnv { fe_type_map = emptyTypeMap - , fe_in_scope = in_scope } - -updateInScopeSet :: FlattenEnv -> (InScopeSet -> InScopeSet) -> FlattenEnv -updateInScopeSet env upd = env { fe_in_scope = upd (fe_in_scope env) } - -flattenTys :: InScopeSet -> [Type] -> [Type] --- See Note [Flattening type-family applications when matching instances] -flattenTys in_scope tys = fst (flattenTysX in_scope tys) - -flattenTysX :: InScopeSet -> [Type] -> ([Type], TyVarEnv (TyCon, [Type])) --- See Note [Flattening type-family applications when matching instances] --- NB: the returned types mention the fresh type variables --- in the domain of the returned env, whose range includes --- the original type family applications. Building a substitution --- from this information and applying it would yield the original --- types -- almost. The problem is that the original type might --- have something like (forall b. F a b); the returned environment --- can't really sensibly refer to that b. So it may include a locally- --- bound tyvar in its range. Currently, the only usage of this env't --- checks whether there are any meta-variables in it --- (in GHC.Tc.Solver.Monad.mightEqualLater), so this is all OK. -flattenTysX in_scope tys - = let (env, result) = coreFlattenTys emptyTvSubstEnv (emptyFlattenEnv in_scope) tys in - (result, build_env (fe_type_map env)) - where - build_env :: TypeMap (TyVar, TyCon, [Type]) -> TyVarEnv (TyCon, [Type]) - build_env env_in - = foldTM (\(tv, tc, tys) env_out -> extendVarEnv env_out tv (tc, tys)) - env_in emptyVarEnv - -coreFlattenTys :: TvSubstEnv -> FlattenEnv - -> [Type] -> (FlattenEnv, [Type]) -coreFlattenTys subst = mapAccumL (coreFlattenTy subst) - -coreFlattenTy :: TvSubstEnv -> FlattenEnv - -> Type -> (FlattenEnv, Type) -coreFlattenTy subst = go - where - go env ty | Just ty' <- coreView ty = go env ty' - - go env (TyVarTy tv) - | Just ty <- lookupVarEnv subst tv = (env, ty) - | otherwise = let (env', ki) = go env (tyVarKind tv) in - (env', mkTyVarTy $ setTyVarKind tv ki) - go env (AppTy ty1 ty2) = let (env1, ty1') = go env ty1 - (env2, ty2') = go env1 ty2 in - (env2, AppTy ty1' ty2') - go env (TyConApp tc tys) - -- NB: Don't just check if isFamilyTyCon: this catches *data* families, - -- which are generative and thus can be preserved during flattening - | not (isGenerativeTyCon tc Nominal) - = coreFlattenTyFamApp subst env tc tys - - | otherwise - = let (env', tys') = coreFlattenTys subst env tys in - (env', mkTyConApp tc tys') - - go env ty@(FunTy { ft_mult = mult, ft_arg = ty1, ft_res = ty2 }) - = let (env1, ty1') = go env ty1 - (env2, ty2') = go env1 ty2 - (env3, mult') = go env2 mult in - (env3, ty { ft_mult = mult', ft_arg = ty1', ft_res = ty2' }) - - go env (ForAllTy (Bndr tv vis) ty) - = let (env1, subst', tv') = coreFlattenVarBndr subst env tv - (env2, ty') = coreFlattenTy subst' env1 ty in - (env2, ForAllTy (Bndr tv' vis) ty') - - go env ty@(LitTy {}) = (env, ty) - - go env (CastTy ty co) - = let (env1, ty') = go env ty - (env2, co') = coreFlattenCo subst env1 co in - (env2, CastTy ty' co') - - go env (CoercionTy co) - = let (env', co') = coreFlattenCo subst env co in - (env', CoercionTy co') - - --- when flattening, we don't care about the contents of coercions. --- so, just return a fresh variable of the right (flattened) type -coreFlattenCo :: TvSubstEnv -> FlattenEnv - -> Coercion -> (FlattenEnv, Coercion) -coreFlattenCo subst env co - = (env2, mkCoVarCo covar) - where - (env1, kind') = coreFlattenTy subst env (coercionType co) - covar = mkFlattenFreshCoVar (fe_in_scope env1) kind' - -- Add the covar to the FlattenEnv's in-scope set. - -- See Note [Flattening type-family applications when matching instances], wrinkle 2A. - env2 = updateInScopeSet env1 (flip extendInScopeSet covar) - -coreFlattenVarBndr :: TvSubstEnv -> FlattenEnv - -> TyCoVar -> (FlattenEnv, TvSubstEnv, TyVar) -coreFlattenVarBndr subst env tv - = (env2, subst', tv') - where - -- See Note [Flattening type-family applications when matching instances], wrinkle 2B. - kind = varType tv - (env1, kind') = coreFlattenTy subst env kind - tv' = uniqAway (fe_in_scope env1) (setVarType tv kind') - subst' = extendVarEnv subst tv (mkTyVarTy tv') - env2 = updateInScopeSet env1 (flip extendInScopeSet tv') - -coreFlattenTyFamApp :: TvSubstEnv -> FlattenEnv - -> TyCon -- type family tycon - -> [Type] -- args, already flattened - -> (FlattenEnv, Type) -coreFlattenTyFamApp tv_subst env fam_tc fam_args - = case lookupTypeMap type_map fam_ty of - Just (tv, _, _) -> (env', mkAppTys (mkTyVarTy tv) leftover_args') - Nothing -> - let tyvar_name = mkFlattenFreshTyName fam_tc - tv = uniqAway in_scope $ - mkTyVar tyvar_name (typeKind fam_ty) - - ty' = mkAppTys (mkTyVarTy tv) leftover_args' - env'' = env' { fe_type_map = extendTypeMap type_map fam_ty - (tv, fam_tc, sat_fam_args) - , fe_in_scope = extendInScopeSet in_scope tv } - in (env'', ty') - where - arity = tyConArity fam_tc - tcv_subst = Subst (fe_in_scope env) emptyIdSubstEnv tv_subst emptyVarEnv - (sat_fam_args, leftover_args) = assert (arity <= length fam_args) $ - splitAt arity fam_args - -- Apply the substitution before looking up an application in the - -- environment. See Note [Flattening type-family applications when matching instances], - -- wrinkle 1. - -- NB: substTys short-cuts the common case when the substitution is empty. - sat_fam_args' = substTys tcv_subst sat_fam_args - (env', leftover_args') = coreFlattenTys tv_subst env leftover_args - -- `fam_tc` may be over-applied to `fam_args` (see - -- Note [Flattening type-family applications when matching instances] - -- wrinkle 3), so we split it into the arguments needed to saturate it - -- (sat_fam_args') and the rest (leftover_args') - fam_ty = mkTyConApp fam_tc sat_fam_args' - FlattenEnv { fe_type_map = type_map - , fe_in_scope = in_scope } = env' - -mkFlattenFreshTyName :: Uniquable a => a -> Name -mkFlattenFreshTyName unq - = mkSysTvName (getUnique unq) (fsLit "flt") - -mkFlattenFreshCoVar :: InScopeSet -> Kind -> CoVar -mkFlattenFreshCoVar in_scope kind - = let uniq = unsafeGetFreshLocalUnique in_scope - name = mkSystemVarName uniq (fsLit "flc") - in mkCoVar name kind - + tcUnifyTy, tcUnifyTys, tcUnifyFunDeps, tcUnifyDebugger, + tcUnifyTysFG, tcUnifyTyForInjectivity, + BindTvFun, BindFamFun, BindFlag(..), + matchBindTv, alwaysBindTv, alwaysBindFam, dontCareBindFam, + UnifyResult, UnifyResultM(..), MaybeApartReason(..), + typesCantMatch, typesAreApart, + + -- Matching a type against a lifted type (coercion) + liftCoMatch + ) where + +import GHC.Prelude + +import GHC.Types.Var +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Builtin.Names( tYPETyConKey, cONSTRAINTTyConKey ) +import GHC.Core.Type hiding ( getTvSubstEnv ) +import GHC.Core.Coercion hiding ( getCvSubstEnv ) +import GHC.Core.Predicate( scopedSort ) +import GHC.Core.TyCon +import GHC.Core.Predicate( CanEqLHS(..), canEqLHS_maybe ) +import GHC.Core.TyCon.Env +import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.Compare ( eqType, tcEqType, tcEqTyConAppArgs ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfCoList, tyCoFVsOfTypes ) +import GHC.Core.TyCo.Subst ( mkTvSubst ) +import GHC.Core.Map.Type +import GHC.Core.Multiplicity + +import GHC.Utils.FV( FV, fvVarList ) +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.Types.Basic( SwapFlag(..) ) +import GHC.Types.Unique.FM +import GHC.Exts( oneShot ) +import GHC.Utils.Panic + +import GHC.Data.Pair +import GHC.Data.TrieMap +import GHC.Data.Maybe( orElse ) + +import Control.Monad +import qualified Data.Semigroup as S +import GHC.Builtin.Types.Prim (fUNTyCon) + +{- Note [The Core unifier] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +This module contains the (pure) unifier two types. It is subtle in a number +of ways. Here we summarise, but see Note [Specification of unification]. + +(CU1) It creates a substition only for "bindable" or "template" type variables. + These are identified by a `um_bind_tv_fun` function passed down in the `UMEnv` + environment. + +(CU2) We want to match in the presence of foralls; + e.g (forall a. t1) ~ (forall b. t2) + That is what the `um_rn_env :: RnEnv2` field of `UMEnv` is for; it does the + alpha-renaming that makes it as if `a` and `b` were the same variable. + Initialising the `RnEnv2`, so that it can generate a fresh binder when + necessary, entails knowing the free variables of both types. + + Of course, we must be careful not to bind a template type variable to a + locally bound variable. E.g. + (forall a. x) ~ (forall b. b) + where `x` is the template type variable. Then we do not want to + bind `x` to a/b! See `mentionsForAllBoundTyVarsL/R`. + +(CU3) We want to take special care for type families. + See the big Note [Apartness and type families] + +(CU4) Rather than returning just "unifiable" or "not-unifiable" we do "fine-grained" + unification (hence "fg" or "FG" in this module) returning three possiblities, + captured in `UnifyResult`: + - Unifiable subst : certainly unifiable with this type substitution + - SurelyApart : cannot be unifiable, regardless of how type familes reduce + - MaybeApart : neither of the above + See Note [Unification result]. + + Four reasons for MaybeApart (see `MaybeApartReason`). The first two are the + big ones! + * MARTypeFamily: + Family reduction might make the two types equal + Maybe (F Int) ~ Maybe Bool + See Note [Apartness and type families] + * MARInfinite (occurs check): + See Note [Infinitary substitutions] + * MARTypeVsConstraint: + See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim + * MARCast (obscure): + See (KCU2) in Note [Kind coercions in Unify] + +(CU5) We need to take care with kinds. See Note [tcMatchTy vs tcMatchTyKi] + +(CU6) The "unifier" can also do /matching/, governed by `um_unif :: AmIUnifying`. + When matching, the LHS and RHS namespaces are unrelated. In particular, the + bindable type variable can occur (unrelatedly) in the RHS. E.g. + match (a,Maybe a) ~ ([a], Maybe [a]) + We get the substitution [a :-> [a]], without confusing the + LHS `a` with the RHS `a`. The substitition is "one-shot", and should not be + iterated. + +Note [Infinitary substitutions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Do the types (x, x) and ([y], y) unify? The answer is seemingly "no" -- +no substitution to finite types makes these match. This is the famous +"occurs check". + +But, a substitution to *infinite* types can unify these two types: + [x |-> [[...]]], y |-> [[[...]]] ]. + +Why do we care? Consider these two type family instances: + + type instance F x x = Int + type instance F [y] y = Bool + +If we also have + + type instance Looper = [Looper] + +then the instances potentially overlap -- they are not "apart". So we must +distinguish failure-to-unify from definitely-apart. The solution is to use +unification over infinite terms. This is possible (see [1] for lots of gory +details), but a full algorithm is a little more powerful than we need. Instead, +we make a conservative approximation and just omit the occurs check. + + [1]: http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf + +tcUnifyTys considers an occurs-check problem as the same as general unification +failure. + +See also #8162. + +It's worth noting that unification in the presence of infinite types is not +complete. This means that, sometimes, a closed type family does not reduce +when it should. See test case indexed-types/should_fail/Overlap15 for an +example. + +Note [tcMatchTy vs tcMatchTyKi] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This module offers two variants of matching: with kinds and without. +The TyKi variant takes two types, of potentially different kinds, +and matches them. Along the way, it necessarily also matches their +kinds. The Ty variant instead assumes that the kinds are already +eqType and so skips matching up the kinds. + +How do you choose between them? + +1. If you know that the kinds of the two types are eqType, use + the Ty variant. It is more efficient, as it does less work. + +2. If the kinds of variables in the template type might mention type families, + use the Ty variant (and do other work to make sure the kinds + work out). These pure unification functions do a straightforward + syntactic unification and do no complex reasoning about type + families. Note that the types of the variables in instances can indeed + mention type families, so instance lookup must use the Ty variant. + + (Nothing goes terribly wrong -- no panics -- if there might be type + families in kinds in the TyKi variant. You just might get match + failure even though a reducing a type family would lead to success.) + +3. Otherwise, if you're sure that the variable kinds do not mention + type families and you're not already sure that the kind of the template + equals the kind of the target, then use the TyKi version. + +Note [Unification result] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See `UnifyResult` and `UnifyResultM`. When unifying t1 ~ t2, we return +* Unifiable s, if s is a substitution such that s(t1) is syntactically the + same as s(t2), modulo type-synonym expansion. +* SurelyApart, if there is no substitution s such that s(t1) = s(t2), + where "=" includes type-family reductions. +* MaybeApart mar s, when we aren't sure. `mar` is a MaybeApartReason. + +Examples +* [a] ~ Maybe b: SurelyApart, because [] and Maybe can't unify + +* [(a,Int)] ~ [(Bool,b)]: Unifiable + +* [F Int] ~ [Bool]: MaybeApart MARTypeFamily, because F Int might reduce to Bool + (the unifier does not try this) + +* a ~ Maybe a: MaybeApart MARInfinite. Not Unifiable clearly, but not SurelyApart + either; consider + a := Loop + where type family Loop where Loop = Maybe Loop + +Wrinkle (UR1): see `combineMAR` + There is the possibility that two types are MaybeApart for *both* reasons: + + * (a, F Int) ~ (Maybe a, Bool) + + What reason should we use? The *only* consumer of the reason is described + in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv. The goal + there is identify which instances might match a target later (but don't + match now) -- except that we want to ignore the possibility of infinitary + substitutions. So let's examine a concrete scenario: + + class C a b c + instance C a (Maybe a) Bool + -- other instances, including one that will actually match + [W] C b b (F Int) + + Do we want the instance as a future possibility? No. The only way that + instance can match is in the presence of an infinite type (infinitely nested + Maybes). We thus say that `MARInfinite` takes precedence, so that InstEnv treats + this case as an infinitary substitution case; the fact that a type family is + involved is only incidental. We thus define `combineMAR` to prefer + `MARInfinite`. + +Note [Apartness and type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this: + + type family F a b where + F Int Bool = Char + F a b = Double + type family G a -- open, no instances + +How do we reduce (F (G Float) (G Float))? The first equation clearly doesn't +match immediately while the second equation does. But, before reducing, we must +make sure that the target can never become (F Int Bool). Well, no matter what G +Float becomes, it certainly won't become *both* Int and Bool, so indeed we're +safe reducing (F (G Float) (G Float)) to Double. + +So we must say that the argument list + (G Float) (G Float) is SurelyApart from Int Bool + +This is necessary not only to get more reductions (which we might be willing to +give up on), but for /substitutivity/. If we have (F x x), we can see that (F x x) +can reduce to Double. So, it had better be the case that (F blah blah) can +reduce to Double, no matter what (blah) is! + +To achieve this, `go` in `uVarOrFam` does this; + +* We maintain /two/ substitutions, not just one: + * um_tv_env: the regular substitution, mapping TyVar :-> Type + * um_fam_env: maps (TyCon,[Type]) :-> Type, where the LHS is a type-fam application + In effect, these constitute one substitution mapping + CanEqLHS :-> Types + +* When we attempt to unify (G Float) ~ Int, we return MaybeApart.. + but we /also/ add a "family substitution" [G Float :-> Int], + to `um_fam_env`. See the `BindMe` case of `go` in `uVarOrFam`. + +* When we later encounter (G Float) ~ Bool, we apply the family substitution, + very much as we apply the conventional [tyvar :-> type] substitution + when we encounter a type variable. See the `lookupFamEnv` in `go` in + `uVarOrFam`. + + So (G Float ~ Bool) becomes (Int ~ Bool) which is SurelyApart. Bingo. + + +Wrinkles + +(ATF0) Once we encounter a type-family application, we only ever return + MaybeApart or SurelyApart + but never `Unifiable`. Accordingly, we only return a TyCoVar substitution + from `tcUnifyTys` and friends; we don't return a type-family substitution as + well. (We could imagine doing so, though.) + +(ATF1) Exactly the same mechanism is used in class-instance checking. + If we have + instance C (Maybe b) + instance {-# OVERLAPPING #-} C (Maybe Bool) + [W] C (Maybe (F a)) + we want to know that the second instance might match later, when we know more about `a`. + The function `GHC.Core.InstEnv.instEnvMatchesAndUnifiers` uses `tcUnifyTysFG` to + account for type families in the type being matched. + +(ATF2) A very similar check is made in `GHC.Tc.Utils.Unify.mightEqualLater`, which + again uses `tcUnifyTysFG` to account for the possibility of type families. See + Note [What might equal later?] in GHC.Tc.Utils.Unify, esp example (10). + +(ATF3) What about foralls? For example, supppose we are unifying + (forall a. F a) -> (forall a. F a) + against some other type. Those two (F a) types are unrelated, bound by + different foralls; we cannot extend the um_fam_env with a binding [F a :-> blah] + + So to keep things simple, the entire family-substitution machinery is used + only if there are no enclosing foralls (see the `under_forall` check in + `uSatFamApp`). That's fine, because the apartness business is used only for + reducing type-family applications, and class instances, and their arguments + can't have foralls anyway. + + The bottom line is that we won't discover that + (forall a. (a, F Int, F Int)) + is surely apart from + (forall a. (a, Int, Bool)) + but that doesn't matter. Fixing this would be possible, but would require + quite a bit of head-scratching. + +(ATF4) The family substitution only has /saturated/ family applications in + its domain. Consider the following concrete example from #16995: + + type family Param :: Type -> Type -- arity 0 + + type family LookupParam (a :: Type) :: Type where + LookupParam (f Char) = Bool + LookupParam x = Int + + foo :: LookupParam (Param ()) + foo = 42 + + In order for `foo` to typecheck, `LookupParam (Param ())` must reduce to + `Int`. So (f Char) ~ (Param ()) must be SurelyApart. Remember, since + `Param` is a nullary type family, it is over-saturated in (Param ()). + This unification will only be SurelyApart if we decompose the outer AppTy + separately, to then give (() ~ Char). + + Not only does this allow more programs to be accepted, it's also important + for correctness. Not doing this was the root cause of the Core Lint error + in #16995. + +(ATF5) Consider + instance (Generic1 f, Ord (Rep1 f a)) + => Ord (Generically1 f a) where ... + -- The "..." gives rise to [W] Ord (Generically1 f a) + where Rep1 is a type family. + + We must use the instance decl (recursively) to simplify the [W] constraint; + we do /not/ want to worry that the `[G] Ord (Rep1 f a)` might be an + alternative path. So `noMatchableGivenDicts` must return False; + so `mightMatchLater` must return False; so when um_bind_fam_fun returns + `DontBindMe`, the unifier must return `SurelyApart`, not `MaybeApart`. See + `go` in `uVarOrFam` + + This looks a bit sketchy, because they aren't SurelyApart, but see + Note [What might equal later?] in GHC.Tc.Utils.Unify, esp "Red Herring". + + If we are under a forall, we return `MaybeApart`; that seems more conservative, + and class constraints are on tau-types so it doesn't matter. + +(ATF6) When /matching/ can we ever have a type-family application on the LHS, in + the template? You might think not, because type-class-instance and + type-family-instance heads can't include type families. E.g. + instance C (F a) where ... -- Illegal + + But you'd be wrong: even when matching, we can see type families in the LHS template: + * In `checkValidClass`, in `check_dm` we check that the default method has the + right type, using matching, both ways. And that type may have type-family + applications in it. Examples in test CoOpt_Singletons and T26457. + + * In the specialiser: see the call to `tcMatchTy` in + `GHC.Core.Opt.Specialise.beats_or_same` + + * With -fpolymorphic-specialisation, we might get a specialiation rule like + RULE forall a (d :: Eq (Maybe (F a))) . + f @(Maybe (F a)) d = ... + See #25965. + + * A user-written RULE could conceivably have a type-family application + in the template. It might not be a good rule, but I don't think we currently + check for this. + + In all these cases we are only interested in finding a substitution /for + type variables/ that makes the match work. So we simply want to recurse into + the arguments of the type family. E.g. + Template: forall a. Maybe (F a) + Target: Maybe (F Int) + We want to succeed with substitution [a :-> Int]. See (ATF9). + + Conclusion: where we enter via `tcMatchTy`, `tcMatchTys`, `tc_match_tys`, + etc, we always end up in `tc_match_tys_x`. There we invoke the unifier + but we do not distinguish between `SurelyApart` and `MaybeApart`. So in + these cases we can set `um_bind_fam_fun` to `neverBindFam`. + +(ATF7) There is one other, very special case of matching where we /do/ want to + bind type families in `um_fam_env`, namely in GHC.Tc.Solver.Equality, the call + to `tcUnifyTyForInjectivity False` in `improve_injective_wanted_top`. + Consider + of a match. Consider + type family G6 a = r | r -> a + type instance G6 [a] = [G a] + type instance G6 Bool = Int + and suppose we have a Wanted constraint + [W] G6 alpha ~ [Int] + According to Section 5.2 of "Injective type families for Haskell", we /match/ + the RHS each of type instance with [Int]. So we try + Template: [G a] Target: [Int] + and we want to succeed with MaybeApart, so that we can generate the improvement + constraint + [W] alpha ~ [beta] + where beta is fresh. We do this by binding [G a :-> Int] + +(ATF8) The treatment of type families is governed by + um_bind_fam_fun :: BindFamFun + in UMEnv, where + type BindFamFun = TyCon -> [Type] -> Type -> BindFlag + There are some simple BindFamFun functions provided: + alwaysBindFam do the clever stuff above + neverBindFam treat type families as SurelyApart + dontCareBindFam type families shouldn't exist at all + This function only affects the difference between the results MaybeApart and + SurelyApart; it never does not affect whether or not we return Unifiable. + +(ATF9) Decomposition. Consider unifying + F a ~ F Int + when `um_bind_fam_fun` says DontBindMe. There is a unifying substitition [a :-> Int], + and we want to find it, returning Unifiable. Why? + - Remember, this is the Core unifier -- we are not doing type inference + - When we have two equal types, like F a ~ F a, it is ridiculous to say that they + are MaybeApart. Example: the two-way tcMatchTy in `checkValidClass` and #26457. + + (ATF9-1) But consider unifying + F Int ~ F Bool + Although Int and Bool are SurelyApart, we must return MaybeApart for the outer + unification. Hence the use of `don'tBeSoSure` in `go_fam_fam`; it leaves Unifiable + alone, but weakens `SurelyApart` to `MaybeApart`. + + (ATF9-2) We want this decomposition to occur even under a forall (this was #26457). + E.g. (forall a. F Int) -> Int ~ (forall a. F Int) ~ Int + + +(ATF10) Injectivity. Consider (AFT9) where F is known to be injective. Then if we + are unifying + F Int ~ F Bool + we /can/ say SurelyApart. See the inj/noninj stuff in `go_fam_fam`. + +(ATF11) Consider unifying + [F Int, F Int, F Bool] ~ [F Bool, Char, Double] + We find (F Int ~ F Bool), so we can decompose. But we /also/ want to remember + the substitution [F Int :-> F Bool]. Then from (F Int ~ Char) we get the + substitution [F Bool :-> Char]. And that flat-out contradicts (F Bool ~ Double) + so we should get SurelyApart. + + Key point: when decomposing (F tys1 ~ F tys2), we should /also/ extend the + type-family substitution. + + (ATF11-1) All this cleverness only matters when unifying, not when matching + +(ATF12) There is a horrid exception for the injectivity check. See (UR1) in + in Note [Specification of unification]. + +(ATF13) We have to be careful about the occurs check. + See Note [The occurs check in the Core unifier] + +SIDE NOTE. The paper "Closed type families with overlapping equations" +http://research.microsoft.com/en-us/um/people/simonpj/papers/ext-f/axioms-extended.pdf +tries to achieve the same effect with a standard yes/no unifier, by "flattening" +the types (replacing each type-family application with a fresh type variable) +and then unifying. But that does not work well. Consider (#25657) + + type MyEq :: k -> k -> Bool + type family MyEq a b where + MyEq a a = 'True + MyEq _ _ = 'False + + type Var :: forall {k}. Tag -> k + type family Var tag = a | a -> tag + +Then, because Var is injective, we want + MyEq (Var A) (Var B) --> False + MyEq (Var A) (Var A) --> True + +But if we flattten the types (Var A) and (Var B) we'll just get fresh type variables, +and all is lost. But with the current algorithm we have that + a a ~ (Var A) (Var B) +is SurelyApart, so the first equation definitely doesn't match and we can try the +second, which does. END OF SIDE NOTE. + +Note [Shortcomings of the apartness test] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Apartness and type families] is very clever. + +But it still has shortcomings (#26358). Consider unifying + [F a, F Int, Int] ~ [Bool, Char, a] +Working left to right you might think we would build the mapping + F a :-> Bool + F Int :-> Char +Now we discover that `a` unifies with `Int`. So really these two lists are Apart +because F Int can't be both Bool and Char. + +Just the same applies when adding a type-family binding to um_fam_env: + [F (G Float), F Int, G Float] ~ [Bool, Char, Iont] +Again these are Apart, because (G Float = Int), +and (F Int) can't be both Bool and Char + +But achieving this is very tricky! Perhaps whenever we unify a type variable, +or a type family, we should run it over the domain and (maybe range) of the +type-family mapping too? Sigh. + +For now we make no such attempt. +* The um_fam_env has only /un-substituted/ types. +* We look up only /un-substituted/ types in um_fam_env + +This may make us say MaybeApart when we could say SurelyApart, but it has no +effect on the correctness of unification: if we return Unifiable, it really is +Unifiable. + +This is all quite subtle. suppose we have: + um_tv_env: c :-> b + um_fam_env F b :-> a +and we are trying to add a :-> F c. We will call lookupFamEnv on (F, [c]), which will +fail because b and c are not equal. So we go ahead and add a :-> F c as a new tyvar eq, +getting: + um_tv_env: a :-> F c, c :-> b + um_fam_env F b :-> a + +Does that loop, like this: + a --> F c --> F b --> a? +No, because we do not substitute (F c) to (F b) and then look up in um_fam_env; +we look up only un-substituted types. +-} + +{- ********************************************************************* +* * + Binding decisions +* * +********************************************************************* -} + +data BindFlag + = BindMe -- ^ A bindable type variable + + | DontBindMe -- ^ Do not bind this type variable is /apart/ + -- See also Note [Super skolems: binding when looking up instances] + -- in GHC.Core.InstEnv. + deriving Eq + +-- | Some unification functions are parameterised by a 'BindTvFun', which +-- says whether or not to allow a certain unification to take place. +-- A 'BindTvFun' takes the 'TyVar' involved along with the 'Type' it will +-- potentially be bound to. +-- +-- It is possible for the variable to actually be a coercion variable +-- (Note [Matching coercion variables]), but only when one-way matching. +-- In this case, the 'Type' will be a 'CoercionTy'. +type BindTvFun = TyCoVar -> Type -> BindFlag + +-- | BindFamFun is similiar to BindTvFun, but deals with a saturated +-- type-family application. See Note [Apartness and type families]. +type BindFamFun = TyCon -> [Type] -> Type -> BindFlag + +-- | Allow binding only for any variable in the set. Variables may +-- be bound to any type. +-- Used when doing simple matching; e.g. can we find a substitution +-- +-- @ +-- S = [a :-> t1, b :-> t2] such that +-- S( Maybe (a, b->Int ) = Maybe (Bool, Char -> Int) +-- @ +matchBindTv :: TyCoVarSet -> BindTvFun +matchBindTv tvs tv _ty + | tv `elemVarSet` tvs = BindMe + | otherwise = DontBindMe + +-- | Allow the binding of any variable to any type +alwaysBindTv :: BindTvFun +alwaysBindTv _tv _ty = BindMe + +-- | Allow the binding of a type-family application to any type +alwaysBindFam :: BindFamFun +-- See (ATF8) in Note [Apartness and type families] +alwaysBindFam _tc _args _rhs = BindMe + +dontCareBindFam :: HasCallStack => BindFamFun +-- See (ATF8) in Note [Apartness and type families] +dontCareBindFam tc args rhs + = pprPanic "dontCareBindFam" $ + vcat [ ppr tc <+> ppr args, text "rhs" <+> ppr rhs ] + +-- | Don't allow the binding of a type-family application at all +neverBindFam :: BindFamFun +-- See (ATF8) in Note [Apartness and type families] +neverBindFam _tc _args _rhs = DontBindMe + + +{- ********************************************************************* +* * + Various wrappers for matching +* * +********************************************************************* -} + +-- | @tcMatchTy t1 t2@ produces a substitution (over fvs(t1)) +-- @s@ such that @s(t1)@ equals @t2@. +-- The returned substitution might bind coercion variables, +-- if the variable is an argument to a GADT constructor. +-- +-- Precondition: typeKind ty1 `eqType` typeKind ty2 +-- +-- We don't pass in a set of "template variables" to be bound +-- by the match, because tcMatchTy (and similar functions) are +-- always used on top-level types, so we can bind any of the +-- free variables of the LHS. +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTy :: HasDebugCallStack => Type -> Type -> Maybe Subst +tcMatchTy ty1 ty2 = tcMatchTys [ty1] [ty2] + +tcMatchTyX_BM :: HasDebugCallStack + => BindTvFun -> Subst + -> Type -> Type -> Maybe Subst +tcMatchTyX_BM bind_tv subst ty1 ty2 + = tc_match_tys_x bind_tv False subst [ty1] [ty2] + +-- | Like 'tcMatchTy', but allows the kinds of the types to differ, +-- and thus matches them as well. +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTyKi :: HasDebugCallStack => Type -> Type -> Maybe Subst +tcMatchTyKi ty1 ty2 + = tc_match_tys alwaysBindTv True [ty1] [ty2] + +-- | This is similar to 'tcMatchTy', but extends a substitution +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTyX :: HasDebugCallStack + => Subst -- ^ Substitution to extend + -> Type -- ^ Template + -> Type -- ^ Target + -> Maybe Subst +tcMatchTyX subst ty1 ty2 + = tc_match_tys_x alwaysBindTv False subst [ty1] [ty2] + +-- | Like 'tcMatchTy' but over a list of types. +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTys :: HasDebugCallStack + => [Type] -- ^ Template + -> [Type] -- ^ Target + -> Maybe Subst -- ^ One-shot; in principle the template + -- variables could be free in the target + -- See (CU6) in Note [The Core unifier] +tcMatchTys tys1 tys2 + = tc_match_tys alwaysBindTv False tys1 tys2 + +-- | Like 'tcMatchTyKi' but over a list of types. +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTyKis :: HasDebugCallStack + => [Type] -- ^ Template + -> [Type] -- ^ Target + -> Maybe Subst -- ^ One-shot substitution + -- See (CU6) in Note [The Core unifier] +tcMatchTyKis tys1 tys2 + = tc_match_tys alwaysBindTv True tys1 tys2 + +-- | Like 'tcMatchTys', but extending a substitution +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTysX :: HasDebugCallStack + => Subst -- ^ Substitution to extend + -> [Type] -- ^ Template + -> [Type] -- ^ Target + -> Maybe Subst -- ^ One-shot substitution +tcMatchTysX subst tys1 tys2 + = tc_match_tys_x alwaysBindTv False subst tys1 tys2 + +-- | Like 'tcMatchTyKis', but extending a substitution +-- See also Note [tcMatchTy vs tcMatchTyKi] +tcMatchTyKisX :: HasDebugCallStack + => Subst -- ^ Substitution to extend + -> [Type] -- ^ Template + -> [Type] -- ^ Target + -> Maybe Subst -- ^ One-shot substitution +tcMatchTyKisX subst tys1 tys2 + = tc_match_tys_x alwaysBindTv True subst tys1 tys2 + +-- | Same as tc_match_tys_x, but starts with an empty substitution +tc_match_tys :: HasDebugCallStack + => BindTvFun + -> Bool -- ^ match kinds? + -> [Type] + -> [Type] + -> Maybe Subst +tc_match_tys bind_me match_kis tys1 tys2 + = tc_match_tys_x bind_me match_kis (mkEmptySubst in_scope) tys1 tys2 + where + in_scope = mkInScopeSet (tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2) + +-- | Worker for 'tcMatchTysX' and 'tcMatchTyKisX' +tc_match_tys_x :: HasDebugCallStack + => BindTvFun + -> Bool -- ^ match kinds? + -> Subst + -> [Type] + -> [Type] + -> Maybe Subst +tc_match_tys_x bind_tv match_kis (Subst in_scope id_env tv_env cv_env) tys1 tys2 + = case tc_unify_tys neverBindFam -- (ATF7) in Note [Apartness and type families] + bind_tv + False -- Matching, not unifying + False -- Not an injectivity check + match_kis + RespectMultiplicities + (mkRnEnv2 in_scope) tv_env cv_env tys1 tys2 of + Unifiable (tv_env', cv_env') + -> Just $ Subst in_scope id_env tv_env' cv_env' + _ -> Nothing + +-- | This one is called from the expression matcher, +-- which already has a MatchEnv in hand +ruleMatchTyKiX + :: TyCoVarSet -- ^ template variables + -> RnEnv2 + -> TvSubstEnv -- ^ type substitution to extend + -> Type -- ^ Template + -> Type -- ^ Target + -> Maybe TvSubstEnv +ruleMatchTyKiX tmpl_tvs rn_env tenv tmpl target +-- See Note [Kind coercions in Unify] + = case tc_unify_tys neverBindFam (matchBindTv tmpl_tvs) + -- neverBindFam: a type family probably shouldn't appear + -- on the LHS of a RULE, although we don't currently prevent it. + -- But even if it did, (ATF8) in Note [Apartness and type families] + -- says it doesn't matter becuase here we only care about Unifiable. + -- So neverBindFam is efficient, and sufficient. + False -- Matching, not unifying + False -- No doing an injectivity check + True -- Match the kinds + IgnoreMultiplicities + -- See Note [Rewrite rules ignore multiplicities in FunTy] + rn_env tenv emptyCvSubstEnv [tmpl] [target] of + Unifiable (tenv', _) -> Just tenv' + _ -> Nothing + +{- +************************************************************************ +* * + GADTs +* * +************************************************************************ + +Note [Pruning dead case alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider data T a where + T1 :: T Int + T2 :: T a + + newtype X = MkX Int + newtype Y = MkY Char + + type family F a + type instance F Bool = Int + +Now consider case x of { T1 -> e1; T2 -> e2 } + +The question before the house is this: if I know something about the type +of x, can I prune away the T1 alternative? + +Suppose x::T Char. It's impossible to construct a (T Char) using T1, + Answer = YES we can prune the T1 branch (clearly) + +Suppose x::T (F a), where 'a' is in scope. Then 'a' might be instantiated +to 'Bool', in which case x::T Int, so + ANSWER = NO (clearly) + +We see here that we want precisely the apartness check implemented within +tcUnifyTysFG. So that's what we do! Two types cannot match if they are surely +apart. Note that since we are simply dropping dead code, a conservative test +suffices. +-} + +-- | Given a list of pairs of types, are any two members of a pair surely +-- apart, even after arbitrary type function evaluation and substitution? +typesCantMatch :: [(Type,Type)] -> Bool +-- See Note [Pruning dead case alternatives] +typesCantMatch prs = any (uncurry typesAreApart) prs + +typesAreApart :: Type -> Type -> Bool +typesAreApart t1 t2 = case tcUnifyTysFG alwaysBindFam alwaysBindTv [t1] [t2] of + SurelyApart -> True + _ -> False +{- +************************************************************************ +* * + Various wrappers for unification +* * +********************************************************************* -} + +-- | Simple unification of two types; all type variables are bindable +-- Precondition: the kinds are already equal +tcUnifyTy :: Type -> Type -- All tyvars are bindable + -> Maybe Subst + -- A regular one-shot (idempotent) substitution +tcUnifyTy t1 t2 = tcUnifyTys alwaysBindTv [t1] [t2] + +tcUnifyDebugger :: Type -> Type -> Maybe Subst +tcUnifyDebugger t1 t2 + = case tc_unify_tys_fg + True -- Unify kinds + neverBindFam -- Does not affect Unifiable, so pick max efficient + -- See (ATF8) in Note [Apartness and type families] + alwaysBindTv + [t1] [t2] of + Unifiable subst -> Just subst + _ -> Nothing + +-- | Like 'tcUnifyTys' but also unifies the kinds +tcUnifyFunDeps :: TyCoVarSet + -> [Type] -> [Type] + -> Maybe Subst +tcUnifyFunDeps qtvs tys1 tys2 + = case tc_unify_tys_fg + True -- Unify kinds + dontCareBindFam -- Class-instance heads never mention type families + (matchBindTv qtvs) + tys1 tys2 of + Unifiable subst -> Just subst + _ -> Nothing + +-- | Unify or match a type-family RHS with a type (possibly another type-family RHS) +-- Precondition: kinds are the same +tcUnifyTyForInjectivity + :: AmIUnifying -- ^ True <=> do two-way unification; + -- False <=> do one-way matching. + -- See end of sec 5.2 from the paper + -> InScopeSet -- Should include the free tyvars of both Type args + -> Type -> Type -- Types to unify + -> Maybe Subst +-- This algorithm is an implementation of the "Algorithm U" presented in +-- the paper "Injective type families for Haskell", Figures 2 and 3. +-- The code is incorporated with the standard unifier for convenience, but +-- its operation should match the specification in the paper. +tcUnifyTyForInjectivity unif in_scope t1 t2 + = case tc_unify_tys alwaysBindFam alwaysBindTv + unif -- Am I unifying? + True -- Do injectivity checks + False -- Don't check outermost kinds + RespectMultiplicities + rn_env emptyTvSubstEnv emptyCvSubstEnv + [t1] [t2] of + Unifiable (tv_subst, _cv_subst) -> Just $ maybe_fix tv_subst + MaybeApart _reason (tv_subst, _cv_subst) -> Just $ maybe_fix tv_subst + -- We want to *succeed* in questionable cases. + -- This is a pre-unification algorithm. + SurelyApart -> Nothing + where + rn_env = mkRnEnv2 in_scope + + maybe_fix | unif = niFixSubst in_scope + | otherwise = mkTvSubst in_scope -- when matching, don't confuse + -- domain with range + +----------------- +tcUnifyTys :: BindTvFun + -> [Type] -> [Type] + -> Maybe Subst + -- ^ A regular one-shot (idempotent) substitution + -- that unifies the erased types. See comments + -- for 'tcUnifyTysFG' + +-- The two types may have common type variables, and indeed do so in the +-- second call to tcUnifyTys in GHC.Tc.Instance.FunDeps.checkClsFD +tcUnifyTys bind_fn tys1 tys2 + = case tcUnifyTysFG neverBindFam bind_fn tys1 tys2 of + Unifiable result -> Just result + _ -> Nothing + +-- | (tcUnifyTysFG bind_fam bind_tv tys1 tys2) does "fine-grain" unification +-- of tys1 and tys2, under the control of `bind_fam` and `bind_tv`. +-- This version requires that the kinds of the types are the same, +-- if you unify left-to-right. +-- See Note [The Core unifier] +tcUnifyTysFG :: BindFamFun -> BindTvFun + -> [Type] -> [Type] + -> UnifyResult +tcUnifyTysFG bind_fam bind_tv tys1 tys2 + = tc_unify_tys_fg False bind_fam bind_tv tys1 tys2 + +tc_unify_tys_fg :: Bool + -> BindFamFun -> BindTvFun + -> [Type] -> [Type] + -> UnifyResult +tc_unify_tys_fg match_kis bind_fam bind_tv tys1 tys2 + = do { (tv_env, _) <- tc_unify_tys bind_fam bind_tv + True -- Unifying + False -- Not doing an injectivity check + match_kis -- Match outer kinds + RespectMultiplicities rn_env + emptyTvSubstEnv emptyCvSubstEnv + tys1 tys2 + ; return $ niFixSubst in_scope tv_env } + where + in_scope = mkInScopeSet $ tyCoVarsOfTypes tys1 `unionVarSet` tyCoVarsOfTypes tys2 + rn_env = mkRnEnv2 in_scope + +-- | This function is actually the one to call the unifier -- a little +-- too general for outside clients, though. +tc_unify_tys :: BindFamFun -> BindTvFun + -> AmIUnifying -- ^ True <=> unify; False <=> match + -> Bool -- ^ True <=> doing an injectivity check + -> Bool -- ^ True <=> treat the kinds as well + -> MultiplicityFlag -- ^ see Note [Rewrite rules ignore multiplicities in FunTy] in GHC.Core.Unify + -> RnEnv2 + -> TvSubstEnv -- ^ substitution to extend + -> CvSubstEnv + -> [Type] -> [Type] + -> UnifyResultM (TvSubstEnv, CvSubstEnv) +-- NB: It's tempting to ASSERT here that, if we're not matching kinds, then +-- the kinds of the types should be the same. However, this doesn't work, +-- as the types may be a dependent telescope, where later types have kinds +-- that mention variables occurring earlier in the list of types. Here's an +-- example (from typecheck/should_fail/T12709): +-- template: [rep :: RuntimeRep, a :: TYPE rep] +-- target: [LiftedRep :: RuntimeRep, Int :: TYPE LiftedRep] +-- We can see that matching the first pair will make the kinds of the second +-- pair equal. Yet, we still don't need a separate pass to unify the kinds +-- of these types, so it's appropriate to use the Ty variant of unification. +-- See also Note [tcMatchTy vs tcMatchTyKi]. +tc_unify_tys bind_fam bind_tv unif inj_check match_kis match_mults rn_env tv_env cv_env tys1 tys2 + = initUM tv_env cv_env $ + do { when match_kis $ + unify_tys env kis1 kis2 + ; unify_tys env tys1 tys2 } + where + env = UMEnv { um_bind_tv_fun = bind_tv + , um_bind_fam_fun = bind_fam + , um_foralls = emptyVarSet + , um_unif = unif + , um_inj_tf = inj_check + , um_arr_mult = match_mults + , um_rn_env = rn_env } + + kis1 = map typeKind tys1 + kis2 = map typeKind tys2 + + +{- ********************************************************************* +* * + UnifyResult, MaybeApart etc +* * +********************************************************************* -} + +{- Note [Rewrite rules ignore multiplicities in FunTy] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following (higher-order) rule: + +m :: Bool -> Bool -> Bool +{-# RULES "m" forall f. m (f True) = f #-} + +let x = m ((,) @Bool @Bool True True) + +The rewrite rule expects an `f :: Bool -> Bool`, but `(,) @Bool @Bool True :: +Bool %1 -> Bool` is linear (see Note [Data constructors are linear by default] +in GHC.Core.Multiplicity) Should the rule match? Yes! According to the +principles laid out in Note [Linting linearity] in GHC.Core.Lint, optimisation +shouldn't be constrained by linearity. + +However, when matching the template variable `f` to `(,) True`, we do check that +their types unify (see Note [Matching variable types] in GHC.Core.Rules). So +when unifying types for the sake of rule-matching, the unification algorithm +must be able to ignore multiplicities altogether. + +How is this done? + (1) The `um_arr_mult` field of `UMEnv` recordsw when we are doing rule-matching, + and hence want to ignore multiplicities. + (2) The field is set to True in by `ruleMatchTyKiX`. + (3) It is consulted when matching `FunTy` in `unify_ty`. + +Wrinkle in (3). In `unify_tc_app`, in `unify_ty`, `FunTy` is handled as if it +was a regular type constructor. In this case, and when the types being unified +are *function* arrows, but not constraint arrows, then the first argument is a +multiplicity. + +We select this situation by comparing the type constructor with fUNTyCon. In +this case, and this case only, we can safely drop the first argument (using the +tail function) and unify the rest. + +Note [The substitution in MaybeApart] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The constructor MaybeApart carries data with it, typically a TvSubstEnv. Why? +Because consider unifying these: + +(a, a, Int) ~ (b, [b], Bool) + +If we go left-to-right, we start with [a |-> b]. Then, on the middle terms, we +apply the subst we have so far and discover that we need [b |-> [b]]. Because +this fails the occurs check, we say that the types are MaybeApart (see above +Note [Infinitary substitutions]). But, we can't stop there! Because if we +continue, we discover that Int is SurelyApart from Bool, and therefore the +types are apart. This has practical consequences for the ability for closed +type family applications to reduce. See test case +indexed-types/should_compile/Overlap14. +-} + +-- This type does double-duty. It is used in the UM (unifier monad) and to +-- return the final result. See Note [Unification result] +type UnifyResult = UnifyResultM Subst + +-- | See Note [Unification result] +data UnifyResultM a = Unifiable a -- the subst that unifies the types + | MaybeApart MaybeApartReason + a -- the subst has as much as we know + -- it must be part of a most general unifier + -- See Note [The substitution in MaybeApart] + | SurelyApart + deriving Functor + +-- | Why are two types 'MaybeApart'? 'MARInfinite' takes precedence: +-- This is used (only) in Note [Infinitary substitution in lookup] in GHC.Core.InstEnv +-- As of Feb 2022, we never differentiate between MARTypeFamily and MARTypeVsConstraint; +-- it's really only MARInfinite that's interesting here. +data MaybeApartReason + = MARTypeFamily -- ^ matching e.g. F Int ~? Bool + + | MARInfinite -- ^ matching e.g. a ~? Maybe a + + | MARTypeVsConstraint -- ^ matching Type ~? Constraint or the arrow types + -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim + + | MARCast -- ^ Very obscure. + -- See (KCU2) in Note [Kind coercions in Unify] + + +combineMAR :: MaybeApartReason -> MaybeApartReason -> MaybeApartReason +-- See (UR1) in Note [Unification result] for why MARInfinite wins +combineMAR MARInfinite _ = MARInfinite -- MARInfinite wins +combineMAR MARTypeFamily r = r -- Otherwise it doesn't really matter +combineMAR MARTypeVsConstraint r = r +combineMAR MARCast r = r + +instance Outputable MaybeApartReason where + ppr MARTypeFamily = text "MARTypeFamily" + ppr MARInfinite = text "MARInfinite" + ppr MARTypeVsConstraint = text "MARTypeVsConstraint" + ppr MARCast = text "MARCast" + +instance Semigroup MaybeApartReason where + (<>) = combineMAR + +instance Applicative UnifyResultM where + pure = Unifiable + (<*>) = ap + +instance Monad UnifyResultM where + SurelyApart >>= _ = SurelyApart + MaybeApart r1 x >>= f = case f x of + Unifiable y -> MaybeApart r1 y + MaybeApart r2 y -> MaybeApart (r1 S.<> r2) y + SurelyApart -> SurelyApart + Unifiable x >>= f = f x + +instance Outputable a => Outputable (UnifyResultM a) where + ppr SurelyApart = text "SurelyApart" + ppr (Unifiable x) = text "Unifiable" <+> ppr x + ppr (MaybeApart r x) = text "MaybeApart" <+> ppr r <+> ppr x + +{- +************************************************************************ +* * + Non-idempotent substitution +* * +************************************************************************ + +Note [Non-idempotent substitution] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +During unification we use a TvSubstEnv/CvSubstEnv pair that is + (a) non-idempotent + (b) loop-free; ie repeatedly applying it yields a fixed point + +Note [Finding the substitution fixpoint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Finding the fixpoint of a non-idempotent substitution arising from a +unification is much trickier than it looks, because of kinds. Consider + T k (H k (f:k)) ~ T * (g:*) +If we unify, we get the substitution + [ k -> * + , g -> H k (f:k) ] +To make it idempotent we don't want to get just + [ k -> * + , g -> H * (f:k) ] +We also want to substitute inside f's kind, to get + [ k -> * + , g -> H k (f:*) ] +If we don't do this, we may apply the substitution to something, +and get an ill-formed type, i.e. one where typeKind will fail. +This happened, for example, in #9106. + +It gets worse. In #14164 we wanted to take the fixpoint of +this substitution + [ xs_asV :-> F a_aY6 (z_aY7 :: a_aY6) + (rest_aWF :: G a_aY6 (z_aY7 :: a_aY6)) + , a_aY6 :-> a_aXQ ] + +We have to apply the substitution for a_aY6 two levels deep inside +the invocation of F! We don't have a function that recursively +applies substitutions inside the kinds of variable occurrences (and +probably rightly so). + +So, we work as follows: + + 1. Start with the current substitution (which we are + trying to fixpoint + [ xs :-> F a (z :: a) (rest :: G a (z :: a)) + , a :-> b ] + + 2. Take all the free vars of the range of the substitution: + {a, z, rest, b} + NB: the free variable finder closes over + the kinds of variable occurrences + + 3. If none are in the domain of the substitution, stop. + We have found a fixpoint. + + 4. Remove the variables that are bound by the substitution, leaving + {z, rest, b} + + 5. Do a topo-sort to put them in dependency order: + [ b :: *, z :: a, rest :: G a z ] + + 6. Apply the substitution left-to-right to the kinds of these + tyvars, extending it each time with a new binding, so we + finish up with + [ xs :-> ..as before.. + , a :-> b + , b :-> b :: * + , z :-> z :: b + , rest :-> rest :: G b (z :: b) ] + Note that rest now has the right kind + + 7. Apply this extended substitution (once) to the range of + the /original/ substitution. (Note that we do the + extended substitution would go on forever if you tried + to find its fixpoint, because it maps z to z.) + + 8. And go back to step 1 + +In Step 6 we use the free vars from Step 2 as the initial +in-scope set, because all of those variables appear in the +range of the substitution, so they must all be in the in-scope +set. But NB that the type substitution engine does not look up +variables in the in-scope set; it is used only to ensure no +shadowing. +-} + +niFixSubst :: InScopeSet -> TvSubstEnv -> Subst +-- Find the idempotent fixed point of the non-idempotent substitution +-- This is surprisingly tricky: +-- see Note [Finding the substitution fixpoint] +-- ToDo: use laziness instead of iteration? +niFixSubst in_scope tenv + | not_fixpoint = niFixSubst in_scope (mapVarEnv (substTy subst) tenv) + | otherwise = subst + where + range_fvs :: FV + range_fvs = tyCoFVsOfTypes (nonDetEltsUFM tenv) + -- It's OK to use nonDetEltsUFM here because the + -- order of range_fvs, range_tvs is immaterial + + range_tvs :: [TyVar] + range_tvs = fvVarList range_fvs + + not_fixpoint = any in_domain range_tvs + in_domain tv = tv `elemVarEnv` tenv + + free_tvs = scopedSort (filterOut in_domain range_tvs) + + -- See Note [Finding the substitution fixpoint], Step 6 + subst = foldl' add_free_tv + (mkTvSubst in_scope tenv) + free_tvs + + add_free_tv :: Subst -> TyVar -> Subst + add_free_tv subst tv + = extendTvSubst subst tv (mkTyVarTy tv') + where + tv' = updateTyVarKind (substTy subst) tv + +{- +************************************************************************ +* * + unify_ty: the main workhorse +* * +************************************************************************ + +Note [Specification of unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The pure unifier, unify_ty, defined in this module, tries to work out +a substitution to make two types say True to eqType. NB: eqType is +itself not purely syntactic; it accounts for CastTys; +see Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep + +Unlike the "impure unifiers" in the typechecker (the eager unifier in +GHC.Tc.Utils.Unify, and the constraint solver itself in GHC.Tc.Solver.Equality), +the pure unifier does /not/ work up to ~. + +The algorithm implemented here is rather delicate, and we depend on it +to uphold certain properties. This is a summary of these required +properties. + +Notation: + θ,φ substitutions + ξ type-function-free types + τ,σ other types + τ♭ type τ, flattened + + ≡ eqType + +(U1) Soundness. + If (unify τ₁ τ₂) = Unifiable θ, then θ(τ₁) ≡ θ(τ₂). + θ is a most general unifier for τ₁ and τ₂. + +(U2) Completeness. + If (unify ξ₁ ξ₂) = SurelyApart, + then there exists no substitution θ such that θ(ξ₁) ≡ θ(ξ₂). + +These two properties are stated as Property 11 in the "Closed Type Families" +paper (POPL'14). Below, this paper is called [CTF]. + +(U3) Apartness under substitution. + If (unify ξ τ♭) = SurelyApart, then (unify ξ θ(τ)♭) = SurelyApart, + for any θ. (Property 12 from [CTF]) + +(U4) Apart types do not unify. + If (unify ξ τ♭) = SurelyApart, then there exists no θ + such that θ(ξ) = θ(τ). (Property 13 from [CTF]) + +THEOREM. Completeness w.r.t ~ + If (unify τ₁♭ τ₂♭) = SurelyApart, + then there exists no proof that (τ₁ ~ τ₂). + +PROOF. See appendix of [CTF]. + + +The unification algorithm is used for type family injectivity, as described +in the "Injective Type Families" paper (Haskell'15), called [ITF]. When run +in this mode, it has the following properties. + +(I1) If (unify σ τ) = SurelyApart, then σ and τ are not unifiable, even + after arbitrary type family reductions. + +(I2) If (unify σ τ) = MaybeApart θ, and if some + φ exists such that φ(σ) ~ φ(τ), then φ extends θ. + + +Furthermore, the RULES matching algorithm requires this property, +but only when using this algorithm for matching: + +(M1) If (match σ τ) succeeds with θ, then all matchable tyvars + in σ are bound in θ. + + Property M1 means that we must extend the substitution with, + say (a ↦ a) when appropriate during matching. + See also Note [Self-substitution when unifying or matching]. + +(M2) Completeness of matching. + If θ(σ) = τ, then (match σ τ) = Unifiable φ, + where θ is an extension of φ. + +Wrinkle (SI1): um_inj_tf: + Sadly, property M2 and I2 conflict. Consider + + type family F1 a b where + F1 Int Bool = Char + F1 Double String = Char + + Consider now two matching problems: + + P1. match (F1 a Bool) (F1 Int Bool) + P2. match (F1 a Bool) (F1 Double String) + + In case P1, we must find (a ↦ Int) to satisfy M2. In case P2, we must /not/ + find (a ↦ Double), in order to satisfy I2. (Note that the correct mapping for + I2 is (a ↦ Int). There is no way to discover this, but we mustn't map a to + anything else!) + + We thus must parameterize the algorithm over whether it's being used + for an injectivity check (refrain from looking at non-injective arguments + to type families) or not (do indeed look at those arguments). This is + implemented by the um_inj_tf field of UMEnv. + + (It's all a question of whether or not to include equation (7) from Fig. 2 + of [ITF].) + + This extra parameter is a bit fiddly, perhaps, but seemingly less so than + having two separate, almost-identical algorithms. + +Note [Self-substitution when unifying or matching] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +What happens when we are unifying or matching two identical type variables? + a ~ a + +* When /unifying/, just succeed, without binding [a :-> a] in the substitution, + else we'd get an infinite substitution. We need to make this check before + we do the occurs check, of course. + +* When /matching/, and `a` is a bindable variable from the template, we /do/ + want to extend the substitution. Remember, a successful match should map all + the template variables (except ones that disappear when expanding synonyms), + + But when `a` is /not/ a bindable variable (perhaps it is a globally-in-scope + skolem) we want to treat it like a constant `Int ~ Int` and succeed. + + Notice: no occurs check! It's fine to match (a ~ Maybe a), because the + template vars of the template come from a different name space to the free + vars of the target. + + Note that this arrangement was provoked by a real failure, where the same + unique ended up in the template as in the target. (It was a rule firing when + compiling Data.List.NonEmpty.) + +* What about matching a /non-bindable/ variable? For example: + template-vars : {a} + matching problem: (forall b. b -> a) ~ (forall c. c -> Int) + We want to emerge with the substitution [a :-> Int] + But on the way we will encounter (b ~ b), when we match the bits before the + arrow under the forall, having renamed `c` to `b`. This match should just + succeed, just like (Int ~ Int), without extending the substitution. + + It's important to do this for /non-bindable/ variables, not just for + forall-bound ones. In an associated type + instance C (Maybe a) where { type F (Maybe a) = Int } + `checkConsistentFamInst` matches (Maybe a) from the header against (Maybe a) + from the type-family instance, with `a` marked as non-bindable. + + +Note [Matching coercion variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this: + + type family F a + + data G a where + MkG :: F a ~ Bool => G a + + type family Foo (x :: G a) :: F a + type instance Foo MkG = False + +We would like that to be accepted. For that to work, we need to introduce +a coercion variable on the left and then use it on the right. Accordingly, +at use sites of Foo, we need to be able to use matching to figure out the +value for the coercion. (See the desugared version: + + axFoo :: [a :: *, c :: F a ~ Bool]. Foo (MkG c) = False |> (sym c) + +) We never want this action to happen during *unification* though, when +all bets are off. + +Note [Kind coercions in Unify] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We wish to match/unify while ignoring casts. But, we can't just ignore +them completely, or we'll end up with ill-kinded substitutions. For example, +say we're matching `a` with `ty |> co`. If we just drop the cast, we'll +return [a |-> ty], but `a` and `ty` might have different kinds. We can't +just match/unify their kinds, either, because this might gratuitously +fail. After all, `co` is the witness that the kinds are the same -- they +may look nothing alike. + +So, we pass a kind coercion `kco` to the main `unify_ty`. This coercion witnesses +the equality between the substed kind of the left-hand type and the substed +kind of the right-hand type. Note that we do not unify kinds at the leaves +(as we did previously). + +Hence: (UKINV) Unification Kind Invariant +* In the call + unify_ty ty1 ty2 kco + it must be that + subst(kco) :: subst(kind(ty1)) ~N subst(kind(ty2)) + where `subst` is the ambient substitution in the UM monad +* In the call + unify_tys tys1 tys2 + (which has no kco), after we unify any prefix of tys1,tys2, the kinds of the + head of the remaining tys1,tys2 are identical after substitution. This + implies, for example, that the kinds of the head of tys1,tys2 are identical + after substitution. + +Preserving (UKINV) takes a bit of work, governed by the `match_kis` flag in +`tc_unify_tys`: + +* When we're working with type applications (either TyConApp or AppTy) we + need to worry about establishing (UKINV), as the kinds of the function + & arguments aren't (necessarily) included in the kind of the result. + When unifying two TyConApps, this is easy, because the two TyCons are + the same. Their kinds are thus the same. As long as we unify left-to-right, + we'll be sure to unify types' kinds before the types themselves. (For example, + think about Proxy :: forall k. k -> *. Unifying the first args matches up + the kinds of the second args.) + +* For AppTy, we must unify the kinds of the functions, but once these are + unified, we can continue unifying arguments without worrying further about + kinds. + +* The interface to this module includes both "...Ty" functions and + "...TyKi" functions. The former assume that (UKINV) is already + established, either because the kinds are the same or because the + list of types being passed in are the well-typed arguments to some + type constructor (see two paragraphs above). The latter take a separate + pre-pass over the kinds to establish (UKINV). Sometimes, it's important + not to take the second pass, as it caused #12442. + +Wrinkles + +(KCU1) We ensure that the `kco` argument never mentions variables in the + domain of either RnEnvL or RnEnvR. Why? + + * `kco` is used only to build the final well-kinded substitution + a :-> ty |> kco + The range of the substitution never mentions forall-bound variables, + so `kco` cannot either. + + * `kco` mixes up types from both left and right arguments of + `unify_ty`, which have different renamings in the RnEnv2. + + The easiest thing is to insist that `kco` does not need renaming with + the RnEnv2; it mentions no forall-bound variables. + + To achieve this we do a `mentionsForAllBoundTyVars` test in the + `CastTy` cases of `unify_ty`. + +(KCU2) Suppose we are unifying + (forall a. x |> (...F a b...) ~ (forall a. y) + We can't bind y :-> x |> (...F a b...), becuase of that free `a`. + + But if we later learn that b=Int, and F a Int = Bool, + that free `a` might disappear, so we could unify with + y :-> x |> (...Bool...) + + Conclusion: if there is a free forall-bound variable in a cast, + return MaybeApart, with a MaybeApartReason of MARCast. + +(KCU3) We thought, at one point, that this was all unnecessary: why should + casts be in types in the first place? But they are sometimes. In + dependent/should_compile/KindEqualities2, we see, for example the + constraint Num (Int |> (blah ; sym blah)). We naturally want to find + a dictionary for that constraint, which requires dealing with + coercions in this manner. + +Note [Matching in the presence of casts (1)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When matching, it is crucial that no variables from the template +end up in the range of the matching substitution (obviously!). +When unifying, that's not a constraint; instead we take the fixpoint +of the substitution at the end. + +So what should we do with this, when matching? + unify_ty (tmpl |> co) tgt kco + +Previously, wrongly, we pushed 'co' in the (horrid) accumulating +'kco' argument like this: + unify_ty (tmpl |> co) tgt kco + = unify_ty tmpl tgt (kco ; co) + +But that is obviously wrong because 'co' (from the template) ends +up in 'kco', which in turn ends up in the range of the substitution. + +This all came up in #13910. Because we match tycon arguments +left-to-right, the ambient substitution will already have a matching +substitution for any kinds; so there is an easy fix: just apply +the substitution-so-far to the coercion from the LHS. + +Note that + +* When matching, the first arg of unify_ty is always the template; + we never swap round. + +* The above argument is distressingly indirect. We seek a + better way. + +* One better way is to ensure that type patterns (the template + in the matching process) have no casts. See #14119. + +Note [Matching in the presence of casts (2)] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There is another wrinkle (#17395). Suppose (T :: forall k. k -> Type) +and we are matching + tcMatchTy (T k (a::k)) (T j (b::j)) + +Then we'll match k :-> j, as expected. But then in unify_tys +we invoke + unify_tys env (a::k) (b::j) (Refl j) + +Although we have unified k and j, it's very important that we put +(Refl j), /not/ (Refl k) as the fourth argument to unify_tys. +If we put (Refl k) we'd end up with the substitution + a :-> b |> Refl k +which is bogus because one of the template variables, k, +appears in the range of the substitution. Eek. + +Similar care is needed in unify_ty_app. + + +Note [Polykinded tycon applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose T :: forall k. Type -> K +and we are unifying + ty1: T @Type Int :: Type + ty2: T @(Type->Type) Int Int :: Type + +These two TyConApps have the same TyCon at the front but they +(legitimately) have different numbers of arguments. They +are surelyApart, so we can report that without looking any +further (see #15704). + +Note [Unifying type applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unifying type applications is quite subtle, as we found +in #23134 and #22647, when type families are involved. + +Suppose + type family F a :: Type -> Type + type family G k :: k = r | r -> k + +and consider these examples: + +* F Int ~ F Char, where F is injective + Since F is injective, we can reduce this to Int ~ Char, + therefore SurelyApart. + +* F Int ~ F Char, where F is not injective + Without injectivity, return MaybeApart. + +* G Type ~ G (Type -> Type) Int + Even though G is injective and the arguments to G are different, + we cannot deduce apartness because the RHS is oversaturated. + For example, G might be defined as + G Type = Maybe Int + G (Type -> Type) = Maybe + So we return MaybeApart. + +* F Int Bool ~ F Int Char -- SurelyApart (since Bool is apart from Char) + F Int Bool ~ Maybe a -- MaybeApart + F Int Bool ~ a b -- MaybeApart + F Int Bool ~ Char -> Bool -- MaybeApart + An oversaturated type family can match an application, + whether it's a TyConApp, AppTy or FunTy. Decompose. + +* F Int ~ a b + We cannot decompose a saturated, or under-saturated + type family application. We return MaybeApart. + +To handle all those conditions, unify_ty goes through +the following checks in sequence, where Fn is a type family +of arity n: + +* (C1) Fn x_1 ... x_n ~ Fn y_1 .. y_n + A saturated application. + Here we can unify arguments in which Fn is injective. +* (C2) Fn x_1 ... x_n ~ anything, anything ~ Fn x_1 ... x_n + A saturated type family can match anything - we return MaybeApart. +* (C3) Fn x_1 ... x_m ~ a b, a b ~ Fn x_1 ... x_m where m > n + An oversaturated type family can be decomposed. +* (C4) Fn x_1 ... x_m ~ anything, anything ~ Fn x_1 ... x_m, where m > n + If we couldn't decompose in the previous step, we return SurelyApart. + +Afterwards, the rest of the code doesn't have to worry about type families. + +Note [Unifying type synonyms] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the task of unifying two 'Type's of the form + + TyConApp tc [] ~ TyConApp tc [] + +where `tc` is a type synonym. A naive way to perform this comparison these +would first expand the synonym and then compare the resulting expansions. + +However, this is obviously wasteful and the RHS of `tc` may be large; it is +much better to rather compare the TyCons directly. Consequently, before +expanding type synonyms in type comparisons we first look for a nullary +TyConApp and simply compare the TyCons if we find one. + +Of course, if we find that the TyCons are *not* equal then we still need to +perform the expansion as their RHSs may still be unifiable. E.g + type T = S (a->a) + type S a = [a] +and consider + T Int ~ S (Int -> Int) + +We can't decompose non-nullary synonyms. E.g. + type R a = F a -- Where F is a type family +and consider + R (a->a) ~ R Int +We can't conclude that (a->) ~ Int. (There is a currently-missed opportunity +here; if we knew that R was /injective/, perhaps we could decompose.) + +We perform the nullary-type-synonym optimisation in a number of places: + + * GHC.Core.Unify.unify_ty + * GHC.Tc.Solver.Equality.can_eq_nc' + * GHC.Tc.Utils.Unify.uType + +This optimisation is especially helpful for the ubiquitous GHC.Types.Type, +since GHC prefers to use the type synonym over @TYPE 'LiftedRep@ applications +whenever possible. See Note [Using synonyms to compress types] in +GHC.Core.Type for details. + +c.f. Note [Comparing type synonyms] in GHC.Core.TyCo.Compare +-} + +-------------- unify_ty: the main workhorse ----------- + +type AmIUnifying = Bool -- True <=> Unifying + -- False <=> Matching + +type InType = Type -- Before applying the RnEnv2 +type OutCoercion = Coercion -- After applying the RnEnv2 + + +unify_ty :: UMEnv + -> InType -> InType -- Types to be unified + -> OutCoercion -- A nominal coercion between their kinds + -- OutCoercion: the RnEnv has already been applied + -- When matching, the coercion is in "target space", + -- not "template space" + -- See Note [Kind coercions in Unify] + -> UM () +-- Precondition: see (Unification Kind Invariant) +-- +-- See Note [Specification of unification] +-- Respects newtypes, PredTypes +-- See Note [Computing equality on types] in GHC.Core.Type +unify_ty _env (TyConApp tc1 []) (TyConApp tc2 []) _kco + -- See Note [Unifying type synonyms] + | tc1 == tc2 + = return () + +unify_ty env ty1 ty2 kco + -- Now handle the cases we can "look through": synonyms and casts. + | Just ty1' <- coreView ty1 = unify_ty env ty1' ty2 kco + | Just ty2' <- coreView ty2 = unify_ty env ty1 ty2' kco + +unify_ty env (CastTy ty1 co1) ty2 kco + | mentionsForAllBoundTyVarsL env (tyCoVarsOfCo co1) + -- See (KCU1) in Note [Kind coercions in Unify] + = maybeApart MARCast -- See (KCU2) + + | um_unif env + = unify_ty env ty1 ty2 (co1 `mkTransCo` kco) + + | otherwise -- We are matching, not unifying + = do { subst <- getSubst env + ; let co' = substCo subst co1 + -- We match left-to-right, so the free template vars of the + -- coercion should already have been matched. + -- See Note [Matching in the presence of casts (1)] + -- NB: co1 does not mention forall-bound vars, so no need to rename + ; unify_ty env ty1 ty2 (co' `mkTransCo` kco) } + +unify_ty env ty1 (CastTy ty2 co2) kco + | mentionsForAllBoundTyVarsR env (tyCoVarsOfCo co2) + -- See (KCU1) in Note [Kind coercions in Unify] + = maybeApart MARCast -- See (KCU2) + | otherwise + = unify_ty env ty1 ty2 (kco `mkTransCo` mkSymCo co2) + -- NB: co2 does not mention forall-bound variables + +-- Applications need a bit of care! +-- They can match FunTy and TyConApp, so use splitAppTy_maybe +unify_ty env (AppTy ty1a ty1b) ty2 _kco + | Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + = unify_ty_app env ty1a [ty1b] ty2a [ty2b] + +unify_ty env ty1 (AppTy ty2a ty2b) _kco + | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + = unify_ty_app env ty1a [ty1b] ty2a [ty2b] + +unify_ty _ (LitTy x) (LitTy y) _kco | x == y = return () + +unify_ty env (ForAllTy (Bndr tv1 _) ty1) (ForAllTy (Bndr tv2 _) ty2) kco + -- ToDo: See Note [Unifying coercion-foralls] + = do { unify_ty env (varType tv1) (varType tv2) (mkNomReflCo liftedTypeKind) + ; let env' = umRnBndr2 env tv1 tv2 + ; unify_ty env' ty1 ty2 kco } + +-- See Note [Matching coercion variables] +unify_ty env (CoercionTy co1) (CoercionTy co2) kco + = do { c_subst <- getCvSubstEnv + ; case co1 of + CoVarCo cv + | not (um_unif env) + , not (cv `elemVarEnv` c_subst) -- Not forall-bound + , let (_mult_co, co_l, co_r) = decomposeFunCo kco + -- Because the coercion is used in a type, it should be safe to + -- ignore the multiplicity coercion, _mult_co + -- cv :: t1 ~ t2 + -- co2 :: s1 ~ s2 + -- co_l :: t1 ~ s1 + -- co_r :: t2 ~ s2 + rhs_co = co_l `mkTransCo` co2 `mkTransCo` mkSymCo co_r + , BindMe <- um_bind_tv_fun env cv (CoercionTy rhs_co) + -> if mentionsForAllBoundTyVarsR env (tyCoVarsOfCo co2) + then surelyApart + else extendCvEnv cv rhs_co + + _ -> return () } + +unify_ty env (TyVarTy tv1) ty2 kco + = uVarOrFam env (TyVarLHS tv1) ty2 kco + +unify_ty env ty1 (TyVarTy tv2) kco + | um_unif env -- If unifying, can swap args; but not when matching + = uVarOrFam (umSwapRn env) (TyVarLHS tv2) ty1 (mkSymCo kco) + +-- Deal with TyConApps +unify_ty env ty1 ty2 kco + -- Handle non-oversaturated type families first + -- See Note [Unifying type applications] + | Just (tc,tys) <- mb_sat_fam_app1 + = uVarOrFam env (TyFamLHS tc tys) ty2 kco + + | um_unif env + , Just (tc,tys) <- mb_sat_fam_app2 + = uVarOrFam (umSwapRn env) (TyFamLHS tc tys) ty1 (mkSymCo kco) + + -- Handle oversaturated type families. Suppose we have + -- (F a b) ~ (c d) where F has arity 1 + -- We definitely want to decompose that type application! (#22647) + -- + -- If there is no application, an oversaturated type family can only + -- match a type variable or a saturated type family, + -- both of which we handled earlier. So we can say surelyApart. + | Just (tc1, _) <- mb_tc_app1 + , isTypeFamilyTyCon tc1 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + | Just (tc2, _) <- mb_tc_app2 + , isTypeFamilyTyCon tc2 + = if | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1 + , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2 + -> unify_ty_app env ty1a [ty1b] ty2a [ty2b] -- (C3) + | otherwise -> surelyApart -- (C4) + + -- At this point, neither tc1 nor tc2 can be a type family. + | Just (tc1, tys1) <- mb_tc_app1 + , Just (tc2, tys2) <- mb_tc_app2 + , tc1 == tc2 + = do { massertPpr (isInjectiveTyCon tc1 Nominal) (ppr tc1) + ; unify_tc_app env tc1 tys1 tys2 + } + + -- TYPE and CONSTRAINT are not Apart + -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim + -- NB: at this point we know that the two TyCons do not match + | Just (tc1,_) <- mb_tc_app1, let u1 = tyConUnique tc1 + , Just (tc2,_) <- mb_tc_app2, let u2 = tyConUnique tc2 + , (u1 == tYPETyConKey && u2 == cONSTRAINTTyConKey) || + (u2 == tYPETyConKey && u1 == cONSTRAINTTyConKey) + = maybeApart MARTypeVsConstraint + -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim + -- Note [Type and Constraint are not apart] + + -- The arrow types are not Apart + -- See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim + -- wrinkle (W2) + -- NB1: at this point we know that the two TyCons do not match + -- NB2: In the common FunTy/FunTy case you might wonder if we want to go via + -- splitTyConApp_maybe. But yes we do: we need to look at those implied + -- kind argument in order to satisfy (Unification Kind Invariant) + | FunTy {} <- ty1 + , FunTy {} <- ty2 + = maybeApart MARTypeVsConstraint + -- We don't bother to look inside; wrinkle (W3) in GHC.Builtin.Types.Prim + -- Note [Type and Constraint are not apart] + + where + mb_tc_app1 = splitTyConApp_maybe ty1 + mb_tc_app2 = splitTyConApp_maybe ty2 + mb_sat_fam_app1 = isSatTyFamApp ty1 + mb_sat_fam_app2 = isSatTyFamApp ty2 + +unify_ty _ _ _ _ = surelyApart + +----------------------------- +unify_tc_app :: UMEnv -> TyCon -> [Type] -> [Type] -> UM () +-- Mainly just unifies the argument types; +-- but with a special case for fUNTyCon +unify_tc_app env tc tys1 tys2 + | tc == fUNTyCon + , IgnoreMultiplicities <- um_arr_mult env + , (_mult1 : no_mult_tys1) <- tys1 + , (_mult2 : no_mult_tys2) <- tys2 + = -- We're comparing function arrow types here (not constraint arrow + -- types!), and they have at least one argument, which is the arrow's + -- multiplicity annotation. The flag `um_arr_mult` instructs us to + -- ignore multiplicities in this very case. This is a little tricky: see + -- point (3) in Note [Rewrite rules ignore multiplicities in FunTy]. + unify_tys env no_mult_tys1 no_mult_tys2 + + | otherwise + = unify_tys env tys1 tys2 + +----------------------------- +unify_ty_app :: UMEnv -> Type -> [Type] -> Type -> [Type] -> UM () +-- Deal with (t1 t1args) ~ (t2 t2args) +-- where length t1args = length t2args +unify_ty_app env ty1 ty1args ty2 ty2args + | Just (ty1', ty1a) <- splitAppTyNoView_maybe ty1 + , Just (ty2', ty2a) <- splitAppTyNoView_maybe ty2 + = unify_ty_app env ty1' (ty1a : ty1args) ty2' (ty2a : ty2args) + + | otherwise + = do { let ki1 = typeKind ty1 + ki2 = typeKind ty2 + -- See Note [Kind coercions in Unify] + ; unify_ty env ki1 ki2 (mkNomReflCo liftedTypeKind) + ; unify_ty env ty1 ty2 (mkNomReflCo ki2) + -- Very important: 'ki2' not 'ki1' + -- See Note [Matching in the presence of casts (2)] + ; unify_tys env ty1args ty2args } + +----------------------------- +unify_tys :: UMEnv -> [Type] -> [Type] -> UM () +-- Precondition: see (Unification Kind Invariant) +unify_tys env orig_xs orig_ys + = go orig_xs orig_ys + where + go [] [] = return () + go (x:xs) (y:ys) + -- See Note [Kind coercions in Unify] + = do { unify_ty env x y (mkNomReflCo $ typeKind y) + -- Very important: 'y' not 'x' + -- See Note [Matching in the presence of casts (2)] + ; go xs ys } + go _ _ = surelyApart + -- Possibly different saturations of a polykinded tycon + -- See Note [Polykinded tycon applications] + +--------------------------------- +uVarOrFam :: UMEnv -> CanEqLHS -> InType -> OutCoercion -> UM () +-- Invariants: (a) If ty1 is a TyFamLHS, then ty2 is NOT a TyVarTy +-- (b) both args have had coreView already applied +-- Why saturated? See (ATF4) in Note [Apartness and type families] +uVarOrFam env ty1 ty2 kco + = do { substs <- getSubstEnvs +-- ; pprTrace "uVarOrFam" (vcat +-- [ text "ty1" <+> ppr ty1 +-- , text "ty2" <+> ppr ty2 +-- , text "tv_env" <+> ppr (um_tv_env substs) +-- , text "fam_env" <+> ppr (um_fam_env substs) ]) $ + ; go NotSwapped substs ty1 ty2 kco } + where + foralld_tvs = um_foralls env + under_forall = not (isEmptyVarSet foralld_tvs) + + -- `go` takes two bites at the cherry; if the first one fails + -- it swaps the arguments and tries again; and then it fails. + -- The SwapFlag argument tells `go` whether it is on the first + -- bite (NotSwapped) or the second (IsSwapped). + -- E.g. a ~ F p q + -- Starts with: go a (F p q) + -- if `a` not bindable, swap to: go (F p q) a + + ----------------------------- + -- LHS is a type variable + -- The sequence of tests is very similar to go_tv + go :: SwapFlag -> UMState -> CanEqLHS -> InType -> OutCoercion -> UM () + go swapped substs lhs@(TyVarLHS tv1) ty2 kco + | Just ty1' <- lookupVarEnv (um_tv_env substs) tv1' + = -- We already have a substitution for tv1 + if | um_unif env -> unify_ty env ty1' ty2 kco + | (ty1' `mkCastTy` kco) `tcEqType` ty2 -> return () + | otherwise -> surelyApart + -- Unifying: recurse into unify_ty + -- Matching: we /don't/ want to just recurse here, because the range of + -- the subst is the target type, not the template type. So, just check + -- for normal type equality. + -- NB: it's important to use `tcEqType` instead of `eqType` here, + -- otherwise we might not reject a substitution + -- which unifies `Type` with `Constraint`, e.g. + -- a call to tc_unify_tys with arguments + -- + -- tys1 = [k,k] + -- tys2 = [Type, Constraint] + -- + -- See test cases: T11715b, T20521. + + -- If we are matching or unifying a ~ a, take care + -- See Note [Self-substitution when unifying or matching] + | TyVarTy tv2 <- ty2 + , let tv2' = umRnOccR env tv2 + , tv1' == tv2' + = if | um_unif env -> return () + | tv1_is_bindable -> extendTvEnv tv1' ty2 + | otherwise -> return () + + | tv1_is_bindable + , not (mentionsForAllBoundTyVarsR env ty2_fvs) + -- ty2_fvs: kco does not mention forall-bound vars + , not occurs_check + = -- No occurs check, nor skolem-escape; just bind the tv + -- We don't need to rename `rhs` because it mentions no forall-bound vars + extendTvEnv tv1' rhs -- Bind tv1:=rhs and continue + + -- When unifying, try swapping: + -- e.g. a ~ F p q with `a` not bindable: we might succeed with go_fam + -- e.g. a ~ beta with `a` not bindable: we might be able to bind `beta` + -- e.g. beta ~ F beta Int occurs check; but MaybeApart after swapping + | um_unif env + , NotSwapped <- swapped -- If we have swapped already, don't do so again + , Just lhs2 <- canEqLHS_maybe ty2 + = go IsSwapped substs lhs2 (mkTyVarTy tv1) (mkSymCo kco) + + | occurs_check = maybeApart MARInfinite -- Occurs check + | otherwise = surelyApart + + where + tv1' = umRnOccL env tv1 + ty2_fvs = tyCoVarsOfType ty2 + rhs = ty2 `mkCastTy` mkSymCo kco + tv1_is_bindable | not (tv1' `elemVarSet` foralld_tvs) + -- tv1' is not forall-bound, but tv1 can still differ + -- from tv1; see Note [Cloning the template binders] + -- in GHC.Core.Rules. So give tv1' to um_bind_tv_fun. + , BindMe <- um_bind_tv_fun env tv1' rhs + = True + | otherwise + = False + + occurs_check = um_unif env && uOccursCheck substs foralld_tvs lhs rhs + -- Occurs check, only when unifying + -- see Note [Infinitary substitutions] + -- Make sure you include `kco` in rhs #14846 + + ----------------------------- + -- LHS is a saturated type-family application + -- Invariant: ty2 is not a TyVarTy + go swapped substs lhs@(TyFamLHS tc1 tys1) ty2 kco + -- Check if we have an existing substitution for the LHS; if so, recurse + -- But not under a forall; see (ATF3) in Note [Apartness and type families] + -- Hence the RnEnv2 is empty + | not under_forall + , Just ty1' <- lookupFamEnv (um_fam_env substs) tc1 tys1 + = if | um_unif env -> unify_ty env ty1' ty2 kco + -- Below here we are matching + -- The return () case deals with: + -- Template: (F a)..(F a) + -- Target: (F b)..(F b) + -- This should match! With [a :-> b] + | (ty1' `mkCastTy` kco) `tcEqType` ty2 -> return () + | otherwise -> maybeApart MARTypeFamily + + -- Check for equality F tys1 ~ F tys2 + -- Very important that this can happen under a forall, so that we + -- successfully match (forall a. F a) ~ (forall b. F b) See (ATF9-2) + | Just (tc2, tys2) <- isSatTyFamApp ty2 + , tc1 == tc2 + = go_fam_fam substs tc1 tys1 tys2 kco + + -- If we are under a forall, just give up + -- see (ATF3) and (ATF5) in Note [Apartness and type families] + | under_forall + = maybeApart MARTypeFamily + + -- Now check if we can bind the (F tys) to the RHS + -- Again, not under a forall; see (ATF3) + -- This can happen even when matching: see (ATF7) + | BindMe <- um_bind_fam_fun env tc1 tys1 rhs + = if uOccursCheck substs emptyVarSet lhs rhs + then maybeApart MARInfinite + else do { extendFamEnv tc1 tys1 rhs + -- We don't substitute tys1 before extending + -- See Note [Shortcomings of the apartness test] + ; maybeApart MARTypeFamily } + + -- Swap in case of (F a b) ~ (G c d e) + -- Maybe um_bind_fam_fun is False of (F a b) but true of (G c d e) + -- NB: a type family can appear on the template when matching + -- see (ATF6) in Note [Apartness and type families] + -- (Only worth doing this if we are not under a forall.) + | um_unif env + , NotSwapped <- swapped + , Just lhs2 <- canEqLHS_maybe ty2 + = go IsSwapped substs lhs2 (mkTyConApp tc1 tys1) (mkSymCo kco) + + | otherwise -- See (ATF5) in Note [Apartness and type families] + = surelyApart + + where + rhs = ty2 `mkCastTy` mkSymCo kco + + ----------------------------- + -- go_fam_fam: LHS and RHS are both saturated type-family applications, + -- for the same type-family F + go_fam_fam substs tc tys1 tys2 kco + -- Decompose (F tys1 ~ F tys2): (ATF9) + -- Use injectivity information of F: (ATF10) + -- But first bind the type-fam if poss: (ATF11) + = do { bind_fam_if_poss -- (ATF11) + ; unify_tys env inj_tys1 inj_tys2 -- (ATF10) + ; unless (um_inj_tf env) $ -- (ATF12) + don'tBeSoSure MARTypeFamily $ -- (ATF9-1) + unify_tys env noninj_tys1 noninj_tys2 } + where + inj = case tyConInjectivityInfo tc of + NotInjective -> repeat False + Injective bs -> bs + + (inj_tys1, noninj_tys1) = partitionByList inj tys1 + (inj_tys2, noninj_tys2) = partitionByList inj tys2 + + bind_fam_if_poss + | not (um_unif env) -- Not when matching (ATF11-1) + = return () + | under_forall -- Not under a forall (ATF3) + = return () + | BindMe <- um_bind_fam_fun env tc tys1 rhs1 + = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys1) rhs1) $ + extendFamEnv tc tys1 rhs1 + -- At this point um_unif=True, so we can unify either way + | BindMe <- um_bind_fam_fun env tc tys2 rhs2 + = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys2) rhs2) $ + extendFamEnv tc tys2 rhs2 + | otherwise + = return () + + rhs1 = mkTyConApp tc tys2 `mkCastTy` mkSymCo kco + rhs2 = mkTyConApp tc tys1 `mkCastTy` kco + + +uOccursCheck :: UMState + -> TyVarSet -- Bound by enclosing foralls; see (OCU1) + -> CanEqLHS -> Type -- Can we unify (lhs := ty)? + -> Bool +-- See Note [The occurs check in the Core unifier] and (ATF13) +uOccursCheck (UMState { um_tv_env = tv_env, um_fam_env = fam_env }) bvs lhs ty + = go bvs ty + where + go :: TyCoVarSet -- Bound by enclosing foralls; see (OCU1) + -> Type -> Bool + go bvs ty | Just ty' <- coreView ty = go bvs ty' + go bvs (TyVarTy tv) | Just ty' <- lookupVarEnv tv_env tv + = go bvs ty' + | TyVarLHS tv' <- lhs, tv==tv' + = True + | otherwise + = go bvs (tyVarKind tv) + go bvs (AppTy ty1 ty2) = go bvs ty1 || go bvs ty2 + go _ (LitTy {}) = False + go bvs (FunTy _ w arg res) = go bvs w || go bvs arg || go bvs res + go bvs (TyConApp tc tys) = go_tc bvs tc tys + + go bvs (ForAllTy (Bndr tv _) ty) + = go bvs (tyVarKind tv) || + (case lhs of + TyVarLHS tv' | tv==tv' -> False -- Shadowing + | otherwise -> go (bvs `extendVarSet` tv) ty + TyFamLHS {} -> False) -- Lookups don't happen under a forall + + go bvs (CastTy ty _co) = go bvs ty -- ToDo: should we worry about `co`? + go _ (CoercionTy _co) = False -- ToDo: should we worry about `co`? + + go_tc bvs tc tys + | isEmptyVarSet bvs -- Never look up in um_fam_env under a forall (ATF3) + , isTypeFamilyTyCon tc + , Just ty' <- lookupFamEnv fam_env tc (take arity tys) + -- NB: we look up /un-substituted/ types; + -- See Note [Shortcomings of the apartness test] + = go bvs ty' || any (go bvs) (drop arity tys) + + | TyFamLHS tc' tys' <- lhs + , tc == tc' + , tys `lengthAtLeast` arity -- Saturated, or over-saturated + , tcEqTyConAppArgs tys tys' + = True + + | otherwise + = any (go bvs) tys + where + arity = tyConArity tc + +{- Note [The occurs check in the Core unifier] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The unifier applies both substitutions (um_tv_env and um_fam_env) as it goes, +so we'll get an infinite loop if we have, for example + um_tv_env: a :-> F b -- (1) + um_fam_env F b :-> a -- (2) + +So (uOccursCheck substs lhs ty) returns True iff extending `substs` with `lhs :-> ty` +could lead to a loop. That is, could there by a type `s` such that + applySubsts( (substs + lhs:->ty), s ) is infinite + +It's vital that we do both at once: we might have (1) already and add (2); +or we might have (2) already and add (1). + +A very similar task is done by GHC.Tc.Utils.Unify.checkTyEqRhs. + +(OCU1) We keep track of the forall-bound variables because the um_fam_env is inactive + under a forall; indeed it is /unsound/ to consult it because we may have a binding + (F a :-> Int), and then unify (forall a. ...(F a)...) with something. We don't + want to map that (F a) to Int! + +(OCU2) Performance. Consider unifying + [a, b] ~ [big-ty, (a,a,a)] + We'll unify a:=big-ty. Then we'll attempt b:=(a,a,a), but must do an occurs check. + So we'll walk over big-ty, looking for `b`. And then again, and again, once for + each occurrence of `a`. A similar thing happens for + [a, (b,b,b)] ~ [big-ty, (a,a,a)] + albeit a bit less obviously. + + Potentially we could use a cache to record checks we have already done; + but I have not attempted that yet. Precisely similar remarks would apply + to GHC.Tc.Utils.Unify.checkTyEqRhs + +Note [Unifying coercion-foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we try to unify (forall cv. t1) ~ (forall cv. t2). +See Note [ForAllTy] in GHC.Core.TyCo.Rep. + +The problem with coercion variables is that coercion abstraction is not erased: +the `kco` shouldn't propagate from outside the ForAllTy to inside. Instead, I think +the correct new `kco` for the recursive call is `mkNomReflCo liftedTypeKind` (but I'm +a little worried it might be Constraint sometimes). + +This potential problem has been there a long time, and I'm going to let +sleeping dogs lie for now. +-} + +{- +************************************************************************ +* * + Unification monad +* * +************************************************************************ +-} + +data UMEnv + = UMEnv { um_unif :: AmIUnifying + + , um_inj_tf :: Bool + -- Checking for injectivity? + -- See (SI1) in Note [Specification of unification] + + , um_arr_mult :: MultiplicityFlag + -- Whether to unify multiplicity arguments when unifying arrows. + -- See Note [Rewrite rules ignore multiplicities in FunTy] + + , um_rn_env :: RnEnv2 + -- Renaming InTyVars to OutTyVars; this eliminates shadowing, and + -- lines up matching foralls on the left and right + -- See (CU2) in Note [The Core unifier] + + , um_foralls :: TyVarSet + -- OutTyVars bound by a forall in this unification; + -- Do not bind these in the substitution! + -- See the function tvBindFlag + + , um_bind_tv_fun :: BindTvFun + -- User-supplied BindFlag function, for variables not in um_foralls + -- See (CU1) in Note [The Core unifier] + + , um_bind_fam_fun :: BindFamFun + -- Similar to um_bind_tv_fun, but for type-family applications + -- See (ATF8) in Note [Apartness and type families] + } + +type FamSubstEnv = TyConEnv (ListMap TypeMap Type) + -- Map a TyCon and a list of types to a type + -- Domain of FamSubstEnv is exactly-saturated type-family + -- applications (F t1...tn) + +lookupFamEnv :: FamSubstEnv -> TyCon -> [Type] -> Maybe Type +lookupFamEnv env tc tys + = do { tys_map <- lookupTyConEnv env tc + ; lookupTM tys tys_map } + +data UMState = UMState + { um_tv_env :: TvSubstEnv + , um_cv_env :: CvSubstEnv + , um_fam_env :: FamSubstEnv } + -- um_tv_env, um_cv_env, um_fam_env are all "global" substitutions; + -- that is, neither their domains nor their ranges mention any variables + -- in um_foralls; i.e. variables bound by foralls inside the types being unified + + -- When /matching/ um_fam_env is usually empty; but not quite always. + -- See (ATF7) of Note [Apartness and type families] + +newtype UM a + = UM' { unUM :: UMState -> UnifyResultM (UMState, a) } + -- See Note [The one-shot state monad trick] in GHC.Utils.Monad + +pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +pattern UM m <- UM' m + where + UM m = UM' (oneShot m) +{-# COMPLETE UM #-} + +instance Functor UM where + fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s)) + +instance Applicative UM where + pure a = UM (\s -> pure (s, a)) + (<*>) = ap + +instance Monad UM where + {-# INLINE (>>=) #-} + -- See Note [INLINE pragmas and (>>)] in GHC.Utils.Monad + m >>= k = UM (\state -> + do { (state', v) <- unUM m state + ; unUM (k v) state' }) + +instance MonadFail UM where + fail _ = UM (\_ -> SurelyApart) -- failed pattern match + +initUM :: TvSubstEnv -- subst to extend + -> CvSubstEnv + -> UM () + -> UnifyResultM (TvSubstEnv, CvSubstEnv) +initUM subst_env cv_subst_env um + = case unUM um state of + Unifiable (state, _) -> Unifiable (get state) + MaybeApart r (state, _) -> MaybeApart r (get state) + SurelyApart -> SurelyApart + where + state = UMState { um_tv_env = subst_env + , um_cv_env = cv_subst_env + , um_fam_env = emptyTyConEnv } + get (UMState { um_tv_env = tv_env, um_cv_env = cv_env }) = (tv_env, cv_env) + +getTvSubstEnv :: UM TvSubstEnv +getTvSubstEnv = UM $ \state -> Unifiable (state, um_tv_env state) + +getCvSubstEnv :: UM CvSubstEnv +getCvSubstEnv = UM $ \state -> Unifiable (state, um_cv_env state) + +getSubstEnvs :: UM UMState +getSubstEnvs = UM $ \state -> Unifiable (state, state) + +getSubst :: UMEnv -> UM Subst +getSubst env = do { tv_env <- getTvSubstEnv + ; cv_env <- getCvSubstEnv + ; let in_scope = rnInScopeSet (um_rn_env env) + ; return (mkTCvSubst in_scope tv_env cv_env) } + +extendTvEnv :: TyVar -> Type -> UM () +extendTvEnv tv ty = UM $ \state -> + Unifiable (state { um_tv_env = extendVarEnv (um_tv_env state) tv ty }, ()) + +extendCvEnv :: CoVar -> Coercion -> UM () +extendCvEnv cv co = UM $ \state -> + Unifiable (state { um_cv_env = extendVarEnv (um_cv_env state) cv co }, ()) + +extendFamEnv :: TyCon -> [Type] -> Type -> UM () +extendFamEnv tc tys ty = UM $ \state -> + Unifiable (state { um_fam_env = extend (um_fam_env state) tc }, ()) + where + extend :: FamSubstEnv -> TyCon -> FamSubstEnv + extend = alterTyConEnv alter_tm + + alter_tm :: Maybe (ListMap TypeMap Type) -> Maybe (ListMap TypeMap Type) + alter_tm m_elt = Just (alterTM tys (\_ -> Just ty) (m_elt `orElse` emptyTM)) + +umRnBndr2 :: UMEnv -> TyCoVar -> TyCoVar -> UMEnv +umRnBndr2 env v1 v2 + = env { um_rn_env = rn_env', um_foralls = um_foralls env `extendVarSet` v' } + where + (rn_env', v') = rnBndr2_var (um_rn_env env) v1 v2 + +mentionsForAllBoundTyVarsL, mentionsForAllBoundTyVarsR :: UMEnv -> VarSet -> Bool +-- See (CU2) in Note [The Core unifier] +mentionsForAllBoundTyVarsL = mentions_forall_bound_tvs inRnEnvL +mentionsForAllBoundTyVarsR = mentions_forall_bound_tvs inRnEnvR + +mentions_forall_bound_tvs :: (RnEnv2 -> TyVar -> Bool) -> UMEnv -> VarSet -> Bool +mentions_forall_bound_tvs in_rn_env env varset + | isEmptyVarSet (um_foralls env) = False + | anyVarSet (in_rn_env (um_rn_env env)) varset = True + | otherwise = False + -- NB: That isEmptyVarSet guard is a critical optimization; + -- it means we don't have to calculate the free vars of + -- the type, often saving quite a bit of allocation. + +-- | Converts any SurelyApart to a MaybeApart +don'tBeSoSure :: MaybeApartReason -> UM () -> UM () +don'tBeSoSure r um = UM $ \ state -> + case unUM um state of + SurelyApart -> MaybeApart r (state, ()) + other -> other + +umRnOccL :: UMEnv -> TyVar -> TyVar +umRnOccL env v = rnOccL (um_rn_env env) v + +umRnOccR :: UMEnv -> TyVar -> TyVar +umRnOccR env v = rnOccR (um_rn_env env) v + +umSwapRn :: UMEnv -> UMEnv +umSwapRn env = env { um_rn_env = rnSwap (um_rn_env env) } + +maybeApart :: MaybeApartReason -> UM () +maybeApart r = UM (\state -> MaybeApart r (state, ())) + +surelyApart :: UM a +surelyApart = UM (\_ -> SurelyApart) + +{- +%************************************************************************ +%* * + Matching a (lifted) type against a coercion +%* * +%************************************************************************ + +This section defines essentially an inverse to liftCoSubst. It is defined +here to avoid a dependency from Coercion on this module. + +-} + +data MatchEnv = ME { me_tmpls :: TyVarSet + , me_env :: RnEnv2 } + +-- | 'liftCoMatch' is sort of inverse to 'liftCoSubst'. In particular, if +-- @liftCoMatch vars ty co == Just s@, then @liftCoSubst s ty == co@, +-- where @==@ there means that the result of 'liftCoSubst' has the same +-- type as the original co; but may be different under the hood. +-- That is, it matches a type against a coercion of the same +-- "shape", and returns a lifting substitution which could have been +-- used to produce the given coercion from the given type. +-- Note that this function is incomplete -- it might return Nothing +-- when there does indeed exist a possible lifting context. +-- +-- This function is incomplete in that it doesn't respect the equality +-- in `eqType`. That is, it's possible that this will succeed for t1 and +-- fail for t2, even when t1 `eqType` t2. That's because it depends on +-- there being a very similar structure between the type and the coercion. +-- This incompleteness shouldn't be all that surprising, especially because +-- it depends on the structure of the coercion, which is a silly thing to do. +-- +-- The lifting context produced doesn't have to be exacting in the roles +-- of the mappings. This is because any use of the lifting context will +-- also require a desired role. Thus, this algorithm prefers mapping to +-- nominal coercions where it can do so. +liftCoMatch :: TyCoVarSet -> Type -> Coercion -> Maybe LiftingContext +liftCoMatch tmpls ty co + = do { cenv1 <- ty_co_match menv emptyVarEnv ki ki_co ki_ki_co ki_ki_co + ; cenv2 <- ty_co_match menv cenv1 ty co + (mkNomReflCo co_lkind) (mkNomReflCo co_rkind) + ; return (LC (mkEmptySubst in_scope) cenv2) } + where + menv = ME { me_tmpls = tmpls, me_env = mkRnEnv2 in_scope } + in_scope = mkInScopeSet (tmpls `unionVarSet` tyCoVarsOfCo co) + -- Like tcMatchTy, assume all the interesting variables + -- in ty are in tmpls + + ki = typeKind ty + ki_co = promoteCoercion co + ki_ki_co = mkNomReflCo liftedTypeKind + + Pair co_lkind co_rkind = coercionKind ki_co + +-- | 'ty_co_match' does all the actual work for 'liftCoMatch'. +ty_co_match :: MatchEnv -- ^ ambient helpful info + -> LiftCoEnv -- ^ incoming subst + -> Type -- ^ ty, type to match + -> Coercion -- ^ co :: lty ~r rty, coercion to match against + -> Coercion -- ^ :: kind(lsubst(ty)) ~N kind(lty) + -> Coercion -- ^ :: kind(rsubst(ty)) ~N kind(rty) + -> Maybe LiftCoEnv + -- ^ Just env ==> liftCoSubst Nominal env ty == co, modulo roles. + -- Also: Just env ==> lsubst(ty) == lty and rsubst(ty) == rty, + -- where lsubst = lcSubstLeft(env) and rsubst = lcSubstRight(env) +ty_co_match menv subst ty co lkco rkco + | Just ty' <- coreView ty = ty_co_match menv subst ty' co lkco rkco + + -- handle Refl case: + | tyCoVarsOfType ty `isNotInDomainOf` subst + , Just (ty', _) <- isReflCo_maybe co + , ty `eqType` ty' + -- Why `eqType` and not `tcEqType`? Because this function is only used + -- during coercion optimisation, after type-checking has finished. + = Just subst + + where + isNotInDomainOf :: VarSet -> VarEnv a -> Bool + isNotInDomainOf set env + = noneSet (\v -> elemVarEnv v env) set + + noneSet :: (Var -> Bool) -> VarSet -> Bool + noneSet f = allVarSet (not . f) + +ty_co_match menv subst ty co lkco rkco + | CastTy ty' co' <- ty + -- See Note [Matching in the presence of casts (1)] + = let empty_subst = mkEmptySubst (rnInScopeSet (me_env menv)) + substed_co_l = substCo (liftEnvSubstLeft empty_subst subst) co' + substed_co_r = substCo (liftEnvSubstRight empty_subst subst) co' + in + ty_co_match menv subst ty' co (substed_co_l `mkTransCo` lkco) + (substed_co_r `mkTransCo` rkco) + + | SymCo co' <- co + = swapLiftCoEnv <$> ty_co_match menv (swapLiftCoEnv subst) ty co' rkco lkco + + -- Match a type variable against a non-refl coercion +ty_co_match menv subst (TyVarTy tv1) co lkco rkco + | Just co1' <- lookupVarEnv subst tv1' -- tv1' is already bound to co1 + = if eqCoercionX (nukeRnEnvL rn_env) co1' co + then Just subst + else Nothing -- no match since tv1 matches two different coercions + + | tv1' `elemVarSet` me_tmpls menv -- tv1' is a template var + = if any (inRnEnvR rn_env) (tyCoVarsOfCoList co) + then Nothing -- occurs check failed + else Just $ extendVarEnv subst tv1' $ + castCoercionKind co (mkSymCo lkco) (mkSymCo rkco) + + | otherwise + = Nothing + + where + rn_env = me_env menv + tv1' = rnOccL rn_env tv1 + + -- just look through SubCo's. We don't really care about roles here. +ty_co_match menv subst ty (SubCo co) lkco rkco + = ty_co_match menv subst ty co lkco rkco + +ty_co_match menv subst (AppTy ty1a ty1b) co _lkco _rkco + | Just (co2, arg2) <- splitAppCo_maybe co -- c.f. Unify.match on AppTy + = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2] +ty_co_match menv subst ty1 (AppCo co2 arg2) _lkco _rkco + | Just (ty1a, ty1b) <- splitAppTyNoView_maybe ty1 + -- yes, the one from Type, not TcType; this is for coercion optimization + = ty_co_match_app menv subst ty1a [ty1b] co2 [arg2] + +ty_co_match menv subst (TyConApp tc1 tys) (TyConAppCo _ tc2 cos) _lkco _rkco + = ty_co_match_tc menv subst tc1 tys tc2 cos + +ty_co_match menv subst (FunTy { ft_mult = w, ft_arg = ty1, ft_res = ty2 }) + (FunCo { fco_mult = co_w, fco_arg = co1, fco_res = co2 }) _lkco _rkco + = ty_co_match_args menv subst [w, rep1, rep2, ty1, ty2] + [co_w, co1_rep, co2_rep, co1, co2] + where + rep1 = getRuntimeRep ty1 + rep2 = getRuntimeRep ty2 + co1_rep = mkRuntimeRepCo co1 + co2_rep = mkRuntimeRepCo co2 + -- NB: we include the RuntimeRep arguments in the matching; + -- not doing so caused #21205. + +ty_co_match menv subst (ForAllTy (Bndr tv1 vis1t) ty1) + (ForAllCo tv2 vis1c vis2c kind_co2 co2) + lkco rkco + | isTyVar tv1 && isTyVar tv2 + , vis1t == vis1c && vis1c == vis2c -- Is this necessary? + -- Is this visibility check necessary? @rae says: yes, I think the + -- check is necessary, if we're caring about visibility (and we are). + -- But ty_co_match is a dark and not important corner. + = do { subst1 <- ty_co_match menv subst (tyVarKind tv1) kind_co2 + ki_ki_co ki_ki_co + ; let rn_env0 = me_env menv + rn_env1 = rnBndr2 rn_env0 tv1 tv2 + menv' = menv { me_env = rn_env1 } + ; ty_co_match menv' subst1 ty1 co2 lkco rkco } + where + ki_ki_co = mkNomReflCo liftedTypeKind + +-- ty_co_match menv subst (ForAllTy (Bndr cv1 _) ty1) +-- (ForAllCo cv2 kind_co2 co2) +-- lkco rkco +-- | isCoVar cv1 && isCoVar cv2 +-- We seems not to have enough information for this case +-- 1. Given: +-- cv1 :: (s1 :: k1) ~r (s2 :: k2) +-- kind_co2 :: (s1' ~ s2') ~N (t1 ~ t2) +-- eta1 = mkSelCo (SelTyCon 2 role) (downgradeRole r Nominal kind_co2) +-- :: s1' ~ t1 +-- eta2 = mkSelCo (SelTyCon 3 role) (downgradeRole r Nominal kind_co2) +-- :: s2' ~ t2 +-- Wanted: +-- subst1 <- ty_co_match menv subst s1 eta1 kco1 kco2 +-- subst2 <- ty_co_match menv subst1 s2 eta2 kco3 kco4 +-- Question: How do we get kcoi? +-- 2. Given: +-- lkco :: <*> -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep +-- rkco :: <*> +-- Wanted: +-- ty_co_match menv' subst2 ty1 co2 lkco' rkco' +-- Question: How do we get lkco' and rkco'? + +ty_co_match _ subst (CoercionTy {}) _ _ _ + = Just subst -- don't inspect coercions + +ty_co_match menv subst ty (GRefl r t (MCo co)) lkco rkco + = ty_co_match menv subst ty (GRefl r t MRefl) lkco (rkco `mkTransCo` mkSymCo co) + +ty_co_match menv subst ty co1 lkco rkco + | Just (CastTy t co, r) <- isReflCo_maybe co1 + -- In @pushRefl@, pushing reflexive coercion inside CastTy will give us + -- t |> co ~ t ; ; t ~ t |> co + -- But transitive coercions are not helpful. Therefore we deal + -- with it here: we do recursion on the smaller reflexive coercion, + -- while propagating the correct kind coercions. + = let kco' = mkSymCo co + in ty_co_match menv subst ty (mkReflCo r t) (lkco `mkTransCo` kco') + (rkco `mkTransCo` kco') + +ty_co_match menv subst ty co lkco rkco + | Just co' <- pushRefl co = ty_co_match menv subst ty co' lkco rkco + | otherwise = Nothing + +ty_co_match_tc :: MatchEnv -> LiftCoEnv + -> TyCon -> [Type] + -> TyCon -> [Coercion] + -> Maybe LiftCoEnv +ty_co_match_tc menv subst tc1 tys1 tc2 cos2 + = do { guard (tc1 == tc2) + ; ty_co_match_args menv subst tys1 cos2 } + +ty_co_match_app :: MatchEnv -> LiftCoEnv + -> Type -> [Type] -> Coercion -> [Coercion] + -> Maybe LiftCoEnv +ty_co_match_app menv subst ty1 ty1args co2 co2args + | Just (ty1', ty1a) <- splitAppTyNoView_maybe ty1 + , Just (co2', co2a) <- splitAppCo_maybe co2 + = ty_co_match_app menv subst ty1' (ty1a : ty1args) co2' (co2a : co2args) + + | otherwise + = do { subst1 <- ty_co_match menv subst ki1 ki2 ki_ki_co ki_ki_co + ; let Pair lkco rkco = mkNomReflCo <$> coercionKind ki2 + ; subst2 <- ty_co_match menv subst1 ty1 co2 lkco rkco + ; ty_co_match_args menv subst2 ty1args co2args } + where + ki1 = typeKind ty1 + ki2 = promoteCoercion co2 + ki_ki_co = mkNomReflCo liftedTypeKind + +ty_co_match_args :: MatchEnv -> LiftCoEnv -> [Type] -> [Coercion] + -> Maybe LiftCoEnv +ty_co_match_args menv subst (ty:tys) (arg:args) + = do { let Pair lty rty = coercionKind arg + lkco = mkNomReflCo (typeKind lty) + rkco = mkNomReflCo (typeKind rty) + ; subst' <- ty_co_match menv subst ty arg lkco rkco + ; ty_co_match_args menv subst' tys args } +ty_co_match_args _ subst [] [] = Just subst +ty_co_match_args _ _ _ _ = Nothing + +pushRefl :: Coercion -> Maybe Coercion +pushRefl co = + case (isReflCo_maybe co) of + Just (AppTy ty1 ty2, Nominal) + -> Just (AppCo (mkReflCo Nominal ty1) (mkNomReflCo ty2)) + Just (FunTy af w ty1 ty2, r) + -> Just (FunCo r af af (mkReflCo r w) (mkReflCo r ty1) (mkReflCo r ty2)) + Just (TyConApp tc tys, r) + -> Just (TyConAppCo r tc (zipWith mkReflCo (tyConRoleListX r tc) tys)) + Just (ForAllTy (Bndr tv vis) ty, r) + -> Just (ForAllCo { fco_tcv = tv, fco_visL = vis, fco_visR = vis + , fco_kind = mkNomReflCo (varType tv) + , fco_body = mkReflCo r ty }) + _ -> Nothing diff --git a/GHC/Core/UsageEnv.hs b/GHC/Core/UsageEnv.hs --- a/GHC/Core/UsageEnv.hs +++ b/GHC/Core/UsageEnv.hs @@ -90,9 +90,13 @@ combineUsage Nothing Nothing = pprPanic "supUE" (ppr e1 <+> ppr e2) -- Note: If you are changing this logic, check 'mkMultSup' in Multiplicity as well. -supUEs :: [UsageEnv] -> UsageEnv +-- Used with @f = '[]'@ and @f = 'NonEmpty'@ +supUEs :: Foldable f => f UsageEnv -> UsageEnv supUEs = foldr supUE bottomUE +-- INLINE to ensure specialization at use site, and to avoid multiple specialization on the same +-- type +{-# INLINE supUEs #-} deleteUE :: NamedThing n => UsageEnv -> n -> UsageEnv deleteUE (UsageEnv e b) x = UsageEnv (delFromNameEnv e (getName x)) b diff --git a/GHC/Core/Utils.hs b/GHC/Core/Utils.hs --- a/GHC/Core/Utils.hs +++ b/GHC/Core/Utils.hs @@ -32,6 +32,7 @@ isCheapApp, isExpandableApp, isSaturatedConApp, exprIsTickedString, exprIsTickedString_maybe, exprIsTopLevelBindable, + exprIsUnaryClassFun, isUnaryClassId, altsAreExhaustive, etaExpansionTick, -- * Equality @@ -74,7 +75,8 @@ import GHC.Core.FVs( bindFreeVars ) import GHC.Core.DataCon import GHC.Core.Type as Type -import GHC.Core.Predicate( isCoVarType ) +import GHC.Core.Predicate( isEqPred ) +import GHC.Core.Predicate( isUnaryClass ) import GHC.Core.FamInstEnv import GHC.Core.TyCo.Compare( eqType, eqTypeX ) import GHC.Core.Coercion @@ -113,6 +115,7 @@ import Data.ByteString ( ByteString ) import Data.Function ( on ) import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) +import qualified Data.List as Partial ( init, last ) import Data.Ord ( comparing ) import Control.Monad ( guard ) import qualified Data.Set as Set @@ -142,7 +145,7 @@ exprType (Lam binder expr) = mkLamType binder (exprType expr) exprType e@(App _ _) = case collectArgs e of - (fun, args) -> applyTypeToArgs (pprCoreExpr e) (exprType fun) args + (fun, args) -> applyTypeToArgs (exprType fun) args exprType (Type ty) = pprPanic "exprType" (ppr ty) coreAltType :: CoreAlt -> Type @@ -180,7 +183,7 @@ = mkForAllTy (Bndr v coreTyLamForAllTyFlag) body_ty | otherwise - = mkFunctionType (varMult v) (varType v) body_ty + = mkFunctionType (idMult v) (idType v) body_ty mkLamTypes vs ty = foldr mkLamType ty vs @@ -221,11 +224,10 @@ Note that there might be existentially quantified coercion variables, too. -} -applyTypeToArgs :: HasDebugCallStack => SDoc -> Type -> [CoreExpr] -> Type +applyTypeToArgs :: HasDebugCallStack => Type -> [CoreExpr] -> Type -- ^ Determines the type resulting from applying an expression with given type --- to given argument expressions. --- The first argument is just for debugging, and gives some context -applyTypeToArgs pp_e op_ty args +applyTypeToArgs op_ty args = go op_ty args where go op_ty [] = op_ty @@ -244,14 +246,13 @@ go_ty_args op_ty rev_tys args = go (piResultTys op_ty (reverse rev_tys)) args - panic_msg as = vcat [ text "Expression:" <+> pp_e - , text "Type:" <+> ppr op_ty + panic_msg as = vcat [ text "Type:" <+> ppr op_ty , text "Args:" <+> ppr args , text "Args':" <+> ppr as ] mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr mkCastMCo e MRefl = e -mkCastMCo e (MCo co) = mkCast e co +mkCastMCo e (MCo co) = Cast e co -- We are careful to use (MCo co) only when co is not reflexive -- Hence (Cast e co) rather than (mkCast e co) @@ -283,7 +284,7 @@ Cast expr co2 -> mkCast expr (mkTransCo co2 co) Tick t expr -> Tick t (mkCast expr co) - Coercion e_co | isCoVarType (coercionRKind co) + Coercion e_co | isEqPred (coercionRKind co) -- The guard here checks that g has a (~#) on both sides, -- otherwise decomposeCo fails. Can in principle happen -- with unsafeCoerce @@ -302,41 +303,40 @@ -- | Wraps the given expression in the source annotation, dropping the -- annotation if possible. mkTick :: CoreTickish -> CoreExpr -> CoreExpr -mkTick t orig_expr = mkTick' id orig_expr +mkTick t orig_expr = mkTick' id id orig_expr where -- Some ticks (cost-centres) can be split in two, with the -- non-counting part having laxer placement properties. canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t - -- mkTick' handles floating of ticks *into* the expression. - mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with) - -- Always a composition of (Tick t) wrappers - -> CoreExpr -- Current expression + -- In this function, `top` is applied after adding the tick, and `rest` before. + -- This will result in applications that look like (top $ Tick t $ rest expr). + -- If we want to push the tick deeper, we pre-compose `top` with a function + -- adding the tick. + mkTick' :: (CoreExpr -> CoreExpr) -- apply after adding tick (float through) + -> (CoreExpr -> CoreExpr) -- apply before adding tick (float with) + -> CoreExpr -- current expression -> CoreExpr - -- So in the call (mkTick' rest e), the expression - -- (rest e) - -- has the same type as e - -- Returns an expression equivalent to (Tick t (rest e)) - mkTick' rest expr = case expr of + mkTick' top rest expr = case expr of -- Float ticks into unsafe coerce the same way we would do with a cast. Case scrut bndr ty alts@[Alt ac abs _rhs] | Just rhs <- isUnsafeEqualityCase scrut bndr alts - -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)] + -> top $ mkTick' (\e -> Case scrut bndr ty [Alt ac abs e]) rest rhs -- Cost centre ticks should never be reordered relative to each -- other. Therefore we can stop whenever two collide. Tick t2 e - | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr + | ProfNote{} <- t2, ProfNote{} <- t -> top $ Tick t $ rest expr -- Otherwise we assume that ticks of different placements float -- through each other. - | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e + | tickishPlace t2 /= tickishPlace t -> mkTick' (top . Tick t2) rest e -- For annotations this is where we make sure to not introduce -- redundant ticks. - | tickishContains t t2 -> mkTick' rest e -- Drop t2 - | tickishContains t2 t -> rest e -- Drop t - | otherwise -> mkTick' (rest . Tick t2) e + | tickishContains t t2 -> mkTick' top rest e + | tickishContains t2 t -> orig_expr + | otherwise -> mkTick' top (rest . Tick t2) e -- Ticks don't care about types, so we just float all ticks -- through them. Note that it's not enough to check for these @@ -344,14 +344,14 @@ -- expressions below ticks, such constructs can be the result of -- unfoldings. We therefore make an effort to put everything into -- the right place no matter what we start with. - Cast e co -> mkCast (mkTick' rest e) co - Coercion co -> Tick t $ rest (Coercion co) + Cast e co -> mkTick' (top . flip Cast co) rest e + Coercion co -> Coercion co Lam x e -- Always float through type lambdas. Even for non-type lambdas, -- floating is allowed for all but the most strict placement rule. | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime - -> Lam x $ mkTick' rest e + -> mkTick' (top . Lam x) rest e -- If it is both counting and scoped, we split the tick into its -- two components, often allowing us to keep the counting tick on @@ -360,25 +360,25 @@ -- floated, and the lambda may then be in a position to be -- beta-reduced. | canSplit - -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e + -> top $ Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e App f arg -- Always float through type applications. | not (isRuntimeArg arg) - -> App (mkTick' rest f) arg + -> mkTick' (top . flip App arg) rest f -- We can also float through constructor applications, placement -- permitting. Again we can split. | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit) -> if tickishPlace t == PlaceCostCentre - then rest $ tickHNFArgs t expr - else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr + then top $ rest $ tickHNFArgs t expr + else top $ Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr Var x | notFunction && tickishPlace t == PlaceCostCentre - -> rest expr -- Drop t + -> orig_expr | notFunction && canSplit - -> Tick (mkNoScope t) $ rest expr + -> top $ Tick (mkNoScope t) $ rest expr where -- SCCs can be eliminated on variables provided the variable -- is not a function. In these cases the SCC makes no difference: @@ -390,10 +390,10 @@ Lit{} | tickishPlace t == PlaceCostCentre - -> rest expr -- Drop t + -> orig_expr -- Catch-all: Annotate where we stand - _any -> Tick t $ rest expr + _any -> top $ Tick t $ rest expr mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr mkTicks ticks expr = foldr mkTick expr ticks @@ -1296,14 +1296,17 @@ -- * `case e of {}` an empty case trivial_expr_fold k_id k_lit k_triv k_not_triv = go where - -- If you change this function, be sure to change SetLevels.notWorthFloating - -- as well! + -- If you change this function, be sure to change + -- SetLevels.notWorthFloating as well! -- (Or yet better: Come up with a way to share code with this function.) go (Var v) = k_id v -- See Note [Variables are trivial] go (Lit l) | litIsTrivial l = k_lit l go (Type _) = k_triv go (Coercion _) = k_triv - go (App f t) | not (isRuntimeArg t) = go f + go (App f arg) + | not (isRuntimeArg arg) = go f + | exprIsUnaryClassFun f = go arg + | otherwise = k_not_triv go (Lam b e) | not (isRuntimeVar b) = go e go (Tick t e) | not (tickishIsCode t) = go e -- See Note [Tick trivial] go (Cast e _) = go e @@ -1498,18 +1501,23 @@ in \w. v True -} --------------------- -exprIsWorkFree :: CoreExpr -> Bool -- See Note [exprIsWorkFree] -exprIsWorkFree e = exprIsCheapX isWorkFreeApp e - -exprIsCheap :: CoreExpr -> Bool -exprIsCheap e = exprIsCheapX isCheapApp e +------------------------------------- +type CheapAppFun = Id -> Arity -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- True mainly of data constructors, partial applications; + -- but with minor variations: + -- isWorkFreeApp + -- isCheapApp + -- isExpandableApp -exprIsCheapX :: CheapAppFun -> CoreExpr -> Bool +exprIsCheapX :: CheapAppFun -> Bool -> CoreExpr -> Bool {-# INLINE exprIsCheapX #-} --- allow specialization of exprIsCheap and exprIsWorkFree +-- allow specialization of exprIsCheap, exprIsWorkFree and exprIsExpandable -- instead of having an unknown call to ok_app -exprIsCheapX ok_app e +-- expandable=True <=> Treat Case and Let as cheap, if their sub-expressions are. +-- This flag is set for exprIsExpandable +exprIsCheapX ok_app expandable e = ok e where ok e = go 0 e @@ -1520,7 +1528,7 @@ go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && + go n (Case scrut _ _ alts) = not expandable && ok scrut && and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e @@ -1528,90 +1536,26 @@ | otherwise = go n e go n (App f e) | isRuntimeArg e = go (n+1) f && ok e | otherwise = go n f - go n (Let (NonRec _ r) e) = go n e && ok r - go n (Let (Rec prs) e) = go n e && all (ok . snd) prs + go n (Let (NonRec _ r) e) = not expandable && go n e && ok r + go n (Let (Rec prs) e) = not expandable && go n e && all (ok . snd) prs -- Case: see Note [Case expressions are work-free] -- App, Let: see Note [Arguments and let-bindings exprIsCheapX] - -{- Note [exprIsExpandable] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -An expression is "expandable" if we are willing to duplicate it, if doing -so might make a RULE or case-of-constructor fire. Consider - let x = (a,b) - y = build g - in ....(case x of (p,q) -> rhs)....(foldr k z y).... - -We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), -but we do want - - * the case-expression to simplify - (via exprIsConApp_maybe, exprIsLiteral_maybe) - - * the foldr/build RULE to fire - (by expanding the unfolding during rule matching) - -So we classify the unfolding of a let-binding as "expandable" (via the -uf_expandable field) if we want to do this kind of on-the-fly -expansion. Specifically: - -* True of constructor applications (K a b) - -* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. - (NB: exprIsCheap might not be true of this) - -* False of case-expressions. If we have - let x = case ... in ...(case x of ...)... - we won't simplify. We have to inline x. See #14688. - -* False of let-expressions (same reason); and in any case we - float lets out of an RHS if doing so will reveal an expandable - application (see SimplEnv.doFloatFromRhs). - -* Take care: exprIsExpandable should /not/ be true of primops. I - found this in test T5623a: - let q = /\a. Ptr a (a +# b) - in case q @ Float of Ptr v -> ...q... +-------------------- +exprIsWorkFree :: CoreExpr -> Bool +-- See Note [exprIsWorkFree] +exprIsWorkFree e = exprIsCheapX isWorkFreeApp False e - q's inlining should not be expandable, else exprIsConApp_maybe will - say that (q @ Float) expands to (Ptr a (a +# b)), and that will - duplicate the (a +# b) primop, which we should not do lightly. - (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) --} +-------------------- +exprIsCheap :: CoreExpr -> Bool +-- See Note [exprIsCheap] +exprIsCheap e = exprIsCheapX isCheapApp False e -------------------------------------- +-------------------- exprIsExpandable :: CoreExpr -> Bool -- See Note [exprIsExpandable] -exprIsExpandable e - = ok e - where - ok e = go 0 e - - -- n is the number of value arguments - go n (Var v) = isExpandableApp v n - go _ (Lit {}) = True - go _ (Type {}) = True - go _ (Coercion {}) = True - go n (Cast e _) = go n e - go n (Tick t e) | tickishCounts t = False - | otherwise = go n e - go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e - | otherwise = go n e - go n (App f e) | isRuntimeArg e = go (n+1) f && ok e - | otherwise = go n f - go _ (Case {}) = False - go _ (Let {}) = False - - -------------------------------------- -type CheapAppFun = Id -> Arity -> Bool - -- Is an application of this function to n *value* args - -- always cheap, assuming the arguments are cheap? - -- True mainly of data constructors, partial applications; - -- but with minor variations: - -- isWorkFreeApp - -- isCheapApp +exprIsExpandable e = exprIsCheapX isExpandableApp True e isWorkFreeApp :: CheapAppFun isWorkFreeApp fn n_val_args @@ -1631,7 +1575,7 @@ | isDeadEndId fn = True -- See Note [isCheapApp: bottoming functions] | otherwise = case idDetails fn of - DataConWorkId {} -> True -- Actually handled by isWorkFreeApp + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId op _ -> primOpIsCheap op @@ -1646,6 +1590,7 @@ | isWorkFreeApp fn n_val_args = True | otherwise = case idDetails fn of + -- DataConWorkId {} -> _ -- Handled by isWorkFreeApp RecSelId {} -> n_val_args == 1 -- See Note [Record selection] ClassOpId {} -> n_val_args == 1 PrimOpId {} -> False @@ -1677,6 +1622,50 @@ I'm not sure why we have a special case for bottoming functions in isCheapApp. Maybe we don't need it. +Note [exprIsExpandable] +~~~~~~~~~~~~~~~~~~~~~~~ +An expression is "expandable" if we are willing to duplicate it, if doing +so might make a RULE or case-of-constructor fire. Consider + let x = (a,b) + y = build g + in ....(case x of (p,q) -> rhs)....(foldr k z y).... + +We don't inline 'x' or 'y' (see Note [Lone variables] in GHC.Core.Unfold), +but we do want + + * the case-expression to simplify + (via exprIsConApp_maybe, exprIsLiteral_maybe) + + * the foldr/build RULE to fire + (by expanding the unfolding during rule matching) + +So we classify the unfolding of a let-binding as "expandable" (via the +uf_expandable field) if we want to do this kind of on-the-fly +expansion. Specifically: + +* True of constructor applications (K a b) + +* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic. + (NB: exprIsCheap might not be true of this) + +* False of case-expressions. If we have + let x = case ... in ...(case x of ...)... + we won't simplify. We have to inline x. See #14688. + +* False of let-expressions (same reason); and in any case we + float lets out of an RHS if doing so will reveal an expandable + application (see SimplEnv.doFloatFromRhs). + +* Take care: exprIsExpandable should /not/ be true of primops. I + found this in test T5623a: + let q = /\a. Ptr a (a +# b) + in case q @ Float of Ptr v -> ...q... + + q's inlining should not be expandable, else exprIsConApp_maybe will + say that (q @ Float) expands to (Ptr a (a +# b)), and that will + duplicate the (a +# b) primop, which we should not do lightly. + (It's quite hard to trigger this bug, but T13155 does so for GHC 8.0.) + Note [isExpandableApp: bottoming functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important that isExpandableApp does not respond True to bottoming @@ -1720,14 +1709,31 @@ So we treat the application of a function (negate in this case) to a *dictionary* as expandable. In effect, every function is CONLIKE when it's applied only to dictionaries. +-} +isUnaryClassId :: Id -> Bool +-- True of (a) the method selector (classop) +-- (b) the dictionary data constructor +-- of a unary class +isUnaryClassId v + | Just cls <- isClassOpId_maybe v = isUnaryClass cls + | Just dc <- isDataConWorkId_maybe v = isUnaryClassDataCon dc + | otherwise = False -************************************************************************ +exprIsUnaryClassFun :: CoreExpr -> Bool +-- True of an a type application (f @t1 .. @tn), +-- where `f` is a unary-class-id +-- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon +exprIsUnaryClassFun (App f (Type {})) = exprIsUnaryClassFun f +exprIsUnaryClassFun (Var v) = isUnaryClassId v +exprIsUnaryClassFun _ = False + + +{- ********************************************************************* * * exprOkForSpeculation * * -************************************************************************ --} +********************************************************************* -} ----------------------------- -- | To a first approximation, 'exprOkForSpeculation' returns True of @@ -1857,7 +1863,7 @@ _ -> False ----------------------------- -app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool +app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreArg] -> Bool app_ok fun_ok primop_ok fun args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] @@ -1868,17 +1874,16 @@ | otherwise = case idDetails fun of - DFunId new_type -> not new_type + DFunId unary_class -> not unary_class -- DFuns terminate, unless the dict is implemented - -- with a newtype in which case they may not + -- by a no-op in which case they may not + -- See (UCM3) in Note [Unary class magic] in GHC.Core.TyCon - DataConWorkId {} -> args_ok - -- The strictness of the constructor has already - -- been expressed by its "wrapper", so we don't need - -- to take the arguments into account - -- Well, we thought so. But it's definitely wrong! - -- See #20749 and Note [How untagged pointers can - -- end up in strict fields] in GHC.Stg.InferTags + DataConWorkId dc + | isLazyDataConRep dc + -> args_ok + | otherwise + -> fields_ok (dataConRepStrictness dc) ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] @@ -1889,10 +1894,10 @@ PrimOpId op _ | primOpIsDiv op - , Lit divisor <- last args + , Lit divisor <- Partial.last args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (init args) + -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args) -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK @@ -1928,7 +1933,7 @@ -- Even if a function call itself is OK, any unlifted -- args are still evaluated eagerly and must be checked - args_ok = and (zipWith arg_ok arg_tys args) + args_ok = all2Prefix arg_ok arg_tys args arg_ok :: PiTyVarBinder -> CoreExpr -> Bool arg_ok (Named _) _ = True -- A type argument arg_ok (Anon ty _) arg -- A term argument @@ -1937,6 +1942,18 @@ | otherwise = expr_ok fun_ok primop_ok arg + -- Used for strict DataCon worker arguments + -- See (SFC1) of Note [Strict fields in Core] + fields_ok str_marks = all3Prefix field_ok arg_tys str_marks args + field_ok :: PiTyVarBinder -> StrictnessMark -> CoreExpr -> Bool + field_ok (Named _) _ _ = True + field_ok (Anon ty _) str arg + | NotMarkedStrict <- str -- iff it's a lazy field + , definitelyLiftedType (scaledThing ty) -- and its type is lifted + = True -- then the worker app does not eval + | otherwise + = expr_ok fun_ok primop_ok arg + ----------------------------- altsAreExhaustive :: [Alt b] -> Bool -- True <=> the case alternatives are definitely exhaustive @@ -2133,6 +2150,7 @@ -- and in so doing makes the binding lazy. -- -- So, it does /not/ treat variables as evaluated, unless they say they are. +-- -- However, it /does/ treat partial applications and constructor applications -- as values, even if their arguments are non-trivial, provided the argument -- type is lifted. For example, both of these are values: @@ -2162,12 +2180,14 @@ -- or PAPs. -- exprIsHNFlike :: HasDebugCallStack => (Var -> Bool) -> (Unfolding -> Bool) -> CoreExpr -> Bool -exprIsHNFlike is_con is_con_unf = is_hnf_like +exprIsHNFlike is_con is_con_unf e + = -- pprTraceWith "hnf" (\r -> ppr r <+> ppr e) $ + is_hnf_like e where is_hnf_like (Var v) -- NB: There are no value args at this point - = id_app_is_value v 0 -- Catches nullary constructors, - -- so that [] and () are values, for example - -- and (e.g.) primops that don't have unfoldings + = id_app_is_value v [] -- Catches nullary constructors, + -- so that [] and () are values, for example + -- and (e.g.) primops that don't have unfoldings || is_con_unf (idUnfolding v) -- Check the thing's unfolding; it might be bound to a value -- or to a guaranteed-evaluated variable (isEvaldUnfolding) @@ -2191,7 +2211,7 @@ -- See Note [exprIsHNF Tick] is_hnf_like (Cast e _) = is_hnf_like e is_hnf_like (App e a) - | isValArg a = app_is_value e 1 + | isValArg a = app_is_value e [a] | otherwise = is_hnf_like e is_hnf_like (Let _ e) = is_hnf_like e -- Lazy let(rec)s don't affect us is_hnf_like (Case e b _ as) @@ -2199,27 +2219,71 @@ = is_hnf_like rhs is_hnf_like _ = False - -- 'n' is the number of value args to which the expression is applied - -- And n>0: there is at least one value argument - app_is_value :: CoreExpr -> Int -> Bool - app_is_value (Var f) nva = id_app_is_value f nva - app_is_value (Tick _ f) nva = app_is_value f nva - app_is_value (Cast f _) nva = app_is_value f nva - app_is_value (App f a) nva - | isValArg a = - app_is_value f (nva + 1) && - not (needsCaseBinding (exprType a) a) - -- For example f (x /# y) where f has arity two, and the first - -- argument is unboxed. This is not a value! - -- But f 34# is a value. - -- NB: Check app_is_value first, the arity check is cheaper - | otherwise = app_is_value f nva - app_is_value _ _ = False + -- Collect arguments through Casts and Ticks and call id_app_is_value + app_is_value :: CoreExpr -> [CoreArg] -> Bool + app_is_value (Var f) as = id_app_is_value f as + app_is_value (Tick _ f) as = app_is_value f as + app_is_value (Cast f _) as = app_is_value f as + app_is_value (App f a) as | isValArg a = app_is_value f (a:as) + | otherwise = app_is_value f as + app_is_value _ _ = False - id_app_is_value id n_val_args - = is_con id - || idArity id > n_val_args + id_app_is_value id val_args + | Just dc <- isDataConWorkId_maybe id + , isUnaryClassDataCon dc + = all is_hnf_like val_args -- Look through unary class data cons + | otherwise + -- See Note [exprIsHNF for function applications] + -- for the specification and examples + = case compare (idArity id) (length val_args) of + EQ | is_con id -> -- Saturated app of a DataCon/CONLIKE Id + case mb_str_marks id of + Just str_marks -> -- with strict fields; see (SFC1) of Note [Strict fields in Core] + assert (val_args `equalLength` str_marks) $ + fields_hnf str_marks + Nothing -> -- without strict fields: like PAP + args_hnf -- NB: CONLIKEs are lazy! + GT -> -- PAP: Check unlifted val_args + args_hnf + + _ -> False + + where + -- Saturated, Strict DataCon: Check unlifted val_args and strict fields + fields_hnf str_marks = all3Prefix check_field val_arg_tys str_marks val_args + + -- PAP: Check unlifted val_args + args_hnf = all2Prefix check_arg val_arg_tys val_args + + fun_ty = idType id + val_arg_tys = mapMaybe anonPiTyBinderType_maybe (collectPiTyBinders fun_ty) + -- val_arg_tys = map exprType val_args, but much less costly. + -- The obvious definition regresses T16577 by 30% so we don't do it. + + check_arg a_ty a + | mightBeUnliftedType a_ty = is_hnf_like a + | otherwise = True + -- Check unliftedness; for example f (x /# 12#) where f has arity two, + -- and the first argument is unboxed. This is not a value! + -- But f 34# is a value, so check args for HNFs. + -- NB: We check arity (and CONLIKEness) first because it's cheaper + -- and we reject quickly on saturated apps. + check_field a_ty str a + | mightBeUnliftedType a_ty = is_hnf_like a + | isMarkedStrict str = is_hnf_like a + | otherwise = True + -- isMarkedStrict: Respect Note [Strict fields in Core] + + mb_str_marks id + | Just dc <- isDataConWorkId_maybe id + , not (isLazyDataConRep dc) + = Just (dataConRepStrictness dc) + | otherwise + = Nothing + +{-# INLINE exprIsHNFlike #-} + {- Note [exprIsHNF Tick] ~~~~~~~~~~~~~~~~~~~~~ @@ -2233,6 +2297,58 @@ regarded as HNF if the expression they surround is HNF, because the tick is there to tell us that the expression was evaluated, so we don't want to discard a seq on it. + +Note [exprIsHNF for function applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider an application with an Id head where the argument is a redex: + + f + +Is this expression a value? + +The answer depends on the type of `f`, its arity and whether or not it is a +strict data constructor. The decision diagram is as follows: + +* If is unlifted, it is *not* a value (regardless of arity!) +* Otherwise, is lifted. + Does its `idArity` (a lower bound on the actual arity) + exceed the number of actual arguments (= 1)? + * If so, it is a PAP and thus a value + * If not, it is a saturated call. + Is it a lazy data constructor? Then it is a value. + Is it a strict data constructor? Then it is *not* a value. (See also Note [Strict fields in Core].) + Otherwise, it is a regular, possibly saturated function call, and hence *not* a value. + +The code in exprIsHNF is tweaked for efficiency, hence it delays the +unliftedness check after the arity check. + +Here are a few examples (enshrined in testcase AppIsHNF) to bring home this +point. Let us say that + + f :: Int# -> Int -> Int -> Int, with idArity 3 + expensive# :: Int -> Int# -- unlifted result + expensive :: Int -> Int -- lifted result + data T where + K1 :: !Int -> Int -> T -- strict field + K2 :: Int# -> Int -> T -- unlifted field + +Now consider + + f (expensive# 1) 2 -- Not HNF + f 1# (expensive 2) -- HNF + + K1 1 (expensive 2) -- HNF + K1 (expensive 1) 2 -- Not HNF + K1 (expensive 1) -- HNF (!) + + K2 1# (expensive 1) -- HNF + K2 (expensive# 1) 2 -- Not HNF + K2 (expensive# 1) -- Not HNF (!) + +Note that the cases marked (!) exemplify that strict fields are different to +unlifted fields when considering partial applications: Unlifted fields are +evaluated eagerly whereas evaluation of strict fields is delayed until the call +is saturated. -} -- | Can we bind this 'CoreExpr' at the top level? @@ -2404,11 +2520,10 @@ -- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool -eqTickish env (Breakpoint lext lid lids lmod) (Breakpoint rext rid rids rmod) +eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids) = lid == rid && map (rnOccL env) lids == map (rnOccR env) rids && - lext == rext && - lmod == rmod + lext == rext eqTickish _ l r = l == r -- | Finds differences between core bindings, see @diffExpr@. @@ -2608,11 +2723,16 @@ -- | If @normSplitTyConApp_maybe _ ty = Just (tc, tys, co)@ -- then @ty |> co = tc tys@. It's 'splitTyConApp_maybe', but looks through -- coercions via 'topNormaliseType_maybe'. Hence the \"norm\" prefix. +-- +-- Postcondition: tc is not a newtype (guaranteed by topNormaliseType_maybe) normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion) normSplitTyConApp_maybe fam_envs ty | let Reduction co ty1 = topNormaliseType_maybe fam_envs ty `orElse` (mkReflRedn Representational ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 + , not (isNewTyCon tc) -- How can tc be a newtype, after `topNormaliseType`? + -- Answer: if it is a recursive newtype, `topNormaliseType` + -- may be a no-op. Example: tc226 = Just (tc, tc_args, co) normSplitTyConApp_maybe _ _ = Nothing @@ -2780,7 +2900,7 @@ The downside is that the caller of $wfoo potentially has to evaluate `y` once if we can't prove it isn't already evaluated. But y coming out of a strict field is in WHNF so safe to evaluated. And most of the time it will be properly tagged+evaluated -already at the call site because of the Strict Field Invariant! See Note [Strict Field Invariant] for more in this. +already at the call site because of the EPT Invariant! See Note [EPT enforcement] for more in this. This makes GHC itself around 1% faster despite doing slightly more work! So this is generally quite good. We only apply this when we think there is a benefit in doing so however. There are a number of cases in which @@ -2873,7 +2993,7 @@ 5) Functions -Functions are tricky (see Note [TagInfo of functions] in InferTags). +Functions are tricky (see Note [TagInfo of functions] in EnforceEpt). But the gist of it even if we make a higher order function argument strict we can't avoid the tag check when it's used later in the body. So there is no benefit. @@ -2905,7 +3025,7 @@ -- See Note [Which Ids should be strictified] point 2) , mightBeLiftedType ty -- Functions sometimes get a zero tag so we can't eliminate the tag check. - -- See Note [TagInfo of functions] in InferTags. + -- See Note [TagInfo of functions] in EnforceEpt. -- See Note [Which Ids should be strictified] point 5) , not $ isFunTy ty -- If the var is strict already a seq is redundant. diff --git a/GHC/CoreToIface.hs b/GHC/CoreToIface.hs --- a/GHC/CoreToIface.hs +++ b/GHC/CoreToIface.hs @@ -43,16 +43,13 @@ , toIfaceVar -- * Other stuff , toIfaceLFInfo - -- * CgBreakInfo - , dehydrateCgBreakInfo + , toIfaceBooleanFormula ) where import GHC.Prelude import GHC.StgToCmm.Types -import GHC.ByteCode.Types - import GHC.Core import GHC.Core.TyCon hiding ( pprPromotionQuote ) import GHC.Core.Coercion.Axiom @@ -62,13 +59,14 @@ import GHC.Core.PatSyn import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCo.Tidy ( tidyCo ) +import GHC.Core.TyCo.Tidy import GHC.Builtin.Types.Prim ( eqPrimTyCon, eqReprPrimTyCon ) import GHC.Builtin.Types ( heqTyCon ) import GHC.Iface.Syntax import GHC.Data.FastString +import GHC.Data.BooleanFormula qualified as BF(BooleanFormula(..)) import GHC.Types.Id import GHC.Types.Id.Info @@ -82,11 +80,14 @@ import GHC.Types.Tickish import GHC.Types.Demand ( isNopSig ) import GHC.Types.Cpr ( topCprSig ) +import GHC.Types.SrcLoc (unLoc) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc +import GHC.Hs.Extension (GhcRn) + import Data.Maybe ( isNothing, catMaybes ) {- Note [Avoiding space leaks in toIface*] @@ -430,7 +431,7 @@ toIfaceBang _ (HsStrict _) = IfStrict toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang -toIfaceSrcBang (HsSrcBang _ (HsBang unpk bang)) = IfSrcBang unpk bang +toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang toIfaceLetBndr :: Id -> IfaceLetBndr toIfaceLetBndr id = IfLetBndr (mkIfLclName (occNameFS (getOccName id))) @@ -537,6 +538,14 @@ , isStableSource src = IfWhen arity unsat_ok boring_ok | otherwise = IfNoGuidance +toIfaceBooleanFormula :: BF.BooleanFormula GhcRn -> IfaceBooleanFormula +toIfaceBooleanFormula = go + where + go (BF.Var nm ) = IfVar $ mkIfLclName . getOccFS . unLoc $ nm + go (BF.And bfs ) = IfAnd $ map (go . unLoc) bfs + go (BF.Or bfs ) = IfOr $ map (go . unLoc) bfs + go (BF.Parens bf) = IfParens $ (go . unLoc) bf + {- ************************************************************************ * * @@ -573,8 +582,8 @@ toIfaceTickish (HpcTick modl ix) = IfaceHpcTick modl ix toIfaceTickish (SourceNote src (LexicalFastString names)) = IfaceSource src names -toIfaceTickish (Breakpoint _ ix fv m) = - IfaceBreakpoint ix (toIfaceVar <$> fv) m +toIfaceTickish (Breakpoint _ ix fv) = + IfaceBreakpoint ix (toIfaceVar <$> fv) --------------------- toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr @@ -689,16 +698,7 @@ LFLetNoEscape -> panic "toIfaceLFInfo: LFLetNoEscape" --- Dehydrating CgBreakInfo -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo -dehydrateCgBreakInfo ty_vars idOffSets tick_ty = - CgBreakInfo - { cgb_tyvars = map toIfaceTvBndr ty_vars - , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets - , cgb_resty = toIfaceType tick_ty - } - {- Note [Inlining and hs-boot files] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this example (#10083, #12789): @@ -785,9 +785,9 @@ * When creating the interface, check the criteria above and don't serialise the RHS if such a case. - See -* When reading an interface, look at the realIdUnfolding, and then the unfoldingTemplate. - See `tc_iface_binding` for where this happens. + +* When reading an interface, look at the realIdUnfolding, and then the + maybeUnfoldingTemplate. See `tc_iface_binding` for where this happens. There are two main reasons why the mi_extra_decls field exists rather than shoe-horning all the core bindings diff --git a/GHC/CoreToStg.hs b/GHC/CoreToStg.hs --- a/GHC/CoreToStg.hs +++ b/GHC/CoreToStg.hs @@ -221,6 +221,22 @@ -- (For the gory details, see also the (unpublished) paper, “Practical -- aspects of evidence-based compilation in System FC.”) +-- Note [Saturation of data constructors in STG] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We guarantee that `StgConApp` is an exactly-saturated application of a data +-- constructor worker. +-- +-- * If the data constructor is /under/-saturated we just fall through to build +-- a `StgApp`. Remember, data constructor workers have a regular top-level definition +-- (injected by GHC.CoreToStg.Prep.mkDataConWorkers) so we can partially apply +-- that function. +-- +-- * If the data constructor is /over/-saturated, which can happen (see #23865) we again +-- fall through to `StgApp`. That will fail horribly at runtime (by applying data +-- constructor to an argument) but it should be in dead code, and at least the compiler +-- itself won't crash. (We could inject an error-thunk instead.) + + -- -------------------------------------------------------------- -- Setting variable info: top-level, binds, RHSs -- -------------------------------------------------------------- @@ -388,24 +404,25 @@ -- CorePrep should have converted them all to a real core representation. coreToStgExpr (Lit (LitNumber LitNumBigNat _)) = panic "coreToStgExpr: LitNumBigNat" coreToStgExpr (Lit l) = return (StgLit l) -coreToStgExpr (Var v) = coreToStgApp v [] [] +coreToStgExpr (Var v) = coreToStgApp v [] [] (idType v) coreToStgExpr (Coercion _) -- See Note [Coercion tokens] - = coreToStgApp coercionTokenId [] [] + = coreToStgApp coercionTokenId [] [] (idType coercionTokenId) coreToStgExpr expr@(App _ _) = case app_head of - Var f -> coreToStgApp f args ticks -- Regular application - Lit l | isLitRubbish l -- If there is LitRubbish at the head, - -- discard the arguments - -- Recompute representation, because in - -- '(RUBBISH[rep] x) :: (T :: TYPE rep2)' - -- rep might not be equal to rep2 - -> return (StgLit $ LitRubbish TypeLike $ getRuntimeRep (exprType expr)) + Var f -> coreToStgApp f args ticks res_ty -- Regular application + Lit l | isLitRubbish l -- Discard arguments if head is LitRubbish + -- Recompute representation, because in + -- '(RUBBISH[rep] x) :: (T :: TYPE rep2)' + -- rep might not be equal to rep2 + -> return (StgLit $ LitRubbish TypeLike $ getRuntimeRep res_ty) _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) where - (app_head, args, ticks) = myCollectArgs expr + res_ty = exprType expr + (app_head, args, ticks) = myCollectArgs expr res_ty + coreToStgExpr expr@(Lam _ _) = let (args, body) = myCollectBinders expr @@ -508,58 +525,61 @@ coreToStgApp :: Id -- Function -> [CoreArg] -- Arguments - -> [CoreTickish] -- Debug ticks + -> [StgTickish] -- From the application nodes + -> Type -- Type of the whole application -> CtsM StgExpr -coreToStgApp f args ticks = do - (args', ticks') <- coreToStgArgs args - how_bound <- lookupVarCts f - - let - n_val_args = valArgCount args - - -- Mostly, the arity info of a function is in the fn's IdInfo - -- But new bindings introduced by CoreSat may not have no - -- arity info; it would do us no good anyway. For example: - -- let f = \ab -> e in f - -- No point in having correct arity info for f! - -- Hence the hasArity stuff below. - -- NB: f_arity is only consulted for LetBound things - f_arity = stgArity f how_bound - saturated = f_arity <= n_val_args +coreToStgApp f core_args app_ticks res_ty + = do { how_bound <- lookupVarCts f + ; (stg_args, arg_ticks) <- coreToStgArgs core_args + ; let app = mkStgApp f how_bound core_args stg_args res_ty + all_ticks = app_ticks ++ arg_ticks - res_ty = exprType (mkApps (Var f) args) - app = case idDetails f of - DataConWorkId dc - | saturated -> if isUnboxedSumDataCon dc then - StgConApp dc NoNumber args' (sumPrimReps args) - else - StgConApp dc NoNumber args' [] + -- Forcing these fixes a leak in the code generator, + -- noticed while profiling for #4367 + ; app `seq` return (foldr add_tick app all_ticks)} + where + add_tick !t !e = StgTick t e - -- Some primitive operator that might be implemented as a library call. - -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps - -- we require that primop applications be saturated. - PrimOpId op _ -> -- assertPpr saturated (ppr f <+> ppr args) $ - StgOpApp (StgPrimOp op) args' res_ty +mkStgApp :: Id -> HowBound -> [CoreArg] -> [StgArg] -> Type -> StgExpr +mkStgApp f how_bound core_args stg_args res_ty + = case idDetails f of + DataConWorkId dc + | exactly_saturated -- See Note [Saturation of data constructors in STG] + -> if isUnboxedSumDataCon dc then + StgConApp dc NoNumber stg_args (sumPrimReps core_args) + else + StgConApp dc NoNumber stg_args [] - -- A call to some primitive Cmm function. - FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) - PrimCallConv _)) - -> assert saturated $ - StgOpApp (StgPrimCallOp (PrimCall lbl pkgId)) args' res_ty + -- Some primitive operator that might be implemented as a library call. + -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps + -- we require that primop applications be saturated. + PrimOpId op _ -> -- assertPpr saturated (ppr f <+> ppr stg_args) $ + StgOpApp (StgPrimOp op) stg_args res_ty - -- A regular foreign call. - FCallId call -> assert saturated $ - StgOpApp (StgFCallOp call (idType f)) args' res_ty + -- A call to some primitive Cmm function. + FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) + PrimCallConv _)) + -> assert exactly_saturated $ + StgOpApp (StgPrimCallOp (PrimCall lbl pkgId)) stg_args res_ty - TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args') - _other -> StgApp f args' + -- A regular foreign call. + FCallId call -> assert exactly_saturated $ + StgOpApp (StgFCallOp call (idType f)) stg_args res_ty - add_tick !t !e = StgTick t e - tapp = foldr add_tick app (map (coreToStgTick res_ty) ticks ++ ticks') + TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,stg_args) - -- Forcing these fixes a leak in the code generator, noticed while - -- profiling for #4367 - app `seq` return tapp + _other -> StgApp f stg_args + where + -- Mostly, the arity info of a function is in the fn's IdInfo + -- But new bindings introduced by CoreSat may not have no + -- arity info; it would do us no good anyway. For example: + -- let f = \ab -> e in f + -- No point in having correct arity info for f! + -- Hence the hasArity stuff below. + -- NB: f_arity is only consulted for LetBound things + f_arity = stgArity f how_bound + n_val_args = length stg_args -- StgArgs are all value arguments + exactly_saturated = f_arity == n_val_args -- Given Core arguments to an unboxed sum datacon, return the 'PrimRep's @@ -624,10 +644,10 @@ coreToStgTick :: Type -- type of the ticked expression -> CoreTickish -> StgTickish -coreToStgTick _ty (HpcTick m i) = HpcTick m i -coreToStgTick _ty (SourceNote span nm) = SourceNote span nm -coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope -coreToStgTick !ty (Breakpoint _ bid fvs modl) = Breakpoint ty bid fvs modl +coreToStgTick _ty (HpcTick m i) = HpcTick m i +coreToStgTick _ty (SourceNote span nm) = SourceNote span nm +coreToStgTick _ty (ProfNote cc cnt scope) = ProfNote cc cnt scope +coreToStgTick !ty (Breakpoint _ bid fvs) = Breakpoint ty bid fvs -- --------------------------------------------------------------------------- -- The magic for lets: @@ -809,17 +829,28 @@ -- INVARIANT: If the app head is trivial, return the atomic Var/Lit that was -- wrapped in casts, empty case, ticks, etc. -- So keep in sync with 'exprIsTrivial'. -myCollectArgs :: HasDebugCallStack => CoreExpr -> (CoreExpr, [CoreArg], [CoreTickish]) -myCollectArgs expr +myCollectArgs :: HasDebugCallStack + => CoreExpr -> Type -> (CoreExpr, [CoreArg], [StgTickish]) +myCollectArgs expr res_ty = go expr [] [] where - go h@(Var _v) as ts = (h, as, ts) - go (App f a) as ts = go f (a:as) ts - go (Tick t e) as ts = assertPpr (not (tickishIsCode t) || all isTypeArg as) - (ppr e $$ ppr as $$ ppr ts) $ - -- See Note [Ticks in applications] - go e as (t:ts) -- ticks can appear in type apps - go (Cast e _) as ts = go e as ts + go h@(Var f) as ts + | isUnaryClassId f, (the_arg:as') <- dropWhile isTypeArg as + = go the_arg as' ts + -- See (UCM1) in Note [Unary class magic] in GHC.Core.TyCon + -- isUnaryClassId includes both the class op and the data-con + + | otherwise + = (h, as, ts) + + go (App f a) as ts = go f (a:as) ts + go (Cast e _) as ts = go e as ts + go (Tick t e) as ts = assertPpr (not (tickishIsCode t) || all isTypeArg as) + (ppr e $$ ppr as $$ ppr ts) $ + -- See Note [Ticks in applications] + -- ticks can appear in type apps + go e as (coreToStgTick res_ty t : ts) + go (Case e b _ alts) as ts -- Just like in exprIsTrivial! -- Otherwise we fall over in case we encounter -- `(case f a of {}) b` in the future. @@ -828,9 +859,12 @@ go e [] ts -- NB: Empty case discards arguments | Just rhs <- isUnsafeEqualityCase e b alts = go rhs as ts -- Discards unsafeCoerce in App heads - go (Lam b e) as ts - | isTyVar b = go e (drop 1 as) ts -- Note [Collect args] - go e as ts = (e, as, ts) + + go (Lam b e) as ts + | isTyVar b + = go e (drop 1 as) ts -- Note [Collect args] + + go e as ts = (e, as, ts) {- Note [Collect args] ~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/CoreToStg/AddImplicitBinds.hs b/GHC/CoreToStg/AddImplicitBinds.hs new file mode 100644 --- /dev/null +++ b/GHC/CoreToStg/AddImplicitBinds.hs @@ -0,0 +1,151 @@ +{- +(c) The University of Glasgow, 1994-2006 + +Add implicit bindings +-} + +module GHC.CoreToStg.AddImplicitBinds ( addImplicitBinds ) where + +import GHC.Prelude + +import GHC.CoreToStg.Prep( CorePrepPgmConfig(..) ) + +import GHC.Unit( ModLocation(..) ) + +import GHC.Core +import GHC.Core.DataCon( DataCon, dataConWorkId, dataConWrapId ) +import GHC.Core.TyCon( TyCon, tyConDataCons, isBoxedDataTyCon, tyConClass_maybe ) +import GHC.Core.Class( classAllSelIds ) + +import GHC.Types.Name +import GHC.Types.Tickish( GenTickish( SourceNote ) ) +import GHC.Types.Id( dataConWrapUnfolding_maybe ) +import GHC.Types.Id.Make( mkDictSelRhs ) +import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) + +import GHC.Utils.Outputable +import GHC.Data.FastString + + +{- ********************************************************************* +* * + Implicit bindings +* * +********************************************************************* -} + +{- Note [Injecting implicit bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`addImplicitBinds` injects the so-called "implicit bindings" generated by +the TyCons of the module. Specifically: + + * Data constructor wrappers + * Data constructor workers: see Note [Data constructor workers] + * Class op selectors: we want curriedn versions of these too + +Note that /record selector/ are injected much earlier, at the beginning +of the pipeline -- see Note [Record selectors] in GHC.Tc.TyCl.Utils. + +At one time I tried injecting the implicit bindings *early*, at the +beginning of SimplCore. But that gave rise to real difficulty, +because GlobalIds are supposed to have *fixed* IdInfo, but the +simplifier and other core-to-core passes mess with IdInfo all the +time. The straw that broke the camels back was when a class selector +got the wrong arity -- ie the simplifier gave it arity 2, whereas +importing modules were expecting it to have arity 1 (#2844). +It's much safer just to inject them right at the end, after tidying. + +Oh: two other reasons for injecting them late: + + - If implicit Ids are already in the bindings when we start tidying, + we'd have to be careful not to treat them as external Ids (in + the sense of chooseExternalIds); else the Ids mentioned in *their* + RHSs will be treated as external and you get an interface file + saying a18 = + but nothing referring to a18 (because the implicit Id is the + one that does, and implicit Ids don't appear in interface files). + + - More seriously, the tidied type-envt will include the implicit + Id replete with a18 in its unfolding; but we won't take account + of a18 when computing a fingerprint for the class; result chaos. + +Note [Data constructor workers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Create any necessary "implicit" bindings for data con workers. We +create the rather strange (non-recursive!) binding + + $wC = \x y -> $wC x y + +i.e. a curried constructor that allocates. This means that we can +treat the worker for a constructor like any other function in the rest +of the compiler. The point here is that CoreToStg will generate a +StgConApp for the RHS, rather than a call to the worker (which would +give a loop). As Lennart says: the ice is thin here, but it works. + +Hmm. Should we create bindings for dictionary constructors? They are +always fully applied, and the bindings are just there to support +partial applications. But it's easier to let them through. +-} + + +addImplicitBinds :: CorePrepPgmConfig -> ModLocation + -> [TyCon] -> CoreProgram -> IO CoreProgram +addImplicitBinds pgm_cfg mod_loc tycons binds + = return (implicit_binds ++ binds) + where + gen_debug_info = cpPgm_generateDebugInfo pgm_cfg + implicit_binds = concatMap (mkImplicitBinds gen_debug_info mod_loc) tycons + + +mkImplicitBinds :: Bool -> ModLocation -> TyCon -> [CoreBind] +-- See Note [Data constructor workers] +-- c.f. Note [Injecting implicit bindings] in GHC.Iface.Tidy +mkImplicitBinds gen_debug_info mod_loc tycon + = classop_binds ++ datacon_binds + where + datacon_binds + | isBoxedDataTyCon tycon + = concatMap (dataConBinds gen_debug_info mod_loc) (tyConDataCons tycon) + | otherwise + = [] + -- The 'otherwise' includes family TyCons of course, but also (less obviously) + -- * Newtypes: see Note [Compulsory newtype unfolding] in GHC.Types.Id.Make + -- * type data: we don't want any code for type-only stuff (#24620) + + classop_binds + | Just cls <- tyConClass_maybe tycon + = [ NonRec op (mkDictSelRhs cls val_index) + | (op, val_index) <- classAllSelIds cls `zip` [0..] ] + | otherwise + = [] + +dataConBinds :: Bool -> ModLocation -> DataCon -> [CoreBind] +dataConBinds gen_debug_info mod_loc data_con + = wrapper_bind ++ worker_bind + where + work_id = dataConWorkId data_con + wrap_id = dataConWrapId data_con + worker_bind = [NonRec work_id (add_tick (Var work_id))] + -- worker_bind: the ice is thin here, but it works: + -- CorePrep will eta-expand it + wrapper_bind = case dataConWrapUnfolding_maybe wrap_id of + Nothing -> [] + Just rhs -> [NonRec wrap_id rhs] + add_tick = tick_it gen_debug_info mod_loc (getName data_con) + +tick_it :: Bool -> ModLocation -> Name -> CoreExpr -> CoreExpr +-- If we want to generate debug info, we put a source note on the +-- worker. This is useful, especially for heap profiling. +tick_it generate_debug_info mod_loc name + | not generate_debug_info = id + | RealSrcSpan span _ <- nameSrcSpan name = tick span + | Just file <- ml_hs_file mod_loc = tick (span1 file) + | otherwise = tick (span1 "???") + where + tick span = Tick $ SourceNote span $ + LexicalFastString $ mkFastString $ + renderWithContext defaultSDocContext $ ppr name + span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 + + + + diff --git a/GHC/CoreToStg/Prep.hs b/GHC/CoreToStg/Prep.hs --- a/GHC/CoreToStg/Prep.hs +++ b/GHC/CoreToStg/Prep.hs @@ -1,7 +1,5 @@ {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The University of Glasgow, 1994-2006 @@ -61,8 +59,8 @@ import GHC.Types.Id.Info import GHC.Types.Id.Make ( realWorldPrimId ) import GHC.Types.Basic -import GHC.Types.Name ( NamedThing(..), nameSrcSpan, isInternalName ) -import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc ) +import GHC.Types.Name ( OccName, NamedThing(..), isInternalName ) +import GHC.Types.Name.Occurrence (occNameString) import GHC.Types.Literal import GHC.Types.Tickish import GHC.Types.Unique.Supply @@ -72,6 +70,7 @@ import Data.ByteString.Builder.Prim import Control.Monad +import Data.List (intercalate) {- Note [CorePrep Overview] @@ -108,23 +107,17 @@ 7. Give each dynamic CCall occurrence a fresh unique; this is rather like the cloning step above. -8. Inject bindings for the "implicit" Ids: - * Constructor wrappers - * Constructor workers - We want curried definitions for all of these in case they - aren't inlined by some caller. - - 9. Convert bignum literals into their core representation. +8. Convert bignum literals into their core representation. -10. Uphold tick consistency while doing this: We move ticks out of +9. Uphold tick consistency while doing this: We move ticks out of (non-type) applications where we can, and make sure that we annotate according to scoping rules when floating. -11. Collect cost centres (including cost centres in unfoldings) if we're in +10. Collect cost centres (including cost centres in unfoldings) if we're in profiling mode. We have to do this here because we won't have unfoldings after this pass (see `trimUnfolding` and Note [Drop unfoldings and rules]. -12. Eliminate some magic Ids, specifically +11. Eliminate some magic Ids, specifically runRW# (\s. e) ==> e[readWorldId/s] lazy e ==> e (see Note [lazyId magic] in GHC.Types.Id.Make) noinline e ==> e @@ -242,30 +235,24 @@ corePrepPgm :: Logger -> CorePrepConfig -> CorePrepPgmConfig - -> Module -> ModLocation -> CoreProgram -> [TyCon] + -> Module -> CoreProgram -> IO CoreProgram corePrepPgm logger cp_cfg pgm_cfg - this_mod mod_loc binds data_tycons = + this_mod binds = withTiming logger (text "CorePrep"<+>brackets (ppr this_mod)) (\a -> a `seqList` ()) $ do - us <- mkSplitUniqSupply 's' let initialCorePrepEnv = mkInitialCorePrepEnv cp_cfg + us <- mkSplitUniqSupply 's' let - implicit_binds = mkDataConWorkers - (cpPgm_generateDebugInfo pgm_cfg) - mod_loc data_tycons - -- NB: we must feed mkImplicitBinds through corePrep too - -- so that they are suitably cloned and eta-expanded - - binds_out = initUs_ us $ do - floats1 <- corePrepTopBinds initialCorePrepEnv binds - floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds - return (deFloatTop (floats1 `zipFloats` floats2)) + floats = initUs_ us $ + corePrepTopBinds initialCorePrepEnv binds + binds_out = deFloatTop floats endPassIO logger (cpPgm_endPassConfig pgm_cfg) binds_out [] + return binds_out corePrepExpr :: Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr @@ -291,27 +278,11 @@ floatss <- go env' binds return (floats `zipFloats` floatss) -mkDataConWorkers :: Bool -> ModLocation -> [TyCon] -> [CoreBind] --- See Note [Data constructor workers] --- c.f. Note [Injecting implicit bindings] in GHC.Iface.Tidy -mkDataConWorkers generate_debug_info mod_loc data_tycons - = [ NonRec id (tick_it (getName data_con) (Var id)) - -- The ice is thin here, but it works - | tycon <- data_tycons, -- CorePrep will eta-expand it - data_con <- tyConDataCons tycon, - let id = dataConWorkId data_con - ] - where - -- If we want to generate debug info, we put a source note on the - -- worker. This is useful, especially for heap profiling. - tick_it name - | not generate_debug_info = id - | RealSrcSpan span _ <- nameSrcSpan name = tick span - | Just file <- ml_hs_file mod_loc = tick (span1 file) - | otherwise = tick (span1 "???") - where tick span = Tick $ SourceNote span $ - LexicalFastString $ mkFastString $ renderWithContext defaultSDocContext $ ppr name - span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1 +{- ********************************************************************* +* * + The main code +* * +********************************************************************* -} {- Note [Floating in CorePrep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -394,24 +365,6 @@ join points from nullary join points, but there's no clear benefit at this stage. -Note [Data constructor workers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Create any necessary "implicit" bindings for data con workers. We -create the rather strange (non-recursive!) binding - - $wC = \x y -> $wC x y - -i.e. a curried constructor that allocates. This means that we can -treat the worker for a constructor like any other function in the rest -of the compiler. The point here is that CoreToStg will generate a -StgConApp for the RHS, rather than a call to the worker (which would -give a loop). As Lennart says: the ice is thin here, but it works. - -Hmm. Should we create bindings for dictionary constructors? They are -always fully applied, and the bindings are just there to support -partial applications. But it's easier to let them through. - - Note [Dead code in CorePrep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Imagine that we got an input program like this (see #4962): @@ -614,12 +567,6 @@ - #14375 - #15260 - #18061 - -************************************************************************ -* * - The main code -* * -************************************************************************ -} cpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind @@ -630,11 +577,10 @@ cpeBind top_lvl env (NonRec bndr rhs) | not (isJoinId bndr) = do { (env1, bndr1) <- cpCloneBndr env bndr - ; let dmd = idDemandInfo bndr - is_unlifted = isUnliftedType (idType bndr) + ; let dmd = idDemandInfo bndr + lev = typeLevity (idType bndr) ; (floats, rhs1) <- cpePair top_lvl NonRecursive - dmd is_unlifted - env bndr1 rhs + dmd lev env bndr1 rhs -- See Note [Inlining in CorePrep] ; let triv_rhs = exprIsTrivial rhs1 env2 | triv_rhs = extendCorePrepEnvExpr env1 bndr rhs1 @@ -644,7 +590,7 @@ | otherwise = snocFloat floats new_float - new_float = mkNonRecFloat env is_unlifted bndr1 rhs1 + (new_float, _bndr2) = mkNonRecFloat env lev bndr1 rhs1 ; return (env2, floats1, Nothing) } @@ -660,7 +606,7 @@ | not (isJoinId (head bndrs)) = do { (env, bndrs1) <- cpCloneBndrs env bndrs ; let env' = enterRecGroupRHSs env bndrs1 - ; stuff <- zipWithM (cpePair top_lvl Recursive topDmd False env') + ; stuff <- zipWithM (cpePair top_lvl Recursive topDmd Lifted env') bndrs1 rhss ; let (zipManyFloats -> floats, rhss1) = unzip stuff @@ -709,18 +655,18 @@ --------------- -cpePair :: TopLevelFlag -> RecFlag -> Demand -> Bool +cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity -> CorePrepEnv -> OutId -> CoreExpr -> UniqSM (Floats, CpeRhs) -- Used for all bindings -- The binder is already cloned, hence an OutId -cpePair top_lvl is_rec dmd is_unlifted env bndr rhs +cpePair top_lvl is_rec dmd lev env0 bndr rhs = assert (not (isJoinId bndr)) $ -- those should use cpeJoinPair do { (floats1, rhs1) <- cpeRhsE env rhs -- See if we are allowed to float this stuff out of the RHS ; let dec = want_float_from_rhs floats1 rhs1 - ; (floats2, rhs2) <- executeFloatDecision dec floats1 rhs1 + ; (floats2, rhs2) <- executeFloatDecision env dec floats1 rhs1 -- Make the arity match up ; (floats3, rhs3) @@ -728,21 +674,23 @@ then return (floats2, cpeEtaExpand arity rhs2) else warnPprTrace True "CorePrep: silly extra arguments:" (ppr bndr) $ -- Note [Silly extra arguments] - (do { v <- newVar (idType bndr) - ; let float = mkNonRecFloat env False v rhs2 + (do { v <- newVar env (idType bndr) + ; let (float, v') = mkNonRecFloat env Lifted v rhs2 ; return ( snocFloat floats2 float - , cpeEtaExpand arity (Var v)) }) + , cpeEtaExpand arity (Var v')) }) -- Wrap floating ticks ; let (floats4, rhs4) = wrapTicks floats3 rhs3 ; return (floats4, rhs4) } where + env = pushBinderContext bndr env0 + arity = idArity bndr -- We must match this arity want_float_from_rhs floats rhs | isTopLevel top_lvl = wantFloatTop floats - | otherwise = wantFloatLocal is_rec dmd is_unlifted floats rhs + | otherwise = wantFloatLocal is_rec dmd lev floats rhs {- Note [Silly extra arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -766,7 +714,9 @@ -- No eta-expansion: see Note [Do not eta-expand join points] in GHC.Core.Opt.Simplify.Utils cpeJoinPair env bndr rhs = assert (isJoinId bndr) $ - do { let JoinPoint join_arity = idJoinPointHood bndr + do { let join_arity = case idJoinPointHood bndr of + JoinPoint join_arity -> join_arity + _ -> panic "cpeJoinPair" (bndrs, body) = collectNBinders join_arity rhs ; (env', bndrs') <- cpCloneBndrs env bndrs @@ -839,9 +789,9 @@ = do { body <- cpeBodyNF env expr ; return (emptyFloats, mkTick tickish' body) } where - tickish' | Breakpoint ext n fvs modl <- tickish + tickish' | Breakpoint ext bid fvs <- tickish -- See also 'substTickish' - = Breakpoint ext n (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) modl + = Breakpoint ext bid (map (getIdFromTrivialExpr . lookupCorePrepEnv env) fvs) | otherwise = tickish @@ -916,6 +866,7 @@ cpeRhsE env (Case scrut bndr ty alts) = do { (floats, scrut') <- cpeBody env scrut ; (env', bndr2) <- cpCloneBndr env bndr + ; let bndr3 = bndr2 `setIdUnfolding` evaldUnfolding ; let alts' | cp_catchNonexhaustiveCases $ cpe_config env -- Suppose the alternatives do not cover all the data constructors of the type. @@ -931,10 +882,9 @@ ; case alts'' of [Alt DEFAULT _ rhs] -- See Note [Flatten case-binds] - | let is_unlifted = isUnliftedType (idType bndr2) - , let float = mkCaseFloat is_unlifted bndr2 scrut' + | let float = mkCaseFloat bndr3 scrut' -> return (snocFloat floats float, rhs) - _ -> return (floats, Case scrut' bndr2 (cpSubstTy env ty) alts'') } + _ -> return (floats, Case scrut' bndr3 (cpSubstTy env ty) alts'') } where sat_alt env (Alt con bs rhs) = do { (env2, bs') <- cpCloneBndrs env bs @@ -968,36 +918,36 @@ cpeBody :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeBody) cpeBody env expr = do { (floats1, rhs) <- cpeRhsE env expr - ; (floats2, body) <- rhsToBody rhs + ; (floats2, body) <- rhsToBody env rhs ; return (floats1 `appFloats` floats2, body) } -------- -rhsToBody :: CpeRhs -> UniqSM (Floats, CpeBody) +rhsToBody :: CorePrepEnv -> CpeRhs -> UniqSM (Floats, CpeBody) -- Remove top level lambdas by let-binding -rhsToBody (Tick t expr) +rhsToBody env (Tick t expr) | tickishScoped t == NoScope -- only float out of non-scoped annotations - = do { (floats, expr') <- rhsToBody expr + = do { (floats, expr') <- rhsToBody env expr ; return (floats, mkTick t expr') } -rhsToBody (Cast e co) +rhsToBody env (Cast e co) -- You can get things like -- case e of { p -> coerce t (\s -> ...) } - = do { (floats, e') <- rhsToBody e + = do { (floats, e') <- rhsToBody env e ; return (floats, Cast e' co) } -rhsToBody expr@(Lam {}) -- See Note [No eta reduction needed in rhsToBody] +rhsToBody env expr@(Lam {}) -- See Note [No eta reduction needed in rhsToBody] | all isTyVar bndrs -- Type lambdas are ok = return (emptyFloats, expr) | otherwise -- Some value lambdas = do { let rhs = cpeEtaExpand (exprArity expr) expr - ; fn <- newVar (exprType rhs) + ; fn <- newVar env (exprType rhs) ; let float = Float (NonRec fn rhs) LetBound TopLvlFloatable ; return (unitFloat float, Var fn) } where (bndrs,_) = collectBinders expr -rhsToBody expr = return (emptyFloats, expr) +rhsToBody _env expr = return (emptyFloats, expr) {- Note [No eta reduction needed in rhsToBody] @@ -1169,10 +1119,9 @@ -- allocating CaseBound Floats for token and thing as needed = do { (floats1, token) <- cpeArg env topDmd token ; (floats2, thing) <- cpeBody env thing - ; case_bndr <- newVar ty + ; case_bndr <- (`setIdUnfolding` evaldUnfolding) <$> newVar env ty ; let tup = mkCoreUnboxedTuple [token, Var case_bndr] - ; let is_unlifted = False -- otherwise seq# would not type-check - ; let float = mkCaseFloat is_unlifted case_bndr thing + ; let float = mkCaseFloat case_bndr thing ; return (floats1 `appFloats` floats2 `snocFloat` float, tup) } cpe_app env (Var v) args @@ -1263,8 +1212,8 @@ rebuild_app' :: CorePrepEnv - -> [ArgInfo] -- The arguments (inner to outer) - -> CpeApp + -> [ArgInfo] -- The arguments (inner to outer); substitution not applied + -> CpeApp -- Substitution already applied -> Floats -> [Demand] -> [CoreTickish] @@ -1276,12 +1225,9 @@ rebuild_app' env (a : as) fun' floats ss rt_ticks req_depth = case a of -- See Note [Ticks and mandatory eta expansion] - _ - | not (null rt_ticks) - , req_depth <= 0 - -> - let tick_fun = foldr mkTick fun' rt_ticks - in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth + _ | not (null rt_ticks), req_depth <= 0 + -> let tick_fun = foldr mkTick fun' rt_ticks + in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth AIApp (Type arg_ty) -> rebuild_app' env as (App fun' (Type arg_ty')) floats ss rt_ticks req_depth @@ -1299,7 +1245,7 @@ (_ : ss_rest, True) -> (topDmd, ss_rest) (ss1 : ss_rest, False) -> (ss1, ss_rest) ([], _) -> (topDmd, []) - (fs, arg') <- cpeArg top_env ss1 arg + (fs, arg') <- cpeArg env ss1 arg rebuild_app' env as (App fun' arg') (fs `zipFloats` floats) ss_rest rt_ticks (req_depth-1) AICast co @@ -1494,7 +1440,6 @@ Other considered designs ------------------------ - One design that was rejected was to *require* that runRW#'s continuation be headed by a lambda. However, this proved to be quite fragile. For instance, SetLevels is very eager to float bottoming expressions. For instance given @@ -1576,10 +1521,10 @@ -> CoreArg -> UniqSM (Floats, CpeArg) cpeArg env dmd arg = do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda - ; let arg_ty = exprType arg1 - is_unlifted = isUnliftedType arg_ty - dec = wantFloatLocal NonRecursive dmd is_unlifted floats1 arg1 - ; (floats2, arg2) <- executeFloatDecision dec floats1 arg1 + ; let arg_ty = exprType arg1 + lev = typeLevity arg_ty + dec = wantFloatLocal NonRecursive dmd lev floats1 arg1 + ; (floats2, arg2) <- executeFloatDecision env dec floats1 arg1 -- Else case: arg1 might have lambdas, and we can't -- put them inside a wrapBinds @@ -1588,13 +1533,14 @@ -- see Note [ANF-ising literal string arguments] ; if exprIsTrivial arg2 then return (floats2, arg2) - else do { v <- (`setIdDemandInfo` dmd) <$> newVar arg_ty + else do { v <- (`setIdDemandInfo` dmd) <$> newVar env arg_ty -- See Note [Pin demand info on floats] ; let arity = cpeArgArity env dec floats1 arg2 arg3 = cpeEtaExpand arity arg2 -- See Note [Eta expansion of arguments in CorePrep] - ; let arg_float = mkNonRecFloat env is_unlifted v arg3 - ; return (snocFloat floats2 arg_float, varToCoreExpr v) } + ; let (arg_float, v') = mkNonRecFloat env lev v arg3 + ---; pprTraceM "cpeArg" (ppr arg1 $$ ppr dec $$ ppr arg2) + ; return (snocFloat floats2 arg_float, varToCoreExpr v') } } cpeArgArity :: CorePrepEnv -> FloatDecision -> Floats -> CoreArg -> Arity @@ -1664,7 +1610,7 @@ excess_arity = (max fn_arity mark_arity) - n_args sat_expr = cpeEtaExpand excess_arity expr applied_marks = n_args >= (length . dropWhile (not . isMarkedCbv) . - reverse . expectJust "maybeSaturate" $ (idCbvMarks_maybe fn)) + reverse . expectJust $ (idCbvMarks_maybe fn)) -- For join points we never eta-expand (See Note [Do not eta-expand join points]) -- so we assert all arguments that need to be passed cbv are visible so that the -- backend can evalaute them if required.. @@ -1824,10 +1770,10 @@ Note [Pin demand info on floats] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We pin demand info on floated lets, so that we can see the one-shot thunks. +We pin demand info on floated lets, so that we can see one-shot thunks. For example, f (g x) -where `f` uses its argument at least once, creates a Float for `y = g x` and we +where `f` uses its argument at most once, creates a Float for `y = g x` and we should better pin appropriate demand info on `y`. Note [Flatten case-binds] @@ -1838,7 +1784,7 @@ `case` out because `f` is strict.) In Prep, `cpeArg` will ANF-ise that argument, and we'll get a `FloatingBind` - Float (a = case x of y { DEFAULT -> blah }) CaseBound top_lvl + Float (a = case x of y { DEFAULT -> blah }) CaseBound top-lvl with the call `f a`. When we wrap that `Float` we will get @@ -1857,8 +1803,8 @@ into a FloatingBind of its own. This is easily done in the Case equation for `cpsRhsE`. Then our example will generate /two/ floats: - Float (y = x) CaseBound top_lvl - Float (a = blah) CaseBound top_lvl + Float (y = x) CaseBound str-ctx + Float (a = blah) CaseBound top-lvl and we'll end up with nested cases. @@ -1871,6 +1817,45 @@ and the above footwork in cpsRhsE avoids generating a nested case. +Note [Pin evaluatedness on floats] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When creating a new float `sat=e` in `mkNonRecFloat`, we propagate `sat` with an +`evaldUnfolding` if `e` is a value. + +To see why, consider a call to a CBV function, such as a DataCon worker with +*strict* fields, in an argument context, such as + + data Box a = Box !a + ... f (Box e) ... + +where `f` is *lazy* and `e` is ok-for-spec, e.g. `e = I# (x +# 1#)`. +After ANFisation, we want to get the very nice code + + case x +# 1# of x' -> + let sat = I# x' in + let sat2 = Box sat in + f sat2 + +Note that Case (2) of Note [wantFloatLocal] is in effect. That is, + + * x' is unlifted but ok-for-spec, hence floated out of the lazy arg of f + * Since x' is unlifted, `I# x'` is a value, and so `sat` can be let-bound. + * Since `sat` is a value, `Box sat` is a value as well, and so `sat2` can + be let-bound. + +Hence no thunk needs to be allocated! However, in order to recognise +`Box sat` as a value, it is crucial that the newly created `sat` has an +`evaldUnfolding`; otherwise the strict worker `Box` forces an eval on `sat`. +and we would get the far worse code + + let sat2 = + case x +# 1# of x' -> + case I# x' of sat' -> + Box sat in + f sat2 + +A live example of this is T24730, inspired by $walexGetByte. + Note [Speculative evaluation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Since call-by-value is much cheaper than call-by-need, we case-bind arguments @@ -2016,13 +2001,28 @@ Note [Controlling Speculative Evaluation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Most of the time, speculative evaluation has a positive effect on performance, -but we have found a case where speculative evaluation of dictionary functions -leads to a performance regression #25284. +Most of the time, speculative evaluation in the coreprep phase has a positive +effect on performance, however we have found that some forms of speculative +evaluation can lead to large performance regressions. See #25284. -Therefore we have some flags to control it. See the optimization section in -the User's Guide for the description of these flags and when to use them. +Therefore we have some flags to control which types of speculative evaluation +are done: + -fspec-eval + Globally enable/disable speculative evaluation ( -fno-spec-eval also turns + off all other speculative evaluation). On by default for all + optimization levels. Turning on this flag by itself should never cause + a performance regression. Please open a ticket if you find any. + + -fspec-eval-dictfun + Enable speculative evaluation for dictionary functions. Off by default + since it can cause an increase in allocations (#24284). We have no + examples that show a large performance improvement when turning on this + flag. Please open a ticket if you find any. + +Also see the optimization section in the User's Guide for the description of +these flags and when to use them. + Note [Floats and FloatDecision] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have a special datatype `Floats` for modelling a telescope of `FloatingBind` @@ -2162,62 +2162,92 @@ zipManyFloats :: [Floats] -> Floats zipManyFloats = foldr zipFloats emptyFloats -mkCaseFloat :: Bool -> Id -> CpeRhs -> FloatingBind -mkCaseFloat is_unlifted bndr scrut - = Float (NonRec bndr scrut) bound info +data FloatInfoArgs + = FIA + { fia_levity :: Levity + , fia_demand :: Demand + , fia_is_hnf :: Bool + , fia_is_triv :: Bool + , fia_is_string :: Bool + , fia_is_dc_worker :: Bool + , fia_ok_for_spec :: Bool + } + +defFloatInfoArgs :: Id -> CoreExpr -> FloatInfoArgs +defFloatInfoArgs bndr rhs + = FIA + { fia_levity = typeLevity (idType bndr) + , fia_demand = idDemandInfo bndr -- mkCaseFloat uses evalDmd + , fia_is_hnf = exprIsHNF rhs + , fia_is_triv = exprIsTrivial rhs + , fia_is_string = exprIsTickedString rhs + , fia_is_dc_worker = isJust (isDataConId_maybe bndr) -- mkCaseFloat uses False + , fia_ok_for_spec = False -- mkNonRecFloat uses exprOkForSpecEval + } + +decideFloatInfo :: FloatInfoArgs -> (BindInfo, FloatInfo) +decideFloatInfo FIA{fia_levity=lev, fia_demand=dmd, fia_is_hnf=is_hnf, + fia_is_triv=is_triv, fia_is_string=is_string, + fia_is_dc_worker=is_dc_worker, fia_ok_for_spec=ok_for_spec} + | Lifted <- lev, is_hnf, not is_triv = (LetBound, TopLvlFloatable) + -- is_lifted: We currently don't allow unlifted values at the + -- top-level or inside letrecs + -- (but SG thinks that in principle, we should) + -- is_triv: Should not turn `case x of x' ->` into `let x' = x` + -- when x is a HNF (cf. fun3 of T24264) + | is_dc_worker = (LetBound, TopLvlFloatable) + -- We need this special case for nullary unlifted DataCon + -- workers/wrappers (top-level bindings) until #17521 is fixed + | is_string = (CaseBound, TopLvlFloatable) + -- String literals are unboxed (so must be case-bound) and float to + -- the top-level + | ok_for_spec = (CaseBound, case lev of Unlifted -> LazyContextFloatable + Lifted -> TopLvlFloatable) + -- See Note [Speculative evaluation] + -- Ok-for-spec-eval things will be case-bound, lifted or not. + -- But when it's lifted we are ok with floating it to top-level + -- (where it is actually bound lazily). + | Unlifted <- lev = (CaseBound, StrictContextFloatable) + | isStrUsedDmd dmd = (CaseBound, StrictContextFloatable) + -- These will never be floated out of a lazy RHS context + | Lifted <- lev = (LetBound, TopLvlFloatable) + -- And these float freely but can't be speculated, hence LetBound + +mkCaseFloat :: Id -> CpeRhs -> FloatingBind +mkCaseFloat bndr scrut + = -- pprTrace "mkCaseFloat" (ppr bndr <+> ppr (bound,info) + -- -- <+> ppr is_lifted <+> ppr is_strict + -- -- <+> ppr ok_for_spec <+> ppr evald + -- $$ ppr scrut) $ + Float (NonRec bndr scrut) bound info where - (bound, info) -{- -Eventually we want the following code, when #20749 is fixed. - | is_lifted, is_hnf = (LetBound, TopLvlFloatable) - -- `seq# (case x of x' { __DEFAULT -> StrictBox x' }) s` should - -- let-bind `StrictBox x'` after Note [Flatten case-binds]. --} - | exprIsTickedString scrut = (CaseBound, TopLvlFloatable) - -- String literals are unboxed (so must be case-bound) and float to - -- the top-level - | otherwise = (CaseBound, StrictContextFloatable) - -- For a Case, we never want to drop the eval; hence no need to test - -- for ok-for-spec-eval - _is_lifted = not is_unlifted - _is_hnf = exprIsHNF scrut + !(bound, info) = decideFloatInfo $ (defFloatInfoArgs bndr scrut) + { fia_demand = evalDmd + -- Strict demand, so that we do not let-bind unless it's a value + , fia_is_dc_worker = False + -- DataCon worker *bindings* are never case-bound + , fia_ok_for_spec = False + -- We do not currently float around case bindings. + -- (ok-for-spec case bindings are unlikely anyway.) + } -mkNonRecFloat :: CorePrepEnv -> Bool -> Id -> CpeRhs -> FloatingBind -mkNonRecFloat env is_unlifted bndr rhs +mkNonRecFloat :: CorePrepEnv -> Levity -> Id -> CpeRhs -> (FloatingBind, Id) +mkNonRecFloat env lev bndr rhs = -- pprTrace "mkNonRecFloat" (ppr bndr <+> ppr (bound,info) - -- <+> ppr is_lifted <+> ppr is_strict - -- <+> ppr ok_for_spec + -- <+> if is_strict then text "strict" else if is_lifted then text "lazy" else text "unlifted" + -- <+> if ok_for_spec then text "ok-for-spec" else empty + -- <+> if evald then text "evald" else empty -- $$ ppr rhs) $ - Float (NonRec bndr rhs) bound info + (Float (NonRec bndr' rhs) bound info, bndr') where - (bound, info) - | is_lifted, is_hnf = (LetBound, TopLvlFloatable) - -- is_lifted: We currently don't allow unlifted values at the - -- top-level or inside letrecs - -- (but SG thinks that in principle, we should) - | is_data_con bndr = (LetBound, TopLvlFloatable) - -- We need this special case for nullary unlifted DataCon - -- workers/wrappers (top-level bindings) until #17521 is fixed - | exprIsTickedString rhs = (CaseBound, TopLvlFloatable) - -- String literals are unboxed (so must be case-bound) and float to - -- the top-level - | is_unlifted, ok_for_spec = (CaseBound, LazyContextFloatable) - | is_lifted, ok_for_spec = (CaseBound, TopLvlFloatable) - -- See Note [Speculative evaluation] - -- Ok-for-spec-eval things will be case-bound, lifted or not. - -- But when it's lifted we are ok with floating it to top-level - -- (where it is actually bound lazily). - | is_unlifted || is_strict = (CaseBound, StrictContextFloatable) - -- These will never be floated out of a lazy RHS context - | otherwise = assertPpr is_lifted (ppr rhs) $ - (LetBound, TopLvlFloatable) - -- And these float freely but can't be speculated, hence LetBound + !(bound, info) = decideFloatInfo $ (defFloatInfoArgs bndr rhs) + { fia_levity = lev + , fia_is_hnf = is_hnf + , fia_ok_for_spec = ok_for_spec + } - cfg = cpe_config env - is_lifted = not is_unlifted is_hnf = exprIsHNF rhs - dmd = idDemandInfo bndr - is_strict = isStrUsedDmd dmd + cfg = cpe_config env ok_for_spec = exprOkForSpecEval call_ok_for_spec rhs -- See Note [Controlling Speculative Evaluation] @@ -2227,8 +2257,11 @@ | not (cp_specEvalDFun cfg) && isDFunId x = False | otherwise = True is_rec_call = (`elemUnVarSet` cpe_rec_ids env) - is_data_con = isJust . isDataConId_maybe + -- See Note [Pin evaluatedness on floats] + bndr' | is_hnf = bndr `setIdUnfolding` evaldUnfolding + | otherwise = bndr + -- | Wrap floats around an expression wrapBinds :: Floats -> CpeBody -> CpeBody wrapBinds floats body @@ -2270,7 +2303,7 @@ let x = let y = e1 in e2 in e Similarly for `(\x. e) (let y = e1 in e2)`. -Do we want to float out `y` out of `x`? +Do we want to float `y` out of `x`? (This is discussed in detail in the paper "Let-floating: moving bindings to give faster programs".) @@ -2334,13 +2367,17 @@ = FloatNone | FloatAll -executeFloatDecision :: FloatDecision -> Floats -> CpeRhs -> UniqSM (Floats, CpeRhs) -executeFloatDecision dec floats rhs +instance Outputable FloatDecision where + ppr FloatNone = text "none" + ppr FloatAll = text "all" + +executeFloatDecision :: CorePrepEnv -> FloatDecision -> Floats -> CpeRhs -> UniqSM (Floats, CpeRhs) +executeFloatDecision env dec floats rhs = case dec of FloatAll -> return (floats, rhs) FloatNone | isEmptyFloats floats -> return (emptyFloats, rhs) - | otherwise -> do { (floats', body) <- rhsToBody rhs + | otherwise -> do { (floats', body) <- rhsToBody env rhs ; return (emptyFloats, wrapBinds floats $ wrapBinds floats' body) } -- FloatNone case: `rhs` might have lambdas, and we can't @@ -2351,12 +2388,12 @@ | fs_info fs `floatsAtLeastAsFarAs` TopLvlFloatable = FloatAll | otherwise = FloatNone -wantFloatLocal :: RecFlag -> Demand -> Bool -> Floats -> CpeRhs -> FloatDecision +wantFloatLocal :: RecFlag -> Demand -> Levity -> Floats -> CpeRhs -> FloatDecision -- See Note [wantFloatLocal] -wantFloatLocal is_rec rhs_dmd rhs_is_unlifted floats rhs +wantFloatLocal is_rec rhs_dmd rhs_lev floats rhs | isEmptyFloats floats -- Well yeah... || isStrUsedDmd rhs_dmd -- Case (1) of Note [wantFloatLocal] - || rhs_is_unlifted -- dito + || rhs_lev == Unlifted -- dito || (fs_info floats `floatsAtLeastAsFarAs` max_float_info && exprIsHNF rhs) -- Case (2) of Note [wantFloatLocal] = FloatAll @@ -2479,6 +2516,8 @@ , cpe_subst :: Subst -- ^ See Note [CorePrepEnv: cpe_subst] , cpe_rec_ids :: UnVarSet -- Faster OutIdSet; See Note [Speculative evaluation] + + , cpe_context :: [OccName] -- ^ See Note [Binder context] } mkInitialCorePrepEnv :: CorePrepConfig -> CorePrepEnv @@ -2486,6 +2525,7 @@ { cpe_config = cfg , cpe_subst = emptySubst , cpe_rec_ids = emptyUnVarSet + , cpe_context = [] } extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv @@ -2526,6 +2566,14 @@ cpSubstCo (CPE { cpe_subst = subst }) co = substCo subst co -- substCo has a short-cut if the TCvSubst is empty +-- | See Note [Binder context] +pushBinderContext :: Id -> CorePrepEnv -> CorePrepEnv +pushBinderContext ident env + | lengthAtLeast (cpe_context env) 2 + = env + | otherwise + = env { cpe_context = getOccName ident : cpe_context env} + ------------------------------------------------------------------------------ -- Cloning binders -- --------------------------------------------------------------------------- @@ -2614,10 +2662,20 @@ -- Generating new binders -- --------------------------------------------------------------------------- -newVar :: Type -> UniqSM Id -newVar ty - = seqType ty `seq` mkSysLocalOrCoVarM (fsLit "sat") ManyTy ty +newVar :: CorePrepEnv -> Type -> UniqSM Id +newVar env ty + -- See Note [Binder context] + = seqType ty `seq` mkSysLocalOrCoVarM (fsLit occ) ManyTy ty + where occ = intercalate "_" (map occNameString $ cpe_context env) ++ "_sat" +{- Note [Binder context] + ~~~~~~~~~~~~~~~~~~~~~ + To ensure that the compiled program (specifically symbol names) + remains understandable to the user we maintain a context + of binders that we are currently under. This allows us to give + identifiers conjured during CorePrep more contextually-meaningful + names. This is done in `newVar`. + -} ------------------------------------------------------------------------------ -- Floating ticks @@ -2689,7 +2747,7 @@ let platform = cp_platform (cpe_config env) - -- Per the documentation in GHC.Num.BigNat, a BigNat# is: + -- Per the documentation in GHC.Internal.Bignum.BigNat, a BigNat# is: -- "Represented as an array of limbs (Word#) stored in -- little-endian order (Word# themselves use machine order)." -- @@ -2750,7 +2808,7 @@ let litAddrRhs = Lit (LitString words) -- not "mkLitString"; that does UTF-8 encoding, which we don't want here - litAddrFloat = mkNonRecFloat env True litAddrId litAddrRhs + (litAddrFloat, litAddrId') = mkNonRecFloat env Unlifted litAddrId litAddrRhs contentsLength = mkIntLit platform (toInteger (BS.length words)) @@ -2763,7 +2821,7 @@ copyContentsCall = Var (primOpId CopyAddrToByteArrayOp) `App` Type realWorldTy - `App` Var litAddrId + `App` Var litAddrId' `App` Var mutableByteArrayId `App` mkIntLit platform 0 `App` contentsLength diff --git a/GHC/Data/Bag.hs b/GHC/Data/Bag.hs --- a/GHC/Data/Bag.hs +++ b/GHC/Data/Bag.hs @@ -16,7 +16,7 @@ mapBag, pprBag, elemBag, lengthBag, filterBag, partitionBag, partitionBagWith, - concatBag, catBagMaybes, foldBag, + concatBag, catBagMaybes, foldBag_flip, isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag, listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL, concatMapBag, concatMapBagPair, mapMaybeBag, mapMaybeBagM, unzipBag, @@ -194,24 +194,10 @@ partitionBagWith pred (ListBag vs) = (listToBag sats, listToBag fails) where (sats, fails) = partitionWith pred (toList vs) -foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative - -> (a -> r) -- Replace UnitBag with this - -> r -- Replace EmptyBag with this - -> Bag a - -> r - -{- Standard definition -foldBag t u e EmptyBag = e -foldBag t u e (UnitBag x) = u x -foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2) -foldBag t u e (ListBag xs) = foldr (t.u) e xs --} - --- More tail-recursive definition, exploiting associativity of "t" -foldBag _ _ e EmptyBag = e -foldBag t u e (UnitBag x) = u x `t` e -foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1 -foldBag t u e (ListBag xs) = foldr (t.u) e xs +foldBag_flip :: (a -> b -> b) -> Bag a -> b -> b +-- Just foldr with flipped arguments, +-- so it can be chained more nicely +foldBag_flip k bag z = foldr k z bag mapBag :: (a -> b) -> Bag a -> Bag b mapBag = fmap diff --git a/GHC/Data/BooleanFormula.hs b/GHC/Data/BooleanFormula.hs --- a/GHC/Data/BooleanFormula.hs +++ b/GHC/Data/BooleanFormula.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveTraversable #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeFamilies #-} -------------------------------------------------------------------------------- -- | Boolean formulas without quantifiers and without negation. @@ -8,75 +9,64 @@ -- This module is used to represent minimal complete definitions for classes. -- module GHC.Data.BooleanFormula ( - BooleanFormula(..), LBooleanFormula, - mkFalse, mkTrue, mkAnd, mkOr, mkVar, + module Language.Haskell.Syntax.BooleanFormula, isFalse, isTrue, + bfMap, bfTraverse, eval, simplify, isUnsatisfied, implies, impliesAtom, - pprBooleanFormula, pprBooleanFormulaNice + pprBooleanFormula, pprBooleanFormulaNice, pprBooleanFormulaNormal ) where -import GHC.Prelude hiding ( init, last ) - -import Data.List ( nub, intersperse ) +import Data.List ( intersperse ) import Data.List.NonEmpty ( NonEmpty (..), init, last ) -import Data.Data -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Parser.Annotation ( LocatedL ) -import GHC.Types.SrcLoc +import GHC.Prelude hiding ( init, last ) import GHC.Types.Unique import GHC.Types.Unique.Set +import GHC.Types.SrcLoc (unLoc) +import GHC.Utils.Outputable +import GHC.Parser.Annotation ( SrcSpanAnnL ) +import GHC.Hs.Extension (GhcPass (..), OutputableBndrId) +import Language.Haskell.Syntax.Extension (Anno, LIdP, IdP) +import Language.Haskell.Syntax.BooleanFormula + ---------------------------------------------------------------------- -- Boolean formula type and smart constructors ---------------------------------------------------------------------- -type LBooleanFormula a = LocatedL (BooleanFormula a) - -data BooleanFormula a = Var a | And [LBooleanFormula a] | Or [LBooleanFormula a] - | Parens (LBooleanFormula a) - deriving (Eq, Data, Functor, Foldable, Traversable) - -mkVar :: a -> BooleanFormula a -mkVar = Var - -mkFalse, mkTrue :: BooleanFormula a -mkFalse = Or [] -mkTrue = And [] +type instance Anno (BooleanFormula (GhcPass p)) = SrcSpanAnnL --- Convert a Bool to a BooleanFormula -mkBool :: Bool -> BooleanFormula a -mkBool False = mkFalse -mkBool True = mkTrue +-- if we had Functor/Traversable (LbooleanFormula p) we could use that +-- as a constraint and we wouldn't need to specialize to just GhcPass p, +-- but becuase LBooleanFormula is a type synonym such a constraint is +-- impossible. --- Make a conjunction, and try to simplify -mkAnd :: Eq a => [LBooleanFormula a] -> BooleanFormula a -mkAnd = maybe mkFalse (mkAnd' . nub) . concatMapM fromAnd +-- BooleanFormula can't be an instance of functor because it can't lift +-- arbitrary functions `a -> b`, only functions of type `LIdP a -> LIdP b` +-- ditto for Traversable. +bfMap :: (LIdP (GhcPass p) -> LIdP (GhcPass p')) + -> BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p') +bfMap f = go where - -- See Note [Simplification of BooleanFormulas] - fromAnd :: LBooleanFormula a -> Maybe [LBooleanFormula a] - fromAnd (L _ (And xs)) = Just xs - -- assume that xs are already simplified - -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs - fromAnd (L _ (Or [])) = Nothing - -- in case of False we bail out, And [..,mkFalse,..] == mkFalse - fromAnd x = Just [x] - mkAnd' [x] = unLoc x - mkAnd' xs = And xs + go (Var a ) = Var $ f a + go (And bfs) = And $ map (fmap go) bfs + go (Or bfs) = Or $ map (fmap go) bfs + go (Parens bf ) = Parens $ fmap go bf -mkOr :: Eq a => [LBooleanFormula a] -> BooleanFormula a -mkOr = maybe mkTrue (mkOr' . nub) . concatMapM fromOr +bfTraverse :: Applicative f + => (LIdP (GhcPass p) -> f (LIdP (GhcPass p'))) + -> BooleanFormula (GhcPass p) + -> f (BooleanFormula (GhcPass p')) +bfTraverse f = go where - -- See Note [Simplification of BooleanFormulas] - fromOr (L _ (Or xs)) = Just xs - fromOr (L _ (And [])) = Nothing - fromOr x = Just [x] - mkOr' [x] = unLoc x - mkOr' xs = Or xs + go (Var a ) = Var <$> f a + go (And bfs) = And <$> traverse @[] (traverse go) bfs + go (Or bfs) = Or <$> traverse @[] (traverse go) bfs + go (Parens bf ) = Parens <$> traverse go bf + {- Note [Simplification of BooleanFormulas] ~~~~~~~~~~~~~~~~~~~~~~ @@ -115,15 +105,15 @@ -- Evaluation and simplification ---------------------------------------------------------------------- -isFalse :: BooleanFormula a -> Bool +isFalse :: BooleanFormula (GhcPass p) -> Bool isFalse (Or []) = True isFalse _ = False -isTrue :: BooleanFormula a -> Bool +isTrue :: BooleanFormula (GhcPass p) -> Bool isTrue (And []) = True isTrue _ = False -eval :: (a -> Bool) -> BooleanFormula a -> Bool +eval :: (LIdP (GhcPass p) -> Bool) -> BooleanFormula (GhcPass p) -> Bool eval f (Var x) = f x eval f (And xs) = all (eval f . unLoc) xs eval f (Or xs) = any (eval f . unLoc) xs @@ -131,18 +121,24 @@ -- Simplify a boolean formula. -- The argument function should give the truth of the atoms, or Nothing if undecided. -simplify :: Eq a => (a -> Maybe Bool) -> BooleanFormula a -> BooleanFormula a +simplify :: forall p. Eq (LIdP (GhcPass p)) + => (LIdP (GhcPass p) -> Maybe Bool) + -> BooleanFormula (GhcPass p) + -> BooleanFormula (GhcPass p) simplify f (Var a) = case f a of Nothing -> Var a Just b -> mkBool b -simplify f (And xs) = mkAnd (map (\(L l x) -> L l (simplify f x)) xs) -simplify f (Or xs) = mkOr (map (\(L l x) -> L l (simplify f x)) xs) +simplify f (And xs) = mkAnd (map (fmap (simplify f)) xs) +simplify f (Or xs) = mkOr (map (fmap (simplify f)) xs) simplify f (Parens x) = simplify f (unLoc x) -- Test if a boolean formula is satisfied when the given values are assigned to the atoms -- if it is, returns Nothing -- if it is not, return (Just remainder) -isUnsatisfied :: Eq a => (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a) +isUnsatisfied :: Eq (LIdP (GhcPass p)) + => (LIdP (GhcPass p) -> Bool) + -> BooleanFormula (GhcPass p) + -> Maybe (BooleanFormula (GhcPass p)) isUnsatisfied f bf | isTrue bf' = Nothing | otherwise = Just bf' @@ -155,42 +151,42 @@ -- eval f x == False <==> isFalse (simplify (Just . f) x) -- If the boolean formula holds, does that mean that the given atom is always true? -impliesAtom :: Eq a => BooleanFormula a -> a -> Bool -Var x `impliesAtom` y = x == y -And xs `impliesAtom` y = any (\x -> (unLoc x) `impliesAtom` y) xs +impliesAtom :: Eq (IdP (GhcPass p)) => BooleanFormula (GhcPass p) -> LIdP (GhcPass p) -> Bool +Var x `impliesAtom` y = (unLoc x) == (unLoc y) +And xs `impliesAtom` y = any (\x -> unLoc x `impliesAtom` y) xs -- we have all of xs, so one of them implying y is enough -Or xs `impliesAtom` y = all (\x -> (unLoc x) `impliesAtom` y) xs -Parens x `impliesAtom` y = (unLoc x) `impliesAtom` y +Or xs `impliesAtom` y = all (\x -> unLoc x `impliesAtom` y) xs +Parens x `impliesAtom` y = unLoc x `impliesAtom` y -implies :: Uniquable a => BooleanFormula a -> BooleanFormula a -> Bool +implies :: (Uniquable (IdP (GhcPass p))) => BooleanFormula (GhcPass p) -> BooleanFormula (GhcPass p) -> Bool implies e1 e2 = go (Clause emptyUniqSet [e1]) (Clause emptyUniqSet [e2]) where - go :: Uniquable a => Clause a -> Clause a -> Bool + go :: Uniquable (IdP (GhcPass p)) => Clause (GhcPass p) -> Clause (GhcPass p) -> Bool go l@Clause{ clauseExprs = hyp:hyps } r = case hyp of - Var x | memberClauseAtoms x r -> True - | otherwise -> go (extendClauseAtoms l x) { clauseExprs = hyps } r + Var x | memberClauseAtoms (unLoc x) r -> True + | otherwise -> go (extendClauseAtoms l (unLoc x)) { clauseExprs = hyps } r Parens hyp' -> go l { clauseExprs = unLoc hyp':hyps } r And hyps' -> go l { clauseExprs = map unLoc hyps' ++ hyps } r Or hyps' -> all (\hyp' -> go l { clauseExprs = unLoc hyp':hyps } r) hyps' go l r@Clause{ clauseExprs = con:cons } = case con of - Var x | memberClauseAtoms x l -> True - | otherwise -> go l (extendClauseAtoms r x) { clauseExprs = cons } + Var x | memberClauseAtoms (unLoc x) l -> True + | otherwise -> go l (extendClauseAtoms r (unLoc x)) { clauseExprs = cons } Parens con' -> go l r { clauseExprs = unLoc con':cons } And cons' -> all (\con' -> go l r { clauseExprs = unLoc con':cons }) cons' Or cons' -> go l r { clauseExprs = map unLoc cons' ++ cons } go _ _ = False -- A small sequent calculus proof engine. -data Clause a = Clause { - clauseAtoms :: UniqSet a, - clauseExprs :: [BooleanFormula a] +data Clause p = Clause { + clauseAtoms :: UniqSet (IdP p), + clauseExprs :: [BooleanFormula p] } -extendClauseAtoms :: Uniquable a => Clause a -> a -> Clause a +extendClauseAtoms :: Uniquable (IdP p) => Clause p -> IdP p -> Clause p extendClauseAtoms c x = c { clauseAtoms = addOneToUniqSet (clauseAtoms c) x } -memberClauseAtoms :: Uniquable a => a -> Clause a -> Bool +memberClauseAtoms :: Uniquable (IdP p) => IdP p -> Clause p -> Bool memberClauseAtoms x c = x `elementOfUniqSet` clauseAtoms c ---------------------------------------------------------------------- @@ -199,28 +195,29 @@ -- Pretty print a BooleanFormula, -- using the arguments as pretty printers for Var, And and Or respectively -pprBooleanFormula' :: (Rational -> a -> SDoc) - -> (Rational -> [SDoc] -> SDoc) - -> (Rational -> [SDoc] -> SDoc) - -> Rational -> BooleanFormula a -> SDoc +pprBooleanFormula' :: (Rational -> LIdP (GhcPass p) -> SDoc) + -> (Rational -> [SDoc] -> SDoc) + -> (Rational -> [SDoc] -> SDoc) + -> Rational -> BooleanFormula (GhcPass p) -> SDoc pprBooleanFormula' pprVar pprAnd pprOr = go where go p (Var x) = pprVar p x - go p (And []) = cparen (p > 0) $ empty + go p (And []) = cparen (p > 0) empty go p (And xs) = pprAnd p (map (go 3 . unLoc) xs) go _ (Or []) = keyword $ text "FALSE" go p (Or xs) = pprOr p (map (go 2 . unLoc) xs) go p (Parens x) = go p (unLoc x) -- Pretty print in source syntax, "a | b | c,d,e" -pprBooleanFormula :: (Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> SDoc +pprBooleanFormula :: (Rational -> LIdP (GhcPass p) -> SDoc) + -> Rational -> BooleanFormula (GhcPass p) -> SDoc pprBooleanFormula pprVar = pprBooleanFormula' pprVar pprAnd pprOr where pprAnd p = cparen (p > 3) . fsep . punctuate comma pprOr p = cparen (p > 2) . fsep . intersperse vbar -- Pretty print human in readable format, "either `a' or `b' or (`c', `d' and `e')"? -pprBooleanFormulaNice :: Outputable a => BooleanFormula a -> SDoc +pprBooleanFormulaNice :: Outputable (LIdP (GhcPass p)) => BooleanFormula (GhcPass p) -> SDoc pprBooleanFormulaNice = pprBooleanFormula' pprVar pprAnd pprOr 0 where pprVar _ = quotes . ppr @@ -230,14 +227,13 @@ pprAnd' (x:xs) = fsep (punctuate comma (init (x:|xs))) <> text ", and" <+> last (x:|xs) pprOr p xs = cparen (p > 1) $ text "either" <+> sep (intersperse (text "or") xs) -instance (OutputableBndr a) => Outputable (BooleanFormula a) where +instance OutputableBndrId p => Outputable (BooleanFormula (GhcPass p)) where ppr = pprBooleanFormulaNormal -pprBooleanFormulaNormal :: (OutputableBndr a) - => BooleanFormula a -> SDoc +pprBooleanFormulaNormal :: OutputableBndrId p => BooleanFormula (GhcPass p) -> SDoc pprBooleanFormulaNormal = go where - go (Var x) = pprPrefixOcc x + go (Var x) = pprPrefixOcc (unLoc x) go (And xs) = fsep $ punctuate comma (map (go . unLoc) xs) go (Or []) = keyword $ text "FALSE" go (Or xs) = fsep $ intersperse vbar (map (go . unLoc) xs) diff --git a/GHC/Data/FastString.hs b/GHC/Data/FastString.hs --- a/GHC/Data/FastString.hs +++ b/GHC/Data/FastString.hs @@ -1,12 +1,20 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} +#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) +{-# OPTIONS_GHC -fno-unoptimized-core-for-interpreter #-} +#endif -- We always optimise this, otherwise performance of a non-optimised -- compiler is severely affected +-- +-- Also important, if you load this module into GHCi then the data representation of +-- FastString has to match that of the host compiler due to the shared FastString +-- table. Otherwise you will get segfaults when the table is consulted and the fields +-- from the FastString are in an incorrect order. -- | -- There are two principal string types used internally by GHC: @@ -127,9 +135,6 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Short as SBS -#if !MIN_VERSION_bytestring(0,11,0) -import qualified Data.ByteString.Short.Internal as SBS -#endif import GHC.Data.ShortText (ShortText(..)) import Foreign.C import System.IO @@ -139,9 +144,7 @@ import Foreign -#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) import GHC.Conc.Sync (sharedCAF) -#endif import GHC.Exts import GHC.IO @@ -400,9 +403,6 @@ -- use the support wired into the RTS to share this CAF among all images of -- libHSghc -#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) - return tab -#else sharedCAF tab getOrSetLibHSghcFastStringTable -- from the 9.3 RTS; the previous RTS before might not have this symbol. The @@ -410,7 +410,6 @@ -- or similar rather than use (odd parity) development versions. foreign import ccall unsafe "getOrSetLibHSghcFastStringTable" getOrSetLibHSghcFastStringTable :: Ptr a -> IO (Ptr a) -#endif {- @@ -704,10 +703,6 @@ -- ----------------------------------------------------------------------------- -- under the carpet -#if !MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) -foreign import ccall unsafe "strlen" - cstringLength# :: Addr# -> Int# -#endif ptrStrLength :: Ptr Word8 -> Int {-# INLINE ptrStrLength #-} diff --git a/GHC/Data/FastString/Env.hs b/GHC/Data/FastString/Env.hs --- a/GHC/Data/FastString/Env.hs +++ b/GHC/Data/FastString/Env.hs @@ -82,7 +82,7 @@ filterFsEnv x y = filterUFM x y mapMaybeFsEnv f x = mapMaybeUFM f x -lookupFsEnv_NF env n = expectJust "lookupFsEnv_NF" (lookupFsEnv env n) +lookupFsEnv_NF env n = expectJust (lookupFsEnv env n) strictMapFsEnv :: (a -> b) -> FastStringEnv a -> FastStringEnv b strictMapFsEnv = strictMapUFM diff --git a/GHC/Data/FlatBag.hs b/GHC/Data/FlatBag.hs --- a/GHC/Data/FlatBag.hs +++ b/GHC/Data/FlatBag.hs @@ -8,13 +8,11 @@ , mappendFlatBag -- * Construction , fromList - , fromSizedSeq + , fromSmallArray ) where import GHC.Prelude -import GHC.Data.SizedSeq (SizedSeq, ssElts, sizeSS) - import Control.DeepSeq import GHC.Data.SmallArray @@ -125,5 +123,10 @@ -- | Convert a 'SizedSeq' into its flattened representation. -- A 'FlatBag a' is more memory efficient than '[a]', if no further modification -- is necessary. -fromSizedSeq :: SizedSeq a -> FlatBag a -fromSizedSeq s = fromList (sizeSS s) (ssElts s) +fromSmallArray :: SmallArray a -> FlatBag a +fromSmallArray s = case sizeofSmallArray s of + 0 -> EmptyFlatBag + 1 -> UnitFlatBag (indexSmallArray s 0) + 2 -> TupleFlatBag (indexSmallArray s 0) (indexSmallArray s 1) + _ -> FlatBag s + diff --git a/GHC/Data/Graph/Color.hs b/GHC/Data/Graph/Color.hs --- a/GHC/Data/Graph/Color.hs +++ b/GHC/Data/Graph/Color.hs @@ -380,5 +380,3 @@ in chooseColor - - diff --git a/GHC/Data/Graph/Directed.hs b/GHC/Data/Graph/Directed.hs --- a/GHC/Data/Graph/Directed.hs +++ b/GHC/Data/Graph/Directed.hs @@ -8,13 +8,14 @@ module GHC.Data.Graph.Directed ( Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq, - graphFromVerticesAndAdjacency, + graphFromVerticesAndAdjacency, emptyGraph, SCC(..), Node(..), G.flattenSCC, G.flattenSCCs, stronglyConnCompG, topologicalSortG, verticesG, edgesG, hasVertexG, - reachableG, reachablesG, transposeG, allReachable, allReachableCyclic, outgoingG, + reachablesG, + transposeG, outgoingG, emptyG, findCycle, @@ -43,7 +44,6 @@ -- removed them since they were not used anywhere in GHC. ------------------------------------------------------------------------------ - import GHC.Prelude import GHC.Utils.Misc ( sortWith, count ) @@ -60,14 +60,14 @@ import qualified Data.Graph as G import Data.Graph ( Vertex, Bounds, SCC(..) ) -- Used in the underlying representation -import Data.Tree import GHC.Types.Unique import GHC.Types.Unique.FM -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Map as M -import qualified Data.Set as S +-- The graph internals are defined in the .Internal module so they can be +-- imported by GHC.Data.Graph.Directed.Reachability while still allowing this +-- module to export it abstractly. +import GHC.Data.Graph.Directed.Internal + {- ************************************************************************ * * @@ -86,14 +86,6 @@ arranged densely in 0.n -} -data Graph node = Graph { - gr_int_graph :: IntGraph, - gr_vertex_to_node :: Vertex -> node, - gr_node_to_vertex :: node -> Maybe Vertex - } - -data Edge node = Edge node node - {-| Representation for nodes of the Graph. * The @payload@ is user data, just carried around in this module @@ -357,51 +349,22 @@ topologicalSortG graph = map (gr_vertex_to_node graph) result where result = {-# SCC "Digraph.topSort" #-} G.topSort (gr_int_graph graph) -reachableG :: Graph node -> node -> [node] -reachableG graph from = map (gr_vertex_to_node graph) result - where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from) - result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex] - outgoingG :: Graph node -> node -> [node] outgoingG graph from = map (gr_vertex_to_node graph) result - where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from) + where from_vertex = expectJust (gr_node_to_vertex graph from) result = gr_int_graph graph ! from_vertex --- | Given a list of roots return all reachable nodes. +-- | Given a list of roots, return all reachable nodes in topological order. +-- Implemented using a depth-first traversal. reachablesG :: Graph node -> [node] -> [node] reachablesG graph froms = map (gr_vertex_to_node graph) result where result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) vs vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ] --- | Efficiently construct a map which maps each key to it's set of transitive --- dependencies. Only works on acyclic input. -allReachable :: Ord key => Graph node -> (node -> key) -> M.Map key (S.Set key) -allReachable = all_reachable reachableGraph - --- | Efficiently construct a map which maps each key to it's set of transitive --- dependencies. Less efficient than @allReachable@, but works on cyclic input as well. -allReachableCyclic :: Ord key => Graph node -> (node -> key) -> M.Map key (S.Set key) -allReachableCyclic = all_reachable reachableGraphCyclic - -all_reachable :: Ord key => (IntGraph -> IM.IntMap IS.IntSet) -> Graph node -> (node -> key) -> M.Map key (S.Set key) -all_reachable int_reachables (Graph g from _) keyOf = - M.fromList [(k, IS.foldr (\v' vs -> keyOf (from v') `S.insert` vs) S.empty vs) - | (v, vs) <- IM.toList int_graph - , let k = keyOf (from v)] - where - int_graph = int_reachables g - hasVertexG :: Graph node -> node -> Bool hasVertexG graph node = isJust $ gr_node_to_vertex graph node -verticesG :: Graph node -> [node] -verticesG graph = map (gr_vertex_to_node graph) $ G.vertices (gr_int_graph graph) - -edgesG :: Graph node -> [Edge node] -edgesG graph = map (\(v1, v2) -> Edge (v2n v1) (v2n v2)) $ G.edges (gr_int_graph graph) - where v2n = gr_vertex_to_node graph - transposeG :: Graph node -> Graph node transposeG graph = Graph (G.transposeG (gr_int_graph graph)) (gr_vertex_to_node graph) @@ -410,114 +373,12 @@ emptyG :: Graph node -> Bool emptyG g = graphEmpty (gr_int_graph g) -{- -************************************************************************ -* * -* Showing Graphs -* * -************************************************************************ --} - -instance Outputable node => Outputable (Graph node) where - ppr graph = vcat [ - hang (text "Vertices:") 2 (vcat (map ppr $ verticesG graph)), - hang (text "Edges:") 2 (vcat (map ppr $ edgesG graph)) - ] - -instance Outputable node => Outputable (Edge node) where - ppr (Edge from to) = ppr from <+> text "->" <+> ppr to - graphEmpty :: G.Graph -> Bool graphEmpty g = lo > hi where (lo, hi) = bounds g -{- -************************************************************************ -* * -* IntGraphs -* * -************************************************************************ --} -type IntGraph = G.Graph - {- ------------------------------------------------------------- --- Depth first search numbering ------------------------------------------------------------- --} - --- Data.Tree has flatten for Tree, but nothing for Forest -preorderF :: Forest a -> [a] -preorderF ts = concatMap flatten ts - -{- ------------------------------------------------------------- --- Finding reachable vertices ------------------------------------------------------------- --} - --- This generalizes reachable which was found in Data.Graph -reachable :: IntGraph -> [Vertex] -> [Vertex] -reachable g vs = preorderF (G.dfs g vs) - -reachableGraph :: IntGraph -> IM.IntMap IS.IntSet -reachableGraph g = res - where - do_one v = IS.unions (IS.fromList (g ! v) : mapMaybe (flip IM.lookup res) (g ! v)) - res = IM.fromList [(v, do_one v) | v <- G.vertices g] - -scc :: IntGraph -> [SCC Vertex] -scc graph = map decode forest - where - forest = {-# SCC "Digraph.scc" #-} G.scc graph - - decode (Node v []) | mentions_itself v = CyclicSCC [v] - | otherwise = AcyclicSCC v - decode other = CyclicSCC (dec other []) - where dec (Node v ts) vs = v : foldr dec vs ts - mentions_itself v = v `elem` (graph ! v) - -reachableGraphCyclic :: IntGraph -> IM.IntMap IS.IntSet -reachableGraphCyclic g = foldl' add_one_comp mempty comps - where - neighboursOf v = g!v - - comps = scc g - - -- To avoid divergence on cyclic input, we build the result - -- strongly connected component by component, in topological - -- order. For each SCC, we know that: - -- - -- * All vertices in the component can reach all other vertices - -- in the component ("local" reachables) - -- - -- * Other reachable vertices ("remote" reachables) must come - -- from earlier components, either via direct neighbourhood, or - -- transitively from earlier reachability map - -- - -- This allows us to build the extension of the reachability map - -- directly, without any self-reference, thereby avoiding a loop. - add_one_comp :: IM.IntMap IS.IntSet -> SCC Vertex -> IM.IntMap IS.IntSet - add_one_comp earlier (AcyclicSCC v) = IM.insert v all_remotes earlier - where - earlier_neighbours = neighboursOf v - earlier_further = mapMaybe (flip IM.lookup earlier) earlier_neighbours - all_remotes = IS.unions (IS.fromList earlier_neighbours : earlier_further) - add_one_comp earlier (CyclicSCC vs) = IM.union (IM.fromList [(v, local v `IS.union` all_remotes) | v <- vs]) earlier - where - all_locals = IS.fromList vs - local v = IS.delete v all_locals - -- Arguably, for a cyclic SCC we should include each - -- vertex in its own reachable set. However, this could - -- lead to a lot of extra pain in client code to avoid - -- looping when traversing the reachability map. - all_neighbours = IS.fromList (concatMap neighboursOf vs) - earlier_neighbours = all_neighbours IS.\\ all_locals - earlier_further = mapMaybe (flip IM.lookup earlier) (IS.toList earlier_neighbours) - all_remotes = IS.unions (earlier_neighbours : earlier_further) - -{- ************************************************************************ * * * Classify Edge Types @@ -619,7 +480,8 @@ graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vertex . key_extractor) where key_extractor = node_key (bounds, vertex_node, key_vertex, _) = reduceNodesIntoVerticesOrd vertices key_extractor - key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a, - expectJust "graphFromVerticesAndAdjacency" $ key_vertex b) + key_vertex_pair (a, b) = (expectJust $ key_vertex a, + expectJust $ key_vertex b) reduced_edges = map key_vertex_pair edges graph = G.buildG bounds reduced_edges + diff --git a/GHC/Data/Graph/Directed/Internal.hs b/GHC/Data/Graph/Directed/Internal.hs new file mode 100644 --- /dev/null +++ b/GHC/Data/Graph/Directed/Internal.hs @@ -0,0 +1,79 @@ +module GHC.Data.Graph.Directed.Internal where + +import GHC.Prelude +import GHC.Utils.Outputable + +import Data.Array +import qualified Data.Graph as G +import Data.Graph ( Vertex, SCC(..) ) -- Used in the underlying representation +import Data.Tree + +data Graph node = Graph { + gr_int_graph :: IntGraph, + gr_vertex_to_node :: Vertex -> node, + gr_node_to_vertex :: node -> Maybe Vertex +} + +data Edge node = Edge node node + +------------------------------------------------------------ +-- Nodes and Edges +------------------------------------------------------------ + +verticesG :: Graph node -> [node] +verticesG graph = map (gr_vertex_to_node graph) $ G.vertices (gr_int_graph graph) + +edgesG :: Graph node -> [Edge node] +edgesG graph = map (\(v1, v2) -> Edge (v2n v1) (v2n v2)) $ G.edges (gr_int_graph graph) + where v2n = gr_vertex_to_node graph + +------------------------------------------------------------ +-- Showing Graphs +------------------------------------------------------------ + +instance Outputable node => Outputable (Graph node) where + ppr graph = vcat [ + hang (text "Vertices:") 2 (vcat (map ppr $ verticesG graph)), + hang (text "Edges:") 2 (vcat (map ppr $ edgesG graph)) + ] + +instance Outputable node => Outputable (Edge node) where + ppr (Edge from to) = ppr from <+> text "->" <+> ppr to + +{- +************************************************************************ +* * +* IntGraphs +* * +************************************************************************ +-} + +type IntGraph = G.Graph + +------------------------------------------------------------ +-- Depth first search numbering +------------------------------------------------------------ + +-- Data.Tree has flatten for Tree, but nothing for Forest +preorderF :: Forest a -> [a] +preorderF ts = concatMap flatten ts + +------------------------------------------------------------ +-- Finding reachable vertices +------------------------------------------------------------ + +-- This generalizes reachable which was found in Data.Graph +reachable :: IntGraph -> [Vertex] -> [Vertex] +reachable g vs = preorderF (G.dfs g vs) + +scc :: IntGraph -> [SCC Vertex] +scc graph = map decode forest + where + forest = {-# SCC "Digraph.scc" #-} G.scc graph + + decode (Node v []) | mentions_itself v = CyclicSCC [v] + | otherwise = AcyclicSCC v + decode other = CyclicSCC (dec other []) + where dec (Node v ts) vs = v : foldr dec vs ts + mentions_itself v = v `elem` (graph ! v) + diff --git a/GHC/Data/Graph/Directed/Reachability.hs b/GHC/Data/Graph/Directed/Reachability.hs new file mode 100644 --- /dev/null +++ b/GHC/Data/Graph/Directed/Reachability.hs @@ -0,0 +1,178 @@ +-- | An abstract interface for a fast reachability data structure constructed +-- from a 'GHC.Data.Graph.Directed' graph. +module GHC.Data.Graph.Directed.Reachability + ( ReachabilityIndex + + -- * Constructing a reachability index + , graphReachability, cyclicGraphReachability + + -- * Reachability queries + , allReachable, allReachableMany + , isReachable, isReachableMany + + -- * Debugging + , reachabilityIndexMembers + + ) + where + +import GHC.Prelude +import GHC.Data.Maybe + +import qualified Data.Graph as G +import Data.Graph ( Vertex, SCC(..) ) + +import Data.Array ((!)) +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS + +import GHC.Data.Graph.Directed.Internal + +-------------------------------------------------------------------------------- +-- * Reachability index +-------------------------------------------------------------------------------- + +-- | The abstract data structure for fast reachability queries +data ReachabilityIndex node = ReachabilityIndex { + index :: IM.IntMap IS.IntSet, + from_vertex :: Vertex -> node, + to_vertex :: node -> Maybe Vertex +} + +-- +reachabilityIndexMembers :: ReachabilityIndex node -> [node] +reachabilityIndexMembers (ReachabilityIndex index from_vert _) = map from_vert (IM.keys index) + +-------------------------------------------------------------------------------- +-- * Construction +-------------------------------------------------------------------------------- + +-- | Construct a 'ReachabilityIndex' from an acyclic 'Graph'. +-- If the graph can have cycles, use 'cyclicGraphReachability' +graphReachability :: Graph node -> ReachabilityIndex node +graphReachability (Graph g from to) = + ReachabilityIndex{index = reachableGraph, from_vertex = from, to_vertex = to} + where + reachableGraph :: IM.IntMap IS.IntSet + reachableGraph = IM.fromList [(v, do_one v) | v <- G.vertices g] + + do_one v = IS.unions (IS.fromList (g ! v) : mapMaybe (flip IM.lookup reachableGraph) (g ! v)) + +-- | Construct a 'ReachabilityIndex' from a 'Graph' which may have cycles. +-- If this reachability index is just going to be used once, it may make sense +-- to use 'reachablesG' instead, which will traverse the reachable nodes without +-- constructing the index -- which may be faster. +cyclicGraphReachability :: Graph node -> ReachabilityIndex node +cyclicGraphReachability (Graph g from to) = + ReachabilityIndex{index = reachableGraphCyclic, from_vertex = from, to_vertex = to} + where + reachableGraphCyclic :: IM.IntMap IS.IntSet + reachableGraphCyclic = foldl' add_one_comp mempty comps + + neighboursOf v = g!v + + comps = scc g + + -- To avoid divergence on cyclic input, we build the result + -- strongly connected component by component, in topological + -- order. For each SCC, we know that: + -- + -- * All vertices in the component can reach all other vertices + -- in the component ("local" reachables) + -- + -- * Other reachable vertices ("remote" reachables) must come + -- from earlier components, either via direct neighbourhood, or + -- transitively from earlier reachability map + -- + -- This allows us to build the extension of the reachability map + -- directly, without any self-reference, thereby avoiding a loop. + add_one_comp :: IM.IntMap IS.IntSet -> SCC Vertex -> IM.IntMap IS.IntSet + add_one_comp earlier (AcyclicSCC v) = IM.insert v all_remotes earlier + where + earlier_neighbours = neighboursOf v + earlier_further = mapMaybe (flip IM.lookup earlier) earlier_neighbours + all_remotes = IS.unions (IS.fromList earlier_neighbours : earlier_further) + add_one_comp earlier (CyclicSCC vs) = IM.union (IM.fromList [(v, local v `IS.union` all_remotes) | v <- vs]) earlier + where + all_locals = IS.fromList vs + local v = IS.delete v all_locals + -- Arguably, for a cyclic SCC we should include each + -- vertex in its own reachable set. However, this could + -- lead to a lot of extra pain in client code to avoid + -- looping when traversing the reachability map. + all_neighbours = IS.fromList (concatMap neighboursOf vs) + earlier_neighbours = all_neighbours IS.\\ all_locals + earlier_further = mapMaybe (flip IM.lookup earlier) (IS.toList earlier_neighbours) + all_remotes = IS.unions (earlier_neighbours : earlier_further) + +-------------------------------------------------------------------------------- +-- * Reachability queries +-------------------------------------------------------------------------------- + +-- | 'allReachable' returns the nodes reachable from the given @root@ node. +-- +-- Properties: +-- * The list of nodes /does not/ include the @root@ node! +-- * The list of nodes is deterministically ordered, but according to an +-- internal order determined by the indices attributed to graph nodes. +-- +-- If you need a topologically sorted list, consider using the functions exposed from 'GHC.Data.Graph.Directed' on 'Graph' instead. +allReachable :: ReachabilityIndex node -> node {-^ The @root@ node -} -> [node] {-^ All nodes reachable from @root@ -} +allReachable (ReachabilityIndex index from to) root = map from result + where root_i = expectJust (to root) + hits = {-# SCC "allReachable" #-} IM.lookup root_i index + result = IS.toList $! expectJust hits + +-- | 'allReachableMany' returns all nodes reachable from the many given @roots@. +-- +-- Properties: +-- * The list of nodes /does not/ include the @roots@ node! +-- * The list of nodes is deterministically ordered, but according to an +-- internal order determined by the indices attributed to graph nodes. +-- * This function has $O(n)$ complexity where $n$ is the number of @roots@. +-- +-- If you need a topologically sorted list, consider using the functions +-- exposed from 'GHC.Data.Graph.Directed' on 'Graph' instead ('reachableG'). +allReachableMany :: ReachabilityIndex node -> [node] {-^ The @roots@ -} -> [node] {-^ All nodes reachable from all @roots@ -} +allReachableMany (ReachabilityIndex index from to) roots = map from (IS.toList hits) + where roots_i = [ v | Just v <- map to roots ] + hits = {-# SCC "allReachableMany" #-} + IS.unions $ map (expectJust . flip IM.lookup index) roots_i + +-- | Fast reachability query. +-- +-- On graph @g@ with nodes @a@ and @b@, @isReachable g a b@ +-- asks whether @b@ can be reached through @g@ starting from @a@. +-- +-- Properties: +-- * No self loops, i.e. @isReachable _ a a == False@ +isReachable :: ReachabilityIndex node {-^ @g@ -} + -> node -- ^ @a@ + -> node -- ^ @b@ + -> Bool -- ^ @b@ is reachable from @a@ +isReachable (ReachabilityIndex index _ to) a b = + IS.member b_i $ + expectJust $ IM.lookup a_i index + where a_i = expectJust $ to a + b_i = expectJust $ to b + +-- | Fast reachability query with many roots. +-- +-- On graph @g@ with many nodes @roots@ and node @b@, @isReachableMany g as b@ +-- asks whether @b@ can be reached through @g@ from any of the @roots@. +-- +-- By partially applying this function to a set of roots, the resulting function can +-- be applied many times and share the initial work. +-- +-- Properties: +-- * No self loops, i.e. @isReachableMany _ [a] a == False@ +isReachableMany :: ReachabilityIndex node -- ^ @g@ + -> [node] -- ^ @roots@ + -> (node -> Bool) -- ^ @b@ is reachable from any of the @roots@ +isReachableMany (ReachabilityIndex index _ to) roots = + let roots_i = [ v | Just v <- map to roots ] + unions = + IS.unions $ + map (expectJust . flip IM.lookup index) roots_i + in \b -> let b_i = expectJust $ to b + in IS.member b_i unions diff --git a/GHC/Data/Graph/Inductive/Graph.hs b/GHC/Data/Graph/Inductive/Graph.hs --- a/GHC/Data/Graph/Inductive/Graph.hs +++ b/GHC/Data/Graph/Inductive/Graph.hs @@ -70,6 +70,7 @@ import Data.Function (on) import qualified Data.IntSet as IntSet import Data.List (delete, groupBy, sort, sortBy, (\\)) +import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe, isJust) import GHC.Utils.Panic @@ -167,11 +168,9 @@ -- | The minimum and maximum 'Node' in a 'Graph'. nodeRange :: gr a b -> (Node,Node) - nodeRange g - | isEmpty g = panic "nodeRange of empty graph" - | otherwise = (minimum vs, maximum vs) - where - vs = nodes g + nodeRange g = case nonEmpty (nodes g) of + Nothing -> panic "nodeRange of empty graph" + Just vs -> (minimum vs, maximum vs) -- | A list of all 'LEdge's in the 'Graph'. labEdges :: gr a b -> [LEdge b] diff --git a/GHC/Data/IOEnv.hs b/GHC/Data/IOEnv.hs --- a/GHC/Data/IOEnv.hs +++ b/GHC/Data/IOEnv.hs @@ -22,7 +22,7 @@ IOEnvFailure(..), -- Getting at the environment - getEnv, setEnv, updEnv, + getEnv, setEnv, updEnv, updEnvIO, runIOEnv, unsafeInterleaveM, uninterruptibleMaskM_, tryM, tryAllM, tryMostM, fixM, @@ -253,3 +253,8 @@ updEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a {-# INLINE updEnv #-} updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env)) + +-- | Perform a computation with an altered environment +updEnvIO :: (env -> IO env') -> IOEnv env' a -> IOEnv env a +{-# INLINE updEnvIO #-} +updEnvIO upd (IOEnv m) = IOEnv (\ env -> m =<< upd env) diff --git a/GHC/Data/List.hs b/GHC/Data/List.hs new file mode 100644 --- /dev/null +++ b/GHC/Data/List.hs @@ -0,0 +1,25 @@ +module GHC.Data.List where + +mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c]) +mapAndUnzip _ [] = ([], []) +mapAndUnzip f (x:xs) + = let (r1, r2) = f x + (rs1, rs2) = mapAndUnzip f xs + in + (r1:rs1, r2:rs2) + +mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d]) +mapAndUnzip3 _ [] = ([], [], []) +mapAndUnzip3 f (x:xs) + = let (r1, r2, r3) = f x + (rs1, rs2, rs3) = mapAndUnzip3 f xs + in + (r1:rs1, r2:rs2, r3:rs3) + +mapAndUnzip4 :: (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e]) +mapAndUnzip4 _ [] = ([], [], [], []) +mapAndUnzip4 f (x:xs) + = let (r1, r2, r3, r4) = f x + (rs1, rs2, rs3, rs4) = mapAndUnzip4 f xs + in + (r1:rs1, r2:rs2, r3:rs3, r4:rs4) diff --git a/GHC/Data/List/Infinite.hs b/GHC/Data/List/Infinite.hs --- a/GHC/Data/List/Infinite.hs +++ b/GHC/Data/List/Infinite.hs @@ -16,15 +16,18 @@ , allListsOf , toList , repeat + , enumFrom ) where -import Prelude ((-), Applicative (..), Bool (..), Foldable, Functor (..), Int, Maybe (..), Traversable (..), flip, otherwise) +import Prelude ((-), Applicative (..), Bool (..), Enum (succ), Foldable, Functor (..), Int, Maybe (..), Monad (..), Traversable (..), (<$>), flip, otherwise) import Control.Category (Category (..)) import Control.Monad (guard) import qualified Data.Foldable as F import Data.List.NonEmpty (NonEmpty (..)) import qualified GHC.Base as List (build) +infixr 5 `Inf` + data Infinite a = Inf a (Infinite a) deriving (Foldable, Functor, Traversable) @@ -44,6 +47,11 @@ pure = repeat Inf f fs <*> Inf a as = Inf (f a) (fs <*> as) +instance Monad Infinite where + x >>= f = join (f <$> x) + where + join (Inf a as) = head a `Inf` join (tail <$> as) + mapMaybe :: (a -> Maybe b) -> Infinite a -> Infinite b mapMaybe f = go where @@ -170,6 +178,10 @@ "repeat" [~1] forall a . repeat a = build \ c -> repeatFB c a "repeatFB" [1] repeatFB Inf = repeat #-} + +enumFrom :: Enum a => a -> Infinite a +enumFrom = iterate succ +{-# INLINE enumFrom #-} {- Note [Fusion for `Infinite` lists] diff --git a/GHC/Data/List/NonEmpty.hs b/GHC/Data/List/NonEmpty.hs new file mode 100644 --- /dev/null +++ b/GHC/Data/List/NonEmpty.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE LambdaCase #-} + +module GHC.Data.List.NonEmpty (module Data.List.NonEmpty, module GHC.Data.List.NonEmpty, toList) where + +import Prelude (Bool, (.)) +import Control.Applicative +import qualified Control.Monad as List (zipWithM) +import Data.Foldable (Foldable (toList)) +import Data.List.NonEmpty hiding (toList, unzip) +import qualified Data.List as List +import qualified GHC.Data.List as List + +zipWithM :: Applicative f => (a -> b -> f c) -> NonEmpty a -> NonEmpty b -> f (NonEmpty c) +zipWithM f (a:|as) (b:|bs) = liftA2 (:|) (f a b) (List.zipWithM f as bs) +-- Inline to enable fusion of `List.zipWithM` +-- See Note [Fusion for zipN/zipWithN] in List.hs +{-# INLINE zipWithM #-} + +unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b) +unzip ((a,b):|xs) = (a:|as, b:|bs) + where + (as, bs) = List.unzip xs + +unzip3 :: NonEmpty (a, b, c) -> (NonEmpty a, NonEmpty b, NonEmpty c) +unzip3 ((a,b,c):|xs) = (a:|as, b:|bs, c:|cs) + where + (as, bs, cs) = List.unzip3 xs + +mapAndUnzip :: (a -> (b, c)) -> NonEmpty a -> (NonEmpty b, NonEmpty c) +mapAndUnzip f (x:|xs) = (b:|bs, c:|cs) + where + (b, c) = f x + (bs, cs) = List.mapAndUnzip f xs + +mapAndUnzip3 :: (a -> (b, c, d)) -> NonEmpty a -> (NonEmpty b, NonEmpty c, NonEmpty d) +mapAndUnzip3 f (x:|xs) = (b:|bs, c:|cs, d:|ds) + where + (b, c, d) = f x + (bs, cs, ds) = List.mapAndUnzip3 f xs + +isSingleton :: NonEmpty a -> Bool +isSingleton = List.null . tail diff --git a/GHC/Data/Maybe.hs b/GHC/Data/Maybe.hs --- a/GHC/Data/Maybe.hs +++ b/GHC/Data/Maybe.hs @@ -33,7 +33,9 @@ import Control.Exception (SomeException(..)) import Data.Maybe import Data.Foldable ( foldlM, for_ ) -import GHC.Utils.Misc (HasDebugCallStack) +import GHC.Utils.Misc (HasCallStack) +import GHC.Utils.Panic +import GHC.Utils.Outputable import Data.List.NonEmpty ( NonEmpty ) import Control.Applicative( Alternative( (<|>) ) ) @@ -66,10 +68,14 @@ go Nothing action = action go result@(Just _) _action = return result -expectJust :: HasDebugCallStack => String -> Maybe a -> a +expectJust :: HasCallStack => Maybe a -> a +-- always enable the call stack to get the location even on non-debug builds {-# INLINE expectJust #-} -expectJust _ (Just x) = x -expectJust err Nothing = error ("expectJust " ++ err) +expectJust = fromMaybe expectJustError + +expectJustError :: HasCallStack => a +expectJustError = pprPanic "expectJust" empty +{-# NOINLINE expectJustError #-} whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenIsJust = for_ diff --git a/GHC/Data/Pair.hs b/GHC/Data/Pair.hs --- a/GHC/Data/Pair.hs +++ b/GHC/Data/Pair.hs @@ -66,3 +66,6 @@ !(as,bs) = unzipPairs prs -- This makes the unzip work eagerly, building no thunks at -- the cost of doing all the work up-front. + +instance Foldable1 Pair where + foldMap1 f (Pair a b) = f a Semi.<> f b diff --git a/GHC/Data/SmallArray.hs b/GHC/Data/SmallArray.hs --- a/GHC/Data/SmallArray.hs +++ b/GHC/Data/SmallArray.hs @@ -16,11 +16,18 @@ , mapSmallArray , foldMapSmallArray , rnfSmallArray + + -- * IO Operations + , SmallMutableArrayIO + , newSmallArrayIO + , writeSmallArrayIO + , unsafeFreezeSmallArrayIO ) where import GHC.Exts import GHC.Prelude +import GHC.IO import GHC.ST import Control.DeepSeq @@ -28,6 +35,8 @@ data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a) +type SmallMutableArrayIO a = SmallMutableArray RealWorld a + newSmallArray :: Int -- ^ size -> a -- ^ initial contents @@ -37,6 +46,9 @@ newSmallArray (I# sz) x s = case newSmallArray# sz x s of (# s', a #) -> (# s', SmallMutableArray a #) +newSmallArrayIO :: Int -> a -> IO (SmallMutableArrayIO a) +newSmallArrayIO sz x = IO $ \s -> newSmallArray sz x s + writeSmallArray :: SmallMutableArray s a -- ^ array -> Int -- ^ index @@ -46,7 +58,13 @@ {-# INLINE writeSmallArray #-} writeSmallArray (SmallMutableArray a) (I# i) x = writeSmallArray# a i x +writeSmallArrayIO :: SmallMutableArrayIO a + -> Int + -> a + -> IO () +writeSmallArrayIO a ix v = IO $ \s -> (# writeSmallArray a ix v s, () #) + -- | Copy and freeze a slice of a mutable array. freezeSmallArray :: SmallMutableArray s a -- ^ source @@ -68,6 +86,9 @@ unsafeFreezeSmallArray (SmallMutableArray ma) s = case unsafeFreezeSmallArray# ma s of (# s', a #) -> (# s', SmallArray a #) + +unsafeFreezeSmallArrayIO :: SmallMutableArrayIO a -> IO (SmallArray a) +unsafeFreezeSmallArrayIO arr = IO $ \s -> unsafeFreezeSmallArray arr s -- | Get the size of a 'SmallArray' sizeofSmallArray diff --git a/GHC/Data/Strict.hs b/GHC/Data/Strict.hs --- a/GHC/Data/Strict.hs +++ b/GHC/Data/Strict.hs @@ -22,9 +22,14 @@ import Control.Applicative import Data.Semigroup import Data.Data +import Control.DeepSeq data Maybe a = Nothing | Just !a deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Data) + +instance NFData a => NFData (Maybe a) where + rnf Nothing = () + rnf (Just x) = rnf x fromMaybe :: a -> Maybe a -> a fromMaybe d Nothing = d diff --git a/GHC/Data/StringBuffer.hs b/GHC/Data/StringBuffer.hs --- a/GHC/Data/StringBuffer.hs +++ b/GHC/Data/StringBuffer.hs @@ -6,7 +6,6 @@ Buffers for scanning string input stored in external arrays. -} -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE LambdaCase #-} @@ -77,12 +76,7 @@ import GHC.Exts import Foreign -#if MIN_VERSION_base(4,15,0) import GHC.ForeignPtr (unsafeWithForeignPtr) -#else -unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -unsafeWithForeignPtr = withForeignPtr -#endif -- ----------------------------------------------------------------------------- -- The StringBuffer type diff --git a/GHC/Data/TrieMap.hs b/GHC/Data/TrieMap.hs --- a/GHC/Data/TrieMap.hs +++ b/GHC/Data/TrieMap.hs @@ -69,7 +69,7 @@ lookupTM :: forall b. Key m -> m b -> Maybe b alterTM :: forall b. Key m -> XT b -> m b -> m b filterTM :: (a -> Bool) -> m a -> m a - + mapMaybeTM :: (a -> Maybe b) -> m a -> m b foldTM :: (a -> b -> b) -> m a -> b -> b -- The unusual argument order here makes -- it easy to compose calls to foldTM; @@ -146,6 +146,7 @@ alterTM = xtInt foldTM k m z = IntMap.foldr k z m filterTM f m = IntMap.filter f m + mapMaybeTM f m = IntMap.mapMaybe f m xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a xtInt k f m = IntMap.alter f k m @@ -157,6 +158,7 @@ alterTM k f m = Map.alter f k m foldTM k m z = Map.foldr k z m filterTM f m = Map.filter f m + mapMaybeTM f m = Map.mapMaybe f m {- @@ -233,6 +235,7 @@ alterTM k f m = alterUDFM f m k foldTM k m z = foldUDFM k z m filterTM f m = filterUDFM f m + mapMaybeTM f m = mapMaybeUDFM f m {- ************************************************************************ @@ -259,6 +262,7 @@ alterTM = xtMaybe alterTM foldTM = fdMaybe filterTM = ftMaybe + mapMaybeTM = mpMaybe instance TrieMap m => Foldable (MaybeMap m) where foldMap = foldMapTM @@ -281,6 +285,10 @@ ftMaybe f (MM { mm_nothing = mn, mm_just = mj }) = MM { mm_nothing = filterMaybe f mn, mm_just = filterTM f mj } +mpMaybe :: TrieMap m => (a -> Maybe b) -> MaybeMap m a -> MaybeMap m b +mpMaybe f (MM { mm_nothing = mn, mm_just = mj }) + = MM { mm_nothing = mn >>= f, mm_just = mapMaybeTM f mj } + foldMaybe :: (a -> b -> b) -> Maybe a -> b -> b foldMaybe _ Nothing b = b foldMaybe k (Just a) b = k a b @@ -314,6 +322,7 @@ alterTM = xtList alterTM foldTM = fdList filterTM = ftList + mapMaybeTM = mpList instance TrieMap m => Foldable (ListMap m) where foldMap = foldMapTM @@ -340,6 +349,10 @@ ftList f (LM { lm_nil = mnil, lm_cons = mcons }) = LM { lm_nil = filterMaybe f mnil, lm_cons = fmap (filterTM f) mcons } +mpList :: TrieMap m => (a -> Maybe b) -> ListMap m a -> ListMap m b +mpList f (LM { lm_nil = mnil, lm_cons = mcons }) + = LM { lm_nil = mnil >>= f, lm_cons = fmap (mapMaybeTM f) mcons } + {- ************************************************************************ * * @@ -395,6 +408,7 @@ alterTM = xtG foldTM = fdG filterTM = ftG + mapMaybeTM = mpG instance (Eq (Key m), TrieMap m) => Foldable (GenMap m) where foldMap = foldMapTM @@ -457,3 +471,11 @@ ftG f (MultiMap m) = MultiMap (filterTM f m) -- we don't have enough information to reconstruct the key to make -- a SingletonMap + +{-# INLINEABLE mpG #-} +mpG :: TrieMap m => (a -> Maybe b) -> GenMap m a -> GenMap m b +mpG _ EmptyMap = EmptyMap +mpG f (SingletonMap k v) = case f v of + Just v' -> SingletonMap k v' + Nothing -> EmptyMap +mpG f (MultiMap m) = MultiMap (mapMaybeTM f m) diff --git a/GHC/Data/Unboxed.hs b/GHC/Data/Unboxed.hs --- a/GHC/Data/Unboxed.hs +++ b/GHC/Data/Unboxed.hs @@ -4,6 +4,13 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UnliftedNewtypes #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} + -- If you use -fomit-interface-pragmas for your build, we won't + -- inline the matcher for JustUB, and that turns out to have a + -- catastropic effect on Lint, which uses unboxed Maybes. + -- Simple fix: switch off -fomit-interface-pragmas for this tiny + -- and very stable module. + module GHC.Data.Unboxed ( MaybeUB(JustUB, NothingUB), fmapMaybeUB, fromMaybeUB, apMaybeUB, maybeUB diff --git a/GHC/Data/Word64Map/Internal.hs b/GHC/Data/Word64Map/Internal.hs --- a/GHC/Data/Word64Map/Internal.hs +++ b/GHC/Data/Word64Map/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} @@ -303,14 +302,12 @@ import GHC.Utils.Containers.Internal.BitUtil import GHC.Utils.Containers.Internal.StrictPair -#ifdef __GLASGOW_HASKELL__ import Data.Coerce import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType, gcast1) import GHC.Exts (build) import qualified GHC.Exts as GHCExts import Text.Read -#endif import qualified Control.Category as Category import Data.Word @@ -481,7 +478,6 @@ rnf (Tip _ v) = rnf v rnf (Bin _ _ l r) = rnf l `seq` rnf r -#if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance @@ -505,7 +501,6 @@ intMapDataType :: DataType intMapDataType = mkDataType "Data.Word64Map.Internal.Word64Map" [fromListConstr] -#endif {-------------------------------------------------------------------- Query @@ -2394,13 +2389,11 @@ go (Tip k x) = Tip k (f x) go Nil = Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs "map/coerce" map coerce = coerce #-} -#endif -- | \(O(n)\). Map a function over all values in the map. -- @@ -2414,7 +2407,6 @@ Tip k x -> Tip k (f k x) Nil -> Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] mapWithKey #-} {-# RULES "mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) = @@ -2424,7 +2416,6 @@ "map/mapWithKey" forall f g xs . map f (mapWithKey g xs) = mapWithKey (\k a -> f (g k a)) xs #-} -#endif -- | \(O(n)\). -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ @@ -3093,13 +3084,11 @@ Lists --------------------------------------------------------------------} -#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHCExts.IsList (Word64Map a) where type Item (Word64Map a) = (Key,a) fromList = fromList toList = toList -#endif -- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list -- fusion. @@ -3127,7 +3116,6 @@ toDescList = foldlWithKey (\xs k x -> (k,x):xs) [] -- List fusion for the list generating functions. -#if __GLASGOW_HASKELL__ -- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion. -- They are important to convert unfused methods back, see mapFB in prelude. foldrFB :: (Key -> a -> b -> b) -> b -> Word64Map a -> b @@ -3159,7 +3147,6 @@ {-# RULES "Word64Map.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-} {-# RULES "Word64Map.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-} {-# RULES "Word64Map.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-} -#endif -- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs. @@ -3349,11 +3336,9 @@ instance Functor Word64Map where fmap = map -#ifdef __GLASGOW_HASKELL__ a <$ Bin p m l r = Bin p m (a <$ l) (a <$ r) a <$ Tip k _ = Tip k a _ <$ Nil = Nil -#endif {-------------------------------------------------------------------- Show @@ -3375,19 +3360,12 @@ Read --------------------------------------------------------------------} instance (Read e) => Read (Word64Map e) where -#ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault -#else - readsPrec p = readParen (p > 10) $ \ r -> do - ("fromList",s) <- lex r - (xs,t) <- reads s - return (fromList xs,t) -#endif -- | @since 0.5.9 instance Read1 Word64Map where diff --git a/GHC/Data/Word64Map/Lazy.hs b/GHC/Data/Word64Map/Lazy.hs --- a/GHC/Data/Word64Map/Lazy.hs +++ b/GHC/Data/Word64Map/Lazy.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | @@ -62,11 +61,7 @@ module GHC.Data.Word64Map.Lazy ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty diff --git a/GHC/Data/Word64Map/Strict.hs b/GHC/Data/Word64Map/Strict.hs --- a/GHC/Data/Word64Map/Strict.hs +++ b/GHC/Data/Word64Map/Strict.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | @@ -80,11 +79,7 @@ module GHC.Data.Word64Map.Strict ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty diff --git a/GHC/Data/Word64Map/Strict/Internal.hs b/GHC/Data/Word64Map/Strict/Internal.hs --- a/GHC/Data/Word64Map/Strict/Internal.hs +++ b/GHC/Data/Word64Map/Strict/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} @@ -82,11 +81,7 @@ module GHC.Data.Word64Map.Strict.Internal ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty @@ -823,13 +818,11 @@ go (Tip k x) = Tip k $! f x go Nil = Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs "map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs #-} -#endif -- | \(O(n)\). Map a function over all values in the map. -- @@ -843,7 +836,6 @@ Tip k x -> Tip k $! f k x Nil -> Nil -#ifdef __GLASGOW_HASKELL__ -- Pay close attention to strictness here. We need to force the -- intermediate result for map f . map g, and we need to refrain -- from forcing it for map f . L.map g, etc. @@ -871,7 +863,6 @@ "map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) = mapWithKey (\k a -> f (g k a)) xs #-} -#endif -- | \(O(n)\). -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ diff --git a/GHC/Data/Word64Set.hs b/GHC/Data/Word64Set.hs --- a/GHC/Data/Word64Set.hs +++ b/GHC/Data/Word64Set.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | @@ -60,11 +59,7 @@ -- $strictness -- * Set type -#if !defined(TESTING) Word64Set -- instance Eq,Show -#else - Word64Set(..) -- instance Eq,Show -#endif , Key -- * Construction @@ -150,10 +145,6 @@ , showTree , showTreeWith -#if defined(TESTING) - -- * Internals - , match -#endif ) where import GHC.Data.Word64Set.Internal as WS diff --git a/GHC/Data/Word64Set/Internal.hs b/GHC/Data/Word64Set/Internal.hs --- a/GHC/Data/Word64Set/Internal.hs +++ b/GHC/Data/Word64Set/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeFamilies #-} @@ -195,15 +194,11 @@ import GHC.Utils.Containers.Internal.BitUtil import GHC.Utils.Containers.Internal.StrictPair -#if __GLASGOW_HASKELL__ import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType) import qualified Data.Data import Text.Read -#endif -#if __GLASGOW_HASKELL__ import qualified GHC.Exts -#endif import Data.Functor.Identity (Identity(..)) @@ -268,7 +263,6 @@ (<>) = union stimes = stimesIdempotentMonoid -#if __GLASGOW_HASKELL__ {-------------------------------------------------------------------- A Data instance @@ -291,7 +285,6 @@ intSetDataType :: DataType intSetDataType = mkDataType "Data.Word64Set.Internal.Word64Set" [fromListConstr] -#endif {-------------------------------------------------------------------- Query @@ -502,15 +495,11 @@ choose True = inserted choose False = deleted -#ifndef __GLASGOW_HASKELL__ -{-# INLINE alterF #-} -#else {-# INLINABLE [2] alterF #-} {-# RULES "alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s #-} -#endif {-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> Word64Set -> Identity Word64Set #-} @@ -1128,13 +1117,11 @@ Lists --------------------------------------------------------------------} -#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHC.Exts.IsList Word64Set where type Item Word64Set = Key fromList = fromList toList = toList -#endif -- | \(O(n)\). Convert the set to a list of elements. Subject to list fusion. toList :: Word64Set -> [Key] @@ -1152,7 +1139,6 @@ toDescList = foldl (flip (:)) [] -- List fusion for the list generating functions. -#if __GLASGOW_HASKELL__ -- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion. -- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude. foldrFB :: (Key -> b -> b) -> b -> Word64Set -> b @@ -1178,7 +1164,6 @@ {-# RULES "Word64Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-} {-# RULES "Word64Set.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-} {-# RULES "Word64Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-} -#endif -- | \(O(n \min(n,W))\). Create a set from a list of integers. @@ -1302,19 +1287,12 @@ Read --------------------------------------------------------------------} instance Read Word64Set where -#ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault -#else - readsPrec p = readParen (p > 10) $ \ r -> do - ("fromList",s) <- lex r - (xs,t) <- reads s - return (fromList xs,t) -#endif {-------------------------------------------------------------------- NFData @@ -1536,7 +1514,6 @@ {-# INLINE foldr'Bits #-} {-# INLINE takeWhileAntitoneBits #-} -#if defined(__GLASGOW_HASKELL__) indexOfTheOnlyBit :: Nat -> Word64 {-# INLINE indexOfTheOnlyBit #-} indexOfTheOnlyBit bitmask = fromIntegral $ countTrailingZeros bitmask @@ -1603,63 +1580,6 @@ else ((1 `shiftLL` b) - 1) in bitmap .&. m -#else -{---------------------------------------------------------------------- - In general case we use logarithmic implementation of - lowestBitSet and highestBitSet, which works up to bit sizes of 64. - - Folds are linear scans. -----------------------------------------------------------------------} - -lowestBitSet n0 = - let (n1,b1) = if n0 .&. 0xFFFFFFFF /= 0 then (n0,0) else (n0 `shiftRL` 32, 32) - (n2,b2) = if n1 .&. 0xFFFF /= 0 then (n1,b1) else (n1 `shiftRL` 16, 16+b1) - (n3,b3) = if n2 .&. 0xFF /= 0 then (n2,b2) else (n2 `shiftRL` 8, 8+b2) - (n4,b4) = if n3 .&. 0xF /= 0 then (n3,b3) else (n3 `shiftRL` 4, 4+b3) - (n5,b5) = if n4 .&. 0x3 /= 0 then (n4,b4) else (n4 `shiftRL` 2, 2+b4) - b6 = if n5 .&. 0x1 /= 0 then b5 else 1+b5 - in b6 - -highestBitSet n0 = - let (n1,b1) = if n0 .&. 0xFFFFFFFF00000000 /= 0 then (n0 `shiftRL` 32, 32) else (n0,0) - (n2,b2) = if n1 .&. 0xFFFF0000 /= 0 then (n1 `shiftRL` 16, 16+b1) else (n1,b1) - (n3,b3) = if n2 .&. 0xFF00 /= 0 then (n2 `shiftRL` 8, 8+b2) else (n2,b2) - (n4,b4) = if n3 .&. 0xF0 /= 0 then (n3 `shiftRL` 4, 4+b3) else (n3,b3) - (n5,b5) = if n4 .&. 0xC /= 0 then (n4 `shiftRL` 2, 2+b4) else (n4,b4) - b6 = if n5 .&. 0x2 /= 0 then 1+b5 else b5 - in b6 - -foldlBits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) z (bm `shiftRL` lb) - where go !_ acc 0 = acc - go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1) - | otherwise = go (bi + 1) acc (n `shiftRL` 1) - -foldl'Bits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) z (bm `shiftRL` lb) - where go !_ !acc 0 = acc - go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1) - | otherwise = go (bi + 1) acc (n `shiftRL` 1) - -foldrBits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) (bm `shiftRL` lb) - where go !_ 0 = z - go bi n | n `testBit` 0 = f bi (go (bi + 1) (n `shiftRL` 1)) - | otherwise = go (bi + 1) (n `shiftRL` 1) - -foldr'Bits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) (bm `shiftRL` lb) - where - go !_ 0 = z - go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1) - | otherwise = go (bi + 1) (n `shiftRL` 1) - -takeWhileAntitoneBits prefix predicate = foldl'Bits prefix f 0 -- Does not use antitone property - where - f acc bi | predicate bi = acc .|. bitmapOf bi - | otherwise = acc - -#endif {-------------------------------------------------------------------- diff --git a/GHC/Driver/Backend.hs b/GHC/Driver/Backend.hs --- a/GHC/Driver/Backend.hs +++ b/GHC/Driver/Backend.hs @@ -214,6 +214,7 @@ ArchAArch64 -> True ArchWasm32 -> True ArchRISCV64 -> True + ArchLoongArch64 -> True _ -> False -- | Is the platform supported by the JS backend? diff --git a/GHC/Driver/Backpack.hs b/GHC/Driver/Backpack.hs --- a/GHC/Driver/Backpack.hs +++ b/GHC/Driver/Backpack.hs @@ -24,7 +24,7 @@ -- In a separate module because it hooks into the parser. import GHC.Driver.Backpack.Syntax import GHC.Driver.Config.Finder (initFinderOpts) -import GHC.Driver.Config.Parser (initParserOpts) +import GHC.Driver.Config.Parser import GHC.Driver.Config.Diagnostic import GHC.Driver.Monad import GHC.Driver.Session @@ -45,14 +45,13 @@ import GHC hiding (Failed, Succeeded) import GHC.Tc.Utils.Monad import GHC.Iface.Recomp -import GHC.Builtin.Names import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.SourceFile import GHC.Types.Unique.FM -import GHC.Types.Unique.DFM import GHC.Types.Unique.DSet +import GHC.Types.Basic (convImportLevel) import GHC.Utils.Outputable import GHC.Utils.Fingerprint @@ -67,7 +66,6 @@ import GHC.Unit.Finder import GHC.Unit.Module.Graph import GHC.Unit.Module.ModSummary -import GHC.Unit.Home.ModInfo import GHC.Linker.Types @@ -92,6 +90,9 @@ import qualified Data.Map as Map import qualified Data.Set as Set import GHC.Types.Error (mkUnknownDiagnostic) +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable -- | Entry point to compile a Backpack file. doBackpack :: [FilePath] -> Ghc () @@ -100,8 +101,9 @@ dflags0 <- getDynFlags let dflags1 = dflags0 let parser_opts1 = initParserOpts dflags1 - (p_warns, src_opts) <- liftIO $ getOptionsFromFile parser_opts1 src_filename - (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma dflags1 src_opts + logger0 <- getLogger + (p_warns, src_opts) <- liftIO $ getOptionsFromFile parser_opts1 (supportedLanguagePragmas dflags1) src_filename + (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma logger0 dflags1 src_opts modifySession (hscSetFlags dflags) logger <- getLogger -- Get the logger after having set the session flags, -- so that logger options are correctly set. @@ -334,7 +336,7 @@ ok <- load' noIfaceCache LoadAllTargets mkUnknownDiagnostic (Just msg) mod_graph when (failed ok) (liftIO $ exitWith (ExitFailure 1)) - let hi_dir = expectJust (panic "hiDir Backpack") $ hiDir dflags + let hi_dir = expectJust $ hiDir dflags export_mod ms = (ms_mod_name ms, ms_mod ms) -- Export everything! mods = [ export_mod ms | ms <- mgModSummaries mod_graph @@ -342,14 +344,17 @@ -- Compile relevant only hsc_env <- getSession - let home_mod_infos = eltsUDFM (hsc_HPT hsc_env) - linkables = map (expectJust "bkp link" . homeModInfoObject) - . filter ((==HsSrcFile) . mi_hsc_src . hm_iface) - $ home_mod_infos + let takeLinkables x + | mi_hsc_src (hm_iface x) == HsSrcFile + = [Just $ expectJust $ homeModInfoObject x] + | otherwise + = [Nothing] + linkables <- liftIO $ catMaybes <$> concatHpt takeLinkables (hsc_HPT hsc_env) + let obj_files = concatMap linkableFiles linkables state = hsc_units hsc_env - let compat_fs = unitIdFS cid + compat_fs = unitIdFS cid compat_pn = PackageName compat_fs unit_id = homeUnitId (hsc_home_unit hsc_env) @@ -442,16 +447,17 @@ -- update platform constants dflags <- liftIO $ updatePlatformConstants dflags0 mconstants - let unit_env = ue_setUnits unit_state $ ue_setUnitDbs (Just dbs) $ UnitEnv + let unit_env = UnitEnv { ue_platform = targetPlatform dflags , ue_namever = ghcNameVersion dflags , ue_current_unit = homeUnitId home_unit , ue_home_unit_graph = - unitEnv_singleton + HUG.unitEnv_singleton (homeUnitId home_unit) - (mkHomeUnitEnv dflags (ue_hpt old_unit_env) (Just home_unit)) + (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags (ue_hpt old_unit_env) (Just home_unit)) , ue_eps = ue_eps old_unit_env + , ue_module_graph = ue_module_graph old_unit_env } setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env } @@ -580,7 +586,7 @@ NeedsRecompile reason0 -> showMsg (text "Instantiating ") $ case reason0 of MustCompile -> empty RecompBecause reason -> text " [" <> pprWithUnitState state (ppr reason) <> text "]" - ModuleNode _ _ -> + ModuleNode {} -> case recomp of UpToDate | verbosity (hsc_dflags hsc_env) >= 2 -> showMsg (text "Skipping ") empty @@ -589,6 +595,7 @@ MustCompile -> empty RecompBecause reason -> text " [" <> pprWithUnitState state (ppr reason) <> text "]" LinkNode _ _ -> showMsg (text "Linking ") empty + UnitNode {} -> showMsg (text "Package ") empty -- | 'PprStyle' for Backpack messages; here we usually want the module to -- be qualified (so we can tell how it was instantiated.) But we try not @@ -741,16 +748,19 @@ -- create an "empty" hsig file to induce compilation for the -- requirement. let hsig_set = Set.fromList - [ ms_mod_name ms + [ moduleNodeInfoModuleName ms | ModuleNode _ ms <- nodes - , ms_hsc_src ms == HsigFile + , moduleNodeInfoHscSource ms == Just HsigFile ] req_nodes <- fmap catMaybes . forM (homeUnitInstantiations home_unit) $ \(mod_name, _) -> if Set.member mod_name hsig_set then return Nothing else fmap Just $ summariseRequirement pn mod_name - - let graph_nodes = nodes ++ req_nodes ++ (instantiationNodes (homeUnitId $ hsc_home_unit hsc_env) (hsc_units hsc_env)) + let inodes = instantiationNodes (homeUnitId $ hsc_home_unit hsc_env) (hsc_units hsc_env) + -- TODO: Backpack mode does not properly support ExternalPackage nodes yet + -- Module nodes do not get given package dependencies (see hsModuleToModSummary). + let pkg_nodes = ordNub $ map (\(_, iud) -> UnitNode [] (instUnitInstanceOf iud)) inodes + let graph_nodes = nodes ++ req_nodes ++ (map (uncurry InstantiationNode) $ inodes) ++ pkg_nodes key_nodes = map mkNodeKey graph_nodes all_nodes = graph_nodes ++ [LinkNode key_nodes (homeUnitId $ hsc_home_unit hsc_env) | do_link] -- This error message is not very good but .bkp mode is just for testing so @@ -781,7 +791,7 @@ let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1) let fc = hsc_FC hsc_env - mod <- liftIO $ addHomeModuleToFinder fc home_unit (notBoot mod_name) location + mod <- liftIO $ addHomeModuleToFinder fc home_unit mod_name location HsigFile extra_sig_imports <- liftIO $ findExtraSigImports hsc_env HsigFile mod_name @@ -795,8 +805,7 @@ ms_iface_date = hi_timestamp, ms_hie_date = hie_timestamp, ms_srcimps = [], - ms_textual_imps = ((,) NoPkgQual . noLoc) <$> extra_sig_imports, - ms_ghc_prim_import = False, + ms_textual_imps = ((,,) NormalLevel NoPkgQual . noLoc) <$> extra_sig_imports, ms_parsed_mod = Just (HsParsedModule { hpm_module = L loc (HsModule { hsmodExt = XModulePs { @@ -816,8 +825,8 @@ ms_hspp_opts = dflags, ms_hspp_buf = Nothing } - let nodes = [NodeKey_Module (ModNodeKeyWithUid (GWIB mn NotBoot) (homeUnitId home_unit)) | mn <- extra_sig_imports ] - return (ModuleNode nodes ms) + let nodes = [mkModuleEdge NormalLevel (NodeKey_Module (ModNodeKeyWithUid (GWIB mn NotBoot) (homeUnitId home_unit))) | mn <- extra_sig_imports ] + return (ModuleNode nodes (ModuleNodeCompile ms)) summariseDecl :: PackageName -> HscSource @@ -854,17 +863,14 @@ -- To add insult to injury, we don't even actually use -- these filenames to figure out where the hi files go. -- A travesty! - let location0 = mkHomeModLocation2 fopts modname + let location = mkHomeModLocation fopts modname (unsafeEncodeUtf $ unpackFS unit_fs moduleNameSlashes modname) - (case hsc_src of + (case hsc_src of HsigFile -> os "hsig" HsBootFile -> os "hs-boot" HsSrcFile -> os "hs") - -- DANGEROUS: bootifying can POISON the module finder cache - let location = case hsc_src of - HsBootFile -> addBootSuffixLocnOut location0 - _ -> location0 + hsc_src -- This duplicates a pile of logic in GHC.Driver.Make hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location) hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location) @@ -872,28 +878,23 @@ -- Also copied from 'getImports' let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps - -- GHC.Prim doesn't exist physically, so don't go looking for it. - (ordinary_imps, ghc_prim_import) - = partition ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) - ord_idecls - implicit_prelude = xopt LangExt.ImplicitPrelude dflags implicit_imports = mkPrelImports modname loc implicit_prelude imps rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) modname - convImport (L _ i) = (rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i) + convImport (L _ i) = (convImportLevel (ideclLevelSpec i), rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i) extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname - let normal_imports = map convImport (implicit_imports ++ ordinary_imps) + let normal_imports = map convImport (implicit_imports ++ ord_idecls) (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env normal_imports -- So that Finder can find it, even though it doesn't exist... this_mod <- liftIO $ do let home_unit = hsc_home_unit hsc_env let fc = hsc_FC hsc_env - addHomeModuleToFinder fc home_unit (GWIB modname (hscSourceToIsBoot hsc_src)) location + addHomeModuleToFinder fc home_unit modname location hsc_src let ms = ModSummary { ms_mod = this_mod, ms_hsc_src = hsc_src, @@ -903,14 +904,13 @@ Just d -> d) ".." moduleNameSlashes modname <.> "hi", ms_hspp_opts = dflags, ms_hspp_buf = Nothing, - ms_srcimps = map convImport src_idecls, - ms_ghc_prim_import = not (null ghc_prim_import), + ms_srcimps = (\i -> reLoc (ideclName (unLoc i))) <$> src_idecls, ms_textual_imps = normal_imports -- We have to do something special here: -- due to merging, requirements may end up with -- extra imports - ++ ((,) NoPkgQual . noLoc <$> extra_sig_imports) - ++ ((,) NoPkgQual . noLoc <$> implicit_sigs), + ++ ((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports) + ++ ((,,) NormalLevel NoPkgQual . noLoc <$> implicit_sigs), -- This is our hack to get the parse tree to the right spot ms_parsed_mod = Just (HsParsedModule { hpm_module = hsmod, @@ -930,12 +930,12 @@ let inst_nodes = map NodeKey_Unit inst_deps mod_nodes = -- hs-boot edge - [k | k <- [NodeKey_Module (ModNodeKeyWithUid (GWIB (ms_mod_name ms) IsBoot) (moduleUnitId this_mod))], NotBoot == isBootSummary ms, k `elem` home_keys ] ++ + [k | k <- [NodeKey_Module (ModNodeKeyWithUid (GWIB (ms_mod_name ms) IsBoot) (moduleUnitId this_mod))], NotBoot == isBootSummary ms, k `elem` home_keys ] ++ -- Normal edges - [k | (_, mnwib) <- msDeps ms, let k = NodeKey_Module (ModNodeKeyWithUid (fmap unLoc mnwib) (moduleUnitId this_mod)), k `elem` home_keys] + [k | (_, _, mnwib) <- msDeps ms, let k = NodeKey_Module (ModNodeKeyWithUid (fmap unLoc mnwib) (moduleUnitId this_mod)), k `elem` home_keys] - return (ModuleNode (mod_nodes ++ inst_nodes) ms) + return (ModuleNode (map mkNormalEdge (mod_nodes ++ inst_nodes)) (ModuleNodeCompile ms)) -- | Create a new, externally provided hashed unit id from -- a hash. diff --git a/GHC/Driver/Config.hs b/GHC/Driver/Config.hs --- a/GHC/Driver/Config.hs +++ b/GHC/Driver/Config.hs @@ -3,6 +3,7 @@ ( initOptCoercionOpts , initSimpleOpts , initEvalOpts + , EvalStep(..) ) where @@ -25,15 +26,32 @@ { so_uf_opts = unfoldingOpts dflags , so_co_opts = initOptCoercionOpts dflags , so_eta_red = gopt Opt_DoEtaReduction dflags + , so_inline = True } +-- | Instruct the interpreter evaluation to break... +data EvalStep + -- | ... at every breakpoint tick + = EvalStepSingle + -- | ... after any evaluation to WHNF + -- (See Note [Debugger: Step-out]) + | EvalStepOut + -- | ... only on explicit breakpoints + | EvalStepNone + -- | Extract GHCi options from DynFlags and step -initEvalOpts :: DynFlags -> Bool -> EvalOpts +initEvalOpts :: DynFlags -> EvalStep -> EvalOpts initEvalOpts dflags step = EvalOpts { useSandboxThread = gopt Opt_GhciSandbox dflags - , singleStep = step + , singleStep = singleStep + , stepOut = stepOut , breakOnException = gopt Opt_BreakOnException dflags , breakOnError = gopt Opt_BreakOnError dflags } + where + (singleStep, stepOut) = case step of + EvalStepSingle -> (True, False) + EvalStepOut -> (False, True) + EvalStepNone -> (False, False) diff --git a/GHC/Driver/Config/Core/Lint.hs b/GHC/Driver/Config/Core/Lint.hs --- a/GHC/Driver/Config/Core/Lint.hs +++ b/GHC/Driver/Config/Core/Lint.hs @@ -147,12 +147,6 @@ check_lbs = case pass of CoreDesugar -> False CoreDesugarOpt -> False - - -- Disable Lint warnings on the first simplifier pass, because - -- there may be some INLINE knots still tied, which is tiresomely noisy - CoreDoSimplify cfg - | InitialPhase <- sm_phase (so_mode cfg) - -> False _ -> True -- See Note [Checking StaticPtrs] diff --git a/GHC/Driver/Config/Core/Rules.hs b/GHC/Driver/Config/Core/Rules.hs --- a/GHC/Driver/Config/Core/Rules.hs +++ b/GHC/Driver/Config/Core/Rules.hs @@ -5,19 +5,15 @@ import GHC.Prelude import GHC.Driver.Flags -import GHC.Driver.DynFlags ( DynFlags, gopt, targetPlatform, homeUnitId_ ) +import GHC.Driver.DynFlags ( DynFlags, gopt, targetPlatform ) import GHC.Core.Rules.Config -import GHC.Unit.Types ( primUnitId, bignumUnitId ) - -- | Initialize RuleOpts from DynFlags initRuleOpts :: DynFlags -> RuleOpts initRuleOpts dflags = RuleOpts { roPlatform = targetPlatform dflags , roNumConstantFolding = gopt Opt_NumConstantFolding dflags , roExcessRationalPrecision = gopt Opt_ExcessPrecision dflags - -- disable bignum rules in ghc-prim and ghc-bignum itself - , roBignumRules = homeUnitId_ dflags /= primUnitId - && homeUnitId_ dflags /= bignumUnitId + , roBignumRules = True } diff --git a/GHC/Driver/Config/Linker.hs b/GHC/Driver/Config/Linker.hs --- a/GHC/Driver/Config/Linker.hs +++ b/GHC/Driver/Config/Linker.hs @@ -27,9 +27,8 @@ ld_filter = case platformOS (targetPlatform dflags) of OSSolaris2 -> sunos_ld_filter _ -> id - sunos_ld_filter :: String -> String - sunos_ld_filter = unlines . sunos_ld_filter' . lines - sunos_ld_filter' x = if (undefined_found x && ld_warning_found x) + sunos_ld_filter :: [String] -> [String] + sunos_ld_filter x = if (undefined_found x && ld_warning_found x) then (ld_prefix x) ++ (ld_postfix x) else x breakStartsWith x y = break (isPrefixOf x) y diff --git a/GHC/Driver/Config/Parser.hs b/GHC/Driver/Config/Parser.hs --- a/GHC/Driver/Config/Parser.hs +++ b/GHC/Driver/Config/Parser.hs @@ -1,5 +1,6 @@ module GHC.Driver.Config.Parser ( initParserOpts + , supportedLanguagePragmas ) where @@ -17,9 +18,10 @@ mkParserOpts <$> extensionFlags <*> initDiagOpts - <*> (supportedLanguagesAndExtensions . platformArchOS . targetPlatform) <*> safeImportsOn <*> gopt Opt_Haddock <*> gopt Opt_KeepRawTokenStream <*> const True -- use LINE/COLUMN to update the internal location +supportedLanguagePragmas :: DynFlags -> [String] +supportedLanguagePragmas = supportedLanguagesAndExtensions . platformArchOS . targetPlatform diff --git a/GHC/Driver/Config/StgToCmm.hs b/GHC/Driver/Config/StgToCmm.hs --- a/GHC/Driver/Config/StgToCmm.hs +++ b/GHC/Driver/Config/StgToCmm.hs @@ -82,6 +82,7 @@ , stgToCmmAllowIntMul2Instr = (ncg && (x86ish || aarch64)) || llvm , stgToCmmAllowWordMul2Instr = (ncg && (x86ish || ppc || aarch64)) || llvm + , stgToCmmAllowIntWord64X2MinMax = (ncg && x86ish && isSse4_2Enabled dflags) || llvm -- SIMD flags , stgToCmmVecInstrsErr = vec_err , stgToCmmAvx = isAvxEnabled dflags diff --git a/GHC/Driver/Downsweep.hs b/GHC/Driver/Downsweep.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/Downsweep.hs @@ -0,0 +1,1547 @@ +{-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ViewPatterns #-} +module GHC.Driver.Downsweep + ( downsweep + , downsweepThunk + , downsweepInstalledModules + , downsweepFromRootNodes + , downsweepInteractiveImports + , DownsweepMode(..) + -- * Summary functions + , summariseModule + , summariseFile + , summariseModuleInterface + , SummariseResult(..) + -- * Helper functions + , instantiationNodes + , checkHomeUnitsClosed + ) where + +import GHC.Prelude + +import GHC.Platform.Ways + +import GHC.Driver.Config.Finder (initFinderOpts) +import GHC.Driver.Config.Parser (initParserOpts) +import GHC.Driver.Phases +import {-# SOURCE #-} GHC.Driver.Pipeline (preprocess) +import GHC.Driver.Session +import GHC.Driver.Backend +import GHC.Driver.Monad +import GHC.Driver.Env +import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Messager +import GHC.Driver.MakeSem +import GHC.Driver.MakeAction +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Ppr + +import GHC.Iface.Load + +import GHC.Parser.Header +import GHC.Rename.Names +import GHC.Tc.Utils.Backpack +import GHC.Runtime.Context + +import Language.Haskell.Syntax.ImpExp + +import GHC.Data.Graph.Directed +import GHC.Data.FastString +import GHC.Data.Maybe ( expectJust ) +import qualified GHC.Data.Maybe as M +import GHC.Data.OsPath ( unsafeEncodeUtf ) +import GHC.Data.StringBuffer +import GHC.Data.Graph.Directed.Reachability +import qualified GHC.LanguageExtensions as LangExt + +import GHC.Utils.Exception ( throwIO, SomeAsyncException ) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Misc +import GHC.Utils.Error +import GHC.Utils.Logger +import GHC.Utils.Fingerprint +import GHC.Utils.TmpFs +import GHC.Utils.Constants + +import GHC.Types.Error +import GHC.Types.Target +import GHC.Types.SourceFile +import GHC.Types.SourceError +import GHC.Types.SrcLoc +import GHC.Types.Unique.Map +import GHC.Types.PkgQual +import GHC.Types.Basic + + +import GHC.Unit +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Graph +import GHC.Unit.Module.Deps +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Module.Stage + +import Data.Either ( rights, partitionEithers, lefts ) +import qualified Data.Map as Map +import qualified Data.Set as Set + +import Control.Concurrent.MVar +import Control.Monad +import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) +import qualified Control.Monad.Catch as MC +import Data.Maybe +import Data.List (partition) +import Data.Time +import Data.List (unfoldr) +import Data.Bifunctor (first, bimap) +import System.Directory +import System.FilePath + +import Control.Monad.Trans.Reader +import qualified Data.Map.Strict as M +import Control.Monad.Trans.Class +import System.IO.Unsafe (unsafeInterleaveIO) + +{- +Note [Downsweep and the ModuleGraph] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The ModuleGraph stores the relationship between all the modules, units, and +instantiations in the current session. + +When we do downsweep, we build up a new ModuleGraph, starting from the root +modules. By following all the dependencies we construct a graph which allows +us to answer questions about the transitive closure of the imports. + +The module graph is accessible in the HscEnv. + +When is this graph constructed? + +1. In `--make` mode, we construct the graph before starting to do any compilation. + +2. In `-c` (oneshot) mode, we construct the graph when we have calculated the + ModSummary for the module we are compiling. The `ModuleGraph` is stored in a + thunk, so it is only constructed when it is needed. This avoids reading + the interface files of the whole transitive closure unless they are needed. + +3. In some situations (such as loading plugins) we may need to construct the + graph without having a ModSummary. In this case we use the `downsweepInstalledModules` + function. + +The result is having a uniform graph available for the whole compilation pipeline. + +-} + +-- This caches the answer to the question, if we are in this unit, what does +-- an import of this module mean. +type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModuleNodeInfo] + +----------------------------------------------------------------------------- +-- +-- | Downsweep (dependency analysis) for --make mode +-- +-- Chase downwards from the specified root set, returning summaries +-- for all home modules encountered. Only follow source-import +-- links. +-- +-- We pass in the previous collection of summaries, which is used as a +-- cache to avoid recalculating a module summary if the source is +-- unchanged. +-- +-- The returned ModuleGraph has one node for each home-package +-- module, plus one for any hs-boot files. The imports of these nodes +-- are all there, including the imports of non-home-package modules. +-- +-- This function is intendned for use by --make mode and will also insert +-- LinkNodes and InstantiationNodes for any home units. +-- +-- It will also turn on code generation for any modules that need it by calling +-- 'enableCodeGenForTH'. +downsweep :: HscEnv + -> (GhcMessage -> AnyGhcDiagnostic) + -> Maybe Messager + -> [ModSummary] + -- ^ Old summaries + -> [ModuleName] -- Ignore dependencies on these; treat + -- them as if they were package modules + -> Bool -- True <=> allow multiple targets to have + -- the same module name; this is + -- very useful for ghc -M + -> IO ([DriverMessages], ModuleGraph) + -- The non-error elements of the returned list all have distinct + -- (Modules, IsBoot) identifiers, unless the Bool is true in + -- which case there can be repeats +downsweep hsc_env diag_wrapper msg old_summaries excl_mods allow_dup_roots = do + n_jobs <- mkWorkerLimit (hsc_dflags hsc_env) + (root_errs, root_summaries) <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary + let closure_errs = checkHomeUnitsClosed unit_env + unit_env = hsc_unit_env hsc_env + + all_errs = closure_errs ++ root_errs + + case all_errs of + [] -> do + (downsweep_errs, downsweep_nodes) <- downsweepFromRootNodes hsc_env old_summary_map excl_mods allow_dup_roots DownsweepUseCompile (map ModuleNodeCompile root_summaries) [] + + let (other_errs, unit_nodes) = partitionEithers $ HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env) + + let all_nodes = downsweep_nodes ++ unit_nodes + let all_errs = downsweep_errs ++ other_errs + + let logger = hsc_logger hsc_env + tmpfs = hsc_tmpfs hsc_env + -- if we have been passed -fno-code, we enable code generation + -- for dependencies of modules that have -XTemplateHaskell, + -- otherwise those modules will fail to compile. + -- See Note [-fno-code mode] #8025 + th_configured_nodes <- enableCodeGenForTH logger tmpfs unit_env all_nodes + + return (all_errs, th_configured_nodes) + _ -> return (all_errs, emptyMG) + where + summary = getRootSummary excl_mods old_summary_map + + -- A cache from file paths to the already summarised modules. The same file + -- can be used in multiple units so the map is also keyed by which unit the + -- file was used in. + -- Reuse these if we can because the most expensive part of downsweep is + -- reading the headers. + old_summary_map :: M.Map (UnitId, FilePath) ModSummary + old_summary_map = + M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries] + + -- Dependencies arising on a unit (backpack and module linking deps) + unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode] + unitModuleNodes summaries uid hue = + maybeToList (linkNodes summaries uid hue) + +-- | Calculate the module graph starting from a single ModSummary. The result is a +-- thunk, which when forced will perform the downsweep. This is useful in oneshot +-- mode where the module graph may never be needed. +-- If downsweep fails, then the resulting errors are just thrown. +downsweepThunk :: HscEnv -> ModSummary -> IO ModuleGraph +downsweepThunk hsc_env mod_summary = unsafeInterleaveIO $ do + debugTraceMsg (hsc_logger hsc_env) 3 $ text "Computing Module Graph thunk..." + ~(errs, mg) <- downsweepFromRootNodes hsc_env mempty [] True DownsweepUseFixed [ModuleNodeCompile mod_summary] [] + let dflags = hsc_dflags hsc_env + liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env) + (initPrintConfig dflags) + (initDiagOpts dflags) + (GhcDriverMessage <$> unionManyMessages errs) + return (mkModuleGraph mg) + +-- | Construct a module graph starting from the interactive context. +-- Produces, a thunk, which when forced will perform the downsweep. +-- This graph contains the current interactive module, and its dependencies. +-- +-- Invariant: The hsc_mod_graph already contains the relevant home modules which +-- might be imported by the interactive imports. +-- +-- This is a first approximation for this function. There probably should also +-- be edges linking the interactive modules together. (Ie Ghci7 importing Ghci6 +-- and so on) +-- See Note [runTcInteractive module graph] +downsweepInteractiveImports :: HscEnv -> InteractiveContext -> IO ModuleGraph +downsweepInteractiveImports hsc_env ic = unsafeInterleaveIO $ do + debugTraceMsg (hsc_logger hsc_env) 3 $ (text "Computing Interactive Module Graph thunk...") + let imps = ic_imports (hsc_IC hsc_env) + + let interactive_mn = icInteractiveModule ic + -- No sensible value for ModLocation.. if you hit this panic then you probably + -- need to add proper support for modules without any source files to the driver. + let ml = pprPanic "modLocation" (ppr interactive_mn <+> ppr imps) + let key = moduleToMnk interactive_mn NotBoot + let node_type = ModuleNodeFixed key ml + + -- The existing nodes in the module graph. This will be populated when GHCi runs + -- :load. Any home package modules need to already be in here. + let cached_nodes = Map.fromList [ (mkNodeKey n, n) | n <- mg_mss (hsc_mod_graph hsc_env) ] + + (module_edges, graph) <- loopFromInteractive hsc_env (map mkEdge imps) cached_nodes + let interactive_node = ModuleNode module_edges node_type + + let all_nodes = M.elems graph + return $ mkModuleGraph (interactive_node : all_nodes) + + where + -- + mkEdge :: InteractiveImport -> Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName)) + -- A simple edge to a module from the same home unit + mkEdge (IIModule n) = + let + mod_node_key = ModNodeKeyWithUid + { mnkModuleName = GWIB (moduleName n) NotBoot + , mnkUnitId = + -- 'toUnitId' is safe here, as we can't import modules that + -- don't have a 'UnitId'. + toUnitId (moduleUnit n) + } + mod_node_edge = + ModuleNodeEdge NormalLevel (NodeKey_Module mod_node_key) + in Left mod_node_edge + -- A complete import statement + mkEdge (IIDecl i) = + let lvl = convImportLevel (ideclLevelSpec i) + wanted_mod = unLoc (ideclName i) + is_boot = ideclSource i + mb_pkg = renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i) + unitId = homeUnitId $ hsc_home_unit hsc_env + in Right (unitId, lvl, mb_pkg, GWIB (noLoc wanted_mod) is_boot) + +loopFromInteractive :: HscEnv + -> [Either ModuleNodeEdge (UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))] + -> M.Map NodeKey ModuleGraphNode + -> IO ([ModuleNodeEdge],M.Map NodeKey ModuleGraphNode) +loopFromInteractive _ [] cached_nodes = return ([], cached_nodes) +loopFromInteractive hsc_env (edge:edges) cached_nodes = + case edge of + Left edge -> do + (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes + return (edge : edges, cached_nodes') + Right (unitId, lvl, mb_pkg, GWIB wanted_mod is_boot) -> do + let home_unit = ue_unitHomeUnit unitId (hsc_unit_env hsc_env) + let k _ loc mod = + let key = moduleToMnk mod is_boot + in return $ FoundHome (ModuleNodeFixed key loc) + found <- liftIO $ summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg [] + case found of + -- Case 1: Home modules have to already be in the cache. + FoundHome (ModuleNodeFixed mod _) -> do + let edge = ModuleNodeEdge lvl (NodeKey_Module mod) + -- Note: Does not perform any further downsweep as the module must already be in the cache. + (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes + return (edge : edges, cached_nodes') + -- Case 2: External units may not be in the cache, if we haven't already initialised the + -- module graph. We can construct the module graph for those here by calling loopUnit. + External uid -> do + let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env + cached_nodes' = loopUnit hsc_env' cached_nodes [uid] + edge = ModuleNodeEdge lvl (NodeKey_ExternalUnit uid) + (edges, cached_nodes') <- loopFromInteractive hsc_env edges cached_nodes' + return (edge : edges, cached_nodes') + -- And if it's not found.. just carry on and hope. + _ -> loopFromInteractive hsc_env edges cached_nodes + + +-- | Create a module graph from a list of installed modules. +-- This is used by the loader when we need to load modules but there +-- isn't already an existing module graph. For example, when loading plugins +-- during initialisation. +-- +-- If you call this function, then if the `Module` you request to downsweep can't +-- be found then this function will throw errors. +-- If you need to use this function elsewhere, then it would make sense to make it +-- return [DriverMessages] and [ModuleGraph] so that the caller can handle the errors as it sees fit. +-- At the moment, it is overfitted for what `get_reachable_nodes` needs. +downsweepInstalledModules :: HscEnv -> [Module] -> IO ModuleGraph +downsweepInstalledModules hsc_env mods = do + let + (home_mods, external_mods) = partition (\u -> moduleUnitId u `elem` hsc_all_home_unit_ids hsc_env) mods + installed_mods = map (fst . getModuleInstantiation) home_mods + external_uids = map moduleUnitId external_mods + + process :: InstalledModule -> IO ModuleNodeInfo + process i = do + res <- findExactModule hsc_env i NotBoot + case res of + InstalledFound loc -> return $ ModuleNodeFixed (installedModuleToMnk i) loc + -- It is an internal-ish error if this happens, since we any call to this function should + -- already know that we can find the modules we need to load. + _ -> throwGhcException $ ProgramError $ showSDoc (hsc_dflags hsc_env) $ text "downsweepInstalledModules: Could not find installed module" <+> ppr i + + nodes <- mapM process installed_mods + (errs, mg) <- downsweepFromRootNodes hsc_env mempty [] True DownsweepUseFixed nodes external_uids + + -- Similarly here, we should really not get any errors, but print them out if we do. + let dflags = hsc_dflags hsc_env + liftIO $ printOrThrowDiagnostics (hsc_logger hsc_env) + (initPrintConfig dflags) + (initDiagOpts dflags) + (GhcDriverMessage <$> unionManyMessages errs) + + return (mkModuleGraph mg) + + + +-- | Whether downsweep should use compiler or fixed nodes. Compile nodes are used +-- by --make mode, and fixed nodes by oneshot mode. +-- +-- See Note [Module Types in the ModuleGraph] for the difference between the two. +data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed + +-- | Perform downsweep, starting from the given root 'ModuleNodeInfo's and root +-- 'UnitId's. +-- This function will start at the given roots, and traverse downwards to find +-- all the dependencies, all the way to the leaf units. +downsweepFromRootNodes :: HscEnv + -> M.Map (UnitId, FilePath) ModSummary + -> [ModuleName] + -> Bool + -> DownsweepMode -- ^ Whether to create fixed or compile nodes for dependencies + -> [ModuleNodeInfo] -- ^ The starting ModuleNodeInfo + -> [UnitId] -- ^ The starting units + -> IO ([DriverMessages], [ModuleGraphNode]) +downsweepFromRootNodes hsc_env old_summaries excl_mods allow_dup_roots mode root_nodes root_uids + = do + let root_map = mkRootMap root_nodes + checkDuplicates root_map + let env = DownsweepEnv hsc_env mode old_summaries excl_mods + (deps', map0) <- runDownsweepM env $ do + (module_deps, map0) <- loopModuleNodeInfos root_nodes (M.empty, root_map) + let all_deps = loopUnit hsc_env module_deps root_uids + let all_instantiations = getHomeUnitInstantiations hsc_env + deps' <- loopInstantiations all_instantiations all_deps + return (deps', map0) + + + let downsweep_errs = lefts $ concat $ M.elems map0 + downsweep_nodes = M.elems deps' + + return (downsweep_errs, downsweep_nodes) + where + getHomeUnitInstantiations :: HscEnv -> [(UnitId, InstantiatedUnit)] + getHomeUnitInstantiations hsc_env = HUG.unitEnv_foldWithKey (\nodes uid hue -> nodes ++ instantiationNodes uid (homeUnitEnv_units hue)) [] (hsc_HUG hsc_env) + + -- In a root module, the filename is allowed to diverge from the module + -- name, so we have to check that there aren't multiple root files + -- defining the same module (otherwise the duplicates will be silently + -- ignored, leading to confusing behaviour). + checkDuplicates + :: DownsweepCache + -> IO () + checkDuplicates root_map + | not allow_dup_roots + , dup_root:_ <- dup_roots = liftIO $ multiRootsErr dup_root + | otherwise = pure () + where + dup_roots :: [[ModuleNodeInfo]] -- Each at least of length 2 + dup_roots = filterOut isSingleton $ map rights (M.elems root_map) + + +calcDeps :: ModSummary -> [(UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))] +calcDeps ms = + -- Add a dependency on the HsBoot file if it exists + -- This gets passed to the loopImports function which just ignores it if it + -- can't be found. + [(ms_unitid ms, NormalLevel, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++ + [(ms_unitid ms, lvl, b, c) | (lvl, b, c) <- msDeps ms ] + + +type DownsweepM a = ReaderT DownsweepEnv IO a +data DownsweepEnv = DownsweepEnv { + downsweep_hsc_env :: HscEnv + , _downsweep_mode :: DownsweepMode + , _downsweep_old_summaries :: M.Map (UnitId, FilePath) ModSummary + , _downsweep_excl_mods :: [ModuleName] +} + +runDownsweepM :: DownsweepEnv -> DownsweepM a -> IO a +runDownsweepM env act = runReaderT act env + + +loopInstantiations :: [(UnitId, InstantiatedUnit)] + -> M.Map NodeKey ModuleGraphNode + -> DownsweepM (M.Map NodeKey ModuleGraphNode) +loopInstantiations [] done = pure done +loopInstantiations ((home_uid, iud) :xs) done = do + hsc_env <- asks downsweep_hsc_env + let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env) + let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env + done' = loopUnit hsc_env' done [instUnitInstanceOf iud] + payload = InstantiationNode home_uid iud + loopInstantiations xs (M.insert (mkNodeKey payload) payload done') + + +-- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit +loopSummaries :: [ModSummary] + -> (M.Map NodeKey ModuleGraphNode, + DownsweepCache) + -> DownsweepM ((M.Map NodeKey ModuleGraphNode), DownsweepCache) +loopSummaries [] done = pure done +loopSummaries (ms:next) (done, summarised) + | Just {} <- M.lookup k done + = loopSummaries next (done, summarised) + -- Didn't work out what the imports mean yet, now do that. + | otherwise = do + (final_deps, done', summarised') <- loopImports (calcDeps ms) done summarised + -- This has the effect of finding a .hs file if we are looking at the .hs-boot file. + (_, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised' + loopSummaries next (M.insert k (ModuleNode final_deps (ModuleNodeCompile ms)) done'', summarised'') + where + k = NodeKey_Module (msKey ms) + + hs_file_for_boot + | HsBootFile <- ms_hsc_src ms + = Just $ ((ms_unitid ms), NormalLevel, NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot)) + | otherwise + = Nothing + +loopModuleNodeInfos :: [ModuleNodeInfo] -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache) +loopModuleNodeInfos is cache = foldM (flip loopModuleNodeInfo) cache is + +loopModuleNodeInfo :: ModuleNodeInfo -> (M.Map NodeKey ModuleGraphNode, DownsweepCache) -> DownsweepM (M.Map NodeKey ModuleGraphNode, DownsweepCache) +loopModuleNodeInfo mod_node_info (done, summarised) = do + case mod_node_info of + ModuleNodeCompile ms -> do + loopSummaries [ms] (done, summarised) + ModuleNodeFixed mod ml -> do + done' <- loopFixedModule mod ml done + return (done', summarised) + +-- NB: loopFixedModule does not take a downsweep cache, because if you +-- ever reach a Fixed node, everything under that also must be fixed. +loopFixedModule :: ModNodeKeyWithUid -> ModLocation + -> M.Map NodeKey ModuleGraphNode + -> DownsweepM (M.Map NodeKey ModuleGraphNode) +loopFixedModule key loc done = do + let nk = NodeKey_Module key + hsc_env <- asks downsweep_hsc_env + case M.lookup nk done of + Just {} -> return done + Nothing -> do + -- MP: TODO, we should just read the dependency info from the interface rather than either + -- a. Loading the whole thing into the EPS (this might never nececssary and causes lots of things to be permanently loaded into memory) + -- b. Loading the whole interface into a buffer before discarding it. (wasted allocation and deserialisation) + read_result <- liftIO $ + -- 1. Check if the interface is already loaded into the EPS by some other + -- part of the compiler. + lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case + Just iface -> return (M.Succeeded iface) + Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc) + case read_result of + M.Succeeded iface -> do + -- Computer information about this node + let node_deps = ifaceDeps (mi_deps iface) + edges = map mkFixedEdge node_deps + node = ModuleNode edges (ModuleNodeFixed key loc) + foldM (loopFixedNodeKey (mnkUnitId key)) (M.insert nk node done) (bimap snd snd <$> node_deps) + -- Ignore any failure, we might try to read a .hi-boot file for + -- example, even if there is not one. + M.Failed {} -> + return done + +loopFixedNodeKey :: UnitId -> M.Map NodeKey ModuleGraphNode -> Either ModNodeKeyWithUid UnitId -> DownsweepM (M.Map NodeKey ModuleGraphNode) +loopFixedNodeKey _ done (Left key) = do + loopFixedImports [key] done +loopFixedNodeKey home_uid done (Right uid) = do + -- Set active unit so that looking loopUnit finds the correct + -- -package flags in the unit state. + hsc_env <- asks downsweep_hsc_env + let hsc_env' = hscSetActiveUnitId home_uid hsc_env + return $ loopUnit hsc_env' done [uid] + +mkFixedEdge :: Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId) -> ModuleNodeEdge +mkFixedEdge (Left (lvl, key)) = mkModuleEdge lvl (NodeKey_Module key) +mkFixedEdge (Right (lvl, uid)) = mkModuleEdge lvl (NodeKey_ExternalUnit uid) + +ifaceDeps :: Dependencies -> [Either (ImportLevel, ModNodeKeyWithUid) (ImportLevel, UnitId)] +ifaceDeps deps = + [ Left (tcImportLevel lvl, ModNodeKeyWithUid dep uid) + | (lvl, uid, dep) <- Set.toList (dep_direct_mods deps) + ] ++ + [ Right (tcImportLevel lvl, uid) + | (lvl, uid) <- Set.toList (dep_direct_pkgs deps) + ] + +-- Like loopImports, but we already know exactly which module we are looking for. +loopFixedImports :: [ModNodeKeyWithUid] + -> M.Map NodeKey ModuleGraphNode + -> DownsweepM (M.Map NodeKey ModuleGraphNode) +loopFixedImports [] done = pure done +loopFixedImports (key:keys) done = do + let nk = NodeKey_Module key + hsc_env <- asks downsweep_hsc_env + case M.lookup nk done of + Just {} -> loopFixedImports keys done + Nothing -> do + read_result <- liftIO $ findExactModule hsc_env (mnkToInstalledModule key) (mnkIsBoot key) + case read_result of + InstalledFound loc -> do + done' <- loopFixedModule key loc done + loopFixedImports keys done' + _otherwise -> + -- If the finder fails, just keep going, there will be another + -- error later. + loopFixedImports keys done + +downsweepSummarise :: HomeUnit + -> IsBootInterface + -> Located ModuleName + -> PkgQual + -> Maybe (StringBuffer, UTCTime) + -> DownsweepM SummariseResult +downsweepSummarise home_unit is_boot wanted_mod mb_pkg maybe_buf = do + DownsweepEnv hsc_env mode old_summaries excl_mods <- ask + case mode of + DownsweepUseCompile -> liftIO $ summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods + DownsweepUseFixed -> liftIO $ summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods + + +-- This loops over each import in each summary. It is mutually recursive with loopSummaries if we discover +-- a new module by doing this. +loopImports :: [(UnitId, ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))] + -- Work list: process these modules + -> M.Map NodeKey ModuleGraphNode + -> DownsweepCache + -- Visited set; the range is a list because + -- the roots can have the same module names + -- if allow_dup_roots is True + -> DownsweepM ([ModuleNodeEdge], + M.Map NodeKey ModuleGraphNode, DownsweepCache) + -- The result is the completed NodeMap +loopImports [] done summarised = return ([], done, summarised) +loopImports ((home_uid, imp, mb_pkg, gwib) : ss) done summarised + | Just summs <- M.lookup cache_key summarised + = case summs of + [Right ms] -> do + let nk = mkModuleEdge imp (NodeKey_Module (mnKey ms)) + (rest, summarised', done') <- loopImports ss done summarised + return (nk: rest, summarised', done') + [Left _err] -> + loopImports ss done summarised + _errs -> do + loopImports ss done summarised + | otherwise + = do + hsc_env <- asks downsweep_hsc_env + let home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env) + mb_s <- downsweepSummarise home_unit + is_boot wanted_mod mb_pkg + Nothing + case mb_s of + NotThere -> loopImports ss done summarised + External uid -> do + -- Pass an updated hsc_env to loopUnit, as each unit might + -- have a different visible package database. + let hsc_env' = hscSetActiveHomeUnit home_unit hsc_env + let done' = loopUnit hsc_env' done [uid] + (other_deps, done'', summarised') <- loopImports ss done' summarised + return (mkModuleEdge imp (NodeKey_ExternalUnit uid) : other_deps, done'', summarised') + FoundInstantiation iud -> do + (other_deps, done', summarised') <- loopImports ss done summarised + return (mkModuleEdge imp (NodeKey_Unit iud) : other_deps, done', summarised') + FoundHomeWithError (_uid, e) -> loopImports ss done (Map.insert cache_key [(Left e)] summarised) + FoundHome s -> do + (done', summarised') <- + loopModuleNodeInfo s (done, Map.insert cache_key [Right s] summarised) + (other_deps, final_done, final_summarised) <- loopImports ss done' summarised' + + -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now. + return (mkModuleEdge imp (NodeKey_Module (mnKey s)) : other_deps, final_done, final_summarised) + where + cache_key = (home_uid, mb_pkg, unLoc <$> gwib) + GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib + wanted_mod = L loc mod + +loopUnit :: HscEnv -> Map.Map NodeKey ModuleGraphNode -> [UnitId] -> Map.Map NodeKey ModuleGraphNode +loopUnit _ cache [] = cache +loopUnit lcl_hsc_env cache (u:uxs) = do + let nk = (NodeKey_ExternalUnit u) + case Map.lookup nk cache of + Just {} -> loopUnit lcl_hsc_env cache uxs + Nothing -> case unitDepends <$> lookupUnitId (hsc_units lcl_hsc_env) u of + Just us -> loopUnit lcl_hsc_env (loopUnit lcl_hsc_env (Map.insert nk (UnitNode us u) cache) us) uxs + Nothing -> pprPanic "loopUnit" (text "Malformed package database, missing " <+> ppr u) + +multiRootsErr :: [ModuleNodeInfo] -> IO () +multiRootsErr [] = panic "multiRootsErr" +multiRootsErr summs@(summ1:_) + = throwOneError $ fmap GhcDriverMessage $ + mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files + where + mod = moduleNodeInfoModule summ1 + files = mapMaybe (ml_hs_file . moduleNodeInfoLocation) summs + +moduleNotFoundErr :: UnitId -> ModuleName -> DriverMessages +moduleNotFoundErr uid mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound uid mod) + +-- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes. +-- These are used to represent the type checking that is done after +-- all the free holes (sigs in current package) relevant to that instantiation +-- are compiled. This is necessary to catch some instantiation errors. +instantiationNodes :: UnitId -> UnitState -> [(UnitId, InstantiatedUnit)] +instantiationNodes uid unit_state = map (uid,) iuids_to_check + where + iuids_to_check :: [InstantiatedUnit] + iuids_to_check = + nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state) + where + goUnitId uid = + [ recur + | VirtUnit indef <- [uid] + , inst <- instUnitInsts indef + , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst + ] + +-- The linking plan for each module. If we need to do linking for a home unit +-- then this function returns a graph node which depends on all the modules in the home unit. + +-- At the moment nothing can depend on these LinkNodes. +linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode) +linkNodes summaries uid hue = + let dflags = homeUnitEnv_dflags hue + ofile = outputFile_ dflags + + unit_nodes :: [NodeKey] + unit_nodes = map mkNodeKey (filter ((== uid) . mgNodeUnitId) summaries) + -- Issue a warning for the confusing case where the user + -- said '-o foo' but we're not going to do any linking. + -- We attempt linking if either (a) one of the modules is + -- called Main, or (b) the user said -no-hs-main, indicating + -- that main() is going to come from somewhere else. + -- + no_hs_main = gopt Opt_NoHsMain dflags + + main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes + + do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib + + in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking -> + Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) + -- This should be an error, not a warning (#10895). + | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) + | otherwise -> Nothing + +getRootSummary :: + [ModuleName] -> + M.Map (UnitId, FilePath) ModSummary -> + HscEnv -> + Target -> + IO (Either DriverMessages ModSummary) +getRootSummary excl_mods old_summary_map hsc_env target + | TargetFile file mb_phase <- targetId + = do + let offset_file = augmentByWorkingDirectory dflags file + exists <- liftIO $ doesFileExist offset_file + if exists || isJust maybe_buf + then summariseFile hsc_env home_unit old_summary_map offset_file mb_phase + maybe_buf + else + return $ Left $ singleMessage $ + mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file) + | TargetModule modl <- targetId + = do + maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot + (L rootLoc modl) (ThisPkg (homeUnitId home_unit)) + maybe_buf excl_mods + pure case maybe_summary of + FoundHome (ModuleNodeCompile s) -> Right s + FoundHomeWithError err -> Left (snd err) + _ -> Left (moduleNotFoundErr uid modl) + where + Target {targetId, targetContents = maybe_buf, targetUnitId = uid} = target + home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env) + rootLoc = mkGeneralSrcSpan (fsLit "") + dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env)) + +-- | Execute 'getRootSummary' for the 'Target's using the parallelism pipeline +-- system. +-- Create bundles of 'Target's wrapped in a 'MakeAction' that uses +-- 'withAbstractSem' to wait for a free slot, limiting the number of +-- concurrently computed summaries to the value of the @-j@ option or the slots +-- allocated by the job server, if that is used. +-- +-- The 'MakeAction' returns 'Maybe', which is not handled as an error, because +-- 'runLoop' only sets it to 'Nothing' when an exception was thrown, so the +-- result won't be read anyway here. +-- +-- To emulate the current behavior, we funnel exceptions past the concurrency +-- barrier and rethrow the first one afterwards. +rootSummariesParallel :: + WorkerLimit -> + HscEnv -> + (GhcMessage -> AnyGhcDiagnostic) -> + Maybe Messager -> + (HscEnv -> Target -> IO (Either DriverMessages ModSummary)) -> + IO ([DriverMessages], [ModSummary]) +rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do + (actions, get_results) <- unzip <$> mapM action_and_result (zip [1..] bundles) + runPipelines n_jobs hsc_env diag_wrapper msg actions + (sequence . catMaybes <$> sequence get_results) >>= \case + Right results -> pure (partitionEithers (concat results)) + Left exc -> throwIO exc + where + bundles = mk_bundles targets + + mk_bundles = unfoldr \case + [] -> Nothing + ts -> Just (splitAt bundle_size ts) + + bundle_size = 20 + + targets = hsc_targets hsc_env + + action_and_result (log_queue_id, ts) = do + res_var <- liftIO newEmptyMVar + pure $! (MakeAction (action log_queue_id ts) res_var, readMVar res_var) + + action log_queue_id target_bundle = do + env@MakeEnv {compile_sem} <- ask + lift $ lift $ + withAbstractSem compile_sem $ + withLoggerHsc log_queue_id env \ lcl_hsc_env -> + MC.try (mapM (get_summary lcl_hsc_env) target_bundle) >>= \case + Left e | Just (_ :: SomeAsyncException) <- fromException e -> + throwIO e + a -> pure a + +-- | This function checks then important property that if both p and q are home units +-- then any dependency of p, which transitively depends on q is also a home unit. +-- +-- See Note [Multiple Home Units], section 'Closure Property'. +checkHomeUnitsClosed :: UnitEnv -> [DriverMessages] +checkHomeUnitsClosed ue + | Set.null bad_unit_ids = [] + | otherwise = [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] + where + home_id_set = HUG.allUnits $ ue_home_unit_graph ue + bad_unit_ids = upwards_closure Set.\\ home_id_set {- Remove all home units reached, keep only bad nodes -} + rootLoc = mkGeneralSrcSpan (fsLit "") + + downwards_closure :: Graph (Node UnitId UnitId) + downwards_closure = graphFromEdgedVerticesUniq graphNodes + + inverse_closure = graphReachability $ transposeG downwards_closure + + upwards_closure = Set.fromList $ map node_key $ allReachableMany inverse_closure [DigraphNode uid uid [] | uid <- Set.toList home_id_set] + + all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId) + all_unit_direct_deps + = HUG.unitEnv_foldWithKey go emptyUniqMap $ ue_home_unit_graph ue + where + go rest this this_uis = + plusUniqMap_C Set.union + (addToUniqMap_C Set.union external_depends this (Set.fromList $ this_deps)) + rest + where + external_depends = mapUniqMap (Set.fromList . unitDepends) (unitInfoMap this_units) + this_units = homeUnitEnv_units this_uis + this_deps = [ toUnitId unit | (unit,Just _) <- explicitUnits this_units] + + graphNodes :: [Node UnitId UnitId] + graphNodes = go Set.empty home_id_set + where + go done todo + = case Set.minView todo of + Nothing -> [] + Just (uid, todo') + | Set.member uid done -> go done todo' + | otherwise -> case lookupUniqMap all_unit_direct_deps uid of + Nothing -> pprPanic "uid not found" (ppr (uid, all_unit_direct_deps)) + Just depends -> + let todo'' = (depends Set.\\ done) `Set.union` todo' + in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo'' + +-- | Update the every ModSummary that is depended on +-- by a module that needs template haskell. We enable codegen to +-- the specified target, disable optimization and change the .hi +-- and .o file locations to be temporary files. +-- See Note [-fno-code mode] +enableCodeGenForTH + :: Logger + -> TmpFs + -> UnitEnv + -> [ModuleGraphNode] + -> IO ModuleGraph +enableCodeGenForTH logger tmpfs unit_env = + enableCodeGenWhen logger tmpfs TFL_CurrentModule TFL_GhcSession unit_env + + +data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (Eq, Show, Ord) + +instance Outputable CodeGenEnable where + ppr = text . show + +-- | Helper used to implement 'enableCodeGenForTH'. +-- In particular, this enables +-- unoptimized code generation for all modules that meet some +-- condition (first parameter), or are dependencies of those +-- modules. The second parameter is a condition to check before +-- marking modules for code generation. +enableCodeGenWhen + :: Logger + -> TmpFs + -> TempFileLifetime + -> TempFileLifetime + -> UnitEnv + -> [ModuleGraphNode] + -> IO ModuleGraph +enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do + mgMapM enable_code_gen mg + where + defaultBackendOf ms = platformDefaultBackend (targetPlatform $ ue_unitFlags (ms_unitid ms) unit_env) + + enable_code_gen :: ModuleNodeInfo -> IO ModuleNodeInfo + enable_code_gen (ModuleNodeCompile ms) = ModuleNodeCompile <$> enable_code_gen_ms ms + enable_code_gen m@(ModuleNodeFixed {}) = return m + + -- FIXME: Strong resemblance and some duplication between this and `makeDynFlagsConsistent`. + -- It would be good to consider how to make these checks more uniform and not duplicated. + enable_code_gen_ms :: ModSummary -> IO ModSummary + enable_code_gen_ms ms + | ModSummary + { ms_location = ms_location + , ms_hsc_src = HsSrcFile + , ms_hspp_opts = dflags + } <- ms + , Just enable_spec <- needs_codegen_map ms = + if | nocode_enable ms -> do + let new_temp_file suf dynsuf = do + tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf + let dyn_tn = tn -<.> dynsuf + addFilesToClean tmpfs dynLife [dyn_tn] + return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) + -- We don't want to create .o or .hi files unless we have been asked + -- to by the user. But we need them, so we patch their locations in + -- the ModSummary with temporary files. + -- + ((hi_file, dyn_hi_file), (o_file, dyn_o_file)) <- + -- If ``-fwrite-interface` is specified, then the .o and .hi files + -- are written into `-odir` and `-hidir` respectively. #16670 + if gopt Opt_WriteInterface dflags + then return ((ml_hi_file_ospath ms_location, ml_dyn_hi_file_ospath ms_location) + , (ml_obj_file_ospath ms_location, ml_dyn_obj_file_ospath ms_location)) + else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) + <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) + let new_dflags = case enable_spec of + EnableByteCode -> dflags { backend = interpreterBackend } + EnableObject -> dflags { backend = defaultBackendOf ms } + EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} + let ms' = ms + { ms_location = + ms_location { ml_hi_file_ospath = hi_file + , ml_obj_file_ospath = o_file + , ml_dyn_hi_file_ospath = dyn_hi_file + , ml_dyn_obj_file_ospath = dyn_o_file } + , ms_hspp_opts = updOptLevel 0 $ new_dflags + } + -- Recursive call to catch the other cases + enable_code_gen_ms ms' + + -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough) + -- we only get to this case if the default backend is already generating object files, but we need dynamic + -- objects + | bytecode_and_enable enable_spec ms -> do + let ms' = ms + { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode + } + -- Recursive call to catch the other cases + enable_code_gen_ms ms' + | dynamic_too_enable enable_spec ms -> do + let ms' = ms + { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo + } + -- Recursive call to catch the other cases + enable_code_gen_ms ms' + | ext_interp_enable ms -> do + let ms' = ms + { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ExternalInterpreter + } + -- Recursive call to catch the other cases + enable_code_gen_ms ms' + + | needs_full_ways dflags -> do + let ms' = ms { ms_hspp_opts = set_full_ways dflags } + -- Recursive call to catch the other cases + enable_code_gen_ms ms' + + | otherwise -> return ms + + enable_code_gen_ms ms = return ms + + nocode_enable ms@(ModSummary { ms_hspp_opts = dflags }) = + not (backendGeneratesCode (backend dflags)) && + -- Don't enable codegen for TH on indefinite packages; we + -- can't compile anything anyway! See #16219. + isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) + + bytecode_and_enable enable_spec ms = + -- In the situation where we **would** need to enable dynamic-too + -- IF we had decided we needed objects + dynamic_too_enable EnableObject ms + -- but we prefer to use bytecode rather than objects + && prefer_bytecode + -- and we haven't already turned it on + && not generate_both + where + lcl_dflags = ms_hspp_opts ms + prefer_bytecode = case enable_spec of + EnableByteCodeAndObject -> True + EnableByteCode -> True + EnableObject -> False + + generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags + + -- #8180 - when using TemplateHaskell, switch on -dynamic-too so + -- the linker can correctly load the object files. This isn't necessary + -- when using -fexternal-interpreter. + -- FIXME: Duplicated from makeDynFlagsConsistent + dynamic_too_enable enable_spec ms + | sTargetRTSLinkerOnlySupportsSharedLibs $ settings lcl_dflags = + not isDynWay && not dyn_too_enabled + && enable_object + | otherwise = + hostIsDynamic && not hostIsProfiled && internalInterpreter && + not isDynWay && not isProfWay && not dyn_too_enabled + && enable_object + where + lcl_dflags = ms_hspp_opts ms + internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) + dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags + isDynWay = hasWay (ways lcl_dflags) WayDyn + isProfWay = hasWay (ways lcl_dflags) WayProf + enable_object = case enable_spec of + EnableByteCode -> False + EnableByteCodeAndObject -> True + EnableObject -> True + + -- #16331 - when no "internal interpreter" is available but we + -- need to process some TemplateHaskell or QuasiQuotes, we automatically + -- turn on -fexternal-interpreter. + ext_interp_enable ms = not ghciSupported && internalInterpreter + where + lcl_dflags = ms_hspp_opts ms + internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) + + + mg = mkModuleGraph mod_graph + + (td_map, lookup_node) = mkStageDeps mod_graph + + queryReachable ns = isReachableMany td_map (mapMaybe lookup_node ns) + + -- NB: Do not inline these, it is very important to share them across all calls + -- to needs_obj_set and needs_bc_set. + !query_obj = + let !deps = queryReachable need_obj_set + in \k -> deps (expectJust $ lookup_node k) + + !query_bc = + let !deps = queryReachable need_bc_set + in \k -> deps (expectJust $ lookup_node k) + + -- The direct dependencies of modules which require object code + need_obj_set = + + -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only + -- it's dependencies. + [ (mkNodeKey m, RunStage) + | m@(ModuleNode _deps (ModuleNodeCompile ms)) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , not (gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms)) + ] + + -- The direct dependencies of modules which require byte code + need_bc_set = + [ (mkNodeKey m, RunStage) + | m@(ModuleNode _deps (ModuleNodeCompile ms)) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms) + ] + + needs_obj_set, needs_bc_set :: ModNodeKeyWithUid -> Bool + needs_obj_set k = query_obj (NodeKey_Module k, CompileStage) + + needs_bc_set k = query_bc (NodeKey_Module k, CompileStage) + + -- A map which tells us how to enable code generation for a NodeKey + needs_codegen_map :: ModSummary -> Maybe CodeGenEnable + needs_codegen_map ms = + let nk = msKey ms + + + -- Another option here would be to just produce object code, rather than both object and + -- byte code + in case (needs_obj_set nk, needs_bc_set nk) of + (True, True) -> Just EnableByteCodeAndObject + (True, False) -> Just EnableObject + (False, True) -> Just EnableByteCode + (False, False) -> Nothing + + -- FIXME: Duplicated from makeDynFlagsConsistent + needs_full_ways dflags + = ghcLink dflags == LinkInMemory && + not (gopt Opt_ExternalInterpreter dflags) && + targetWays_ dflags /= hostFullWays + set_full_ways dflags = + let platform = targetPlatform dflags + dflags_a = dflags { targetWays_ = hostFullWays } + dflags_b = foldl gopt_set dflags_a + $ concatMap (wayGeneralFlags platform) + hostFullWays + dflags_c = foldl gopt_unset dflags_b + $ concatMap (wayUnsetGeneralFlags platform) + hostFullWays + in dflags_c + +{- Note [-fno-code mode] +~~~~~~~~~~~~~~~~~~~~~~~~ +GHC offers the flag -fno-code for the purpose of parsing and typechecking a +program without generating object files. This is intended to be used by tooling +and IDEs to provide quick feedback on any parser or type errors as cheaply as +possible. + +When GHC is invoked with -fno-code, no object files or linked output will be +generated. As many errors and warnings as possible will be generated, as if +-fno-code had not been passed. The session DynFlags will have +backend == NoBackend. + +-fwrite-interface +~~~~~~~~~~~~~~~~ +Whether interface files are generated in -fno-code mode is controlled by the +-fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is +not also passed. Recompilation avoidance requires interface files, so passing +-fno-code without -fwrite-interface should be avoided. If -fno-code were +re-implemented today, there would be no need for -fwrite-interface as it +would considered always on; this behaviour is as it is for backwards compatibility. + +================================================================ +IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER +================================================================ + +Template Haskell +~~~~~~~~~~~~~~~~ +A module using Template Haskell may invoke an imported function from inside a +splice. This will cause the type-checker to attempt to execute that code, which +would fail if no object files had been generated. See #8025. To rectify this, +during the downsweep we patch the DynFlags in the ModSummary of any home module +that is imported by a module that uses Template Haskell to generate object +code. + +The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled +or not in the module which needs the code generation. If the module requires byte-code then +dependencies will generate byte-code, otherwise they will generate object files. +In the case where some modules require byte-code and some object files, both are +generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these +configurations. + +The object files (and interface files if -fwrite-interface is disabled) produced +for Template Haskell are written to temporary files. + +Note that since Template Haskell can run arbitrary IO actions, -fno-code mode +is no more secure than running without it. + +Explicit Level Imports +~~~~~~~~~~~~~~~~~~~~~~ +When `-XExplicitLevelImports` is enabled, code is only generated for modules +needed for the compile stage. The ReachabilityIndex created by `mkStageDeps` answers +the question, if I compile a module for a specific stage, then which modules at +other stages do I need. The roots of this query are the modules which use `TemplateHaskell` +at the runtime stage, and modules we need code generation for are those which +are needed at the compile time stage. All the logic about how ExplicitLevelImports +and TemplateHaskell affect the needed stages of a module is encoded in mkStageDeps. + +Potential TODOS: +~~~~~ +* Remove -fwrite-interface and have interface files always written in -fno-code + mode +* Both .o and .dyn_o files are generated for template haskell, but we only need + .dyn_o (for dynamically linked compilers) Fix it. (The needed way is 'hostFullWays') +* In make mode, a message like + Compiling A (A.hs, /tmp/ghc_123.o) + is shown if downsweep enabled object code generation for A. Perhaps we should + show "nothing" or "temporary object file" instead. Note that one + can currently use -keep-tmp-files and inspect the generated file with the + current behaviour. +* Offer a -no-codedir command line option, and write what were temporary + object files there. This would speed up recompilation. +* Use existing object files (if they are up to date) instead of always + generating temporary ones. +-} + +-- | Populate the Downsweep cache with the root modules. +mkRootMap + :: [ModuleNodeInfo] + -> DownsweepCache +mkRootMap summaries = Map.fromListWith (flip (++)) + [ ((moduleNodeInfoUnitId s, NoPkgQual, moduleNodeInfoMnwib s), [Right s]) | s <- summaries ] + +----------------------------------------------------------------------------- +-- Summarising modules + +-- We have two types of summarisation: +-- +-- * Summarise a file. This is used for the root module(s) passed to +-- cmLoadModules. The file is read, and used to determine the root +-- module name. The module name may differ from the filename. +-- +-- * Summarise a module. We are given a module name, and must provide +-- a summary. The finder is used to locate the file in which the module +-- resides. + +summariseFile + :: HscEnv + -> HomeUnit + -> M.Map (UnitId, FilePath) ModSummary -- old summaries + -> FilePath -- source file name + -> Maybe Phase -- start phase + -> Maybe (StringBuffer,UTCTime) + -> IO (Either DriverMessages ModSummary) + +summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf + -- we can use a cached summary if one is available and the + -- source file hasn't changed, + | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries + = do + let location = ms_location $ old_summary + + src_hash <- get_src_hash + -- The file exists; we checked in getRootSummary above. + -- If it gets removed subsequently, then this + -- getFileHash may fail, but that's the right + -- behaviour. + + -- return the cached summary if the source didn't change + checkSummaryHash + hsc_env (new_summary src_fn) + old_summary location src_hash + + | otherwise + = do src_hash <- get_src_hash + new_summary src_fn src_hash + where + -- change the main active unit so all operations happen relative to the given unit + hsc_env = hscSetActiveHomeUnit home_unit hsc_env' + -- src_fn does not necessarily exist on the filesystem, so we need to + -- check what kind of target we are dealing with + get_src_hash = case maybe_buf of + Just (buf,_) -> return $ fingerprintStringBuffer buf + Nothing -> liftIO $ getFileHash src_fn + + new_summary src_fn src_hash = runExceptT $ do + preimps@PreprocessedImports {..} + <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf + + let fopts = initFinderOpts (hsc_dflags hsc_env) + (basename, extension) = splitExtension src_fn + + hsc_src + | isHaskellSigSuffix (drop 1 extension) = HsigFile + | isHaskellBootSuffix (drop 1 extension) = HsBootFile + | otherwise = HsSrcFile + + -- Make a ModLocation for this file, adding the @-boot@ suffix to + -- all paths if the original was a boot file. + location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf extension) hsc_src + + -- Tell the Finder cache where it is, so that subsequent calls + -- to findModule will find it, even if it's not on any search path + mod <- liftIO $ do + let home_unit = hsc_home_unit hsc_env + let fc = hsc_FC hsc_env + addHomeModuleToFinder fc home_unit pi_mod_name location hsc_src + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_hash = src_hash + , nms_hsc_src = hsc_src + , nms_location = location + , nms_mod = mod + , nms_preimps = preimps + } + +checkSummaryHash + :: HscEnv + -> (Fingerprint -> IO (Either e ModSummary)) + -> ModSummary -> ModLocation -> Fingerprint + -> IO (Either e ModSummary) +checkSummaryHash + hsc_env new_summary + old_summary + location src_hash + | ms_hs_hash old_summary == src_hash && + not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do + -- update the object-file timestamp + obj_timestamp <- modificationTimeIfExists (ml_obj_file location) + + -- We have to repopulate the Finder's cache for file targets + -- because the file might not even be on the regular search path + -- and it was likely flushed in depanal. This is not technically + -- needed when we're called from sumariseModule but it shouldn't + -- hurt. + let fc = hsc_FC hsc_env + mod = ms_mod old_summary + hsc_src = ms_hsc_src old_summary + addModuleToFinder fc mod location hsc_src + + hi_timestamp <- modificationTimeIfExists (ml_hi_file location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file location) + + return $ Right + ( old_summary + { ms_obj_date = obj_timestamp + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + } + ) + + | otherwise = + -- source changed: re-summarise. + new_summary src_hash + +data SummariseResult = + FoundInstantiation InstantiatedUnit + | FoundHomeWithError (UnitId, DriverMessages) + | FoundHome ModuleNodeInfo + | External UnitId + | NotThere + +-- | summariseModule finds the location of the source file for the given module. +-- This version always returns a ModuleNodeCompile node, it is useful for +-- --make mode. +summariseModule :: HscEnv + -> HomeUnit + -> M.Map (UnitId, FilePath) ModSummary + -> IsBootInterface + -> Located ModuleName + -> PkgQual + -> Maybe (StringBuffer, UTCTime) + -> [ModuleName] + -> IO SummariseResult +summariseModule hsc_env home_unit old_summaries is_boot wanted_mod mb_pkg maybe_buf excl_mods = + summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods + where + k = summariseModuleWithSource home_unit old_summaries is_boot maybe_buf + + +-- | Like summariseModule but for interface files that we don't want to compile. +-- This version always returns a ModuleNodeFixed node. +summariseModuleInterface :: HscEnv + -> HomeUnit + -> IsBootInterface + -> Located ModuleName + -> PkgQual + -> [ModuleName] + -> IO SummariseResult +summariseModuleInterface hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods = + summariseModuleDispatch k hsc_env home_unit is_boot wanted_mod mb_pkg excl_mods + where + k _hsc_env loc mod = do + -- The finder will return a path to the .hi-boot even if it doesn't actually + -- exist. So check if it exists first before concluding it's there. + does_exist <- doesFileExist (ml_hi_file loc) + if does_exist + then let key = moduleToMnk mod is_boot + in return $ FoundHome (ModuleNodeFixed key loc) + else return NotThere + + + +-- Summarise a module, and pick up source and timestamp. +summariseModuleDispatch + :: (HscEnv -> ModLocation -> Module -> IO SummariseResult) -- ^ Continuation about how to summarise a home module. + -> HscEnv + -> HomeUnit + -> IsBootInterface -- True <=> a {-# SOURCE #-} import + -> Located ModuleName -- Imported module to be summarised + -> PkgQual + -> [ModuleName] -- Modules to exclude + -> IO SummariseResult + + +summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg excl_mods + | wanted_mod `elem` excl_mods + = return NotThere + | otherwise = find_it + where + -- Temporarily change the currently active home unit so all operations + -- happen relative to it + hsc_env = hscSetActiveHomeUnit home_unit hsc_env' + + find_it :: IO SummariseResult + + find_it = do + found <- findImportedModuleWithIsBoot hsc_env wanted_mod is_boot mb_pkg + case found of + Found location mod + | moduleUnitId mod `Set.member` hsc_all_home_unit_ids hsc_env -> + -- Home package + k hsc_env location mod + | VirtUnit iud <- moduleUnit mod + , not (isHomeModule home_unit mod) + -> return $ FoundInstantiation iud + | otherwise -> return $ External (moduleUnitId mod) + _ -> return NotThere + -- Not found + -- (If it is TRULY not found at all, we'll + -- error when we actually try to compile) + + +-- | The continuation to summarise a home module if we want to find the source file +-- for it and potentially compile it. +summariseModuleWithSource + :: HomeUnit + -> M.Map (UnitId, FilePath) ModSummary + -- ^ Map of old summaries + -> IsBootInterface -- True <=> a {-# SOURCE #-} import + -> Maybe (StringBuffer, UTCTime) + -> HscEnv + -> ModLocation + -> Module + -> IO SummariseResult +summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env location mod = do + -- Adjust location to point to the hs-boot source file, + -- hi file, object file, when is_boot says so + let src_fn = expectJust (ml_hs_file location) + + -- Check that it exists + -- It might have been deleted since the Finder last found it + maybe_h <- fileHashIfExists src_fn + case maybe_h of + -- This situation can also happen if we have found the .hs file but the + -- .hs-boot file doesn't exist. + Nothing -> return NotThere + Just h -> do + fresult <- new_summary_cache_check location mod src_fn h + return $ case fresult of + Left err -> FoundHomeWithError (moduleUnitId mod, err) + Right ms -> FoundHome (ModuleNodeCompile ms) + + where + dflags = hsc_dflags hsc_env + new_summary_cache_check loc mod src_fn h + | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) old_summary_map = + + -- check the hash on the source file, and + -- return the cached summary if it hasn't changed. If the + -- file has changed then need to resummarise. + case maybe_buf of + Just (buf,_) -> + checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf) + Nothing -> + checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h + | otherwise = new_summary loc mod src_fn h + + new_summary :: ModLocation + -> Module + -> FilePath + -> Fingerprint + -> IO (Either DriverMessages ModSummary) + new_summary location mod src_fn src_hash + = runExceptT $ do + preimps@PreprocessedImports {..} + -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP + -- See multiHomeUnits_cpp2 test + <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf + + -- NB: Despite the fact that is_boot is a top-level parameter, we + -- don't actually know coming into this function what the HscSource + -- of the module in question is. This is because we may be processing + -- this module because another module in the graph imported it: in this + -- case, we know if it's a boot or not because of the {-# SOURCE #-} + -- annotation, but we don't know if it's a signature or a regular + -- module until we actually look it up on the filesystem. + let hsc_src + | is_boot == IsBoot = HsBootFile + | isHaskellSigFilename src_fn = HsigFile + | otherwise = HsSrcFile + + when (pi_mod_name /= moduleName mod) $ + throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc + $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod) + + let instantiations = homeUnitInstantiations home_unit + when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $ + throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc + $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations + + liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary + { nms_src_fn = src_fn + , nms_src_hash = src_hash + , nms_hsc_src = hsc_src + , nms_location = location + , nms_mod = mod + , nms_preimps = preimps + } + +-- | Convenience named arguments for 'makeNewModSummary' only used to make +-- code more readable, not exported. +data MakeNewModSummary + = MakeNewModSummary + { nms_src_fn :: FilePath + , nms_src_hash :: Fingerprint + , nms_hsc_src :: HscSource + , nms_location :: ModLocation + , nms_mod :: Module + , nms_preimps :: PreprocessedImports + } + +makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary +makeNewModSummary hsc_env MakeNewModSummary{..} = do + let PreprocessedImports{..} = nms_preimps + obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location) + dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location) + hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location) + hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) + + extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name + (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps + + return $ + ModSummary + { ms_mod = nms_mod + , ms_hsc_src = nms_hsc_src + , ms_location = nms_location + , ms_hspp_file = pi_hspp_fn + , ms_hspp_opts = pi_local_dflags + , ms_hspp_buf = Just pi_hspp_buf + , ms_parsed_mod = Nothing + , ms_srcimps = pi_srcimps + , ms_textual_imps = + ((,,) NormalLevel NoPkgQual . noLoc <$> extra_sig_imports) ++ + ((,,) NormalLevel NoPkgQual . noLoc <$> implicit_sigs) ++ + pi_theimps + , ms_hs_hash = nms_src_hash + , ms_iface_date = hi_timestamp + , ms_hie_date = hie_timestamp + , ms_obj_date = obj_timestamp + , ms_dyn_obj_date = dyn_obj_timestamp + } + +data PreprocessedImports + = PreprocessedImports + { pi_local_dflags :: DynFlags + , pi_srcimps :: [Located ModuleName] + , pi_theimps :: [(ImportLevel, PkgQual, Located ModuleName)] + , pi_hspp_fn :: FilePath + , pi_hspp_buf :: StringBuffer + , pi_mod_name_loc :: SrcSpan + , pi_mod_name :: ModuleName + } + +-- Preprocess the source file and get its imports +-- The pi_local_dflags contains the OPTIONS pragmas +getPreprocessedImports + :: HscEnv + -> FilePath + -> Maybe Phase + -> Maybe (StringBuffer, UTCTime) + -- ^ optional source code buffer and modification time + -> ExceptT DriverMessages IO PreprocessedImports +getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do + (pi_local_dflags, pi_hspp_fn) + <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase + pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn + (pi_srcimps', pi_theimps', L pi_mod_name_loc pi_mod_name) + <- ExceptT $ do + let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags + popts = initParserOpts pi_local_dflags + mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn + return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps) + let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) + let rn_imps = fmap (\(sp, pk, lmn@(L _ mn)) -> (sp, rn_pkg_qual mn pk, lmn)) + let pi_srcimps = pi_srcimps' + let pi_theimps = rn_imps pi_theimps' + return PreprocessedImports {..} diff --git a/GHC/Driver/DynFlags.hs b/GHC/Driver/DynFlags.hs --- a/GHC/Driver/DynFlags.hs +++ b/GHC/Driver/DynFlags.hs @@ -62,6 +62,10 @@ versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, + -- + baseUnitId, + + -- * Include specifications IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes, addImplicitQuoteInclude, @@ -71,6 +75,8 @@ initPromotionTickContext, -- * Platform features + isSse3Enabled, + isSsse3Enabled, isSse4_1Enabled, isSse4_2Enabled, isAvxEnabled, @@ -98,6 +104,7 @@ import GHC.Builtin.Names ( mAIN_NAME ) import GHC.Driver.Backend import GHC.Driver.Flags +import GHC.Driver.IncludeSpecs import GHC.Driver.Phases ( Phase(..), phaseInputExt ) import GHC.Driver.Plugins.External import GHC.Settings @@ -165,6 +172,8 @@ -- formerly Settings ghcNameVersion :: {-# UNPACK #-} !GhcNameVersion, fileSettings :: {-# UNPACK #-} !FileSettings, + unitSettings :: {-# UNPACK #-} !UnitSettings, + targetPlatform :: Platform, -- Filled in by SysTools toolSettings :: {-# UNPACK #-} !ToolSettings, platformMisc :: {-# UNPACK #-} !PlatformMisc, @@ -399,6 +408,13 @@ ghciHistSize :: Int, + -- wasm ghci browser mode + ghciBrowserHost :: !String, + ghciBrowserPort :: !Int, + ghciBrowserPuppeteerLaunchOpts :: !(Maybe String), + ghciBrowserPlaywrightBrowserType :: !(Maybe String), + ghciBrowserPlaywrightLaunchOpts :: !(Maybe String), + flushOut :: FlushOut, ghcVersionFile :: Maybe FilePath, @@ -634,6 +650,7 @@ splitInfo = Nothing, ghcNameVersion = sGhcNameVersion mySettings, + unitSettings = sUnitSettings mySettings, fileSettings = sFileSettings mySettings, toolSettings = sToolSettings mySettings, targetPlatform = sTargetPlatform mySettings, @@ -683,6 +700,12 @@ ghciHistSize = 50, -- keep a log of length 50 by default + ghciBrowserHost = "127.0.0.1", + ghciBrowserPort = 0, + ghciBrowserPuppeteerLaunchOpts = Nothing, + ghciBrowserPlaywrightBrowserType = Nothing, + ghciBrowserPlaywrightLaunchOpts = Nothing, + flushOut = defaultFlushOut, pprUserLength = 5, pprCols = 100, @@ -729,16 +752,6 @@ defaultFlushOut :: FlushOut defaultFlushOut = FlushOut $ hFlush stdout - - -data OnOff a = On a - | Off a - deriving (Eq, Show) - -instance Outputable a => Outputable (OnOff a) where - ppr (On x) = text "On" <+> ppr x - ppr (Off x) = text "Off" <+> ppr x - -- OnOffs accumulate in reverse order, so we use foldr in order to -- process them in the right order flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension @@ -925,46 +938,8 @@ | PkgDbPath FilePath deriving Eq --- | Used to differentiate the scope an include needs to apply to. --- We have to split the include paths to avoid accidentally forcing recursive --- includes since -I overrides the system search paths. See #14312. -data IncludeSpecs - = IncludeSpecs { includePathsQuote :: [String] - , includePathsGlobal :: [String] - -- | See Note [Implicit include paths] - , includePathsQuoteImplicit :: [String] - } - deriving Show --- | Append to the list of includes a path that shall be included using `-I` --- when the C compiler is called. These paths override system search paths. -addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addGlobalInclude spec paths = let f = includePathsGlobal spec - in spec { includePathsGlobal = f ++ paths } --- | Append to the list of includes a path that shall be included using --- `-iquote` when the C compiler is called. These paths only apply when quoted --- includes are used. e.g. #include "foo.h" -addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addQuoteInclude spec paths = let f = includePathsQuote spec - in spec { includePathsQuote = f ++ paths } - --- | These includes are not considered while fingerprinting the flags for iface --- | See Note [Implicit include paths] -addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs -addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec - in spec { includePathsQuoteImplicit = f ++ paths } - - --- | Concatenate and flatten the list of global and quoted includes returning --- just a flat list of paths. -flattenIncludes :: IncludeSpecs -> [String] -flattenIncludes specs = - includePathsQuote specs ++ - includePathsQuoteImplicit specs ++ - includePathsGlobal specs - - -- An argument to --reexported-module which can optionally specify a module renaming. data ReexportedModule = ReexportedModule { reexportFrom :: ModuleName , reexportTo :: ModuleName @@ -1166,6 +1141,7 @@ Opt_GenManifest, Opt_GhciHistory, Opt_GhciSandbox, + Opt_GhciDoLoadTargets, Opt_HelpfulErrors, Opt_KeepHiFiles, Opt_KeepOFiles, @@ -1181,7 +1157,8 @@ Opt_ShowErrorContext, Opt_SuppressStgReps, Opt_UnoptimizedCoreForInterpreter, - Opt_SpecialiseIncoherents + Opt_SpecialiseIncoherents, + Opt_WriteSelfRecompInfo ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -1290,7 +1267,7 @@ -- , ([2], Opt_StaticArgumentTransformation) -- Static Argument Transformation needs investigation. See #9374 , ([0,1,2], Opt_SpecEval) - , ([0,1,2], Opt_SpecEvalDictFun) + , ([], Opt_SpecEvalDictFun) ] @@ -1319,6 +1296,7 @@ -- always generate PIC. See -- #10597 for more -- information. + (OSLinux, ArchLoongArch64) -> [Opt_PIC, Opt_ExternalDynamicRefs] _ -> [] -- | The language extensions implied by the various language variants. @@ -1347,7 +1325,8 @@ -- default unless you specify another language. LangExt.DeepSubsumption, -- Non-standard but enabled for backwards compatability (see GHC proposal #511) - LangExt.ListTuplePuns + LangExt.ListTuplePuns, + LangExt.ImplicitStagePersistence ] languageExtensions (Just Haskell2010) @@ -1365,7 +1344,9 @@ LangExt.FieldSelectors, LangExt.RelaxedPolyRec, LangExt.DeepSubsumption, - LangExt.ListTuplePuns ] + LangExt.ListTuplePuns, + LangExt.ImplicitStagePersistence + ] languageExtensions (Just GHC2021) = [LangExt.ImplicitPrelude, @@ -1416,7 +1397,9 @@ LangExt.TupleSections, LangExt.TypeApplications, LangExt.TypeOperators, - LangExt.TypeSynonymInstances] + LangExt.TypeSynonymInstances, + LangExt.ImplicitStagePersistence + ] languageExtensions (Just GHC2024) = languageExtensions (Just GHC2021) ++ @@ -1485,6 +1468,11 @@ versionedFilePath :: ArchOS -> FilePath versionedFilePath platform = uniqueSubdir platform +-- | Access the unit-id of the version of `base` which we will automatically link +-- against. +baseUnitId :: DynFlags -> UnitId +baseUnitId dflags = unitSettings_baseUnitId (unitSettings dflags) + -- SDoc ------------------------------------------- -- | Initialize the pretty-printing options @@ -1543,6 +1531,12 @@ -- ----------------------------------------------------------------------------- -- SSE, AVX, FMA + +isSse3Enabled :: DynFlags -> Bool +isSse3Enabled dflags = sseVersion dflags >= Just SSE3 + +isSsse3Enabled :: DynFlags -> Bool +isSsse3Enabled dflags = sseVersion dflags >= Just SSSE3 isSse4_1Enabled :: DynFlags -> Bool isSse4_1Enabled dflags = sseVersion dflags >= Just SSE4 diff --git a/GHC/Driver/Env.hs b/GHC/Driver/Env.hs --- a/GHC/Driver/Env.hs +++ b/GHC/Driver/Env.hs @@ -1,7 +1,9 @@ - +{-# LANGUAGE LambdaCase #-} module GHC.Driver.Env ( Hsc(..) , HscEnv (..) + , hsc_mod_graph + , setModuleGraph , hscUpdateFlags , hscSetFlags , hsc_home_unit @@ -13,8 +15,7 @@ , hsc_all_home_unit_ids , hscUpdateLoggerFlags , hscUpdateHUG - , hscUpdateHPT_lazy - , hscUpdateHPT + , hscInsertHPT , hscSetActiveHomeUnit , hscSetActiveUnitId , hscActiveUnitId @@ -24,18 +25,20 @@ , runInteractiveHsc , hscEPS , hscInterp - , hptCompleteSigs - , hptAllInstances - , hptInstancesBelow - , hptAnns - , hptAllThings - , hptSomeThingsBelowUs - , hptRules , prepareAnnotations , discardIC , lookupType , lookupIfaceByModule + , lookupIfaceByModuleHsc , mainModIs + + , hugRulesBelow + , hugInstancesBelow + , hugAnnsBelow + , hugCompleteSigsBelow + + -- * Legacy API + , hscUpdateHPT ) where @@ -56,22 +59,18 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModDetails import GHC.Unit.Home.ModInfo -import GHC.Unit.Env +import GHC.Unit.Home.PackageTable +import GHC.Unit.Home.Graph +import GHC.Unit.Module.Graph +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Env as UnitEnv import GHC.Unit.External -import GHC.Core ( CoreRule ) -import GHC.Core.FamInstEnv -import GHC.Core.InstEnv - -import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv ) -import GHC.Types.CompleteMatch import GHC.Types.Error ( emptyMessages, Messages ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.TyThing -import GHC.Builtin.Names ( gHC_PRIM ) - import GHC.Data.Maybe import GHC.Utils.Exception as Ex @@ -81,9 +80,15 @@ import GHC.Utils.Misc import GHC.Utils.Logger +import GHC.Core.Rules +import GHC.Types.Annotations +import GHC.Types.CompleteMatch +import GHC.Core.InstEnv +import GHC.Core.FamInstEnv +import GHC.Builtin.Names + import Data.IORef import qualified Data.Set as Set -import GHC.Unit.Module.Graph runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env hsc = do @@ -110,13 +115,13 @@ runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env) hsc_home_unit :: HscEnv -> HomeUnit -hsc_home_unit = unsafeGetHomeUnit . hsc_unit_env +hsc_home_unit = ue_unsafeHomeUnit . hsc_unit_env hsc_home_unit_maybe :: HscEnv -> Maybe HomeUnit hsc_home_unit_maybe = ue_homeUnit . hsc_unit_env hsc_units :: HasDebugCallStack => HscEnv -> UnitState -hsc_units = ue_units . hsc_unit_env +hsc_units = ue_homeUnitState . hsc_unit_env hsc_HPT :: HscEnv -> HomePackageTable hsc_HPT = ue_hpt . hsc_unit_env @@ -127,22 +132,21 @@ hsc_HUG :: HscEnv -> HomeUnitGraph hsc_HUG = ue_home_unit_graph . hsc_unit_env -hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId -hsc_all_home_unit_ids = unitEnv_keys . hsc_HUG +hsc_mod_graph :: HscEnv -> ModuleGraph +hsc_mod_graph = ue_module_graph . hsc_unit_env -hscUpdateHPT_lazy :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv -hscUpdateHPT_lazy f hsc_env = - let !res = updateHpt_lazy f (hsc_unit_env hsc_env) - in hsc_env { hsc_unit_env = res } +hsc_all_home_unit_ids :: HscEnv -> Set.Set UnitId +hsc_all_home_unit_ids = HUG.allUnits . hsc_HUG -hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv -hscUpdateHPT f hsc_env = - let !res = updateHpt f (hsc_unit_env hsc_env) - in hsc_env { hsc_unit_env = res } +hscInsertHPT :: HomeModInfo -> HscEnv -> IO () +hscInsertHPT hmi hsc_env = UnitEnv.insertHpt hmi (hsc_unit_env hsc_env) hscUpdateHUG :: (HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv hscUpdateHUG f hsc_env = hsc_env { hsc_unit_env = updateHug f (hsc_unit_env hsc_env) } +setModuleGraph :: ModuleGraph -> HscEnv -> HscEnv +setModuleGraph mod_graph hsc_env = hsc_env { hsc_unit_env = (hsc_unit_env hsc_env) { ue_module_graph = mod_graph } } + {- Note [Target code interpreter] @@ -166,7 +170,7 @@ The target code interpreter to use can be selected per session via the `hsc_interp` field of `HscEnv`. There may be no interpreter available at all, in which case Template Haskell and GHCi will fail to run. The interpreter to use is -configured via command-line flags (in `GHC.setSessionDynFlags`). +configured via command-line flags (in `GHC.setTopSessionDynFlags`). -} @@ -217,66 +221,68 @@ hscEPS :: HscEnv -> IO ExternalPackageState hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env))) -hptCompleteSigs :: HscEnv -> CompleteMatches -hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) - --- | Find all the instance declarations (of classes and families) from --- the Home Package Table filtered by the provided predicate function. --- Used in @tcRnImports@, to select the instances that are in the --- transitive closure of imports from the currently compiled module. -hptAllInstances :: HscEnv -> (InstEnv, [FamInst]) -hptAllInstances hsc_env - = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do - let details = hm_details mod_info - return (md_insts details, md_fam_insts details) - in (foldl' unionInstEnv emptyInstEnv insts, concat famInsts) - --- | Find instances visible from the given set of imports -hptInstancesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> (InstEnv, [FamInst]) -hptInstancesBelow hsc_env uid mnwib = - let - mn = gwib_mod mnwib - (insts, famInsts) = - unzip $ hptSomeThingsBelowUs (\mod_info -> - let details = hm_details mod_info - -- Don't include instances for the current module - in if moduleName (mi_module (hm_iface mod_info)) == mn - then [] - else [(md_insts details, md_fam_insts details)]) - True -- Include -hi-boot - hsc_env - uid - mnwib - in (foldl' unionInstEnv emptyInstEnv insts, concat famInsts) - --- | Get rules from modules "below" this one (in the dependency sense) -hptRules :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> [CoreRule] -hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False +-------------------------------------------------------------------------------- +-- * Queries on Transitive Closure +-------------------------------------------------------------------------------- +-- | Find all rules in modules that are in the transitive closure of the given +-- module. +hugRulesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO RuleBase +hugRulesBelow hsc_env uid mn = foldr (flip extendRuleBaseList) emptyRuleBase <$> + hugSomeThingsBelowUs (md_rules . hm_details) False hsc_env uid mn --- | Get annotations from modules "below" this one (in the dependency sense) -hptAnns :: HscEnv -> Maybe (UnitId, ModuleNameWithIsBoot) -> [Annotation] -hptAnns hsc_env (Just (uid, mn)) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env uid mn -hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env +-- | Get annotations from all modules "below" this one (in the dependency +-- sense) within the home units. If the module is @Nothing@, returns /all/ +-- annotations in the home units. +hugAnnsBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO AnnEnv +hugAnnsBelow hsc_env uid mn = foldr (flip extendAnnEnvList) emptyAnnEnv <$> + hugSomeThingsBelowUs (md_anns . hm_details) False hsc_env uid mn -hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a] -hptAllThings extract hsc_env = concatMap (concatHpt extract . homeUnitEnv_hpt . snd) - (hugElts (hsc_HUG hsc_env)) +-- | Find all COMPLETE pragmas in modules that are in the transitive closure of the +-- given module. +hugCompleteSigsBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO CompleteMatches +hugCompleteSigsBelow hsc uid mn = foldr (++) [] <$> + hugSomeThingsBelowUs (md_complete_matches . hm_details) False hsc uid mn --- | Get things from modules "below" this one (in the dependency sense) --- C.f Inst.hptInstances -hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> UnitId -> ModuleNameWithIsBoot -> [a] -hptSomeThingsBelowUs extract include_hi_boot hsc_env uid mn - | isOneShot (ghcMode (hsc_dflags hsc_env)) = [] +-- | Find instances visible from the given set of imports +hugInstancesBelow :: HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO (InstEnv, [FamInst]) +hugInstancesBelow hsc_env uid mnwib = do + let mn = gwib_mod mnwib + (insts, famInsts) <- + unzip . concat <$> + hugSomeThingsBelowUs (\mod_info -> + let details = hm_details mod_info + -- Don't include instances for the current module + in if moduleName (mi_module (hm_iface mod_info)) == mn + then [] + else [(md_insts details, md_fam_insts details)]) + True -- Include -hi-boot + hsc_env + uid + mnwib + return (foldl' unionInstEnv emptyInstEnv insts, concat famInsts) - | otherwise +-- | Get things from modules in the transitive closure of the given module. +-- +-- Note: Don't expose this function. This is a footgun if exposed! +hugSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO [[a]] +-- An explicit check to see if we are in one-shot mode to avoid poking the ModuleGraph thunk +-- These things are currently stored in the EPS for home packages. (See #25795 for +-- progress in removing these kind of checks; and making these functions of +-- `UnitEnv` rather than `HscEnv`) +-- See Note [Downsweep and the ModuleGraph] +hugSomeThingsBelowUs _ _ hsc_env _ _ | isOneShot (ghcMode (hsc_dflags hsc_env)) = return [] +hugSomeThingsBelowUs extract include_hi_boot hsc_env uid mn = let hug = hsc_HUG hsc_env mg = hsc_mod_graph hsc_env in - [ thing - | - -- Find each non-hi-boot module below me - (ModNodeKeyWithUid (GWIB { gwib_mod = mod, gwib_isBoot = is_boot }) mod_uid) <- Set.toList (moduleGraphModulesBelow mg uid mn) + sequence + [ things + -- "Finding each non-hi-boot module below me" maybe could be cached (well, + -- the inverse) in the module graph to avoid filtering the boots out of + -- the transitive closure out every time this is called + | (ModNodeKeyWithUid (GWIB { gwib_mod = mod, gwib_isBoot = is_boot }) mod_uid) + <- Set.toList (moduleGraphModulesBelow mg uid mn) , include_hi_boot || (is_boot == NotBoot) -- unsavoury: when compiling the base package with --make, we @@ -286,20 +292,17 @@ , mod /= moduleName gHC_PRIM , not (mod == gwib_mod mn && uid == mod_uid) - -- Look it up in the HPT - , let things = case lookupHug hug mod_uid mod of - Just info -> extract info - Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg mempty + -- Look it up in the HUG + , let things = lookupHug hug mod_uid mod >>= \case + Just info -> return $ extract info + Nothing -> pprTrace "WARNING in hugSomeThingsBelowUs" msg mempty msg = vcat [text "missing module" <+> ppr mod, text "When starting from" <+> ppr mn, text "below:" <+> ppr (moduleGraphModulesBelow mg uid mn), text "Probable cause: out-of-date interface files"] -- This really shouldn't happen, but see #962 - , thing <- things ] - - -- | Deal with gathering annotations in from all possible places -- and combining them into a single 'AnnEnv' prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv @@ -311,11 +314,13 @@ -- otherwise load annotations from all home package table -- entries regardless of dependency ordering. get_mod mg = (moduleUnitId (mg_module mg), GWIB (moduleName (mg_module mg)) NotBoot) - home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap get_mod mb_guts + home_pkg_anns <- fromMaybe (hugAllAnns (hsc_unit_env hsc_env)) + $ uncurry (hugAnnsBelow hsc_env) + . get_mod <$> mb_guts + let other_pkg_anns = eps_ann_env eps - ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns, - Just home_pkg_anns, - Just other_pkg_anns] + !ann_env = maybe id plusAnnEnv mb_this_module_anns $! + plusAnnEnv home_pkg_anns other_pkg_anns return ann_env -- | Find the 'TyThing' for the given 'Name' by using all the resources @@ -327,9 +332,9 @@ lookupType hsc_env name = do eps <- liftIO $ hscEPS hsc_env let pte = eps_PTE eps - return $ lookupTypeInPTE hsc_env pte name + lookupTypeInPTE hsc_env pte name -lookupTypeInPTE :: HscEnv -> PackageTypeEnv -> Name -> Maybe TyThing +lookupTypeInPTE :: HscEnv -> PackageTypeEnv -> Name -> IO (Maybe TyThing) lookupTypeInPTE hsc_env pte name = ty where hpt = hsc_HUG hsc_env @@ -338,12 +343,12 @@ then mkHomeModule (hsc_home_unit hsc_env) (moduleName (nameModule name)) else nameModule name - !ty = if isOneShot (ghcMode (hsc_dflags hsc_env)) + ty = if isOneShot (ghcMode (hsc_dflags hsc_env)) -- in one-shot, we don't use the HPT - then lookupNameEnv pte name - else case lookupHugByModule mod hpt of - Just hm -> lookupNameEnv (md_types (hm_details hm)) name - Nothing -> lookupNameEnv pte name + then return $! lookupNameEnv pte name + else HUG.lookupHugByModule mod hpt >>= \case + Just hm -> pure $! lookupNameEnv (md_types (hm_details hm)) name + Nothing -> pure $! lookupNameEnv pte name -- | Find the 'ModIface' for a 'Module', searching in both the loaded home -- and external package module information @@ -351,9 +356,9 @@ :: HomeUnitGraph -> PackageIfaceTable -> Module - -> Maybe ModIface + -> IO (Maybe ModIface) lookupIfaceByModule hug pit mod - = case lookupHugByModule mod hug of + = HUG.lookupHugByModule mod hug >>= pure . \case Just hm -> Just (hm_iface hm) Nothing -> lookupModuleEnv pit mod -- If the module does come from the home package, why do we look in the PIT as well? @@ -363,8 +368,13 @@ -- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package -- of its own, but it doesn't seem worth the bother. +lookupIfaceByModuleHsc :: HscEnv -> Module -> IO (Maybe ModIface) +lookupIfaceByModuleHsc hsc_env mod = do + eps <- hscEPS hsc_env + lookupIfaceByModule (hsc_HUG hsc_env) (eps_PIT eps) mod + mainModIs :: HomeUnitEnv -> Module -mainModIs hue = mkHomeModule (expectJust "mainModIs" $ homeUnitEnv_home_unit hue) (mainModuleNameIs (homeUnitEnv_dflags hue)) +mainModIs hue = mkHomeModule (expectJust $ homeUnitEnv_home_unit hue) (mainModuleNameIs (homeUnitEnv_dflags hue)) -- | Retrieve the target code interpreter -- @@ -425,3 +435,19 @@ where home_unit = hsc_home_unit hsc_env old_name = ic_name old_ic + + +-------------------------------------------------------------------------------- +-- * The Legacy API, should be removed after enough deprecation cycles +-------------------------------------------------------------------------------- + +{-# DEPRECATED hscUpdateHPT "Updating the HPT directly is no longer a supported \ + \ operation. Instead, the HPT is an insert-only data structure. If you want to \ + \ overwrite an existing entry, just use 'hscInsertHPT' to insert it again (it \ + \ will override the existing entry if there is one). See 'GHC.Unit.Home.PackageTable' for more details." #-} +hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv +hscUpdateHPT f hsc_env = hsc_env { hsc_unit_env = updateHug (HUG.unitEnv_adjust upd (ue_currentUnit $ hsc_unit_env hsc_env)) ue } + where + ue = hsc_unit_env hsc_env + upd hue = hue { homeUnitEnv_hpt = f (homeUnitEnv_hpt hue) } + diff --git a/GHC/Driver/Env/Types.hs b/GHC/Driver/Env/Types.hs --- a/GHC/Driver/Env/Types.hs +++ b/GHC/Driver/Env/Types.hs @@ -18,7 +18,6 @@ import GHC.Types.Target import GHC.Types.TypeEnv import GHC.Unit.Finder.Types -import GHC.Unit.Module.Graph import GHC.Unit.Env import GHC.Utils.Logger import GHC.Utils.TmpFs @@ -65,9 +64,6 @@ hsc_targets :: [Target], -- ^ The targets (or roots) of the current session - hsc_mod_graph :: ModuleGraph, - -- ^ The module graph of the current session - hsc_IC :: InteractiveContext, -- ^ The context for evaluating interactive statements @@ -112,3 +108,4 @@ , hsc_llvm_config :: !LlvmConfigCache -- ^ LLVM configuration cache. } + diff --git a/GHC/Driver/Errors.hs b/GHC/Driver/Errors.hs --- a/GHC/Driver/Errors.hs +++ b/GHC/Driver/Errors.hs @@ -13,7 +13,7 @@ import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext ) import GHC.Utils.Logger -printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO () +printMessages :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO () printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } @@ -28,7 +28,7 @@ errMsgContext = name_ppr_ctx } <- sortMsgBag (Just opts) (getMessages msgs) ] where - messageWithHints :: Diagnostic a => a -> SDoc + messageWithHints :: a -> SDoc messageWithHints e = let main_msg = formatBulleted $ diagnosticMessage msg_opts e in case diagnosticHints e of diff --git a/GHC/Driver/Errors/Ppr.hs b/GHC/Driver/Errors/Ppr.hs --- a/GHC/Driver/Errors/Ppr.hs +++ b/GHC/Driver/Errors/Ppr.hs @@ -23,7 +23,6 @@ import GHC.Utils.Panic import GHC.Unit.Module import GHC.Unit.Module.Graph -import GHC.Unit.Module.ModSummary import GHC.Unit.State import GHC.Types.Hint import GHC.Types.SrcLoc @@ -63,7 +62,7 @@ -> diagnosticMessage (dsMessageOpts opts) m GhcDriverMessage m -> diagnosticMessage (driverMessageOpts opts) m - GhcUnknownMessage (UnknownDiagnostic f m) + GhcUnknownMessage (UnknownDiagnostic f _ m) -> diagnosticMessage (f opts) m diagnosticReason = \case @@ -90,7 +89,7 @@ GhcUnknownMessage m -> diagnosticHints m - diagnosticCode = constructorCode + diagnosticCode = constructorCode @GHC instance HasDefaultDiagnosticOpts DriverMessageOpts where defaultOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage) @@ -98,7 +97,7 @@ instance Diagnostic DriverMessage where type DiagnosticOpts DriverMessage = DriverMessageOpts diagnosticMessage opts = \case - DriverUnknownMessage (UnknownDiagnostic f m) + DriverUnknownMessage (UnknownDiagnostic f _ m) -> diagnosticMessage (f opts) m DriverPsHeaderMessage m -> diagnosticMessage (psDiagnosticOpts opts) m @@ -156,7 +155,7 @@ text "module" <+> quotes (ppr mod) <+> text "is defined in multiple files:" <+> sep (map text files) - DriverModuleNotFound mod + DriverModuleNotFound _uid mod -> mkSimpleDecorated (text "module" <+> quotes (ppr mod) <+> text "cannot be found locally") DriverFileModuleNameMismatch actual expected -> mkSimpleDecorated $ @@ -261,10 +260,16 @@ ppr_node (ModuleNode _deps m) = text "module" <+> ppr_ms m ppr_node (InstantiationNode _uid u) = text "instantiated unit" <+> ppr u ppr_node (LinkNode uid _) = pprPanic "LinkNode should not be in a cycle" (ppr uid) + ppr_node (UnitNode uid _) = pprPanic "UnitNode should not be in a cycle" (ppr uid) - ppr_ms :: ModSummary -> SDoc - ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+> - (parens (text (msHsFilePath ms))) + ppr_ms :: ModuleNodeInfo -> SDoc + ppr_ms ms = quotes (ppr (moduleNodeInfoModule ms)) <+> + (parens (text (node_path ms))) + + node_path :: ModuleNodeInfo -> FilePath + node_path ms = case ml_hs_file (moduleNodeInfoLocation ms) of + Just f -> f + Nothing -> ml_hi_file (moduleNodeInfoLocation ms) DriverInstantiationNodeInDependencyGeneration node -> mkSimpleDecorated $ vcat [ text "Unexpected backpack instantiation in dependency graph while constructing Makefile:" @@ -422,4 +427,4 @@ DriverNoConfiguredLLVMToolchain -> noHints - diagnosticCode = constructorCode + diagnosticCode = constructorCode @GHC diff --git a/GHC/Driver/Errors/Types.hs b/GHC/Driver/Errors/Types.hs --- a/GHC/Driver/Errors/Types.hs +++ b/GHC/Driver/Errors/Types.hs @@ -4,6 +4,7 @@ module GHC.Driver.Errors.Types ( GhcMessage(..) + , AnyGhcDiagnostic , GhcMessageOpts(..) , DriverMessage(..) , DriverMessageOpts(..) @@ -94,10 +95,11 @@ -- 'Diagnostic' constraint ensures that worst case scenario we can still -- render this into something which can be eventually converted into a -- 'DecoratedSDoc'. - GhcUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts GhcMessage)) -> GhcMessage + GhcUnknownMessage :: (UnknownDiagnosticFor GhcMessage) -> GhcMessage deriving Generic +type AnyGhcDiagnostic = UnknownDiagnosticFor GhcMessage data GhcMessageOpts = GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage , tcMessageOpts :: DiagnosticOpts TcRnMessage @@ -111,7 +113,7 @@ -- conversion can happen gradually. This function should not be needed within -- GHC, as it would typically be used by plugin or library authors (see -- comment for the 'GhcUnknownMessage' type constructor) -ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) => a -> GhcMessage +ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ DiagnosticHint GhcMessage, Diagnostic a, Typeable a) => a -> GhcMessage ghcUnknownMessage = GhcUnknownMessage . mkSimpleUnknownDiagnostic -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on @@ -130,7 +132,7 @@ -- | A message from the driver. data DriverMessage where -- | Simply wraps a generic 'Diagnostic' message @a@. - DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage + DriverUnknownMessage :: UnknownDiagnosticFor DriverMessage -> DriverMessage -- | A parse error in parsing a Haskell file header during dependency -- analysis @@ -185,7 +187,7 @@ Test cases: None. -} - DriverModuleNotFound :: !ModuleName -> DriverMessage + DriverModuleNotFound :: !UnitId -> !ModuleName -> DriverMessage {-| DriverFileModuleNameMismatch occurs if a module 'A' is defined in a file with a different name. The first field is the name written in the source code; the second argument is the name extracted diff --git a/GHC/Driver/Flags.hs b/GHC/Driver/Flags.hs --- a/GHC/Driver/Flags.hs +++ b/GHC/Driver/Flags.hs @@ -29,6 +29,7 @@ , minusWcompatOpts , unusedBindsFlags + , OnOff(..) , TurnOnFlag , turnOn , turnOff @@ -75,8 +76,19 @@ get bh = toEnum <$> get bh instance NFData Language where - rnf x = x `seq` () + rnf Haskell98 = () + rnf Haskell2010 = () + rnf GHC2021 = () + rnf GHC2024 = () +data OnOff a = On a + | Off a + deriving (Eq, Show) + +instance Outputable a => Outputable (OnOff a) where + ppr (On x) = text "On" <+> ppr x + ppr (Off x) = text "Off" <+> ppr x + type TurnOnFlag = Bool -- True <=> we are turning the flag on -- False <=> we are turning the flag off turnOn :: TurnOnFlag; turnOn = True @@ -247,6 +259,8 @@ LangExt.ExtendedLiterals -> "ExtendedLiterals" LangExt.ListTuplePuns -> "ListTuplePuns" LangExt.MultilineStrings -> "MultilineStrings" + LangExt.ExplicitLevelImports -> "ExplicitLevelImports" + LangExt.ImplicitStagePersistence -> "ImplicitStagePersistence" -- | Is this extension known by any other names? For example -- -XGeneralizedNewtypeDeriving is accepted @@ -269,78 +283,79 @@ ++ mk (ExtensionDeprecatedFor [ext]) (extensionDeprecatedNames ext) where mk depr = map (\name -> (depr, name)) - -impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)] +impliedXFlags :: [(LangExt.Extension, OnOff LangExt.Extension)] impliedXFlags -- See Note [Updating flag description in the User's Guide] - = [ (LangExt.RankNTypes, turnOn, LangExt.ExplicitForAll) - , (LangExt.QuantifiedConstraints, turnOn, LangExt.ExplicitForAll) - , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExplicitForAll) - , (LangExt.LiberalTypeSynonyms, turnOn, LangExt.ExplicitForAll) - , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll) - , (LangExt.FlexibleInstances, turnOn, LangExt.TypeSynonymInstances) - , (LangExt.FunctionalDependencies, turnOn, LangExt.MultiParamTypeClasses) - , (LangExt.MultiParamTypeClasses, turnOn, LangExt.ConstrainedClassMethods) -- c.f. #7854 - , (LangExt.TypeFamilyDependencies, turnOn, LangExt.TypeFamilies) + = [ (LangExt.RankNTypes, On LangExt.ExplicitForAll) + , (LangExt.QuantifiedConstraints, On LangExt.ExplicitForAll) + , (LangExt.ScopedTypeVariables, On LangExt.ExplicitForAll) + , (LangExt.LiberalTypeSynonyms, On LangExt.ExplicitForAll) + , (LangExt.ExistentialQuantification, On LangExt.ExplicitForAll) + , (LangExt.FlexibleInstances, On LangExt.TypeSynonymInstances) + , (LangExt.FunctionalDependencies, On LangExt.MultiParamTypeClasses) + , (LangExt.MultiParamTypeClasses, On LangExt.ConstrainedClassMethods) -- c.f. #7854 + , (LangExt.TypeFamilyDependencies, On LangExt.TypeFamilies) - , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! + , (LangExt.RebindableSyntax, Off LangExt.ImplicitPrelude) -- NB: turn off! - , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies) + , (LangExt.DerivingVia, On LangExt.DerivingStrategies) - , (LangExt.GADTs, turnOn, LangExt.GADTSyntax) - , (LangExt.GADTs, turnOn, LangExt.MonoLocalBinds) - , (LangExt.TypeFamilies, turnOn, LangExt.MonoLocalBinds) + , (LangExt.GADTs, On LangExt.GADTSyntax) + , (LangExt.GADTs, On LangExt.MonoLocalBinds) + , (LangExt.TypeFamilies, On LangExt.MonoLocalBinds) - , (LangExt.TypeFamilies, turnOn, LangExt.KindSignatures) -- Type families use kind signatures - , (LangExt.PolyKinds, turnOn, LangExt.KindSignatures) -- Ditto polymorphic kinds + , (LangExt.TypeFamilies, On LangExt.KindSignatures) -- Type families use kind signatures + , (LangExt.PolyKinds, On LangExt.KindSignatures) -- Ditto polymorphic kinds -- TypeInType is now just a synonym for a couple of other extensions. - , (LangExt.TypeInType, turnOn, LangExt.DataKinds) - , (LangExt.TypeInType, turnOn, LangExt.PolyKinds) - , (LangExt.TypeInType, turnOn, LangExt.KindSignatures) + , (LangExt.TypeInType, On LangExt.DataKinds) + , (LangExt.TypeInType, On LangExt.PolyKinds) + , (LangExt.TypeInType, On LangExt.KindSignatures) -- Standalone kind signatures are a replacement for CUSKs. - , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs) + , (LangExt.StandaloneKindSignatures, Off LangExt.CUSKs) -- AutoDeriveTypeable is not very useful without DeriveDataTypeable - , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable) + , (LangExt.AutoDeriveTypeable, On LangExt.DeriveDataTypeable) -- We turn this on so that we can export associated type -- type synonyms in subordinates (e.g. MyClass(type AssocType)) - , (LangExt.TypeFamilies, turnOn, LangExt.ExplicitNamespaces) - , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces) + , (LangExt.TypeFamilies, On LangExt.ExplicitNamespaces) + , (LangExt.TypeOperators, On LangExt.ExplicitNamespaces) - , (LangExt.ImpredicativeTypes, turnOn, LangExt.RankNTypes) + , (LangExt.ImpredicativeTypes, On LangExt.RankNTypes) -- Record wild-cards implies field disambiguation -- Otherwise if you write (C {..}) you may well get -- stuff like " 'a' not in scope ", which is a bit silly -- if the compiler has just filled in field 'a' of constructor 'C' - , (LangExt.RecordWildCards, turnOn, LangExt.DisambiguateRecordFields) - - , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp) + , (LangExt.RecordWildCards, On LangExt.DisambiguateRecordFields) - , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI) + , (LangExt.ParallelArrays, On LangExt.ParallelListComp) + , (LangExt.MonadComprehensions, On LangExt.ParallelListComp) + , (LangExt.JavaScriptFFI, On LangExt.InterruptibleFFI) - , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor) - , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable) + , (LangExt.DeriveTraversable, On LangExt.DeriveFunctor) + , (LangExt.DeriveTraversable, On LangExt.DeriveFoldable) -- Duplicate record fields require field disambiguation - , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields) + , (LangExt.DuplicateRecordFields, On LangExt.DisambiguateRecordFields) - , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes) - , (LangExt.Strict, turnOn, LangExt.StrictData) + , (LangExt.TemplateHaskell, On LangExt.TemplateHaskellQuotes) + , (LangExt.Strict, On LangExt.StrictData) -- Historically only UnboxedTuples was required for unboxed sums to work. -- To avoid breaking code, we make UnboxedTuples imply UnboxedSums. - , (LangExt.UnboxedTuples, turnOn, LangExt.UnboxedSums) + , (LangExt.UnboxedTuples, On LangExt.UnboxedSums) -- The extensions needed to declare an H98 unlifted data type - , (LangExt.UnliftedDatatypes, turnOn, LangExt.DataKinds) - , (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures) + , (LangExt.UnliftedDatatypes, On LangExt.DataKinds) + , (LangExt.UnliftedDatatypes, On LangExt.StandaloneKindSignatures) -- See (NVP3) in Note [Non-variable pattern bindings aren't linear] in GHC.Tc.Gen.Bind - , (LangExt.LinearTypes, turnOn, LangExt.MonoLocalBinds) + , (LangExt.LinearTypes, On LangExt.MonoLocalBinds) + + , (LangExt.ExplicitLevelImports, Off LangExt.ImplicitStagePersistence) ] @@ -352,7 +367,7 @@ , (Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits) , (Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits) ] --- General flags that are switched on/off when other general flags are switched +-- | General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles) @@ -365,12 +380,12 @@ ,(Opt_InfoTableMap, turnOn, Opt_InfoTableMapWithFallback) ] ++ validHoleFitsImpliedGFlags --- General flags that are switched on/off when other general flags are switched +-- | General flags that are switched on/off when other general flags are switched -- off impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)] --- Please keep what_glasgow_exts_does.rst up to date with this list +-- Please keep @docs/users_guide/what_glasgow_exts_does.rst@ up to date with this list. glasgowExtsFlags :: [LangExt.Extension] glasgowExtsFlags = [ LangExt.ConstrainedClassMethods @@ -418,7 +433,7 @@ -- enabled if you run -ddump-cmm-verbose-by-proc -- Each flag corresponds to exact stage of Cmm pipeline. | Opt_D_dump_cmm_verbose - -- same as -ddump-cmm-verbose-by-proc but writes each stage + -- ^ same as -ddump-cmm-verbose-by-proc but writes each stage -- to a separate file (if used with -ddump-to-file) | Opt_D_dump_cmm_cfg | Opt_D_dump_cmm_cbe @@ -470,6 +485,7 @@ | Opt_D_dump_stg_cg -- ^ STG (after stg2stg) | Opt_D_dump_stg_tags -- ^ Result of tag inference analysis. | Opt_D_dump_stg_final -- ^ Final STG (before cmm gen) + | Opt_D_dump_stg_from_js_sinker -- ^ STG after JS sinker | Opt_D_dump_call_arity | Opt_D_dump_exitify | Opt_D_dump_dmdanal @@ -491,9 +507,9 @@ | Opt_D_dump_rn_stats | Opt_D_dump_opt_cmm | Opt_D_dump_simpl_stats - | Opt_D_dump_cs_trace -- Constraint solver in type checker + | Opt_D_dump_cs_trace -- ^ Constraint solver in type checker | Opt_D_dump_tc_trace - | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker + | Opt_D_dump_ec_trace -- ^ Pattern match exhaustiveness checker | Opt_D_dump_if_trace | Opt_D_dump_splices | Opt_D_th_dec_file @@ -582,9 +598,13 @@ | Opt_InfoTableMapWithFallback | Opt_InfoTableMapWithStack - | Opt_WarnIsError -- -Werror; makes warnings fatal - | Opt_ShowWarnGroups -- Show the group a warning belongs to - | Opt_HideSourcePaths -- Hide module source/object paths + | Opt_WarnIsError + -- ^ @-Werror@; makes all warnings fatal. + -- See 'wopt_set_fatal' for making individual warnings fatal as in @-Werror=foo@. + | Opt_ShowWarnGroups + -- ^ Show the group a warning belongs to. + | Opt_HideSourcePaths + -- ^ @-fhide-source-paths@; hide module source/object paths. | Opt_PrintExplicitForalls | Opt_PrintExplicitKinds @@ -632,15 +652,15 @@ | Opt_IgnoreAsserts | Opt_DoEtaReduction | Opt_CaseMerge - | Opt_CaseFolding -- Constant folding through case-expressions + | Opt_CaseFolding -- ^ Constant folding through case-expressions | Opt_UnboxStrictFields | Opt_UnboxSmallStrictFields | Opt_DictsCheap - | Opt_EnableRewriteRules -- Apply rewrite rules during simplification - | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices - | Opt_RegsGraph -- do graph coloring register allocation - | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation - | Opt_PedanticBottoms -- Be picky about how we treat bottom + | Opt_EnableRewriteRules -- ^ Apply rewrite rules during simplification + | Opt_EnableThSpliceWarnings -- ^ Enable warnings for TH splices + | Opt_RegsGraph -- ^ Do graph coloring register allocation + | Opt_RegsIterative -- ^ Do iterative coalescing graph coloring register allocation + | Opt_PedanticBottoms -- ^ Be picky about how we treat bottom | Opt_LlvmFillUndefWithGarbage -- Testing for undef bugs (hidden flag) | Opt_IrrefutableTuples | Opt_CmmSink @@ -650,20 +670,20 @@ | Opt_AsmShortcutting | Opt_InterModuleFarJumps | Opt_OmitYields - | Opt_FunToThunk -- deprecated - | Opt_DictsStrict -- be strict in argument dictionaries + | Opt_FunToThunk -- deprecated + | Opt_DictsStrict -- ^ Be strict in argument dictionaries | Opt_DmdTxDictSel -- ^ deprecated, no effect and behaviour is now default. -- Allowed switching of a special demand transformer for dictionary selectors - | Opt_Loopification -- See Note [Self-recursive tail calls] - | Opt_CfgBlocklayout -- ^ Use the cfg based block layout algorithm. - | Opt_WeightlessBlocklayout -- ^ Layout based on last instruction per block. + | Opt_Loopification -- See Note [Self-recursive tail calls] + | Opt_CfgBlocklayout -- ^ Use the cfg based block layout algorithm. + | Opt_WeightlessBlocklayout -- ^ Layout based on last instruction per block. | Opt_CprAnal | Opt_WorkerWrapper | Opt_WorkerWrapperUnlift -- ^ Do W/W split for unlifting even if we won't unbox anything. | Opt_SolveConstantDicts | Opt_AlignmentSanitisation | Opt_CatchNonexhaustiveCases - | Opt_NumConstantFolding + | Opt_NumConstantFolding -- ^ See Note [Constant folding through nested expressions] in GHC.Core.Opt.ConstantFold | Opt_CoreConstantFolding | Opt_FastPAPCalls -- #6084 | Opt_SpecEval @@ -673,7 +693,7 @@ -- Inference flags | Opt_DoTagInferenceChecks - -- PreInlining is on by default. The option is there just to see how + -- | PreInlining is on by default. The option is there just to see how -- bad things get if you turn it off! | Opt_SimplPreInlining @@ -682,13 +702,15 @@ | Opt_OmitInterfacePragmas | Opt_ExposeAllUnfoldings | Opt_ExposeOverloadedUnfoldings - | Opt_KeepAutoRules -- ^Keep auto-generated rules even if they seem to have become useless - | Opt_WriteInterface -- forces .hi files to be written even with -fno-code - | Opt_WriteHie -- generate .hie files + | Opt_KeepAutoRules -- ^ Keep auto-generated rules even if they seem to have become useless + | Opt_WriteInterface -- ^ Forces .hi files to be written even with -fno-code + | Opt_WriteSelfRecompInfo + | Opt_WriteSelfRecompFlags -- ^ Include detailed flag information for self-recompilation debugging + | Opt_WriteHie -- ^ Generate .hie files -- JavaScript opts - | Opt_DisableJsMinifier -- ^ render JavaScript pretty-printed instead of minified (compacted) - | Opt_DisableJsCsources -- ^ don't link C sources (compiled to JS) with Haskell code (compiled to JS) + | Opt_DisableJsMinifier -- ^ Render JavaScript pretty-printed instead of minified (compacted) + | Opt_DisableJsCsources -- ^ Don't link C sources (compiled to JS) with Haskell code (compiled to JS) -- profiling opts | Opt_AutoSccsOnIndividualCafs @@ -731,6 +753,14 @@ | Opt_ValidateHie | Opt_LocalGhciHistory | Opt_NoIt + + -- wasm ghci browser mode + | Opt_GhciBrowser + | Opt_GhciBrowserRedirectWasiConsole + + -- | Instruct GHCi to load all targets on startup + | Opt_GhciDoLoadTargets + | Opt_HelpfulErrors | Opt_DeferTypeErrors -- Since 7.6 | Opt_DeferTypedHoles -- Since 7.10 @@ -771,11 +801,11 @@ | Opt_LinkRts -- output style opts - | Opt_ErrorSpans -- Include full span info in error messages, + | Opt_ErrorSpans -- ^ Include full span info in error messages, -- instead of just the start position. | Opt_DeferDiagnostics | Opt_DiagnosticsAsJSON -- ^ Dump diagnostics as JSON - | Opt_DiagnosticsShowCaret -- Show snippets of offending code + | Opt_DiagnosticsShowCaret -- ^ Show snippets of offending code | Opt_PprCaseAsLet | Opt_PprShowTicks | Opt_ShowHoleConstraints @@ -798,29 +828,29 @@ | Opt_ShowLoadedModules | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals] - -- Suppress a coercions inner structure, replacing it with '...' + -- | Suppress a coercions inner structure, replacing it with '...' | Opt_SuppressCoercions - -- Suppress the type of a coercion as well + -- | Suppress the type of a coercion as well | Opt_SuppressCoercionTypes | Opt_SuppressVarKinds - -- Suppress module id prefixes on variables. + -- | Suppress module id prefixes on variables. | Opt_SuppressModulePrefixes - -- Suppress type applications. + -- | Suppress type applications. | Opt_SuppressTypeApplications - -- Suppress info such as arity and unfoldings on identifiers. + -- | Suppress info such as arity and unfoldings on identifiers. | Opt_SuppressIdInfo - -- Suppress separate type signatures in core, but leave types on + -- | Suppress separate type signatures in core, but leave types on -- lambda bound vars | Opt_SuppressUnfoldings - -- Suppress the details of even stable unfoldings + -- | Suppress the details of even stable unfoldings | Opt_SuppressTypeSignatures - -- Suppress unique ids on variables. + -- | Suppress unique ids on variables. -- Except for uniques, as some simplifier phases introduce new -- variables that have otherwise identical names. | Opt_SuppressUniques | Opt_SuppressStgExts | Opt_SuppressStgReps - | Opt_SuppressTicks -- Replaces Opt_PprShowTicks + | Opt_SuppressTicks -- ^ Replaces Opt_PprShowTicks | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps | Opt_SuppressCoreSizes -- ^ Suppress per binding Core size stats in dumps @@ -1021,55 +1051,62 @@ | Opt_WarnDerivingTypeable | Opt_WarnDeferredTypeErrors | Opt_WarnDeferredOutOfScopeVariables - | Opt_WarnNonCanonicalMonadInstances -- since 8.0 - | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0, removed 8.8 - | Opt_WarnNonCanonicalMonoidInstances -- since 8.0 - | Opt_WarnMissingPatternSynonymSignatures -- since 8.0 - | Opt_WarnUnrecognisedWarningFlags -- since 8.0 - | Opt_WarnSimplifiableClassConstraints -- Since 8.2 - | Opt_WarnCPPUndef -- Since 8.2 - | Opt_WarnUnbangedStrictPatterns -- Since 8.2 - | Opt_WarnMissingHomeModules -- Since 8.2 - | Opt_WarnPartialFields -- Since 8.4 + | Opt_WarnNonCanonicalMonadInstances -- ^ @since 8.0 + | Opt_WarnNonCanonicalMonadFailInstances -- ^ @since 8.0, has no effect since 8.8 + | Opt_WarnNonCanonicalMonoidInstances -- ^ @since 8.0 + | Opt_WarnMissingPatternSynonymSignatures -- ^ @since 8.0 + | Opt_WarnUnrecognisedWarningFlags -- ^ @since 8.0 + | Opt_WarnSimplifiableClassConstraints -- ^ @since 8.2 + | Opt_WarnCPPUndef -- ^ @since 8.2 + | Opt_WarnUnbangedStrictPatterns -- ^ @since 8.2 + | Opt_WarnMissingHomeModules -- ^ @since 8.2 + | Opt_WarnPartialFields -- ^ @since 8.4 | Opt_WarnMissingExportList | Opt_WarnInaccessibleCode - | Opt_WarnStarIsType -- Since 8.6 - | Opt_WarnStarBinder -- Since 8.6 - | Opt_WarnImplicitKindVars -- Since 8.6 + | Opt_WarnStarIsType -- ^ @since 8.6 + | Opt_WarnStarBinder -- ^ @since 8.6 + | Opt_WarnImplicitKindVars -- ^ @since 8.6 | Opt_WarnSpaceAfterBang - | Opt_WarnMissingDerivingStrategies -- Since 8.8 - | Opt_WarnPrepositiveQualifiedModule -- Since 8.10 - | Opt_WarnUnusedPackages -- Since 8.10 - | Opt_WarnInferredSafeImports -- Since 8.10 - | Opt_WarnMissingSafeHaskellMode -- Since 8.10 - | Opt_WarnCompatUnqualifiedImports -- Since 8.10 + | Opt_WarnMissingDerivingStrategies -- ^ @since 8.8 + | Opt_WarnPrepositiveQualifiedModule -- ^ @since 8.10 + | Opt_WarnUnusedPackages -- ^ @since 8.10 + | Opt_WarnInferredSafeImports -- ^ @since 8.10 + | Opt_WarnMissingSafeHaskellMode -- ^ @since 8.10 + | Opt_WarnCompatUnqualifiedImports -- ^ @since 8.10 | Opt_WarnDerivingDefaults - | Opt_WarnInvalidHaddock -- Since 9.0 - | Opt_WarnOperatorWhitespaceExtConflict -- Since 9.2 - | Opt_WarnOperatorWhitespace -- Since 9.2 - | Opt_WarnAmbiguousFields -- Since 9.2 - | Opt_WarnImplicitLift -- Since 9.2 - | Opt_WarnMissingKindSignatures -- Since 9.2 - | Opt_WarnMissingPolyKindSignatures -- Since 9.8 - | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2 - | Opt_WarnRedundantStrictnessFlags -- Since 9.4 - | Opt_WarnForallIdentifier -- Since 9.4 - | Opt_WarnUnicodeBidirectionalFormatCharacters -- Since 9.0.2 - | Opt_WarnGADTMonoLocalBinds -- Since 9.4 - | Opt_WarnTypeEqualityOutOfScope -- Since 9.4 - | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 - | Opt_WarnLoopySuperclassSolve -- Since 9.6, has no effect since 9.10 - | Opt_WarnTermVariableCapture -- Since 9.8 - | Opt_WarnMissingRoleAnnotations -- Since 9.8 - | Opt_WarnImplicitRhsQuantification -- Since 9.8 - | Opt_WarnIncompleteExportWarnings -- Since 9.8 - | Opt_WarnIncompleteRecordSelectors -- Since 9.10 - | Opt_WarnBadlyStagedTypes -- Since 9.10 - | Opt_WarnInconsistentFlags -- Since 9.8 - | Opt_WarnDataKindsTC -- Since 9.10 - | Opt_WarnDeprecatedTypeAbstractions -- Since 9.10 - | Opt_WarnDefaultedExceptionContext -- Since 9.10 - | Opt_WarnViewPatternSignatures -- Since 9.12 + | Opt_WarnInvalidHaddock -- ^ @since 9.0 + | Opt_WarnOperatorWhitespaceExtConflict -- ^ @since 9.2 + | Opt_WarnOperatorWhitespace -- ^ @since 9.2 + | Opt_WarnAmbiguousFields -- ^ @since 9.2 + | Opt_WarnImplicitLift -- ^ @since 9.2 + | Opt_WarnMissingKindSignatures -- ^ @since 9.2 + | Opt_WarnMissingPolyKindSignatures -- ^ @since 9.8 + | Opt_WarnMissingExportedPatternSynonymSignatures -- ^ @since 9.2 + | Opt_WarnRedundantStrictnessFlags -- ^ @since 9.4 + | Opt_WarnForallIdentifier -- ^ @since 9.4 + | Opt_WarnUnicodeBidirectionalFormatCharacters -- ^ @since 9.0.2 + | Opt_WarnGADTMonoLocalBinds -- ^ @since 9.4 + | Opt_WarnTypeEqualityOutOfScope -- ^ @since 9.4 + | Opt_WarnTypeEqualityRequiresOperators -- ^ @since 9.4 + | Opt_WarnLoopySuperclassSolve -- ^ @since 9.6, has no effect since 9.10 + | Opt_WarnTermVariableCapture -- ^ @since 9.8 + | Opt_WarnMissingRoleAnnotations -- ^ @since 9.8 + | Opt_WarnImplicitRhsQuantification -- ^ @since 9.8 + | Opt_WarnIncompleteExportWarnings -- ^ @since 9.8 + | Opt_WarnIncompleteRecordSelectors -- ^ @since 9.10 + | Opt_WarnBadlyLevelledTypes -- ^ @since 9.10 + | Opt_WarnInconsistentFlags -- ^ @since 9.8 + | Opt_WarnDataKindsTC -- ^ @since 9.10 + | Opt_WarnDefaultedExceptionContext -- ^ @since 9.10 + | Opt_WarnViewPatternSignatures -- ^ @since 9.12 + | Opt_WarnUselessSpecialisations -- ^ @since 9.14 + | Opt_WarnDeprecatedPragmas -- ^ @since 9.14 + | Opt_WarnRuleLhsEqualities + -- ^ @since 9.14, scheduled to be removed in 9.18 + -- + -- See Note [Quantifying over equalities in RULES] in GHC.Tc.Gen.Sig + | Opt_WarnUnusableUnpackPragmas -- Since 9.14 + | Opt_WarnPatternNamespaceSpecifier -- Since 9.14 deriving (Eq, Ord, Show, Enum, Bounded) -- | Return the names of a WarningFlag @@ -1181,12 +1218,16 @@ Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] Opt_WarnIncompleteExportWarnings -> "incomplete-export-warnings" :| [] Opt_WarnIncompleteRecordSelectors -> "incomplete-record-selectors" :| [] - Opt_WarnBadlyStagedTypes -> "badly-staged-types" :| [] + Opt_WarnBadlyLevelledTypes -> "badly-levelled-types" :| [] Opt_WarnInconsistentFlags -> "inconsistent-flags" :| [] Opt_WarnDataKindsTC -> "data-kinds-tc" :| [] - Opt_WarnDeprecatedTypeAbstractions -> "deprecated-type-abstractions" :| [] Opt_WarnDefaultedExceptionContext -> "defaulted-exception-context" :| [] Opt_WarnViewPatternSignatures -> "view-pattern-signatures" :| [] + Opt_WarnUselessSpecialisations -> "useless-specialisations" :| ["useless-specializations"] + Opt_WarnDeprecatedPragmas -> "deprecated-pragmas" :| [] + Opt_WarnRuleLhsEqualities -> "rule-lhs-equalities" :| [] + Opt_WarnUnusableUnpackPragmas -> "unusable-unpack-pragmas" :| [] + Opt_WarnPatternNamespaceSpecifier -> "pattern-namespace-specifier" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -1246,7 +1287,7 @@ -- | Warning groups. -- --- As all warnings are in the Weverything set, it is ignored when +-- As all warnings are in the 'W_everything' set, it is ignored when -- displaying to the user which group a warning is in. warningGroups :: [WarningGroup] warningGroups = [minBound..maxBound] @@ -1261,7 +1302,7 @@ -- Separating this from 'warningGroups' allows for multiple -- hierarchies with no inherent relation to be defined. -- --- The special-case Weverything group is not included. +-- The special-case 'W_everything' group is not included. warningHierarchies :: [[WarningGroup]] warningHierarchies = hierarchies ++ map (:[]) rest where @@ -1323,15 +1364,19 @@ Opt_WarnOperatorWhitespaceExtConflict, Opt_WarnUnicodeBidirectionalFormatCharacters, Opt_WarnGADTMonoLocalBinds, - Opt_WarnBadlyStagedTypes, + Opt_WarnBadlyLevelledTypes, Opt_WarnTypeEqualityRequiresOperators, Opt_WarnInconsistentFlags, - Opt_WarnDataKindsTC, Opt_WarnTypeEqualityOutOfScope, - Opt_WarnViewPatternSignatures + Opt_WarnImplicitRhsQuantification, -- was in -Wcompat since 9.8, enabled by default since 9.14, to turn into a hard error in 9.16 + Opt_WarnViewPatternSignatures, + Opt_WarnUselessSpecialisations, + Opt_WarnDeprecatedPragmas, + Opt_WarnRuleLhsEqualities, + Opt_WarnUnusableUnpackPragmas ] --- | Things you get with -W +-- | Things you get with @-W@. minusWOpts :: [WarningFlag] minusWOpts = standardWarnings ++ @@ -1347,7 +1392,7 @@ Opt_WarnUnbangedStrictPatterns ] --- | Things you get with -Wall +-- | Things you get with @-Wall@. minusWallOpts :: [WarningFlag] minusWallOpts = minusWOpts ++ @@ -1364,25 +1409,25 @@ Opt_WarnIncompleteUniPatterns, Opt_WarnIncompletePatternsRecUpd, Opt_WarnIncompleteExportWarnings, + Opt_WarnIncompleteRecordSelectors, Opt_WarnDerivingTypeable ] --- | Things you get with -Weverything, i.e. *all* known warnings flags +-- | Things you get with @-Weverything@, i.e. *all* known warnings flags. minusWeverythingOpts :: [WarningFlag] minusWeverythingOpts = [ toEnum 0 .. ] --- | Things you get with -Wcompat. +-- | Things you get with @-Wcompat@. -- -- This is intended to group together warnings that will be enabled by default -- at some point in the future, so that library authors eager to make their -- code future compatible to fix issues before they even generate warnings. minusWcompatOpts :: [WarningFlag] minusWcompatOpts - = [ Opt_WarnImplicitRhsQuantification - , Opt_WarnDeprecatedTypeAbstractions + = [ Opt_WarnPatternNamespaceSpecifier ] --- | Things you get with -Wunused-binds +-- | Things you get with @-Wunused-binds@. unusedBindsFlags :: [WarningFlag] unusedBindsFlags = [ Opt_WarnUnusedTopBinds , Opt_WarnUnusedLocalBinds diff --git a/GHC/Driver/Hooks.hs b/GHC/Driver/Hooks.hs --- a/GHC/Driver/Hooks.hs +++ b/GHC/Driver/Hooks.hs @@ -52,7 +52,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface -import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable import GHC.Core import GHC.Core.TyCon diff --git a/GHC/Driver/IncludeSpecs.hs b/GHC/Driver/IncludeSpecs.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/IncludeSpecs.hs @@ -0,0 +1,48 @@ +module GHC.Driver.IncludeSpecs + ( IncludeSpecs(..) + , addGlobalInclude + , addQuoteInclude + , addImplicitQuoteInclude + , flattenIncludes + ) where + +import GHC.Prelude + +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + -- | See Note [Implicit include paths] + , includePathsQuoteImplicit :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | These includes are not considered while fingerprinting the flags for iface +-- | See Note [Implicit include paths] +addImplicitQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addImplicitQuoteInclude spec paths = let f = includePathsQuoteImplicit spec + in spec { includePathsQuoteImplicit = f ++ paths } + + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = + includePathsQuote specs ++ + includePathsQuoteImplicit specs ++ + includePathsGlobal specs diff --git a/GHC/Driver/Main.hs b/GHC/Driver/Main.hs --- a/GHC/Driver/Main.hs +++ b/GHC/Driver/Main.hs @@ -47,6 +47,7 @@ , initModDetails , initWholeCoreBindings , loadIfaceByteCode + , loadIfaceByteCodeLazy , hscMaybeWriteIface , hscCompileCmmFile @@ -81,7 +82,7 @@ , hscRnImportDecls , hscTcRnLookupRdrName , hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt - , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls + , hscParseDeclsWithLocation, hscParsedDecls , hscParseModuleWithLocation , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType , hscParseExpr @@ -104,6 +105,7 @@ , hscAddSptEntries , writeInterfaceOnlyMode , loadByteCode + , genModDetails ) where import GHC.Prelude @@ -116,6 +118,7 @@ import GHC.Driver.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Errors +import GHC.Driver.Messager import GHC.Driver.Errors.Types import GHC.Driver.CodeOutput import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig) @@ -162,7 +165,7 @@ import GHC.IfaceToCore ( typecheckIface, typecheckWholeCoreBindings ) -import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression ) +import GHC.Iface.Load ( ifaceStats, writeIface, flagsToIfCompression, getGhcPrimIface ) import GHC.Iface.Make import GHC.Iface.Recomp import GHC.Iface.Tidy @@ -187,7 +190,8 @@ import GHC.Core.LateCC.Types -import GHC.CoreToStg.Prep +import GHC.CoreToStg.Prep( CorePrepPgmConfig, corePrepPgm, corePrepExpr ) +import GHC.CoreToStg.AddImplicitBinds( addImplicitBinds ) import GHC.CoreToStg ( coreToStg ) import GHC.Parser.Errors.Types @@ -202,7 +206,6 @@ import GHC.Stg.Syntax import GHC.Stg.Pipeline ( stg2stg, StgCgInfos ) -import GHC.Builtin.Utils import GHC.Builtin.Names import qualified GHC.StgToCmm as StgToCmm ( codeGen ) @@ -219,7 +222,6 @@ import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder -import GHC.Unit.External import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface @@ -244,7 +246,7 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Name -import GHC.Types.Name.Cache ( initNameCache ) +import GHC.Types.Name.Cache ( newNameCache ) import GHC.Types.Name.Reader import GHC.Types.Name.Ppr import GHC.Types.TyThing @@ -295,12 +297,14 @@ import System.IO.Unsafe ( unsafeInterleaveIO ) import GHC.Iface.Env ( trace_if ) import GHC.Platform.Ways -import GHC.Stg.InferTags.TagSig (seqTagSig) +import GHC.Stg.EnforceEpt.TagSig (seqTagSig) import GHC.StgToCmm.Utils (IPEStats) import GHC.Types.Unique.FM import GHC.Types.Unique.DFM import GHC.Cmm.Config (CmmConfig) import Data.Bifunctor +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Home.PackageTable {- ********************************************************************** %* * @@ -309,25 +313,26 @@ %********************************************************************* -} newHscEnv :: FilePath -> DynFlags -> IO HscEnv -newHscEnv top_dir dflags = newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags) home_unit_graph +newHscEnv top_dir dflags = do + hpt <- emptyHomePackageTable + newHscEnvWithHUG top_dir dflags (homeUnitId_ dflags) (home_unit_graph hpt) where - home_unit_graph = unitEnv_singleton + home_unit_graph hpt = HUG.unitEnv_singleton (homeUnitId_ dflags) - (mkHomeUnitEnv dflags emptyHomePackageTable Nothing) + (HUG.mkHomeUnitEnv emptyUnitState Nothing dflags hpt Nothing) newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do - nc_var <- initNameCache 'r' knownKeyNames + nc_var <- newNameCache fc_var <- initFinderCache logger <- initLogger tmpfs <- initTmpFs - let dflags = homeUnitEnv_dflags $ unitEnv_lookup cur_unit home_unit_graph + let dflags = homeUnitEnv_dflags $ HUG.unitEnv_lookup cur_unit home_unit_graph unit_env <- initUnitEnv cur_unit home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags) llvm_config <- initLlvmConfigCache top_dir return HscEnv { hsc_dflags = top_dynflags , hsc_logger = setLogFlags logger (initLogFlags top_dynflags) , hsc_targets = [] - , hsc_mod_graph = emptyMG , hsc_IC = emptyInteractiveContext dflags , hsc_NC = nc_var , hsc_FC = fc_var @@ -809,7 +814,6 @@ -} -type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModuleGraphNode -> IO () -- | Do the recompilation avoidance checks for both one-shot and --make modes -- This function is the *only* place in the compiler where we decide whether to @@ -826,7 +830,7 @@ = do let msg what = case mHscMessage of - Just hscMessage -> hscMessage hsc_env mod_index what (ModuleNode [] mod_summary) + Just hscMessage -> hscMessage hsc_env mod_index what (ModuleNode [] (ModuleNodeCompile mod_summary)) Nothing -> return () -- First check to see if the interface file agrees with the @@ -841,7 +845,7 @@ case recomp_if_result of OutOfDateItem reason mb_checked_iface -> do msg $ NeedsRecompile reason - return $ HscRecompNeeded $ fmap (mi_iface_hash . mi_final_exts) mb_checked_iface + return $ HscRecompNeeded $ fmap mi_iface_hash mb_checked_iface UpToDateItem checked_iface -> do let lcl_dflags = ms_hspp_opts mod_summary if | not (backendGeneratesCode (backend lcl_dflags)) -> do @@ -859,7 +863,7 @@ , xopt LangExt.TemplateHaskell lcl_dflags -> do msg $ needsRecompileBecause THWithJS - return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface + return $ HscRecompNeeded $ Just $ mi_iface_hash $ checked_iface | otherwise -> do -- Do need linkable @@ -915,7 +919,7 @@ return $ HscUpToDate checked_iface $ linkable OutOfDateItem reason _ -> do msg $ NeedsRecompile reason - return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface + return $ HscRecompNeeded $ Just $ mi_iface_hash $ checked_iface -- | Check that the .o files produced by compilation are already up-to-date -- or not. @@ -965,10 +969,8 @@ let this_mod = ms_mod mod_sum if_date = fromJust $ ms_iface_date mod_sum - case mi_extra_decls iface of - Just extra_decls -> do - let fi = WholeCoreBindings extra_decls this_mod (ms_location mod_sum) - (mi_foreign iface) + case iface_core_bindings iface (ms_location mod_sum) of + Just fi -> do return (UpToDateItem (Linkable if_date this_mod (NE.singleton (CoreBindings fi)))) _ -> return $ outOfDateItemBecause MissingBytecode Nothing @@ -976,23 +978,21 @@ -- Compilers -------------------------------------------------------------- -add_iface_to_hpt :: ModIface -> ModDetails -> HscEnv -> HscEnv +add_iface_to_hpt :: ModIface -> ModDetails -> HscEnv -> IO () add_iface_to_hpt iface details = - hscUpdateHPT $ \ hpt -> - addToHpt hpt (moduleName (mi_module iface)) - (HomeModInfo iface details emptyHomeModInfoLinkable) + hscInsertHPT (HomeModInfo iface details emptyHomeModInfoLinkable) -- Knot tying! See Note [Knot-tying typecheckIface] -- See Note [ModDetails and --make mode] initModDetails :: HscEnv -> ModIface -> IO ModDetails initModDetails hsc_env iface = fixIO $ \details' -> do - let !hsc_env' = add_iface_to_hpt iface details' hsc_env + add_iface_to_hpt iface details' hsc_env -- NB: This result is actually not that useful -- in one-shot mode, since we're not going to do -- any further typechecking. It's much more useful -- in make mode, since this HMI will go into the HPT. - genModDetails hsc_env' iface + genModDetails hsc_env iface -- | Modify flags such that objects are compiled for the interpreter's way. -- This is necessary when building foreign objects for Template Haskell, since @@ -1018,15 +1018,15 @@ -- | Assemble 'WholeCoreBindings' if the interface contains Core bindings. iface_core_bindings :: ModIface -> ModLocation -> Maybe WholeCoreBindings iface_core_bindings iface wcb_mod_location = - mi_extra_decls <&> \ wcb_bindings -> + mi_simplified_core <&> \(IfaceSimplifiedCore bindings foreign') -> WholeCoreBindings { - wcb_bindings, + wcb_bindings = bindings, wcb_module = mi_module, wcb_mod_location, - wcb_foreign = mi_foreign + wcb_foreign = foreign' } where - ModIface {mi_module, mi_extra_decls, mi_foreign} = iface + ModIface {mi_module, mi_simplified_core} = iface -- | Return an 'IO' that hydrates Core bindings and compiles them to bytecode if -- the interface contains any, using the supplied type env for typechecking. @@ -1058,6 +1058,27 @@ time <- maybe getCurrentTime pure if_time return $! Linkable time (mi_module iface) parts +loadIfaceByteCodeLazy :: + HscEnv -> + ModIface -> + ModLocation -> + TypeEnv -> + IO (Maybe Linkable) +loadIfaceByteCodeLazy hsc_env iface location type_env = + case iface_core_bindings iface location of + Nothing -> return Nothing + Just wcb -> do + Just <$> compile wcb + where + compile decls = do + ~(bcos, fos) <- unsafeInterleaveIO $ compileWholeCoreBindings hsc_env type_env decls + linkable $ NE.singleton (LazyBCOs bcos fos) + + linkable parts = do + if_time <- modificationTimeIfExists (ml_hi_file location) + time <- maybe getCurrentTime pure if_time + return $!Linkable time (mi_module iface) parts + -- | If the 'Linkable' contains Core bindings loaded from an interface, replace -- them with a lazy IO thunk that compiles them to bytecode and foreign objects, -- using the supplied environment for type checking. @@ -1074,23 +1095,29 @@ -- -- This is sound because generateByteCode just depends on things already loaded -- in the interface file. + +-- TODO: We should just use loadIfaceByteCodeLazy instead of the two stage process with +-- loadByteCode and initWholeCoreBindings. The main reason it is like this is because +-- initWholeCoreBindings requires a ModDetails, which we don't have during recompilation +-- checking. We should modify recompilation checking to return a HomeModInfo directly. + initWholeCoreBindings :: HscEnv -> ModIface -> ModDetails -> Linkable -> IO Linkable -initWholeCoreBindings hsc_env iface details (Linkable utc_time this_mod uls) = - Linkable utc_time this_mod <$> mapM go uls +initWholeCoreBindings hsc_env iface details (Linkable utc_time this_mod uls) = do + Linkable utc_time this_mod <$> mapM (go hsc_env) uls where - go = \case + go hsc_env' = \case CoreBindings wcb -> do + add_iface_to_hpt iface details hsc_env ~(bco, fos) <- unsafeInterleaveIO $ compileWholeCoreBindings hsc_env' type_env wcb pure (LazyBCOs bco fos) l -> pure l - hsc_env' = add_iface_to_hpt iface details hsc_env type_env = md_types details -- | Hydrate interface Core bindings and compile them to bytecode. @@ -1214,12 +1241,17 @@ -- -- We usually desugar even when we are not generating code, otherwise we -- would miss errors thrown by the desugaring (see #10600). The only - -- exceptions are when the Module is Ghc.Prim or when it is not a - -- HsSrcFile Module. - mb_desugar <- - if ms_mod summary /= gHC_PRIM && hsc_src == HsSrcFile - then Just <$> hscDesugar' (ms_location summary) tc_result - else pure Nothing + -- exception is when it is not a HsSrcFile module. + mb_desugar <- if + | hsc_src /= HsSrcFile -> pure Nothing + -- Desugar an empty ghc-prim:GHC.Prim module by filtering out all its + -- bindings: the reason is that some of them are invalid (such as top-level + -- unlifted ones like void# or proxy#) and cause HsToCore failures. + -- + -- We still need to desugar *something* because the driver and the linkers + -- expect a valid object file (.o) to be generated for this module. + | ms_mod summary == gHC_PRIM -> Just <$> hscDesugar' (ms_location summary) (tc_result { tcg_binds = [] }) + | otherwise -> Just <$> hscDesugar' (ms_location summary) tc_result -- Report the warnings from both typechecking and desugar together w <- getDiagnostics @@ -1237,11 +1269,11 @@ (cg_guts, details) <- liftIO $ hscTidy hsc_env simplified_guts - let !partial_iface = + !partial_iface <- liftIO $ {-# SCC "GHC.Driver.Main.mkPartialIface" #-} -- This `force` saves 2M residency in test T10370 -- See Note [Avoiding space leaks in toIface*] for details. - force (mkPartialIface hsc_env (cg_binds cg_guts) details summary (tcg_import_decls tc_result) simplified_guts) + fmap force (mkPartialIface hsc_env (cg_binds cg_guts) details summary (tcg_import_decls tc_result) simplified_guts) return HscRecomp { hscs_guts = cg_guts, hscs_mod_location = ms_location summary, @@ -1264,7 +1296,11 @@ liftIO $ hscMaybeWriteIface logger dflags True iface mb_old_hash (ms_location summary) - return $ HscUpdate iface + -- when compiling gHC_PRIM without generating code (e.g. with + -- Haddock), we still want the virtual interface in the cache + if ms_mod summary == gHC_PRIM + then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env)) + else return $ HscUpdate iface -- We are not generating code or writing an interface with simplified core so we can skip simplification @@ -1275,7 +1311,11 @@ liftIO $ hscMaybeWriteIface logger dflags True iface mb_old_hash (ms_location summary) - return $ HscUpdate iface + -- when compiling gHC_PRIM without generating code (e.g. with + -- Haddock), we still want the virtual interface in the cache + if ms_mod summary == gHC_PRIM + then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env)) + else return $ HscUpdate iface {- Note [Writing interface files] @@ -1362,7 +1402,7 @@ -- dynamic interfaces. Hopefully both the dynamic and the non-dynamic -- interfaces stay in sync... -- - let change = old_iface /= Just (mi_iface_hash (mi_final_exts iface)) + let change = old_iface /= Just (mi_iface_hash iface) let dt = dynamicTooState dflags @@ -1435,46 +1475,7 @@ dumpIfaceStats hsc_env return new_details --------------------------------------------------------------- --- Progress displayers. --------------------------------------------------------------- -oneShotMsg :: Logger -> RecompileRequired -> IO () -oneShotMsg logger recomp = - case recomp of - UpToDate -> compilationProgressMsg logger $ text "compilation IS NOT required" - NeedsRecompile _ -> return () - -batchMsg :: Messager -batchMsg = batchMsgWith (\_ _ _ _ -> empty) -batchMultiMsg :: Messager -batchMultiMsg = batchMsgWith (\_ _ _ node -> brackets (ppr (moduleGraphNodeUnitId node))) - -batchMsgWith :: (HscEnv -> (Int, Int) -> RecompileRequired -> ModuleGraphNode -> SDoc) -> Messager -batchMsgWith extra hsc_env_start mod_index recomp node = - case recomp of - UpToDate - | logVerbAtLeast logger 2 -> showMsg (text "Skipping") empty - | otherwise -> return () - NeedsRecompile reason0 -> showMsg (text herald) $ case reason0 of - MustCompile -> empty - (RecompBecause reason) -> text " [" <> pprWithUnitState state (ppr reason) <> text "]" - where - herald = case node of - LinkNode {} -> "Linking" - InstantiationNode {} -> "Instantiating" - ModuleNode {} -> "Compiling" - hsc_env = hscSetActiveUnitId (moduleGraphNodeUnitId node) hsc_env_start - dflags = hsc_dflags hsc_env - logger = hsc_logger hsc_env - state = hsc_units hsc_env - showMsg msg reason = - compilationProgressMsg logger $ - (showModuleIndex mod_index <> - msg <+> showModMsg dflags (recompileRequired recomp) node) - <> extra hsc_env mod_index recomp node - <> reason - -------------------------------------------------------------- -- Safe Haskell -------------------------------------------------------------- @@ -1761,10 +1762,7 @@ lookup' :: Module -> Hsc (Maybe ModIface) lookup' m = do hsc_env <- getHscEnv - hsc_eps <- liftIO $ hscEPS hsc_env - let pkgIfaceT = eps_PIT hsc_eps - hug = hsc_HUG hsc_env - iface = lookupIfaceByModule hug pkgIfaceT m + iface <- liftIO $ lookupIfaceByModuleHsc hsc_env m -- the 'lookupIfaceByModule' method will always fail when calling from GHCi -- as the compiler hasn't filled in the various module tables -- so we need to call 'getModuleInterface' to load from disk @@ -1919,7 +1917,7 @@ hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], Maybe StgCgInfos, Maybe CmmCgInfos ) -- ^ @Just f@ <=> _stub.c is f -hscGenHardCode hsc_env cgguts location output_filename = do +hscGenHardCode hsc_env cgguts mod_loc output_filename = do let CgGuts{ cg_module = this_mod, cg_binds = core_binds, cg_ccs = local_ccs @@ -1927,14 +1925,21 @@ dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env + ------------------- + -- ADD IMPLICIT BINDINGS + -- NB: we must feed mkImplicitBinds through corePrep too + -- so that they are suitably cloned and eta-expanded + let cp_pgm_cfg :: CorePrepPgmConfig + cp_pgm_cfg = initCorePrepPgmConfig (hsc_dflags hsc_env) + (interactiveInScope $ hsc_IC hsc_env) + binds_with_implicits <- addImplicitBinds cp_pgm_cfg mod_loc (cg_tycons cgguts) core_binds ------------------- - -- Insert late cost centres based on the provided flags. + -- INSERT LATE COST CENTRES, based on the provided flags. -- -- If -fprof-late-inline is enabled, we will skip adding CCs on any - -- top-level bindings here (via shortcut in `addLateCostCenters`), - -- since it will have already added a superset of the CCs we would add - -- here. + -- top-level bindings here (via shortcut in `addLateCostCenters`), since + -- it will have already added a superset of the CCs we would add here. let late_cc_config :: LateCCConfig late_cc_config = @@ -1953,21 +1958,21 @@ , lateCCConfig_env = LateCCEnv { lateCCEnv_module = this_mod - , lateCCEnv_file = fsLit <$> ml_hs_file location + , lateCCEnv_file = fsLit <$> ml_hs_file mod_loc , lateCCEnv_countEntries= gopt Opt_ProfCountEntries dflags , lateCCEnv_collectCCs = True } } (late_cc_binds, late_cc_state) <- - addLateCostCenters logger late_cc_config core_binds + addLateCostCenters logger late_cc_config binds_with_implicits when (dopt Opt_D_dump_late_cc dflags || dopt Opt_D_verbose_core2core dflags) $ putDumpFileMaybe logger Opt_D_dump_late_cc "LateCC" FormatCore (vcat (map ppr late_cc_binds)) ------------------- - -- Run late plugins - -- This is the last use of the ModGuts in a compilation. + -- RUN LATE PLUGINS + -- This is the last use of the CgGuts in a compilation. -- From now on, we just use the bits we need. ( CgGuts { cg_tycons = tycons, @@ -1975,7 +1980,7 @@ cg_foreign_files = foreign_files, cg_dep_pkgs = dependencies, cg_spt_entries = spt_entries, - cg_binds = late_binds, + cg_binds = binds_to_prep, cg_ccs = late_local_ccs } , _ @@ -1999,22 +2004,15 @@ tmpfs = hsc_tmpfs hsc_env llvm_config = hsc_llvm_config hsc_env profile = targetProfile dflags - data_tycons = filter isDataTyCon tycons - -- cg_tycons includes newtypes, for the benefit of External Core, - -- but we don't generate any code for newtypes - - ------------------- -- PREPARE FOR CODE GENERATION -- Do saturation and convert to A-normal form - (prepd_binds) <- {-# SCC "CorePrep" #-} do - cp_cfg <- initCorePrepConfig hsc_env - corePrepPgm - (hsc_logger hsc_env) - cp_cfg - (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) - this_mod location late_binds data_tycons + cp_cfg <- initCorePrepConfig hsc_env + (prepd_binds) <- {-# SCC "CorePrep" #-} + corePrepPgm + (hsc_logger hsc_env) cp_cfg cp_pgm_cfg + this_mod binds_to_prep ----------------- Convert to STG ------------------ (stg_binds_with_deps, denv, (caf_ccs, caf_cc_stacks), stg_cg_infos) @@ -2027,7 +2025,7 @@ c `seqList` d `seqList` (seqEltsUFM (seqTagSig) tag_env)) - (myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) False this_mod location prepd_binds) + (myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) False this_mod mod_loc prepd_binds) let (stg_binds,_stg_deps) = unzip stg_binds_with_deps @@ -2075,7 +2073,7 @@ _ -> do cmms <- {-# SCC "StgToCmm" #-} - doCodeGen hsc_env this_mod denv data_tycons + doCodeGen hsc_env this_mod denv tycons cost_centre_info stg_binds @@ -2096,7 +2094,7 @@ (output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos) <- {-# SCC "codeOutput" #-} - codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location + codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename mod_loc foreign_stubs foreign_files dependencies (initDUniqSupply 'n' 0) rawcmms1 return ( output_filename, stub_c_exists, foreign_fps , Just stg_cg_infos, Just cmm_cg_infos) @@ -2120,7 +2118,7 @@ -> CgInteractiveGuts -> ModLocation -> IO (Maybe FilePath, CompiledByteCode) -- ^ .c stub path (if any) and ByteCode -hscInteractive hsc_env cgguts location = do +hscInteractive hsc_env cgguts mod_loc = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env let tmpfs = hsc_tmpfs hsc_env @@ -2133,35 +2131,35 @@ cgi_modBreaks = mod_breaks, cgi_spt_entries = spt_entries } = cgguts - data_tycons = filter isDataTyCon tycons - -- cg_tycons includes newtypes, for the benefit of External Core, - -- but we don't generate any code for newtypes + ------------------- + -- ADD IMPLICIT BINDINGS + let cp_pgm_cfg :: CorePrepPgmConfig + cp_pgm_cfg = initCorePrepPgmConfig (hsc_dflags hsc_env) + (interactiveInScope $ hsc_IC hsc_env) + binds_to_prep <- addImplicitBinds cp_pgm_cfg mod_loc tycons core_binds ------------------- -- PREPARE FOR CODE GENERATION -- Do saturation and convert to A-normal form - prepd_binds <- {-# SCC "CorePrep" #-} do - cp_cfg <- initCorePrepConfig hsc_env - corePrepPgm - (hsc_logger hsc_env) - cp_cfg - (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env)) - this_mod location core_binds data_tycons + cp_cfg <- initCorePrepConfig hsc_env + prepd_binds <- {-# SCC "CorePrep" #-} + corePrepPgm (hsc_logger hsc_env) cp_cfg cp_pgm_cfg + this_mod binds_to_prep -- The stg cg info only provides a runtime benfit, but is not requires so we just -- omit it here (stg_binds_with_deps, _infotable_prov, _caf_ccs__caf_cc_stacks, _ignore_stg_cg_infos) <- {-# SCC "CoreToStg" #-} - myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) True this_mod location prepd_binds + myCoreToStg logger dflags (interactiveInScope (hsc_IC hsc_env)) True this_mod mod_loc prepd_binds let (stg_binds,_stg_deps) = unzip stg_binds_with_deps ----------------- Generate byte code ------------------ - comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks spt_entries + comp_bc <- byteCodeGen hsc_env this_mod stg_binds tycons mod_breaks spt_entries ------------------ Create f-x-dynamic C-side stuff ----- (_istub_h_exists, istub_c_exists) - <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) this_mod location foreign_stubs + <- outputForeignStubs logger tmpfs dflags (hsc_units hsc_env) this_mod mod_loc foreign_stubs return (istub_c_exists, comp_bc) -- | Compile Core bindings and foreign inputs that were loaded from an @@ -2288,7 +2286,7 @@ -- Note we produce a 'Stream' of CmmGroups, so that the -- backend can be run incrementally. Otherwise it generates all -- the C-- up front, which has a significant space cost. -doCodeGen hsc_env this_mod denv data_tycons +doCodeGen hsc_env this_mod denv tycons cost_centre_info stg_binds_w_fvs = do let dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env @@ -2307,7 +2305,7 @@ let cmm_stream :: CgStream CmmGroup (ModuleLFInfos, DetUniqFM) -- See Note [Forcing of stg_binds] cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-} - stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs + stg_to_cmm dflags this_mod denv tycons cost_centre_info stg_binds_w_fvs -- codegen consumes a stream of CmmGroup, and produces a new -- stream of CmmGroup (not necessarily synchronised: one @@ -2458,12 +2456,6 @@ return $ Just (ids, hval, fix_env) --- | Compile a decls -hscDecls :: HscEnv - -> String -- ^ The statement - -> IO ([TyThing], InteractiveContext) -hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "" 1 - hscParseModuleWithLocation :: HscEnv -> String -> Int -> String -> IO (HsModule GhcPs) hscParseModuleWithLocation hsc_env source line_num str = do L _ mod <- @@ -2476,18 +2468,6 @@ HsModule { hsmodDecls = decls } <- hscParseModuleWithLocation hsc_env source line_num str return decls --- | Compile a decls -hscDeclsWithLocation :: HscEnv - -> String -- ^ The statement - -> String -- ^ The source - -> Int -- ^ Starting line - -> IO ([TyThing], InteractiveContext) -hscDeclsWithLocation hsc_env str source linenumber = do - L _ (HsModule{ hsmodDecls = decls }) <- - runInteractiveHsc hsc_env $ - hscParseThingWithLocation source linenumber parseModule str - hscParsedDecls hsc_env decls - hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext) hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do hsc_env <- getHscEnv @@ -2819,8 +2799,7 @@ (fv_hvs, mods_needed, units_needed) <- loadDecls interp hsc_env srcspan $ Linkable bco_time this_mod $ NE.singleton $ BCOs bcos {- Get the HValue for the root -} - return (expectJust "hscCompileCoreExpr'" - $ lookup (idName binding_id) fv_hvs, mods_needed, units_needed) + return (expectJust $ lookup (idName binding_id) fv_hvs, mods_needed, units_needed) @@ -2904,7 +2883,7 @@ jsLinkObject logger tmpfs tmp_dir js_config unit_env inst out_obj roots -- look up "id_sym" closure and create a StablePtr (HValue) from it - href <- lookupClosure interp (unpackFS id_sym) >>= \case + href <- lookupClosure interp (IFaststringSymbol id_sym) >>= \case Nothing -> pprPanic "Couldn't find just linked TH closure" (ppr id_sym) Just r -> pure r @@ -2931,18 +2910,6 @@ logDumpMsg logger "Interface statistics" (ifaceStats eps) -{- ********************************************************************** -%* * - Progress Messages: Module i of n -%* * -%********************************************************************* -} - -showModuleIndex :: (Int, Int) -> SDoc -showModuleIndex (i,n) = text "[" <> pad <> int i <> text " of " <> int n <> text "] " - where - -- compute the length of x > 0 in base 10 - len x = ceiling (logBase 10 (fromIntegral x+1) :: Float) - pad = text (replicate (len n - len i) ' ') -- TODO: use GHC.Utils.Ppr.RStr writeInterfaceOnlyMode :: DynFlags -> Bool writeInterfaceOnlyMode dflags = diff --git a/GHC/Driver/Make.hs b/GHC/Driver/Make.hs --- a/GHC/Driver/Make.hs +++ b/GHC/Driver/Make.hs @@ -1,3042 +1,1935 @@ {-# LANGUAGE NondecreasingIndentation #-} - -{-# LANGUAGE GADTs #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} - --- ----------------------------------------------------------------------------- --- --- (c) The University of Glasgow, 2011 --- --- This module implements multi-module compilation, and is used --- by --make and GHCi. --- --- ----------------------------------------------------------------------------- -module GHC.Driver.Make ( - depanal, depanalE, depanalPartial, checkHomeUnitsClosed, - load, loadWithCache, load', AnyGhcDiagnostic, LoadHowMuch(..), ModIfaceCache(..), noIfaceCache, newIfaceCache, - instantiationNodes, - - downsweep, - - topSortModuleGraph, - - ms_home_srcimps, ms_home_imps, - - summariseModule, - SummariseResult(..), - summariseFile, - hscSourceToIsBoot, - findExtraSigImports, - implicitRequirementsShallow, - - noModError, cyclicModuleErr, - SummaryNode, - IsBootInterface(..), mkNodeKey, - - ModNodeKey, ModNodeKeyWithUid(..), - ModNodeMap(..), emptyModNodeMap, modNodeMapElems, modNodeMapLookup, modNodeMapInsert, modNodeMapSingleton, modNodeMapUnionWith - ) where - -import GHC.Prelude -import GHC.Platform - -import GHC.Tc.Utils.Backpack -import GHC.Tc.Utils.Monad ( initIfaceCheck, concatMapM ) - -import GHC.Runtime.Interpreter -import qualified GHC.Linker.Loader as Linker -import GHC.Linker.Types - -import GHC.Platform.Ways - -import GHC.Driver.Config.Finder (initFinderOpts) -import GHC.Driver.Config.Parser (initParserOpts) -import GHC.Driver.Config.Diagnostic -import GHC.Driver.Phases -import GHC.Driver.Pipeline -import GHC.Driver.Session -import GHC.Driver.DynFlags (ReexportedModule(..)) -import GHC.Driver.Backend -import GHC.Driver.Monad -import GHC.Driver.Env -import GHC.Driver.Errors -import GHC.Driver.Errors.Types -import GHC.Driver.Main -import GHC.Driver.MakeSem - -import GHC.Parser.Header -import GHC.ByteCode.Types - -import GHC.Iface.Load ( cannotFindModule ) -import GHC.IfaceToCore ( typecheckIface ) -import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) - -import GHC.Data.Bag ( listToBag ) -import GHC.Data.Graph.Directed -import GHC.Data.FastString -import GHC.Data.Maybe ( expectJust ) -import GHC.Data.OsPath ( unsafeEncodeUtf ) -import GHC.Data.StringBuffer -import qualified GHC.LanguageExtensions as LangExt - -import GHC.Utils.Exception ( throwIO, SomeAsyncException ) -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Utils.Misc -import GHC.Utils.Error -import GHC.Utils.Logger -import GHC.Utils.Fingerprint -import GHC.Utils.TmpFs - -import GHC.Types.Basic -import GHC.Types.Error -import GHC.Types.Target -import GHC.Types.SourceFile -import GHC.Types.SourceError -import GHC.Types.SrcLoc -import GHC.Types.Unique.Map -import GHC.Types.PkgQual - -import GHC.Unit -import GHC.Unit.Env -import GHC.Unit.Finder -import GHC.Unit.Module.ModSummary -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.Graph -import GHC.Unit.Home.ModInfo -import GHC.Unit.Module.ModDetails - -import Data.Either ( rights, partitionEithers, lefts ) -import qualified Data.Map as Map -import qualified Data.Set as Set - -import Control.Concurrent ( newQSem, waitQSem, signalQSem, ThreadId, killThread, forkIOWithUnmask ) -import qualified GHC.Conc as CC -import Control.Concurrent.MVar -import Control.Monad -import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE ) -import qualified Control.Monad.Catch as MC -import Data.IORef -import Data.Maybe -import Data.Time -import Data.List (sortOn) -import Data.Bifunctor (first) -import System.Directory -import System.FilePath -import System.IO ( fixIO ) - -import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities ) -import Control.Monad.IO.Class -import Control.Monad.Trans.Reader -import GHC.Driver.Pipeline.LogQueue -import qualified Data.Map.Strict as M -import GHC.Types.TypeEnv -import Control.Monad.Trans.State.Lazy -import Control.Monad.Trans.Class -import GHC.Driver.Env.KnotVars -import Control.Concurrent.STM -import Control.Monad.Trans.Maybe -import GHC.Runtime.Loader -import GHC.Rename.Names -import GHC.Utils.Constants -import GHC.Types.Unique.DFM (udfmRestrictKeysSet) -import GHC.Types.Unique -import GHC.Iface.Errors.Types - -import qualified GHC.Data.Word64Set as W - --- ----------------------------------------------------------------------------- --- Loading the program - --- | Perform a dependency analysis starting from the current targets --- and update the session with the new module graph. --- --- Dependency analysis entails parsing the @import@ directives and may --- therefore require running certain preprocessors. --- --- Note that each 'ModSummary' in the module graph caches its 'DynFlags'. --- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the --- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want --- changes to the 'DynFlags' to take effect you need to call this function --- again. --- In case of errors, just throw them. --- -depanal :: GhcMonad m => - [ModuleName] -- ^ excluded modules - -> Bool -- ^ allow duplicate roots - -> m ModuleGraph -depanal excluded_mods allow_dup_roots = do - (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots - if isEmptyMessages errs - then pure mod_graph - else throwErrors (fmap GhcDriverMessage errs) - --- | Perform dependency analysis like in 'depanal'. --- In case of errors, the errors and an empty module graph are returned. -depanalE :: GhcMonad m => -- New for #17459 - [ModuleName] -- ^ excluded modules - -> Bool -- ^ allow duplicate roots - -> m (DriverMessages, ModuleGraph) -depanalE excluded_mods allow_dup_roots = do - hsc_env <- getSession - (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots - if isEmptyMessages errs - then do - hsc_env <- getSession - let one_unit_messages get_mod_errs k hue = do - errs <- get_mod_errs - unknown_module_err <- warnUnknownModules (hscSetActiveUnitId k hsc_env) (homeUnitEnv_dflags hue) mod_graph - - let unused_home_mod_err = warnMissingHomeModules (homeUnitEnv_dflags hue) (hsc_targets hsc_env) mod_graph - unused_pkg_err = warnUnusedPackages (homeUnitEnv_units hue) (homeUnitEnv_dflags hue) mod_graph - - - return $ errs `unionMessages` unused_home_mod_err - `unionMessages` unused_pkg_err - `unionMessages` unknown_module_err - - all_errs <- liftIO $ unitEnv_foldWithKey one_unit_messages (return emptyMessages) (hsc_HUG hsc_env) - logDiagnostics (GhcDriverMessage <$> all_errs) - setSession hsc_env { hsc_mod_graph = mod_graph } - pure (emptyMessages, mod_graph) - else do - -- We don't have a complete module dependency graph, - -- The graph may be disconnected and is unusable. - setSession hsc_env { hsc_mod_graph = emptyMG } - pure (errs, emptyMG) - - --- | Perform dependency analysis like 'depanal' but return a partial module --- graph even in the face of problems with some modules. --- --- Modules which have parse errors in the module header, failing --- preprocessors or other issues preventing them from being summarised will --- simply be absent from the returned module graph. --- --- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the --- new module graph. -depanalPartial - :: GhcMonad m - => [ModuleName] -- ^ excluded modules - -> Bool -- ^ allow duplicate roots - -> m (DriverMessages, ModuleGraph) - -- ^ possibly empty 'Bag' of errors and a module graph. -depanalPartial excluded_mods allow_dup_roots = do - hsc_env <- getSession - let - targets = hsc_targets hsc_env - old_graph = hsc_mod_graph hsc_env - logger = hsc_logger hsc_env - - withTiming logger (text "Chasing dependencies") (const ()) $ do - liftIO $ debugTraceMsg logger 2 (hcat [ - text "Chasing modules from: ", - hcat (punctuate comma (map pprTarget targets))]) - - -- Home package modules may have been moved or deleted, and new - -- source files may have appeared in the home package that shadow - -- external package modules, so we have to discard the existing - -- cached finder data. - liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env) - - (errs, graph_nodes) <- liftIO $ downsweep - hsc_env (mgModSummaries old_graph) - excluded_mods allow_dup_roots - let - mod_graph = mkModuleGraph graph_nodes - return (unionManyMessages errs, mod_graph) - --- | Collect the instantiations of dependencies to create 'InstantiationNode' work graph nodes. --- These are used to represent the type checking that is done after --- all the free holes (sigs in current package) relevant to that instantiation --- are compiled. This is necessary to catch some instantiation errors. --- --- In the future, perhaps more of the work of instantiation could be moved here, --- instead of shoved in with the module compilation nodes. That could simplify --- backpack, and maybe hs-boot too. -instantiationNodes :: UnitId -> UnitState -> [ModuleGraphNode] -instantiationNodes uid unit_state = InstantiationNode uid <$> iuids_to_check - where - iuids_to_check :: [InstantiatedUnit] - iuids_to_check = - nubSort $ concatMap (goUnitId . fst) (explicitUnits unit_state) - where - goUnitId uid = - [ recur - | VirtUnit indef <- [uid] - , inst <- instUnitInsts indef - , recur <- (indef :) $ goUnitId $ moduleUnit $ snd inst - ] - --- The linking plan for each module. If we need to do linking for a home unit --- then this function returns a graph node which depends on all the modules in the home unit. - --- At the moment nothing can depend on these LinkNodes. -linkNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> Maybe (Either (Messages DriverMessage) ModuleGraphNode) -linkNodes summaries uid hue = - let dflags = homeUnitEnv_dflags hue - ofile = outputFile_ dflags - - unit_nodes :: [NodeKey] - unit_nodes = map mkNodeKey (filter ((== uid) . moduleGraphNodeUnitId) summaries) - -- Issue a warning for the confusing case where the user - -- said '-o foo' but we're not going to do any linking. - -- We attempt linking if either (a) one of the modules is - -- called Main, or (b) the user said -no-hs-main, indicating - -- that main() is going to come from somewhere else. - -- - no_hs_main = gopt Opt_NoHsMain dflags - - main_sum = any (== NodeKey_Module (ModNodeKeyWithUid (GWIB (mainModuleNameIs dflags) NotBoot) uid)) unit_nodes - - do_linking = main_sum || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib - - in if | ghcLink dflags == LinkBinary && isJust ofile && not do_linking -> - Just (Left $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverRedirectedNoMain $ mainModuleNameIs dflags)) - -- This should be an error, not a warning (#10895). - | ghcLink dflags /= NoLink, do_linking -> Just (Right (LinkNode unit_nodes uid)) - | otherwise -> Nothing - --- Note [Missing home modules] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Sometimes we don't want GHC to process modules that weren't specified as --- explicit targets. For example, cabal may want to enable this warning --- when building a library, so that GHC warns the user about modules listed --- neither in `exposed-modules` nor in `other-modules`. --- --- Here "home module" means a module that doesn't come from another package. --- --- For example, if GHC is invoked with modules "A" and "B" as targets, --- but "A" imports some other module "C", then GHC will issue a warning --- about module "C" not being listed in the command line. --- --- The warning in enabled by `-Wmissing-home-modules`. See #13129 -warnMissingHomeModules :: DynFlags -> [Target] -> ModuleGraph -> DriverMessages -warnMissingHomeModules dflags targets mod_graph = - if null missing - then emptyMessages - else warn - where - diag_opts = initDiagOpts dflags - - -- We need to be careful to handle the case where (possibly - -- path-qualified) filenames (aka 'TargetFile') rather than module - -- names are being passed on the GHC command-line. - -- - -- For instance, `ghc --make src-exe/Main.hs` and - -- `ghc --make -isrc-exe Main` are supposed to be equivalent. - -- Note also that we can't always infer the associated module name - -- directly from the filename argument. See #13727. - is_known_module mod = - is_module_target mod - || - maybe False is_file_target (ml_hs_file (ms_location mod)) - - is_module_target mod = (moduleName (ms_mod mod), ms_unitid mod) `Set.member` mod_targets - - is_file_target file = Set.member (withoutExt file) file_targets - - file_targets = Set.fromList (mapMaybe file_target targets) - - file_target Target {targetId} = - case targetId of - TargetModule _ -> Nothing - TargetFile file _ -> - Just (withoutExt (augmentByWorkingDirectory dflags file)) - - mod_targets = Set.fromList (mod_target <$> targets) - - mod_target Target {targetUnitId, targetId} = - case targetId of - TargetModule name -> (name, targetUnitId) - TargetFile file _ -> (mkModuleName (withoutExt file), targetUnitId) - - withoutExt = fst . splitExtension - - missing = map (moduleName . ms_mod) $ - filter (not . is_known_module) $ - (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) - (mgModSummaries mod_graph)) - - warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan - $ DriverMissingHomeModules (homeUnitId_ dflags) missing (checkBuildingCabalPackage dflags) - --- Check that any modules we want to reexport or hide are actually in the package. -warnUnknownModules :: HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages -warnUnknownModules hsc_env dflags mod_graph = do - reexported_warns <- filterM check_reexport reexported_mods - return $ final_msgs hidden_warns reexported_warns - where - diag_opts = initDiagOpts dflags - - unit_mods = Set.fromList (map ms_mod_name - (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) - (mgModSummaries mod_graph))) - - reexported_mods = reexportedModules dflags - hidden_mods = hiddenModules dflags - - hidden_warns = hidden_mods `Set.difference` unit_mods - - lookupModule mn = findImportedModule hsc_env mn NoPkgQual - - check_reexport mn = do - fr <- lookupModule (reexportFrom mn) - case fr of - Found _ m -> return (moduleUnitId m == homeUnitId_ dflags) - _ -> return True - - - warn diagnostic = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan - $ diagnostic - - final_msgs hidden_warns reexported_warns - = - unionManyMessages $ - [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)] - ++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)] - --- | Describes which modules of the module graph need to be loaded. -data LoadHowMuch - = LoadAllTargets - -- ^ Load all targets and its dependencies. - | LoadUpTo HomeUnitModule - -- ^ Load only the given module and its dependencies. - | LoadDependenciesOf HomeUnitModule - -- ^ Load only the dependencies of the given module, but not the module - -- itself. - -{- -Note [Caching HomeModInfo] -~~~~~~~~~~~~~~~~~~~~~~~~~~ - -API clients who call `load` like to cache the HomeModInfo in memory between -calls to this function. In the old days, this cache was a simple MVar which stored -a HomePackageTable. This was insufficient, as the interface files for boot modules -were not recorded in the cache. In the less old days, the cache was returned at the -end of load, and supplied at the start of load, however, this was not sufficient -because it didn't account for the possibility of exceptions such as SIGINT (#20780). - -So now, in the current day, we have this ModIfaceCache abstraction which -can incrementally be updated during the process of upsweep. This allows us -to store interface files for boot modules in an exception-safe way. - -When the final version of an interface file is completed then it is placed into -the cache. The contents of the cache is retrieved, and the cache cleared, by iface_clearCache. - -Note that because we only store the ModIface and Linkable in the ModIfaceCache, -hydration and rehydration is totally irrelevant, and we just store the CachedIface as -soon as it is completed. - --} - - --- Abstract interface to a cache of HomeModInfo --- See Note [Caching HomeModInfo] -data ModIfaceCache = ModIfaceCache { iface_clearCache :: IO [CachedIface] - , iface_addToCache :: CachedIface -> IO () } - -addHmiToCache :: ModIfaceCache -> HomeModInfo -> IO () -addHmiToCache c (HomeModInfo i _ l) = iface_addToCache c (CachedIface i l) - -data CachedIface = CachedIface { cached_modiface :: !ModIface - , cached_linkable :: !HomeModLinkable } - -instance Outputable CachedIface where - ppr (CachedIface mi ln) = hsep [text "CachedIface", ppr (miKey mi), ppr ln] - -noIfaceCache :: Maybe ModIfaceCache -noIfaceCache = Nothing - -newIfaceCache :: IO ModIfaceCache -newIfaceCache = do - ioref <- newIORef [] - return $ - ModIfaceCache - { iface_clearCache = atomicModifyIORef' ioref (\c -> ([], c)) - , iface_addToCache = \hmi -> atomicModifyIORef' ioref (\c -> (hmi:c, ())) - } - - - - --- | Try to load the program. See 'LoadHowMuch' for the different modes. --- --- This function implements the core of GHC's @--make@ mode. It preprocesses, --- compiles and loads the specified modules, avoiding re-compilation wherever --- possible. Depending on the backend (see 'DynFlags.backend' field) compiling --- and loading may result in files being created on disk. --- --- Calls the 'defaultWarnErrLogger' after each compiling each module, whether --- successful or not. --- --- If errors are encountered during dependency analysis, the module `depanalE` --- returns together with the errors an empty ModuleGraph. --- After processing this empty ModuleGraph, the errors of depanalE are thrown. --- All other errors are reported using the 'defaultWarnErrLogger'. - -load :: GhcMonad f => LoadHowMuch -> f SuccessFlag -load how_much = loadWithCache noIfaceCache mkUnknownDiagnostic how_much - -mkBatchMsg :: HscEnv -> Messager -mkBatchMsg hsc_env = - if length (hsc_all_home_unit_ids hsc_env) > 1 - -- This also displays what unit each module is from. - then batchMultiMsg - else batchMsg - -type AnyGhcDiagnostic = UnknownDiagnostic (DiagnosticOpts GhcMessage) - -loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how to cache interfaces as we create them. - -> (GhcMessage -> AnyGhcDiagnostic) -- ^ How to wrap error messages before they are displayed to a user. - -- If you are using the GHC API you can use this to override how messages - -- created during 'loadWithCache' are displayed to the user. - -> LoadHowMuch -- ^ How much `loadWithCache` should load - -> m SuccessFlag -loadWithCache cache diag_wrapper how_much = do - (errs, mod_graph) <- depanalE [] False -- #17459 - msg <- mkBatchMsg <$> getSession - success <- load' cache how_much diag_wrapper (Just msg) mod_graph - if isEmptyMessages errs - then pure success - else throwErrors (fmap GhcDriverMessage errs) - --- Note [Unused packages] --- ~~~~~~~~~~~~~~~~~~~~~~ --- Cabal passes `--package-id` flag for each direct dependency. But GHC --- loads them lazily, so when compilation is done, we have a list of all --- actually loaded packages. All the packages, specified on command line, --- but never loaded, are probably unused dependencies. - -warnUnusedPackages :: UnitState -> DynFlags -> ModuleGraph -> DriverMessages -warnUnusedPackages us dflags mod_graph = - let diag_opts = initDiagOpts dflags - - home_mod_sum = filter (\ms -> homeUnitId_ dflags == ms_unitid ms) (mgModSummaries mod_graph) - - -- Only need non-source imports here because SOURCE imports are always HPT - loadedPackages = concat $ - mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs) - $ concatMap ms_imps home_mod_sum - - any_import_ghc_prim = any ms_ghc_prim_import home_mod_sum - - used_args = Set.fromList (map unitId loadedPackages) - `Set.union` Set.fromList [ primUnitId | any_import_ghc_prim ] - - resolve (u,mflag) = do - -- The units which we depend on via the command line explicitly - flag <- mflag - -- Which we can find the UnitInfo for (should be all of them) - ui <- lookupUnit us u - -- Which are not explicitly used - guard (Set.notMember (unitId ui) used_args) - return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag) - - unusedArgs = sortOn (\(u,_,_,_) -> u) $ mapMaybe resolve (explicitUnits us) - - warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs) - - in if null unusedArgs - then emptyMessages - else warn - --- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any --- path from module to its boot file. -data ModuleGraphNodeWithBootFile - = ModuleGraphNodeWithBootFile - ModuleGraphNode - -- ^ The module itself (not the hs-boot module) - [NodeKey] - -- ^ The modules in between the module and its hs-boot file, - -- not including the hs-boot file itself. - - -instance Outputable ModuleGraphNodeWithBootFile where - ppr (ModuleGraphNodeWithBootFile mgn deps) = text "ModeGraphNodeWithBootFile: " <+> ppr mgn $$ ppr deps - --- | A 'BuildPlan' is the result of attempting to linearise a single strongly-connected --- component of the module graph. -data BuildPlan - -- | A simple, single module all alone (which *might* have an hs-boot file, if it isn't part of a cycle) - = SingleModule ModuleGraphNode - -- | A resolved cycle, linearised by hs-boot files - | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile] - -- | An actual cycle, which wasn't resolved by hs-boot files - | UnresolvedCycle [ModuleGraphNode] - -instance Outputable BuildPlan where - ppr (SingleModule mgn) = text "SingleModule" <> parens (ppr mgn) - ppr (ResolvedCycle mgn) = text "ResolvedCycle:" <+> ppr mgn - ppr (UnresolvedCycle mgn) = text "UnresolvedCycle:" <+> ppr mgn - - --- Just used for an assertion -countMods :: BuildPlan -> Int -countMods (SingleModule _) = 1 -countMods (ResolvedCycle ns) = length ns -countMods (UnresolvedCycle ns) = length ns - --- See Note [Upsweep] for a high-level description. -createBuildPlan :: ModuleGraph -> Maybe HomeUnitModule -> [BuildPlan] -createBuildPlan mod_graph maybe_top_mod = - let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles - cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod - - -- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles. - build_plan :: [BuildPlan] - build_plan - -- Fast path, if there are no boot modules just do a normal toposort - | isEmptyModuleEnv boot_modules = collapseAcyclic $ topSortModuleGraph False mod_graph maybe_top_mod - | otherwise = toBuildPlan cycle_mod_graph [] - - toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan] - toBuildPlan [] mgn = collapseAcyclic (topSortWithBoot mgn) - toBuildPlan ((AcyclicSCC node):sccs) mgn = toBuildPlan sccs (node:mgn) - -- Interesting case - toBuildPlan ((CyclicSCC nodes):sccs) mgn = - let acyclic = collapseAcyclic (topSortWithBoot mgn) - -- Now perform another toposort but just with these nodes and relevant hs-boot files. - -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph. - mresolved_cycle = collapseSCC (topSortWithBoot nodes) - in acyclic ++ [either UnresolvedCycle ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs [] - - (mg, lookup_node) = moduleGraphNodes False (mgModSummaries' mod_graph) - trans_deps_map = allReachable mg (mkNodeKey . node_payload) - -- Compute the intermediate modules between a file and its hs-boot file. - -- See Step 2a in Note [Upsweep] - boot_path mn uid = - map (summaryNodeSummary . expectJust "toNode" . lookup_node) $ Set.toList $ - -- Don't include the boot module itself - Set.delete (NodeKey_Module (key IsBoot)) $ - -- Keep intermediate dependencies: as per Step 2a in Note [Upsweep], these are - -- the transitive dependencies of the non-boot file which transitively depend - -- on the boot file. - Set.filter (\nk -> nodeKeyUnitId nk == uid -- Cheap test - && (NodeKey_Module (key IsBoot)) `Set.member` expectJust "dep_on_boot" (M.lookup nk trans_deps_map)) $ - expectJust "not_boot_dep" (M.lookup (NodeKey_Module (key NotBoot)) trans_deps_map) - where - key ib = ModNodeKeyWithUid (GWIB mn ib) uid - - - -- An environment mapping a module to its hs-boot file and all nodes on the path between the two, if one exists - boot_modules = mkModuleEnv - [ (ms_mod ms, (m, boot_path (ms_mod_name ms) (ms_unitid ms))) | m@(ModuleNode _ ms) <- (mgModSummaries' mod_graph), isBootSummary ms == IsBoot] - - select_boot_modules :: [ModuleGraphNode] -> [ModuleGraphNode] - select_boot_modules = mapMaybe (fmap fst . get_boot_module) - - get_boot_module :: ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode]) - get_boot_module m = case m of ModuleNode _ ms | HsSrcFile <- ms_hsc_src ms -> lookupModuleEnv boot_modules (ms_mod ms); _ -> Nothing - - -- Any cycles should be resolved now - collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)] - -- Must be at least two nodes, as we were in a cycle - collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Right [toNodeWithBoot node1, toNodeWithBoot node2] - collapseSCC (AcyclicSCC node : nodes) = either (Left . (node :)) (Right . (toNodeWithBoot node :)) (collapseSCC nodes) - -- Cyclic - collapseSCC nodes = Left (flattenSCCs nodes) - - toNodeWithBoot :: ModuleGraphNode -> Either ModuleGraphNode ModuleGraphNodeWithBootFile - toNodeWithBoot mn = - case get_boot_module mn of - -- The node doesn't have a boot file - Nothing -> Left mn - -- The node does have a boot file - Just path -> Right (ModuleGraphNodeWithBootFile mn (map mkNodeKey (snd path))) - - -- The toposort and accumulation of acyclic modules is solely to pick-up - -- hs-boot files which are **not** part of cycles. - collapseAcyclic :: [SCC ModuleGraphNode] -> [BuildPlan] - collapseAcyclic (AcyclicSCC node : nodes) = SingleModule node : collapseAcyclic nodes - collapseAcyclic (CyclicSCC cy_nodes : nodes) = (UnresolvedCycle cy_nodes) : collapseAcyclic nodes - collapseAcyclic [] = [] - - topSortWithBoot nodes = topSortModules False (select_boot_modules nodes ++ nodes) Nothing - - - in - - assertPpr (sum (map countMods build_plan) == length (mgModSummaries' mod_graph)) - (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (length (mgModSummaries' mod_graph )))]) - build_plan - -mkWorkerLimit :: DynFlags -> IO WorkerLimit -mkWorkerLimit dflags = - case parMakeCount dflags of - Nothing -> pure $ num_procs 1 - Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) - Just ParMakeNumProcessors -> num_procs <$> getNumProcessors - Just (ParMakeThisMany n) -> pure $ num_procs n - where - num_procs x = NumProcessorsLimit (max 1 x) - -isWorkerLimitSequential :: WorkerLimit -> Bool -isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 -isWorkerLimitSequential (JSemLimit {}) = False - --- | This describes what we use to limit the number of jobs, either we limit it --- ourselves to a specific number or we have an external parallelism semaphore --- limit it for us. -data WorkerLimit - = NumProcessorsLimit Int - | JSemLimit - SemaphoreName - -- ^ Semaphore name to use - deriving Eq - --- | Generalized version of 'load' which also supports a custom --- 'Messager' (for reporting progress) and 'ModuleGraph' (generally --- produced by calling 'depanal'. -load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> ModuleGraph -> m SuccessFlag -load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do - -- In normal usage plugins are initialised already by ghc/Main.hs this is protective - -- for any client who might interact with GHC via load'. - -- See Note [Timing of plugin initialization] - initializeSessionPlugins - modifySession $ \hsc_env -> hsc_env { hsc_mod_graph = mod_graph } - guessOutputFile - hsc_env <- getSession - - let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - let interp = hscInterp hsc_env - - -- The "bad" boot modules are the ones for which we have - -- B.hs-boot in the module graph, but no B.hs - -- The downsweep should have ensured this does not happen - -- (see msDeps) - let all_home_mods = - Set.fromList [ Module (ms_unitid s) (ms_mod_name s) - | s <- mgModSummaries mod_graph, isBootSummary s == NotBoot] - -- TODO: Figure out what the correct form of this assert is. It's violated - -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot - -- files without corresponding hs files. - -- bad_boot_mods = [s | s <- mod_graph, isBootSummary s, - -- not (ms_mod_name s `elem` all_home_mods)] - -- assert (null bad_boot_mods ) return () - - -- check that the module given in HowMuch actually exists, otherwise - -- topSortModuleGraph will bomb later. - let checkHowMuch (LoadUpTo m) = checkMod m - checkHowMuch (LoadDependenciesOf m) = checkMod m - checkHowMuch _ = id - - checkMod m and_then - | m `Set.member` all_home_mods = and_then - | otherwise = do - throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan - $ GhcDriverMessage - $ DriverModuleNotFound (moduleName m) - - checkHowMuch how_much $ do - - -- mg2_with_srcimps drops the hi-boot nodes, returning a - -- graph with cycles. It is just used for warning about unnecessary source imports. - let mg2_with_srcimps :: [SCC ModuleGraphNode] - mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing - - -- If we can determine that any of the {-# SOURCE #-} imports - -- are definitely unnecessary, then emit a warning. - warnUnnecessarySourceImports (filterToposortToModules mg2_with_srcimps) - - let maybe_top_mod = case how_much of - LoadUpTo m -> Just m - LoadDependenciesOf m -> Just m - _ -> Nothing - - build_plan = createBuildPlan mod_graph maybe_top_mod - - - cache <- liftIO $ maybe (return []) iface_clearCache mhmi_cache - let - -- prune the HPT so everything is not retained when doing an - -- upsweep. - !pruned_cache = pruneCache cache - (flattenSCCs (filterToposortToModules mg2_with_srcimps)) - - - -- before we unload anything, make sure we don't leave an old - -- interactive context around pointing to dead bindings. Also, - -- write an empty HPT to allow the old HPT to be GC'd. - - let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable } - setSession $ discardIC $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env - hsc_env <- getSession - - -- Unload everything - liftIO $ unload interp hsc_env - - liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") - 2 (ppr build_plan)) - - worker_limit <- liftIO $ mkWorkerLimit dflags - - (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do - hsc_env <- getSession - liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan - modifySession (addDepsToHscEnv new_deps) - case upsweep_ok of - Failed -> loadFinish upsweep_ok - Succeeded -> do - liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") - loadFinish upsweep_ok - - - --- | Finish up after a load. -loadFinish :: GhcMonad m => SuccessFlag -> m SuccessFlag --- Empty the interactive context and set the module context to the topmost --- newly loaded module, or the Prelude if none were loaded. -loadFinish all_ok - = do modifySession discardIC - return all_ok - - --- | If there is no -o option, guess the name of target executable --- by using top-level source file name as a base. -guessOutputFile :: GhcMonad m => m () -guessOutputFile = modifySession $ \env -> - -- Force mod_graph to avoid leaking env - let !mod_graph = hsc_mod_graph env - new_home_graph = - flip unitEnv_map (hsc_HUG env) $ \hue -> - let dflags = homeUnitEnv_dflags hue - platform = targetPlatform dflags - mainModuleSrcPath :: Maybe String - mainModuleSrcPath = do - ms <- mgLookupModule mod_graph (mainModIs hue) - ml_hs_file (ms_location ms) - name = fmap dropExtension mainModuleSrcPath - - -- MP: This exception is quite sensitive to being forced, if you - -- force it here then the error message is different because it gets - -- caught by a different error handler than the test (T9930fail) expects. - -- Putting an exception into DynFlags is probably not a great design but - -- I'll write this comment rather than more eagerly force the exception. - name_exe = do - -- we must add the .exe extension unconditionally here, otherwise - -- when name has an extension of its own, the .exe extension will - -- not be added by GHC.Driver.Pipeline.exeFileName. See #2248 - !name' <- case platformArchOS platform of - ArchOS _ OSMinGW32 -> fmap (<.> "exe") name - ArchOS ArchWasm32 _ -> fmap (<.> "wasm") name - _ -> name - mainModuleSrcPath' <- mainModuleSrcPath - -- #9930: don't clobber input files (unless they ask for it) - if name' == mainModuleSrcPath' - then throwGhcException . UsageError $ - "default output name would overwrite the input file; " ++ - "must specify -o explicitly" - else Just name' - in - case outputFile_ dflags of - Just _ -> hue - Nothing -> hue {homeUnitEnv_dflags = dflags { outputFile_ = name_exe } } - in env { hsc_unit_env = (hsc_unit_env env) { ue_home_unit_graph = new_home_graph } } - --- ----------------------------------------------------------------------------- --- --- | Prune the HomePackageTable --- --- Before doing an upsweep, we can throw away: --- --- - all ModDetails, all linked code --- - all unlinked code that is out of date with respect to --- the source file --- --- This is VERY IMPORTANT otherwise we'll end up requiring 2x the --- space at the end of the upsweep, because the topmost ModDetails of the --- old HPT holds on to the entire type environment from the previous --- compilation. --- Note [GHC Heap Invariants] -pruneCache :: [CachedIface] - -> [ModSummary] - -> [HomeModInfo] -pruneCache hpt summ - = strictMap prune hpt - where prune (CachedIface { cached_modiface = iface - , cached_linkable = linkable - }) = HomeModInfo iface emptyModDetails linkable' - where - modl = miKey iface - linkable' - | Just ms <- M.lookup modl ms_map - , mi_src_hash iface /= ms_hs_hash ms - = emptyHomeModInfoLinkable - | otherwise - = linkable - - -- Using UFM Module is safe for determinism because the map is just used for a transient lookup. The cache should be unique and a key clash is an error. - ms_map = M.fromListWith - (\ms1 ms2 -> assertPpr False (text "prune_cache" $$ (ppr ms1 <+> ppr ms2)) - ms2) - [(msKey ms, ms) | ms <- summ] - --- --------------------------------------------------------------------------- --- --- | Unloading -unload :: Interp -> HscEnv -> IO () -unload interp hsc_env - = case ghcLink (hsc_dflags hsc_env) of - LinkInMemory -> Linker.unload interp hsc_env [] - _other -> return () - - -{- Parallel Upsweep - -The parallel upsweep attempts to concurrently compile the modules in the -compilation graph using multiple Haskell threads. - -The Algorithm - -* The list of `MakeAction`s are created by `interpretBuildPlan`. A `MakeAction` is -a pair of an `IO a` action and a `MVar a`, where to place the result. - The list is sorted topologically, so can be executed in order without fear of - blocking. -* runPipelines takes this list and eventually passes it to runLoop which executes - each action and places the result into the right MVar. -* The amount of parallelism is controlled by a semaphore. This is just used around the - module compilation step, so that only the right number of modules are compiled at - the same time which reduces overall memory usage and allocations. -* Each proper node has a LogQueue, which dictates where to send it's output. -* The LogQueue is placed into the LogQueueQueue when the action starts and a worker - thread processes the LogQueueQueue printing logs for each module in a stable order. -* The result variable for an action producing `a` is of type `Maybe a`, therefore - it is still filled on a failure. If a module fails to compile, the - failure is propagated through the whole module graph and any modules which didn't - depend on the failure can still be compiled. This behaviour also makes the code - quite a bit cleaner. --} - - -{- - -Note [--make mode] -~~~~~~~~~~~~~~~~~ -There are two main parts to `--make` mode. - -1. `downsweep`: Starts from the top of the module graph and computes dependencies. -2. `upsweep`: Starts from the bottom of the module graph and compiles modules. - -The result of the downsweep is a 'ModuleGraph', which is then passed to 'upsweep' which -computers how to build this ModuleGraph. - -Note [Upsweep] -~~~~~~~~~~~~~~ -Upsweep takes a 'ModuleGraph' as input, computes a build plan and then executes -the plan in order to compile the project. - -The first step is computing the build plan from a 'ModuleGraph'. - -The output of this step is a `[BuildPlan]`, which is a topologically sorted plan for -how to build all the modules. - -``` -data BuildPlan = SingleModule ModuleGraphNode -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle - | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBoot] -- A resolved cycle, linearised by hs-boot files - | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files -``` - -The plan is computed in two steps: - -Step 1: Topologically sort the module graph without hs-boot files. This returns a [SCC ModuleGraphNode] which contains - cycles. -Step 2: For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should - result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle. -Step 2a: For each module in the cycle, if the module has a boot file then compute the - modules on the path between it and the hs-boot file. - These are the intermediate modules which: - (1) are (transitive) dependencies of the non-boot module, and - (2) have the boot module as a (transitive) dependency. - In particular, all such intermediate modules must appear in the same unit as - the module under consideration, as module cycles cannot cross unit boundaries. - This information is stored in ModuleGraphNodeWithBoot. - -The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function. - -* SingleModule nodes are compiled normally by either the upsweep_inst or upsweep_mod functions. -* ResolvedCycles need to compiled "together" so that modules outside the cycle are presented - with a consistent knot-tied version of modules at the end. - - When the ModuleGraphNodeWithBoot nodes are compiled then suitable rehydration - is performed both before and after the module in question is compiled. - See Note [Hydrating Modules] for more information. -* UnresolvedCycles are indicative of a proper cycle, unresolved by hs-boot files - and are reported as an error to the user. - -The main trickiness of `interpretBuildPlan` is deciding which version of a dependency -is visible from each module. For modules which are not in a cycle, there is just -one version of a module, so that is always used. For modules in a cycle, there are two versions of -'HomeModInfo'. - -1. Internal to loop: The version created whilst compiling the loop by upsweep_mod. -2. External to loop: The knot-tied version created by typecheckLoop. - -Whilst compiling a module inside the loop, we need to use the (1). For a module which -is outside of the loop which depends on something from in the loop, the (2) version -is used. - -As the plan is interpreted, which version of a HomeModInfo is visible is updated -by updating a map held in a state monad. So after a loop has finished being compiled, -the visible module is the one created by typecheckLoop and the internal version is not -used again. - -This plan also ensures the most important invariant to do with module loops: - -> If you depend on anything within a module loop, before you can use the dependency, - the whole loop has to finish compiling. - -The end result of `interpretBuildPlan` is a `[MakeAction]`, which are pairs -of `IO a` actions and a `MVar (Maybe a)`, somewhere to put the result of running -the action. This list is topologically sorted, so can be run in order to compute -the whole graph. - -As well as this `interpretBuildPlan` also outputs an `IO [Maybe (Maybe HomeModInfo)]` which -can be queried at the end to get the result of all modules at the end, with their proper -visibility. For example, if any module in a loop fails then all modules in that loop will -report as failed because the visible node at the end will be the result of checking -these modules together. - --} - --- | Simple wrapper around MVar which allows a functor instance. -data ResultVar b = forall a . ResultVar (a -> b) (MVar (Maybe a)) - -deriving instance Functor ResultVar - -mkResultVar :: MVar (Maybe a) -> ResultVar a -mkResultVar = ResultVar id - --- | Block until the result is ready. -waitResult :: ResultVar a -> MaybeT IO a -waitResult (ResultVar f var) = MaybeT (fmap f <$> readMVar var) - -data BuildResult = BuildResult { _resultOrigin :: ResultOrigin - , resultVar :: ResultVar (Maybe HomeModInfo, ModuleNameSet) - } - --- The origin of this result var, useful for debugging -data ResultOrigin = NoLoop | Loop ResultLoopOrigin deriving (Show) - -data ResultLoopOrigin = Initialise | Rehydrated | Finalised deriving (Show) - -mkBuildResult :: ResultOrigin -> ResultVar (Maybe HomeModInfo, ModuleNameSet) -> BuildResult -mkBuildResult = BuildResult - - -data BuildLoopState = BuildLoopState { buildDep :: M.Map NodeKey BuildResult - -- The current way to build a specific TNodeKey, without cycles this just points to - -- the appropriate result of compiling a module but with - -- cycles there can be additional indirection and can point to the result of typechecking a loop - , nNODE :: Int - , hug_var :: MVar HomeUnitGraph - -- A global variable which is incrementally updated with the result - -- of compiling modules. - } - -nodeId :: BuildM Int -nodeId = do - n <- gets nNODE - modify (\m -> m { nNODE = n + 1 }) - return n - - -setModulePipeline :: NodeKey -> BuildResult -> BuildM () -setModulePipeline mgn build_result = do - modify (\m -> m { buildDep = M.insert mgn build_result (buildDep m) }) - -type BuildMap = M.Map NodeKey BuildResult - -getBuildMap :: BuildM BuildMap -getBuildMap = gets buildDep - -getDependencies :: [NodeKey] -> BuildMap -> [BuildResult] -getDependencies direct_deps build_map = - strictMap (expectJust "dep_map" . flip M.lookup build_map) direct_deps - -type BuildM a = StateT BuildLoopState IO a - - - - --- | Environment used when compiling a module -data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module - , compile_sem :: !AbstractSem - -- Modify the environment for module k, with the supplied logger modification function. - -- For -j1, this wrapper doesn't do anything - -- For -jn, the wrapper initialised a log queue and then modifies the logger to pipe its output - -- into the log queue. - , withLogger :: forall a . Int -> ((Logger -> Logger) -> IO a) -> IO a - , env_messager :: !(Maybe Messager) - , diag_wrapper :: GhcMessage -> AnyGhcDiagnostic - } - -type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a - --- | Given the build plan, creates a graph which indicates where each NodeKey should --- get its direct dependencies from. This might not be the corresponding build action --- if the module participates in a loop. This step also labels each node with a number for the output. --- See Note [Upsweep] for a high-level description. -interpretBuildPlan :: HomeUnitGraph - -> Maybe ModIfaceCache - -> M.Map ModNodeKeyWithUid HomeModInfo - -> [BuildPlan] - -> IO ( Maybe [ModuleGraphNode] -- Is there an unresolved cycle - , [MakeAction] -- Actions we need to run in order to build everything - , IO [Maybe (Maybe HomeModInfo)]) -- An action to query to get all the built modules at the end. -interpretBuildPlan hug mhmi_cache old_hpt plan = do - hug_var <- newMVar hug - ((mcycle, plans), build_map) <- runStateT (buildLoop plan) (BuildLoopState M.empty 1 hug_var) - let wait = collect_results (buildDep build_map) - return (mcycle, plans, wait) - - where - collect_results build_map = - sequence (map (\br -> collect_result (fst <$> resultVar br)) (M.elems build_map)) - where - collect_result res_var = runMaybeT (waitResult res_var) - - n_mods = sum (map countMods plan) - - buildLoop :: [BuildPlan] - -> BuildM (Maybe [ModuleGraphNode], [MakeAction]) - -- Build the abstract pipeline which we can execute - -- Building finished - buildLoop [] = return (Nothing, []) - buildLoop (plan:plans) = - case plan of - -- If there was no cycle, then typecheckLoop is not necessary - SingleModule m -> do - one_plan <- buildSingleModule Nothing NoLoop m - (cycle, all_plans) <- buildLoop plans - return (cycle, one_plan : all_plans) - - -- For a resolved cycle, depend on everything in the loop, then update - -- the cache to point to this node rather than directly to the module build - -- nodes - ResolvedCycle ms -> do - pipes <- buildModuleLoop ms - (cycle, graph) <- buildLoop plans - return (cycle, pipes ++ graph) - - -- Can't continue past this point as the cycle is unresolved. - UnresolvedCycle ns -> return (Just ns, []) - - buildSingleModule :: Maybe [NodeKey] -- Modules we need to rehydrate before compiling this module - -> ResultOrigin - -> ModuleGraphNode -- The node we are compiling - -> BuildM MakeAction - buildSingleModule rehydrate_nodes origin mod = do - mod_idx <- nodeId - !build_map <- getBuildMap - hug_var <- gets hug_var - -- 1. Get the direct dependencies of this module - let direct_deps = nodeDependencies False mod - -- It's really important to force build_deps, or the whole buildMap is retained, - -- which would retain all the result variables, preventing us from collecting them - -- after they are no longer used. - !build_deps = getDependencies direct_deps build_map - let !build_action = - case mod of - InstantiationNode uid iu -> do - withCurrentUnit (moduleGraphNodeUnitId mod) $ do - (hug, deps) <- wait_deps_hug hug_var build_deps - executeInstantiationNode mod_idx n_mods hug uid iu - return (Nothing, deps) - ModuleNode _build_deps ms -> - let !old_hmi = M.lookup (msKey ms) old_hpt - rehydrate_mods = mapMaybe nodeKeyModName <$> rehydrate_nodes - in withCurrentUnit (moduleGraphNodeUnitId mod) $ do - (hug, deps) <- wait_deps_hug hug_var build_deps - hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms - -- Write the HMI to an external cache (if one exists) - -- See Note [Caching HomeModInfo] - liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi - -- This global MVar is incrementally modified in order to avoid having to - -- recreate the HPT before compiling each module which leads to a quadratic amount of work. - liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi) - return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps ) - LinkNode _nks uid -> do - withCurrentUnit (moduleGraphNodeUnitId mod) $ do - (hug, deps) <- wait_deps_hug hug_var build_deps - executeLinkNode hug (mod_idx, n_mods) uid direct_deps - return (Nothing, deps) - - - res_var <- liftIO newEmptyMVar - let result_var = mkResultVar res_var - setModulePipeline (mkNodeKey mod) (mkBuildResult origin result_var) - return $! (MakeAction build_action res_var) - - - buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction] - buildOneLoopyModule (ModuleGraphNodeWithBootFile mn deps) = do - ma <- buildSingleModule (Just deps) (Loop Initialise) mn - -- Rehydration (1) from Note [Hydrating Modules], "Loops with multiple boot files" - rehydrate_action <- rehydrateAction Rehydrated ((GWIB (mkNodeKey mn) IsBoot) : (map (\d -> GWIB d NotBoot) deps)) - return $ [ma, rehydrate_action] - - - buildModuleLoop :: [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> BuildM [MakeAction] - buildModuleLoop ms = do - build_modules <- concatMapM (either (fmap (:[]) <$> buildSingleModule Nothing (Loop Initialise)) buildOneLoopyModule) ms - let extract (Left mn) = GWIB (mkNodeKey mn) NotBoot - extract (Right (ModuleGraphNodeWithBootFile mn _)) = GWIB (mkNodeKey mn) IsBoot - let loop_mods = map extract ms - -- Rehydration (2) from Note [Hydrating Modules], "Loops with multiple boot files" - -- Fixes the space leak described in that note. - rehydrate_action <- rehydrateAction Finalised loop_mods - - return $ build_modules ++ [rehydrate_action] - - -- An action which rehydrates the given keys - rehydrateAction :: ResultLoopOrigin -> [GenWithIsBoot NodeKey] -> BuildM MakeAction - rehydrateAction origin deps = do - hug_var <- gets hug_var - !build_map <- getBuildMap - res_var <- liftIO newEmptyMVar - let loop_unit :: UnitId - !loop_unit = nodeKeyUnitId (gwib_mod (head deps)) - !build_deps = getDependencies (map gwib_mod deps) build_map - let loop_action = withCurrentUnit loop_unit $ do - (hug, tdeps) <- wait_deps_hug hug_var build_deps - hsc_env <- asks hsc_env - let new_hsc = setHUG hug hsc_env - mns :: [ModuleName] - mns = mapMaybe (nodeKeyModName . gwib_mod) deps - - hmis' <- liftIO $ rehydrateAfter new_hsc mns - - checkRehydrationInvariant hmis' deps - - -- Add hydrated interfaces to global variable - liftIO $ modifyMVar_ hug_var (\hug -> return $ foldr addHomeModInfoToHug hug hmis') - return (hmis', tdeps) - - let fanout i = first (Just . (!! i)) <$> mkResultVar res_var - -- From outside the module loop, anyone must wait for the loop to finish and then - -- use the result of the rehydrated iface. This makes sure that things not in the - -- module loop will see the updated interfaces for all the identifiers in the loop. - boot_key :: NodeKey -> NodeKey - boot_key (NodeKey_Module m) = NodeKey_Module (m { mnkModuleName = (mnkModuleName m) { gwib_isBoot = IsBoot } } ) - boot_key k = pprPanic "boot_key" (ppr k) - - update_module_pipeline (m, i) = - case gwib_isBoot m of - NotBoot -> setModulePipeline (gwib_mod m) (mkBuildResult (Loop origin) (fanout i)) - IsBoot -> do - setModulePipeline (gwib_mod m) (mkBuildResult (Loop origin) (fanout i)) - -- SPECIAL: Anything outside the loop needs to see A rather than A.hs-boot - setModulePipeline (boot_key (gwib_mod m)) (mkBuildResult (Loop origin) (fanout i)) - - let deps_i = zip deps [0..] - mapM update_module_pipeline deps_i - - return $ MakeAction loop_action res_var - - -- Checks that the interfaces returned from hydration match-up with the names of the - -- modules which were fed into the function. - checkRehydrationInvariant hmis deps = - let hmi_names = map (moduleName . mi_module . hm_iface) hmis - start = mapMaybe (nodeKeyModName . gwib_mod) deps - in massertPpr (hmi_names == start) $ (ppr hmi_names $$ ppr start) - - -withCurrentUnit :: UnitId -> RunMakeM a -> RunMakeM a -withCurrentUnit uid = do - local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) - -upsweep - :: WorkerLimit -- ^ The number of workers we wish to run in parallel - -> HscEnv -- ^ The base HscEnv, which is augmented for each module - -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to - -> (GhcMessage -> AnyGhcDiagnostic) - -> Maybe Messager - -> M.Map ModNodeKeyWithUid HomeModInfo - -> [BuildPlan] - -> IO (SuccessFlag, [HomeModInfo]) -upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do - (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan - runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines - res <- collect_result - - let completed = [m | Just (Just m) <- res] - - -- Handle any cycle in the original compilation graph and return the result - -- of the upsweep. - case cycle of - Just mss -> do - throwOneError $ cyclicModuleErr mss - Nothing -> do - let success_flag = successIf (all isJust res) - return (success_flag, completed) - -toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo -toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) - -miKey :: ModIface -> ModNodeKeyWithUid -miKey hmi = ModNodeKeyWithUid (mi_mnwib hmi) ((toUnitId $ moduleUnit (mi_module hmi))) - -upsweep_inst :: HscEnv - -> Maybe Messager - -> Int -- index of module - -> Int -- total number of modules - -> UnitId - -> InstantiatedUnit - -> IO () -upsweep_inst hsc_env mHscMessage mod_index nmods uid iuid = do - case mHscMessage of - Just hscMessage -> hscMessage hsc_env (mod_index, nmods) (NeedsRecompile MustCompile) (InstantiationNode uid iuid) - Nothing -> return () - runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ tcRnCheckUnit hsc_env $ VirtUnit iuid - pure () - --- | Compile a single module. Always produce a Linkable for it if --- successful. If no compilation happened, return the old Linkable. -upsweep_mod :: HscEnv - -> Maybe Messager - -> Maybe HomeModInfo - -> ModSummary - -> Int -- index of module - -> Int -- total number of modules - -> IO HomeModInfo -upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods = do - hmi <- compileOne' mHscMessage hsc_env summary - mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi) - - -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module - -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I - -- am unsure if this is sound (wrt running TH splices for example). - -- This function only does anything if the linkable produced is a BCO, which - -- used to only happen with the bytecode backend, but with - -- @-fprefer-byte-code@, @HomeModInfo@ has bytecode even when generating - -- object code, see #25230. - addSptEntries (hscUpdateHPT (\hpt -> addToHpt hpt (ms_mod_name summary) hmi) hsc_env) - (homeModInfoByteCode hmi) - - return hmi - --- | Add the entries from a BCO linkable to the SPT table, see --- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. -addSptEntries :: HscEnv -> Maybe Linkable -> IO () -addSptEntries hsc_env mlinkable = - hscAddSptEntries hsc_env - [ spt - | linkable <- maybeToList mlinkable - , bco <- linkableBCOs linkable - , spt <- bc_spt_entries bco - ] - -{- Note [-fno-code mode] -~~~~~~~~~~~~~~~~~~~~~~~~ -GHC offers the flag -fno-code for the purpose of parsing and typechecking a -program without generating object files. This is intended to be used by tooling -and IDEs to provide quick feedback on any parser or type errors as cheaply as -possible. - -When GHC is invoked with -fno-code no object files or linked output will be -generated. As many errors and warnings as possible will be generated, as if --fno-code had not been passed. The session DynFlags will have -backend == NoBackend. - --fwrite-interface -~~~~~~~~~~~~~~~~ -Whether interface files are generated in -fno-code mode is controlled by the --fwrite-interface flag. The -fwrite-interface flag is a no-op if -fno-code is -not also passed. Recompilation avoidance requires interface files, so passing --fno-code without -fwrite-interface should be avoided. If -fno-code were -re-implemented today, -fwrite-interface would be discarded and it would be -considered always on; this behaviour is as it is for backwards compatibility. - -================================================================ -IN SUMMARY: ALWAYS PASS -fno-code AND -fwrite-interface TOGETHER -================================================================ - -Template Haskell -~~~~~~~~~~~~~~~~ -A module using template haskell may invoke an imported function from inside a -splice. This will cause the type-checker to attempt to execute that code, which -would fail if no object files had been generated. See #8025. To rectify this, -during the downsweep we patch the DynFlags in the ModSummary of any home module -that is imported by a module that uses template haskell, to generate object -code. - -The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled -or not in the module which needs the code generation. If the module requires byte-code then -dependencies will generate byte-code, otherwise they will generate object files. -In the case where some modules require byte-code and some object files, both are -generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these -configurations. - -The object files (and interface files if -fwrite-interface is disabled) produced -for template haskell are written to temporary files. - -Note that since template haskell can run arbitrary IO actions, -fno-code mode -is no more secure than running without it. - -Potential TODOS: -~~~~~ -* Remove -fwrite-interface and have interface files always written in -fno-code - mode -* Both .o and .dyn_o files are generated for template haskell, but we only need - .dyn_o. Fix it. -* In make mode, a message like - Compiling A (A.hs, /tmp/ghc_123.o) - is shown if downsweep enabled object code generation for A. Perhaps we should - show "nothing" or "temporary object file" instead. Note that one - can currently use -keep-tmp-files and inspect the generated file with the - current behaviour. -* Offer a -no-codedir command line option, and write what were temporary - object files there. This would speed up recompilation. -* Use existing object files (if they are up to date) instead of always - generating temporary ones. --} - --- Note [When source is considered modified] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- A number of functions in GHC.Driver accept a SourceModified argument, which --- is part of how GHC determines whether recompilation may be avoided (see the --- definition of the SourceModified data type for details). --- --- Determining whether or not a source file is considered modified depends not --- only on the source file itself, but also on the output files which compiling --- that module would produce. This is done because GHC supports a number of --- flags which control which output files should be produced, e.g. -fno-code --- -fwrite-interface and -fwrite-ide-file; we must check not only whether the --- source file has been modified since the last compile, but also whether the --- source file has been modified since the last compile which produced all of --- the output files which have been requested. --- --- Specifically, a source file is considered unmodified if it is up-to-date --- relative to all of the output files which have been requested. Whether or --- not an output file is up-to-date depends on what kind of file it is: --- --- * iface (.hi) files are considered up-to-date if (and only if) their --- mi_src_hash field matches the hash of the source file, --- --- * all other output files (.o, .dyn_o, .hie, etc) are considered up-to-date --- if (and only if) their modification times on the filesystem are greater --- than or equal to the modification time of the corresponding .hi file. --- --- Why do we use '>=' rather than '>' for output files other than the .hi file? --- If the filesystem has poor resolution for timestamps (e.g. FAT32 has a --- resolution of 2 seconds), we may often find that the .hi and .o files have --- the same modification time. Using >= is slightly unsafe, but it matches --- make's behaviour. --- --- This strategy allows us to do the minimum work necessary in order to ensure --- that all the files the user cares about are up-to-date; e.g. we should not --- worry about .o files if the user has indicated that they are not interested --- in them via -fno-code. See also #9243. --- --- Note that recompilation avoidance is dependent on .hi files being produced, --- which does not happen if -fno-write-interface -fno-code is passed. That is, --- passing -fno-write-interface -fno-code means that you cannot benefit from --- recompilation avoidance. See also Note [-fno-code mode]. --- --- The correctness of this strategy depends on an assumption that whenever we --- are producing multiple output files, the .hi file is always written first. --- If this assumption is violated, we risk recompiling unnecessarily by --- incorrectly regarding non-.hi files as outdated. --- - --- --------------------------------------------------------------------------- --- --- | Topological sort of the module graph -topSortModuleGraph - :: Bool - -- ^ Drop hi-boot nodes? (see below) - -> ModuleGraph - -> Maybe HomeUnitModule - -- ^ Root module name. If @Nothing@, use the full graph. - -> [SCC ModuleGraphNode] --- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes --- The resulting list of strongly-connected-components is in topologically --- sorted order, starting with the module(s) at the bottom of the --- dependency graph (ie compile them first) and ending with the ones at --- the top. --- --- Drop hi-boot nodes (first boolean arg)? --- --- - @False@: treat the hi-boot summaries as nodes of the graph, --- so the graph must be acyclic --- --- - @True@: eliminate the hi-boot nodes, and instead pretend --- the a source-import of Foo is an import of Foo --- The resulting graph has no hi-boot nodes, but can be cyclic -topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod = - -- stronglyConnCompG flips the original order, so if we reverse - -- the summaries we get a stable topological sort. - topSortModules drop_hs_boot_nodes (reverse $ mgModSummaries' module_graph) mb_root_mod - -topSortModules :: Bool -> [ModuleGraphNode] -> Maybe HomeUnitModule -> [SCC ModuleGraphNode] -topSortModules drop_hs_boot_nodes summaries mb_root_mod - = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph - where - (graph, lookup_node) = - moduleGraphNodes drop_hs_boot_nodes summaries - - initial_graph = case mb_root_mod of - Nothing -> graph - Just (Module uid root_mod) -> - -- restrict the graph to just those modules reachable from - -- the specified module. We do this by building a graph with - -- the full set of nodes, and determining the reachable set from - -- the specified node. - let root | Just node <- lookup_node $ NodeKey_Module $ ModNodeKeyWithUid (GWIB root_mod NotBoot) uid - , graph `hasVertexG` node - = node - | otherwise - = throwGhcException (ProgramError "module does not exist") - in graphFromEdgedVerticesUniq (seq root (reachableG graph root)) - -newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a } - deriving (Functor, Traversable, Foldable) - -emptyModNodeMap :: ModNodeMap a -emptyModNodeMap = ModNodeMap Map.empty - -modNodeMapInsert :: ModNodeKey -> a -> ModNodeMap a -> ModNodeMap a -modNodeMapInsert k v (ModNodeMap m) = ModNodeMap (Map.insert k v m) - -modNodeMapElems :: ModNodeMap a -> [a] -modNodeMapElems (ModNodeMap m) = Map.elems m - -modNodeMapLookup :: ModNodeKey -> ModNodeMap a -> Maybe a -modNodeMapLookup k (ModNodeMap m) = Map.lookup k m - -modNodeMapSingleton :: ModNodeKey -> a -> ModNodeMap a -modNodeMapSingleton k v = ModNodeMap (M.singleton k v) - -modNodeMapUnionWith :: (a -> a -> a) -> ModNodeMap a -> ModNodeMap a -> ModNodeMap a -modNodeMapUnionWith f (ModNodeMap m) (ModNodeMap n) = ModNodeMap (M.unionWith f m n) - --- | If there are {-# SOURCE #-} imports between strongly connected --- components in the topological sort, then those imports can --- definitely be replaced by ordinary non-SOURCE imports: if SOURCE --- were necessary, then the edge would be part of a cycle. -warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m () -warnUnnecessarySourceImports sccs = do - diag_opts <- initDiagOpts <$> getDynFlags - when (diag_wopt Opt_WarnUnusedImports diag_opts) $ do - let check ms = - let mods_in_this_cycle = map ms_mod_name ms in - [ warn i | m <- ms, i <- ms_home_srcimps m, - unLoc i `notElem` mods_in_this_cycle ] - - warn :: Located ModuleName -> MsgEnvelope GhcMessage - warn (L loc mod) = GhcDriverMessage <$> mkPlainMsgEnvelope diag_opts - loc (DriverUnnecessarySourceImports mod) - logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs)) - - --- This caches the answer to the question, if we are in this unit, what does --- an import of this module mean. -type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModSummary] - ------------------------------------------------------------------------------ --- --- | Downsweep (dependency analysis) --- --- Chase downwards from the specified root set, returning summaries --- for all home modules encountered. Only follow source-import --- links. --- --- We pass in the previous collection of summaries, which is used as a --- cache to avoid recalculating a module summary if the source is --- unchanged. --- --- The returned list of [ModSummary] nodes has one node for each home-package --- module, plus one for any hs-boot files. The imports of these nodes --- are all there, including the imports of non-home-package modules. -downsweep :: HscEnv - -> [ModSummary] - -- ^ Old summaries - -> [ModuleName] -- Ignore dependencies on these; treat - -- them as if they were package modules - -> Bool -- True <=> allow multiple targets to have - -- the same module name; this is - -- very useful for ghc -M - -> IO ([DriverMessages], [ModuleGraphNode]) - -- The non-error elements of the returned list all have distinct - -- (Modules, IsBoot) identifiers, unless the Bool is true in - -- which case there can be repeats -downsweep hsc_env old_summaries excl_mods allow_dup_roots - = do - (root_errs, rootSummariesOk) <- partitionWithM getRootSummary roots -- #17549 - let root_map = mkRootMap rootSummariesOk - checkDuplicates root_map - (deps, map0) <- loopSummaries rootSummariesOk (M.empty, root_map) - let closure_errs = checkHomeUnitsClosed (hsc_unit_env hsc_env) - let unit_env = hsc_unit_env hsc_env - let tmpfs = hsc_tmpfs hsc_env - - let downsweep_errs = lefts $ concat $ M.elems map0 - downsweep_nodes = M.elems deps - - (other_errs, unit_nodes) = partitionEithers $ unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env) - all_nodes = downsweep_nodes ++ unit_nodes - all_errs = all_root_errs ++ downsweep_errs ++ other_errs - all_root_errs = closure_errs ++ map snd root_errs - - -- if we have been passed -fno-code, we enable code generation - -- for dependencies of modules that have -XTemplateHaskell, - -- otherwise those modules will fail to compile. - -- See Note [-fno-code mode] #8025 - th_enabled_nodes <- enableCodeGenForTH logger tmpfs unit_env all_nodes - if null all_root_errs - then return (all_errs, th_enabled_nodes) - else pure $ (all_root_errs, []) - where - -- Dependencies arising on a unit (backpack and module linking deps) - unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode] - unitModuleNodes summaries uid hue = - let instantiation_nodes = instantiationNodes uid (homeUnitEnv_units hue) - in map Right instantiation_nodes - ++ maybeToList (linkNodes (instantiation_nodes ++ summaries) uid hue) - - calcDeps ms = - -- Add a dependency on the HsBoot file if it exists - -- This gets passed to the loopImports function which just ignores it if it - -- can't be found. - [(ms_unitid ms, NoPkgQual, GWIB (noLoc $ ms_mod_name ms) IsBoot) | NotBoot <- [isBootSummary ms] ] ++ - [(ms_unitid ms, b, c) | (b, c) <- msDeps ms ] - - logger = hsc_logger hsc_env - roots = hsc_targets hsc_env - - -- A cache from file paths to the already summarised modules. The same file - -- can be used in multiple units so the map is also keyed by which unit the - -- file was used in. - -- Reuse these if we can because the most expensive part of downsweep is - -- reading the headers. - old_summary_map :: M.Map (UnitId, FilePath) ModSummary - old_summary_map = M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries] - - getRootSummary :: Target -> IO (Either (UnitId, DriverMessages) ModSummary) - getRootSummary Target { targetId = TargetFile file mb_phase - , targetContents = maybe_buf - , targetUnitId = uid - } - = do let offset_file = augmentByWorkingDirectory dflags file - exists <- liftIO $ doesFileExist offset_file - if exists || isJust maybe_buf - then first (uid,) <$> - summariseFile hsc_env home_unit old_summary_map offset_file mb_phase - maybe_buf - else return $ Left $ (uid,) $ singleMessage - $ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file) - where - dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env)) - home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env) - getRootSummary Target { targetId = TargetModule modl - , targetContents = maybe_buf - , targetUnitId = uid - } - = do maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot - (L rootLoc modl) (ThisPkg (homeUnitId home_unit)) - maybe_buf excl_mods - case maybe_summary of - FoundHome s -> return (Right s) - FoundHomeWithError err -> return (Left err) - _ -> return $ Left $ (uid, moduleNotFoundErr modl) - where - home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env) - rootLoc = mkGeneralSrcSpan (fsLit "") - - -- In a root module, the filename is allowed to diverge from the module - -- name, so we have to check that there aren't multiple root files - -- defining the same module (otherwise the duplicates will be silently - -- ignored, leading to confusing behaviour). - checkDuplicates - :: DownsweepCache - -> IO () - checkDuplicates root_map - | allow_dup_roots = return () - | null dup_roots = return () - | otherwise = liftIO $ multiRootsErr (head dup_roots) - where - dup_roots :: [[ModSummary]] -- Each at least of length 2 - dup_roots = filterOut isSingleton $ map rights (M.elems root_map) - - -- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit - loopSummaries :: [ModSummary] - -> (M.Map NodeKey ModuleGraphNode, - DownsweepCache) - -> IO ((M.Map NodeKey ModuleGraphNode), DownsweepCache) - loopSummaries [] done = return done - loopSummaries (ms:next) (done, summarised) - | Just {} <- M.lookup k done - = loopSummaries next (done, summarised) - -- Didn't work out what the imports mean yet, now do that. - | otherwise = do - (final_deps, done', summarised') <- loopImports (calcDeps ms) done summarised - -- This has the effect of finding a .hs file if we are looking at the .hs-boot file. - (_, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised' - loopSummaries next (M.insert k (ModuleNode final_deps ms) done'', summarised'') - where - k = NodeKey_Module (msKey ms) - - hs_file_for_boot - | HsBootFile <- ms_hsc_src ms - = Just $ ((ms_unitid ms), NoPkgQual, (GWIB (noLoc $ ms_mod_name ms) NotBoot)) - | otherwise - = Nothing - - - -- This loops over each import in each summary. It is mutually recursive with loopSummaries if we discover - -- a new module by doing this. - loopImports :: [(UnitId, PkgQual, GenWithIsBoot (Located ModuleName))] - -- Work list: process these modules - -> M.Map NodeKey ModuleGraphNode - -> DownsweepCache - -- Visited set; the range is a list because - -- the roots can have the same module names - -- if allow_dup_roots is True - -> IO ([NodeKey], - M.Map NodeKey ModuleGraphNode, DownsweepCache) - -- The result is the completed NodeMap - loopImports [] done summarised = return ([], done, summarised) - loopImports ((home_uid,mb_pkg, gwib) : ss) done summarised - | Just summs <- M.lookup cache_key summarised - = case summs of - [Right ms] -> do - let nk = NodeKey_Module (msKey ms) - (rest, summarised', done') <- loopImports ss done summarised - return (nk: rest, summarised', done') - [Left _err] -> - loopImports ss done summarised - _errs -> do - loopImports ss done summarised - | otherwise - = do - mb_s <- summariseModule hsc_env home_unit old_summary_map - is_boot wanted_mod mb_pkg - Nothing excl_mods - case mb_s of - NotThere -> loopImports ss done summarised - External _ -> do - (other_deps, done', summarised') <- loopImports ss done summarised - return (other_deps, done', summarised') - FoundInstantiation iud -> do - (other_deps, done', summarised') <- loopImports ss done summarised - return (NodeKey_Unit iud : other_deps, done', summarised') - FoundHomeWithError (_uid, e) -> loopImports ss done (Map.insert cache_key [(Left e)] summarised) - FoundHome s -> do - (done', summarised') <- - loopSummaries [s] (done, Map.insert cache_key [Right s] summarised) - (other_deps, final_done, final_summarised) <- loopImports ss done' summarised' - - -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now. - return (NodeKey_Module (msKey s) : other_deps, final_done, final_summarised) - where - cache_key = (home_uid, mb_pkg, unLoc <$> gwib) - home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env) - GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib - wanted_mod = L loc mod - --- | This function checks then important property that if both p and q are home units --- then any dependency of p, which transitively depends on q is also a home unit. --- --- See Note [Multiple Home Units], section 'Closure Property'. -checkHomeUnitsClosed :: UnitEnv -> [DriverMessages] -checkHomeUnitsClosed ue - | Set.null bad_unit_ids = [] - | otherwise = [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)] - where - home_id_set = unitEnv_keys $ ue_home_unit_graph ue - bad_unit_ids = upwards_closure Set.\\ home_id_set - rootLoc = mkGeneralSrcSpan (fsLit "") - - graph :: Graph (Node UnitId UnitId) - graph = graphFromEdgedVerticesUniq graphNodes - - -- downwards closure of graph - downwards_closure - = graphFromEdgedVerticesUniq [ DigraphNode uid uid (Set.toList deps) - | (uid, deps) <- M.toList (allReachable graph node_key)] - - inverse_closure = transposeG downwards_closure - - upwards_closure = Set.fromList $ map node_key $ reachablesG inverse_closure [DigraphNode uid uid [] | uid <- Set.toList home_id_set] - - all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId) - all_unit_direct_deps - = unitEnv_foldWithKey go emptyUniqMap $ ue_home_unit_graph ue - where - go rest this this_uis = - plusUniqMap_C Set.union - (addToUniqMap_C Set.union external_depends this (Set.fromList $ this_deps)) - rest - where - external_depends = mapUniqMap (Set.fromList . unitDepends) (unitInfoMap this_units) - this_units = homeUnitEnv_units this_uis - this_deps = [ toUnitId unit | (unit,Just _) <- explicitUnits this_units] - - graphNodes :: [Node UnitId UnitId] - graphNodes = go Set.empty home_id_set - where - go done todo - = case Set.minView todo of - Nothing -> [] - Just (uid, todo') - | Set.member uid done -> go done todo' - | otherwise -> case lookupUniqMap all_unit_direct_deps uid of - Nothing -> pprPanic "uid not found" (ppr (uid, all_unit_direct_deps)) - Just depends -> - let todo'' = (depends Set.\\ done) `Set.union` todo' - in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo'' - --- | Update the every ModSummary that is depended on --- by a module that needs template haskell. We enable codegen to --- the specified target, disable optimization and change the .hi --- and .o file locations to be temporary files. --- See Note [-fno-code mode] -enableCodeGenForTH - :: Logger - -> TmpFs - -> UnitEnv - -> [ModuleGraphNode] - -> IO [ModuleGraphNode] -enableCodeGenForTH logger tmpfs unit_env = - enableCodeGenWhen logger tmpfs TFL_CurrentModule TFL_GhcSession unit_env - - -data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (Eq, Show, Ord) - -instance Outputable CodeGenEnable where - ppr = text . show - --- | Helper used to implement 'enableCodeGenForTH'. --- In particular, this enables --- unoptimized code generation for all modules that meet some --- condition (first parameter), or are dependencies of those --- modules. The second parameter is a condition to check before --- marking modules for code generation. -enableCodeGenWhen - :: Logger - -> TmpFs - -> TempFileLifetime - -> TempFileLifetime - -> UnitEnv - -> [ModuleGraphNode] - -> IO [ModuleGraphNode] -enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = - mapM enable_code_gen mod_graph - where - defaultBackendOf ms = platformDefaultBackend (targetPlatform $ ue_unitFlags (ms_unitid ms) unit_env) - enable_code_gen :: ModuleGraphNode -> IO ModuleGraphNode - enable_code_gen n@(ModuleNode deps ms) - | ModSummary - { ms_location = ms_location - , ms_hsc_src = HsSrcFile - , ms_hspp_opts = dflags - } <- ms - , Just enable_spec <- mkNodeKey n `Map.lookup` needs_codegen_map = - if | nocode_enable ms -> do - let new_temp_file suf dynsuf = do - tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf - let dyn_tn = tn -<.> dynsuf - addFilesToClean tmpfs dynLife [dyn_tn] - return (unsafeEncodeUtf tn, unsafeEncodeUtf dyn_tn) - -- We don't want to create .o or .hi files unless we have been asked - -- to by the user. But we need them, so we patch their locations in - -- the ModSummary with temporary files. - -- - ((hi_file, dyn_hi_file), (o_file, dyn_o_file)) <- - -- If ``-fwrite-interface` is specified, then the .o and .hi files - -- are written into `-odir` and `-hidir` respectively. #16670 - if gopt Opt_WriteInterface dflags - then return ((ml_hi_file_ospath ms_location, ml_dyn_hi_file_ospath ms_location) - , (ml_obj_file_ospath ms_location, ml_dyn_obj_file_ospath ms_location)) - else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) - <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) - let new_dflags = case enable_spec of - EnableByteCode -> dflags { backend = interpreterBackend } - EnableObject -> dflags { backend = defaultBackendOf ms } - EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} - let ms' = ms - { ms_location = - ms_location { ml_hi_file_ospath = hi_file - , ml_obj_file_ospath = o_file - , ml_dyn_hi_file_ospath = dyn_hi_file - , ml_dyn_obj_file_ospath = dyn_o_file } - , ms_hspp_opts = updOptLevel 0 $ new_dflags - } - -- Recursive call to catch the other cases - enable_code_gen (ModuleNode deps ms') - - -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough) - -- we only get to this case if the default backend is already generating object files, but we need dynamic - -- objects - | bytecode_and_enable enable_spec ms -> do - let ms' = ms - { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode - } - -- Recursive call to catch the other cases - enable_code_gen (ModuleNode deps ms') - | dynamic_too_enable enable_spec ms -> do - let ms' = ms - { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo - } - -- Recursive call to catch the other cases - enable_code_gen (ModuleNode deps ms') - | ext_interp_enable ms -> do - let ms' = ms - { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ExternalInterpreter - } - -- Recursive call to catch the other cases - enable_code_gen (ModuleNode deps ms') - - | otherwise -> return n - - enable_code_gen ms = return ms - - nocode_enable ms@(ModSummary { ms_hspp_opts = dflags }) = - not (backendGeneratesCode (backend dflags)) && - -- Don't enable codegen for TH on indefinite packages; we - -- can't compile anything anyway! See #16219. - isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) - - bytecode_and_enable enable_spec ms = - -- In the situation where we **would** need to enable dynamic-too - -- IF we had decided we needed objects - dynamic_too_enable EnableObject ms - -- but we prefer to use bytecode rather than objects - && prefer_bytecode - -- and we haven't already turned it on - && not generate_both - where - lcl_dflags = ms_hspp_opts ms - prefer_bytecode = case enable_spec of - EnableByteCodeAndObject -> True - EnableByteCode -> True - EnableObject -> False - - generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags - - -- #8180 - when using TemplateHaskell, switch on -dynamic-too so - -- the linker can correctly load the object files. This isn't necessary - -- when using -fexternal-interpreter. - dynamic_too_enable enable_spec ms - | sTargetRTSLinkerOnlySupportsSharedLibs $ settings lcl_dflags = - not isDynWay && not dyn_too_enabled - && enable_object - | otherwise = - hostIsDynamic && not hostIsProfiled && internalInterpreter && - not isDynWay && not isProfWay && not dyn_too_enabled - && enable_object - where - lcl_dflags = ms_hspp_opts ms - internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags - isDynWay = hasWay (ways lcl_dflags) WayDyn - isProfWay = hasWay (ways lcl_dflags) WayProf - enable_object = case enable_spec of - EnableByteCode -> False - EnableByteCodeAndObject -> True - EnableObject -> True - - -- #16331 - when no "internal interpreter" is available but we - -- need to process some TemplateHaskell or QuasiQuotes, we automatically - -- turn on -fexternal-interpreter. - ext_interp_enable ms = not ghciSupported && internalInterpreter - where - lcl_dflags = ms_hspp_opts ms - internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - - (mg, lookup_node) = moduleGraphNodes False mod_graph - - mk_needed_set roots = Set.fromList $ map (mkNodeKey . node_payload) $ reachablesG mg (map (expectJust "needs_th" . lookup_node) roots) - - needs_obj_set, needs_bc_set :: Set.Set NodeKey - needs_obj_set = mk_needed_set need_obj_set - - needs_bc_set = mk_needed_set need_bc_set - - -- A map which tells us how to enable code generation for a NodeKey - needs_codegen_map :: Map.Map NodeKey CodeGenEnable - needs_codegen_map = - -- Another option here would be to just produce object code, rather than both object and - -- byte code - Map.unionWith (\_ _ -> EnableByteCodeAndObject) - (Map.fromList $ [(m, EnableObject) | m <- Set.toList needs_obj_set]) - (Map.fromList $ [(m, EnableByteCode) | m <- Set.toList needs_bc_set]) - - -- The direct dependencies of modules which require object code - need_obj_set = - concat - -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only - -- it's dependencies. - [ deps - | (ModuleNode deps ms) <- mod_graph - , isTemplateHaskellOrQQNonBoot ms - , not (gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms)) - ] - - -- The direct dependencies of modules which require byte code - need_bc_set = - concat - [ deps - | (ModuleNode deps ms) <- mod_graph - , isTemplateHaskellOrQQNonBoot ms - , gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms) - ] - --- | Populate the Downsweep cache with the root modules. -mkRootMap - :: [ModSummary] - -> DownsweepCache -mkRootMap summaries = Map.fromListWith (flip (++)) - [ ((ms_unitid s, NoPkgQual, ms_mnwib s), [Right s]) | s <- summaries ] - ------------------------------------------------------------------------------ --- Summarising modules - --- We have two types of summarisation: --- --- * Summarise a file. This is used for the root module(s) passed to --- cmLoadModules. The file is read, and used to determine the root --- module name. The module name may differ from the filename. --- --- * Summarise a module. We are given a module name, and must provide --- a summary. The finder is used to locate the file in which the module --- resides. - -summariseFile - :: HscEnv - -> HomeUnit - -> M.Map (UnitId, FilePath) ModSummary -- old summaries - -> FilePath -- source file name - -> Maybe Phase -- start phase - -> Maybe (StringBuffer,UTCTime) - -> IO (Either DriverMessages ModSummary) - -summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf - -- we can use a cached summary if one is available and the - -- source file hasn't changed, - | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries - = do - let location = ms_location $ old_summary - - src_hash <- get_src_hash - -- The file exists; we checked in getRootSummary above. - -- If it gets removed subsequently, then this - -- getFileHash may fail, but that's the right - -- behaviour. - - -- return the cached summary if the source didn't change - checkSummaryHash - hsc_env (new_summary src_fn) - old_summary location src_hash - - | otherwise - = do src_hash <- get_src_hash - new_summary src_fn src_hash - where - -- change the main active unit so all operations happen relative to the given unit - hsc_env = hscSetActiveHomeUnit home_unit hsc_env' - -- src_fn does not necessarily exist on the filesystem, so we need to - -- check what kind of target we are dealing with - get_src_hash = case maybe_buf of - Just (buf,_) -> return $ fingerprintStringBuffer buf - Nothing -> liftIO $ getFileHash src_fn - - new_summary src_fn src_hash = runExceptT $ do - preimps@PreprocessedImports {..} - <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf - - let fopts = initFinderOpts (hsc_dflags hsc_env) - src_path = unsafeEncodeUtf src_fn - - is_boot = case takeExtension src_fn of - ".hs-boot" -> IsBoot - ".lhs-boot" -> IsBoot - _ -> NotBoot - - (path_without_boot, hsc_src) - | isHaskellSigFilename src_fn = (src_path, HsigFile) - | IsBoot <- is_boot = (removeBootSuffix src_path, HsBootFile) - | otherwise = (src_path, HsSrcFile) - - -- Make a ModLocation for the Finder, who only has one entry for - -- each @ModuleName@, and therefore needs to use the locations for - -- the non-boot files. - location_without_boot = - mkHomeModLocation fopts pi_mod_name path_without_boot - - -- Make a ModLocation for this file, adding the @-boot@ suffix to - -- all paths if the original was a boot file. - location - | IsBoot <- is_boot - = addBootSuffixLocn location_without_boot - | otherwise - = location_without_boot - - -- Tell the Finder cache where it is, so that subsequent calls - -- to findModule will find it, even if it's not on any search path - mod <- liftIO $ do - let home_unit = hsc_home_unit hsc_env - let fc = hsc_FC hsc_env - addHomeModuleToFinder fc home_unit (GWIB pi_mod_name is_boot) location - - liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary - { nms_src_fn = src_fn - , nms_src_hash = src_hash - , nms_hsc_src = hsc_src - , nms_location = location - , nms_mod = mod - , nms_preimps = preimps - } - -checkSummaryHash - :: HscEnv - -> (Fingerprint -> IO (Either e ModSummary)) - -> ModSummary -> ModLocation -> Fingerprint - -> IO (Either e ModSummary) -checkSummaryHash - hsc_env new_summary - old_summary - location src_hash - | ms_hs_hash old_summary == src_hash && - not (gopt Opt_ForceRecomp (hsc_dflags hsc_env)) = do - -- update the object-file timestamp - obj_timestamp <- modificationTimeIfExists (ml_obj_file location) - - -- We have to repopulate the Finder's cache for file targets - -- because the file might not even be on the regular search path - -- and it was likely flushed in depanal. This is not technically - -- needed when we're called from sumariseModule but it shouldn't - -- hurt. - -- Also, only add to finder cache for non-boot modules as the finder cache - -- makes sure to add a boot suffix for boot files. - _ <- do - let fc = hsc_FC hsc_env - gwib = GWIB (ms_mod old_summary) (isBootSummary old_summary) - case ms_hsc_src old_summary of - HsSrcFile -> addModuleToFinder fc gwib location - _ -> return () - - hi_timestamp <- modificationTimeIfExists (ml_hi_file location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file location) - - return $ Right - ( old_summary - { ms_obj_date = obj_timestamp - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp - } - ) - - | otherwise = - -- source changed: re-summarise. - new_summary src_hash - -data SummariseResult = - FoundInstantiation InstantiatedUnit - | FoundHomeWithError (UnitId, DriverMessages) - | FoundHome ModSummary - | External UnitId - | NotThere - --- Summarise a module, and pick up source and timestamp. -summariseModule - :: HscEnv - -> HomeUnit - -> M.Map (UnitId, FilePath) ModSummary - -- ^ Map of old summaries - -> IsBootInterface -- True <=> a {-# SOURCE #-} import - -> Located ModuleName -- Imported module to be summarised - -> PkgQual - -> Maybe (StringBuffer, UTCTime) - -> [ModuleName] -- Modules to exclude - -> IO SummariseResult - - -summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_pkg - maybe_buf excl_mods - | wanted_mod `elem` excl_mods - = return NotThere - | otherwise = find_it - where - -- Temporarily change the currently active home unit so all operations - -- happen relative to it - hsc_env = hscSetActiveHomeUnit home_unit hsc_env' - dflags = hsc_dflags hsc_env - - find_it :: IO SummariseResult - - find_it = do - found <- findImportedModule hsc_env wanted_mod mb_pkg - case found of - Found location mod - | isJust (ml_hs_file location) -> - -- Home package - just_found location mod - | VirtUnit iud <- moduleUnit mod - , not (isHomeModule home_unit mod) - -> return $ FoundInstantiation iud - | otherwise -> return $ External (moduleUnitId mod) - _ -> return NotThere - -- Not found - -- (If it is TRULY not found at all, we'll - -- error when we actually try to compile) - - just_found location mod = do - -- Adjust location to point to the hs-boot source file, - -- hi file, object file, when is_boot says so - let location' = case is_boot of - IsBoot -> addBootSuffixLocn location - NotBoot -> location - src_fn = expectJust "summarise2" (ml_hs_file location') - - -- Check that it exists - -- It might have been deleted since the Finder last found it - maybe_h <- fileHashIfExists src_fn - case maybe_h of - -- This situation can also happen if we have found the .hs file but the - -- .hs-boot file doesn't exist. - Nothing -> return NotThere - Just h -> do - fresult <- new_summary_cache_check location' mod src_fn h - return $ case fresult of - Left err -> FoundHomeWithError (moduleUnitId mod, err) - Right ms -> FoundHome ms - - new_summary_cache_check loc mod src_fn h - | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) old_summary_map = - - -- check the hash on the source file, and - -- return the cached summary if it hasn't changed. If the - -- file has changed then need to resummarise. - case maybe_buf of - Just (buf,_) -> - checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc (fingerprintStringBuffer buf) - Nothing -> - checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h - | otherwise = new_summary loc mod src_fn h - - new_summary :: ModLocation - -> Module - -> FilePath - -> Fingerprint - -> IO (Either DriverMessages ModSummary) - new_summary location mod src_fn src_hash - = runExceptT $ do - preimps@PreprocessedImports {..} - -- Remember to set the active unit here, otherwise the wrong include paths are passed to CPP - -- See multiHomeUnits_cpp2 test - <- getPreprocessedImports (hscSetActiveUnitId (moduleUnitId mod) hsc_env) src_fn Nothing maybe_buf - - -- NB: Despite the fact that is_boot is a top-level parameter, we - -- don't actually know coming into this function what the HscSource - -- of the module in question is. This is because we may be processing - -- this module because another module in the graph imported it: in this - -- case, we know if it's a boot or not because of the {-# SOURCE #-} - -- annotation, but we don't know if it's a signature or a regular - -- module until we actually look it up on the filesystem. - let hsc_src - | is_boot == IsBoot = HsBootFile - | isHaskellSigFilename src_fn = HsigFile - | otherwise = HsSrcFile - - when (pi_mod_name /= moduleName mod) $ - throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc - $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod) - - let instantiations = homeUnitInstantiations home_unit - when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $ - throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc - $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations - - liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary - { nms_src_fn = src_fn - , nms_src_hash = src_hash - , nms_hsc_src = hsc_src - , nms_location = location - , nms_mod = mod - , nms_preimps = preimps - } - --- | Convenience named arguments for 'makeNewModSummary' only used to make --- code more readable, not exported. -data MakeNewModSummary - = MakeNewModSummary - { nms_src_fn :: FilePath - , nms_src_hash :: Fingerprint - , nms_hsc_src :: HscSource - , nms_location :: ModLocation - , nms_mod :: Module - , nms_preimps :: PreprocessedImports - } - -makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ModSummary -makeNewModSummary hsc_env MakeNewModSummary{..} = do - let PreprocessedImports{..} = nms_preimps - obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location) - dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location) - hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location) - hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location) - - extra_sig_imports <- findExtraSigImports hsc_env nms_hsc_src pi_mod_name - (implicit_sigs, _inst_deps) <- implicitRequirementsShallow (hscSetActiveUnitId (moduleUnitId nms_mod) hsc_env) pi_theimps - - return $ - ModSummary - { ms_mod = nms_mod - , ms_hsc_src = nms_hsc_src - , ms_location = nms_location - , ms_hspp_file = pi_hspp_fn - , ms_hspp_opts = pi_local_dflags - , ms_hspp_buf = Just pi_hspp_buf - , ms_parsed_mod = Nothing - , ms_srcimps = pi_srcimps - , ms_ghc_prim_import = pi_ghc_prim_import - , ms_textual_imps = - ((,) NoPkgQual . noLoc <$> extra_sig_imports) ++ - ((,) NoPkgQual . noLoc <$> implicit_sigs) ++ - pi_theimps - , ms_hs_hash = nms_src_hash - , ms_iface_date = hi_timestamp - , ms_hie_date = hie_timestamp - , ms_obj_date = obj_timestamp - , ms_dyn_obj_date = dyn_obj_timestamp - } - -data PreprocessedImports - = PreprocessedImports - { pi_local_dflags :: DynFlags - , pi_srcimps :: [(PkgQual, Located ModuleName)] - , pi_theimps :: [(PkgQual, Located ModuleName)] - , pi_ghc_prim_import :: Bool - , pi_hspp_fn :: FilePath - , pi_hspp_buf :: StringBuffer - , pi_mod_name_loc :: SrcSpan - , pi_mod_name :: ModuleName - } - --- Preprocess the source file and get its imports --- The pi_local_dflags contains the OPTIONS pragmas -getPreprocessedImports - :: HscEnv - -> FilePath - -> Maybe Phase - -> Maybe (StringBuffer, UTCTime) - -- ^ optional source code buffer and modification time - -> ExceptT DriverMessages IO PreprocessedImports -getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do - (pi_local_dflags, pi_hspp_fn) - <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn - (pi_srcimps', pi_theimps', pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name) - <- ExceptT $ do - let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags - popts = initParserOpts pi_local_dflags - mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn - return (first (mkMessages . fmap mkDriverPsHeaderMessage . getMessages) mimps) - let rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) - let rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) - let pi_srcimps = rn_imps pi_srcimps' - let pi_theimps = rn_imps pi_theimps' - return PreprocessedImports {..} - - ------------------------------------------------------------------------------ --- Error messages ------------------------------------------------------------------------------ - --- Defer and group warning, error and fatal messages so they will not get lost --- in the regular output. -withDeferredDiagnostics :: GhcMonad m => m a -> m a -withDeferredDiagnostics f = do - dflags <- getDynFlags - if not $ gopt Opt_DeferDiagnostics dflags - then f - else do - warnings <- liftIO $ newIORef [] - errors <- liftIO $ newIORef [] - fatals <- liftIO $ newIORef [] - logger <- getLogger - - let deferDiagnostics _dflags !msgClass !srcSpan !msg = do - let action = logMsg logger msgClass srcSpan msg - case msgClass of - MCDiagnostic SevWarning _reason _code - -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) - MCDiagnostic SevError _reason _code - -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) - MCFatal - -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) - _ -> action - - printDeferredDiagnostics = liftIO $ - forM_ [warnings, errors, fatals] $ \ref -> do - -- This IORef can leak when the dflags leaks, so let us always - -- reset the content. The lazy variant is used here as we want to force - -- this error if the IORef is ever accessed again, rather than now. - -- See #20981 for an issue which discusses this general issue. - let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] - actions <- atomicModifyIORef ref $ \i -> (landmine, i) - sequence_ $ reverse actions - - MC.bracket - (pushLogHookM (const deferDiagnostics)) - (\_ -> popLogHookM >> printDeferredDiagnostics) - (\_ -> f) - -noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage --- ToDo: we don't have a proper line number for this error -noModError hsc_env loc wanted_mod err - = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ - DriverInterfaceError $ - (Can'tFindInterface (cannotFindModule hsc_env wanted_mod err) (LookingForModule wanted_mod NotBoot)) - -{- -noHsFileErr :: SrcSpan -> String -> DriverMessages -noHsFileErr loc path - = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path) - -} - -moduleNotFoundErr :: ModuleName -> DriverMessages -moduleNotFoundErr mod = singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (DriverModuleNotFound mod) - -multiRootsErr :: [ModSummary] -> IO () -multiRootsErr [] = panic "multiRootsErr" -multiRootsErr summs@(summ1:_) - = throwOneError $ fmap GhcDriverMessage $ - mkPlainErrorMsgEnvelope noSrcSpan $ DriverDuplicatedModuleDeclaration mod files - where - mod = ms_mod summ1 - files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs - -cyclicModuleErr :: [ModuleGraphNode] -> MsgEnvelope GhcMessage --- From a strongly connected component we find --- a single cycle to report -cyclicModuleErr mss - = assert (not (null mss)) $ - case findCycle graph of - Nothing -> pprPanic "Unexpected non-cycle" (ppr mss) - Just path -> mkPlainErrorMsgEnvelope src_span $ - GhcDriverMessage $ DriverModuleGraphCycle path - where - src_span = maybe noSrcSpan (mkFileSrcSpan . ms_location) (moduleGraphNodeModSum (head path)) - where - graph :: [Node NodeKey ModuleGraphNode] - graph = - [ DigraphNode - { node_payload = ms - , node_key = mkNodeKey ms - , node_dependencies = nodeDependencies False ms - } - | ms <- mss - ] - -cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () -cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = - if gopt Opt_KeepTmpFiles dflags - then liftIO $ keepCurrentModuleTempFiles logger tmpfs - else liftIO $ cleanCurrentModuleTempFiles logger tmpfs - - -addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv -addDepsToHscEnv deps hsc_env = - hscUpdateHUG (\hug -> foldr addHomeModInfoToHug hug deps) hsc_env - -setHPT :: HomePackageTable -> HscEnv -> HscEnv -setHPT deps hsc_env = - hscUpdateHPT (const $ deps) hsc_env - -setHUG :: HomeUnitGraph -> HscEnv -> HscEnv -setHUG deps hsc_env = - hscUpdateHUG (const $ deps) hsc_env - --- | Wrap an action to catch and handle exceptions. -wrapAction :: (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a) -wrapAction msg_wrapper hsc_env k = do - let lcl_logger = hsc_logger hsc_env - lcl_dynflags = hsc_dflags hsc_env - print_config = initPrintConfig lcl_dynflags - let logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (msg_wrapper <$> srcErrorMessages err) - -- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle - -- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches` - -- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to - -- internally using forkIO. - mres <- MC.try $ liftIO $ prettyPrintGhcErrors lcl_logger $ k - case mres of - Right res -> return $ Just res - Left exc -> do - case fromException exc of - Just (err :: SourceError) - -> logg err - Nothing -> case fromException exc of - -- ThreadKilled in particular needs to actually kill the thread. - -- So rethrow that and the other async exceptions - Just (err :: SomeAsyncException) -> throwIO err - _ -> errorMsg lcl_logger (text (show exc)) - return Nothing - -withParLog :: TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b -withParLog lqq_var k cont = do - let init_log = do - -- Make a new log queue - lq <- newLogQueue k - -- Add it into the LogQueueQueue - atomically $ initLogQueue lqq_var lq - return lq - finish_log lq = liftIO (finishLogQueue lq) - MC.bracket init_log finish_log $ \lq -> cont (pushLogHook (const (parLogAction lq))) - -withLoggerHsc :: Int -> MakeEnv -> (HscEnv -> IO a) -> IO a -withLoggerHsc k MakeEnv{withLogger, hsc_env} cont = do - withLogger k $ \modifyLogger -> do - let lcl_logger = modifyLogger (hsc_logger hsc_env) - hsc_env' = hsc_env { hsc_logger = lcl_logger } - -- Run continuation with modified logger - cont hsc_env' - - -executeInstantiationNode :: Int - -> Int - -> HomeUnitGraph - -> UnitId - -> InstantiatedUnit - -> RunMakeM () -executeInstantiationNode k n deps uid iu = do - env <- ask - -- Output of the logger is mediated by a central worker to - -- avoid output interleaving - msg <- asks env_messager - wrapper <- asks diag_wrapper - lift $ MaybeT $ withLoggerHsc k env $ \hsc_env -> - let lcl_hsc_env = setHUG deps hsc_env - in wrapAction wrapper lcl_hsc_env $ do - res <- upsweep_inst lcl_hsc_env msg k n uid iu - cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) - return res - - -executeCompileNode :: Int - -> Int - -> Maybe HomeModInfo - -> HomeUnitGraph - -> Maybe [ModuleName] -- List of modules we need to rehydrate before compiling - -> ModSummary - -> RunMakeM HomeModInfo -executeCompileNode k n !old_hmi hug mrehydrate_mods mod = do - me@MakeEnv{..} <- ask - -- Rehydrate any dependencies if this module had a boot file or is a signature file. - lift $ MaybeT (withAbstractSem compile_sem $ withLoggerHsc k me $ \hsc_env -> do - hydrated_hsc_env <- liftIO $ maybeRehydrateBefore (setHUG hug hsc_env) mod fixed_mrehydrate_mods - let -- Use the cached DynFlags which includes OPTIONS_GHC pragmas - lcl_dynflags = ms_hspp_opts mod - let lcl_hsc_env = - -- Localise the hsc_env to use the cached flags - hscSetFlags lcl_dynflags $ - hydrated_hsc_env - -- Compile the module, locking with a semaphore to avoid too many modules - -- being compiled at the same time leading to high memory usage. - wrapAction diag_wrapper lcl_hsc_env $ do - res <- upsweep_mod lcl_hsc_env env_messager old_hmi mod k n - cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) lcl_dynflags - return res) - - where - fixed_mrehydrate_mods = - case ms_hsc_src mod of - -- MP: It is probably a bit of a misimplementation in backpack that - -- compiling a signature requires an knot_var for that unit. - -- If you remove this then a lot of backpack tests fail. - HsigFile -> Just [] - _ -> mrehydrate_mods - -{- Rehydration, see Note [Rehydrating Modules] -} - -rehydrate :: HscEnv -- ^ The HPT in this HscEnv needs rehydrating. - -> [HomeModInfo] -- ^ These are the modules we want to rehydrate. - -> IO HscEnv -rehydrate hsc_env hmis = do - debugTraceMsg logger 2 $ ( - text "Re-hydrating loop: " <+> (ppr (map (mi_module . hm_iface) hmis))) - new_mods <- fixIO $ \new_mods -> do - let new_hpt = addListToHpt old_hpt new_mods - let new_hsc_env = hscUpdateHPT_lazy (const new_hpt) hsc_env - mds <- initIfaceCheck (text "rehydrate") new_hsc_env $ - mapM (typecheckIface . hm_iface) hmis - let new_mods = [ (mn,hmi{ hm_details = details }) - | (hmi,details) <- zip hmis mds - , let mn = moduleName (mi_module (hm_iface hmi)) ] - return new_mods - return $ setHPT (foldl' (\old (mn, hmi) -> addToHpt old mn hmi) old_hpt new_mods) hsc_env - - where - logger = hsc_logger hsc_env - to_delete = (map (moduleName . mi_module . hm_iface) hmis) - -- Filter out old modules before tying the knot, otherwise we can end - -- up with a thunk which keeps reference to the old HomeModInfo. - !old_hpt = foldl' delFromHpt (hsc_HPT hsc_env) to_delete - --- If needed, then rehydrate the necessary modules with a suitable KnotVars for the --- module currently being compiled. -maybeRehydrateBefore :: HscEnv -> ModSummary -> Maybe [ModuleName] -> IO HscEnv -maybeRehydrateBefore hsc_env _ Nothing = return hsc_env -maybeRehydrateBefore hsc_env mod (Just mns) = do - knot_var <- initialise_knot_var hsc_env - let hmis = map (expectJust "mr" . lookupHpt (hsc_HPT hsc_env)) mns - rehydrate (hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv knot_var }) hmis - - where - initialise_knot_var hsc_env = liftIO $ - let mod_name = homeModuleInstantiation (hsc_home_unit_maybe hsc_env) (ms_mod mod) - in mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv - -rehydrateAfter :: HscEnv - -> [ModuleName] - -> IO [HomeModInfo] -rehydrateAfter new_hsc mns = do - let new_hpt = hsc_HPT new_hsc - hmis = map (expectJust "mrAfter" . lookupHpt new_hpt) mns - hsc_env <- rehydrate (new_hsc { hsc_type_env_vars = emptyKnotVars }) hmis - return $ map (\mn -> expectJust "rehydrate" $ lookupHpt (hsc_HPT hsc_env) mn) mns - -{- -Note [Hydrating Modules] -~~~~~~~~~~~~~~~~~~~~~~~~ -There are at least 4 different representations of an interface file as described -by this diagram. - ------------------------------- -| On-disk M.hi | ------------------------------- - | ^ - | Read file | Write file - V | -------------------------------- -| ByteString | -------------------------------- - | ^ - | Binary.get | Binary.put - V | --------------------------------- -| ModIface (an acyclic AST) | --------------------------------- - | ^ - | hydrate | mkIfaceTc - V | ---------------------------------- -| ModDetails (lots of cycles) | ---------------------------------- - -The last step, converting a ModIface into a ModDetails is known as "hydration". - -Hydration happens in three different places - -* When an interface file is initially loaded from disk, it has to be hydrated. -* When a module is finished compiling, we hydrate the ModIface in order to generate - the version of ModDetails which exists in memory (see Note [ModDetails and --make mode]) -* When dealing with boot files and module loops (see Note [Rehydrating Modules]) - -Note [Rehydrating Modules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If a module has a boot file then it is critical to rehydrate the modules on -the path between the two (see #20561). - -Suppose we have ("R" for "recursive"): -``` -R.hs-boot: module R where - data T - g :: T -> T - -A.hs: module A( f, T, g ) where - import {-# SOURCE #-} R - data S = MkS T - f :: T -> S = ...g... - -R.hs: module R where - import A - data T = T1 | T2 S - g = ...f... -``` - -== Why we need to rehydrate A's ModIface before compiling R.hs - -After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type -type uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same -AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about -it.) - -When compiling R.hs, we build a TyCon for `T`. But that TyCon mentions `S`, and -it currently has an AbstractTyCon for `T` inside it. But we want to build a -fully cyclic structure, in which `S` refers to `T` and `T` refers to `S`. - -Solution: **rehydration**. *Before compiling `R.hs`*, rehydrate all the -ModIfaces below it that depend on R.hs-boot. To rehydrate a ModIface, call -`typecheckIface` to convert it to a ModDetails. It's just a de-serialisation -step, no type inference, just lookups. - -Now `S` will be bound to a thunk that, when forced, will "see" the final binding -for `T`; see [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot). -But note that this must be done *before* compiling R.hs. - -== Why we need to rehydrate A's ModIface after compiling R.hs - -When compiling R.hs, the knot-tying stuff above will ensure that `f`'s unfolding -mentions the `LocalId` for `g`. But when we finish R, we carefully ensure that -all those `LocalIds` are turned into completed `GlobalIds`, replete with -unfoldings etc. Alas, that will not apply to the occurrences of `g` in `f`'s -unfolding. And if we leave matters like that, they will stay that way, and *all* -subsequent modules that import A will see a crippled unfolding for `f`. - -Solution: rehydrate both R and A's ModIface together, right after completing R.hs. - -~~ Which modules to rehydrate - -We only need rehydrate modules that are -* Below R.hs -* Above R.hs-boot - -There might be many unrelated modules (in the home package) that don't need to be -rehydrated. - -== Loops with multiple boot files - -It is possible for a module graph to have a loop (SCC, when ignoring boot files) -which requires multiple boot files to break. In this case, we must perform -several hydration steps: - 1. The hydration steps described above, which are necessary for correctness. - 2. An extra hydration step at the end of compiling the entire SCC, in order to - remove space leaks, as we explain below. - -Consider the following example: - - ┌─────┐ ┌─────┐ - │ A │ │ B │ - └──┬──┘ └──┬──┘ - │ │ - ┌───▼───────────▼───┐ - │ C │ - └───┬───────────┬───┘ - │ │ - ┌────▼───┐ ┌───▼────┐ - │ A-boot │ │ B-boot │ - └────────┘ └────────┘ - -A, B and C live together in a SCC. Suppose that we compile the modules in the -order: - - A-boot, B-boot, C, A, B. - -When we come to compile A, we will perform the necessary hydration steps, -because A has a boot file. This means that C will be hydrated relative to A, -and the ModDetails for A will reference C/A. Then, when B is compiled, -C will be rehydrated again, and so B will reference C/A,B. At this point, -its interface will be hydrated relative to both A and B. -This causes a space leak: there are now two different copies of C's ModDetails, -kept alive by modules A and B. This is especially problematic if C is large. - -The way to avoid this space leak is to rehydrate an entire SCC together at the -end of compilation, so that all the ModDetails point to interfaces for .hs files. -In this example, when we hydrate A, B and C together, then both A and B will refer to -C/A,B. - -See #21900 for some more discussion. - -== Modules "above" the loop - -This dark corner is the subject of #14092. - -Suppose we add to our example -``` -X.hs module X where - import A - data XT = MkX T - fx = ...g... -``` -If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the argument type of `MkX`. So: - -* Either we should delay compiling X until after R has been compiled. (This is what we do) -* Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot. - -Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode. -#20200 has lots of issues, many of them now fixed; -this particular issue starts [here](https://gitlab.haskell.org/ghc/ghc/-/issues/20200#note_385758). - -The wiki page [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot) is helpful. -Also closely related are - * #14092 - * #14103 - --} - -executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM () -executeLinkNode hug kn uid deps = do - withCurrentUnit uid $ do - MakeEnv{..} <- ask - let dflags = hsc_dflags hsc_env - let hsc_env' = setHUG hug hsc_env - msg' = (\messager -> \recomp -> messager hsc_env kn recomp (LinkNode deps uid)) <$> env_messager - - linkresult <- liftIO $ withAbstractSem compile_sem $ do - link (ghcLink dflags) - (hsc_logger hsc_env') - (hsc_tmpfs hsc_env') - (hsc_FC hsc_env') - (hsc_hooks hsc_env') - dflags - (hsc_unit_env hsc_env') - True -- We already decided to link - msg' - (hsc_HPT hsc_env') - case linkresult of - Failed -> fail "Link Failed" - Succeeded -> return () - -{- -Note [ModuleNameSet, efficiency and space leaks] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -During upsweep, the results of compiling modules are placed into a MVar. When we need -to compute the right compilation environment for a module, we consult this MVar and -set the HomeUnitGraph accordingly. This is done to avoid having to precisely track -module dependencies and recreating the HUG from scratch each time, which is very expensive. - -In serial mode (-j1), this all works out fine: a module can only be compiled -after its dependencies have finished compiling, and compilation can't be -interleaved with the compilation of other module loops. This ensures that -the HUG only ever contains finalised interfaces. - -In parallel mode, we have to be more careful: the HUG variable can contain non-finalised -interfaces, which have been started by another thread. In order to avoid a space leak -in which a finalised interface is compiled against a HPT which contains a non-finalised -interface, we have to restrict the HUG to only contain the visible modules. - -The collection of visible modules explains which transitive modules are visible -from a certain point. It is recorded in the ModuleNameSet. -Before a module is compiled, we use this set to restrict the HUG to the visible -modules only, avoiding this tricky space leak. - -Efficiency of the ModuleNameSet is of utmost importance, because a union occurs for -each edge in the module graph. To achieve this, the set is represented directly as an IntSet, -which provides suitable performance – even using a UniqSet (which is backed by an IntMap) is -too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. - -See test "jspace" for an example which used to trigger this problem. - --} - --- See Note [ModuleNameSet, efficiency and space leaks] -type ModuleNameSet = M.Map UnitId W.Word64Set - -addToModuleNameSet :: UnitId -> ModuleName -> ModuleNameSet -> ModuleNameSet -addToModuleNameSet uid mn s = - let k = (getKey $ getUnique $ mn) - in M.insertWith (W.union) uid (W.singleton k) s - --- | Wait for some dependencies to finish and then read from the given MVar. -wait_deps_hug :: MVar HomeUnitGraph -> [BuildResult] -> ReaderT MakeEnv (MaybeT IO) (HomeUnitGraph, ModuleNameSet) -wait_deps_hug hug_var deps = do - (_, module_deps) <- wait_deps deps - hug <- liftIO $ readMVar hug_var - let pruneHomeUnitEnv uid hme = - let -- Restrict to things which are in the transitive closure to avoid retaining - -- reference to loop modules which have already been compiled by other threads. - -- See Note [ModuleNameSet, efficiency and space leaks] - !new = udfmRestrictKeysSet (homeUnitEnv_hpt hme) (fromMaybe W.empty $ M.lookup uid module_deps) - in hme { homeUnitEnv_hpt = new } - return (unitEnv_mapWithKey pruneHomeUnitEnv hug, module_deps) - --- | Wait for dependencies to finish, and then return their results. -wait_deps :: [BuildResult] -> RunMakeM ([HomeModInfo], ModuleNameSet) -wait_deps [] = return ([], M.empty) -wait_deps (x:xs) = do - (res, deps) <- lift $ waitResult (resultVar x) - (hmis, all_deps) <- wait_deps xs - let !new_deps = deps `unionModuleNameSet` all_deps - case res of - Nothing -> return (hmis, new_deps) - Just hmi -> return (hmi:hmis, new_deps) - where - unionModuleNameSet = M.unionWith W.union - - --- Executing the pipelines - - -label_self :: String -> IO () -label_self thread_name = do - self_tid <- CC.myThreadId - CC.labelThread self_tid thread_name - - -runPipelines :: WorkerLimit -> HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () --- Don't even initialise plugins if there are no pipelines -runPipelines n_job hsc_env diag_wrapper mHscMessager all_pipelines = do - liftIO $ label_self "main --make thread" - case n_job of - NumProcessorsLimit n | n <= 1 -> runSeqPipelines hsc_env diag_wrapper mHscMessager all_pipelines - _n -> runParPipelines n_job hsc_env diag_wrapper mHscMessager all_pipelines - -runSeqPipelines :: HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () -runSeqPipelines plugin_hsc_env diag_wrapper mHscMessager all_pipelines = - let env = MakeEnv { hsc_env = plugin_hsc_env - , withLogger = \_ k -> k id - , compile_sem = AbstractSem (return ()) (return ()) - , env_messager = mHscMessager - , diag_wrapper = diag_wrapper - } - in runAllPipelines (NumProcessorsLimit 1) env all_pipelines - -runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a -runNjobsAbstractSem n_jobs action = do - compile_sem <- newQSem n_jobs - n_capabilities <- getNumCapabilities - n_cpus <- getNumProcessors - let - asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) - set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n - updNumCapabilities = do - -- Setting number of capabilities more than - -- CPU count usually leads to high userspace - -- lock contention. #9221 - set_num_caps $ min n_jobs n_cpus - resetNumCapabilities = set_num_caps n_capabilities - MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem - -runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a -runWorkerLimit worker_limit action = case worker_limit of - NumProcessorsLimit n_jobs -> - runNjobsAbstractSem n_jobs action - JSemLimit sem -> - runJSemAbstractSem sem action - --- | Build and run a pipeline -runParPipelines :: WorkerLimit -- ^ How to limit work parallelism - -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module - -> (GhcMessage -> AnyGhcDiagnostic) - -> Maybe Messager -- ^ Optional custom messager to use to report progress - -> [MakeAction] -- ^ The build plan for all the module nodes - -> IO () -runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipelines = do - - - -- A variable which we write to when an error has happened and we have to tell the - -- logging thread to gracefully shut down. - stopped_var <- newTVarIO False - -- The queue of LogQueues which actions are able to write to. When an action starts it - -- will add it's LogQueue into this queue. - log_queue_queue_var <- newTVarIO newLogQueueQueue - -- Thread which coordinates the printing of logs - wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var - - - -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. - thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) - let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } - - runWorkerLimit worker_limit $ \abstract_sem -> do - let env = MakeEnv { hsc_env = thread_safe_hsc_env - , withLogger = withParLog log_queue_queue_var - , compile_sem = abstract_sem - , env_messager = mHscMessager - , diag_wrapper = diag_wrapper - } - -- Reset the number of capabilities once the upsweep ends. - runAllPipelines worker_limit env all_pipelines - atomically $ writeTVar stopped_var True - wait_log_thread - -withLocalTmpFS :: TmpFs -> (TmpFs -> IO a) -> IO a -withLocalTmpFS tmpfs act = do - let initialiser = do - liftIO $ forkTmpFsFrom tmpfs - finaliser tmpfs_local = do - liftIO $ mergeTmpFsInto tmpfs_local tmpfs - -- Add remaining files which weren't cleaned up into local tmp fs for - -- clean-up later. - -- Clear the logQueue if this node had it's own log queue - MC.bracket initialiser finaliser act - -withLocalTmpFSMake :: MakeEnv -> (MakeEnv -> IO a) -> IO a -withLocalTmpFSMake env k = - withLocalTmpFS (hsc_tmpfs (hsc_env env)) $ \lcl_tmpfs - -> k (env { hsc_env = (hsc_env env) { hsc_tmpfs = lcl_tmpfs }}) - - --- | Run the given actions and then wait for them all to finish. -runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () -runAllPipelines worker_limit env acts = do - let single_worker = isWorkerLimitSequential worker_limit - spawn_actions :: IO [ThreadId] - spawn_actions = if single_worker - then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) - else runLoop forkIOWithUnmask env acts - - kill_actions :: [ThreadId] -> IO () - kill_actions tids = mapM_ killThread tids - - MC.bracket spawn_actions kill_actions $ \_ -> do - mapM_ waitMakeAction acts - --- | Execute each action in order, limiting the amount of parallelism by the given --- semaphore. -runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a] -runLoop _ _env [] = return [] -runLoop fork_thread env (MakeAction act res_var :acts) = do - - -- withLocalTmpFs has to occur outside of fork to remain deterministic - new_thread <- withLocalTmpFSMake env $ \lcl_env -> - fork_thread $ \unmask -> (do - mres <- (unmask $ run_pipeline lcl_env act) - `MC.onException` (putMVar res_var Nothing) -- Defensive: If there's an unhandled exception then still signal the failure. - putMVar res_var mres) - threads <- runLoop fork_thread env acts - return (new_thread : threads) - where - run_pipeline :: MakeEnv -> RunMakeM a -> IO (Maybe a) - run_pipeline env p = runMaybeT (runReaderT p env) - -data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a)) - -waitMakeAction :: MakeAction -> IO () -waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar - -{- Note [GHC Heap Invariants] - ~~~~~~~~~~~~~~~~~~~~~~~~~~ -This note is a general place to explain some of the heap invariants which should -hold for a program compiled with --make mode. These invariants are all things -which can be checked easily using ghc-debug. - -1. No HomeModInfo are reachable via the EPS. - Why? Interfaces are lazily loaded into the EPS and the lazy thunk retains - a reference to the entire HscEnv, if we are not careful the HscEnv will - contain the HomePackageTable at the time the interface was loaded and - it will never be released. - Where? dontLeakTheHUG in GHC.Iface.Load - -2. No KnotVars are live at the end of upsweep (#20491) - Why? KnotVars contains an old stale reference to the TypeEnv for modules - which participate in a loop. At the end of a loop all the KnotVars references - should be removed by the call to typecheckLoop. - Where? typecheckLoop in GHC.Driver.Make. - -3. Immediately after a reload, no ModDetails are live. - Why? During the upsweep all old ModDetails are replaced with a new ModDetails - generated from a ModIface. If we don't clear the ModDetails before the - reload takes place then memory usage during the reload is twice as much - as it should be as we retain a copy of the ModDetails for too long. - Where? pruneCache in GHC.Driver.Make - -4. No TcGblEnv or TcLclEnv are live after typechecking is completed. - Why? By the time we get to simplification all the data structures from typechecking - should be eliminated. - Where? No one place in the compiler. These leaks can be introduced by not suitable - forcing functions which take a TcLclEnv as an argument. - -5. At the end of a successful upsweep, the number of live ModDetails equals the - number of non-boot Modules. - Why? Each module has a HomeModInfo which contains a ModDetails from that module. - Where? See Note [ModuleNameSet, efficiency and space leaks], a variety of places - in the driver are responsible. +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ViewPatterns #-} + +-- ----------------------------------------------------------------------------- +-- +-- (c) The University of Glasgow, 2011 +-- +-- This module implements multi-module compilation, and is used +-- by --make and GHCi. +-- +-- ----------------------------------------------------------------------------- +module GHC.Driver.Make ( + depanal, depanalE, depanalPartial, + load, loadWithCache, load', AnyGhcDiagnostic, LoadHowMuch(..), ModIfaceCache(..), noIfaceCache, newIfaceCache, + + downsweep, + + topSortModuleGraph, + + ms_home_srcimps, ms_home_imps, + + hscSourceToIsBoot, + findExtraSigImports, + implicitRequirementsShallow, + + noModError, cyclicModuleErr, + SummaryNode, + IsBootInterface(..), mkNodeKey, + + ModNodeKey, ModNodeKeyWithUid(..), + ModNodeMap(..), emptyModNodeMap, modNodeMapElems, modNodeMapLookup, modNodeMapInsert, modNodeMapSingleton, modNodeMapUnionWith, + + -- * Re-exports from Downsweep + checkHomeUnitsClosed, + summariseModule, + summariseModuleInterface, + SummariseResult(..), + summariseFile, + + instantiationNodes, + ) where + +import GHC.Prelude +import GHC.Platform + +import GHC.Tc.Utils.Backpack +import GHC.Tc.Utils.Monad ( initIfaceCheck, concatMapM ) + +import GHC.Runtime.Interpreter +import qualified GHC.Linker.Loader as Linker +import GHC.Linker.Types + + +import GHC.Driver.Config.Diagnostic +import GHC.Driver.Pipeline +import GHC.Driver.Session +import GHC.Driver.DynFlags (ReexportedModule(..)) +import GHC.Driver.Monad +import GHC.Driver.Env +import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Main +import GHC.Driver.MakeSem +import GHC.Driver.Downsweep +import GHC.Driver.MakeAction + +import GHC.ByteCode.Types + +import GHC.Iface.Load ( cannotFindModule, readIface ) +import GHC.IfaceToCore ( typecheckIface ) +import GHC.Iface.Recomp ( RecompileRequired(..), CompileReason(..) ) + +import GHC.Data.Bag ( listToBag ) +import GHC.Data.Graph.Directed +import GHC.Data.Maybe ( expectJust ) + +import GHC.Utils.Exception ( throwIO, SomeAsyncException ) +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Misc +import GHC.Utils.Error +import GHC.Utils.Logger +import GHC.Utils.TmpFs + +import GHC.Types.Basic +import GHC.Types.Error +import GHC.Types.Target +import GHC.Types.SourceFile +import GHC.Types.SourceError +import GHC.Types.SrcLoc +import GHC.Types.PkgQual + +import GHC.Unit +import GHC.Unit.Env +import GHC.Unit.Finder +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Graph +import GHC.Unit.Home.ModInfo +import GHC.Unit.Module.ModDetails + +import qualified Data.Map as Map +import qualified Data.Set as Set + +import Control.Concurrent.MVar +import Control.Monad +import qualified Control.Monad.Catch as MC +import Data.IORef +import Data.Maybe +import Data.List (sortOn, groupBy, sortBy) +import qualified Data.List as List +import System.FilePath + +import Control.Monad.IO.Class +import Control.Monad.Trans.Reader +import qualified Data.Map.Strict as M +import GHC.Types.TypeEnv +import Control.Monad.Trans.State.Lazy +import Control.Monad.Trans.Class +import GHC.Driver.Env.KnotVars +import Control.Monad.Trans.Maybe +import GHC.Runtime.Loader +import GHC.Utils.Constants +import GHC.Iface.Errors.Types +import Data.Function +import qualified GHC.Data.Maybe as M + +import GHC.Data.Graph.Directed.Reachability +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Home.PackageTable + +-- ----------------------------------------------------------------------------- +-- Loading the program + +-- | Perform a dependency analysis starting from the current targets +-- and update the session with the new module graph. +-- +-- Dependency analysis entails parsing the @import@ directives and may +-- therefore require running certain preprocessors. +-- +-- Note that each 'ModSummary' in the module graph caches its 'DynFlags'. +-- These 'DynFlags' are determined by the /current/ session 'DynFlags' and the +-- @OPTIONS@ and @LANGUAGE@ pragmas of the parsed module. Thus if you want +-- changes to the 'DynFlags' to take effect you need to call this function +-- again. +-- In case of errors, just throw them. +-- +depanal :: GhcMonad m => + [ModuleName] -- ^ excluded modules + -> Bool -- ^ allow duplicate roots + -> m ModuleGraph +depanal excluded_mods allow_dup_roots = do + (errs, mod_graph) <- depanalE mkUnknownDiagnostic Nothing excluded_mods allow_dup_roots + if isEmptyMessages errs + then pure mod_graph + else throwErrors (fmap GhcDriverMessage errs) + +-- | Perform dependency analysis like in 'depanal'. +-- In case of errors, the errors and an empty module graph are returned. +depanalE :: GhcMonad m => -- New for #17459 + (GhcMessage -> AnyGhcDiagnostic) + -> Maybe Messager + -> [ModuleName] -- ^ excluded modules + -> Bool -- ^ allow duplicate roots + -> m (DriverMessages, ModuleGraph) +depanalE diag_wrapper msg excluded_mods allow_dup_roots = do + hsc_env <- getSession + (errs, mod_graph) <- depanalPartial diag_wrapper msg excluded_mods allow_dup_roots + if isEmptyMessages errs + then do + hsc_env <- getSession + let one_unit_messages get_mod_errs k hue = do + errs <- get_mod_errs + unknown_module_err <- warnUnknownModules (hscSetActiveUnitId k hsc_env) (homeUnitEnv_dflags hue) mod_graph + + let unused_home_mod_err = warnMissingHomeModules (homeUnitEnv_dflags hue) (hsc_targets hsc_env) mod_graph + unused_pkg_err = warnUnusedPackages (homeUnitEnv_units hue) (homeUnitEnv_dflags hue) mod_graph + + + return $ errs `unionMessages` unused_home_mod_err + `unionMessages` unused_pkg_err + `unionMessages` unknown_module_err + + all_errs <- liftIO $ HUG.unitEnv_foldWithKey one_unit_messages (return emptyMessages) (hsc_HUG hsc_env) + logDiagnostics (GhcDriverMessage <$> all_errs) + setSession (setModuleGraph mod_graph hsc_env) + pure (emptyMessages, mod_graph) + else do + -- We don't have a complete module dependency graph, + -- The graph may be disconnected and is unusable. + setSession (setModuleGraph emptyMG hsc_env) + pure (errs, emptyMG) + + +-- | Perform dependency analysis like 'depanal' but return a partial module +-- graph even in the face of problems with some modules. +-- +-- Modules which have parse errors in the module header, failing +-- preprocessors or other issues preventing them from being summarised will +-- simply be absent from the returned module graph. +-- +-- Unlike 'depanal' this function will not update 'hsc_mod_graph' with the +-- new module graph. +depanalPartial + :: GhcMonad m + => (GhcMessage -> AnyGhcDiagnostic) + -> Maybe Messager + -> [ModuleName] -- ^ excluded modules + -> Bool -- ^ allow duplicate roots + -> m (DriverMessages, ModuleGraph) + -- ^ possibly empty 'Bag' of errors and a module graph. +depanalPartial diag_wrapper msg excluded_mods allow_dup_roots = do + hsc_env <- getSession + let + targets = hsc_targets hsc_env + old_graph = hsc_mod_graph hsc_env + logger = hsc_logger hsc_env + + withTiming logger (text "Chasing dependencies") (const ()) $ do + liftIO $ debugTraceMsg logger 2 (hcat [ + text "Chasing modules from: ", + hcat (punctuate comma (map pprTarget targets))]) + + -- Home package modules may have been moved or deleted, and new + -- source files may have appeared in the home package that shadow + -- external package modules, so we have to discard the existing + -- cached finder data. + liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env) + + (errs, mod_graph) <- liftIO $ downsweep + hsc_env diag_wrapper msg (mgModSummaries old_graph) + excluded_mods allow_dup_roots + return (unionManyMessages errs, mod_graph) + + +-- Note [Missing home modules] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Sometimes we don't want GHC to process modules that weren't specified as +-- explicit targets. For example, cabal may want to enable this warning +-- when building a library, so that GHC warns the user about modules listed +-- neither in `exposed-modules` nor in `other-modules`. +-- +-- Here "home module" means a module that doesn't come from another package. +-- +-- For example, if GHC is invoked with modules "A" and "B" as targets, +-- but "A" imports some other module "C", then GHC will issue a warning +-- about module "C" not being listed in the command line. +-- +-- The warning in enabled by `-Wmissing-home-modules`. See #13129 +warnMissingHomeModules :: DynFlags -> [Target] -> ModuleGraph -> DriverMessages +warnMissingHomeModules dflags targets mod_graph = + if null missing + then emptyMessages + else warn + where + diag_opts = initDiagOpts dflags + + -- We need to be careful to handle the case where (possibly + -- path-qualified) filenames (aka 'TargetFile') rather than module + -- names are being passed on the GHC command-line. + -- + -- For instance, `ghc --make src-exe/Main.hs` and + -- `ghc --make -isrc-exe Main` are supposed to be equivalent. + -- Note also that we can't always infer the associated module name + -- directly from the filename argument. See #13727. + is_known_module mod = + is_module_target mod + || + maybe False is_file_target (ml_hs_file (ms_location mod)) + + is_module_target mod = (moduleName (ms_mod mod), ms_unitid mod) `Set.member` mod_targets + + is_file_target file = Set.member (withoutExt file) file_targets + + file_targets = Set.fromList (mapMaybe file_target targets) + + file_target Target {targetId} = + case targetId of + TargetModule _ -> Nothing + TargetFile file _ -> + Just (withoutExt (augmentByWorkingDirectory dflags file)) + + mod_targets = Set.fromList (mod_target <$> targets) + + mod_target Target {targetUnitId, targetId} = + case targetId of + TargetModule name -> (name, targetUnitId) + TargetFile file _ -> (mkModuleName (withoutExt file), targetUnitId) + + withoutExt = fst . splitExtension + + missing = map (moduleName . ms_mod) $ + filter (not . is_known_module) $ + (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) + (mgModSummaries mod_graph)) + + warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan + $ DriverMissingHomeModules (homeUnitId_ dflags) missing (checkBuildingCabalPackage dflags) + +-- Check that any modules we want to reexport or hide are actually in the package. +warnUnknownModules :: HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages +warnUnknownModules hsc_env dflags mod_graph = do + reexported_warns <- filterM check_reexport reexported_mods + return $ final_msgs hidden_warns reexported_warns + where + diag_opts = initDiagOpts dflags + + unit_mods = Set.fromList (map ms_mod_name + (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) + (mgModSummaries mod_graph))) + + reexported_mods = reexportedModules dflags + hidden_mods = hiddenModules dflags + + hidden_warns = hidden_mods `Set.difference` unit_mods + + lookupModule mn = findImportedModule hsc_env mn NoPkgQual + + check_reexport mn = do + fr <- lookupModule (reexportFrom mn) + case fr of + Found _ m -> return (moduleUnitId m == homeUnitId_ dflags) + _ -> return True + + + warn diagnostic = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan + $ diagnostic + + final_msgs hidden_warns reexported_warns + = + unionManyMessages $ + [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)] + ++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)] + +-- | Describes which modules of the module graph need to be loaded. +data LoadHowMuch + = LoadAllTargets + -- ^ Load all targets and its dependencies. + | LoadUpTo [HomeUnitModule] + -- ^ Load only the given modules and its dependencies. + -- If empty, we load none of the targets + | LoadDependenciesOf HomeUnitModule + -- ^ Load only the dependencies of the given module, but not the module + -- itself. + +{- +Note [Caching HomeModInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +API clients who call `load` like to cache the HomeModInfo in memory between +calls to this function. In the old days, this cache was a simple MVar which stored +a HomePackageTable. This was insufficient, as the interface files for boot modules +were not recorded in the cache. In the less old days, the cache was returned at the +end of load, and supplied at the start of load, however, this was not sufficient +because it didn't account for the possibility of exceptions such as SIGINT (#20780). + +So now, in the current day, we have this ModIfaceCache abstraction which +can incrementally be updated during the process of upsweep. This allows us +to store interface files for boot modules in an exception-safe way. + +When the final version of an interface file is completed then it is placed into +the cache. The contents of the cache is retrieved, and the cache cleared, by iface_clearCache. + +Note that because we only store the ModIface and Linkable in the ModIfaceCache, +hydration and rehydration is totally irrelevant, and we just store the CachedIface as +soon as it is completed. + +-} + + +-- Abstract interface to a cache of HomeModInfo +-- See Note [Caching HomeModInfo] +data ModIfaceCache = ModIfaceCache { iface_clearCache :: IO [CachedIface] + , iface_addToCache :: CachedIface -> IO () } + +addHmiToCache :: ModIfaceCache -> HomeModInfo -> IO () +addHmiToCache c (HomeModInfo i _ l) = iface_addToCache c (CachedIface i l) + +data CachedIface = CachedIface { cached_modiface :: !ModIface + , cached_linkable :: !HomeModLinkable } + +instance Outputable CachedIface where + ppr (CachedIface mi ln) = hsep [text "CachedIface", ppr (miKey mi), ppr ln] + +noIfaceCache :: Maybe ModIfaceCache +noIfaceCache = Nothing + +newIfaceCache :: IO ModIfaceCache +newIfaceCache = do + ioref <- newIORef [] + return $ + ModIfaceCache + { iface_clearCache = atomicModifyIORef' ioref (\c -> ([], c)) + , iface_addToCache = \hmi -> atomicModifyIORef' ioref (\c -> (hmi:c, ())) + } + + + + +-- | Try to load the program. See 'LoadHowMuch' for the different modes. +-- +-- This function implements the core of GHC's @--make@ mode. It preprocesses, +-- compiles and loads the specified modules, avoiding re-compilation wherever +-- possible. Depending on the backend (see 'DynFlags.backend' field) compiling +-- and loading may result in files being created on disk. +-- +-- Calls the 'defaultWarnErrLogger' after each compiling each module, whether +-- successful or not. +-- +-- If errors are encountered during dependency analysis, the module `depanalE` +-- returns together with the errors an empty ModuleGraph. +-- After processing this empty ModuleGraph, the errors of depanalE are thrown. +-- All other errors are reported using the 'defaultWarnErrLogger'. + +load :: GhcMonad f => LoadHowMuch -> f SuccessFlag +load how_much = loadWithCache noIfaceCache mkUnknownDiagnostic how_much + +mkBatchMsg :: HscEnv -> Messager +mkBatchMsg hsc_env = + if length (hsc_all_home_unit_ids hsc_env) > 1 + -- This also displays what unit each module is from. + then batchMultiMsg + else batchMsg + + +loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how to cache interfaces as we create them. + -> (GhcMessage -> AnyGhcDiagnostic) -- ^ How to wrap error messages before they are displayed to a user. + -- If you are using the GHC API you can use this to override how messages + -- created during 'loadWithCache' are displayed to the user. + -> LoadHowMuch -- ^ How much `loadWithCache` should load + -> m SuccessFlag +loadWithCache cache diag_wrapper how_much = do + msg <- mkBatchMsg <$> getSession + (errs, mod_graph) <- depanalE diag_wrapper (Just msg) [] False -- #17459 + success <- load' cache how_much diag_wrapper (Just msg) mod_graph + if isEmptyMessages errs + then pure success + else throwErrors (fmap GhcDriverMessage errs) + +-- Note [Unused packages] +-- ~~~~~~~~~~~~~~~~~~~~~~ +-- Cabal passes `-package-id` flag for each direct dependency. But GHC +-- loads them lazily, so when compilation is done, we have a list of all +-- actually loaded packages. All the packages, specified on command line, +-- but never loaded, are probably unused dependencies. + +warnUnusedPackages :: UnitState -> DynFlags -> ModuleGraph -> DriverMessages +warnUnusedPackages us dflags mod_graph = + let diag_opts = initDiagOpts dflags + + home_mod_sum = filter (\ms -> homeUnitId_ dflags == ms_unitid ms) (mgModSummaries mod_graph) + + -- Only need non-source imports here because SOURCE imports are always HPT + loadedPackages = concat $ + mapMaybe (\(_st, fs, mn) -> lookupModulePackage us (unLoc mn) fs) + $ concatMap ms_imps home_mod_sum + + used_args = Set.fromList (map unitId loadedPackages) + + resolve (u,mflag) = do + -- The units which we depend on via the command line explicitly + flag <- mflag + -- Which we can find the UnitInfo for (should be all of them) + ui <- lookupUnit us u + -- Which are not explicitly used + guard (Set.notMember (unitId ui) used_args) + return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag) + + unusedArgs = sortOn (\(u,_,_,_) -> u) $ mapMaybe resolve (explicitUnits us) + + warn = singleMessage $ mkPlainMsgEnvelope diag_opts noSrcSpan (DriverUnusedPackages unusedArgs) + + in if null unusedArgs + then emptyMessages + else warn + +-- | A ModuleGraphNode which also has a hs-boot file, and the list of nodes on any +-- path from module to its boot file. +data ModuleGraphNodeWithBootFile + = ModuleGraphNodeWithBootFile + ModuleGraphNode + -- ^ The module itself (not the hs-boot module) + [NodeKey] + -- ^ The modules in between the module and its hs-boot file, + -- not including the hs-boot file itself. + + +instance Outputable ModuleGraphNodeWithBootFile where + ppr (ModuleGraphNodeWithBootFile mgn deps) = text "ModeGraphNodeWithBootFile: " <+> ppr mgn $$ ppr deps + +-- | A 'BuildPlan' is the result of attempting to linearise a single strongly-connected +-- component of the module graph. +data BuildPlan + -- | A simple, single module all alone (which *might* have an hs-boot file, if it isn't part of a cycle) + = SingleModule ModuleGraphNode + -- | A resolved cycle, linearised by hs-boot files + | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBootFile] + -- | An actual cycle, which wasn't resolved by hs-boot files + | UnresolvedCycle [ModuleGraphNode] + +instance Outputable BuildPlan where + ppr (SingleModule mgn) = text "SingleModule" <> parens (ppr mgn) + ppr (ResolvedCycle mgn) = text "ResolvedCycle:" <+> ppr mgn + ppr (UnresolvedCycle mgn) = text "UnresolvedCycle:" <+> ppr mgn + + +-- Just used for an assertion +countMods :: BuildPlan -> Int +countMods (SingleModule _) = 1 +countMods (ResolvedCycle ns) = length ns +countMods (UnresolvedCycle ns) = length ns + +-- See Note [Upsweep] for a high-level description. +createBuildPlan :: ModuleGraph -> Maybe [HomeUnitModule] -> [BuildPlan] +createBuildPlan mod_graph maybe_top_mod = + let -- Step 1: Compute SCCs without .hi-boot files, to find the cycles + cycle_mod_graph = topSortModuleGraph True mod_graph maybe_top_mod + acyclic_mod_graph = topSortModuleGraph False mod_graph maybe_top_mod + + -- Step 2: Reanalyse loops, with relevant boot modules, to solve the cycles. + build_plan :: [BuildPlan] + build_plan + -- Fast path, if there are no boot modules just do a normal toposort + | isEmptyModuleEnv boot_modules = collapseAcyclic acyclic_mod_graph + | otherwise = toBuildPlan cycle_mod_graph [] + + toBuildPlan :: [SCC ModuleGraphNode] -> [ModuleGraphNode] -> [BuildPlan] + toBuildPlan [] mgn = collapseAcyclic (topSortWithBoot mgn) + toBuildPlan ((AcyclicSCC node):sccs) mgn = toBuildPlan sccs (node:mgn) + -- Interesting case + toBuildPlan ((CyclicSCC nodes):sccs) mgn = + let acyclic = collapseAcyclic (topSortWithBoot mgn) + -- Now perform another toposort but just with these nodes and relevant hs-boot files. + -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph. + mresolved_cycle = collapseSCC (topSortWithBoot nodes) + in acyclic ++ [either UnresolvedCycle ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs [] + + -- Compute the intermediate modules between a file and its hs-boot file. + -- See Step 2a in Note [Upsweep] + boot_path mn uid = + Set.toList $ + -- Don't include the boot module itself + Set.filter ((/= NodeKey_Module (key IsBoot)) . mkNodeKey) $ + -- Keep intermediate dependencies: as per Step 2a in Note [Upsweep], these are + -- the transitive dependencies of the non-boot file which transitively depend + -- on the boot file. + Set.filter (\(mkNodeKey -> nk) -> + nodeKeyUnitId nk == uid -- Cheap test + && mgQuery mod_graph nk (NodeKey_Module (key IsBoot))) $ + Set.fromList $ + expectJust (mgReachable mod_graph (NodeKey_Module (key NotBoot))) + where + key ib = ModNodeKeyWithUid (GWIB mn ib) uid + + + -- An environment mapping a module to its hs-boot file and all nodes on the path between the two, if one exists + boot_modules = mkModuleEnv + [ (mn, (m, boot_path (moduleName mn) (moduleUnitId mn))) + | m@(ModuleNode _ ms) <- mgModSummaries' mod_graph + , let mn = moduleNodeInfoModule ms + , isBootModuleNodeInfo ms == IsBoot] + + select_boot_modules :: [ModuleGraphNode] -> [ModuleGraphNode] + select_boot_modules = mapMaybe (fmap fst . get_boot_module) + + get_boot_module :: ModuleGraphNode -> Maybe (ModuleGraphNode, [ModuleGraphNode]) + get_boot_module (ModuleNode _ ms) + | NotBoot <- isBootModuleNodeInfo ms + = lookupModuleEnv boot_modules (moduleNodeInfoModule ms) + get_boot_module _ = Nothing + + -- Any cycles should be resolved now + collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)] + -- Must be at least two nodes, as we were in a cycle + collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Right [toNodeWithBoot node1, toNodeWithBoot node2] + collapseSCC (AcyclicSCC node : nodes) = either (Left . (node :)) (Right . (toNodeWithBoot node :)) (collapseSCC nodes) + -- Cyclic + collapseSCC nodes = Left (flattenSCCs nodes) + + toNodeWithBoot :: ModuleGraphNode -> Either ModuleGraphNode ModuleGraphNodeWithBootFile + toNodeWithBoot mn = + case get_boot_module mn of + -- The node doesn't have a boot file + Nothing -> Left mn + -- The node does have a boot file + Just path -> Right (ModuleGraphNodeWithBootFile mn (map mkNodeKey (snd path))) + + -- The toposort and accumulation of acyclic modules is solely to pick-up + -- hs-boot files which are **not** part of cycles. + collapseAcyclic :: [SCC ModuleGraphNode] -> [BuildPlan] + collapseAcyclic (AcyclicSCC node : nodes) = SingleModule node : collapseAcyclic nodes + collapseAcyclic (CyclicSCC cy_nodes : nodes) = (UnresolvedCycle cy_nodes) : collapseAcyclic nodes + collapseAcyclic [] = [] + + topSortWithBoot nodes = topSortModules False (select_boot_modules nodes ++ nodes) Nothing + in + -- We need to use 'acyclic_mod_graph', since if 'maybe_top_mod' is 'Just', then the resulting module + -- graph is pruned, reducing the number of 'build_plan' elements. + -- We don't use the size of 'cycle_mod_graph', as it removes @.hi-boot@ modules. These are added + -- later in the processing. + assertPpr (sum (map countMods build_plan) == lengthMGWithSCC acyclic_mod_graph) + (vcat [text "Build plan missing nodes:", (text "PLAN:" <+> ppr (sum (map countMods build_plan))), (text "GRAPH:" <+> ppr (lengthMGWithSCC acyclic_mod_graph))]) + build_plan + where + lengthMGWithSCC :: [SCC a] -> Int + lengthMGWithSCC = List.foldl' (\acc scc -> length scc + acc) 0 + +-- | Generalized version of 'load' which also supports a custom +-- 'Messager' (for reporting progress) and 'ModuleGraph' (generally +-- produced by calling 'depanal'. +load' :: GhcMonad m => Maybe ModIfaceCache -> LoadHowMuch -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> ModuleGraph -> m SuccessFlag +load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do + -- In normal usage plugins are initialised already by ghc/Main.hs this is protective + -- for any client who might interact with GHC via load'. + -- See Note [Timing of plugin initialization] + initializeSessionPlugins + modifySession (setModuleGraph mod_graph) + guessOutputFile + hsc_env <- getSession + + let dflags = hsc_dflags hsc_env + let logger = hsc_logger hsc_env + let interp = hscInterp hsc_env + + -- The "bad" boot modules are the ones for which we have + -- B.hs-boot in the module graph, but no B.hs + -- The downsweep should have ensured this does not happen + -- (see msDeps) + let all_home_mods = + Set.fromList [ Module (ms_unitid s) (ms_mod_name s) + | s <- mgModSummaries mod_graph, isBootSummary s == NotBoot] + -- TODO: Figure out what the correct form of this assert is. It's violated + -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot + -- files without corresponding hs files. + -- bad_boot_mods = [s | s <- mod_graph, isBootSummary s, + -- not (ms_mod_name s `elem` all_home_mods)] + -- assert (null bad_boot_mods ) return () + + -- check that the module given in HowMuch actually exists, otherwise + -- topSortModuleGraph will bomb later. + let checkHowMuch (LoadUpTo ms) = checkMods ms + checkHowMuch (LoadDependenciesOf m) = checkMods [m] + checkHowMuch _ = id + + checkMods ms and_then = + case List.partition (`Set.member` all_home_mods) ms of + (_, []) -> and_then + (_, not_found_mods) -> do + let + mkModuleNotFoundError m = + mkPlainErrorMsgEnvelope noSrcSpan + $ GhcDriverMessage + $ DriverModuleNotFound (moduleUnit m) (moduleName m) + throwErrors $ mkMessages $ listToBag [mkModuleNotFoundError not_found | not_found <- not_found_mods] + + checkHowMuch how_much $ do + + -- mg2_with_srcimps drops the hi-boot nodes, returning a + -- graph with cycles. It is just used for warning about unnecessary source imports. + let mg2_with_srcimps :: [SCC ModuleGraphNode] + mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing + + -- If we can determine that any of the {-# SOURCE #-} imports + -- are definitely unnecessary, then emit a warning. + warnUnnecessarySourceImports (filterToposortToModules mg2_with_srcimps) + + let maybe_top_mods = case how_much of + LoadUpTo m -> Just m + LoadDependenciesOf m -> Just [m] + _ -> Nothing + + build_plan = createBuildPlan mod_graph maybe_top_mods + + + cache <- liftIO $ maybe (return []) iface_clearCache mhmi_cache + let + -- prune the HPT so everything is not retained when doing an + -- upsweep. + !pruned_cache = pruneCache cache + [ms | (ModuleNodeCompile ms) <- (flattenSCCs (filterToposortToModules mg2_with_srcimps))] + + + + -- before we unload anything, make sure we don't leave an old + -- interactive context around pointing to dead bindings. Also, + -- write an empty HPT to allow the old HPT to be GC'd. + + let pruneHomeUnitEnv hme = do + emptyHPT <- liftIO emptyHomePackageTable + pure $! hme{ homeUnitEnv_hpt = emptyHPT } + hug' <- traverse pruneHomeUnitEnv (ue_home_unit_graph $ hsc_unit_env hsc_env) + let ue' = (hsc_unit_env hsc_env){ ue_home_unit_graph = hug' } + setSession $ discardIC hsc_env{hsc_unit_env = ue' } + hsc_env <- getSession + + -- Unload everything + liftIO $ unload interp hsc_env + + liftIO $ debugTraceMsg logger 2 (hang (text "Ready for upsweep") + 2 (ppr build_plan)) + + worker_limit <- liftIO $ mkWorkerLimit dflags + + (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do + hsc_env <- getSession + liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan + + -- At this point, all the HPT variables will be populated, but we don't want + -- to leak the contents of a failed session. + liftIO $ restrictDepsHscEnv new_deps hsc_env + case upsweep_ok of + Failed -> loadFinish upsweep_ok + Succeeded -> do + liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") + loadFinish upsweep_ok + + + +-- | Finish up after a load. +loadFinish :: GhcMonad m => SuccessFlag -> m SuccessFlag +-- Empty the interactive context and set the module context to the topmost +-- newly loaded module, or the Prelude if none were loaded. +loadFinish all_ok + = do modifySession discardIC + return all_ok + + +-- | If there is no -o option, guess the name of target executable +-- by using top-level source file name as a base. +guessOutputFile :: GhcMonad m => m () +guessOutputFile = modifySession $ \env -> + -- Force mod_graph to avoid leaking env + let !mod_graph = hsc_mod_graph env + new_home_graph = + flip fmap (hsc_HUG env) $ \hue -> + let dflags = homeUnitEnv_dflags hue + platform = targetPlatform dflags + mainModuleSrcPath :: Maybe String + mainModuleSrcPath = do + ms <- mgLookupModule mod_graph (mainModIs hue) + ml_hs_file (moduleNodeInfoLocation ms) + name = fmap dropExtension mainModuleSrcPath + + -- MP: This exception is quite sensitive to being forced, if you + -- force it here then the error message is different because it gets + -- caught by a different error handler than the test (T9930fail) expects. + -- Putting an exception into DynFlags is probably not a great design but + -- I'll write this comment rather than more eagerly force the exception. + name_exe = do + -- we must add the .exe extension unconditionally here, otherwise + -- when name has an extension of its own, the .exe extension will + -- not be added by GHC.Driver.Pipeline.exeFileName. See #2248 + !name' <- case platformArchOS platform of + ArchOS _ OSMinGW32 -> fmap (<.> "exe") name + ArchOS ArchWasm32 _ -> fmap (<.> "wasm") name + _ -> name + mainModuleSrcPath' <- mainModuleSrcPath + -- #9930: don't clobber input files (unless they ask for it) + if name' == mainModuleSrcPath' + then throwGhcException . UsageError $ + "default output name would overwrite the input file; " ++ + "must specify -o explicitly" + else Just name' + in + case outputFile_ dflags of + Just _ -> hue + Nothing -> hue {homeUnitEnv_dflags = dflags { outputFile_ = name_exe } } + in env { hsc_unit_env = (hsc_unit_env env) { ue_home_unit_graph = new_home_graph } } + +-- ----------------------------------------------------------------------------- +-- +-- | Prune the HomePackageTable +-- +-- Before doing an upsweep, we can throw away: +-- +-- - all ModDetails, all linked code +-- - all unlinked code that is out of date with respect to +-- the source file +-- +-- This is VERY IMPORTANT otherwise we'll end up requiring 2x the +-- space at the end of the upsweep, because the topmost ModDetails of the +-- old HPT holds on to the entire type environment from the previous +-- compilation. +-- Note [GHC Heap Invariants] +pruneCache :: [CachedIface] + -> [ModSummary] + -> [HomeModInfo] +pruneCache hpt summ + = strictMap prune hpt + where prune (CachedIface { cached_modiface = iface + , cached_linkable = linkable + }) = HomeModInfo iface emptyModDetails linkable' + where + modl = miKey iface + linkable' + | Just ms <- M.lookup modl ms_map + , mi_src_hash iface == Just (ms_hs_hash ms) + = linkable + | otherwise + = emptyHomeModInfoLinkable + + -- Using UFM Module is safe for determinism because the map is just used for a transient lookup. The cache should be unique and a key clash is an error. + ms_map = M.fromListWith + (\ms1 ms2 -> assertPpr False (text "prune_cache" $$ (ppr ms1 <+> ppr ms2)) + ms2) + [(msKey ms, ms) | ms <- summ] + +-- --------------------------------------------------------------------------- +-- +-- | Unloading +unload :: Interp -> HscEnv -> IO () +unload interp hsc_env + = case ghcLink (hsc_dflags hsc_env) of + LinkInMemory -> Linker.unload interp hsc_env [] + _other -> return () + + +{- Parallel Upsweep + +The parallel upsweep attempts to concurrently compile the modules in the +compilation graph using multiple Haskell threads. + +The Algorithm + +* The list of `MakeAction`s are created by `interpretBuildPlan`. A `MakeAction` is +a pair of an `IO a` action and a `MVar a`, where to place the result. + The list is sorted topologically, so can be executed in order without fear of + blocking. +* runPipelines takes this list and eventually passes it to runLoop which executes + each action and places the result into the right MVar. +* The amount of parallelism is controlled by a semaphore. This is just used around the + module compilation step, so that only the right number of modules are compiled at + the same time which reduces overall memory usage and allocations. +* Each proper node has a LogQueue, which dictates where to send it's output. +* The LogQueue is placed into the LogQueueQueue when the action starts and a worker + thread processes the LogQueueQueue printing logs for each module in a stable order. +* The result variable for an action producing `a` is of type `Maybe a`, therefore + it is still filled on a failure. If a module fails to compile, the + failure is propagated through the whole module graph and any modules which didn't + depend on the failure can still be compiled. This behaviour also makes the code + quite a bit cleaner. +-} + + +{- + +Note [--make mode] +~~~~~~~~~~~~~~~~~ +There are two main parts to `--make` mode. + +1. `downsweep`: Starts from the top of the module graph and computes dependencies. +2. `upsweep`: Starts from the bottom of the module graph and compiles modules. + +The result of the downsweep is a 'ModuleGraph', which is then passed to 'upsweep' which +computers how to build this ModuleGraph. + +Note [Upsweep] +~~~~~~~~~~~~~~ +Upsweep takes a 'ModuleGraph' as input, computes a build plan and then executes +the plan in order to compile the project. + +The first step is computing the build plan from a 'ModuleGraph'. + +The output of this step is a `[BuildPlan]`, which is a topologically sorted plan for +how to build all the modules. + +``` +data BuildPlan = SingleModule ModuleGraphNode -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle + | ResolvedCycle [Either ModuleGraphNode ModuleGraphNodeWithBoot] -- A resolved cycle, linearised by hs-boot files + | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files +``` + +The plan is computed in two steps: + +Step 1: Topologically sort the module graph without hs-boot files. This returns a [SCC ModuleGraphNode] which contains + cycles. +Step 2: For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should + result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle. +Step 2a: For each module in the cycle, if the module has a boot file then compute the + modules on the path between it and the hs-boot file. + These are the intermediate modules which: + (1) are (transitive) dependencies of the non-boot module, and + (2) have the boot module as a (transitive) dependency. + In particular, all such intermediate modules must appear in the same unit as + the module under consideration, as module cycles cannot cross unit boundaries. + This information is stored in ModuleGraphNodeWithBoot. + +The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function. + +* SingleModule nodes are compiled normally by either the upsweep_inst or upsweep_mod functions. +* ResolvedCycles need to compiled "together" so that modules outside the cycle are presented + with a consistent knot-tied version of modules at the end. + - When the ModuleGraphNodeWithBoot nodes are compiled then suitable rehydration + is performed both before and after the module in question is compiled. + See Note [Hydrating Modules] for more information. +* UnresolvedCycles are indicative of a proper cycle, unresolved by hs-boot files + and are reported as an error to the user. + +The main trickiness of `interpretBuildPlan` is deciding which version of a dependency +is visible from each module. For modules which are not in a cycle, there is just +one version of a module, so that is always used. For modules in a cycle, there are two versions of +'HomeModInfo'. + +1. Internal to loop: The version created whilst compiling the loop by upsweep_mod. +2. External to loop: The knot-tied version created by typecheckLoop. + +Whilst compiling a module inside the loop, we need to use the (1). For a module which +is outside of the loop which depends on something from in the loop, the (2) version +is used. + +As the plan is interpreted, which version of a HomeModInfo is visible is updated +by updating a map held in a state monad. So after a loop has finished being compiled, +the visible module is the one created by typecheckLoop and the internal version is not +used again. + +This plan also ensures the most important invariant to do with module loops: + +> If you depend on anything within a module loop, before you can use the dependency, + the whole loop has to finish compiling. + +The end result of `interpretBuildPlan` is a `[MakeAction]`, which are pairs +of `IO a` actions and a `MVar (Maybe a)`, somewhere to put the result of running +the action. This list is topologically sorted, so can be run in order to compute +the whole graph. + +As well as this `interpretBuildPlan` also outputs an `IO [Maybe (Maybe HomeModInfo)]` which +can be queried at the end to get the result of all modules at the end, with their proper +visibility. For example, if any module in a loop fails then all modules in that loop will +report as failed because the visible node at the end will be the result of checking +these modules together. + +-} + +-- | Simple wrapper around MVar which allows a functor instance. +data ResultVar b = forall a . ResultVar (a -> b) (MVar (Maybe a)) + +deriving instance Functor ResultVar + +mkResultVar :: MVar (Maybe a) -> ResultVar a +mkResultVar = ResultVar id + +-- | Block until the result is ready. +waitResult :: ResultVar a -> MaybeT IO a +waitResult (ResultVar f var) = MaybeT (fmap f <$> readMVar var) + +data BuildResult = BuildResult { _resultOrigin :: ResultOrigin + , resultVar :: ResultVar (Maybe HomeModInfo) + } + +-- The origin of this result var, useful for debugging +data ResultOrigin = NoLoop | Loop ResultLoopOrigin deriving (Show) + +data ResultLoopOrigin = Initialise | Rehydrated | Finalised deriving (Show) + +mkBuildResult :: ResultOrigin -> ResultVar (Maybe HomeModInfo) -> BuildResult +mkBuildResult = BuildResult + + +data BuildLoopState = BuildLoopState { buildDep :: M.Map NodeKey BuildResult + -- The current way to build a specific TNodeKey, without cycles this just points to + -- the appropriate result of compiling a module but with + -- cycles there can be additional indirection and can point to the result of typechecking a loop + , nNODE :: Int + } + +nodeId :: BuildM Int +nodeId = do + n <- gets nNODE + modify (\m -> m { nNODE = n + 1 }) + return n + + +setModulePipeline :: NodeKey -> BuildResult -> BuildM () +setModulePipeline mgn build_result = do + modify (\m -> m { buildDep = M.insert mgn build_result (buildDep m) }) + +type BuildMap = M.Map NodeKey BuildResult + +getBuildMap :: BuildM BuildMap +getBuildMap = gets buildDep + +getDependencies :: [NodeKey] -> BuildMap -> [BuildResult] +getDependencies direct_deps build_map = + strictMap (expectJust . flip M.lookup build_map) direct_deps + +type BuildM a = StateT BuildLoopState IO a + + + + +-- | Given the build plan, creates a graph which indicates where each NodeKey should +-- get its direct dependencies from. This might not be the corresponding build action +-- if the module participates in a loop. This step also labels each node with a number for the output. +-- See Note [Upsweep] for a high-level description. +interpretBuildPlan :: HomeUnitGraph + -> Maybe ModIfaceCache + -> M.Map ModNodeKeyWithUid HomeModInfo + -> [BuildPlan] + -> IO ( Maybe [ModuleGraphNode] -- Is there an unresolved cycle + , [MakeAction] -- Actions we need to run in order to build everything + , IO [Maybe (Maybe HomeModInfo)]) -- An action to query to get all the built modules at the end. +interpretBuildPlan hug mhmi_cache old_hpt plan = do + ((mcycle, plans), build_map) <- runStateT (buildLoop plan) (BuildLoopState M.empty 1) + let wait = collect_results (buildDep build_map) + return (mcycle, plans, wait) + + where + collect_results build_map = + sequence (map (\br -> collect_result (resultVar br)) (M.elems build_map)) + where + collect_result res_var = runMaybeT (waitResult res_var) + + -- Just used for an assertion + count_mods :: BuildPlan -> Int + count_mods (SingleModule m) = count_m m + count_mods (ResolvedCycle ns) = length ns + count_mods (UnresolvedCycle ns) = length ns + + count_m (UnitNode {}) = 0 + count_m _ = 1 + + n_mods = sum (map count_mods plan) + + buildLoop :: [BuildPlan] + -> BuildM (Maybe [ModuleGraphNode], [MakeAction]) + -- Build the abstract pipeline which we can execute + -- Building finished + buildLoop [] = return (Nothing, []) + buildLoop (plan:plans) = + case plan of + -- If there was no cycle, then typecheckLoop is not necessary + SingleModule m -> do + one_plan <- buildSingleModule Nothing NoLoop m + (cycle, all_plans) <- buildLoop plans + return (cycle, one_plan : all_plans) + + -- For a resolved cycle, depend on everything in the loop, then update + -- the cache to point to this node rather than directly to the module build + -- nodes + ResolvedCycle ms -> do + pipes <- buildModuleLoop ms + (cycle, graph) <- buildLoop plans + return (cycle, pipes ++ graph) + + -- Can't continue past this point as the cycle is unresolved. + UnresolvedCycle ns -> return (Just ns, []) + + buildSingleModule :: Maybe [NodeKey] -- Modules we need to rehydrate before compiling this module + -> ResultOrigin + -> ModuleGraphNode -- The node we are compiling + -> BuildM MakeAction + buildSingleModule rehydrate_nodes origin mod = do + !build_map <- getBuildMap + -- 1. Get the direct dependencies of this module + let direct_deps = mgNodeDependencies False mod + -- It's really important to force build_deps, or the whole buildMap is retained, + -- which would retain all the result variables, preventing us from collecting them + -- after they are no longer used. + !build_deps = getDependencies direct_deps build_map + !build_action <- + case mod of + InstantiationNode uid iu -> do + mod_idx <- nodeId + return $ withCurrentUnit (mgNodeUnitId mod) $ do + !_ <- wait_deps build_deps + executeInstantiationNode mod_idx n_mods hug uid iu + return Nothing + ModuleNode _build_deps ms -> do + let !old_hmi = M.lookup (mnKey ms) old_hpt + rehydrate_mods = mapMaybe nodeKeyModName <$> rehydrate_nodes + mod_idx <- nodeId + return $ withCurrentUnit (mgNodeUnitId mod) $ do + !_ <- wait_deps build_deps + hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms + -- Write the HMI to an external cache (if one exists) + -- See Note [Caching HomeModInfo] + liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi + -- Make sure the result is written to the HPT var + liftIO $ HUG.addHomeModInfoToHug hmi hug + return (Just hmi) + LinkNode _nks uid -> do + mod_idx <- nodeId + return $ withCurrentUnit (mgNodeUnitId mod) $ do + !_ <- wait_deps build_deps + executeLinkNode hug (mod_idx, n_mods) uid direct_deps + return Nothing + UnitNode {} -> return $ return Nothing + + + res_var <- liftIO newEmptyMVar + let result_var = mkResultVar res_var + setModulePipeline (mkNodeKey mod) (mkBuildResult origin result_var) + return $! (MakeAction build_action res_var) + + + buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction] + buildOneLoopyModule (ModuleGraphNodeWithBootFile mn deps) = do + ma <- buildSingleModule (Just deps) (Loop Initialise) mn + -- Rehydration (1) from Note [Hydrating Modules], "Loops with multiple boot files" + rehydrate_action <- rehydrateAction Rehydrated ((GWIB (mkNodeKey mn) IsBoot) : (map (\d -> GWIB d NotBoot) deps)) + return $ [ma, rehydrate_action] + + + buildModuleLoop :: [Either ModuleGraphNode ModuleGraphNodeWithBootFile] -> BuildM [MakeAction] + buildModuleLoop ms = do + build_modules <- concatMapM (either (fmap (:[]) <$> buildSingleModule Nothing (Loop Initialise)) buildOneLoopyModule) ms + let extract (Left mn) = GWIB (mkNodeKey mn) NotBoot + extract (Right (ModuleGraphNodeWithBootFile mn _)) = GWIB (mkNodeKey mn) IsBoot + let loop_mods = map extract ms + -- Rehydration (2) from Note [Hydrating Modules], "Loops with multiple boot files" + -- Fixes the space leak described in that note. + rehydrate_action <- rehydrateAction Finalised loop_mods + + return $ build_modules ++ [rehydrate_action] + + -- An action which rehydrates the given keys + rehydrateAction :: ResultLoopOrigin -> [GenWithIsBoot NodeKey] -> BuildM MakeAction + rehydrateAction origin deps = do + !build_map <- getBuildMap + res_var <- liftIO newEmptyMVar + let loop_unit :: UnitId + !loop_unit = nodeKeyUnitId (gwib_mod (head deps)) + !build_deps = getDependencies (map gwib_mod deps) build_map + let loop_action = withCurrentUnit loop_unit $ do + !_ <- wait_deps build_deps + hsc_env <- asks hsc_env + let mns :: [ModuleName] + mns = mapMaybe (nodeKeyModName . gwib_mod) deps + + hmis' <- liftIO $ rehydrateAfter hsc_env mns + + checkRehydrationInvariant hmis' deps + + -- Add hydrated interfaces to global variable + liftIO $ mapM_ (\hmi -> HUG.addHomeModInfoToHug hmi hug) hmis' + return hmis' + + let fanout i = Just . (!! i) <$> mkResultVar res_var + -- From outside the module loop, anyone must wait for the loop to finish and then + -- use the result of the rehydrated iface. This makes sure that things not in the + -- module loop will see the updated interfaces for all the identifiers in the loop. + boot_key :: NodeKey -> NodeKey + boot_key (NodeKey_Module m) = NodeKey_Module (m { mnkModuleName = (mnkModuleName m) { gwib_isBoot = IsBoot } } ) + boot_key k = pprPanic "boot_key" (ppr k) + + update_module_pipeline (m, i) = + case gwib_isBoot m of + NotBoot -> setModulePipeline (gwib_mod m) (mkBuildResult (Loop origin) (fanout i)) + IsBoot -> do + setModulePipeline (gwib_mod m) (mkBuildResult (Loop origin) (fanout i)) + -- SPECIAL: Anything outside the loop needs to see A rather than A.hs-boot + setModulePipeline (boot_key (gwib_mod m)) (mkBuildResult (Loop origin) (fanout i)) + + let deps_i = zip deps [0..] + mapM update_module_pipeline deps_i + + return $ MakeAction loop_action res_var + + -- Checks that the interfaces returned from hydration match-up with the names of the + -- modules which were fed into the function. + checkRehydrationInvariant hmis deps = + let hmi_names = map (moduleName . mi_module . hm_iface) hmis + start = mapMaybe (nodeKeyModName . gwib_mod) deps + in massertPpr (hmi_names == start) $ (ppr hmi_names $$ ppr start) + + +withCurrentUnit :: UnitId -> RunMakeM a -> RunMakeM a +withCurrentUnit uid = do + local (\env -> env { hsc_env = hscSetActiveUnitId uid (hsc_env env)}) + +upsweep + :: WorkerLimit -- ^ The number of workers we wish to run in parallel + -> HscEnv -- ^ The base HscEnv, which is augmented for each module + -> Maybe ModIfaceCache -- ^ A cache to incrementally write final interface files to + -> (GhcMessage -> AnyGhcDiagnostic) + -> Maybe Messager + -> M.Map ModNodeKeyWithUid HomeModInfo + -> [BuildPlan] + -> IO (SuccessFlag, [HomeModInfo]) +upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do + (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan + runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines + res <- collect_result + + let completed = [m | Just (Just m) <- res] + + -- Handle any cycle in the original compilation graph and return the result + -- of the upsweep. + case cycle of + Just mss -> do + throwOneError $ cyclicModuleErr mss + Nothing -> do + let success_flag = successIf (all isJust res) + return (success_flag, completed) + +toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo +toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) + +upsweep_inst :: HscEnv + -> Maybe Messager + -> Int -- index of module + -> Int -- total number of modules + -> UnitId + -> InstantiatedUnit + -> IO () +upsweep_inst hsc_env mHscMessage mod_index nmods uid iuid = do + case mHscMessage of + Just hscMessage -> hscMessage hsc_env (mod_index, nmods) (NeedsRecompile MustCompile) (InstantiationNode uid iuid) + Nothing -> return () + runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ tcRnCheckUnit hsc_env $ VirtUnit iuid + pure () + +-- | Compile a single module. Always produce a Linkable for it if +-- successful. If no compilation happened, return the old Linkable. +upsweep_mod :: HscEnv + -> Maybe Messager + -> Maybe HomeModInfo + -> ModSummary + -> Int -- index of module + -> Int -- total number of modules + -> IO HomeModInfo +upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods = do + hmi <- compileOne' mHscMessage hsc_env summary + mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi) + + -- MP: This is a bit janky, because before you add the entries you have to extend the HPT with the module + -- you just compiled. Another option, would be delay adding anything until after upsweep has finished, but I + -- am unsure if this is sound (wrt running TH splices for example). + -- This function only does anything if the linkable produced is a BCO, which + -- used to only happen with the bytecode backend, but with + -- @-fprefer-byte-code@, @HomeModInfo@ has bytecode even when generating + -- object code, see #25230. + hscInsertHPT hmi hsc_env + addSptEntries (hsc_env) + (homeModInfoByteCode hmi) + + return hmi + +-- | Add the entries from a BCO linkable to the SPT table, see +-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable. +addSptEntries :: HscEnv -> Maybe Linkable -> IO () +addSptEntries hsc_env mlinkable = + hscAddSptEntries hsc_env + [ spt + | linkable <- maybeToList mlinkable + , bco <- linkableBCOs linkable + , spt <- bc_spt_entries bco + ] + + +-- Note [When source is considered modified] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- A number of functions in GHC.Driver accept a SourceModified argument, which +-- is part of how GHC determines whether recompilation may be avoided (see the +-- definition of the SourceModified data type for details). +-- +-- Determining whether or not a source file is considered modified depends not +-- only on the source file itself, but also on the output files which compiling +-- that module would produce. This is done because GHC supports a number of +-- flags which control which output files should be produced, e.g. -fno-code +-- -fwrite-interface and -fwrite-ide-file; we must check not only whether the +-- source file has been modified since the last compile, but also whether the +-- source file has been modified since the last compile which produced all of +-- the output files which have been requested. +-- +-- Specifically, a source file is considered unmodified if it is up-to-date +-- relative to all of the output files which have been requested. Whether or +-- not an output file is up-to-date depends on what kind of file it is: +-- +-- * iface (.hi) files are considered up-to-date if (and only if) their +-- mi_src_hash field matches the hash of the source file, +-- +-- * all other output files (.o, .dyn_o, .hie, etc) are considered up-to-date +-- if (and only if) their modification times on the filesystem are greater +-- than or equal to the modification time of the corresponding .hi file. +-- +-- Why do we use '>=' rather than '>' for output files other than the .hi file? +-- If the filesystem has poor resolution for timestamps (e.g. FAT32 has a +-- resolution of 2 seconds), we may often find that the .hi and .o files have +-- the same modification time. Using >= is slightly unsafe, but it matches +-- make's behaviour. +-- +-- This strategy allows us to do the minimum work necessary in order to ensure +-- that all the files the user cares about are up-to-date; e.g. we should not +-- worry about .o files if the user has indicated that they are not interested +-- in them via -fno-code. See also #9243. +-- +-- Note that recompilation avoidance is dependent on .hi files being produced, +-- which does not happen if -fno-write-interface -fno-code is passed. That is, +-- passing -fno-write-interface -fno-code means that you cannot benefit from +-- recompilation avoidance. See also Note [-fno-code mode]. +-- +-- The correctness of this strategy depends on an assumption that whenever we +-- are producing multiple output files, the .hi file is always written first. +-- If this assumption is violated, we risk recompiling unnecessarily by +-- incorrectly regarding non-.hi files as outdated. +-- + +-- --------------------------------------------------------------------------- +-- +-- | Topological sort of the module graph +topSortModuleGraph + :: Bool + -- ^ Drop hi-boot nodes? (see below) + -> ModuleGraph + -> Maybe [HomeUnitModule] + -- ^ Root module name. If @Nothing@, use the full graph. + -> [SCC ModuleGraphNode] +-- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes +-- The resulting list of strongly-connected-components is in topologically +-- sorted order, starting with the module(s) at the bottom of the +-- dependency graph (ie compile them first) and ending with the ones at +-- the top. +-- +-- Drop hi-boot nodes (first boolean arg)? +-- +-- - @False@: treat the hi-boot summaries as nodes of the graph, +-- so the graph must be acyclic +-- +-- - @True@: eliminate the hi-boot nodes, and instead pretend +-- the a source-import of Foo is an import of Foo +-- The resulting graph has no hi-boot nodes, but can be cyclic +topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod = + topSortModules drop_hs_boot_nodes + (sortBy (cmpModuleGraphNodes `on` mkNodeKey) $ mgModSummaries' module_graph) + mb_root_mod + + + where + -- In order to get the "right" ordering + -- Module nodes must be in reverse lexigraphic order. + -- All modules nodes must appear before package nodes. + -- + -- MP: This is just the ordering which the tests needed in Jan 2025, it does + -- not arise from nature. + -- + -- Given the current implementation of scc, the result is in + -- The order is sensitive to the internal implementation in Data.Graph, + -- if it changes in future then this ordering will need to be modified. + -- + -- The SCC algorithm firstly transposes the input graph and then + -- performs dfs on the vertices in the order which they are originally given. + -- Therefore, if `ExternalUnit` nodes are first, the order returned will + -- be determined by the order the dependencies are stored in the transposed graph. + moduleGraphNodeRank :: NodeKey -> Int + moduleGraphNodeRank k = + case k of + NodeKey_Unit {} -> 0 + NodeKey_Module {} -> 1 + NodeKey_Link {} -> 2 + NodeKey_ExternalUnit {} -> 3 + + cmpModuleGraphNodes k1 k2 = compare (moduleGraphNodeRank k1) (moduleGraphNodeRank k2) + `mappend` compare k2 k1 + +topSortModules :: Bool -> [ModuleGraphNode] -> Maybe [HomeUnitModule] -> [SCC ModuleGraphNode] +topSortModules drop_hs_boot_nodes summaries mb_root_mod + = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph + where + (graph, lookup_node) = + moduleGraphNodes drop_hs_boot_nodes summaries + + initial_graph = case mb_root_mod of + Nothing -> graph + Just mods -> + -- restrict the graph to just those modules reachable from + -- the specified module. We do this by building a graph with + -- the full set of nodes, and determining the reachable set from + -- the specified node. + let + findNodeForModule (Module uid root_mod) + | Just node <- lookup_node $ NodeKey_Module $ ModNodeKeyWithUid (GWIB root_mod NotBoot) uid + , graph `hasVertexG` node + = seq node node + | otherwise + = throwGhcException (ProgramError "module does not exist") + roots = fmap findNodeForModule mods + in graphFromEdgedVerticesUniq (seq roots (roots ++ allReachableMany (graphReachability graph) roots)) + +newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a } + deriving (Functor, Traversable, Foldable) + +emptyModNodeMap :: ModNodeMap a +emptyModNodeMap = ModNodeMap Map.empty + +modNodeMapInsert :: ModNodeKey -> a -> ModNodeMap a -> ModNodeMap a +modNodeMapInsert k v (ModNodeMap m) = ModNodeMap (Map.insert k v m) + +modNodeMapElems :: ModNodeMap a -> [a] +modNodeMapElems (ModNodeMap m) = Map.elems m + +modNodeMapLookup :: ModNodeKey -> ModNodeMap a -> Maybe a +modNodeMapLookup k (ModNodeMap m) = Map.lookup k m + +modNodeMapSingleton :: ModNodeKey -> a -> ModNodeMap a +modNodeMapSingleton k v = ModNodeMap (M.singleton k v) + +modNodeMapUnionWith :: (a -> a -> a) -> ModNodeMap a -> ModNodeMap a -> ModNodeMap a +modNodeMapUnionWith f (ModNodeMap m) (ModNodeMap n) = ModNodeMap (M.unionWith f m n) + +-- | If there are {-# SOURCE #-} imports between strongly connected +-- components in the topological sort, then those imports can +-- definitely be replaced by ordinary non-SOURCE imports: if SOURCE +-- were necessary, then the edge would be part of a cycle. +warnUnnecessarySourceImports :: GhcMonad m => [SCC ModuleNodeInfo] -> m () +warnUnnecessarySourceImports sccs = do + diag_opts <- initDiagOpts <$> getDynFlags + when (diag_wopt Opt_WarnUnusedImports diag_opts) $ do + let check ms = + let mods_in_this_cycle = map moduleNodeInfoModuleName ms in + [ warn i | (ModuleNodeCompile m) <- ms, i <- ms_home_srcimps m, + unLoc i `notElem` mods_in_this_cycle ] + + warn :: Located ModuleName -> MsgEnvelope GhcMessage + warn (L loc mod) = GhcDriverMessage <$> mkPlainMsgEnvelope diag_opts + loc (DriverUnnecessarySourceImports mod) + logDiagnostics (mkMessages $ listToBag (concatMap (check . flattenSCC) sccs)) + + +----------------------------------------------------------------------------- +-- Error messages +----------------------------------------------------------------------------- + +-- Defer and group warning, error and fatal messages so they will not get lost +-- in the regular output. +withDeferredDiagnostics :: GhcMonad m => m a -> m a +withDeferredDiagnostics f = do + dflags <- getDynFlags + if not $ gopt Opt_DeferDiagnostics dflags + then f + else do + warnings <- liftIO $ newIORef [] + errors <- liftIO $ newIORef [] + fatals <- liftIO $ newIORef [] + logger <- getLogger + + let deferDiagnostics _dflags !msgClass !srcSpan !msg = do + let action = logMsg logger msgClass srcSpan msg + case msgClass of + MCDiagnostic SevWarning _reason _code + -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) + MCDiagnostic SevError _reason _code + -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) + MCFatal + -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) + _ -> action + + printDeferredDiagnostics = liftIO $ + forM_ [warnings, errors, fatals] $ \ref -> do + -- This IORef can leak when the dflags leaks, so let us always + -- reset the content. The lazy variant is used here as we want to force + -- this error if the IORef is ever accessed again, rather than now. + -- See #20981 for an issue which discusses this general issue. + let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] + actions <- atomicModifyIORef ref $ \i -> (landmine, i) + sequence_ $ reverse actions + + MC.bracket + (pushLogHookM (const deferDiagnostics)) + (\_ -> popLogHookM >> printDeferredDiagnostics) + (\_ -> f) + +noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage +-- ToDo: we don't have a proper line number for this error +noModError hsc_env loc wanted_mod err + = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ + DriverInterfaceError $ + (Can'tFindInterface (cannotFindModule hsc_env wanted_mod err) (LookingForModule wanted_mod NotBoot)) + +{- +noHsFileErr :: SrcSpan -> String -> DriverMessages +noHsFileErr loc path + = singleMessage $ mkPlainErrorMsgEnvelope loc (DriverFileNotFound path) + -} + + + +cyclicModuleErr :: [ModuleGraphNode] -> MsgEnvelope GhcMessage +-- From a strongly connected component we find +-- a single cycle to report +cyclicModuleErr mss + = assert (not (null mss)) $ + case findCycle graph of + Nothing -> pprPanic "Unexpected non-cycle" (ppr mss) + Just path -> mkPlainErrorMsgEnvelope src_span $ + GhcDriverMessage $ DriverModuleGraphCycle path + where + src_span = maybe noSrcSpan (mkFileSrcSpan . moduleNodeInfoLocation) (mgNodeIsModule (head path)) + where + graph :: [Node NodeKey ModuleGraphNode] + graph = + [ DigraphNode + { node_payload = ms + , node_key = mkNodeKey ms + , node_dependencies = mgNodeDependencies False ms + } + | ms <- mss + ] + +cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () +cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = + if gopt Opt_KeepTmpFiles dflags + then liftIO $ keepCurrentModuleTempFiles logger tmpfs + else liftIO $ cleanCurrentModuleTempFiles logger tmpfs + + +-- | Thin each HPT variable to only contain keys from the given dependencies. +-- This is used at the end of upsweep to make sure that only completely successfully loaded +-- modules are visible for subsequent operations. +restrictDepsHscEnv :: [HomeModInfo] -> HscEnv -> IO () +restrictDepsHscEnv deps hsc_env = + let deps_with_unit = map (\xs -> (fst (head xs), map snd xs)) $ groupBy ((==) `on` fst) (sortOn fst (map go deps)) + hug = ue_home_unit_graph $ hsc_unit_env hsc_env + go hmi = (hmi_unit, hmi) + where + hmi_mod = mi_module (hm_iface hmi) + hmi_unit = toUnitId (moduleUnit hmi_mod) + in HUG.restrictHug deps_with_unit hug + + +setHUG :: HomeUnitGraph -> HscEnv -> HscEnv +setHUG deps hsc_env = + hscUpdateHUG (const $ deps) hsc_env + +-- | Wrap an action to catch and handle exceptions. +wrapAction :: (GhcMessage -> AnyGhcDiagnostic) -> HscEnv -> IO a -> IO (Maybe a) +wrapAction msg_wrapper hsc_env k = do + let lcl_logger = hsc_logger hsc_env + lcl_dynflags = hsc_dflags hsc_env + print_config = initPrintConfig lcl_dynflags + logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (msg_wrapper <$> srcErrorMessages err) + -- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle + -- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches` + -- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to + -- internally using forkIO. + mres <- MC.try $ prettyPrintGhcErrors lcl_logger $ k + case mres of + Right res -> return $ Just res + Left exc -> do + case fromException exc of + Just (err :: SourceError) + -> logg err + Nothing -> case fromException exc of + -- ThreadKilled in particular needs to actually kill the thread. + -- So rethrow that and the other async exceptions + Just (err :: SomeAsyncException) -> throwIO err + _ -> errorMsg lcl_logger (text (show exc)) + return Nothing + + + + +executeInstantiationNode :: Int + -> Int + -> HomeUnitGraph + -> UnitId + -> InstantiatedUnit + -> RunMakeM () +executeInstantiationNode k n deps uid iu = do + env <- ask + -- Output of the logger is mediated by a central worker to + -- avoid output interleaving + msg <- asks env_messager + wrapper <- asks diag_wrapper + lift $ MaybeT $ withLoggerHsc k env $ \hsc_env -> + let lcl_hsc_env = setHUG deps hsc_env + in wrapAction wrapper lcl_hsc_env $ do + res <- upsweep_inst lcl_hsc_env msg k n uid iu + cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) + return res + + +-- | executeCompileNode interprets how --make module should compile a ModuleNode +-- +-- 1. If the ModuleNode is a ModuleNodeCompile, then we first check +-- if the interface file exists and is up to date. If it is, we return those. +-- Otherwise, we compile the module and return the new HomeModInfo. +-- 2. If the ModuleNode is a ModuleNodeFixed, then we just need to load the interface +-- and artifacts from disk. + +executeCompileNode :: Int + -> Int + -> Maybe HomeModInfo + -> HomeUnitGraph + -> Maybe [ModuleName] -- List of modules we need to rehydrate before compiling + -> ModuleNodeInfo + -> RunMakeM HomeModInfo +executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do + me@MakeEnv{..} <- ask + -- Rehydrate any dependencies if this module had a boot file or is a signature file. + lift $ MaybeT (withAbstractSem compile_sem $ withLoggerHsc k me $ \hsc_env -> do + hsc_env' <- liftIO $ maybeRehydrateBefore (setHUG hug hsc_env) mni fixed_mrehydrate_mods + case mni of + ModuleNodeCompile mod -> executeCompileNodeWithSource hsc_env' me mod + ModuleNodeFixed key loc -> executeCompileNodeFixed hsc_env' me key loc + ) + + where + fixed_mrehydrate_mods = + case moduleNodeInfoHscSource mni of + -- MP: It is probably a bit of a misimplementation in backpack that + -- compiling a signature requires an knot_var for that unit. + -- If you remove this then a lot of backpack tests fail. + Just HsigFile -> Just [] + _ -> mrehydrate_mods + + executeCompileNodeFixed :: HscEnv -> MakeEnv -> ModNodeKeyWithUid -> ModLocation -> IO (Maybe HomeModInfo) + executeCompileNodeFixed hsc_env MakeEnv{diag_wrapper, env_messager} mod loc = + wrapAction diag_wrapper hsc_env $ do + forM_ env_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc)) + read_result <- readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc) + case read_result of + M.Failed interface_err -> + let mn = mnkModuleName mod + err = Can'tFindInterface (BadIfaceFile interface_err) (LookingForModule (gwib_mod mn) (gwib_isBoot mn)) + in throwErrors $ singleMessage $ mkPlainErrorMsgEnvelope noSrcSpan (GhcDriverMessage (DriverInterfaceError err)) + M.Succeeded iface -> do + details <- genModDetails hsc_env iface + mb_object <- findObjectLinkableMaybe (mi_module iface) loc + mb_bytecode <- loadIfaceByteCodeLazy hsc_env iface loc (md_types details) + let hm_linkable = HomeModLinkable mb_bytecode mb_object + return (HomeModInfo iface details hm_linkable) + + executeCompileNodeWithSource :: HscEnv -> MakeEnv -> ModSummary -> IO (Maybe HomeModInfo) + executeCompileNodeWithSource hsc_env MakeEnv{diag_wrapper, env_messager} mod = do + let -- Use the cached DynFlags which includes OPTIONS_GHC pragmas + lcl_dynflags = ms_hspp_opts mod + let lcl_hsc_env = + -- Localise the hsc_env to use the cached flags + hscSetFlags lcl_dynflags $ + hsc_env + -- Compile the module, locking with a semaphore to avoid too many modules + -- being compiled at the same time leading to high memory usage. + wrapAction diag_wrapper lcl_hsc_env $ do + res <- upsweep_mod lcl_hsc_env env_messager old_hmi mod k n + cleanCurrentModuleTempFilesMaybe (hsc_logger hsc_env) (hsc_tmpfs hsc_env) lcl_dynflags + return res + + +{- Rehydration, see Note [Rehydrating Modules] -} + +rehydrate :: HscEnv -- ^ The HPT in this HscEnv needs rehydrating. + -> [HomeModInfo] -- ^ These are the modules we want to rehydrate. + -> IO [HomeModInfo] +rehydrate hsc_env hmis = do + debugTraceMsg logger 2 $ ( + text "Re-hydrating loop: " <+> (ppr (map (mi_module . hm_iface) hmis))) + -- When the HPT was pure we had to tie a knot to update the ModDetails in the + -- HPT required to update those ModDetails, but since it was made an IORef we + -- just have to make sure the new ModDetails are "reset" so that the new + -- modules are looked up in HPT when it is forced. If we didn't "reset" the + -- ModDetails, modules in a loop would refer the wrong (hs-boot) definitions + -- (as explained in Note [Rehydrating Modules]). + mds <- initIfaceCheck (text "rehydrate") hsc_env $ + mapM (typecheckIface . hm_iface) hmis + let new_mods = [ hmi{ hm_details = details } + | (hmi,details) <- zip hmis mds + ] + return new_mods + + where + logger = hsc_logger hsc_env + +-- If needed, then rehydrate the necessary modules with a suitable KnotVars for the +-- module currently being compiled. +maybeRehydrateBefore :: HscEnv -> ModuleNodeInfo -> Maybe [ModuleName] -> IO HscEnv +maybeRehydrateBefore hsc_env _ Nothing = return hsc_env +maybeRehydrateBefore hsc_env mni (Just mns) = do + knot_var <- initialise_knot_var hsc_env + let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv knot_var } + hmis <- mapM (fmap expectJust . lookupHpt (hsc_HPT hsc_env')) mns + hmis' <- rehydrate hsc_env' hmis + mapM_ (\hmi -> HUG.addHomeModInfoToHug hmi (hsc_HUG hsc_env')) hmis' + return hsc_env' + + where + initialise_knot_var hsc_env = liftIO $ + let mod_name = homeModuleInstantiation (hsc_home_unit_maybe hsc_env) (moduleNodeInfoModule mni) + in mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv + +rehydrateAfter :: HscEnv + -> [ModuleName] + -> IO [HomeModInfo] +rehydrateAfter hsc mns = do + let hpt = hsc_HPT hsc + hmis <- mapM (fmap expectJust . lookupHpt hpt) mns + rehydrate (hsc { hsc_type_env_vars = emptyKnotVars }) hmis + +{- +Note [Hydrating Modules] +~~~~~~~~~~~~~~~~~~~~~~~~ +There are at least 4 different representations of an interface file as described +by this diagram. + +------------------------------ +| On-disk M.hi | +------------------------------ + | ^ + | Read file | Write file + V | +------------------------------- +| ByteString | +------------------------------- + | ^ + | Binary.get | Binary.put + V | +-------------------------------- +| ModIface (an acyclic AST) | +-------------------------------- + | ^ + | hydrate | mkIfaceTc + V | +--------------------------------- +| ModDetails (lots of cycles) | +--------------------------------- + +The last step, converting a ModIface into a ModDetails is known as "hydration". + +Hydration happens in three different places + +* When an interface file is initially loaded from disk, it has to be hydrated. +* When a module is finished compiling, we hydrate the ModIface in order to generate + the version of ModDetails which exists in memory (see Note [ModDetails and --make mode]) +* When dealing with boot files and module loops (see Note [Rehydrating Modules]) + +Note [Rehydrating Modules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a module has a boot file then it is critical to rehydrate the modules on +the path between the two (see #20561). + +Suppose we have ("R" for "recursive"): +``` +R.hs-boot: module R where + data T + g :: T -> T + +A.hs: module A( f, T, g ) where + import {-# SOURCE #-} R + data S = MkS T + f :: T -> S = ...g... + +R.hs: module R where + import A + data T = T1 | T2 S + g = ...f... +``` + +== Why we need to rehydrate A's ModIface before compiling R.hs + +After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type +that uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same +AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about +it.) + +When compiling R.hs, we build a TyCon for `T`. But that TyCon mentions `S`, and +it currently has an AbstractTyCon for `T` inside it. But we want to build a +fully cyclic structure, in which `S` refers to `T` and `T` refers to `S`. + +Solution: **rehydration**. *Before compiling `R.hs`*, rehydrate all the +ModIfaces below it that depend on R.hs-boot. To rehydrate a ModIface, call +`typecheckIface` to convert it to a ModDetails. It's just a de-serialisation +step, no type inference, just lookups. + +Now `S` will be bound to a thunk that, when forced, will "see" the final binding +for `T`; see [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot). +But note that this must be done *before* compiling R.hs. + +== Why we need to rehydrate A's ModIface after compiling R.hs + +When compiling R.hs, the knot-tying stuff above will ensure that `f`'s unfolding +mentions the `LocalId` for `g`. But when we finish R, we carefully ensure that +all those `LocalIds` are turned into completed `GlobalIds`, replete with +unfoldings etc. Alas, that will not apply to the occurrences of `g` in `f`'s +unfolding. And if we leave matters like that, they will stay that way, and *all* +subsequent modules that import A will see a crippled unfolding for `f`. + +Solution: rehydrate both R and A's ModIface together, right after completing R.hs. + +~~ Which modules to rehydrate + +We only need rehydrate modules that are +* Below R.hs +* Above R.hs-boot + +There might be many unrelated modules (in the home package) that don't need to be +rehydrated. + +== Loops with multiple boot files + +It is possible for a module graph to have a loop (SCC, when ignoring boot files) +which requires multiple boot files to break. In this case, we must perform +several hydration steps: + 1. The hydration steps described above, which are necessary for correctness. + 2. An extra hydration step at the end of compiling the entire SCC, in order to + remove space leaks, as we explain below. + +Consider the following example: + + ┌─────┐ ┌─────┐ + │ A │ │ B │ + └──┬──┘ └──┬──┘ + │ │ + ┌───▼───────────▼───┐ + │ C │ + └───┬───────────┬───┘ + │ │ + ┌────▼───┐ ┌───▼────┐ + │ A-boot │ │ B-boot │ + └────────┘ └────────┘ + +A, B and C live together in a SCC. Suppose that we compile the modules in the +order: + + A-boot, B-boot, C, A, B. + +When we come to compile A, we will perform the necessary hydration steps, +because A has a boot file. This means that C will be hydrated relative to A, +and the ModDetails for A will reference C/A. Then, when B is compiled, +C will be rehydrated again, and so B will reference C/A,B. At this point, +its interface will be hydrated relative to both A and B. +This causes a space leak: there are now two different copies of C's ModDetails, +kept alive by modules A and B. This is especially problematic if C is large. + +The way to avoid this space leak is to rehydrate an entire SCC together at the +end of compilation, so that all the ModDetails point to interfaces for .hs files. +In this example, when we hydrate A, B and C together, then both A and B will refer to +C/A,B. + +See #21900 for some more discussion. + +== Modules "above" the loop + +This dark corner is the subject of #14092. + +Suppose we add to our example +``` +X.hs module X where + import A + data XT = MkX T + fx = ...g... +``` +If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the argument type of `MkX`. So: + +* Either we should delay compiling X until after R has been compiled. (This is what we do) +* Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot. + +Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode. +#20200 has lots of issues, many of them now fixed; +this particular issue starts [here](https://gitlab.haskell.org/ghc/ghc/-/issues/20200#note_385758). + +The wiki page [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot) is helpful. +Also closely related are + * #14092 + * #14103 + +-} + +executeLinkNode :: HomeUnitGraph -> (Int, Int) -> UnitId -> [NodeKey] -> RunMakeM () +executeLinkNode hug kn uid deps = do + withCurrentUnit uid $ do + MakeEnv{..} <- ask + let dflags = hsc_dflags hsc_env + let hsc_env' = setHUG hug hsc_env + msg' = (\messager -> \recomp -> messager hsc_env kn recomp (LinkNode deps uid)) <$> env_messager + + linkresult <- liftIO $ withAbstractSem compile_sem $ do + link (ghcLink dflags) + (hsc_logger hsc_env') + (hsc_tmpfs hsc_env') + (hsc_FC hsc_env') + (hsc_hooks hsc_env') + dflags + (hsc_unit_env hsc_env') + True -- We already decided to link + msg' + (hsc_HPT hsc_env') + case linkresult of + Failed -> fail "Link Failed" + Succeeded -> return () + +-- | Wait for dependencies to finish, and then return their results. +wait_deps :: [BuildResult] -> RunMakeM [HomeModInfo] +wait_deps [] = return [] +wait_deps (x:xs) = do + res <- lift $ waitResult (resultVar x) + hmis <- wait_deps xs + case res of + Nothing -> return hmis + Just hmi -> return (hmi:hmis) + + +{- Note [GHC Heap Invariants] + ~~~~~~~~~~~~~~~~~~~~~~~~~~ +This note is a general place to explain some of the heap invariants which should +hold for a program compiled with --make mode. These invariants are all things +which can be checked easily using ghc-debug. + +1. No HomeModInfo are reachable via the EPS. + Why? Interfaces are lazily loaded into the EPS and the lazy thunk retains + a reference to the entire HscEnv, if we are not careful the HscEnv will + contain the HomePackageTable at the time the interface was loaded and + it will never be released. + Where? dontLeakTheHUG in GHC.Iface.Load + +2. No KnotVars are live at the end of upsweep (#20491) + Why? KnotVars contains an old stale reference to the TypeEnv for modules + which participate in a loop. At the end of a loop all the KnotVars references + should be removed by the call to typecheckLoop. + Where? typecheckLoop in GHC.Driver.Make. + +3. Immediately after a reload, no ModDetails are live. + Why? During the upsweep all old ModDetails are replaced with a new ModDetails + generated from a ModIface. If we don't clear the ModDetails before the + reload takes place then memory usage during the reload is twice as much + as it should be as we retain a copy of the ModDetails for too long. + Where? pruneCache in GHC.Driver.Make + +4. No TcGblEnv or TcLclEnv are live after typechecking is completed. + Why? By the time we get to simplification all the data structures from typechecking + should be eliminated. + Where? No one place in the compiler. These leaks can be introduced by not suitable + forcing functions which take a TcLclEnv as an argument. + +5. At the end of a successful upsweep, the number of live ModDetails equals the + number of non-boot Modules. + Why? Each module has a HomeModInfo which contains a ModDetails from that module. -} diff --git a/GHC/Driver/MakeAction.hs b/GHC/Driver/MakeAction.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/MakeAction.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE CPP #-} +module GHC.Driver.MakeAction + ( MakeAction(..) + , MakeEnv(..) + , RunMakeM + -- * Running the pipelines + , runAllPipelines + , runParPipelines + , runSeqPipelines + , runPipelines + -- * Worker limit + , WorkerLimit(..) + , mkWorkerLimit + , runWorkerLimit + -- * Utility + , withLoggerHsc + , withParLog + , withLocalTmpFS + , withLocalTmpFSMake + ) where + +import GHC.Prelude +import GHC.Driver.DynFlags + +import GHC.Driver.Monad +import GHC.Driver.Env +import GHC.Driver.Errors.Types +import GHC.Driver.Messager +import GHC.Driver.MakeSem + +import GHC.Utils.Logger +import GHC.Utils.TmpFs + +import Control.Concurrent ( newQSem, waitQSem, signalQSem, ThreadId, killThread, forkIOWithUnmask ) +import qualified GHC.Conc as CC +import Control.Concurrent.MVar +import Control.Monad +import qualified Control.Monad.Catch as MC + +import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities ) +import Control.Monad.Trans.Reader +import GHC.Driver.Pipeline.LogQueue +import Control.Concurrent.STM +import Control.Monad.Trans.Maybe + +-- Executing the pipelines + +mkWorkerLimit :: DynFlags -> IO WorkerLimit +mkWorkerLimit dflags = + case parMakeCount dflags of + Nothing -> pure $ num_procs 1 + Just (ParMakeSemaphore h) -> pure (JSemLimit (SemaphoreName h)) + Just ParMakeNumProcessors -> num_procs <$> getNumProcessors + Just (ParMakeThisMany n) -> pure $ num_procs n + where + num_procs x = NumProcessorsLimit (max 1 x) + +isWorkerLimitSequential :: WorkerLimit -> Bool +isWorkerLimitSequential (NumProcessorsLimit x) = x <= 1 +isWorkerLimitSequential (JSemLimit {}) = False + +-- | This describes what we use to limit the number of jobs, either we limit it +-- ourselves to a specific number or we have an external parallelism semaphore +-- limit it for us. +data WorkerLimit + = NumProcessorsLimit Int + | JSemLimit + SemaphoreName + -- ^ Semaphore name to use + deriving Eq + +-- | Environment used when compiling a module +data MakeEnv = MakeEnv { hsc_env :: !HscEnv -- The basic HscEnv which will be augmented for each module + , compile_sem :: !AbstractSem + -- Modify the environment for module k, with the supplied logger modification function. + -- For -j1, this wrapper doesn't do anything + -- For -jn, the wrapper initialised a log queue and then modifies the logger to pipe its output + -- into the log queue. + , withLogger :: forall a . Int -> ((Logger -> Logger) -> IO a) -> IO a + , env_messager :: !(Maybe Messager) + , diag_wrapper :: GhcMessage -> AnyGhcDiagnostic + } + + +label_self :: String -> IO () +label_self thread_name = do + self_tid <- CC.myThreadId + CC.labelThread self_tid thread_name + + +runPipelines :: WorkerLimit -> HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () +-- Don't even initialise plugins if there are no pipelines +runPipelines n_job hsc_env diag_wrapper mHscMessager all_pipelines = do + liftIO $ label_self "main --make thread" + case n_job of + NumProcessorsLimit n | n <= 1 -> runSeqPipelines hsc_env diag_wrapper mHscMessager all_pipelines + _n -> runParPipelines n_job hsc_env diag_wrapper mHscMessager all_pipelines + +runSeqPipelines :: HscEnv -> (GhcMessage -> AnyGhcDiagnostic) -> Maybe Messager -> [MakeAction] -> IO () +runSeqPipelines plugin_hsc_env diag_wrapper mHscMessager all_pipelines = + let env = MakeEnv { hsc_env = plugin_hsc_env + , withLogger = \_ k -> k id + , compile_sem = AbstractSem (return ()) (return ()) + , env_messager = mHscMessager + , diag_wrapper = diag_wrapper + } + in runAllPipelines (NumProcessorsLimit 1) env all_pipelines + +runNjobsAbstractSem :: Int -> (AbstractSem -> IO a) -> IO a +runNjobsAbstractSem n_jobs action = do + compile_sem <- newQSem n_jobs + n_capabilities <- getNumCapabilities + n_cpus <- getNumProcessors + let + asem = AbstractSem (waitQSem compile_sem) (signalQSem compile_sem) + set_num_caps n = unless (n_capabilities /= 1) $ setNumCapabilities n + updNumCapabilities = do + -- Setting number of capabilities more than + -- CPU count usually leads to high userspace + -- lock contention. #9221 + set_num_caps $ min n_jobs n_cpus + resetNumCapabilities = set_num_caps n_capabilities + MC.bracket_ updNumCapabilities resetNumCapabilities $ action asem + +runWorkerLimit :: WorkerLimit -> (AbstractSem -> IO a) -> IO a +#if defined(wasm32_HOST_ARCH) +runWorkerLimit _ action = do + lock <- newMVar () + action $ AbstractSem (takeMVar lock) (putMVar lock ()) +#else +runWorkerLimit worker_limit action = case worker_limit of + NumProcessorsLimit n_jobs -> + runNjobsAbstractSem n_jobs action + JSemLimit sem -> + runJSemAbstractSem sem action +#endif + +-- | Build and run a pipeline +runParPipelines :: WorkerLimit -- ^ How to limit work parallelism + -> HscEnv -- ^ The basic HscEnv which is augmented with specific info for each module + -> (GhcMessage -> AnyGhcDiagnostic) + -> Maybe Messager -- ^ Optional custom messager to use to report progress + -> [MakeAction] -- ^ The build plan for all the module nodes + -> IO () +runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipelines = do + + + -- A variable which we write to when an error has happened and we have to tell the + -- logging thread to gracefully shut down. + stopped_var <- newTVarIO False + -- The queue of LogQueues which actions are able to write to. When an action starts it + -- will add it's LogQueue into this queue. + log_queue_queue_var <- newTVarIO newLogQueueQueue + -- Thread which coordinates the printing of logs + wait_log_thread <- logThread (hsc_logger plugin_hsc_env) stopped_var log_queue_queue_var + + + -- Make the logger thread-safe, in case there is some output which isn't sent via the LogQueue. + thread_safe_logger <- liftIO $ makeThreadSafe (hsc_logger plugin_hsc_env) + let thread_safe_hsc_env = plugin_hsc_env { hsc_logger = thread_safe_logger } + + runWorkerLimit worker_limit $ \abstract_sem -> do + let env = MakeEnv { hsc_env = thread_safe_hsc_env + , withLogger = withParLog log_queue_queue_var + , compile_sem = abstract_sem + , env_messager = mHscMessager + , diag_wrapper = diag_wrapper + } + -- Reset the number of capabilities once the upsweep ends. + runAllPipelines worker_limit env all_pipelines + atomically $ writeTVar stopped_var True + wait_log_thread + +withLoggerHsc :: Int -> MakeEnv -> (HscEnv -> IO a) -> IO a +withLoggerHsc k MakeEnv{withLogger, hsc_env} cont = do + withLogger k $ \modifyLogger -> do + let lcl_logger = modifyLogger (hsc_logger hsc_env) + hsc_env' = hsc_env { hsc_logger = lcl_logger } + -- Run continuation with modified logger + cont hsc_env' + +withParLog :: TVar LogQueueQueue -> Int -> ((Logger -> Logger) -> IO b) -> IO b +withParLog lqq_var k cont = do + let init_log = do + -- Make a new log queue + lq <- newLogQueue k + -- Add it into the LogQueueQueue + atomically $ initLogQueue lqq_var lq + return lq + finish_log lq = liftIO (finishLogQueue lq) + MC.bracket init_log finish_log $ \lq -> cont (pushLogHook (const (parLogAction lq))) + +withLocalTmpFS :: TmpFs -> (TmpFs -> IO a) -> IO a +withLocalTmpFS tmpfs act = do + let initialiser = do + liftIO $ forkTmpFsFrom tmpfs + finaliser tmpfs_local = do + liftIO $ mergeTmpFsInto tmpfs_local tmpfs + -- Add remaining files which weren't cleaned up into local tmp fs for + -- clean-up later. + -- Clear the logQueue if this node had it's own log queue + MC.bracket initialiser finaliser act + +withLocalTmpFSMake :: MakeEnv -> (MakeEnv -> IO a) -> IO a +withLocalTmpFSMake env k = + withLocalTmpFS (hsc_tmpfs (hsc_env env)) $ \lcl_tmpfs + -> k (env { hsc_env = (hsc_env env) { hsc_tmpfs = lcl_tmpfs }}) + + +-- | Run the given actions and then wait for them all to finish. +runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO () +runAllPipelines worker_limit env acts = do + let single_worker = isWorkerLimitSequential worker_limit + spawn_actions :: IO [ThreadId] + spawn_actions = if single_worker + then (:[]) <$> (forkIOWithUnmask $ \unmask -> void $ runLoop (\io -> io unmask) env acts) + else runLoop forkIOWithUnmask env acts + + kill_actions :: [ThreadId] -> IO () + kill_actions tids = mapM_ killThread tids + + MC.bracket spawn_actions kill_actions $ \_ -> do + mapM_ waitMakeAction acts + +-- | Execute each action in order, limiting the amount of parallelism by the given +-- semaphore. +runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a] +runLoop _ _env [] = return [] +runLoop fork_thread env (MakeAction act res_var :acts) = do + + -- withLocalTmpFs has to occur outside of fork to remain deterministic + new_thread <- withLocalTmpFSMake env $ \lcl_env -> + fork_thread $ \unmask -> (do + mres <- (unmask $ run_pipeline lcl_env act) + `MC.onException` (putMVar res_var Nothing) -- Defensive: If there's an unhandled exception then still signal the failure. + putMVar res_var mres) + threads <- runLoop fork_thread env acts + return (new_thread : threads) + where + run_pipeline :: MakeEnv -> RunMakeM a -> IO (Maybe a) + run_pipeline env p = runMaybeT (runReaderT p env) + +type RunMakeM a = ReaderT MakeEnv (MaybeT IO) a + +data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a)) + +waitMakeAction :: MakeAction -> IO () +waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar diff --git a/GHC/Driver/MakeFile.hs b/GHC/Driver/MakeFile.hs --- a/GHC/Driver/MakeFile.hs +++ b/GHC/Driver/MakeFile.hs @@ -10,6 +10,7 @@ module GHC.Driver.MakeFile ( doMkDependHS + , doMkDependModuleGraph ) where @@ -53,6 +54,7 @@ import Data.IORef import qualified Data.Set as Set import GHC.Iface.Errors.Types +import Data.Either ----------------------------------------------------------------- -- @@ -62,8 +64,6 @@ doMkDependHS :: GhcMonad m => [FilePath] -> m () doMkDependHS srcs = do - logger <- getLogger - -- Initialisation dflags0 <- GHC.getSessionDynFlags @@ -85,17 +85,22 @@ then dflags1 { depSuffixes = [""] } else dflags1 - tmpfs <- hsc_tmpfs <$> getSession - files <- liftIO $ beginMkDependHS logger tmpfs dflags - -- Do the downsweep to find all the modules targets <- mapM (\s -> GHC.guessTarget s Nothing Nothing) srcs GHC.setTargets targets let excl_mods = depExcludeMods dflags module_graph <- GHC.depanal excl_mods True {- Allow dup roots -} + doMkDependModuleGraph dflags module_graph - -- Sort into dependency order - -- There should be no cycles + + +doMkDependModuleGraph :: GhcMonad m => DynFlags -> ModuleGraph -> m () +doMkDependModuleGraph dflags module_graph = do + logger <- getLogger + tmpfs <- hsc_tmpfs <$> getSession + let excl_mods = depExcludeMods dflags + + files <- liftIO $ beginMkDependHS logger tmpfs dflags let sorted = GHC.topSortModuleGraph False module_graph Nothing -- Print out the dependencies if wanted @@ -221,8 +226,11 @@ GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return () - -processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ node)) +processDeps _dflags _ _ _ _ (AcyclicSCC (UnitNode {})) = return () +processDeps _ _ _ _ _ (AcyclicSCC (ModuleNode _ (ModuleNodeFixed {}))) + -- No dependencies needed for fixed modules (already compiled) + = return () +processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ (ModuleNodeCompile node))) = do { let extra_suffixes = depSuffixes dflags include_pkg_deps = depIncludePkgDeps dflags src_file = msHsFilePath node @@ -274,10 +282,10 @@ ; let do_imps is_boot idecls = sequence_ [ do_imp loc is_boot mb_pkg mod - | (mb_pkg, L loc mod) <- idecls, + | (_lvl, mb_pkg, L loc mod) <- idecls, mod `notElem` excl_mods ] - ; do_imps IsBoot (ms_srcimps node) + ; do_imps IsBoot (map ((,,) NormalLevel NoPkgQual) (ms_srcimps node)) ; do_imps NotBoot (ms_imps node) } @@ -292,12 +300,12 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do -- Find the module; this will be fast because -- we've done it once during downsweep - r <- findImportedModule hsc_env imp pkg + r <- findImportedModuleWithIsBoot hsc_env imp is_boot pkg case r of Found loc _ -- Home package: just depend on the .hi or hi-boot file | isJust (ml_hs_file loc) || include_pkg_deps - -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ospath loc))) + -> return (Just (ml_hi_file loc)) -- Not in this package: we don't need a dependency | otherwise @@ -403,43 +411,63 @@ -- Print a cycle, but show only the imports within the cycle pprCycle summaries = pp_group (CyclicSCC summaries) where - cycle_mods :: [ModuleName] -- The modules in this cycle - cycle_mods = map (moduleName . ms_mod) [ms | ModuleNode _ ms <- summaries] + cycle_keys :: [NodeKey] -- The modules in this cycle + cycle_keys = map mkNodeKey summaries pp_group :: SCC ModuleGraphNode -> SDoc - pp_group (AcyclicSCC (ModuleNode _ ms)) = pp_ms ms + pp_group (AcyclicSCC (ModuleNode deps m)) = pp_mod deps m pp_group (AcyclicSCC _) = empty pp_group (CyclicSCC mss) = assert (not (null boot_only)) $ -- The boot-only list must be non-empty, else there would -- be an infinite chain of non-boot imports, and we've -- already checked for that in processModDeps - pp_ms loop_breaker $$ vcat (map pp_group groups) + pp_mod loop_deps loop_breaker $$ vcat (map pp_group groups) where - (boot_only, others) = partition is_boot_only mss - is_boot_only (ModuleNode _ ms) = not (any in_group (map snd (ms_imps ms))) - is_boot_only _ = False - in_group (L _ m) = m `elem` group_mods - group_mods = map (moduleName . ms_mod) [ms | ModuleNode _ ms <- mss] + (boot_only, others) = partitionEithers (map is_boot_only mss) + is_boot_key (NodeKey_Module (ModNodeKeyWithUid (GWIB _ IsBoot) _)) = True + is_boot_key _ = False + is_boot_only n@(ModuleNode deps ms) = + let dep_mods = map edgeTargetKey deps + non_boot_deps = filter (not . is_boot_key) dep_mods + in if not (any in_group non_boot_deps) + then Left (deps, ms) + else Right n + is_boot_only n = Right n + in_group m = m `elem` group_mods + group_mods = map mkNodeKey mss - loop_breaker = head ([ms | ModuleNode _ ms <- boot_only]) - all_others = tail boot_only ++ others + (loop_deps, loop_breaker) = head boot_only + all_others = tail (map (uncurry ModuleNode) boot_only) ++ others groups = GHC.topSortModuleGraph True (mkModuleGraph all_others) Nothing - pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' ')) - <+> (pp_imps empty (map snd (ms_imps summary)) $$ - pp_imps (text "{-# SOURCE #-}") (map snd (ms_srcimps summary))) - where - mod_str = moduleNameString (moduleName (ms_mod summary)) + pp_mod :: [ModuleNodeEdge] -> ModuleNodeInfo -> SDoc + pp_mod deps mn = + text mod_str <> text (take (20 - length mod_str) (repeat ' ')) <> ppr_deps (map edgeTargetKey deps) + where + mod_str = moduleNameString (moduleNodeInfoModuleName mn) - pp_imps :: SDoc -> [Located ModuleName] -> SDoc - pp_imps _ [] = empty - pp_imps what lms - = case [m | L _ m <- lms, m `elem` cycle_mods] of - [] -> empty - ms -> what <+> text "imports" <+> - pprWithCommas ppr ms + ppr_deps :: [NodeKey] -> SDoc + ppr_deps [] = empty + ppr_deps deps = + let is_mod_dep (NodeKey_Module {}) = True + is_mod_dep _ = False + + is_boot_dep (NodeKey_Module (ModNodeKeyWithUid (GWIB _ IsBoot) _)) = True + is_boot_dep _ = False + + cycle_deps = filter (`elem` cycle_keys) deps + (mod_deps, other_deps) = partition is_mod_dep cycle_deps + (boot_deps, normal_deps) = partition is_boot_dep mod_deps + in vcat [ + if null normal_deps then empty + else text "imports" <+> pprWithCommas ppr normal_deps, + if null boot_deps then empty + else text "{-# SOURCE #-} imports" <+> pprWithCommas ppr boot_deps, + if null other_deps then empty + else text "depends on" <+> pprWithCommas ppr other_deps + ] ----------------------------------------------------------------- -- diff --git a/GHC/Driver/Messager.hs b/GHC/Driver/Messager.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/Messager.hs @@ -0,0 +1,66 @@ +module GHC.Driver.Messager (Messager, oneShotMsg, batchMsg, batchMultiMsg, showModuleIndex) where + +import GHC.Prelude +import GHC.Driver.Env +import GHC.Unit.Module.Graph +import GHC.Iface.Recomp +import GHC.Utils.Logger +import GHC.Utils.Outputable +import GHC.Utils.Error +import GHC.Unit.State + +type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModuleGraphNode -> IO () + +-------------------------------------------------------------- +-- Progress displayers. +-------------------------------------------------------------- + +oneShotMsg :: Logger -> RecompileRequired -> IO () +oneShotMsg logger recomp = + case recomp of + UpToDate -> compilationProgressMsg logger $ text "compilation IS NOT required" + NeedsRecompile _ -> return () + +batchMsg :: Messager +batchMsg = batchMsgWith (\_ _ _ _ -> empty) +batchMultiMsg :: Messager +batchMultiMsg = batchMsgWith (\_ _ _ node -> brackets (ppr (mgNodeUnitId node))) + +batchMsgWith :: (HscEnv -> (Int, Int) -> RecompileRequired -> ModuleGraphNode -> SDoc) -> Messager +batchMsgWith extra hsc_env_start mod_index recomp node = + case recomp of + UpToDate + | logVerbAtLeast logger 2 -> showMsg (text "Skipping") empty + | otherwise -> return () + NeedsRecompile reason0 -> showMsg (text herald) $ case reason0 of + MustCompile -> empty + (RecompBecause reason) -> text " [" <> pprWithUnitState state (ppr reason) <> text "]" + where + herald = case node of + LinkNode {} -> "Linking" + InstantiationNode {} -> "Instantiating" + ModuleNode {} -> "Compiling" + UnitNode {} -> "Loading" + hsc_env = hscSetActiveUnitId (mgNodeUnitId node) hsc_env_start + dflags = hsc_dflags hsc_env + logger = hsc_logger hsc_env + state = hsc_units hsc_env + showMsg msg reason = + compilationProgressMsg logger $ + (showModuleIndex mod_index <> + msg <+> showModMsg dflags (recompileRequired recomp) node) + <> extra hsc_env mod_index recomp node + <> reason + +{- ********************************************************************** +%* * + Progress Messages: Module i of n +%* * +%********************************************************************* -} + +showModuleIndex :: (Int, Int) -> SDoc +showModuleIndex (i,n) = text "[" <> pad <> int i <> text " of " <> int n <> text "] " + where + -- compute the length of x > 0 in base 10 + len x = ceiling (logBase 10 (fromIntegral x+1) :: Float) + pad = text (replicate (len n - len i) ' ') -- TODO: use GHC.Utils.Ppr.RStr diff --git a/GHC/Driver/Phases.hs b/GHC/Driver/Phases.hs --- a/GHC/Driver/Phases.hs +++ b/GHC/Driver/Phases.hs @@ -23,6 +23,7 @@ isDynLibSuffix, isHaskellUserSrcSuffix, isHaskellSigSuffix, + isHaskellBootSuffix, isSourceSuffix, isHaskellishTarget, @@ -234,7 +235,7 @@ phaseInputExt StopLn = "o" haskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes, - js_suffixes, haskellish_user_src_suffixes, haskellish_sig_suffixes + js_suffixes, haskellish_user_src_suffixes, haskellish_sig_suffixes, haskellish_boot_suffixes :: [String] -- When a file with an extension in the haskellish_src_suffixes group is -- loaded in --make mode, its imports will be loaded too. @@ -247,7 +248,8 @@ -- Will not be deleted as temp files: haskellish_user_src_suffixes = - haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ] + haskellish_sig_suffixes ++ haskellish_boot_suffixes ++ [ "hs", "lhs" ] +haskellish_boot_suffixes = [ "hs-boot", "lhs-boot" ] haskellish_sig_suffixes = [ "hsig", "lhsig" ] backpackish_suffixes = [ "bkp" ] @@ -265,11 +267,12 @@ _ -> ["so"] isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix, - isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix + isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix, isHaskellBootSuffix :: String -> Bool isHaskellishSuffix s = s `elem` haskellish_suffixes isBackpackishSuffix s = s `elem` backpackish_suffixes isHaskellSigSuffix s = s `elem` haskellish_sig_suffixes +isHaskellBootSuffix s = s `elem` haskellish_boot_suffixes isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes isCishSuffix s = s `elem` cish_suffixes isJsSuffix s = s `elem` js_suffixes diff --git a/GHC/Driver/Pipeline.hs b/GHC/Driver/Pipeline.hs --- a/GHC/Driver/Pipeline.hs +++ b/GHC/Driver/Pipeline.hs @@ -44,6 +44,7 @@ import GHC.Prelude +import GHC.Builtin.Names import GHC.Platform @@ -91,6 +92,7 @@ import GHC.Data.Maybe ( expectJust ) import GHC.Iface.Make ( mkFullIface ) +import GHC.Iface.Load ( getGhcPrimIface ) import GHC.Runtime.Loader ( initializePlugins ) @@ -105,11 +107,10 @@ import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder ---import GHC.Unit.State import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface -import GHC.Unit.Module.Deps import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable import System.Directory import System.FilePath @@ -253,7 +254,7 @@ where lcl_dflags = ms_hspp_opts summary location = ms_location summary - input_fn = expectJust "compile:hs" (ml_hs_file location) + input_fn = expectJust (ml_hs_file location) input_fnpp = ms_hspp_file summary pipelineOutput = backendPipelineOutput bcknd @@ -403,18 +404,18 @@ LinkStaticLib -> True _ -> False - home_mod_infos = eltsHpt hpt + -- the packages we depend on + -- TODO: This should be a query on the 'ModuleGraph', since we need to + -- know which packages are actually needed at the runtime stage. + pkg_deps <- map snd . Set.toList <$> hptCollectDependencies hpt - -- the packages we depend on - pkg_deps = Set.toList - $ Set.unions - $ fmap (dep_direct_pkgs . mi_deps . hm_iface) - $ home_mod_infos + -- the linkables to link + linkables <- hptCollectObjects hpt - -- the linkables to link - linkables = map (expectJust "link". homeModInfoObject) home_mod_infos + -- the home modules, for tracing + home_modules <- hptCollectModules hpt - debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map (ppr . mi_module . hm_iface) home_mod_infos)) + debugTraceMsg logger 3 (text "link: hmi ..." $$ vcat (map ppr home_modules)) debugTraceMsg logger 3 (text "link: linkables are ..." $$ vcat (map ppr linkables)) debugTraceMsg logger 3 (text "link: pkg deps are ..." $$ vcat (map ppr pkg_deps)) @@ -472,7 +473,7 @@ -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). let platform = ue_platform unit_env - unit_state = ue_units unit_env + unit_state = ue_homeUnitState unit_env arch_os = platformArchOS platform exe_file = exeFileName arch_os staticLink (outputFile_ dflags) e_exe_time <- tryIO $ getModificationUTCTime exe_file @@ -820,7 +821,13 @@ let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject)) -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend. return (mlinkable { homeMod_object = Just linkable }) - return (miface, final_linkable) + + -- when building ghc-internal with --make (e.g. with cabal-install), we want + -- the virtual interface for gHC_PRIM in the cache, not the empty one. + let miface_final + | ms_mod mod_sum == gHC_PRIM = getGhcPrimIface (hsc_hooks hsc_env) + | otherwise = miface + return (miface_final, final_linkable) asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile) asPipeline use_cpp pipe_env hsc_env location input_fn = diff --git a/GHC/Driver/Pipeline.hs-boot b/GHC/Driver/Pipeline.hs-boot --- a/GHC/Driver/Pipeline.hs-boot +++ b/GHC/Driver/Pipeline.hs-boot @@ -3,12 +3,22 @@ import GHC.Driver.Env.Types ( HscEnv ) import GHC.ForeignSrcLang ( ForeignSrcLang ) -import GHC.Prelude (FilePath, IO) +import GHC.Prelude (FilePath, IO, Maybe, Either) import GHC.Unit.Module.Location (ModLocation) import GHC.Driver.Session (DynFlags) +import GHC.Driver.Phases (Phase) +import GHC.Driver.Errors.Types (DriverMessages) +import GHC.Types.Target (InputFileBuffer) import Language.Haskell.Syntax.Module.Name -- These are used in GHC.Driver.Pipeline.Execute, but defined in terms of runPipeline compileForeign :: HscEnv -> ForeignSrcLang -> FilePath -> IO FilePath compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO () + +preprocess :: HscEnv + -> FilePath + -> Maybe InputFileBuffer + -> Maybe Phase + -> IO (Either DriverMessages (DynFlags, FilePath)) + diff --git a/GHC/Driver/Pipeline/Execute.hs b/GHC/Driver/Pipeline/Execute.hs --- a/GHC/Driver/Pipeline/Execute.hs +++ b/GHC/Driver/Pipeline/Execute.hs @@ -4,7 +4,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GADTs #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} #include {- Functions for providing the default interpretation of the 'TPhase' actions @@ -34,6 +33,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Types.SrcLoc import GHC.Driver.Main +import GHC.Driver.Downsweep import GHC.Tc.Types import GHC.Types.Error import GHC.Driver.Errors.Types @@ -42,7 +42,6 @@ import GHC.Utils.TmpFs import GHC.Platform import Data.List (intercalate, isInfixOf) -import qualified Data.List.NonEmpty as NE import GHC.Unit.Env import GHC.Utils.Error import Data.Maybe @@ -69,7 +68,6 @@ import GHC.Platform.Ways import GHC.Driver.LlvmConfigCache (readLlvmConfigCache) import GHC.CmmToLlvm.Config (LlvmTarget (..), LlvmConfig (..)) -import GHC.CmmToLlvm.Version.Type (LlvmVersion (..)) import {-# SOURCE #-} GHC.Driver.Pipeline (compileForeign, compileEmptyStub) import GHC.Settings import System.IO @@ -230,9 +228,8 @@ 1 -> "-O1" _ -> "-O2" - llvm_version <- figureLlvmVersion logger dflags - let defaultOptions = map GHC.SysTools.Option . concatMap words . snd - $ unzip (llvmOptions llvm_config llvm_version dflags) + defaultOptions = map GHC.SysTools.Option . concatMap words . snd + $ unzip (llvmOptions llvm_config dflags) optFlag = if null (getOpts dflags opt_lc) then map GHC.SysTools.Option $ words llvmOpts else [] @@ -267,9 +264,8 @@ Nothing -> panic ("runPhase LlvmOpt: llvm-passes file " ++ "is missing passes for level " ++ show optIdx) - llvm_version <- figureLlvmVersion logger dflags - let defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst - $ unzip (llvmOptions llvm_config llvm_version dflags) + defaultOptions = map GHC.SysTools.Option . concat . fmap words . fst + $ unzip (llvmOptions llvm_config dflags) -- don't specify anything if user has specified commands. We do this -- for opt but not llc since opt is very specifically for optimisation @@ -482,7 +478,7 @@ -- very weakly typed, being derived from C--. ["-fno-strict-aliasing"] - ghcVersionH <- getGhcVersionPathName dflags unit_env + ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env withAtomicRename output_fn $ \temp_outputFilename -> GHC.SysTools.runCc (phaseForeignLanguage cc_phase) logger tmpfs dflags ( @@ -516,7 +512,7 @@ Just hu | isHomeUnitId hu ghcInternalUnitId , platformOS platform == OSMinGW32 - -> ["-DCOMPILING_BASE_PACKAGE"] + -> ["-DCOMPILING_GHC_INTERNAL_PACKAGE"] _ -> []) -- GCC 4.6+ doesn't like -Wimplicit when compiling C++. @@ -529,7 +525,7 @@ else []) ++ verbFlags ++ cc_opt - ++ [ "-include", ghcVersionH ] + ++ ghcVersionH ++ framework_paths ++ include_paths ++ pkg_extra_cc_opts @@ -564,7 +560,7 @@ HsigFile -> do -- We need to create a REAL but empty .o file -- because we are going to attempt to put it in a library - let input_fn = expectJust "runPhase" (ml_hs_file location) + let input_fn = expectJust (ml_hs_file location) basename = dropExtension input_fn compileEmptyStub dflags hsc_env basename location mod_name @@ -662,10 +658,11 @@ getFileArgs :: HscEnv -> FilePath -> IO ((DynFlags, Messages PsMessage, Messages DriverMessage)) getFileArgs hsc_env input_fn = do let dflags0 = hsc_dflags hsc_env + logger = hsc_logger hsc_env parser_opts = initParserOpts dflags0 - (warns0, src_opts) <- getOptionsFromFile parser_opts input_fn + (warns0, src_opts) <- getOptionsFromFile parser_opts (supportedLanguagePragmas dflags0) input_fn (dflags1, unhandled_flags, warns) - <- parseDynamicFilePragma dflags0 src_opts + <- parseDynamicFilePragma logger dflags0 src_opts checkProcessArgsResult unhandled_flags return (dflags1, warns0, warns) @@ -707,17 +704,17 @@ hsc_env <- initializePlugins hsc_env1 -- gather the imports and module name - (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do + (hspp_buf,mod_name,imps,src_imps) <- do buf <- hGetStringBuffer input_fn let imp_prelude = xopt LangExt.ImplicitPrelude dflags popts = initParserOpts dflags rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) - rn_imps = fmap (\(rpk, lmn@(L _ mn)) -> (rn_pkg_qual mn rpk, lmn)) + rn_imps = fmap (\(s, rpk, lmn@(L _ mn)) -> (s, rn_pkg_qual mn rpk, lmn)) eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff) case eimps of Left errs -> throwErrors (GhcPsMessage <$> errs) - Right (src_imps,imps, ghc_prim_imp, L _ mod_name) -> return - (Just buf, mod_name, rn_imps imps, rn_imps src_imps, ghc_prim_imp) + Right (src_imps,imps, L _ mod_name) -> return + (Just buf, mod_name, rn_imps imps, src_imps) -- Take -o into account if present -- Very like -ohi, but we must *only* do this if we aren't linking @@ -740,7 +737,7 @@ mod <- do let home_unit = hsc_home_unit hsc_env let fc = hsc_FC hsc_env - addHomeModuleToFinder fc home_unit (GWIB mod_name (hscSourceToIsBoot src_flavour)) location + addHomeModuleToFinder fc home_unit mod_name location src_flavour -- Make the ModSummary to hand to hscMain let @@ -756,7 +753,6 @@ ms_parsed_mod = Nothing, ms_iface_date = hi_date, ms_hie_date = hie_date, - ms_ghc_prim_import = ghc_prim_imp, ms_textual_imps = imps, ms_srcimps = src_imps } @@ -765,12 +761,19 @@ let msg :: Messager msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what + -- A lazy module graph thunk, don't force it unless you need it! + mg <- downsweepThunk hsc_env mod_summary + -- Need to set the knot-tying mutable variable for interface -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. -- See also Note [hsc_type_env_var hack] type_env_var <- newIORef emptyNameEnv - let hsc_env' = hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } + let hsc_env' = + setModuleGraph mg + hsc_env { hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(mod, type_env_var)]) } + + status <- hscRecompStatus (Just msg) hsc_env' mod_summary Nothing emptyHomeModInfoLinkable (1, 1) @@ -783,24 +786,18 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) - - -- Boot-ify it if necessary - let location2 - | HsBootFile <- src_flavour = addBootSuffixLocnOut location1 - | otherwise = location1 - + let location1 = mkHomeModLocation fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) src_flavour -- Take -ohi into account if present -- This can't be done in mkHomeModuleLocation because -- it only applies to the module being compiles let ohi = outputHi dflags - location3 | Just fn <- ohi = location2{ ml_hi_file_ospath = unsafeEncodeUtf fn } - | otherwise = location2 + location2 | Just fn <- ohi = location1{ ml_hi_file_ospath = unsafeEncodeUtf fn } + | otherwise = location1 let dynohi = dynOutputHi dflags - location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn } - | otherwise = location3 + location3 | Just fn <- dynohi = location2{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn } + | otherwise = location2 -- Take -o into account if present -- Very like -ohi, but we must *only* do this if we aren't linking @@ -813,11 +810,11 @@ location5 | Just ofile <- expl_o_file , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file , isNoLink (ghcLink dflags) - = location4 { ml_obj_file_ospath = unsafeEncodeUtf ofile + = location3 { ml_obj_file_ospath = unsafeEncodeUtf ofile , ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } | Just dyn_ofile <- expl_dyn_o_file - = location4 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } - | otherwise = location4 + = location3 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile } + | otherwise = location3 return location5 where fopts = initFinderOpts dflags @@ -962,21 +959,12 @@ -- | LLVM Options. These are flags to be passed to opt and llc, to ensure -- consistency we list them in pairs, so that they form groups. llvmOptions :: LlvmConfig - -> Maybe LlvmVersion -> DynFlags -> [(String, String)] -- ^ pairs of (opt, llc) arguments -llvmOptions llvm_config llvm_version dflags = +llvmOptions llvm_config dflags = [("-relocation-model=" ++ rmodel ,"-relocation-model=" ++ rmodel) | not (null rmodel)] - -- Both llc/opt need these flags for split sections - ++ [ ("--data-sections", "--data-sections") - | gopt Opt_SplitSections dflags - ] - ++ [ ("--function-sections", "--function-sections") - | gopt Opt_SplitSections dflags - ] - -- Additional llc flags ++ [("", "-mcpu=" ++ mcpu) | not (null mcpu) , not (any (isInfixOf "-mcpu") (getOpts dflags opt_lc)) ] @@ -985,7 +973,7 @@ where target = platformMisc_llvmTarget $ platformMisc dflags target_os = platformOS (targetPlatform dflags) - Just (LlvmTarget _ mcpu mattr) = lookup target (llvmTargets llvm_config) + LlvmTarget _ mcpu mattr = expectJust $ lookup target (llvmTargets llvm_config) -- Relocation models rmodel | gopt Opt_PIC dflags @@ -1007,13 +995,12 @@ -- LLVM gates POPCNT instructions behind the popcnt flag, -- while the GHC NCG (as well as GCC, Clang) gates it -- behind SSE4.2 instead. + ++ ["+sse4.1" | isSse4_1Enabled dflags ] + ++ ["+ssse3" | isSsse3Enabled dflags ] + ++ ["+sse3" | isSse3Enabled dflags ] ++ ["+sse2" | isSse2Enabled platform ] ++ ["+sse" | isSseEnabled platform ] ++ ["+avx512f" | isAvx512fEnabled dflags ] - ++ ["+evex512" | isAvx512fEnabled dflags - , maybe False (>= LlvmVersion (18 NE.:| [])) llvm_version ] - -- +evex512 is recognized by LLVM 18 or newer and needed on macOS (#26410). - -- It may become deprecated in a future LLVM version, though. ++ ["+avx2" | isAvx2Enabled dflags ] ++ ["+avx" | isAvxEnabled dflags ] ++ ["+avx512cd"| isAvx512cdEnabled dflags ] diff --git a/GHC/Driver/Ppr.hs b/GHC/Driver/Ppr.hs --- a/GHC/Driver/Ppr.hs +++ b/GHC/Driver/Ppr.hs @@ -6,6 +6,7 @@ , showPpr , showPprUnsafe , printForUser + , printForUserColoured ) where @@ -34,6 +35,13 @@ doc' = pprWithUnitState unit_state doc printForUser :: DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO () -printForUser dflags handle name_ppr_ctx depth doc +printForUser = printForUser' False + +printForUserColoured :: DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO () +printForUserColoured = printForUser' True + +printForUser' :: Bool -> DynFlags -> Handle -> NamePprCtx -> Depth -> SDoc -> IO () +printForUser' colour dflags handle name_ppr_ctx depth doc = printSDocLn ctx (PageMode False) handle doc - where ctx = initSDocContext dflags (mkUserStyle name_ppr_ctx depth) + where ctx = initSDocContext dflags (setStyleColoured colour $ mkUserStyle name_ppr_ctx depth) + diff --git a/GHC/Driver/Session.hs b/GHC/Driver/Session.hs --- a/GHC/Driver/Session.hs +++ b/GHC/Driver/Session.hs @@ -17,8 +17,6 @@ -- ------------------------------------------------------------------------------- -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module GHC.Driver.Session ( -- * Dynamic flags and associated configuration types DumpFlag(..), @@ -80,6 +78,9 @@ safeDirectImpsReq, safeImplicitImpsReq, unsafeFlags, unsafeFlagsForInfer, + -- ** base + baseUnitId, + -- ** System tool settings and locations Settings(..), sProgramName, @@ -161,6 +162,7 @@ updOptLevel, setTmpDir, setUnitId, + setHomeUnitId, TurnOnFlag, turnOn, @@ -204,6 +206,9 @@ setUnsafeGlobalDynFlags, -- * SSE and AVX + isSse3Enabled, + isSsse3Enabled, + isSse4_1Enabled, isSse4_2Enabled, isBmiEnabled, isBmi2Enabled, @@ -232,6 +237,7 @@ import GHC.Platform import GHC.Platform.Ways import GHC.Platform.Profile +import GHC.Platform.ArchOS import GHC.Unit.Types import GHC.Unit.Parser @@ -246,6 +252,7 @@ import GHC.Settings.Config import GHC.Core.Unfold import GHC.Driver.CmdLine +import GHC.Utils.Logger import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Utils.Constants (debugIsOn) @@ -264,7 +271,7 @@ import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import GHC.Utils.Error (emptyDiagOpts) +import GHC.Utils.Error (emptyDiagOpts, logInfo) import GHC.Settings import GHC.CmmToAsm.CFG.Weight import GHC.Core.Opt.CallerCC @@ -282,6 +289,7 @@ import Data.Ord import Data.Char import Data.List (intercalate, sortBy, partition) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set @@ -390,6 +398,7 @@ settings dflags = Settings { sGhcNameVersion = ghcNameVersion dflags , sFileSettings = fileSettings dflags + , sUnitSettings = unitSettings dflags , sTargetPlatform = targetPlatform dflags , sToolSettings = toolSettings dflags , sPlatformMisc = platformMisc dflags @@ -488,6 +497,10 @@ opt_i :: DynFlags -> [String] opt_i dflags= toolSettings_opt_i $ toolSettings dflags + +setBaseUnitId :: String -> DynP () +setBaseUnitId s = upd $ \d -> d { unitSettings = UnitSettings (stringToUnitId s) } + ----------------------------------------------------------------------------- {- @@ -699,15 +712,15 @@ -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. setPgmP f = alterToolSettings (\s -> s { toolSettings_pgm_P = (pgm, map Option args)}) - where (pgm:args) = words f + where pgm:|args = expectNonEmpty $ words f -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. setPgmJSP f = alterToolSettings (\s -> s { toolSettings_pgm_JSP = (pgm, map Option args)}) - where (pgm:args) = words f + where pgm:|args = expectNonEmpty $ words f -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. setPgmCmmP f = alterToolSettings (\s -> s { toolSettings_pgm_CmmP = (pgm, map Option args)}) - where (pgm:args) = words f + where pgm:|args = expectNonEmpty $ words f addOptl f = alterToolSettings (\s -> s { toolSettings_opt_l = f : toolSettings_opt_l s}) addOptc f = alterToolSettings (\s -> s { toolSettings_opt_c = f : toolSettings_opt_c s}) addOptcxx f = alterToolSettings (\s -> s { toolSettings_opt_cxx = f : toolSettings_opt_cxx s}) @@ -799,7 +812,7 @@ -- the parsed 'DynFlags', the left-over arguments, and a list of warnings. -- Throws a 'UsageError' if errors occurred during parsing (such as unknown -- flags or missing arguments). -parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String] +parseDynamicFlagsCmdLine :: MonadIO m => Logger -> DynFlags -> [Located String] -> m (DynFlags, [Located String], Messages DriverMessage) -- ^ Updated 'DynFlags', left-over arguments, and -- list of warnings. @@ -809,7 +822,7 @@ -- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags -- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db). -- Used to parse flags set in a modules pragma. -parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String] +parseDynamicFilePragma :: MonadIO m => Logger -> DynFlags -> [Located String] -> m (DynFlags, [Located String], Messages DriverMessage) -- ^ Updated 'DynFlags', left-over arguments, and -- list of warnings. @@ -858,10 +871,11 @@ :: forall m. MonadIO m => [Flag (CmdLineP DynFlags)] -- ^ valid flags to match against -> Bool -- ^ are the arguments from the command line? + -> Logger -- ^ logger -> DynFlags -- ^ current dynamic flags -> [Located String] -- ^ arguments to parse -> m (DynFlags, [Located String], Messages DriverMessage) -parseDynamicFlagsFull activeFlags cmdline dflags0 args = do +parseDynamicFlagsFull activeFlags cmdline logger dflags0 args = do ((leftover, errs, cli_warns), dflags1) <- processCmdLineP activeFlags dflags0 args -- See Note [Handling errors when parsing command-line flags] @@ -877,7 +891,7 @@ throwGhcExceptionIO (CmdLineError ("combination not supported: " ++ intercalate "/" (map wayDesc (Set.toAscList theWays)))) - let (dflags3, consistency_warnings) = makeDynFlagsConsistent dflags2 + let (dflags3, consistency_warnings, infoverb) = makeDynFlagsConsistent dflags2 -- Set timer stats & heap size when (enableTimeStats dflags3) $ liftIO enableTimingStats @@ -891,6 +905,9 @@ let diag_opts = initDiagOpts dflags3 warns = warnsToMessages diag_opts $ mconcat [consistency_warnings, sh_warns, cli_warns] + when (logVerbAtLeast logger 3) $ + mapM_ (\(L _loc m) -> liftIO $ logInfo logger m) infoverb + return (dflags3, leftover, warns) -- | Check (and potentially disable) any extensions that aren't allowed @@ -1516,6 +1533,8 @@ "Use `-ddump-stg-from-core` or `-ddump-stg-final` instead" , make_ord_flag defGhcFlag "ddump-stg-tags" (setDumpFlag Opt_D_dump_stg_tags) + , make_ord_flag defGhcFlag "ddump-stg-from-js-sinker" + (setDumpFlag Opt_D_dump_stg_from_js_sinker) , make_ord_flag defGhcFlag "ddump-call-arity" (setDumpFlag Opt_D_dump_call_arity) , make_ord_flag defGhcFlag "ddump-exitify" @@ -1658,6 +1677,8 @@ d { sseVersion = Just SSE2 })) , make_ord_flag defGhcFlag "msse3" (noArg (\d -> d { sseVersion = Just SSE3 })) + , make_ord_flag defGhcFlag "mssse3" (noArg (\d -> + d { sseVersion = Just SSSE3 })) , make_ord_flag defGhcFlag "msse4" (noArg (\d -> d { sseVersion = Just SSE4 })) , make_ord_flag defGhcFlag "msse4.2" (noArg (\d -> @@ -1825,6 +1846,19 @@ (intSuffix (\n d -> d {maxForcedSpecArgs = n})) , make_ord_flag defGhciFlag "fghci-hist-size" (intSuffix (\n d -> d {ghciHistSize = n})) + + -- wasm ghci browser mode + , make_ord_flag defGhciFlag "fghci-browser-host" + $ hasArg $ \f d -> d { ghciBrowserHost = f } + , make_ord_flag defGhciFlag "fghci-browser-port" + $ intSuffix $ \n d -> d { ghciBrowserPort = n } + , make_ord_flag defGhciFlag "fghci-browser-puppeteer-launch-opts" + $ hasArg $ \f d -> d { ghciBrowserPuppeteerLaunchOpts = Just f } + , make_ord_flag defGhciFlag "fghci-browser-playwright-browser-type" + $ hasArg $ \f d -> d { ghciBrowserPlaywrightBrowserType = Just f } + , make_ord_flag defGhciFlag "fghci-browser-playwright-launch-opts" + $ hasArg $ \f d -> d { ghciBrowserPlaywrightLaunchOpts = Just f } + , make_ord_flag defGhcFlag "fmax-inline-alloc-size" (intSuffix (\n d -> d { maxInlineAllocSize = n })) , make_ord_flag defGhcFlag "fmax-inline-memcpy-insns" @@ -2051,6 +2085,7 @@ (NoArg (setGeneralFlag Opt_DistrustAllPackages)) , make_ord_flag defFlag "trust" (HasArg trustPackage) , make_ord_flag defFlag "distrust" (HasArg distrustPackage) + , make_ord_flag defFlag "base-unit-id" (HasArg setBaseUnitId) ] where setPackageEnv env = upd $ \s -> s { packageEnv = Just env } @@ -2231,7 +2266,9 @@ Opt_WarnAmbiguousFields -> warnSpec x Opt_WarnAutoOrphans -> depWarnSpec x "it has no effect" Opt_WarnCPPUndef -> warnSpec x - Opt_WarnBadlyStagedTypes -> warnSpec x + Opt_WarnBadlyLevelledTypes -> + warnSpec x ++ + subWarnSpec "badly-staged-types" x "it is renamed to -Wbadly-levelled-types" Opt_WarnUnbangedStrictPatterns -> warnSpec x Opt_WarnDeferredTypeErrors -> warnSpec x Opt_WarnDeferredOutOfScopeVariables -> warnSpec x @@ -2345,10 +2382,15 @@ Opt_WarnImplicitRhsQuantification -> warnSpec x Opt_WarnIncompleteExportWarnings -> warnSpec x Opt_WarnIncompleteRecordSelectors -> warnSpec x - Opt_WarnDataKindsTC -> warnSpec x - Opt_WarnDeprecatedTypeAbstractions -> warnSpec x + Opt_WarnDataKindsTC + -> depWarnSpec x "DataKinds violations are now always an error" Opt_WarnDefaultedExceptionContext -> warnSpec x Opt_WarnViewPatternSignatures -> warnSpec x + Opt_WarnUselessSpecialisations -> warnSpec x + Opt_WarnDeprecatedPragmas -> warnSpec x + Opt_WarnRuleLhsEqualities -> warnSpec x + Opt_WarnUnusableUnpackPragmas -> warnSpec x + Opt_WarnPatternNamespaceSpecifier -> warnSpec x warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] warningGroupsDeps = map mk warningGroups @@ -2458,6 +2500,14 @@ flagGhciSpec "local-ghci-history" Opt_LocalGhciHistory, flagGhciSpec "no-it" Opt_NoIt, flagSpec "ghci-sandbox" Opt_GhciSandbox, + + -- wasm ghci browser mode + flagGhciSpec "ghci-browser" Opt_GhciBrowser, + flagGhciSpec "ghci-browser-redirect-wasi-console" Opt_GhciBrowserRedirectWasiConsole, + + -- load all targets on GHCi startup + flagGhciSpec "load-initial-targets" Opt_GhciDoLoadTargets, + flagSpec "helpful-errors" Opt_HelpfulErrors, flagSpec "hpc" Opt_Hpc, flagSpec "ignore-asserts" Opt_IgnoreAsserts, @@ -2520,6 +2570,8 @@ flagSpec "use-rpaths" Opt_RPath, flagSpec "write-interface" Opt_WriteInterface, flagSpec "write-if-simplified-core" Opt_WriteIfSimplifiedCore, + flagSpec "write-if-self-recomp" Opt_WriteSelfRecompInfo, + flagSpec "write-if-self-recomp-flags" Opt_WriteSelfRecompFlags, flagSpec "write-ide-info" Opt_WriteHie, flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields, flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, @@ -2927,13 +2979,18 @@ setExtensionFlag', unSetExtensionFlag' :: LangExt.Extension -> DynFlags -> DynFlags setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps where - deps = [ if turn_on then setExtensionFlag' d - else unSetExtensionFlag' d - | (f', turn_on, d) <- impliedXFlags, f' == f ] + deps :: [DynFlags -> DynFlags] + deps = [ setExtension d + | (f', d) <- impliedXFlags, f' == f ] -- When you set f, set the ones it implies -- NB: use setExtensionFlag recursively, in case the implied flags -- implies further flags + setExtension :: OnOff LangExt.Extension -> DynFlags -> DynFlags + setExtension = \ case + On extension -> setExtensionFlag' extension + Off extension -> unSetExtensionFlag' extension + unSetExtensionFlag' f dflags = xopt_unset dflags f -- When you un-set f, however, we don't un-set the things it implies -- (except for -fno-glasgow-exts, which is treated specially) @@ -3063,6 +3120,9 @@ setUnitId :: String -> DynFlags -> DynFlags setUnitId p d = d { homeUnitId_ = stringToUnitId p } +setHomeUnitId :: UnitId -> DynFlags -> DynFlags +setHomeUnitId p d = d { homeUnitId_ = p } + setWorkingDirectory :: String -> DynFlags -> DynFlags setWorkingDirectory p d = d { workingDirectory = Just p } @@ -3155,7 +3215,7 @@ -- dummy parser state. p_state str = initParserState - (mkParserOpts mempty emptyDiagOpts [] False False False True) + (mkParserOpts mempty emptyDiagOpts False False False True) (stringToStringBuffer str) (mkRealSrcLoc (mkFastString []) 1 1) @@ -3403,11 +3463,15 @@ ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), ("Project Unit Id", cProjectUnitId), + ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), ("Host platform", cHostPlatformString), ("Target platform", platformMisc_targetPlatformString $ platformMisc dflags), + ("target os string", stringEncodeOS (platformOS (targetPlatform dflags))), + ("target arch string", stringEncodeArch (platformArch (targetPlatform dflags))), + ("target word size in bits", show (platformWordSizeInBits (targetPlatform dflags))), ("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags), ("Object splitting supported", showBool False), ("Have native code generator", showBool $ platformNcgSupported platform), @@ -3453,6 +3517,26 @@ expandDirectories :: FilePath -> Maybe FilePath -> String -> String expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- Note [Special unit-ids] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- Certain units are special to the compiler: +-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`. +-- - GHC plugins must be linked against a specific unit-id of `ghc`, +-- namely the same one as the compiler. +-- - When using Template Haskell, the result of executing splices refer to +-- the Template Haskell ASTs created using constructors from `ghc-internal`, +-- and must be linked against the same `ghc-internal` unit-id as the compiler. +-- +-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and +-- ghc ("Project Unit Id") through `ghc --info`. +-- +-- This allows build tools to act accordingly, eg, if a user wishes to build a +-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit +-- that the compiler was linked against. +-- See: +-- - https://github.com/haskell/cabal/issues/10087 +-- - https://github.com/commercialhaskell/stack/issues/6749 + {- ----------------------------------------------------------------------------- Note [DynFlags consistency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3477,12 +3561,35 @@ the flags; this is because API clients may parse flags but update the DynFlags afterwords, before finally running code inside a session (see T10052 and #10052). + +Host ways vs Build ways mismatch +-------------------------------- +Many consistency checks aim to fix the situation where the wanted build ways +are not compatible with the ways the compiler is built in. This happens when +using the interpreter, TH, and the runtime linker, where the compiler cannot +load objects compiled for ways not matching its own. + +For instance, a profiled-dynamic object can only be loaded by a +profiled-dynamic compiler (and not any other kind of compiler). + +This incompatibility is traditionally solved in either of two ways: + +(1) Force the "wanted" build ways to match the compiler ways exactly, + guaranteeing they match. + +(2) Force the use of the external interpreter. When interpreting is offloaded + to the external interpreter it no longer matters what are the host compiler ways. + +In the checks and fixes performed by `makeDynFlagsConsistent`, the choice +between the two does not seem uniform. TODO: Make this choice more evident and uniform. -} -- | Resolve any internal inconsistencies in a set of 'DynFlags'. -- Returns the consistent 'DynFlags' as well as a list of warnings --- to report to the user. -makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Warn]) +-- to report to the user, and a list of verbose info msgs. +-- +-- See Note [DynFlags consistency] +makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Warn], [Located SDoc]) -- Whenever makeDynFlagsConsistent does anything, it starts over, to -- ensure that a later change doesn't invalidate an earlier check. -- Be careful not to introduce potential loops! @@ -3573,13 +3680,49 @@ | LinkMergedObj <- ghcLink dflags , Nothing <- outputFile dflags - = pgmError "--output must be specified when using --merge-objs" + = pgmError "--output must be specified when using --merge-objs" - | otherwise = (dflags, mempty) + | platformTablesNextToCode platform + && os == OSMinGW32 + && arch == ArchAArch64 + = case backendCodeOutput (backend dflags) of + LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64" + NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64" + _ -> (dflags, mempty, mempty) + + -- When we do ghci, force using dyn ways if the target RTS linker + -- only supports dynamic code + | LinkInMemory <- ghcLink dflags + , sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags + , not (ways dflags `hasWay` WayDyn && gopt Opt_ExternalInterpreter dflags) + = flip loopNoWarn "Forcing dynamic way because target RTS linker only supports dynamic code" $ + -- See checkOptions, -fexternal-interpreter is + -- required when using --interactive with a non-standard + -- way (-prof, -static, or -dynamic). + setGeneralFlag' Opt_ExternalInterpreter $ + addWay' WayDyn dflags + + | LinkInMemory <- ghcLink dflags + , not (gopt Opt_ExternalInterpreter dflags) + , targetWays_ dflags /= hostFullWays + = flip loopNoWarn "Forcing build ways to match the compiler ways because we're using the internal interpreter" $ + let dflags_a = dflags { targetWays_ = hostFullWays } + dflags_b = foldl gopt_set dflags_a + $ concatMap (wayGeneralFlags platform) + hostFullWays + dflags_c = foldl gopt_unset dflags_b + $ concatMap (wayUnsetGeneralFlags platform) + hostFullWays + in dflags_c + + | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") loop updated_dflags warning = case makeDynFlagsConsistent updated_dflags of - (dflags', ws) -> (dflags', L loc (DriverInconsistentDynFlags warning) : ws) + (dflags', ws, is) -> (dflags', L loc (DriverInconsistentDynFlags warning) : ws, is) + loopNoWarn updated_dflags doc + = case makeDynFlagsConsistent updated_dflags of + (dflags', ws, is) -> (dflags', ws, L loc (text doc):is) platform = targetPlatform dflags arch = platformArch platform os = platformOS platform diff --git a/GHC/Driver/Session/Inspect.hs b/GHC/Driver/Session/Inspect.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/Session/Inspect.hs @@ -0,0 +1,201 @@ +{-# LANGUAGE LambdaCase #-} + +-- | GHC API utilities for inspecting the GHC session +module GHC.Driver.Session.Inspect where + +import GHC.Prelude +import GHC.Data.Maybe +import Control.Monad + +import GHC.ByteCode.Types +import GHC.Core.FamInstEnv +import GHC.Core.InstEnv +import GHC.Driver.Env +import GHC.Driver.Main +import GHC.Driver.Monad +import GHC.Driver.Session +import GHC.Rename.Names +import GHC.Runtime.Context +import GHC.Runtime.Interpreter +import GHC.Types.Avail +import GHC.Types.Name +import GHC.Types.Name.Ppr +import GHC.Types.Name.Reader +import GHC.Types.Name.Set +import GHC.Types.PkgQual +import GHC.Types.SafeHaskell +import GHC.Types.SrcLoc +import GHC.Types.TyThing +import GHC.Types.TypeEnv +import GHC.Unit.External +import GHC.Unit.Home.ModInfo +import GHC.Unit.Module +import GHC.Unit.Module.Graph +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModIface +import GHC.Utils.Misc +import GHC.Utils.Outputable +import qualified GHC.Unit.Home.Graph as HUG + +-- %************************************************************************ +-- %* * +-- Inspecting the session +-- %* * +-- %************************************************************************ + +-- | Get the module dependency graph. +getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary +getModuleGraph = liftM hsc_mod_graph getSession + +{-# DEPRECATED isLoaded "Prefer 'isLoadedModule' and 'isLoadedHomeModule'" #-} +-- | Return @True@ \<==> module is loaded. +isLoaded :: GhcMonad m => ModuleName -> m Bool +isLoaded m = withSession $ \hsc_env -> liftIO $ do + hmis <- HUG.lookupAllHug (hsc_HUG hsc_env) m + return $! not (null hmis) + +-- | Check whether a 'ModuleName' is found in the 'HomePackageTable' +-- for the given 'UnitId'. +isLoadedModule :: GhcMonad m => UnitId -> ModuleName -> m Bool +isLoadedModule uid m = withSession $ \hsc_env -> liftIO $ do + hmi <- HUG.lookupHug (hsc_HUG hsc_env) uid m + return $! isJust hmi + +-- | Check whether 'Module' is part of the 'HomeUnitGraph'. +-- +-- Similar to 'isLoadedModule', but for 'Module's. +isLoadedHomeModule :: GhcMonad m => Module -> m Bool +isLoadedHomeModule m = withSession $ \hsc_env -> liftIO $ do + hmi <- HUG.lookupHugByModule m (hsc_HUG hsc_env) + return $! isJust hmi + +-- | Return the bindings for the current interactive session. +getBindings :: GhcMonad m => m [TyThing] +getBindings = withSession $ \hsc_env -> + return $ icInScopeTTs $ hsc_IC hsc_env + +-- | Return the instances for the current interactive session. +getInsts :: GhcMonad m => m ([ClsInst], [FamInst]) +getInsts = withSession $ \hsc_env -> + let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env) + in return (instEnvElts inst_env, fam_env) + +getNamePprCtx :: GhcMonad m => m NamePprCtx +getNamePprCtx = withSession $ \hsc_env -> do + return $ icNamePprCtx (hsc_unit_env hsc_env) (hsc_IC hsc_env) + +-- | Container for information about a 'Module'. +data ModuleInfo = ModuleInfo { + minf_type_env :: TypeEnv, + minf_exports :: [AvailInfo], + minf_instances :: [ClsInst], + minf_iface :: Maybe ModIface, + minf_safe :: SafeHaskellMode, + minf_modBreaks :: Maybe InternalModBreaks + } + -- We don't want HomeModInfo here, because a ModuleInfo applies + -- to package modules too. + +-- | Request information about a loaded 'Module' +getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X +getModuleInfo mdl = withSession $ \hsc_env -> do + if HUG.memberHugUnit (moduleUnit mdl) (hsc_HUG hsc_env) + then liftIO $ getHomeModuleInfo hsc_env mdl + else liftIO $ getPackageModuleInfo hsc_env mdl + +getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) +getPackageModuleInfo hsc_env mdl + = do eps <- hscEPS hsc_env + iface <- hscGetModuleInterface hsc_env mdl + let + avails = mi_exports iface + pte = eps_PTE eps + tys = [ ty | name <- concatMap availNames avails, + Just ty <- [lookupTypeEnv pte name] ] + + return (Just (ModuleInfo { + minf_type_env = mkTypeEnv tys, + minf_exports = avails, + minf_instances = error "getModuleInfo: instances for package module unimplemented", + minf_iface = Just iface, + minf_safe = getSafeMode $ mi_trust iface, + minf_modBreaks = Nothing + })) + +availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv +availsToGlobalRdrEnv hsc_env mod avails + = forceGlobalRdrEnv rdr_env + -- See Note [Forcing GREInfo] in GHC.Types.GREInfo. + where + rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails) + -- We're building a GlobalRdrEnv as if the user imported + -- all the specified modules into the global interactive module + imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} + decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, + is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual, + is_dloc = srcLocSpan interactiveSrcLoc, + is_level = NormalLevel } + +getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) +getHomeModuleInfo hsc_env mdl = + HUG.lookupHugByModule mdl (hsc_HUG hsc_env) >>= \case + Nothing -> return Nothing + Just hmi -> do + let details = hm_details hmi + iface = hm_iface hmi + return (Just (ModuleInfo { + minf_type_env = md_types details, + minf_exports = md_exports details, + -- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo. + minf_instances = instEnvElts $ md_insts details, + minf_iface = Just iface, + minf_safe = getSafeMode $ mi_trust iface, + minf_modBreaks = getModBreaks hmi + })) + +-- | The list of top-level entities defined in a module +modInfoTyThings :: ModuleInfo -> [TyThing] +modInfoTyThings minf = typeEnvElts (minf_type_env minf) + +modInfoExports :: ModuleInfo -> [Name] +modInfoExports minf = concatMap availNames $! minf_exports minf + +modInfoExportsWithSelectors :: ModuleInfo -> [Name] +modInfoExportsWithSelectors minf = concatMap availNames $! minf_exports minf + +-- | Returns the instances defined by the specified module. +-- Warning: currently unimplemented for package modules. +modInfoInstances :: ModuleInfo -> [ClsInst] +modInfoInstances = minf_instances + +modInfoIsExportedName :: ModuleInfo -> Name -> Bool +modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf)) + +mkNamePprCtxForModule :: + GhcMonad m => + Module -> + ModuleInfo -> + m NamePprCtx +mkNamePprCtxForModule mod minf = withSession $ \hsc_env -> do + let name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env) (availsToGlobalRdrEnv hsc_env mod (minf_exports minf)) + ptc = initPromotionTickContext (hsc_dflags hsc_env) + return name_ppr_ctx + +modInfoLookupName :: GhcMonad m => + ModuleInfo -> Name + -> m (Maybe TyThing) -- XXX: returns a Maybe X +modInfoLookupName minf name = withSession $ \hsc_env -> do + case lookupTypeEnv (minf_type_env minf) name of + Just tyThing -> return (Just tyThing) + Nothing -> liftIO (lookupType hsc_env name) + +modInfoIface :: ModuleInfo -> Maybe ModIface +modInfoIface = minf_iface + +-- | Retrieve module safe haskell mode +modInfoSafe :: ModuleInfo -> SafeHaskellMode +modInfoSafe = minf_safe + +modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks +modInfoModBreaks = minf_modBreaks + diff --git a/GHC/Driver/Session/Units.hs b/GHC/Driver/Session/Units.hs new file mode 100644 --- /dev/null +++ b/GHC/Driver/Session/Units.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE TupleSections #-} +module GHC.Driver.Session.Units (initMake, initMulti) where + +-- The official GHC API +import qualified GHC +import GHC (parseTargetFiles, Ghc, GhcMonad(..)) + +import GHC.Driver.Env +import GHC.Driver.Errors +import GHC.Driver.Errors.Types +import GHC.Driver.Phases +import GHC.Driver.Session +import GHC.Driver.Ppr +import GHC.Driver.Pipeline ( oneShot, compileFile ) +import GHC.Driver.Config.Diagnostic + +import GHC.Unit.Env +import GHC.Unit (UnitId) +import GHC.Unit.Home.PackageTable +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.State ( emptyUnitState ) +import qualified GHC.Unit.State as State + +import GHC.Types.SrcLoc +import GHC.Types.SourceError + +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Outputable as Outputable +import GHC.Utils.Monad ( liftIO, mapMaybeM ) +import GHC.Data.Maybe + +import System.IO +import System.Exit +import System.FilePath +import Control.Monad +import Data.List ( partition, (\\) ) +import qualified Data.Set as Set +import Prelude +import GHC.ResponseFile (expandResponse) +import Data.Bifunctor +import GHC.Data.Graph.Directed +import qualified Data.List.NonEmpty as NE + +-- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list. +removeRTS :: [String] -> [String] +removeRTS ("+RTS" : xs) = + case dropWhile (/= "-RTS") xs of + [] -> [] + (_ : ys) -> removeRTS ys +removeRTS (y:ys) = y : removeRTS ys +removeRTS [] = [] + +initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)] +initMake srcs = do + let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs + + hsc_env <- GHC.getSession + + -- if we have no haskell sources from which to do a dependency + -- analysis, then just do one-shot compilation and/or linking. + -- This means that "ghc Foo.o Bar.o -o baz" links the program as + -- we expect. + if (null hs_srcs) + then liftIO (oneShot hsc_env NoStop srcs) >> return [] + else do + + o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x) + non_hs_srcs + dflags <- GHC.getSessionDynFlags + let dflags' = dflags { ldInputs = map (FileOption "") o_files + ++ ldInputs dflags } + _ <- GHC.setSessionDynFlags dflags' + return hs_srcs + +initMulti :: NE.NonEmpty String + -> (DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()) + -- ^ Function to lint initMulti DynFlags and sources. + -- In GHC, this is instanced to @checkOptions@. + -> Ghc ([(String, Maybe UnitId, Maybe Phase)]) +initMulti unitArgsFiles lintDynFlagsAndSrcs = do + hsc_env <- GHC.getSession + let logger = hsc_logger hsc_env + initial_dflags <- GHC.getSessionDynFlags + + dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do + when (verbosity initial_dflags > 2) (liftIO $ print f) + args <- liftIO $ expandResponse [f] + (dflags2, fileish_args, warns) <- parseDynamicFlagsCmdLine logger initial_dflags (map (mkGeneralLocated f) (removeRTS args)) + handleSourceError (\e -> do + GHC.printException e + liftIO $ exitWith (ExitFailure 1)) $ do + liftIO $ printOrThrowDiagnostics logger (initPrintConfig dflags2) (initDiagOpts dflags2) (GhcDriverMessage <$> warns) + + let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args) + dflags4 = offsetDynFlags dflags3 + + let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs + + -- This is dubious as the whole unit environment won't be set-up correctly, but + -- that doesn't matter for what we use it for (linking and oneShot) + let dubious_hsc_env = hscSetFlags dflags4 hsc_env + -- if we have no haskell sources from which to do a dependency + -- analysis, then just do one-shot compilation and/or linking. + -- This means that "ghc Foo.o Bar.o -o baz" links the program as + -- we expect. + if (null hs_srcs) + then liftIO (oneShot dubious_hsc_env NoStop srcs) >> return (dflags4, []) + else do + + o_files <- mapMaybeM (\x -> liftIO $ compileFile dubious_hsc_env NoStop x) + non_hs_srcs + let dflags5 = dflags4 { ldInputs = map (FileOption "") o_files + ++ ldInputs dflags4 } + + liftIO $ lintDynFlagsAndSrcs dflags5 srcs objs [] + + pure (dflags5, hs_srcs) + + let + unitDflags = NE.map fst dynFlagsAndSrcs + srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs + (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs)) + + checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags)) + + (initial_home_graph, mainUnitId) <- liftIO $ createUnitEnvFromFlags unitDflags + let home_units = HUG.allUnits initial_home_graph + + home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do + let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv + hue_flags = homeUnitEnv_dflags homeUnitEnv + dflags = homeUnitEnv_dflags homeUnitEnv + (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units + + updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants + emptyHpt <- liftIO $ emptyHomePackageTable + pure $ HomeUnitEnv + { homeUnitEnv_units = unit_state + , homeUnitEnv_unit_dbs = Just dbs + , homeUnitEnv_dflags = updated_dflags + , homeUnitEnv_hpt = emptyHpt + , homeUnitEnv_home_unit = Just home_unit + } + + checkUnitCycles initial_dflags home_unit_graph + + let dflags = homeUnitEnv_dflags $ HUG.unitEnv_lookup mainUnitId home_unit_graph + unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags)) + let final_hsc_env = hsc_env { hsc_unit_env = unitEnv } + + GHC.setSession final_hsc_env + + -- if we have no haskell sources from which to do a dependency + -- analysis, then just do one-shot compilation and/or linking. + -- This means that "ghc Foo.o Bar.o -o baz" links the program as + -- we expect. + if (null hs_srcs) + then do + liftIO $ hPutStrLn stderr $ "Multi Mode can not be used for one-shot mode." + liftIO $ exitWith (ExitFailure 1) + else do + +{- + o_files <- liftIO $ mapMaybeM + (\(src, uid, mphase) -> + compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase) + ) + (concat non_hs_srcs) + -} + + -- MP: This should probably modify dflags for each unit? + --let dflags' = dflags { ldInputs = map (FileOption "") o_files + -- ++ ldInputs dflags } + return $ concat hs_srcs + +checkUnitCycles :: DynFlags -> HUG.HomeUnitGraph -> Ghc () +checkUnitCycles dflags graph = processSCCs (HUG.hugSCCs graph) + where + + processSCCs [] = return () + processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs + processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids) + + + cycle_err uids = + hang (text "Units form a dependency cycle:") + 2 + (one_err uids) + + one_err uids = vcat $ + (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start) + ++ [text "-" <+> ppr final] + where + start = init uids + final = last uids + +-- | Check that we don't have multiple units with the same UnitId. +checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc () +checkDuplicateUnits dflags flags = + unless (null duplicate_ids) + (throwGhcException $ CmdLineError $ showSDoc dflags multi_err) + + where + uids = map (second homeUnitId_) flags + deduplicated_uids = ordNubOn snd uids + duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids) + + duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids + + one_err (fp, home_uid) = text "-" <+> ppr home_uid <+> text "defined in" <+> text fp + + multi_err = + hang (text "Multiple units with the same unit-id:") + 2 + (vcat (map one_err duplicate_flags)) + + +offsetDynFlags :: DynFlags -> DynFlags +offsetDynFlags dflags = + dflags { hiDir = c hiDir + , objectDir = c objectDir + , stubDir = c stubDir + , hieDir = c hieDir + , dumpDir = c dumpDir } + + where + c f = augment_maybe (f dflags) + + augment_maybe Nothing = Nothing + augment_maybe (Just f) = Just (augment f) + augment f | isRelative f, Just offset <- workingDirectory dflags = offset f + | otherwise = f + + +createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> IO (HomeUnitGraph, UnitId) +createUnitEnvFromFlags unitDflags = do + unitEnvList <- forM unitDflags $ \dflags -> do + emptyHpt <- emptyHomePackageTable + let newInternalUnitEnv = + HUG.mkHomeUnitEnv emptyUnitState Nothing dflags emptyHpt Nothing + return (homeUnitId_ dflags, newInternalUnitEnv) + let activeUnit = fst $ NE.head unitEnvList + return (HUG.hugFromList (NE.toList unitEnvList), activeUnit) + + diff --git a/GHC/Hs/Binds.hs b/GHC/Hs/Binds.hs --- a/GHC/Hs/Binds.hs +++ b/GHC/Hs/Binds.hs @@ -26,16 +26,19 @@ module GHC.Hs.Binds ( module Language.Haskell.Syntax.Binds , module GHC.Hs.Binds + , HsRuleBndrsAnn(..) ) where import GHC.Prelude import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Binds +import Language.Haskell.Syntax.Expr( LHsExpr ) -import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprFunBind, pprPatBind ) +import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprLExpr, pprFunBind, pprPatBind ) import {-# SOURCE #-} GHC.Hs.Pat (pprLPat ) +import GHC.Data.BooleanFormula ( LBooleanFormula, pprBooleanFormulaNormal ) import GHC.Types.Tickish import GHC.Hs.Extension import GHC.Parser.Annotation @@ -47,7 +50,6 @@ import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var -import GHC.Data.BooleanFormula (LBooleanFormula) import GHC.Types.Name import GHC.Utils.Outputable @@ -138,20 +140,6 @@ type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = DataConCantHappen -type instance XNoMultAnn GhcPs = NoExtField -type instance XNoMultAnn GhcRn = NoExtField -type instance XNoMultAnn GhcTc = Mult - -type instance XPct1Ann GhcPs = EpToken "%1" -type instance XPct1Ann GhcRn = NoExtField -type instance XPct1Ann GhcTc = Mult - -type instance XMultAnn GhcPs = EpToken "%" -type instance XMultAnn GhcRn = NoExtField -type instance XMultAnn GhcTc = Mult - -type instance XXMultAnn (GhcPass _) = DataConCantHappen - data AnnPSB = AnnPSB { ap_pattern :: EpToken "pattern", @@ -165,14 +153,14 @@ noAnn = AnnPSB noAnn noAnn noAnn noAnn noAnn setTcMultAnn :: Mult -> HsMultAnn GhcRn -> HsMultAnn GhcTc -setTcMultAnn mult (HsPct1Ann _) = HsPct1Ann mult -setTcMultAnn mult (HsMultAnn _ p) = HsMultAnn mult p -setTcMultAnn mult (HsNoMultAnn _) = HsNoMultAnn mult +setTcMultAnn mult (HsLinearAnn _) = HsLinearAnn mult +setTcMultAnn mult (HsExplicitMult _ p) = HsExplicitMult mult p +setTcMultAnn mult (HsUnannotated _) = HsUnannotated mult getTcMultAnn :: HsMultAnn GhcTc -> Mult -getTcMultAnn (HsPct1Ann mult) = mult -getTcMultAnn (HsMultAnn mult _) = mult -getTcMultAnn (HsNoMultAnn mult) = mult +getTcMultAnn (HsLinearAnn mult) = mult +getTcMultAnn (HsExplicitMult mult _) = mult +getTcMultAnn (HsUnannotated mult) = mult -- --------------------------------------------------------------------- @@ -544,13 +532,6 @@ plusHsValBinds _ _ = panic "HsBinds.plusHsValBinds" --- Used to print, for instance, let bindings: --- let %1 x = … -pprHsMultAnn :: forall id. OutputableBndrId id => HsMultAnn (GhcPass id) -> SDoc -pprHsMultAnn (HsNoMultAnn _) = empty -pprHsMultAnn (HsPct1Ann _) = text "%1" -pprHsMultAnn (HsMultAnn _ p) = text "%" <> ppr p - instance (OutputableBndrId pl, OutputableBndrId pr) => Outputable (HsBindLR (GhcPass pl) (GhcPass pr)) where ppr mbind = ppr_monobind mbind @@ -631,7 +612,7 @@ GhcPs -> ppr v GhcRn -> ppr v GhcTc -> ppr v - PrefixCon _ vs -> hsep (pprPrefixOcc psyn : map ppr_v vs) + PrefixCon vs -> hsep (pprPrefixOcc psyn : map ppr_v vs) where ppr_v v = case ghcPass @r of GhcPs -> ppr v @@ -646,9 +627,9 @@ GhcTc -> ppr v ppr_rhs = case dir of - Unidirectional -> ppr_simple (text "<-") + Unidirectional -> ppr_simple larrow ImplicitBidirectional -> ppr_simple equals - ExplicitBidirectional mg -> ppr_simple (text "<-") <+> text "where" $$ + ExplicitBidirectional mg -> ppr_simple larrow <+> text "where" $$ (nest 2 $ pprFunBind mg) pprTicks :: SDoc -> SDoc -> SDoc @@ -663,10 +644,9 @@ then pp_when_debug else pp_no_debug -instance Outputable (XRec pass (IdP pass)) => Outputable (RecordPatSynField pass) where +instance Outputable (XRecGhc (IdGhcP p)) => Outputable (RecordPatSynField (GhcPass p)) where ppr (RecordPatSynField { recordPatSynField = v }) = ppr v - {- ************************************************************************ * * @@ -725,6 +705,11 @@ type instance XMinimalSig (GhcPass p) = ((EpaLocation, EpToken "#-}"), SourceText) type instance XSCCFunSig (GhcPass p) = ((EpaLocation, EpToken "#-}"), SourceText) type instance XCompleteMatchSig (GhcPass p) = ((EpaLocation, Maybe TokDcolon, EpToken "#-}"), SourceText) + +type instance XSpecSigE GhcPs = AnnSpecSig +type instance XSpecSigE GhcRn = Name +type instance XSpecSigE GhcTc = NoExtField + -- SourceText: See Note [Pragma source text] in "GHC.Types.SourceText" type instance XXSig GhcPs = DataConCantHappen type instance XXSig GhcRn = IdSig @@ -739,7 +724,7 @@ = AnnSpecSig { ass_open :: EpaLocation, ass_close :: EpToken "#-}", - ass_dcolon :: TokDcolon, + ass_dcolon :: Maybe TokDcolon, -- Only for old SpecSig, remove when it goes ass_act :: ActivationAnn } deriving Data @@ -818,26 +803,48 @@ -- | Type checker Specialisation Pragmas -- --- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer +-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker +-- to the desugarer data TcSpecPrags = IsDefaultMethod -- ^ Super-specialised: a default method should -- be macro-expanded at every call site | SpecPrags [LTcSpecPrag] - deriving Data --- | Located Type checker Specification Pragmas +-- | Located Type checker Specialisation Pragmas type LTcSpecPrag = Located TcSpecPrag --- | Type checker Specification Pragma +-- | Type checker Specialisation Pragma +-- +-- This data type is used to communicate between the typechecker and +-- the desugarer. data TcSpecPrag + -- | Old-form specialise pragma = SpecPrag - Id - HsWrapper - InlinePragma - -- ^ The Id to be specialised, a wrapper that specialises the - -- polymorphic function, and inlining spec for the specialised function - deriving Data + Id + -- ^ 'Id' to be specialised + HsWrapper + -- ^ wrapper that specialises the polymorphic function + InlinePragma + -- ^ inlining spec for the specialised function + -- | New-form specialise pragma + | SpecPragE + { spe_fn_nm :: Name + -- ^ 'Name' of the 'Id' being specialised + , spe_fn_id :: Id + -- ^ 'Id' being specialised + -- + -- Note that 'spe_fn_nm' may differ from @'idName' 'spe_fn_id'@ + -- in the case of instance methods, where the 'Name' is the + -- class-op selector but the 'spe_fn_id' is that for the local method + , spe_inl :: InlinePragma + -- ^ (optional) INLINE annotation and activation phase annotation + , spe_bndrs :: [Var] + -- ^ TyVars, EvVars, and Ids + , spe_call :: LHsExpr GhcTc + -- ^ The type-checked specialise expression + } + noSpecPrags :: TcSpecPrags noSpecPrags = SpecPrags [] @@ -859,19 +866,34 @@ | is_deflt = text "default" <+> pprVarSig (map unLoc vars) (ppr ty) | otherwise = pprVarSig (map unLoc vars) (ppr ty) ppr_sig (FixSig _ fix_sig) = ppr fix_sig -ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec })) - = pragSrcBrackets (inlinePragmaSource inl) pragmaSrc (pprSpec (unLoc var) - (interpp'SP ty) inl) + +ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_src = src, inl_inline = spec })) + = pragSrcBrackets (inlinePragmaSource inl) pragmaSrc $ + pprSpec (unLoc var) (interpp'SP ty) inl where pragmaSrc = case spec of - NoUserInlinePrag -> "{-# " ++ extractSpecPragName (inl_src inl) - _ -> "{-# " ++ extractSpecPragName (inl_src inl) ++ "_INLINE" + NoUserInlinePrag -> "{-# " ++ extractSpecPragName src + _ -> "{-# " ++ extractSpecPragName src ++ "_INLINE" + +ppr_sig (SpecSigE _ bndrs spec_e inl@(InlinePragma { inl_src = src, inl_inline = spec })) + = pragSrcBrackets (inlinePragmaSource inl) pragmaSrc $ + pp_inl <+> hang (ppr bndrs) 2 (pprLExpr spec_e) + where + -- SPECIALISE or SPECIALISE_INLINE + pragmaSrc = case spec of + NoUserInlinePrag -> "{-# " ++ extractSpecPragName src + _ -> "{-# " ++ extractSpecPragName src ++ "_INLINE" + + pp_inl | isDefaultInlinePragma inl = empty + | otherwise = pprInline inl + ppr_sig (InlineSig _ var inl) = ppr_pfx <+> pprInline inl <+> pprPrefixOcc (unLoc var) <+> text "#-}" where ppr_pfx = case inlinePragmaSource inl of SourceText src -> ftext src NoSourceText -> text "{-#" <+> inlinePragmaName (inl_inline inl) + ppr_sig (SpecInstSig (_, src) ty) = pragSrcBrackets src "{-# pragma" (text "instance" <+> ppr ty) ppr_sig (MinimalSig (_, src) bf) @@ -906,6 +928,7 @@ | is_deflt = text "default type signature" | otherwise = text "class method signature" hsSigDoc (SpecSig _ _ _ inl) = (inlinePragmaName . inl_inline $ inl) <+> text "pragma" +hsSigDoc (SpecSigE _ _ _ inl) = (inlinePragmaName . inl_inline $ inl) <+> text "pragma" hsSigDoc (InlineSig _ _ prag) = (inlinePragmaName . inl_inline $ prag) <+> text "pragma" -- Using the 'inlinePragmaName' function ensures that the pragma name for any -- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted @@ -968,11 +991,58 @@ instance Outputable TcSpecPrag where ppr (SpecPrag var _ inl) = text (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "") inl + ppr (SpecPragE { spe_bndrs = bndrs, spe_call = spec_e, spe_inl = inl }) + = text (extractSpecPragName $ inl_src inl) + <+> hang (ppr bndrs) 2 (pprLExpr spec_e) -pprMinimalSig :: (OutputableBndr name) - => LBooleanFormula (GenLocated l name) -> SDoc -pprMinimalSig (L _ bf) = ppr (fmap unLoc bf) +pprMinimalSig :: OutputableBndrId p => LBooleanFormula (GhcPass p) -> SDoc +pprMinimalSig (L _ bf) = pprBooleanFormulaNormal bf + +{- ********************************************************************* +* * + RuleBndrs +* * +********************************************************************* -} + +data HsRuleBndrsAnn + = HsRuleBndrsAnn + { rb_tyanns :: Maybe (TokForall, EpToken ".") + -- ^ The locations of 'forall' and '.' for forall'd type vars + -- Using AddEpAnn to capture possible unicode variants + , rb_tmanns :: Maybe (TokForall, EpToken ".") + -- ^ The locations of 'forall' and '.' for forall'd term vars + -- Using AddEpAnn to capture possible unicode variants + } deriving (Data, Eq) + +instance NoAnn HsRuleBndrsAnn where + noAnn = HsRuleBndrsAnn Nothing Nothing + + + +type instance XXRuleBndrs (GhcPass _) = DataConCantHappen +type instance XCRuleBndrs GhcPs = HsRuleBndrsAnn +type instance XCRuleBndrs GhcRn = NoExtField +type instance XCRuleBndrs GhcTc = [Var] -- Binders of the rule, not + -- necessarily in dependency order + +type instance XRuleBndrSig (GhcPass _) = AnnTyVarBndr +type instance XCRuleBndr (GhcPass _) = AnnTyVarBndr +type instance XXRuleBndr (GhcPass _) = DataConCantHappen + +instance (OutputableBndrId p) => Outputable (RuleBndrs (GhcPass p)) where + ppr (RuleBndrs { rb_tyvs = tyvs, rb_tmvs = tmvs }) + = pp_forall_ty tyvs <+> pp_forall_tm tyvs + where + pp_forall_ty Nothing = empty + pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot + pp_forall_tm Nothing | null tmvs = empty + pp_forall_tm _ = forAllLit <+> fsep (map ppr tmvs) <> dot + +instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where + ppr (RuleBndr _ name) = ppr name + ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty) + {- ************************************************************************ * * @@ -984,6 +1054,7 @@ type instance Anno (HsBindLR (GhcPass idL) (GhcPass idR)) = SrcSpanAnnA type instance Anno (IPBind (GhcPass p)) = SrcSpanAnnA type instance Anno (Sig (GhcPass p)) = SrcSpanAnnA +type instance Anno (RuleBndr (GhcPass p)) = EpAnnCO type instance Anno (FixitySig (GhcPass p)) = SrcSpanAnnA diff --git a/GHC/Hs/Decls.hs b/GHC/Hs/Decls.hs --- a/GHC/Hs/Decls.hs +++ b/GHC/Hs/Decls.hs @@ -43,7 +43,7 @@ isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl, isOpenTypeFamilyInfo, isClosedTypeFamilyInfo, tyFamInstDeclName, tyFamInstDeclLName, - countTyClDecls, pprTyClDeclFlavour, + countTyClDecls, tyClDeclFlavour, tyClDeclLName, tyClDeclTyVars, hsDeclHasCusk, famResultKindSignature, FamilyDecl(..), LFamilyDecl, @@ -67,7 +67,7 @@ XViaStrategyPs(..), -- ** @RULE@ declarations LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..), - HsRuleAnn(..), ActivationAnn(..), + HsRuleAnn(..), RuleBndr(..),LRuleBndr, collectRuleBndrSigTys, flattenRuleDecls, pprFullRuleName, @@ -110,6 +110,7 @@ import GHC.Prelude import Language.Haskell.Syntax.Decls +import Language.Haskell.Syntax.Extension import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprUntypedSplice ) -- Because Expr imports Decls via HsBracket @@ -119,7 +120,7 @@ import GHC.Hs.Doc import GHC.Types.Basic import GHC.Core.Coercion -import Language.Haskell.Syntax.Extension + import GHC.Hs.Extension import GHC.Parser.Annotation import GHC.Types.Name @@ -138,6 +139,7 @@ import GHC.Data.Maybe import Data.Data (Data) +import Data.List (concatMap) import Data.Foldable (toList) {- @@ -229,6 +231,20 @@ , L loc (FixSig _ sig) <- sigs ] +hsGroupInstDecls :: HsGroup (GhcPass p) -> [LInstDecl (GhcPass p)] +hsGroupInstDecls = (=<<) group_instds . hs_tyclds + +-- Helpers to flatten TyClGroups. +-- See (TCDEP1) in Note [Dependency analysis of type and class decls] in GHC.Rename.Module +tyClGroupTyClDecls :: [TyClGroup (GhcPass p)] -> [LTyClDecl (GhcPass p)] +tyClGroupInstDecls :: [TyClGroup (GhcPass p)] -> [LInstDecl (GhcPass p)] +tyClGroupRoleDecls :: [TyClGroup (GhcPass p)] -> [LRoleAnnotDecl (GhcPass p)] +tyClGroupKindSigs :: [TyClGroup (GhcPass p)] -> [LStandaloneKindSig (GhcPass p)] +tyClGroupTyClDecls = Data.List.concatMap group_tyclds +tyClGroupInstDecls = Data.List.concatMap group_instds +tyClGroupRoleDecls = Data.List.concatMap group_roles +tyClGroupKindSigs = Data.List.concatMap group_kisigs + appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p) appendGroups @@ -444,6 +460,10 @@ tyClDeclLName (DataDecl { tcdLName = ln }) = ln tyClDeclLName (ClassDecl { tcdLName = ln }) = ln +tyClDeclTyVars :: TyClDecl (GhcPass p) -> LHsQTyVars (GhcPass p) +tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs +tyClDeclTyVars d = tcdTyVars d + countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int) -- class, synonym decls, data, newtype, family decls countTyClDecls decls @@ -530,7 +550,7 @@ ppr instds pp_vanilla_decl_head :: (OutputableBndrId p) - => XRec (GhcPass p) (IdP (GhcPass p)) + => XRecGhc (IdGhcP p) -> LHsQTyVars (GhcPass p) -> LexicalFixity -> Maybe (LHsContext (GhcPass p)) @@ -551,13 +571,18 @@ , hsep (map (ppr.unLoc) (varl:varsr))] pp_tyvars [] = pprPrefixOcc (unLoc thing) -pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc -pprTyClDeclFlavour (ClassDecl {}) = text "class" -pprTyClDeclFlavour (SynDecl {}) = text "type" -pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) - = pprFlavour info <+> text "family" -pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = nd } }) - = ppr (dataDefnConsNewOrData nd) +tyClDeclFlavour :: TyClDecl (GhcPass p) -> TyConFlavour tc +tyClDeclFlavour (ClassDecl {}) = ClassFlavour +tyClDeclFlavour (SynDecl {}) = TypeSynonymFlavour +tyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) + = case info of + DataFamily -> OpenFamilyFlavour (IAmData DataType) Nothing + OpenTypeFamily -> OpenFamilyFlavour IAmType Nothing + ClosedTypeFamily {} -> ClosedTypeFamilyFlavour +tyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = nd } }) + = case dataDefnConsNewOrData nd of + NewType -> NewtypeFlavour + DataType -> DataTypeFlavour instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where ppr = pprFunDep @@ -580,7 +605,14 @@ * * ********************************************************************* -} -type instance XCTyClGroup (GhcPass _) = NoExtField +type instance XCTyClGroup GhcPs = NoExtField + +type instance XCTyClGroup GhcRn = NameSet -- Lexical dependencies of an SCC + -- What names exactly are in this NameSet? See Note [Prepare TyClGroup FVs] in GHC.Rename.Module + -- How is this NameSet used? See Note [Retrying TyClGroups] in GHC.Tc.TyCl + +type instance XCTyClGroup GhcTc = DataConCantHappen + type instance XXTyClGroup (GhcPass _) = DataConCantHappen @@ -620,7 +652,7 @@ ------------- Functions over FamilyDecls ----------- -familyDeclLName :: FamilyDecl (GhcPass p) -> XRec (GhcPass p) (IdP (GhcPass p)) +familyDeclLName :: FamilyDecl (GhcPass p) -> XRecGhc (IdGhcP p) familyDeclLName (FamilyDecl { fdLName = n }) = n familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p) @@ -667,7 +699,7 @@ TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr pp_inj = case mb_inj of Just (L _ (InjectivityAnn _ lhs rhs)) -> - hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ] + hsep [ vbar, ppr lhs, arrow, hsep (map ppr rhs) ] Nothing -> empty (pp_where, pp_eqns) = case info of ClosedTypeFamily mb_eqns -> @@ -779,7 +811,7 @@ -- | Return @'Just' fields@ if a data constructor declaration uses record -- syntax (i.e., 'RecCon'), where @fields@ are the field selectors. -- Otherwise, return 'Nothing'. -getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (LocatedL [LConDeclField GhcRn]) +getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (LocatedL [LHsConDeclRecField GhcRn]) getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of PrefixCon{} -> Nothing RecCon flds -> Just flds @@ -836,7 +868,7 @@ instance OutputableBndrId p => Outputable (StandaloneKindSig (GhcPass p)) where ppr (StandaloneKindSig _ v ki) - = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki + = text "type" <+> pprPrefixOcc (unLoc v) <+> dcolon <+> ppr ki pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc pp_condecls cs @@ -860,27 +892,31 @@ where -- In ppr_details: let's not print the multiplicities (they are always 1, by -- definition) as they do not appear in an actual declaration. - ppr_details (InfixCon t1 t2) = hsep [ppr (hsScaledThing t1), + ppr_details (InfixCon t1 t2) = hsep [pprHsConDeclFieldNoMult t1, pprInfixOcc con, - ppr (hsScaledThing t2)] - ppr_details (PrefixCon _ tys) = hsep (pprPrefixOcc con - : map (pprHsType . unLoc . hsScaledThing) tys) + pprHsConDeclFieldNoMult t2] + ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con + : map pprHsConDeclFieldNoMult tys) ppr_details (RecCon fields) = pprPrefixOcc con - <+> pprConDeclFields (unLoc fields) + <+> pprHsConDeclRecFields (unLoc fields) -pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs +pprConDecl (ConDeclGADT { con_names = cons + , con_outer_bndrs = L _ outer_bndrs + , con_inner_bndrs = inner_bndrs , con_mb_cxt = mcxt, con_g_args = args , con_res_ty = res_ty, con_doc = doc }) = pprMaybeWithDoc doc $ ppr_con_names (toList cons) <+> dcolon - <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt, + <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs + <+> hsep (map pprHsForAllTelescope inner_bndrs) + <+> pprLHsContext mcxt, sep (ppr_args args ++ [ppr res_ty]) ]) where - ppr_args (PrefixConGADT _ args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args - ppr_args (RecConGADT _ fields) = [pprConDeclFields (unLoc fields) <+> arrow] + ppr_args (PrefixConGADT _ args) = map (pprHsConDeclFieldWith (\arr tyDoc -> tyDoc <+> ppr_arr arr)) args + ppr_args (RecConGADT _ fields) = [pprHsConDeclRecFields (unLoc fields) <+> arrow] -- Display linear arrows as unrestricted with -XNoLinearTypes -- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon) - ppr_arr (HsLinearArrow _) = sdocOption sdocLinearTypes $ \show_linear_types -> + ppr_arr (HsLinearAnn _) = sdocOption sdocLinearTypes $ \show_linear_types -> if show_linear_types then lollipop else arrow ppr_arr arr = pprHsArrow arr @@ -1077,10 +1113,6 @@ newOrDataToFlavour NewType = NewtypeFlavour newOrDataToFlavour DataType = DataTypeFlavour -instance Outputable NewOrData where - ppr NewType = text "newtype" - ppr DataType = text "data" - -- At the moment we only call this with @f = '[]'@ and @f = 'DataDefnCons'@. anyLConIsGadt :: Foldable f => f (GenLocated l (ConDecl pass)) -> Bool anyLConIsGadt xs = case toList xs of @@ -1295,15 +1327,13 @@ type instance XXRuleDecls (GhcPass _) = DataConCantHappen -type instance XHsRule GhcPs = (HsRuleAnn, SourceText) +type instance XHsRule GhcPs = ((ActivationAnn, EpToken "="), SourceText) type instance XHsRule GhcRn = (HsRuleRn, SourceText) type instance XHsRule GhcTc = (HsRuleRn, SourceText) data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS deriving Data -type instance XXRuleDecl (GhcPass _) = DataConCantHappen - data HsRuleAnn = HsRuleAnn { ra_tyanns :: Maybe (TokForall, EpToken ".") @@ -1315,13 +1345,11 @@ instance NoAnn HsRuleAnn where noAnn = HsRuleAnn Nothing Nothing noAnn noAnn +type instance XXRuleDecl (GhcPass _) = DataConCantHappen + flattenRuleDecls :: [LRuleDecls (GhcPass p)] -> [LRuleDecl (GhcPass p)] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls -type instance XCRuleBndr (GhcPass _) = AnnTyVarBndr -type instance XRuleBndrSig (GhcPass _) = AnnTyVarBndr -type instance XXRuleBndr (GhcPass _) = DataConCantHappen - instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where ppr (HsRules { rds_ext = ext , rds_rules = rules }) @@ -1336,28 +1364,18 @@ ppr (HsRule { rd_ext = ext , rd_name = name , rd_act = act - , rd_tyvs = tys - , rd_tmvs = tms + , rd_bndrs = bndrs , rd_lhs = lhs , rd_rhs = rhs }) = sep [pprFullRuleName st name <+> ppr act, - nest 4 (pp_forall_ty tys <+> pp_forall_tm tys - <+> pprExpr (unLoc lhs)), + nest 4 (ppr bndrs <+> pprExpr (unLoc lhs)), nest 6 (equals <+> pprExpr (unLoc rhs)) ] where - pp_forall_ty Nothing = empty - pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot - pp_forall_tm Nothing | null tms = empty - pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot st = case ghcPass @p of GhcPs | (_, st) <- ext -> st GhcRn | (_, st) <- ext -> st GhcTc | (_, st) <- ext -> st -instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where - ppr (RuleBndr _ name) = ppr name - ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty) - pprFullRuleName :: SourceText -> GenLocated a (RuleName) -> SDoc pprFullRuleName st (L _ n) = pprWithSourceText st (doubleQuotes $ ftext n) @@ -1471,7 +1489,7 @@ type instance Anno (StandaloneKindSig (GhcPass p)) = SrcSpanAnnA type instance Anno (ConDecl (GhcPass p)) = SrcSpanAnnA type instance Anno Bool = EpAnnCO -type instance Anno [LocatedA (ConDeclField (GhcPass _))] = SrcSpanAnnL +type instance Anno [LocatedA (HsConDeclRecField (GhcPass _))] = SrcSpanAnnL type instance Anno (FamEqn p (LocatedA (HsType p))) = SrcSpanAnnA type instance Anno (TyFamInstDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (DataFamInstDecl (GhcPass p)) = SrcSpanAnnA @@ -1487,7 +1505,6 @@ type instance Anno (RuleDecls (GhcPass p)) = SrcSpanAnnA type instance Anno (RuleDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (SourceText, RuleName) = EpAnnCO -type instance Anno (RuleBndr (GhcPass p)) = EpAnnCO type instance Anno (WarnDecls (GhcPass p)) = SrcSpanAnnA type instance Anno (WarnDecl (GhcPass p)) = SrcSpanAnnA type instance Anno (AnnDecl (GhcPass p)) = SrcSpanAnnA diff --git a/GHC/Hs/Doc.hs b/GHC/Hs/Doc.hs --- a/GHC/Hs/Doc.hs +++ b/GHC/Hs/Doc.hs @@ -50,7 +50,6 @@ import GHC.Hs.Extension import GHC.Types.Unique.Map import Data.List (sortBy) -import Data.Function import GHC.Hs.DocString @@ -89,7 +88,7 @@ instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where put_ bh (WithHsDocIdentifiers s ids) = do put_ bh s - put_ bh $ BinLocated <$> (sortBy (stableNameCmp `on` getName) ids) + put_ bh $ BinLocated <$> ids get bh = liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh) diff --git a/GHC/Hs/Doc.hs-boot b/GHC/Hs/Doc.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/Hs/Doc.hs-boot @@ -0,0 +1,19 @@ +{-# LANGUAGE RoleAnnotations #-} +module GHC.Hs.Doc where + +-- See #21592 for progress on removing this boot file. + +import GHC.Types.SrcLoc +import GHC.Hs.DocString +import Data.Kind + +type role WithHsDocIdentifiers representational nominal +type WithHsDocIdentifiers :: Type -> Type -> Type +data WithHsDocIdentifiers a pass + +type HsDoc :: Type -> Type +type HsDoc = WithHsDocIdentifiers HsDocString + +type LHsDoc :: Type -> Type +type LHsDoc pass = Located (HsDoc pass) + diff --git a/GHC/Hs/Dump.hs b/GHC/Hs/Dump.hs --- a/GHC/Hs/Dump.hs +++ b/GHC/Hs/Dump.hs @@ -6,6 +6,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -fno-specialise #-} + -- Don't do type-class specialisation; it goes mad in this module + -- See #25463 + -- | Contains a debug function to dump parts of the GHC.Hs AST. It uses a syb -- traversal which falls back to displaying based on the constructor name, so -- can be used to dump anything having a @Data.Data@ instance. diff --git a/GHC/Hs/Expr.hs b/GHC/Hs/Expr.hs --- a/GHC/Hs/Expr.hs +++ b/GHC/Hs/Expr.hs @@ -55,6 +55,7 @@ import GHC.Types.SrcLoc import GHC.Types.Tickish (CoreTickish) import GHC.Types.Unique.Set (UniqSet) +import GHC.Types.ThLevelIndex import GHC.Core.ConLike ( conLikeName, ConLike ) import GHC.Unit.Module (ModuleName) import GHC.Utils.Misc @@ -75,9 +76,10 @@ import qualified Data.Kind import Data.Maybe (isJust) import Data.Foldable ( toList ) -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Void (Void) - +import qualified Data.Set as S {- ********************************************************************* * * Expressions proper @@ -146,11 +148,6 @@ mkSyntaxExpr :: HsExpr GhcRn -> SyntaxExprRn mkSyntaxExpr = SyntaxExprRn --- | Make a 'SyntaxExpr' from a 'Name' (the "rn" is because this is used in the --- renamer). -mkRnSyntaxExpr :: Name -> SyntaxExprRn -mkRnSyntaxExpr name = SyntaxExprRn $ HsVar noExtField $ noLocA name - instance Outputable SyntaxExprRn where ppr (SyntaxExprRn expr) = ppr expr ppr NoSyntaxExprRn = text "" @@ -225,11 +222,6 @@ instance NoAnn EpAnnLam where noAnn = EpAnnLam noAnn noAnn -data EpAnnUnboundVar = EpAnnUnboundVar - { hsUnboundBackquotes :: (EpToken "`", EpToken "`") - , hsUnboundHole :: EpToken "_" - } deriving Data - -- Record selectors at parse time are HsVar; they convert to HsRecSel -- on renaming. type instance XRecSel GhcPs = DataConCantHappen @@ -246,14 +238,6 @@ type instance XVar (GhcPass _) = NoExtField -type instance XUnboundVar GhcPs = Maybe EpAnnUnboundVar -type instance XUnboundVar GhcRn = NoExtField -type instance XUnboundVar GhcTc = HoleExprRef - -- We really don't need the whole HoleExprRef; just the IORef EvTerm - -- would be enough. But then deriving a Data instance becomes impossible. - -- Much, much easier just to define HoleExprRef with a Data instance and - -- store the whole structure. - type instance XIPVar GhcPs = NoExtField type instance XIPVar GhcRn = NoExtField type instance XIPVar GhcTc = DataConCantHappen @@ -399,6 +383,148 @@ -- A free-standing HsEmbTy is an error. -- Valid usages are immediately desugared into Type. + +{- +Note [Holes in expressions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note explains how GHC uses the `HsHole` constructor. + +`HsHole` is used to represent: + + - anonymous ("_") and named ("_x") holes in expressions, + - unbound variables, + - and parse errors. + +A `HsHole` can be thought of as any thing which is not necessarily a valid or +fully defined program fragment, but for which a type can be derived. + +Note that holes (wildcards) in types, and partial type signatures, are not +handled using the mechanisms described here. Instead, see +Note [The wildcard story for types] for the relevant information. + + +* User-facing behavior + + While GHC uses the same internal mechanism to derive the type for any + `HsHole`, it gives different feedback to the user depending on the type of + hole. For example, an anonymous hole of the form + + foo x = x && _ + + gives the diagnostic + + Foo.hs:5:14: error: [GHC-88464] + • Found hole: _ :: Bool + • In the second argument of ‘(&&)’, namely ‘_’ + In the expression: x && _ + + while an expression containing an unbound variable + + foo x = x && y + + gives + + Foo.hs:5:14: error: [GHC-88464] + Variable not in scope: y :: Bool + + +* HsHole during parsing, renaming, and type checking + + The usage of `HsHole` during the three phases is listed below. + + - Anynomous holes, i.e. the user wrote "_": + + Parser HsHole (HoleVar "_") + Renamer HsHole (HoleVar "_") + Typechecker HsHole (HoleVar "_", ref :: HoleExprRef) + + - Unbound variables and named holes; i.e. the user wrote "x" or "_x", where + `x` or `_x` is not in scope. A variable with a leading underscore has no + special meaning to the parser. + + Parser HsVar "_x" + Renamer HsHole (HoleVar "_x") + Typechecker HsHole (HoleVar "_x", ref :: HoleExprRef) + + - Parse errors currently do not survive beyond the parser because an error is + thrown after parsing. However, in the future GHC is intended to be tolerant + of parse errors until the type checking phase to provide diagnostics similar + to holes. This current singular case looks like this: + + Parser HsHole HoleError + + Note that between anonymous holes, named holes, and unbound variables only the + parsing phase is distinct, while during the renaming and type checking phases + the cases are handled identically. The distinction that the user can observe + is only introduced during final error reporting. There the `RdrName` is + examined to see whether it starts with an underscore or not to determine + whether the `HsHole` came from a hole or an out of scope variable. + + +* Contents of HoleExprRef + + The HoleExprRef type used in the type checking phase is a data structure + containing: + + - The type of the hole. + - A ref-cell that is filled in (by the typechecker) with an + error thunk. With -fdefer-type errors we use this as the + value of the hole. + - A Unique (see Note [Uniques and tags]). + +* Typechecking holes + + When the typechecker encounters a `HsHole`, it returns one with the + HoleExprRef, but also emits a `DelayedError` into the `WantedConstraints`. + This DelayedError later triggers the error reporting, and the filling-in of + the error thunk, in GHC.Tc.Errors. + + The user has the option of deferring errors until runtime with + `-fdefer-type-errors`. In this case, the hole carries evidence in its + `HoleExprRef`. This evidence is an erroring expression that prints an error + and crashes at runtime. + +* Desugaring holes + + During desugaring, the `(HsHole (HoleVar "x", ref))` is desugared by + reading the ref-cell to find the error thunk evidence term, put there by the + constraint solver. + +* Wrinkles: + + - Prior to fixing #17812, we used to invent an Id to hold the erroring + expression, and then bind it during type-checking. But this does not support + representation-polymorphic out-of-scope identifiers. See + typecheck/should_compile/T17812. We thus use the mutable-CoreExpr approach + described above. + + - You might think that the type in the HoleExprRef is the same as the type of + the hole. However, because the hole type (hole_ty) is rewritten with respect + to givens, this might not be the case. That is, the hole_ty is always (~) to + the type of the HoleExprRef, but they might not be `eqType`. We need the + type of the generated evidence to match what is expected in the context of + the hole, and so we must store these types separately. + + - We really don't need the whole HoleExprRef; just the IORef EvTerm would be + enough. But then deriving a Data instance becomes impossible. Much, much + easier just to define HoleExprRef with a Data instance and store the whole + structure. +-} +-- | Expression Hole. See Note [Holes in expressions]. +type instance XHole GhcPs = HoleKind +type instance XHole GhcRn = HoleKind +type instance XHole GhcTc = (HoleKind, HoleExprRef) + +data HoleKind + = HoleVar (LIdP GhcPs) + | HoleError + deriving Data + +-- | The RdrName for an unnamed hole ("_"). +unnamedHoleRdrName :: RdrName +unnamedHoleRdrName = mkUnqual varName (fsLit "_") + + type instance XForAll GhcPs = NoExtField type instance XForAll GhcRn = NoExtField type instance XForAll GhcTc = DataConCantHappen @@ -418,9 +544,23 @@ type instance Anno [LocatedA ((StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (body (GhcPass pr)))))] = SrcSpanAnnLW type instance Anno (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))) = SrcSpanAnnA -arrowToHsExpr :: HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn -> LocatedA (HsExpr GhcRn) -arrowToHsExpr = expandHsArrow (HsVar noExtField) +multAnnToHsExpr :: HsMultAnnOf (LocatedA (HsExpr GhcRn)) GhcRn -> Maybe (LocatedA (HsExpr GhcRn)) +multAnnToHsExpr = expandHsMultAnnOf mkHsVar +mkHsVar :: forall p. IsPass p => LIdP (GhcPass p) -> HsExpr (GhcPass p) +mkHsVar n = HsVar noExtField $ + case ghcPass @p of + GhcPs -> n + GhcRn -> fmap (WithUserRdr $ nameRdrName $ unLoc n) n + GhcTc -> n + +mkHsVarWithUserRdr :: forall p. IsPass p => RdrName -> LIdP (GhcPass p) -> HsExpr (GhcPass p) +mkHsVarWithUserRdr rdr n = HsVar noExtField $ + case ghcPass @p of + GhcPs -> n + GhcRn -> fmap (WithUserRdr rdr) n + GhcTc -> n + data AnnExplicitSum = AnnExplicitSum { aesOpen :: EpaLocation, @@ -703,7 +843,13 @@ ppr_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> SDoc ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v -ppr_expr (HsUnboundVar _ uv) = pprPrefixOcc uv +ppr_expr (HsHole x) = case (ghcPass @p, x) of + (GhcPs, HoleVar (L _ v)) -> pprPrefixOcc v + (GhcRn, HoleVar (L _ v)) -> pprPrefixOcc v + (GhcTc, (HoleVar (L _ v), _)) -> pprPrefixOcc v + (GhcPs, HoleError) -> pprPrefixOcc unnamedHoleRdrName + (GhcRn, HoleError) -> pprPrefixOcc unnamedHoleRdrName + (GhcTc, (HoleError, _)) -> pprPrefixOcc unnamedHoleRdrName ppr_expr (HsIPVar _ v) = ppr v ppr_expr (HsOverLabel s l) = case ghcPass @p of GhcPs -> helper s @@ -809,14 +955,9 @@ nest 4 (ppr e3)] ppr_expr (HsMultiIf _ alts) - = hang (text "if") 3 (vcat (map ppr_alt alts)) + = hang (text "if") 3 (vcat $ toList $ NE.map ppr_alt alts) where ppr_alt (L _ (GRHS _ guards expr)) = - hang vbar 2 (ppr_one one_alt) - where - ppr_one [] = panic "ppr_exp HsMultiIf" - ppr_one (h:t) = hang h 2 (sep t) - one_alt = [ interpp'SP guards - , text "->" <+> pprDeeper (ppr expr) ] + hang vbar 2 (hang (interpp'SP guards) 2 (arrow <+> pprDeeper (ppr expr))) ppr_alt (L _ (XGRHS x)) = ppr x -- special case: let ... in let ... @@ -864,7 +1005,10 @@ ppr_expr (HsTypedSplice ext e) = case ghcPass @p of GhcPs -> pprTypedSplice Nothing e - GhcRn -> pprTypedSplice (Just ext) e + GhcRn -> + case ext of + HsTypedSpliceNested n -> pprTypedSplice (Just n) e + HsTypedSpliceTop {} -> pprTypedSplice Nothing e GhcTc -> pprTypedSplice Nothing e ppr_expr (HsUntypedSplice ext s) = case ghcPass @p of @@ -884,12 +1028,14 @@ GhcPs -> ppr q GhcRn -> case b of [] -> ppr q - ps -> ppr q $$ text "pending(rn)" <+> ppr ps + ps -> ppr q $$ whenPprDebug (text "pending(rn)" <+> ppr (map ppr_nested_splice ps)) GhcTc | HsBracketTc rnq _ty _wrap ps <- b -> ppr rnq `ppr_with_pending_tc_splices` ps + where + ppr_nested_splice (PendingRnSplice splice_name expr) = pprUntypedSplice False (Just splice_name) expr ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd))) - = hsep [text "proc", ppr pat, text "->", ppr cmd] + = hsep [text "proc", ppr pat, arrow, ppr cmd] ppr_expr (HsStatic _ e) = hsep [text "static", ppr e] @@ -959,10 +1105,13 @@ ppr exp, text ")"] ppr (HsRecSelTc f) = pprPrefixOcc f - ppr_infix_expr :: forall p. (OutputableBndrId p) => HsExpr (GhcPass p) -> Maybe SDoc ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v) -ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ) +ppr_infix_expr (HsHole x) = Just $ pprInfixOcc $ case (ghcPass @p, x) of + (GhcPs, HoleVar (L _ v)) -> v + (GhcRn, HoleVar (L _ v)) -> v + (GhcTc, (HoleVar (L _ v), _)) -> v + _ -> unnamedHoleRdrName -- TODO: this is the HoleError case; this should print the source text instead of "_". ppr_infix_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr_infix_expr_rn x GhcTc -> ppr_infix_expr_tc x @@ -981,7 +1130,6 @@ ppr_infix_expr_tc (HsBinTick {}) = Nothing ppr_infix_expr_tc (HsRecSelTc f) = Just (pprInfixOcc f) - ppr_infix_hs_expansion :: HsThingRn -> Maybe SDoc ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e ppr_infix_hs_expansion _ = Nothing @@ -1028,7 +1176,6 @@ where go :: HsExpr (GhcPass p) -> Bool go (HsVar{}) = False - go (HsUnboundVar{}) = False go (HsIPVar{}) = False go (HsOverLabel{}) = False go (HsLit _ l) = hsLitNeedsParens prec l @@ -1070,6 +1217,7 @@ go (HsProjection{}) = True go (HsGetField{}) = False go (HsEmbTy{}) = prec > topPrec + go (HsHole{}) = False go (HsForAll{}) = prec >= funPrec go (HsQual{}) = prec >= funPrec go (HsFunArr{}) = prec >= funPrec @@ -1125,7 +1273,7 @@ isAtomicHsExpr (HsOverLit {}) = True isAtomicHsExpr (HsIPVar {}) = True isAtomicHsExpr (HsOverLabel {}) = True -isAtomicHsExpr (HsUnboundVar {}) = True +isAtomicHsExpr (HsHole{}) = True isAtomicHsExpr (XExpr x) | GhcTc <- ghcPass @p = go_x_tc x | GhcRn <- ghcPass @p = go_x_rn x @@ -1574,22 +1722,24 @@ isSingletonMatchGroup :: [LMatch (GhcPass p) body] -> Bool isSingletonMatchGroup matches | [L _ match] <- matches - , Match { m_grhss = GRHSs { grhssGRHSs = [_] } } <- match + , Match { m_grhss = GRHSs { grhssGRHSs = _ :| [] } } <- match = True | otherwise = False matchGroupArity :: MatchGroup (GhcPass id) body -> Arity --- Precondition: MatchGroup is non-empty -- This is called before type checking, when mg_arg_tys is not set -matchGroupArity (MG { mg_alts = alts }) - | L _ (alt1:_) <- alts = count (isVisArgPat . unLoc) (hsLMatchPats alt1) - | otherwise = panic "matchGroupArity" - +matchGroupArity MG { mg_alts = L _ [] } = 1 -- See Note [Empty mg_alts] +matchGroupArity MG { mg_alts = L _ (alt1 : _) } = count isVisArgLPat (hsLMatchPats alt1) hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)] hsLMatchPats (L _ (Match { m_pats = L _ pats })) = pats +isInfixMatch :: Match (GhcPass p) body -> Bool +isInfixMatch match = case m_ctxt match of + FunRhs {mc_fixity = Infix} -> True + _ -> False + -- We keep the type checker happy by providing EpAnnComments. They -- can only be used if they follow a `where` keyword with no binds, -- but in that case the comment is attached to the following parsed @@ -1681,7 +1831,7 @@ pprGRHSs :: (OutputableBndrId idR, Outputable body) => HsMatchContext fn -> GRHSs (GhcPass idR) body -> SDoc pprGRHSs ctxt (GRHSs _ grhss binds) - = vcat (map (pprGRHS ctxt . unLoc) grhss) + = vcat (toList $ NE.map (pprGRHS ctxt . unLoc) grhss) -- Print the "where" even if the contents of the binds is empty. Only -- EmptyLocalBinds means no "where" keyword $$ ppUnless (eqEmptyLocalBinds binds) @@ -1700,10 +1850,10 @@ matchSeparator :: HsMatchContext fn -> SDoc matchSeparator FunRhs{} = text "=" -matchSeparator CaseAlt = text "->" -matchSeparator LamAlt{} = text "->" -matchSeparator IfAlt = text "->" -matchSeparator ArrowMatchCtxt{} = text "->" +matchSeparator CaseAlt = arrow +matchSeparator LamAlt{} = arrow +matchSeparator IfAlt = arrow +matchSeparator ArrowMatchCtxt{} = arrow matchSeparator PatBindRhs = text "=" matchSeparator PatBindGuards = text "=" matchSeparator StmtCtxt{} = text "<-" @@ -1890,7 +2040,7 @@ pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ binds) = hsep [text "let", pprBinds binds] pprStmt (BodyStmt _ expr _ _) = ppr expr -pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) +pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr $ toList stmtss)) pprStmt (TransStmt { trS_stmts = stmts, trS_by = by , trS_using = using, trS_form = form }) @@ -2065,8 +2215,14 @@ } | HsUntypedSpliceNested SplicePointName -- A unique name to identify this splice point -type instance XTypedSplice GhcPs = EpToken "$$" -type instance XTypedSplice GhcRn = SplicePointName +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +-- for an explanation of the Template Haskell extension points. +data HsTypedSpliceResult + = HsTypedSpliceTop + | HsTypedSpliceNested SplicePointName + +type instance XTypedSplice GhcPs = NoExtField +type instance XTypedSplice GhcRn = HsTypedSpliceResult type instance XTypedSplice GhcTc = DelayedSplice type instance XUntypedSplice GhcPs = NoExtField @@ -2075,13 +2231,26 @@ -- HsUntypedSplice type instance XUntypedSpliceExpr GhcPs = EpToken "$" -type instance XUntypedSpliceExpr GhcRn = EpToken "$" +type instance XUntypedSpliceExpr GhcRn = HsUserSpliceExt type instance XUntypedSpliceExpr GhcTc = DataConCantHappen -type instance XQuasiQuote p = NoExtField +type instance XTypedSpliceExpr GhcPs = EpToken "$$" +type instance XTypedSpliceExpr GhcRn = NoExtField +type instance XTypedSpliceExpr GhcTc = NoExtField -type instance XXUntypedSplice p = DataConCantHappen +type instance XQuasiQuote GhcPs = NoExtField +type instance XQuasiQuote GhcRn = HsQuasiQuoteExt +type instance XQuasiQuote GhcTc = DataConCantHappen + +type instance XXUntypedSplice GhcPs = DataConCantHappen +type instance XXUntypedSplice GhcRn = HsImplicitLiftSplice +type instance XXUntypedSplice GhcTc = DataConCantHappen + +type instance XXTypedSplice GhcPs = DataConCantHappen +type instance XXTypedSplice GhcRn = HsImplicitLiftSplice +type instance XXTypedSplice GhcTc = DataConCantHappen + -- See Note [Running typed splices in the zonker] -- These are the arguments that are passed to `GHC.Tc.Gen.Splice.runTopSplice` data DelayedSplice = @@ -2107,22 +2276,52 @@ | UntypedDeclSplice deriving Data --- | Pending Renamer Splice -data PendingRnSplice - = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr GhcRn) +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +-- A 'PendingRnSplice' is lifted from an untyped quotation and then typechecked. +data PendingRnSplice = PendingRnSplice SplicePointName (HsUntypedSplice GhcRn) + +instance Outputable PendingRnSplice where + ppr (PendingRnSplice sp expr) = + angleBrackets (ppr sp <> comma <+> pprUntypedSplice False Nothing expr) + -- | Pending Type-checker Splice +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] data PendingTcSplice = PendingTcSplice SplicePointName (LHsExpr GhcTc) +-- | Information about an implicit lift, discovered by the renamer +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +data HsImplicitLiftSplice = + HsImplicitLiftSplice + { implicit_lift_bind_lvl :: S.Set ThLevelIndex + , implicit_lift_used_lvl :: ThLevelIndex + , implicit_lift_gre :: Maybe GlobalRdrElt + , implicit_lift_lid :: LIdOccP GhcRn + } -pprPendingSplice :: (OutputableBndrId p) - => SplicePointName -> LHsExpr (GhcPass p) -> SDoc -pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr (stripParensLHsExpr e)) +-- | Information about a user-written splice, discovered by the renamer +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +data HsUserSpliceExt = + HsUserSpliceExt + { user_splice_flavour :: UntypedSpliceFlavour + } -pprTypedSplice :: (OutputableBndrId p) => Maybe SplicePointName -> LHsExpr (GhcPass p) -> SDoc -pprTypedSplice n e = ppr_splice (text "$$") n e +-- | Information about a quasi-quoter, discovered by the renamer +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +data HsQuasiQuoteExt = + HsQuasiQuoteExt + { quasi_quote_flavour :: UntypedSpliceFlavour + } + +pprTypedSplice :: forall p . (OutputableBndrId p) => Maybe SplicePointName -> HsTypedSplice (GhcPass p) -> SDoc +pprTypedSplice n (HsTypedSpliceExpr _ e) = ppr_splice (text "$$") n e +pprTypedSplice n (XTypedSplice p) = + case ghcPass @p of + GhcRn -> case p of + HsImplicitLiftSplice _ _ _ lid -> ppr lid <+> whenPprDebug (maybe empty (brackets . ppr) n) + pprUntypedSplice :: forall p. (OutputableBndrId p) => Bool -- Whether to precede the splice with "$" -> Maybe SplicePointName -- Used for pretty printing when exists @@ -2130,7 +2329,11 @@ -> SDoc pprUntypedSplice True n (HsUntypedSpliceExpr _ e) = ppr_splice (text "$") n e pprUntypedSplice False n (HsUntypedSpliceExpr _ e) = ppr_splice empty n e -pprUntypedSplice _ _ (HsQuasiQuote _ q s) = ppr_quasi q (unLoc s) +pprUntypedSplice _ _ (HsQuasiQuote _ q s) = ppr_quasi (unLoc q) (unLoc s) +pprUntypedSplice _ _ (XUntypedSplice x) = + case ghcPass @p of + GhcRn -> case x of + HsImplicitLiftSplice _ _ _ lid -> ppr lid ppr_quasi :: OutputableBndr p => p -> FastString -> SDoc ppr_quasi quoter quote = char '[' <> ppr quoter <> vbar <> @@ -2200,15 +2403,12 @@ thTyBrackets :: SDoc -> SDoc thTyBrackets pp_body = text "[||" <+> pp_body <+> text "||]" -instance Outputable PendingRnSplice where - ppr (PendingRnSplice _ n e) = pprPendingSplice n e - instance Outputable PendingTcSplice where - ppr (PendingTcSplice n e) = pprPendingSplice n e + ppr (PendingTcSplice n e) = angleBrackets (ppr n <> comma <+> ppr (stripParensLHsExpr e)) ppr_with_pending_tc_splices :: SDoc -> [PendingTcSplice] -> SDoc ppr_with_pending_tc_splices x [] = x -ppr_with_pending_tc_splices x ps = x $$ text "pending(tc)" <+> ppr ps +ppr_with_pending_tc_splices x ps = x $$ whenPprDebug (text "pending(tc)" <+> ppr ps) {- ************************************************************************ @@ -2346,7 +2546,8 @@ , trS_form = form }) = pprTransStmt by using form ppr_stmt stmt = pprStmt stmt -pprMatchContext :: Outputable fn => HsMatchContext fn -> SDoc + +pprMatchContext :: Outputable p => HsMatchContext p -> SDoc pprMatchContext ctxt | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt | otherwise = text "a" <+> pprMatchContextNoun ctxt @@ -2458,7 +2659,7 @@ instance (UnXRec p, Outputable (XRec p FieldLabelString)) => Outputable (FieldLabelStrings p) where ppr (FieldLabelStrings flds) = - hcat (punctuate dot (map (ppr . unXRec @p) flds)) + hcat (punctuate dot (toList $ NE.map (ppr . unXRec @p) flds)) instance (UnXRec p, Outputable (XRec p FieldLabelString)) => OutputableBndr (FieldLabelStrings p) where pprInfixOcc = pprFieldLabelStrings @@ -2470,7 +2671,7 @@ pprFieldLabelStrings :: forall p. (UnXRec p, Outputable (XRec p FieldLabelString)) => FieldLabelStrings p -> SDoc pprFieldLabelStrings (FieldLabelStrings flds) = - hcat (punctuate dot (map (ppr . unXRec @p) flds)) + hcat (punctuate dot (toList $ NE.map (ppr . unXRec @p) flds)) pprPrefixFastString :: FastString -> SDoc pprPrefixFastString fs = pprPrefixOcc (mkVarUnqual fs) diff --git a/GHC/Hs/Expr.hs-boot b/GHC/Hs/Expr.hs-boot --- a/GHC/Hs/Expr.hs-boot +++ b/GHC/Hs/Expr.hs-boot @@ -18,6 +18,7 @@ , MatchGroup , GRHSs , HsUntypedSplice + , HsTypedSplice ) import GHC.Hs.Extension ( OutputableBndrId, GhcPass ) import GHC.Types.Name ( Name ) @@ -33,7 +34,7 @@ pprExpr :: (OutputableBndrId p) => HsExpr (GhcPass p) -> SDoc -pprTypedSplice :: (OutputableBndrId p) => Maybe SplicePointName -> LHsExpr (GhcPass p) -> SDoc +pprTypedSplice :: (OutputableBndrId p) => Maybe SplicePointName -> HsTypedSplice (GhcPass p) -> SDoc pprUntypedSplice :: (OutputableBndrId p) => Bool -> Maybe SplicePointName -> HsUntypedSplice (GhcPass p) -> SDoc pprPatBind :: forall bndr p . (OutputableBndrId bndr, diff --git a/GHC/Hs/Extension.hs b/GHC/Hs/Extension.hs --- a/GHC/Hs/Extension.hs +++ b/GHC/Hs/Extension.hs @@ -98,13 +98,20 @@ -} -- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation -type instance XRec (GhcPass p) a = GenLocated (Anno a) a +type instance XRec (GhcPass p) a = XRecGhc a +-- (XRecGhc tree) wraps `tree` in a GHC-specific, +-- but pass-independent, source location +type XRecGhc a = GenLocated (Anno a) a + type instance Anno RdrName = SrcSpanAnnN type instance Anno Name = SrcSpanAnnN type instance Anno Id = SrcSpanAnnN +type instance Anno (WithUserRdr a) = Anno a + type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ EpAnn a, + Anno (IdOccGhcP p) ~ EpAnn a, NoAnn a, IsPass p) @@ -203,6 +210,16 @@ IdGhcP 'Renamed = Name IdGhcP 'Typechecked = Id +type LIdGhcP p = XRecGhc (IdGhcP p) + +type instance IdOccP (GhcPass p) = IdOccGhcP p + +type family IdOccGhcP pass where + IdOccGhcP 'Parsed = RdrName + IdOccGhcP 'Renamed = WithUserRdr Name + IdOccGhcP 'Typechecked = Id +type LIdOccGhcP p = XRecGhc (IdOccGhcP p) + -- | Marks that a field uses the GhcRn variant even when the pass -- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because -- HsType GhcTc should never occur. @@ -219,9 +236,13 @@ -- the @id@ and the 'NoGhcTc' of it. See Note [NoGhcTc]. type OutputableBndrId pass = ( OutputableBndr (IdGhcP pass) + , OutputableBndr (IdOccGhcP pass) , OutputableBndr (IdGhcP (NoGhcTcPass pass)) - , Outputable (GenLocated (Anno (IdGhcP pass)) (IdGhcP pass)) - , Outputable (GenLocated (Anno (IdGhcP (NoGhcTcPass pass))) (IdGhcP (NoGhcTcPass pass))) + , OutputableBndr (IdOccGhcP (NoGhcTcPass pass)) + , Outputable (LIdGhcP pass) + , Outputable (LIdOccGhcP pass) + , Outputable (LIdGhcP (NoGhcTcPass pass)) + , Outputable (LIdOccGhcP (NoGhcTcPass pass)) , IsPass pass ) diff --git a/GHC/Hs/ImpExp.hs b/GHC/Hs/ImpExp.hs --- a/GHC/Hs/ImpExp.hs +++ b/GHC/Hs/ImpExp.hs @@ -8,6 +8,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension +{-# LANGUAGE MultiWayIf #-} + {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -57,16 +59,8 @@ type instance Anno (ImportDecl (GhcPass p)) = SrcSpanAnnA --- | Given two possible located 'qualified' tokens, compute a style --- (in a conforming Haskell program only one of the two can be not --- 'Nothing'). This is called from "GHC.Parser". -importDeclQualifiedStyle :: Maybe (EpToken "qualified") - -> Maybe (EpToken "qualified") - -> (Maybe (EpToken "qualified"), ImportDeclQualifiedStyle) -importDeclQualifiedStyle mPre mPost = - if isJust mPre then (mPre, QualifiedPre) - else if isJust mPost then (mPost,QualifiedPost) else (Nothing, NotQualified) + -- | Convenience function to answer the question if an import decl. is -- qualified. isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool @@ -74,6 +68,7 @@ isImportDeclQualified _ = True + type instance ImportDeclPkgQual GhcPs = RawPkgQual type instance ImportDeclPkgQual GhcRn = PkgQual type instance ImportDeclPkgQual GhcTc = PkgQual @@ -114,13 +109,24 @@ { importDeclAnnImport :: EpToken "import" -- ^ The location of the @import@ keyword , importDeclAnnPragma :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively , importDeclAnnSafe :: Maybe (EpToken "safe") -- ^ The location of the @safe@ keyword + , importDeclAnnLevel :: Maybe EpAnnLevel -- ^ The location of the @splice@ or @quote@ keyword , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword , importDeclAnnPackage :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@) , importDeclAnnAs :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword } deriving (Data) + instance NoAnn EpAnnImportDecl where - noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing + noAnn = EpAnnImportDecl noAnn Nothing Nothing noAnn Nothing Nothing Nothing + +data EpAnnLevel = EpAnnLevelSplice (EpToken "splice") + | EpAnnLevelQuote (EpToken "quote") + deriving Data + +instance HasLoc EpAnnLevel where + getHasLoc (EpAnnLevelSplice tok) = getEpTokenSrcSpan tok + getHasLoc (EpAnnLevelQuote tok) = getEpTokenSrcSpan tok + -- --------------------------------------------------------------------- simpleImportDecl :: ModuleName -> ImportDecl GhcPs @@ -130,6 +136,7 @@ ideclPkgQual = NoRawPkgQual, ideclSource = NotBoot, ideclSafe = False, + ideclLevelSpec = NotLevelled, ideclQualified = NotQualified, ideclAs = Nothing, ideclImportList = Nothing @@ -197,6 +204,7 @@ type instance XIEDefault (GhcPass _) = EpToken "default" type instance XIEPattern (GhcPass _) = EpToken "pattern" type instance XIEType (GhcPass _) = EpToken "type" +type instance XIEData (GhcPass _) = EpToken "data" type instance XXIEWrappedName (GhcPass _) = DataConCantHappen type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA @@ -247,12 +255,15 @@ type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA +ieLIEWrappedName :: IE (GhcPass p) -> LIEWrappedName (GhcPass p) +ieLIEWrappedName (IEVar _ n _) = n +ieLIEWrappedName (IEThingAbs _ n _) = n +ieLIEWrappedName (IEThingWith _ n _ _ _) = n +ieLIEWrappedName (IEThingAll _ n _) = n +ieLIEWrappedName _ = panic "ieLIEWrappedName failed pattern match!" + ieName :: IE (GhcPass p) -> IdP (GhcPass p) -ieName (IEVar _ (L _ n) _) = ieWrappedName n -ieName (IEThingAbs _ (L _ n) _) = ieWrappedName n -ieName (IEThingWith _ (L _ n) _ _ _) = ieWrappedName n -ieName (IEThingAll _ (L _ n) _) = ieWrappedName n -ieName _ = panic "ieName failed pattern match!" +ieName = lieWrappedName . ieLIEWrappedName ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)] ieNames (IEVar _ (L _ n) _) = [ieWrappedName n] @@ -285,6 +296,7 @@ ieWrappedLName (IEName _ (L l n)) = L l n ieWrappedLName (IEPattern _ (L l n)) = L l n ieWrappedLName (IEType _ (L l n)) = L l n +ieWrappedLName (IEData _ (L l n)) = L l n ieWrappedName :: IEWrappedName (GhcPass p) -> IdP (GhcPass p) ieWrappedName = unLoc . ieWrappedLName @@ -301,6 +313,7 @@ replaceWrappedName (IEName x (L l _)) n = IEName x (L l n) replaceWrappedName (IEPattern r (L l _)) n = IEPattern r (L l n) replaceWrappedName (IEType r (L l _)) n = IEType r (L l n) +replaceWrappedName (IEData r (L l _)) n = IEData r (L l n) replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n') @@ -357,6 +370,7 @@ ppr (IEName _ (L _ n)) = pprPrefixOcc n ppr (IEPattern _ (L _ n)) = text "pattern" <+> pprPrefixOcc n ppr (IEType _ (L _ n)) = text "type" <+> pprPrefixOcc n + ppr (IEData _ (L _ n)) = text "data" <+> pprPrefixOcc n pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc pprImpExp name = type_pref <+> pprPrefixOcc name diff --git a/GHC/Hs/Instances.hs b/GHC/Hs/Instances.hs --- a/GHC/Hs/Instances.hs +++ b/GHC/Hs/Instances.hs @@ -33,6 +33,9 @@ import GHC.Hs.Pat import GHC.Hs.ImpExp import GHC.Parser.Annotation +import GHC.Types.Name.Reader (WithUserRdr(..)) +import GHC.Data.BooleanFormula (BooleanFormula(..)) +import Language.Haskell.Syntax.Extension (Anno) -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs----------------------------------------- @@ -108,9 +111,6 @@ deriving instance Data (HsPatSynDir GhcRn) deriving instance Data (HsPatSynDir GhcTc) -deriving instance Data (HsMultAnn GhcPs) -deriving instance Data (HsMultAnn GhcRn) -deriving instance Data (HsMultAnn GhcTc) -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Decls ---------------------------------- @@ -259,6 +259,13 @@ deriving instance Data (RuleBndr GhcRn) deriving instance Data (RuleBndr GhcTc) +deriving instance Data (RuleBndrs GhcPs) +deriving instance Data (RuleBndrs GhcRn) +deriving instance Data (RuleBndrs GhcTc) + +deriving instance Data TcSpecPrags +deriving instance Data TcSpecPrag + -- deriving instance (DataId p) => Data (WarnDecls p) deriving instance Data (WarnDecls GhcPs) deriving instance Data (WarnDecls GhcRn) @@ -403,7 +410,16 @@ deriving instance Data (HsUntypedSplice GhcRn) deriving instance Data (HsUntypedSplice GhcTc) +deriving instance Data (HsTypedSplice GhcPs) +deriving instance Data (HsTypedSplice GhcRn) +deriving instance Data (HsTypedSplice GhcTc) + +deriving instance Data HsImplicitLiftSplice +deriving instance Data HsUserSpliceExt +deriving instance Data HsQuasiQuoteExt + deriving instance Data a => Data (HsUntypedSpliceResult a) +deriving instance Data HsTypedSpliceResult -- deriving instance (DataIdLR p p) => Data (HsQuote p) deriving instance Data (HsQuote GhcPs) @@ -432,6 +448,8 @@ -- deriving instance (DataId p) => Data (HsLit p) deriving instance Data (HsLit GhcPs) deriving instance Data (HsLit GhcRn) + +deriving instance Data HsLitTc deriving instance Data (HsLit GhcTc) -- deriving instance (DataIdLR p p) => Data (HsOverLit p) @@ -452,10 +470,6 @@ deriving instance Data ConPatTc -deriving instance Data (HsConPatTyArg GhcPs) -deriving instance Data (HsConPatTyArg GhcRn) -deriving instance Data (HsConPatTyArg GhcTc) - deriving instance (Data a, Data b) => Data (HsFieldBind a b) deriving instance (Data body) => Data (HsRecFields GhcPs body) @@ -525,34 +539,36 @@ deriving instance Data (HsType GhcRn) deriving instance Data (HsType GhcTc) +deriving instance Data HsTypeGhcPsExt + -- deriving instance (DataIdLR p p) => Data (HsTyLit p) deriving instance Data (HsTyLit GhcPs) deriving instance Data (HsTyLit GhcRn) deriving instance Data (HsTyLit GhcTc) --- deriving instance (Data mult, DataIdLR p p) => Data (HsArrowOf mult p) -deriving instance Data (HsArrowOf (LocatedA (HsType GhcPs)) GhcPs) -deriving instance Data (HsArrowOf (LocatedA (HsType GhcRn)) GhcRn) -deriving instance Data (HsArrowOf (LocatedA (HsType GhcTc)) GhcTc) -deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcPs)) GhcPs) -deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn) -deriving instance Data (HsArrowOf (LocatedA (HsExpr GhcTc)) GhcTc) - --- deriving instance (DataIdLR p p) => Data (HsScaled p a) -deriving instance Data thing => Data (HsScaled GhcPs thing) -deriving instance Data thing => Data (HsScaled GhcRn thing) -deriving instance Data thing => Data (HsScaled GhcTc thing) +-- deriving instance (Data mult, DataIdLR p p) => Data (HsMultAnnOf mult p) +deriving instance Data (HsMultAnnOf (LocatedA (HsType GhcPs)) GhcPs) +deriving instance Data (HsMultAnnOf (LocatedA (HsType GhcRn)) GhcRn) +deriving instance Data (HsMultAnnOf (LocatedA (HsType GhcRn)) GhcTc) +deriving instance Data (HsMultAnnOf (LocatedA (HsExpr GhcPs)) GhcPs) +deriving instance Data (HsMultAnnOf (LocatedA (HsExpr GhcRn)) GhcRn) +deriving instance Data (HsMultAnnOf (LocatedA (HsExpr GhcTc)) GhcTc) -- deriving instance (Data a, Data b) => Data (HsArg p a b) deriving instance (Data a, Data b) => Data (HsArg GhcPs a b) deriving instance (Data a, Data b) => Data (HsArg GhcRn a b) deriving instance (Data a, Data b) => Data (HsArg GhcTc a b) --- deriving instance (DataIdLR p p) => Data (ConDeclField p) -deriving instance Data (ConDeclField GhcPs) -deriving instance Data (ConDeclField GhcRn) -deriving instance Data (ConDeclField GhcTc) +-- deriving instance (DataIdLR p p) => Data (HsConDeclRecField p) +deriving instance Data (HsConDeclRecField GhcPs) +deriving instance Data (HsConDeclRecField GhcRn) +deriving instance Data (HsConDeclRecField GhcTc) +-- deriving instance (DataIdLR p p, Typeable on) => Data (HsConDeclField on p) +deriving instance Data (HsConDeclField GhcPs) +deriving instance Data (HsConDeclField GhcRn) +deriving instance Data (HsConDeclField GhcTc) + -- deriving instance (DataId p) => Data (FieldOcc p) deriving instance Data (FieldOcc GhcPs) deriving instance Data (FieldOcc GhcRn) @@ -577,6 +593,7 @@ deriving instance Data HsThingRn deriving instance Data XXExprGhcRn +deriving instance Data a => Data (WithUserRdr a) -- --------------------------------------------------------------------- @@ -588,3 +605,6 @@ deriving instance Data XViaStrategyPs -- --------------------------------------------------------------------- + +deriving instance (Typeable p, Data (Anno (IdGhcP p)), Data (IdGhcP p)) => Data (BooleanFormula (GhcPass p)) +--------------------------------------------------------------------- diff --git a/GHC/Hs/Lit.hs b/GHC/Hs/Lit.hs --- a/GHC/Hs/Lit.hs +++ b/GHC/Hs/Lit.hs @@ -62,12 +62,27 @@ type instance XHsWord16Prim (GhcPass _) = SourceText type instance XHsWord32Prim (GhcPass _) = SourceText type instance XHsWord64Prim (GhcPass _) = SourceText -type instance XHsInteger (GhcPass _) = SourceText -type instance XHsRat (GhcPass _) = NoExtField type instance XHsFloatPrim (GhcPass _) = NoExtField type instance XHsDoublePrim (GhcPass _) = NoExtField -type instance XXLit (GhcPass _) = DataConCantHappen +type instance XXLit GhcPs = DataConCantHappen +type instance XXLit GhcRn = DataConCantHappen +type instance XXLit GhcTc = HsLitTc + +data HsLitTc + = HsInteger SourceText Integer Type + -- ^ Genuinely an integer; arises only + -- from TRANSLATION (overloaded + -- literals are done with HsOverLit) + | HsRat FractionalLit Type + -- ^ Genuinely a rational; arises only from + -- TRANSLATION (overloaded literals are + -- done with HsOverLit) +instance Eq HsLitTc where + (HsInteger _ x _) == (HsInteger _ y _) = x==y + (HsRat x _) == (HsRat y _) = x==y + _ == _ = False + data OverLitRn = OverLitRn { ol_rebindable :: Bool, -- Note [ol_rebindable] @@ -130,7 +145,7 @@ -- -- See Note [Printing of literals in Core] in GHC.Types.Literal -- for the reasoning. -hsLitNeedsParens :: PprPrec -> HsLit x -> Bool +hsLitNeedsParens :: forall x. IsPass x => PprPrec -> HsLit (GhcPass x) -> Bool hsLitNeedsParens p = go where go (HsChar {}) = False @@ -139,8 +154,6 @@ go (HsMultilineString {}) = False go (HsStringPrim {}) = False go (HsInt _ x) = p > topPrec && il_neg x - go (HsInteger _ x _) = p > topPrec && x < 0 - go (HsRat _ x _) = p > topPrec && fl_neg x go (HsFloatPrim {}) = False go (HsDoublePrim {}) = False go (HsIntPrim {}) = False @@ -153,10 +166,18 @@ go (HsWord16Prim {}) = False go (HsWord64Prim {}) = False go (HsWord32Prim {}) = False - go (XLit _) = False + go (XLit x) = case ghcPass @x of + GhcTc -> case x of + (HsInteger _ x _) -> p > topPrec && x < 0 + (HsRat x _) -> p > topPrec && fl_neg x --- | Convert a literal from one index type to another -convertLit :: HsLit (GhcPass p1) -> HsLit (GhcPass p2) + +-- | Convert a literal from one index type to another. +-- The constraint XXLit (GhcPass p)~DataConCantHappen means that once the +-- XLit constructor is inhabited, we can no longer go back to the case where +-- its not. In practice it just means you can't just convertLit to go from +-- (HsLit GhcTc) -> (HsLit GhcPs/GhcRn), while all other conversions are fine. +convertLit :: XXLit (GhcPass p)~DataConCantHappen => HsLit (GhcPass p) -> HsLit (GhcPass p') convertLit (HsChar a x) = HsChar a x convertLit (HsCharPrim a x) = HsCharPrim a x convertLit (HsString a x) = HsString a x @@ -173,8 +194,6 @@ convertLit (HsWord16Prim a x) = HsWord16Prim a x convertLit (HsWord32Prim a x) = HsWord32Prim a x convertLit (HsWord64Prim a x) = HsWord64Prim a x -convertLit (HsInteger a x b) = HsInteger a x b -convertLit (HsRat a x b) = HsRat a x b convertLit (HsFloatPrim a x) = HsFloatPrim a x convertLit (HsDoublePrim a x) = HsDoublePrim a x @@ -194,7 +213,7 @@ -} -- Instance specific to GhcPs, need the SourceText -instance Outputable (HsLit (GhcPass p)) where +instance IsPass p => Outputable (HsLit (GhcPass p)) where ppr (HsChar st c) = pprWithSourceText st (pprHsChar c) ppr (HsCharPrim st c) = pprWithSourceText st (pprPrimChar c) ppr (HsString st s) = pprWithSourceText st (pprHsString s) @@ -205,8 +224,6 @@ ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s) ppr (HsInt _ i) = pprWithSourceText (il_text i) (integer (il_value i)) - ppr (HsInteger st i _) = pprWithSourceText st (integer i) - ppr (HsRat _ f _) = ppr f ppr (HsFloatPrim _ f) = ppr f <> primFloatSuffix ppr (HsDoublePrim _ d) = ppr d <> primDoubleSuffix ppr (HsIntPrim st i) = pprWithSourceText st (pprPrimInt i) @@ -219,6 +236,10 @@ ppr (HsWord16Prim st w) = pprWithSourceText st (pprPrimWord16 w) ppr (HsWord32Prim st w) = pprWithSourceText st (pprPrimWord32 w) ppr (HsWord64Prim st w) = pprWithSourceText st (pprPrimWord64 w) + ppr (XLit x) = case ghcPass @p of + GhcTc -> case x of + (HsInteger st i _) -> pprWithSourceText st (integer i) + (HsRat f _) -> ppr f -- in debug mode, print the expression that it's resolved to, too instance OutputableBndrId p @@ -237,7 +258,7 @@ -- mainly for too reasons: -- * We do not want to expose their internal representation -- * The warnings become too messy -pmPprHsLit :: HsLit (GhcPass x) -> SDoc +pmPprHsLit :: forall p. IsPass p => HsLit (GhcPass p) -> SDoc pmPprHsLit (HsChar _ c) = pprHsChar c pmPprHsLit (HsCharPrim _ c) = pprHsChar c pmPprHsLit (HsString st s) = pprWithSourceText st (pprHsString s) @@ -254,10 +275,12 @@ pmPprHsLit (HsWord16Prim _ w) = integer w pmPprHsLit (HsWord32Prim _ w) = integer w pmPprHsLit (HsWord64Prim _ w) = integer w -pmPprHsLit (HsInteger _ i _) = integer i -pmPprHsLit (HsRat _ f _) = ppr f pmPprHsLit (HsFloatPrim _ f) = ppr f pmPprHsLit (HsDoublePrim _ d) = ppr d +pmPprHsLit (XLit x) = case ghcPass @p of + GhcTc -> case x of + (HsInteger _ i _) -> integer i + (HsRat f _) -> ppr f negateOverLitVal :: OverLitVal -> OverLitVal negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i) diff --git a/GHC/Hs/Pat.hs b/GHC/Hs/Pat.hs --- a/GHC/Hs/Pat.hs +++ b/GHC/Hs/Pat.hs @@ -24,15 +24,15 @@ module GHC.Hs.Pat ( Pat(..), LPat, - isInvisArgPat, isVisArgPat, + isInvisArgPat, isInvisArgLPat, + isVisArgPat, isVisArgLPat, EpAnnSumPat(..), ConPatTc (..), ConLikeP, HsPatExpansion(..), XXPatGhcTc(..), - HsConPatDetails, hsConPatArgs, hsConPatTyArgs, - HsConPatTyArg(..), + HsConPatDetails, hsConPatArgs, HsRecFields(..), HsFieldBind(..), LHsFieldBind, HsRecField, LHsRecField, HsRecUpdField, LHsRecUpdField, @@ -84,7 +84,9 @@ import GHC.Types.SrcLoc import GHC.Data.Bag -- collect ev vars from pats import GHC.Types.Name + import Data.Data +import qualified Data.List( map ) import qualified Data.List.NonEmpty as NE @@ -177,17 +179,13 @@ -- XXExprGhcRn allows us to handle RebindableSyntax in pattern position: -- see "XXExpr GhcTc" for the counterpart in expressions. -type instance ConLikeP GhcPs = RdrName -- IdP GhcPs -type instance ConLikeP GhcRn = Name -- IdP GhcRn +type instance ConLikeP GhcPs = RdrName -- IdOccP GhcPs +type instance ConLikeP GhcRn = WithUserRdr Name -- IdOccP GhcRn type instance ConLikeP GhcTc = ConLike -type instance XConPatTyArg GhcPs = EpToken "@" -type instance XConPatTyArg GhcRn = NoExtField -type instance XConPatTyArg GhcTc = NoExtField - type instance XHsRecFields GhcPs = NoExtField type instance XHsRecFields GhcRn = NoExtField -type instance XHsRecFields GhcTc = MultiplicityCheckCoercions +type instance XHsRecFields GhcTc = NoExtField type instance XHsFieldBind _ = Maybe (EpToken "=") @@ -337,6 +335,16 @@ cpt_wrap :: HsWrapper } + +hsRecFields :: HsRecFields (GhcPass p) arg -> [IdGhcP p] +hsRecFields rbinds = Data.List.map (hsRecFieldSel . unLoc) (rec_flds rbinds) + +hsRecFieldsArgs :: HsRecFields (GhcPass p) arg -> [arg] +hsRecFieldsArgs rbinds = Data.List.map (hfbRHS . unLoc) (rec_flds rbinds) + +hsRecFieldSel :: HsRecField (GhcPass p) arg -> IdGhcP p +hsRecFieldSel = unLoc . foLabel . unLoc . hfbLHS + hsRecFieldId :: HsRecField GhcTc arg -> Id hsRecFieldId = hsRecFieldSel @@ -348,9 +356,6 @@ ************************************************************************ -} -instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where - ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty - instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot) => Outputable (HsRecFields p arg) where ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing }) @@ -498,8 +503,7 @@ pprConArgs :: (OutputableBndrId p, Outputable (Anno (IdGhcP p))) => HsConPatDetails (GhcPass p) -> SDoc -pprConArgs (PrefixCon ts pats) = fsep (pprTyArgs ts : map (pprParendLPat appPrec) pats) - where pprTyArgs tyargs = fsep (map ppr tyargs) +pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats) pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1 , pprParendLPat appPrec p2 ] pprConArgs (RecCon rpats) = ppr rpats @@ -517,7 +521,7 @@ -- Make a vanilla Prefix constructor pattern mkPrefixConPat dc pats tys = noLocA $ ConPat { pat_con = noLocA (RealDataCon dc) - , pat_args = PrefixCon [] pats + , pat_args = PrefixCon pats , pat_con_ext = ConPatTc { cpt_tvs = [] , cpt_dicts = [] @@ -1091,12 +1095,12 @@ -- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@ -- needs parentheses under precedence @p@. -conPatNeedsParens :: PprPrec -> HsConDetails t a b -> Bool +conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool conPatNeedsParens p = go where - go (PrefixCon ts args) = p >= appPrec && (not (null args) || not (null ts)) - go (InfixCon {}) = p >= opPrec -- type args should be empty in this case - go (RecCon {}) = False + go (PrefixCon args) = p >= appPrec && not (null args) + go (InfixCon {}) = p >= opPrec -- type args should be empty in this case + go (RecCon {}) = False -- | Parenthesize a pattern without token information diff --git a/GHC/Hs/Specificity.hs b/GHC/Hs/Specificity.hs --- a/GHC/Hs/Specificity.hs +++ b/GHC/Hs/Specificity.hs @@ -49,4 +49,3 @@ rnf (Invisible spec) = rnf spec rnf Required = () - diff --git a/GHC/Hs/Stats.hs b/GHC/Hs/Stats.hs --- a/GHC/Hs/Stats.hs +++ b/GHC/Hs/Stats.hs @@ -115,6 +115,7 @@ sig_info (FixSig {}) = (1,0,0,0,0) sig_info (TypeSig {}) = (0,1,0,0,0) sig_info (SpecSig {}) = (0,0,1,0,0) + sig_info (SpecSigE {}) = (0,0,1,0,0) sig_info (InlineSig {}) = (0,0,0,1,0) sig_info (ClassOpSig {}) = (0,0,0,0,1) sig_info _ = (0,0,0,0,0) @@ -134,9 +135,8 @@ spec_info (Just (Exactly, _)) = (0,0,0,0,0,1,0) spec_info (Just (EverythingBut, _)) = (0,0,0,0,0,0,1) - data_info (DataDecl { tcdDataDefn = HsDataDefn - { dd_cons = cs - , dd_derivs = derivs}}) + data_info (DataDecl { tcdDataDefn = dd :: HsDataDefn GhcPs }) + | HsDataDefn { dd_cons = cs, dd_derivs = derivs} <- dd = ( length cs , foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s) 0 derivs ) diff --git a/GHC/Hs/Syn/Type.hs b/GHC/Hs/Syn/Type.hs --- a/GHC/Hs/Syn/Type.hs +++ b/GHC/Hs/Syn/Type.hs @@ -7,8 +7,7 @@ -- * Extracting types from HsExpr lhsExprType, hsExprType, hsWrapperType, -- * Extracting types from HsSyn - hsLitType, hsPatType, hsLPatType - + hsLitType, hsPatType, hsLPatType, ) where import GHC.Prelude @@ -72,7 +71,7 @@ ExpansionPat _ pat -> hsPatType pat hsPatType (SplicePat v _) = dataConCantHappen v -hsLitType :: HsLit (GhcPass p) -> Type +hsLitType :: forall p. IsPass p => HsLit (GhcPass p) -> Type hsLitType (HsChar _ _) = charTy hsLitType (HsCharPrim _ _) = charPrimTy hsLitType (HsString _ _) = stringTy @@ -89,10 +88,12 @@ hsLitType (HsWord16Prim _ _) = word16PrimTy hsLitType (HsWord32Prim _ _) = word32PrimTy hsLitType (HsWord64Prim _ _) = word64PrimTy -hsLitType (HsInteger _ _ ty) = ty -hsLitType (HsRat _ _ ty) = ty hsLitType (HsFloatPrim _ _) = floatPrimTy hsLitType (HsDoublePrim _ _) = doublePrimTy +hsLitType (XLit x) = case ghcPass @p of + GhcTc -> case x of + (HsInteger _ _ ty) -> ty + (HsRat _ ty) -> ty -- | Compute the 'Type' of an @'LHsExpr' 'GhcTc'@ in a pure fashion. @@ -102,7 +103,6 @@ -- | Compute the 'Type' of an @'HsExpr' 'GhcTc'@ in a pure fashion. hsExprType :: HsExpr GhcTc -> Type hsExprType (HsVar _ (L _ id)) = idType id -hsExprType (HsUnboundVar (HER _ ty _) _) = ty hsExprType (HsOverLabel v _) = dataConCantHappen v hsExprType (HsIPVar v _) = dataConCantHappen v hsExprType (HsOverLit _ lit) = overLitType lit @@ -145,6 +145,7 @@ hsExprType (HsStatic (_, ty) _s) = ty hsExprType (HsPragE _ _ e) = lhsExprType e hsExprType (HsEmbTy x _) = dataConCantHappen x +hsExprType (HsHole (_, (HER _ ty _))) = ty hsExprType (HsQual x _ _) = dataConCantHappen x hsExprType (HsForAll x _ _) = dataConCantHappen x hsExprType (HsFunArr x _ _ _) = dataConCantHappen x @@ -200,7 +201,6 @@ go (WpTyLam tv) = liftPRType $ mkForAllTy (Bndr tv Inferred) go (WpTyApp ta) = \(ty,tas) -> (ty, ta:tas) go (WpLet _) = id - go (WpMultCoercion _) = id lhsCmdTopType :: LHsCmdTop GhcTc -> Type lhsCmdTopType (L _ (HsCmdTop (CmdTopTc _ ret_ty _) _)) = ret_ty diff --git a/GHC/Hs/Type.hs b/GHC/Hs/Type.hs --- a/GHC/Hs/Type.hs +++ b/GHC/Hs/Type.hs @@ -23,14 +23,14 @@ -} module GHC.Hs.Type ( - Mult, HsScaled(..), - hsMult, hsScaledThing, - HsArrow, HsArrowOf(..), arrowToHsType, expandHsArrow, - EpLinearArrow(..), - hsLinear, hsUnrestricted, isUnrestricted, - pprHsArrow, + Mult, + HsMultAnn, HsMultAnnOf(..), + multAnnToHsType, expandHsMultAnnOf, + EpLinear(..), EpArrowOrColon(..), + pprHsArrow, pprHsMultAnn, HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, + HsTypeGhcPsExt(..), HsForAllTelescope(..), EpAnnForallVis, EpAnnForallInvis, HsTyVarBndr(..), LHsTyVarBndr, AnnTyVarBndr(..), HsBndrKind(..), @@ -51,14 +51,14 @@ LHsTypeArg, lhsTypeArgSrcSpan, OutputableBndrFlag, - LBangType, BangType, HsSrcBang(..), HsImplBang(..), SrcStrictness(..), SrcUnpackedness(..), - getBangType, getBangStrictness, - ConDeclField(..), LConDeclField, pprConDeclFields, + HsConDeclRecField(..), LHsConDeclRecField, pprHsConDeclRecFields, - HsConDetails(..), noTypeArgs, + HsConDetails(..), + HsConDeclField(..), pprHsConDeclFieldWith, pprHsConDeclFieldNoMult, + hsPlainTypeField, mkConDeclField, FieldOcc(..), LFieldOcc, mkFieldOcc, fieldOccRdrName, fieldOccLRdrName, @@ -77,7 +77,9 @@ hsScopedTvs, hsScopedKvs, hsWcScopedTvs, dropWildCards, hsTyVarLName, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, - hsLTyVarName, hsLTyVarNames, hsForAllTelescopeNames, + hsLTyVarName, hsLTyVarNames, + hsForAllTelescopeBndrs, + hsForAllTelescopeNames, hsLTyVarLocName, hsExplicitLTyVarNames, splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe, splitLHsPatSynTy, @@ -90,7 +92,7 @@ setHsTyVarBndrFlag, hsTyVarBndrFlag, updateHsTyVarBndrFlag, -- Printing - pprHsType, pprHsForAll, + pprHsType, pprHsForAll, pprHsForAllTelescope, pprHsOuterFamEqnTyVarBndrs, pprHsOuterSigTyVarBndrs, pprLHsContext, hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext @@ -105,7 +107,6 @@ import Language.Haskell.Syntax.Extension import GHC.Core.DataCon ( SrcStrictness(..), SrcUnpackedness(..) , HsSrcBang(..), HsImplBang(..) - , mkHsSrcBang ) import GHC.Hs.Extension import GHC.Parser.Annotation @@ -113,11 +114,11 @@ import GHC.Types.Fixity ( LexicalFixity(..) ) import GHC.Types.SourceText import GHC.Types.Name -import GHC.Types.Name.Reader ( RdrName ) +import GHC.Types.Name.Reader ( RdrName, WithUserRdr(..), noUserRdr ) import GHC.Types.Var ( VarBndr, visArgTypeLike ) import GHC.Core.TyCo.Rep ( Type(..) ) import GHC.Builtin.Names ( negateName ) -import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr ) +import GHC.Builtin.Types( oneDataConName, mkTupleStr ) import GHC.Core.Ppr ( pprOccWithTick) import GHC.Core.Type import GHC.Core.Multiplicity( pprArrowWithMultiplicity ) @@ -136,25 +137,6 @@ {- ************************************************************************ * * -\subsection{Bang annotations} -* * -************************************************************************ --} - -getBangType :: LHsType (GhcPass p) -> LHsType (GhcPass p) -getBangType (L _ (HsBangTy _ _ lty)) = lty -getBangType (L _ (HsDocTy x (L _ (HsBangTy _ _ lty)) lds)) = - addCLocA lty lds (HsDocTy x lty lds) -getBangType lty = lty - -getBangStrictness :: LHsType (GhcPass p) -> HsSrcBang -getBangStrictness (L _ (HsBangTy (_, s) b _)) = HsSrcBang s b -getBangStrictness (L _ (HsDocTy _ (L _ (HsBangTy (_, s) b _)) _)) = HsSrcBang s b -getBangStrictness _ = (mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict) - -{- -************************************************************************ -* * \subsection{Data types} * * ************************************************************************ @@ -299,10 +281,14 @@ type instance XHsSig (GhcPass _) = NoExtField type instance XXHsSigType (GhcPass _) = DataConCantHappen -hsSigWcType :: forall p. UnXRec p => LHsSigWcType p -> LHsType p -hsSigWcType = sig_body . unXRec @p . hswc_body -dropWildCards :: LHsSigWcType pass -> LHsSigType pass +hsPatSigType :: HsPatSigType (GhcPass p) -> LHsType (GhcPass p) +hsPatSigType (HsPS { hsps_body = ty }) = ty + +hsSigWcType :: LHsSigWcType (GhcPass p) -> LHsType (GhcPass p) +hsSigWcType = sig_body . unLoc . hswc_body + +dropWildCards :: LHsSigWcType (GhcPass p) -> LHsSigType (GhcPass p) -- Drop the wildcard part of a LHsSigWcType dropWildCards sig_ty = hswc_body sig_ty @@ -475,11 +461,8 @@ type instance XSpliceTy GhcTc = Kind type instance XDocTy (GhcPass _) = NoExtField -type instance XBangTy (GhcPass _) = ((EpaLocation, EpToken "#-}", EpaLocation), SourceText) - -type instance XRecTy GhcPs = AnnList () -type instance XRecTy GhcRn = NoExtField -type instance XRecTy GhcTc = NoExtField +type instance XConDeclField (GhcPass _) = ((EpaLocation, EpToken "#-}", EpaLocation), SourceText) +type instance XXConDeclRecField (GhcPass _) = DataConCantHappen type instance XExplicitListTy GhcPs = (EpToken "'", EpToken "[", EpToken "]") type instance XExplicitListTy GhcRn = NoExtField @@ -495,92 +478,123 @@ type instance XWildCardTy GhcRn = NoExtField type instance XWildCardTy GhcTc = NoExtField -type instance XXType (GhcPass _) = HsCoreTy - --- An escape hatch for tunnelling a Core 'Type' through 'HsType'. --- For more details on how this works, see: --- --- * @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType" --- --- * @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType" -type HsCoreTy = Type +type instance XXType GhcPs = HsTypeGhcPsExt +type instance XXType GhcRn = HsCoreTy +type instance XXType GhcTc = DataConCantHappen type instance XNumTy (GhcPass _) = SourceText type instance XStrTy (GhcPass _) = SourceText type instance XCharTy (GhcPass _) = SourceText type instance XXTyLit (GhcPass _) = DataConCantHappen -data EpLinearArrow - = EpPct1 !(EpToken "%1") !(TokRarrow) - | EpLolly !(EpToken "⊸") - deriving Data +type HsCoreTy = Type -instance NoAnn EpLinearArrow where - noAnn = EpPct1 noAnn noAnn +-- Extension of HsType during parsing. +-- see Note [Trees That Grow] in Language.Haskell.Syntax.Extension +data HsTypeGhcPsExt + = HsCoreTy HsCoreTy + -- An escape hatch for tunnelling a Core 'Type' through 'HsType'. + -- For more details on how this works, see: + -- + -- @Note [Renaming HsCoreTys]@ in "GHC.Rename.HsType" + -- + -- @Note [Typechecking HsCoreTys]@ in "GHC.Tc.Gen.HsType" -type instance XUnrestrictedArrow _ GhcPs = TokRarrow -type instance XUnrestrictedArrow _ GhcRn = NoExtField -type instance XUnrestrictedArrow _ GhcTc = NoExtField + | HsBangTy (EpaLocation, EpToken "#-}", EpaLocation) + HsSrcBang + (LHsType GhcPs) + -- See Note [Parsing data type declarations] -type instance XLinearArrow _ GhcPs = EpLinearArrow -type instance XLinearArrow _ GhcRn = NoExtField -type instance XLinearArrow _ GhcTc = NoExtField + | HsRecTy (AnnList ()) + [LHsConDeclRecField GhcPs] + -- See Note [Parsing data type declarations] -type instance XExplicitMult _ GhcPs = (EpToken "%", TokRarrow) -type instance XExplicitMult _ GhcRn = NoExtField -type instance XExplicitMult _ GhcTc = NoExtField +{- Note [Parsing data type declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When parsing it is not always clear if we're parsing a constructor field type +or not. So during parsing we extend the type syntax to support bang annotations +and record braces. We do this through the extension constructor of (HsType GhcPs), +namely `HsTypeGhcPsExt`, adding data constructors for `HsBangTy` and `HsRecTy`. +Once parsing is done (i.e. (HsType GhcRn) and (HsType GhcTc)) these constructors +are not needed; instead the data is stored in `HsConDeclField`. It is an error +if it turns out the extensions were used outside of a constructor field type. +-} -type instance XXArrow _ (GhcPass _) = DataConCantHappen +data EpArrowOrColon + = EpArrow !TokRarrow + | EpColon !TokDcolon + | EpPatBind + deriving Data -hsLinear :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a -hsLinear = HsScaled (HsLinearArrow x) - where - x = case ghcPass @p of - GhcPs -> noAnn - GhcRn -> noExtField - GhcTc -> noExtField +data EpLinear + = EpPct1 !(EpToken "%1") !EpArrowOrColon + | EpLolly !(EpToken "⊸") + deriving Data -hsUnrestricted :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a -hsUnrestricted = HsScaled (HsUnrestrictedArrow x) - where - x = case ghcPass @p of - GhcPs -> noAnn - GhcRn -> noExtField - GhcTc -> noExtField +instance NoAnn EpLinear where + noAnn = EpPct1 noAnn (EpArrow noAnn) -isUnrestricted :: HsArrow GhcRn -> Bool -isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName -isUnrestricted _ = False +type instance XUnannotated _ GhcPs = EpArrowOrColon +type instance XUnannotated _ GhcRn = NoExtField +type instance XUnannotated _ GhcTc = Mult -arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn -arrowToHsType = expandHsArrow (HsTyVar noAnn NotPromoted) +type instance XLinearAnn _ GhcPs = EpLinear +type instance XLinearAnn _ GhcRn = NoExtField +type instance XLinearAnn _ GhcTc = Mult --- | Convert an arrow into its corresponding multiplicity. In essence this --- erases the information of whether the programmer wrote an explicit --- multiplicity or a shorthand. -expandHsArrow :: (LocatedN Name -> t GhcRn) -> HsArrowOf (LocatedA (t GhcRn)) GhcRn -> LocatedA (t GhcRn) -expandHsArrow mk_var (HsUnrestrictedArrow _) = noLocA (mk_var (noLocA manyDataConName)) -expandHsArrow mk_var (HsLinearArrow _) = noLocA (mk_var (noLocA oneDataConName)) -expandHsArrow _mk_var (HsExplicitMult _ p) = p +type instance XExplicitMult _ GhcPs = (EpToken "%", EpArrowOrColon) +type instance XExplicitMult _ GhcRn = NoExtField +type instance XExplicitMult _ GhcTc = Mult +type instance XXMultAnnOf _ (GhcPass _) = DataConCantHappen + +multAnnToHsType :: HsMultAnn GhcRn -> Maybe (LHsType GhcRn) +multAnnToHsType = expandHsMultAnnOf (HsTyVar noAnn NotPromoted . fmap noUserRdr) + +-- | Convert an multiplicity annotation into its corresponding multiplicity. +-- If no annotation was written, `Nothing` is returned. +-- In this polymorphic function, `t` can be `HsType` or `HsExpr` +expandHsMultAnnOf :: (LocatedN Name -> t GhcRn) + -> HsMultAnnOf (LocatedA (t GhcRn)) GhcRn + -> Maybe (LocatedA (t GhcRn)) +expandHsMultAnnOf _mk_var HsUnannotated{} = Nothing +expandHsMultAnnOf mk_var (HsLinearAnn _) = Just (noLocA (mk_var (noLocA oneDataConName))) +expandHsMultAnnOf _mk_var (HsExplicitMult _ p) = Just p + instance (Outputable mult, OutputableBndrId pass) => - Outputable (HsArrowOf mult (GhcPass pass)) where + Outputable (HsMultAnnOf mult (GhcPass pass)) where ppr arr = parens (pprHsArrow arr) -- See #18846 -pprHsArrow :: (Outputable mult, OutputableBndrId pass) => HsArrowOf mult (GhcPass pass) -> SDoc -pprHsArrow (HsUnrestrictedArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left False) -pprHsArrow (HsLinearArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left True) -pprHsArrow (HsExplicitMult _ p) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p)) +pprHsArrow :: (Outputable mult, OutputableBndrId pass) => HsMultAnnOf mult (GhcPass pass) -> SDoc +pprHsArrow (HsUnannotated _) = pprArrowWithMultiplicity visArgTypeLike (Left False) +pprHsArrow (HsLinearAnn _) = pprArrowWithMultiplicity visArgTypeLike (Left True) +pprHsArrow (HsExplicitMult _ p) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p)) -type instance XConDeclField (GhcPass _) = TokDcolon -type instance XXConDeclField (GhcPass _) = DataConCantHappen +-- Used to print, for instance, let bindings: +-- let %1 x = … +-- and record field declarations: +-- { x %1 :: … } +pprHsMultAnn :: forall id. OutputableBndrId id => HsMultAnn (GhcPass id) -> SDoc +pprHsMultAnn (HsUnannotated _) = empty +pprHsMultAnn (HsLinearAnn _) = text "%1" +pprHsMultAnn (HsExplicitMult _ p) = text "%" <> ppr p +type instance XConDeclRecField (GhcPass _) = NoExtField +type instance XXConDeclRecField (GhcPass _) = DataConCantHappen + instance OutputableBndrId p - => Outputable (ConDeclField (GhcPass p)) where - ppr (ConDeclField _ fld_n fld_ty _) = ppr fld_n <+> dcolon <+> ppr fld_ty + => Outputable (HsConDeclRecField (GhcPass p)) where + ppr (HsConDeclRecField _ fld_n cfs) = pprMaybeWithDoc (cdf_doc cfs) (ppr_names fld_n <+> pprHsConDeclFieldWith ppr_mult cfs { cdf_doc = Nothing }) + where + ppr_names :: [LFieldOcc (GhcPass p)] -> SDoc + ppr_names [n] = pprPrefixOcc n + ppr_names ns = sep (punctuate comma (map pprPrefixOcc ns)) + ppr_mult :: HsMultAnn (GhcPass p) -> SDoc -> SDoc + ppr_mult mult tyDoc = pprHsMultAnn mult <+> dcolon <+> tyDoc + --------------------- hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name] -- Get the lexically-scoped type variables of an LHsSigWcType: @@ -623,6 +637,10 @@ hsLTyVarNames :: [LHsTyVarBndr flag (GhcPass p)] -> [IdP (GhcPass p)] hsLTyVarNames = mapMaybe hsLTyVarName +hsForAllTelescopeBndrs :: HsForAllTelescope (GhcPass p) -> [LHsTyVarBndr ForAllTyFlag (GhcPass p)] +hsForAllTelescopeBndrs (HsForAllVis _ bndrs) = map (fmap (setHsTyVarBndrFlag Required)) bndrs +hsForAllTelescopeBndrs (HsForAllInvis _ bndrs) = map (fmap (updateHsTyVarBndrFlag Invisible)) bndrs + hsForAllTelescopeNames :: HsForAllTelescope (GhcPass p) -> [IdP (GhcPass p)] hsForAllTelescopeNames (HsForAllVis _ bndrs) = hsLTyVarNames bndrs hsForAllTelescopeNames (HsForAllInvis _ bndrs) = hsLTyVarNames bndrs @@ -679,9 +697,9 @@ mkAnonWildCardTy :: EpToken "_" -> HsType GhcPs mkAnonWildCardTy tok = HsWildCardTy tok -mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN) +mkHsOpTy :: (Anno (IdOccGhcP p) ~ SrcSpanAnnN) => PromotionFlag - -> LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p)) + -> LHsType (GhcPass p) -> LocatedN (IdOccP (GhcPass p)) -> LHsType (GhcPass p) -> HsType (GhcPass p) mkHsOpTy prom ty1 op ty2 = HsOpTy noExtField prom ty1 op ty2 @@ -711,10 +729,10 @@ -- splitHsFunType (a -> (b -> c)) = ([a,b], c) -- It returns API Annotations for any parens removed splitHsFunType :: - LHsType (GhcPass p) + LHsType GhcPs -> ( ([EpToken "("], [EpToken ")"]) , EpAnnComments -- The locations of any parens and -- comments discarded - , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p)) + , [HsConDeclField GhcPs], LHsType GhcPs) splitHsFunType ty = go ty where go (L l (HsParTy (op,cp) ty)) @@ -725,7 +743,7 @@ go (L ll (HsFunTy _ mult x y)) | (anns, csy, args, res) <- splitHsFunType y - = (anns, csy S.<> epAnnComments ll, HsScaled mult x:args, res) + = (anns, csy S.<> epAnnComments ll, mkConDeclField mult x:args, res) go other = (noAnn, emptyComments, [], other) @@ -733,18 +751,18 @@ -- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more -- thorough. The purpose of this function is to examine instance heads, so it -- doesn't handle *all* cases (like lists, tuples, @(~)@, etc.). -hsTyGetAppHead_maybe :: (Anno (IdGhcP p) ~ SrcSpanAnnN) +hsTyGetAppHead_maybe :: (Anno (IdOccGhcP p) ~ SrcSpanAnnN) => LHsType (GhcPass p) - -> Maybe (LocatedN (IdP (GhcPass p))) + -> Maybe (LocatedN (IdOccP (GhcPass p))) hsTyGetAppHead_maybe = go where - go (L _ (HsTyVar _ _ ln)) = Just ln - go (L _ (HsAppTy _ l _)) = go l - go (L _ (HsAppKindTy _ t _)) = go t - go (L _ (HsOpTy _ _ _ ln _)) = Just ln - go (L _ (HsParTy _ t)) = go t - go (L _ (HsKindSig _ t _)) = go t - go _ = Nothing + go (L _ (HsTyVar _ _ ln)) = Just ln + go (L _ (HsAppTy _ l _)) = go l + go (L _ (HsAppKindTy _ t _)) = go t + go (L _ (HsOpTy _ _ _ ln _)) = Just ln + go (L _ (HsParTy _ t)) = go t + go (L _ (HsKindSig _ t _)) = go t + go _ = Nothing ------------------------------------------------------------ @@ -895,16 +913,29 @@ -- "GHC.Hs.Decls" for why this is important. splitLHsGadtTy :: LHsSigType GhcPs - -> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs), LHsType GhcPs) + -> (HsOuterSigTyVarBndrs GhcPs, [HsForAllTelescope GhcPs], Maybe (LHsContext GhcPs), LHsType GhcPs) splitLHsGadtTy (L _ sig_ty) - | (outer_bndrs, rho_ty) <- split_bndrs sig_ty - , (mb_ctxt, tau_ty) <- splitLHsQualTy_KP rho_ty - = (outer_bndrs, mb_ctxt, tau_ty) + | (outer_bndrs, sigma_ty) <- split_outer_bndrs sig_ty + , (inner_bndrs, phi_ty) <- split_inner_bndrs sigma_ty + , (mb_ctxt, rho_ty) <- splitLHsQualTy_KP phi_ty + = case rho_ty of + L _ (HsFunTy _ _ (L _ (XHsType HsRecTy{})) _) | not (null inner_bndrs) + -- Bad! Record GADTs are not allowed to have inner_bndrs, + -- undo the split to get a proper error message later + -> (outer_bndrs, [], Nothing, sigma_ty) + _ -> (outer_bndrs, inner_bndrs, mb_ctxt, rho_ty) where - split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs) - split_bndrs (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) = + split_outer_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs) + split_outer_bndrs (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) = (outer_bndrs, body_ty) + split_inner_bndrs :: LHsType GhcPs -> ([HsForAllTelescope GhcPs], LHsType GhcPs) + split_inner_bndrs (L _ HsForAllTy { hst_tele = tele + , hst_body = body }) + = let ~(teles, t) = split_inner_bndrs body + in (tele:teles, t) + split_inner_bndrs t = ([], t) + -- | Decompose a type of the form @forall . body@ into its constituent -- parts. Only splits type variable binders that -- were quantified invisibly (e.g., @forall a.@, with a dot). @@ -999,9 +1030,9 @@ -- | Decompose a type class instance type (of the form -- @forall . context => instance_head@) into the @instance_head@ and -- retrieve the underlying class type constructor (if it exists). -getLHsInstDeclClass_maybe :: (Anno (IdGhcP p) ~ SrcSpanAnnN) +getLHsInstDeclClass_maybe :: (Anno (IdOccGhcP p) ~ SrcSpanAnnN) => LHsSigType (GhcPass p) - -> Maybe (LocatedN (IdP (GhcPass p))) + -> Maybe (LocatedN (IdOccP (GhcPass p))) -- Works on (LHsSigType GhcPs) getLHsInstDeclClass_maybe inst_ty = do { let head_ty = getLHsInstDeclHead inst_ty @@ -1128,9 +1159,7 @@ type instance XCFieldOcc GhcRn = RdrName type instance XCFieldOcc GhcTc = RdrName -type instance XXFieldOcc GhcPs = DataConCantHappen -type instance XXFieldOcc GhcRn = DataConCantHappen -type instance XXFieldOcc GhcTc = DataConCantHappen +type instance XXFieldOcc (GhcPass p) = DataConCantHappen -------------------------------------------------------------------------------- @@ -1143,6 +1172,10 @@ GhcRn -> foExt fo GhcTc -> foExt fo +-- ToDo SPJ: remove +--fieldOccExt :: FieldOcc (GhcPass p) -> XCFieldOcc (GhcPass p) +--fieldOccExt (FieldOcc { foExt = ext }) = ext + fieldOccLRdrName :: forall p. IsPass p => FieldOcc (GhcPass p) -> LocatedN RdrName fieldOccLRdrName fo = case ghcPass @p of GhcPs -> foLabel fo @@ -1164,10 +1197,10 @@ -} -- | Name of an operator in an operator application or section -data OpName = NormalOp Name -- ^ A normal identifier - | NegateOp -- ^ Prefix negation - | UnboundOp RdrName -- ^ An unbound identifier - | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence +data OpName = NormalOp (WithUserRdr Name) -- ^ A normal identifier + | NegateOp -- ^ Prefix negation + | UnboundOp RdrName -- ^ An unbound identifier + | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence instance Outputable OpName where ppr (NormalOp n) = ppr n @@ -1209,6 +1242,15 @@ HsBndrRequired _ -> parens_if_kind bkind d HsBndrInvisible _ -> char '@' <> parens_if_kind bkind d +instance OutputableBndrFlag ForAllTyFlag p where + pprTyVarBndr (HsTvb _ spec bvar bkind) = + text "forall" <+> decorate (ppr_hs_tvb bvar bkind) + where decorate :: SDoc -> SDoc + decorate d = case spec of + Inferred -> braces d <> dot + Specified -> parens_if_kind bkind d <> dot + Required -> parens_if_kind bkind d <+> text "->" + ppr_hs_tvb :: OutputableBndrId p => HsBndrVar (GhcPass p) -> HsBndrKind (GhcPass p) -> SDoc ppr_hs_tvb bvar (HsBndrNoKind _) = ppr bvar ppr_hs_tvb bvar (HsBndrKind _ k) = hsep [ppr bvar, dcolon, ppr k] @@ -1277,13 +1319,31 @@ pprInfixOcc n = ppr n pprPrefixOcc n = ppr n -instance (Outputable tyarg, Outputable arg, Outputable rec) - => Outputable (HsConDetails tyarg arg rec) where - ppr (PrefixCon tyargs args) = text "PrefixCon:" <+> hsep (map (\t -> text "@" <> ppr t) tyargs) <+> ppr args - ppr (RecCon rec) = text "RecCon:" <+> ppr rec - ppr (InfixCon l r) = text "InfixCon:" <+> ppr [l, r] +instance (Outputable arg, Outputable rec) + => Outputable (HsConDetails arg rec) where + ppr (PrefixCon args) = text "PrefixCon:" <+> ppr args + ppr (RecCon rec) = text "RecCon:" <+> ppr rec + ppr (InfixCon l r) = text "InfixCon:" <+> ppr [l, r] -instance Outputable (XRec pass (IdP pass)) => Outputable (FieldOcc pass) where +pprHsConDeclFieldWith :: (OutputableBndrId p) + => (HsMultAnn (GhcPass p) -> SDoc -> SDoc) + -> HsConDeclField (GhcPass p) -> SDoc +pprHsConDeclFieldWith ppr_mult (CDF _ prag mark mult ty doc) = + pprMaybeWithDoc doc (ppr_mult mult (ppr prag <+> ppr mark <> ppr ty)) + +pprHsConDeclFieldNoMult :: (OutputableBndrId p) => HsConDeclField (GhcPass p) -> SDoc +pprHsConDeclFieldNoMult = pprHsConDeclFieldWith (\_ d -> d) + +hsPlainTypeField :: LHsType GhcPs -> HsConDeclField GhcPs +hsPlainTypeField = mkConDeclField (HsUnannotated (EpColon noAnn)) + +mkConDeclField :: HsMultAnn GhcPs -> LHsType GhcPs -> HsConDeclField GhcPs +mkConDeclField mult (L _ (HsDocTy _ ty lds)) = (mkConDeclField mult ty) { cdf_doc = Just lds } +mkConDeclField mult (L _ (XHsType (HsBangTy ann (HsSrcBang srcTxt unp str) t))) = CDF (ann, srcTxt) unp str mult t Nothing +mkConDeclField mult t = CDF noAnn NoSrcUnpack NoSrcStrict mult t Nothing + +instance Outputable (XRecGhc (IdGhcP p)) => + Outputable (FieldOcc (GhcPass p)) where ppr = ppr . foLabel instance (OutputableBndrId pass) => OutputableBndr (FieldOcc (GhcPass pass)) where @@ -1294,8 +1354,6 @@ pprInfixOcc = pprInfixOcc . unLoc pprPrefixOcc = pprPrefixOcc . unLoc - - ppr_tylit :: (HsTyLit (GhcPass p)) -> SDoc ppr_tylit (HsNumTy source i) = pprWithSourceText source (integer i) ppr_tylit (HsStrTy source s) = pprWithSourceText source (text (show s)) @@ -1318,7 +1376,7 @@ => HsOuterSigTyVarBndrs (GhcPass p) -> SDoc pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = - pprHsForAll (mkHsForAllInvisTele noAnn bndrs) Nothing + pprHsForAllTelescope (mkHsForAllInvisTele noAnn bndrs) -- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@ -- only when @-dppr-debug@ is enabled. @@ -1326,13 +1384,16 @@ => HsForAllTelescope (GhcPass p) -> Maybe (LHsContext (GhcPass p)) -> SDoc pprHsForAll tele cxt - = pp_tele tele <+> pprLHsContext cxt - where - pp_tele :: HsForAllTelescope (GhcPass p) -> SDoc - pp_tele tele = case tele of + = pprHsForAllTelescope tele <+> pprLHsContext cxt + +pprHsForAllTelescope :: forall p. OutputableBndrId p + => HsForAllTelescope (GhcPass p) + -> SDoc +pprHsForAllTelescope tele = + case tele of HsForAllVis { hsf_vis_bndrs = qtvs } -> pp_forall (space <> arrow) qtvs HsForAllInvis { hsf_invis_bndrs = qtvs } -> pp_forall dot qtvs - + where pp_forall :: forall flag p. (OutputableBndrId p, OutputableBndrFlag flag p) => SDoc -> [LHsTyVarBndr flag (GhcPass p)] -> SDoc pp_forall separator qtvs @@ -1356,17 +1417,9 @@ [L _ ty] -> ppr_mono_ty ty <+> darrow _ -> parens (interpp'SP ctxt) <+> darrow -pprConDeclFields :: forall p. OutputableBndrId p - => [LConDeclField (GhcPass p)] -> SDoc -pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields))) - where - ppr_fld (L _ (ConDeclField { cd_fld_names = ns, cd_fld_type = ty, - cd_fld_doc = doc })) - = pprMaybeWithDoc doc (ppr_names ns <+> dcolon <+> ppr ty) - - ppr_names :: forall p. OutputableBndrId p => [LFieldOcc (GhcPass p)] -> SDoc - ppr_names [n] = pprPrefixOcc n - ppr_names ns = sep (punctuate comma (map pprPrefixOcc ns)) +pprHsConDeclRecFields :: forall p. OutputableBndrId p + => [LHsConDeclRecField (GhcPass p)] -> SDoc +pprHsConDeclRecFields fields = braces (sep (punctuate comma (map ppr fields))) -- Printing works more-or-less as for Types @@ -1384,8 +1437,6 @@ ppr_mono_ty (HsQualTy { hst_ctxt = ctxt, hst_body = ty }) = sep [pprLHsContextAlways ctxt, ppr_mono_lty ty] -ppr_mono_ty (HsBangTy _ b ty) = ppr b <> ppr_mono_lty ty -ppr_mono_ty (HsRecTy _ flds) = pprConDeclFields flds ppr_mono_ty (HsTyVar _ prom (L _ name)) = pprOccWithTick Prefix prom name ppr_mono_ty (HsFunTy _ mult ty1 ty2) = ppr_fun_ty mult ty1 ty2 ppr_mono_ty (HsTupleTy _ con tys) @@ -1442,11 +1493,16 @@ ppr_mono_ty (HsDocTy _ ty doc) = pprWithDoc doc $ ppr_mono_lty ty -ppr_mono_ty (XHsType t) = ppr t +ppr_mono_ty (XHsType t) = case ghcPass @p of + GhcPs -> case t of + HsCoreTy ty -> ppr ty + HsBangTy _ b ty -> ppr b <> ppr_mono_lty ty + HsRecTy _ flds -> pprHsConDeclRecFields flds + GhcRn -> ppr t -------------------------- ppr_fun_ty :: (OutputableBndrId p) - => HsArrow (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc + => HsMultAnn (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -> SDoc ppr_fun_ty mult ty1 ty2 = let p1 = ppr_mono_lty ty1 p2 = ppr_mono_lty ty2 @@ -1461,13 +1517,11 @@ -------------------------- -- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses -- under precedence @p@. -hsTypeNeedsParens :: PprPrec -> HsType (GhcPass p) -> Bool +hsTypeNeedsParens :: forall p. IsPass p => PprPrec -> HsType (GhcPass p) -> Bool hsTypeNeedsParens p = go_hs_ty where go_hs_ty (HsForAllTy{}) = p >= funPrec go_hs_ty (HsQualTy{}) = p >= funPrec - go_hs_ty (HsBangTy{}) = p > topPrec - go_hs_ty (HsRecTy{}) = False go_hs_ty (HsTyVar{}) = False go_hs_ty (HsFunTy{}) = p >= funPrec -- Special-case unary boxed tuple applications so that they are @@ -1498,7 +1552,12 @@ go_hs_ty (HsOpTy{}) = p >= opPrec go_hs_ty (HsParTy{}) = False go_hs_ty (HsDocTy _ (L _ t) _) = go_hs_ty t - go_hs_ty (XHsType ty) = go_core_ty ty + go_hs_ty (XHsType t) = case ghcPass @p of + GhcPs -> case t of + HsCoreTy ty -> go_core_ty ty + HsBangTy{} -> p > topPrec + HsRecTy{} -> False + GhcRn -> go_core_ty t go_core_ty (TyVarTy{}) = False go_core_ty (AppTy{}) = p >= appPrec @@ -1530,8 +1589,6 @@ go (HsQualTy{ hst_ctxt = ctxt, hst_body = body}) | (L _ (c:_)) <- ctxt = goL c | otherwise = goL body - go (HsBangTy{}) = False - go (HsRecTy{}) = False go (HsTyVar _ p _) = isPromoted p go (HsFunTy _ _ arg _) = goL arg go (HsListTy{}) = False @@ -1555,7 +1612,7 @@ -- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is -- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply -- returns @ty@. -parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p) +parenthesizeHsType :: IsPass p => PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p) parenthesizeHsType p lty@(L loc ty) | hsTypeNeedsParens p ty = L loc (HsParTy noAnn lty) | otherwise = lty @@ -1564,8 +1621,7 @@ -- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@ -- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply -- returns @ctxt@ unchanged. -parenthesizeHsContext :: PprPrec - -> LHsContext (GhcPass p) -> LHsContext (GhcPass p) +parenthesizeHsContext :: IsPass p => PprPrec -> LHsContext (GhcPass p) -> LHsContext (GhcPass p) parenthesizeHsContext p lctxt@(L loc ctxt) = case ctxt of [c] -> L loc [parenthesizeHsType p c] @@ -1579,7 +1635,6 @@ ************************************************************************ -} -type instance Anno (BangType (GhcPass p)) = SrcSpanAnnA type instance Anno [LocatedA (HsType (GhcPass p))] = SrcSpanAnnC type instance Anno (HsType (GhcPass p)) = SrcSpanAnnA type instance Anno (HsSigType (GhcPass p)) = SrcSpanAnnA @@ -1593,6 +1648,6 @@ type instance Anno (HsOuterTyVarBndrs _ (GhcPass _)) = SrcSpanAnnA type instance Anno HsIPName = EpAnnCO -type instance Anno (ConDeclField (GhcPass p)) = SrcSpanAnnA +type instance Anno (HsConDeclRecField (GhcPass p)) = SrcSpanAnnA type instance Anno (FieldOcc (GhcPass p)) = SrcSpanAnnA diff --git a/GHC/Hs/Utils.hs b/GHC/Hs/Utils.hs --- a/GHC/Hs/Utils.hs +++ b/GHC/Hs/Utils.hs @@ -53,13 +53,15 @@ mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap, mkHsCmdIf, mkConLikeTc, - nlHsTyApp, nlHsTyApps, nlHsVar, nl_HsVar, nlHsDataCon, + nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon, nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps, nlHsIntLit, nlHsVarApps, nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList, mkLHsTupleExpr, mkLHsVarTuple, missingTupArg, mkLocatedList, nlAscribe, + forgetUserRdr, noUserRdr, + -- * Bindings mkFunBind, mkVarBind, mkHsVarBind, mkSimpleGeneratedFunBind, mkTopFunBind, mkPatSynBind, @@ -135,7 +137,7 @@ import GHC.Core.Make ( mkChunkified ) import GHC.Core.Type ( Type, isUnliftedType ) -import GHC.Builtin.Types ( unitTy ) +import GHC.Builtin.Types ( unitTy, manyDataConTy ) import GHC.Types.Id import GHC.Types.Name @@ -157,7 +159,7 @@ import Control.Arrow ( first ) import Data.Foldable ( toList ) import Data.List ( partition ) -import Data.List.NonEmpty ( nonEmpty ) +import Data.List.NonEmpty ( NonEmpty (..), nonEmpty ) import qualified Data.List.NonEmpty as NE import Data.IntMap ( IntMap ) @@ -207,8 +209,8 @@ unguardedRHS :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns => EpAnn GrhsAnn -> SrcSpan -> LocatedA (body (GhcPass p)) - -> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))] -unguardedRHS an loc rhs = [L (noAnnSrcSpan loc) (GRHS an [] rhs)] + -> NonEmpty (LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))) +unguardedRHS an loc rhs = NE.singleton $ L (noAnnSrcSpan loc) (GRHS an [] rhs) type AnnoBody p body = ( XMG (GhcPass p) (LocatedA (body (GhcPass p))) ~ Origin @@ -287,8 +289,7 @@ mkHsSyntaxApps ann (SyntaxExprTc { syn_expr = fun , syn_arg_wraps = arg_wraps , syn_res_wrap = res_wrap }) args - = mkLHsWrap res_wrap (foldl' mkHsApp (L ann fun) (zipWithEqual "mkHsSyntaxApps" - mkLHsWrap arg_wraps args)) + = mkLHsWrap res_wrap (foldl' mkHsApp (L ann fun) (zipWithEqual mkLHsWrap arg_wraps args)) mkHsSyntaxApps _ NoSyntaxExprTc args = pprPanic "mkHsSyntaxApps" (ppr args) -- this function should never be called in scenarios where there is no -- syntax expr @@ -306,7 +307,7 @@ nlHsTyApp :: Id -> [Type] -> LHsExpr GhcTc nlHsTyApp fun_id tys - = noLocA (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLocA fun_id))) + = noLocA (mkHsWrap (mkWpTyApps tys) (mkHsVar (noLocA fun_id))) nlHsTyApps :: Id -> [Type] -> [LHsExpr GhcTc] -> LHsExpr GhcTc nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs @@ -475,7 +476,7 @@ -- | A useful function for building @OpApps@. The operator is always a -- variable, and we don't know the fixity yet. mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs -mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLocA (HsVar noExtField (noLocA op))) e2 +mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLocA (mkHsVar (noLocA op))) e2 mkHsString :: String -> HsLit (GhcPass p) mkHsString s = HsString NoSourceText (mkFastString s) @@ -502,11 +503,7 @@ nlHsVar :: IsSrcSpanAnn p a => IdP (GhcPass p) -> LHsExpr (GhcPass p) -nlHsVar n = noLocA (HsVar noExtField (noLocA n)) - -nl_HsVar :: IsSrcSpanAnn p a - => IdP (GhcPass p) -> HsExpr (GhcPass p) -nl_HsVar n = HsVar noExtField (noLocA n) +nlHsVar n = noLocA (mkHsVar (noLocA n)) -- | NB: Only for 'LHsExpr' 'Id'. nlHsDataCon :: DataCon -> LHsExpr GhcTc @@ -538,8 +535,8 @@ nlHsVarApps :: IsSrcSpanAnn p a => IdP (GhcPass p) -> [IdP (GhcPass p)] -> LHsExpr (GhcPass p) -nlHsVarApps f xs = noLocA (foldl' mk (HsVar noExtField (noLocA f)) - (map ((HsVar noExtField) . noLocA) xs)) +nlHsVarApps f xs = noLocA (foldl' mk (mkHsVar (noLocA f)) + (map (mkHsVar . noLocA) xs)) where mk f a = HsApp noExtField (noLocA f) (noLocA a) @@ -561,28 +558,28 @@ nlConPat con pats = noLocA $ ConPat { pat_con_ext = noAnn , pat_con = noLocA con - , pat_args = PrefixCon [] (map (parenthesizePat appPrec) pats) + , pat_args = PrefixCon (map (parenthesizePat appPrec) pats) } nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn nlConPatName con pats = noLocA $ ConPat { pat_con_ext = noExtField - , pat_con = noLocA con - , pat_args = PrefixCon [] (map (parenthesizePat appPrec) pats) + , pat_con = noLocA (noUserRdr con) + , pat_args = PrefixCon (map (parenthesizePat appPrec) pats) } nlNullaryConPat :: RdrName -> LPat GhcPs nlNullaryConPat con = noLocA $ ConPat { pat_con_ext = noAnn , pat_con = noLocA con - , pat_args = PrefixCon [] [] + , pat_args = PrefixCon [] } nlWildConPat :: DataCon -> LPat GhcPs nlWildConPat con = noLocA $ ConPat { pat_con_ext = noAnn , pat_con = noLocA $ getRdrName con - , pat_args = PrefixCon [] $ + , pat_args = PrefixCon $ replicate (dataConSourceArity con) nlWildPat } @@ -608,7 +605,6 @@ -> LHsExpr GhcPs nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs --- AZ:Is this used? nlHsLam match = noLocA $ HsLam noAnn LamSingle $ mkMatchGroup (Generated OtherExpansion SkipPmc) (noLocA [match]) @@ -624,32 +620,32 @@ nlList exprs = noLocA (ExplicitList noAnn exprs) nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) -nlHsTyVar :: IsSrcSpanAnn p a +nlHsTyVar :: forall p a. IsSrcSpanAnn p a => PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p) nlHsFunTy :: forall p. IsPass p => LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsAppTy f t = noLocA (HsAppTy noExtField f t) -nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA x)) -nlHsFunTy a b = noLocA (HsFunTy noExtField (HsUnrestrictedArrow x) a b) +nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA $ noUserRdrP @p x)) +nlHsFunTy a b = noLocA (HsFunTy noExtField (HsUnannotated x) a b) where x = case ghcPass @p of - GhcPs -> noAnn + GhcPs -> EpArrow noAnn GhcRn -> noExtField - GhcTc -> noExtField + GhcTc -> manyDataConTy nlHsParTy t = noLocA (HsParTy noAnn t) nlHsTyConApp :: forall p a. IsSrcSpanAnn p a => PromotionFlag - -> LexicalFixity -> IdP (GhcPass p) + -> LexicalFixity -> IdOccP (GhcPass p) -> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p) nlHsTyConApp prom fixity tycon tys | Infix <- fixity , HsValArg _ ty1 : HsValArg _ ty2 : rest <- tys = foldl' mk_app (noLocA $ HsOpTy noExtField prom ty1 (noLocA tycon) ty2) rest | otherwise - = foldl' mk_app (nlHsTyVar prom tycon) tys + = foldl' mk_app (nlHsTyVar prom $ forgetUserRdr @p tycon) tys where mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p) mk_app fun@(L _ (HsOpTy {})) arg = mk_app (nlHsParTy fun) arg @@ -658,6 +654,22 @@ mk_app fun (HsTypeArg _ ki) = nlHsAppKindTy fun ki mk_app fun (HsArgPar _) = nlHsParTy fun +-- | Turn an 'IdP' into an 'IdOccP', with no user-written 'RdrName' information. +noUserRdrP :: forall p. IsPass p => IdP (GhcPass p) -> IdOccP (GhcPass p) +noUserRdrP = + case ghcPass @p of + GhcPs -> id + GhcRn -> noUserRdr + GhcTc -> id + +-- | Turn an 'IdOccP' into an 'IdP', discarding the user-written 'RdrName'. +forgetUserRdr :: forall p. IsPass p => IdOccP (GhcPass p) -> IdP (GhcPass p) +forgetUserRdr = + case ghcPass @p of + GhcPs -> id + GhcRn -> \ (WithUserRdr _rdr n) -> n + GhcTc -> id + nlHsAppKindTy :: forall p. IsPass p => LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p) nlHsAppKindTy f k = noLocA (HsAppKindTy x f k) @@ -868,9 +880,9 @@ -- |If any of the matches in the 'FunBind' are infix, the 'FunBind' is -- considered infix. -isInfixFunBind :: forall id1 id2. UnXRec id2 => HsBindLR id1 id2 -> Bool +isInfixFunBind :: HsBindLR (GhcPass p1) (GhcPass p2) -> Bool isInfixFunBind (FunBind { fun_matches = MG _ matches }) - = any (isInfixMatch . unXRec @id2) (unXRec @id2 matches) + = any (isInfixMatch . unLoc) (unLoc matches) isInfixFunBind _ = False -- |Return the 'SrcSpan' encompassing the contents of any enclosed binds @@ -1190,7 +1202,7 @@ LetStmt _ binds -> collectLocalBinders flag binds BodyStmt {} -> [] LastStmt {} -> [] - ParStmt _ xs _ _ -> collectLStmtsBinders flag [s | ParStmtBlock _ ss _ _ <- xs, s <- ss] + ParStmt _ xs _ _ -> collectLStmtsBinders flag [s | ParStmtBlock _ ss _ _ <- toList xs, s <- ss] TransStmt { trS_stmts = stmts } -> collectLStmtsBinders flag stmts RecStmt { recS_stmts = L _ ss } -> collectLStmtsBinders flag ss XStmtLR x -> case ghcPass :: GhcPass idR of @@ -1288,15 +1300,11 @@ CollWithDictBinders -> foldr (collect_lpat flag) bndrs (hsConPatArgs ps) ++ collectEvBinders (cpt_binds (pat_con_ext pat)) CollVarTyVarBinders -> foldr (collect_lpat flag) bndrs (hsConPatArgs ps) - ++ concatMap collectConPatTyArgBndrs (hsConPatTyArgs ps) collectEvBinders :: TcEvBinds -> [Id] collectEvBinders (EvBinds bs) = foldr add_ev_bndr [] bs collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders" -collectConPatTyArgBndrs :: HsConPatTyArg GhcRn -> [Name] -collectConPatTyArgBndrs (HsConPatTyArg _ tp) = collectTyPatBndrs tp - collect_ty_pat_bndrs :: CollectFlag p -> HsTyPat (NoGhcTc p) -> [IdP p] -> [IdP p] collect_ty_pat_bndrs CollNoDictBinders _ bndrs = bndrs collect_ty_pat_bndrs CollWithDictBinders _ bndrs = bndrs @@ -1342,7 +1350,6 @@ GhcTc -> case ext of AbsBinds { abs_exports = dbinds } -> (map abe_poly dbinds ++) -- I don't think we want the binders from the abe_binds - -- binding (hence see AbsBinds) is in zonking in GHC.Tc.Zonk.Type collectXSplicePat flag ext = @@ -1647,7 +1654,7 @@ get_flds_h98 :: FieldIndices p -> HsConDeclH98Details (GhcPass p) -> (Maybe [Located Int], FieldIndices p) get_flds_h98 seen (RecCon flds) = first Just $ get_flds seen flds - get_flds_h98 seen (PrefixCon _ []) = (Just [], seen) + get_flds_h98 seen (PrefixCon []) = (Just [], seen) get_flds_h98 seen _ = (Nothing, seen) get_flds_gadt :: FieldIndices p -> HsConDeclGADTDetails (GhcPass p) @@ -1656,7 +1663,7 @@ get_flds_gadt seen (PrefixConGADT _ []) = (Just [], seen) get_flds_gadt seen _ = (Nothing, seen) - get_flds :: FieldIndices p -> LocatedL [LConDeclField (GhcPass p)] + get_flds :: FieldIndices p -> LocatedL [LHsConDeclRecField (GhcPass p)] -> ([Located Int], FieldIndices p) get_flds seen flds = foldr add_fld ([], seen) fld_names @@ -1664,7 +1671,7 @@ add_fld fld (is, ixs) = let (i, ixs') = insertField fld ixs in (i:is, ixs') - fld_names = concatMap (cd_fld_names . unLoc) (unLoc flds) + fld_names = concatMap (cdrf_names . unLoc) (unLoc flds) -- | A bijection between record fields of a datatype and integers, -- used to implement Note [Collecting record fields in data declarations]. @@ -1792,7 +1799,7 @@ hs_stmt (LetStmt _ binds) = hs_local_binds binds hs_stmt (BodyStmt {}) = [] hs_stmt (LastStmt {}) = [] - hs_stmt (ParStmt _ xs _ _) = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs , s <- ss] + hs_stmt (ParStmt _ xs _ _) = hs_lstmts [s | ParStmtBlock _ ss _ _ <- toList xs , s <- ss] hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts hs_stmt (RecStmt { recS_stmts = L _ ss }) = hs_lstmts ss @@ -1844,7 +1851,7 @@ hs_pat _ = [] details :: HsConPatDetails GhcRn -> [(SrcSpan, [ImplicitFieldBinders])] - details (PrefixCon _ ps) = hs_lpats ps + details (PrefixCon ps) = hs_lpats ps details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds })) = hs_lpats $ map (hfbRHS . unLoc) rec_flds details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds })) @@ -1871,5 +1878,5 @@ where (explicit_binds, implicit_binds) = splitAt unRecFieldsDotDot rec_flds implicit_field_binders (L _ (HsFieldBind { hfbLHS = L _ fld, hfbRHS = rhs })) = ImplicitFieldBinders - { implFlBndr_field = unLoc $ foLabel fld + { implFlBndr_field = unLoc $ foLabel (fld :: FieldOcc GhcRn) , implFlBndr_binders = collectPatBinders CollNoDictBinders rhs } diff --git a/GHC/HsToCore.hs b/GHC/HsToCore.hs --- a/GHC/HsToCore.hs +++ b/GHC/HsToCore.hs @@ -22,14 +22,12 @@ import GHC.Driver.Config import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO ) import GHC.Driver.Config.HsToCore.Ticks -import GHC.Driver.Config.HsToCore.Usage import GHC.Driver.Env import GHC.Driver.Backend import GHC.Driver.Plugins import GHC.Hs -import GHC.HsToCore.Usage import GHC.HsToCore.Monad import GHC.HsToCore.Errors.Types import GHC.HsToCore.Expr @@ -41,8 +39,8 @@ import GHC.HsToCore.Docs import GHC.Tc.Types -import GHC.Tc.Types.Origin ( Position(..) ) -import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceLoad ) +import GHC.Tc.Types.Origin ( Position(..), mkArgPos ) +import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances ) import GHC.Tc.Module ( runTcInteractive ) import GHC.Core.Type @@ -54,6 +52,7 @@ import GHC.Core.Utils import GHC.Core.Unfold.Make import GHC.Core.Coercion +import GHC.Core.Predicate( scopedSort, mkNomEqPred ) import GHC.Core.DataCon ( dataConWrapId ) import GHC.Core.Make import GHC.Core.Rules @@ -70,7 +69,7 @@ import GHC.Utils.Error import GHC.Utils.Outputable -import GHC.Utils.Panic.Plain +import GHC.Utils.Panic import GHC.Utils.Misc import GHC.Utils.Monad import GHC.Utils.Logger @@ -98,7 +97,8 @@ import Data.List (partition) import Data.IORef -import Data.Traversable (for) +import GHC.Iface.Make (mkRecompUsageInfo) +import GHC.Runtime.Interpreter (interpreterProfiled) {- ************************************************************************ @@ -121,17 +121,14 @@ tcg_imports = imports, tcg_exports = exports, tcg_keep = keep_var, - tcg_th_splice_used = tc_splice_used, tcg_rdr_env = rdr_env, tcg_fix_env = fix_env, tcg_inst_env = inst_env, tcg_fam_inst_env = fam_inst_env, - tcg_merged = merged, tcg_warns = warns, tcg_anns = anns, tcg_binds = binds, tcg_imp_specs = imp_specs, - tcg_dependent_files = dependent_files, tcg_ev_binds = ev_binds, tcg_th_foreign_files = th_foreign_files_var, tcg_fords = fords, @@ -141,7 +138,6 @@ tcg_default_exports = defaults, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_hpc = other_hpc_info, tcg_complete_matches = complete_matches, tcg_self_boot = self_boot }) @@ -166,13 +162,12 @@ mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) @@ -182,7 +177,7 @@ then writeMixEntries (hpcDir dflags) mod ticks orig_file2 else return 0 -- dummy hash when none are written pure $ HpcInfo (fromIntegral $ sizeSS ticks) hashNo - _ -> pure $ emptyHpcInfo other_hpc_info + _ -> pure $ emptyHpcInfo ; (msgs, mb_res) <- initDs hsc_env tcg_env $ do { dsEvBinds ev_binds $ \ ds_ev_binds -> do @@ -227,26 +222,17 @@ ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps - ; let used_names = mkUsedNames tcg_env - pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) + ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) home_unit = hsc_home_unit hsc_env ; let deps = mkDependencies home_unit (tcg_mod tcg_env) (tcg_imports tcg_env) (map mi_module pluginModules) - ; used_th <- readIORef tc_splice_used - ; dep_files <- readIORef dependent_files ; safe_mode <- finalSafeMode dflags tcg_env - ; (needed_mods, needed_pkgs) <- readIORef (tcg_th_needed_deps tcg_env) - ; let uc = initUsageConfig hsc_env - ; let plugins = hsc_plugins hsc_env - ; let fc = hsc_FC hsc_env - ; let unit_env = hsc_unit_env hsc_env - ; usages <- initIfaceLoad hsc_env $ - mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names - dep_files merged needed_mods needed_pkgs + ; usages <- mkRecompUsageInfo hsc_env tcg_env + -- id_mod /= mod when we are processing an hsig, but hsigs -- never desugared and compiled (there's no code!) -- Consequently, this should hold for any ModGuts that make @@ -264,7 +250,6 @@ mg_exports = exports, mg_usages = usages, mg_deps = deps, - mg_used_th = used_th, mg_rdr_env = rdr_env, mg_fix_env = fix_env, mg_warns = warns, @@ -291,12 +276,6 @@ ; return (msgs, Just mod_guts) }}}} -dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList (Id,CoreExpr), [CoreRule]) -dsImpSpecs imp_specs - = do { spec_prs <- mapMaybeM (dsSpec Nothing) imp_specs - ; let (spec_binds, spec_rules) = unzip spec_prs - ; return (concatOL spec_binds, spec_rules) } - combineEvBinds :: [CoreBind] -> [(Id,CoreExpr)] -> [CoreBind] -- Top-level bindings can include coercion bindings, but not via superclasses -- See Note [Top-level evidence] @@ -335,7 +314,7 @@ -- mb_result is Nothing only when a failure happens in the type-checker, -- but mb_core_expr is Nothing when a failure happens in the desugarer - let (ds_msgs, mb_core_expr) = expectJust "deSugarExpr" mb_result + let (ds_msgs, mb_core_expr) = expectJust mb_result case mb_core_expr of Nothing -> return () @@ -441,14 +420,18 @@ dsRule :: LRuleDecl GhcTc -> DsM (Maybe CoreRule) dsRule (L loc (HsRule { rd_name = name , rd_act = rule_act - , rd_tmvs = vars + , rd_bndrs = RuleBndrs { rb_ext = bndrs } , rd_lhs = lhs , rd_rhs = rhs })) = putSrcSpanDs (locA loc) $ - do { let bndrs' = [var | L _ (RuleBndr _ (L _ var)) <- vars] + do { let bndrs' = scopedSort bndrs + -- The scopedSort is because the binders may not + -- be in dependency order; see wrinkle (FTV1) in + -- Note [Free tyvars on rule LHS] in GHC.Tc.Zonk.Type ; lhs' <- unsetGOptM Opt_EnableRewriteRules $ - unsetWOptM Opt_WarnIdentities $ + unsetWOptM Opt_WarnIdentities $ + zapUnspecables $ dsLExpr lhs -- Note [Desugaring RULE left hand sides] ; rhs' <- dsLExpr rhs @@ -549,6 +532,9 @@ the rule is precisely to optimise them: {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-} +Finally, the `zapUnspecables` is to implement (NC1) of +Note [Desugaring non-canonical evidence] in GHC.HsToCore.Expr + Note [Desugaring coerce as cast] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We want the user to express a rule saying roughly “mapping a coercion over a @@ -762,7 +748,7 @@ unsafe_equality k a b = ( mkTyApps (Var unsafe_equality_proof_id) [k,b,a] , mkTyConApp unsafe_equality_tc [k,b,a] - , mkNomPrimEqPred k a b + , mkNomEqPred a b ) -- NB: UnsafeRefl :: (b ~# a) -> UnsafeEquality a b, so we have to -- carefully swap the arguments above @@ -794,7 +780,7 @@ arity = 1 concs = mkRepPolyIdConcreteTyVars - [((mkTyVarTy openAlphaTyVar, Argument 1 Top), runtimeRep1TyVar)] + [((mkTyVarTy openAlphaTyVar, mkArgPos 1 Top), runtimeRep1TyVar)] unsafeCoercePrimName id = mkExportedLocalId (RepPolyId concs) unsafeCoercePrimName ty `setIdInfo` info diff --git a/GHC/HsToCore/Arrows.hs b/GHC/HsToCore/Arrows.hs --- a/GHC/HsToCore/Arrows.hs +++ b/GHC/HsToCore/Arrows.hs @@ -530,7 +530,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdLam _ LamSingle (MG { mg_alts = (L _ [L _ (Match { m_pats = L _ pats - , m_grhss = GRHSs _ [L _ (GRHS _ [] body)] _ })]) })) + , m_grhss = GRHSs _ (L _ (GRHS _ [] body) :| _) _ })]) })) env_ids = dsCmdLam ids local_vars stack_ty res_ty pats body env_ids @@ -1215,7 +1215,7 @@ [(body, mkVarSet (collectLStmtsBinders CollWithDictBinders stmts) `unionVarSet` defined_vars) - | L _ (GRHS _ stmts body) <- grhss] + | L _ (GRHS _ stmts body) <- toList grhss] -- Replace the leaf commands in a match diff --git a/GHC/HsToCore/Binds.hs b/GHC/HsToCore/Binds.hs --- a/GHC/HsToCore/Binds.hs +++ b/GHC/HsToCore/Binds.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeFamilies #-} {- @@ -15,7 +16,8 @@ -} module GHC.HsToCore.Binds - ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec + ( dsTopLHsBinds, dsLHsBinds + , dsImpSpecs, decomposeRuleLhs , dsHsWrapper, dsHsWrappers , dsEvTerm, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds , dsWarnOrphanRule @@ -42,7 +44,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things -import GHC.Core.SimpleOpt ( simpleOptExpr ) +import GHC.Core.SimpleOpt import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Core.InstEnv ( CanonicalEvidence(..) ) import GHC.Core.Make @@ -55,6 +57,7 @@ import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.Rules +import GHC.Core.Ppr( pprCoreBinders ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Builtin.Names @@ -63,11 +66,11 @@ import GHC.Tc.Types.Evidence import GHC.Types.Id -import GHC.Types.Id.Make ( nospecId ) +import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Var( EvVar ) +import GHC.Types.Var( EvVar, mkLocalVar ) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Unique.Set( nonDetEltsUniqSet ) @@ -76,7 +79,6 @@ import GHC.Data.OrdList import GHC.Data.Graph.Directed import GHC.Data.Bag -import qualified Data.Set as S import GHC.Utils.Constants (debugIsOn) import GHC.Utils.Misc @@ -86,6 +88,7 @@ import Control.Monad + {-********************************************************************** * * Desugaring a MonoBinds @@ -204,33 +207,25 @@ , fun_matches = matches , fun_ext = (co_fn, tick) }) - = do { dsHsWrapper co_fn $ \core_wrap -> do - { (args, body) <- addTyCs FromSource (hsWrapDictBinders co_fn) $ - -- FromSource might not be accurate (we don't have any - -- origin annotations for things in this module), but at - -- worst we do superfluous calls to the pattern match - -- oracle. - -- addTyCs: Add type evidence to the refinement type - -- predicate of the coverage checker - -- See Note [Long-distance information] in "GHC.HsToCore.Pmc" - matchWrapper (mkPrefixFunRhs (L loc (idName fun)) noAnn) Nothing matches + = dsHsWrapper co_fn $ \core_wrap -> + do { (args, body) <- matchWrapper (mkPrefixFunRhs (L loc (idName fun)) noAnn) Nothing matches - ; let body' = mkOptTickBox tick body - rhs = core_wrap (mkLams args body') - core_binds@(id,_) = makeCorePair dflags fun False 0 rhs - force_var - -- Bindings are strict when -XStrict is enabled - | xopt LangExt.Strict dflags - , matchGroupArity matches == 0 -- no need to force lambdas - = [id] - | isBangedHsBind b - = [id] - | otherwise - = [] - ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun) - -- , ppr (mg_alts matches) - -- , ppr args, ppr core_binds, ppr body']) $ - return (force_var, [core_binds]) } } + ; let body' = mkOptTickBox tick body + rhs = core_wrap (mkLams args body') + core_binds@(id,_) = makeCorePair dflags fun False 0 rhs + force_var + -- Bindings are strict when -XStrict is enabled + | xopt LangExt.Strict dflags + , matchGroupArity matches == 0 -- no need to force lambdas + = [id] + | isBangedHsBind b + = [id] + | otherwise + = [] + ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun) + -- , ppr (mg_alts matches) + -- , ppr args, ppr core_binds, ppr body']) $ + return (force_var, [core_binds]) } dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = (ty, (rhs_tick, var_ticks)) @@ -253,15 +248,15 @@ , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig })) - = dsTcEvBinds_s ev_binds $ \ds_ev_binds -> do - { ds_binds <- addTyCs FromSource (listToBag dicts) $ - dsLHsBinds binds + = addTyCs FromSource (listToBag dicts) $ -- addTyCs: push type constraints deeper -- for inner pattern match check -- See Check, Note [Long-distance information] - - -- dsAbsBinds does the hard work - ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds (isSingleton binds) has_sig } + dsTcEvBinds_s ev_binds $ \ds_ev_binds -> do + do { ds_binds <- dsLHsBinds binds + -- dsAbsBinds does the hard work + ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds + (isSingleton binds) has_sig } dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" @@ -795,6 +790,122 @@ 4. Unlifted binds may not be recursive. Checked in second clause of ds_val_bind. +Note [Desugaring new-form SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +"New-form" SPECIALISE pragmas generate a SpecPragE record in the typechecker, +which is desugared in this module by `dsSpec`. For the context see +Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig + +Suppose we have + f :: forall a b c d. (Ord a, Ord b, Eq c, Ix d) => ... + f = rhs + {-# SPECIALISE f @p @[p] @[Int] @(q,r) #-} + +The type-checker generates `the_call` which looks like + + spe_bndrs = (dx1 :: Ord p) (dx2::Ix q) (dx3::Ix r) + the_call = let d6 = dx1 + d2 = $fOrdList d6 + d3 = $fEqList $fEqInt + d7 = dx1 -- Solver may introduce + d1 = d7 -- these indirections + d4 = $fIxPair dx2 dx3 + in f @p @p @[Int] @(q,r) + (d1::Ord p) (d2::Ord [p]) (d3::Eq [Int]) (d4::Ix (q,r) + +We /could/ generate + RULE f d1 d2 d3 d4 e1..en = $sf d1 d2 d3 d4 + $sf d1 d2 d3 d4 = d1 d2 d3 d4 + +But that would do no specialisation at all! What we want is this: + RULE f d1 _d2 _d3 d4 e1..en = $sf d1 d4 + $sf d1 d4 = let d7 = d1 -- Renaming + dx1 = d1 -- Renaming + d6 = d1 -- Renaming + d2 = $fOrdList d6 + d3 = $fEqList $fEqInt + in rhs d1 d2 d3 d4 + +Notice that: + * We pass some, but not all, of the matched dictionaries to $sf + + * We get specialisations for d2 and d3, but not for d1, nor d4. + + * We had to introduce some renaming bindings at the top + to line things up + +The transformation goes in these steps + +(S1) decomposeCall: decompose `the_call` into + - `binds`: the enclosing let-bindings + - `rule_lhs_args`: the arguments of the call itself + + If the expression in the SPECIALISE pragma had a type signature, such as + SPECIALISE g :: Eq b => Int -> b -> b + then the desugared expression may have type abstractions and applications + "in the way", like this: + (/\b. (\d:Eq b). let d1 = $dfOrdInt in f @Int @b d1 d) @b (d2:Eq b) + The lambdas come from the type signature, which is then re-instantiated, + hence the applications of those lambdas. + + To handle these, `decomposeCall` uses the simple optimiser to simplify + this to + let { d = d2; d1 = $dfOrdInt } in f @Int @b d1 d + + Wrinkle (S1a): do no inlining in this "simple optimiser" phase: + use `simpleOptExprNoInline`. E.g. we don't want to turn it into + f @Int @b $dfOrdInt d2 + because the latter is harder to match. Similarly if we have + let { d1=d; d2=d } in f d1 d2 + we don't want to inline d1/d2 to get this + f d d + + TL;DR: as a result the dictionary arguments of the actual call, + `rule_lhs_args` are all distinct dictionary variables, not + expressions. + +(S2) Compute `rule_bndrs`: the free vars of `rule_lhs_args`, which + will be the forall'd template variables of the RULE. In the example, + rule_bndrs = d1,d2,d3,d4 + These variables will get values from a successful RULE match. + +(S3) `getRenamings`: starting from the rule_bndrs, make bindings for + all other variables that are equal to them. In the example, we + make renaming-bindings for d7, dx1, d6. Our goal is to bind + as many variables as possible, by deducing them from `rule_bndrs`. + If we have the binding + d1 = d7 (where `d1` is a rule_bndr) + we want to generate the renaming + d7 = d1 + which instead deduces d7 from d1 + + NB1: we don't actually have to remove the original bindings; + it's harmless to leave them + NB2: We also reverse bindings like d1 = d2 |> co, to get + d2 = d1 |> sym co + It's easy and slightly improves our ability to get bindings + for local variables from `rule_bndrs`. I'm not sure if it + matters in practice, but it's easy to do. + NB3: `getRenamings` works innermost first, so that we get transitivity. + E.g in our example we have + d7 = dx1 + d1 = d7 where d1 is rule_bndr + `getRenamings` generate the renamings + dx1 = d1 + d7 = d2 + +(S4) `pickSpecBinds`: pick the bindings we want to keep in the + specialised function. We start from `known_vars`, the variables we + know, namely the `rule_bndrs` and the binders from (S3), which are + all equal to one of the `rule_bndrs`. + + Then we keep a binding if the free vars of its RHS are all known. + In our example, `d2` and `d3` are both picked, but `d4` is not. + The non-picked ones won't end up being specialised. + +(S5) Finally, work out which of the `rule_bndrs` we must pass on to + specialised function. We just filter out ones bound by a renaming + or a picked binding. -} ------------------------ @@ -802,121 +913,299 @@ -> TcSpecPrags -> DsM ( OrdList (Id,CoreExpr) -- Binding for specialised Ids , [CoreRule] ) -- Rules for the Global Ids --- See Note [Handling SPECIALISE pragmas] in GHC.Tc.Gen.Bind +-- See Note [Overview of SPECIALISE pragmas] in GHC.Tc.Gen.Sig dsSpecs _ IsDefaultMethod = return (nilOL, []) dsSpecs poly_rhs (SpecPrags sps) - = do { pairs <- mapMaybeM (dsSpec (Just poly_rhs)) sps + = do { pairs <- mapMaybeM (dsLSpec poly_rhs) sps ; let (spec_binds_s, rules) = unzip pairs ; return (concatOL spec_binds_s, rules) } -dsSpec :: Maybe CoreExpr -- Just rhs => RULE is for a local binding - -- Nothing => RULE is for an imported Id - -- rhs is in the Id's unfolding - -> Located TcSpecPrag - -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) -dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) - | isJust (isClassOpId_maybe poly_id) - = putSrcSpanDs loc $ - do { diagnosticDs (DsUselessSpecialiseForClassMethodSelector poly_id) - ; return Nothing } -- There is no point in trying to specialise a class op - -- Moreover, classops don't (currently) have an inl_sat arity set - -- (it would be Just 0) and that in turn makes makeCorePair bleat +dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList (Id,CoreExpr), [CoreRule]) +dsImpSpecs imp_specs + = do { spec_prs <- mapMaybeM spec_one imp_specs + ; let (spec_binds, spec_rules) = unzip spec_prs + ; return (concatOL spec_binds, spec_rules) } + where + spec_one (L loc prag) = putSrcSpanDs loc $ + dsSpec (get_rhs prag) prag - | no_act_spec && isNeverActive rule_act - = putSrcSpanDs loc $ - do { diagnosticDs (DsUselessSpecialiseForNoInlineFunction poly_id) - ; return Nothing } -- Function is NOINLINE, and the specialisation inherits that - -- See Note [Activation pragmas for SPECIALISE] + get_rhs (SpecPrag poly_id _ _) = get_rhs1 poly_id + get_rhs (SpecPragE { spe_fn_id = poly_id }) = get_rhs1 poly_id - | otherwise - = putSrcSpanDs loc $ - do { uniq <- newUnique - ; let poly_name = idName poly_id - spec_occ = mkSpecOcc (getOccName poly_name) - spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) - (spec_bndrs, spec_app) = collectHsWrapBinders spec_co + get_rhs1 poly_id + | Just unfolding <- maybeUnfoldingTemplate (realIdUnfolding poly_id) + = unfolding -- Imported Id; this is its unfolding + -- Use realIdUnfolding so we get the unfolding + -- even when it is a loop breaker. + -- We want to specialise recursive functions! + | otherwise = pprPanic "dsImpSpecs" (ppr poly_id) + -- The type checker has checked that it *has* an unfolding + +dsLSpec :: CoreExpr -> Located TcSpecPrag + -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) +dsLSpec poly_rhs (L loc prag) + = putSrcSpanDs loc $ dsSpec poly_rhs prag + +dsSpec :: CoreExpr -- RHS to be specialised + -> TcSpecPrag + -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) +dsSpec poly_rhs (SpecPrag poly_id spec_co spec_inl) + -- SpecPrag case: See Note [Handling old-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig + | (spec_bndrs, spec_app) <- collectHsWrapBinders spec_co -- spec_co looks like -- \spec_bndrs. [] spec_args -- perhaps with the body of the lambda wrapped in some WpLets -- E.g. /\a \(d:Eq a). let d2 = $df d in [] (Maybe a) d2 + = dsHsWrapper spec_app $ \core_app -> + dsSpec_help (idName poly_id) poly_id poly_rhs + spec_inl spec_bndrs (core_app (Var poly_id)) - ; dsHsWrapperForRuleLHS spec_app $ \core_app -> do +dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm + , spe_fn_id = poly_id + , spe_inl = spec_inl + , spe_bndrs = bndrs + , spe_call = the_call }) + -- SpecPragE case: See Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig + = do { ds_call <- unsetGOptM Opt_EnableRewriteRules $ -- Note [Desugaring RULE left hand sides] + unsetWOptM Opt_WarnIdentities $ + zapUnspecables $ + dsLExpr the_call + ; dsSpec_help poly_nm poly_id poly_rhs spec_inl bndrs ds_call } - { let ds_lhs = core_app (Var poly_id) - spec_ty = mkLamTypes spec_bndrs (exprType ds_lhs) - ; -- pprTrace "dsRule" (vcat [ text "Id:" <+> ppr poly_id - -- , text "spec_co:" <+> ppr spec_co - -- , text "ds_rhs:" <+> ppr ds_lhs ]) $ - dflags <- getDynFlags - ; case decomposeRuleLhs dflags spec_bndrs ds_lhs (mkVarSet spec_bndrs) of { - Left msg -> do { diagnosticDs msg; return Nothing } ; - Right (rule_bndrs, _fn, rule_lhs_args) -> do +dsSpec_help :: Name -> Id -> CoreExpr -- Function to specialise + -> InlinePragma -> [Var] -> CoreExpr + -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) +dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call + = do { -- Decompose the call + -- Step (S1) of Note [Desugaring new-form SPECIALISE pragmas] + mb_call_info <- decomposeCall poly_id ds_call + ; case mb_call_info of { + Nothing -> return Nothing ; + Just (binds, rule_lhs_args) -> - { this_mod <- getModule - ; let fn_unf = realIdUnfolding poly_id + do { dflags <- getDynFlags + ; this_mod <- getModule + ; uniq <- newUnique + ; let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds + is_local :: Var -> Bool + is_local v = v `elemVarSet` locals + + -- Find `rule_bndrs`: (S2) of Note [Desugaring new-form SPECIALISE pragmas] + rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args) + + -- getRenamings: (S3) of Note [Desugaring new-form SPECIALISE pragmas] + rn_binds = getRenamings orig_bndrs binds rule_bndrs + + -- pickSpecBinds: (S4) of Note [Desugaring new-form SPECIALISE pragmas] + known_vars = mkVarSet rule_bndrs `extendVarSetList` bindersOfBinds rn_binds + picked_binds = pickSpecBinds is_local known_vars binds + + -- Find `spec_bndrs`: (S5) of Note [Desugaring new-form SPECIALISE pragmas] + -- Make spec_bndrs, the variables to pass to the specialised + -- function, by filtering out the rule_bndrs that aren't needed + spec_binds_bndr_set = mkVarSet (bindersOfBinds picked_binds) + `minusVarSet` exprsFreeVars (rhssOfBinds rn_binds) + spec_bndrs = filterOut (`elemVarSet` spec_binds_bndr_set) rule_bndrs + + mk_spec_body fn_body = mkLets (rn_binds ++ picked_binds) $ + mkApps fn_body rule_lhs_args + -- NB: not mkCoreApps! That uses exprType on fun + -- which fails in specUnfolding, sigh + + poly_name = idName poly_id + spec_occ = mkSpecOcc (getOccName poly_name) + spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) + id_inl = idInlinePragma poly_id + simpl_opts = initSimpleOpts dflags - spec_unf = specUnfolding simpl_opts spec_bndrs core_app rule_lhs_args fn_unf - spec_id = mkLocalId spec_name ManyTy spec_ty -- Specialised binding is toplevel, hence Many. - `setInlinePragma` inl_prag - `setIdUnfolding` spec_unf + fn_unf = realIdUnfolding poly_id + spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf + spec_info = vanillaIdInfo + `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl + `setUnfoldingInfo` spec_unf + spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info + -- Specialised binding is toplevel, hence Many. + -- The RULE looks like + -- RULE "USPEC" forall rule_bndrs. f rule_lhs_args = $sf spec_bndrs + -- The specialised function looks like + -- $sf spec_bndrs = mk_spec_body + -- We also use mk_spec_body to specialise the methods in f's stable unfolding + -- NB: spec_bindrs is a subset of rule_bndrs rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") poly_id rule_bndrs rule_lhs_args (mkVarApps (Var spec_id) spec_bndrs) - spec_rhs = mkLams spec_bndrs (core_app poly_rhs) - ; dsWarnOrphanRule rule + rule_ty = exprType (mkApps (Var poly_id) rule_lhs_args) + spec_ty = mkLamTypes spec_bndrs rule_ty + spec_rhs = mkLams spec_bndrs (mk_spec_body poly_rhs) - ; tracePm "dsSpec" (vcat - [ text "fun:" <+> ppr poly_id - , text "spec_co:" <+> ppr spec_co - , text "spec_bndrs:" <+> ppr spec_bndrs - , text "ds_lhs:" <+> ppr ds_lhs - , text "args:" <+> ppr rule_lhs_args ]) - ; return (Just (unitOL (spec_id, spec_rhs), rule)) + result = (unitOL (spec_id, spec_rhs), rule) -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because -- makeCorePair overwrites the unfolding, which we have -- just created using specUnfolding - } } } } - where - is_local_id = isJust mb_poly_rhs - poly_rhs | Just rhs <- mb_poly_rhs - = rhs -- Local Id; this is its rhs - | Just unfolding <- maybeUnfoldingTemplate (realIdUnfolding poly_id) - = unfolding -- Imported Id; this is its unfolding - -- Use realIdUnfolding so we get the unfolding - -- even when it is a loop breaker. - -- We want to specialise recursive functions! - | otherwise = pprPanic "dsImpSpecs" (ppr poly_id) - -- The type checker has checked that it *has* an unfolding + ; tracePm "dsSpec(new route)" $ + vcat [ text "poly_id" <+> ppr poly_id + , text "unfolding" <+> ppr (realIdUnfolding poly_id) + , text "orig_bndrs" <+> pprCoreBinders orig_bndrs + , text "locals" <+> ppr locals + , text "fvs" <+> ppr (exprsSomeFreeVarsList is_local rule_lhs_args) + , text "ds_call" <+> ppr ds_call + , text "binds" <+> ppr binds + , text "rule_lhs_args" <+> ppr rule_lhs_args + , text "rule_bndrs" <+> ppr rule_bndrs + , text "spec_bndrs" <+> ppr spec_bndrs + , text "rn_binds" <+> ppr rn_binds + , text "picked_binds" <+> ppr picked_binds ] - id_inl = idInlinePragma poly_id + ; dsWarnOrphanRule rule - -- See Note [Activation pragmas for SPECIALISE] - inl_prag | not (isDefaultInlinePragma spec_inl) = spec_inl - | not is_local_id -- See Note [Specialising imported functions] - -- in OccurAnal - , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma - | otherwise = id_inl - -- Get the INLINE pragma from SPECIALISE declaration, or, - -- failing that, from the original Id + ; case checkUselessSpecPrag poly_id rule_lhs_args spec_bndrs + no_act_spec spec_inl rule_act of + Nothing -> return (Just result) - spec_prag_act = inlinePragmaActivation spec_inl + Just reason -> do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason + ; if uselessSpecialisePragmaKeepAnyway reason + then return (Just result) + else return Nothing } } } } + where -- See Note [Activation pragmas for SPECIALISE] -- no_act_spec is True if the user didn't write an explicit -- phase specification in the SPECIALISE pragma + id_inl = idInlinePragma poly_id + inl_prag_act = inlinePragmaActivation id_inl + spec_prag_act = inlinePragmaActivation spec_inl no_act_spec = case inlinePragmaSpec spec_inl of NoInline _ -> isNeverActive spec_prag_act Opaque _ -> isNeverActive spec_prag_act _ -> isAlwaysActive spec_prag_act - rule_act | no_act_spec = inlinePragmaActivation id_inl -- Inherit - | otherwise = spec_prag_act -- Specified by user + rule_act | no_act_spec = inl_prag_act -- Inherit + | otherwise = spec_prag_act -- Specified by user + is_dfun = case idDetails poly_id of + DFunId {} -> True + _ -> False +decomposeCall :: Id -> CoreExpr + -> DsM (Maybe ([CoreBind], [CoreExpr] )) +-- Decompose the call into (let in f ) +-- See (S1) in Note [Desugaring new-form SPECIALISE pragmas] +decomposeCall poly_id ds_call + = do { dflags <- getDynFlags + ; let simpl_opts = initSimpleOpts dflags + core_call = simpleOptExprNoInline simpl_opts ds_call + -- simpleOptExprNoInline: see Wrinkle (S1a)! + + ; case go [] core_call of { + Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) + ; return Nothing } ; + Just result -> return (Just result) } } + where + go :: [CoreBind] -> CoreExpr -> Maybe ([CoreBind],[CoreExpr]) + go acc (Let bind body) = go (bind:acc) body + go acc (Cast e _) = go acc e -- Discard outer casts + -- ToDo: document this + go acc e + | (Var fun, args) <- collectArgs e + = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ + Just (reverse acc, args) + | otherwise + = Nothing + + -- Is this SPECIALISE pragma useless? +checkUselessSpecPrag :: Id -> [CoreExpr] + -> [Var] -> Bool -> InlinePragma -> Activation + -> Maybe UselessSpecialisePragmaReason +checkUselessSpecPrag poly_id rule_lhs_args + spec_bndrs no_act_spec spec_inl rule_act + | isJust (isClassOpId_maybe poly_id) + -- There is no point in trying to specialise a class op + -- Moreover, classops don't (currently) have an inl_sat arity set + -- (it would be Just 0) and that in turn makes makeCorePair bleat + = Just UselessSpecialiseForClassMethodSelector + + | no_act_spec, isNeverActive rule_act + -- Function is NOINLINE, and the specialisation inherits that + -- See Note [Activation pragmas for SPECIALISE] + = Just UselessSpecialiseForNoInlineFunction + + | all is_nop_arg rule_lhs_args, not (isInlinePragma spec_inl) + -- The specialisation does nothing. + -- But don't complain if it is SPECIALISE INLINE (#4444) + = Just UselessSpecialiseNoSpecialisation + + | otherwise + = Nothing + + where + is_nop_arg (Type {}) = True + is_nop_arg (Coercion {}) = True + is_nop_arg (Cast e _) = is_nop_arg e + is_nop_arg (Tick _ e) = is_nop_arg e + is_nop_arg (Var x) = x `elem` spec_bndrs + is_nop_arg _ = False + + +getRenamings :: [Var] -> [CoreBind] -- orig_bndrs and bindings + -> [Var] -- rule_bndrs + -> [CoreBind] -- Binds some of the orig_bndrs to a rule_bndr +getRenamings orig_bndrs binds rule_bndrs + = [ NonRec b e | b <- orig_bndrs + , not (b `elem` rule_bndrs) + , Just e <- [lookupVarEnv final_renamings b] ] + where + init_renamings, final_renamings :: IdEnv CoreExpr + -- In this function, IdEnv maps a local variable to (v |> co), + -- where `v` is a rule_bndr + + init_renamings = mkVarEnv [ (v, Var v) | v <- rule_bndrs, isId v ] + final_renamings = go binds + + go :: [CoreBind] -> IdEnv CoreExpr + go [] = init_renamings + go (bind : binds) + | NonRec b rhs <- bind + , Just (v, mco) <- getCastedVar rhs + , Just e <- lookupVarEnv renamings b + = extendVarEnv renamings v (mkCastMCo e (mkSymMCo mco)) + | otherwise + = renamings + where + renamings = go binds + +pickSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] -> [CoreBind] +pickSpecBinds _ _ [] = [] +pickSpecBinds is_local known_bndrs (bind:binds) + | all keep_me (rhssOfBind bind) + , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind + = bind : pickSpecBinds is_local known_bndrs' binds + | otherwise + = pickSpecBinds is_local known_bndrs binds + where + keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) + bad_var v = is_local v && not (v `elemVarSet` known_bndrs) + +getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) +getCastedVar (Var v) = Just (v, MRefl) +getCastedVar (Cast (Var v) co) = Just (v, MCo co) +getCastedVar _ = Nothing + +specFunInlinePrag :: Id -> InlinePragma + -> InlinePragma -> InlinePragma +-- See Note [Activation pragmas for SPECIALISE] +specFunInlinePrag poly_id id_inl spec_inl + | not (isDefaultInlinePragma spec_inl) = spec_inl + | isGlobalId poly_id -- See Note [Specialising imported functions] + -- in OccurAnal + , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma + | otherwise = id_inl + -- Get the INLINE pragma from SPECIALISE declaration, or, + -- failing that, from the original Id + dsWarnOrphanRule :: CoreRule -> DsM () dsWarnOrphanRule rule - = when (isOrphan (ru_orphan rule)) $ + = when (ruleIsOrphan rule) $ diagnosticDs (DsOrphanRule rule) {- Note [SPECIALISE on INLINE functions] @@ -995,64 +1284,63 @@ = Left (DsRuleIgnoredDueToConstructor con) -- See Note [No RULES on datacons] | otherwise = case decompose fun2 args2 of - Nothing -> -- pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs - -- , text "orig_lhs:" <+> ppr orig_lhs - -- , text "rhs_fvs:" <+> ppr rhs_fvs - -- , text "orig_lhs:" <+> ppr orig_lhs - -- , text "lhs1:" <+> ppr lhs1 - -- , text "lhs2:" <+> ppr lhs2 - -- , text "fun2:" <+> ppr fun2 - -- , text "args2:" <+> ppr args2 - -- ]) $ + Nothing -> -- pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs + -- , text "orig_lhs:" <+> ppr orig_lhs + -- , text "rhs_fvs:" <+> ppr rhs_fvs + -- , text "lhs1:" <+> ppr lhs1 + -- , text "lhs2:" <+> ppr lhs2 + -- , text "fun2:" <+> ppr fun2 + -- , text "args2:" <+> ppr args2 + -- ]) $ Left (DsRuleLhsTooComplicated orig_lhs lhs2) + Just (fn_id, args) | not (null unbound) -> -- Check for things unbound on LHS -- See Note [Unused spec binders] - -- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs - -- , text "orig_lhs:" <+> ppr orig_lhs - -- , text "lhs_fvs:" <+> ppr lhs_fvs - -- , text "rhs_fvs:" <+> ppr rhs_fvs - -- , text "unbound:" <+> ppr unbound - -- ]) $ + -- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs + -- , text "orig_lhs:" <+> ppr orig_lhs + -- , text "lhs_fvs:" <+> ppr lhs_fvs + -- , text "rhs_fvs:" <+> ppr rhs_fvs + -- , text "unbound:" <+> ppr unbound + -- ]) $ Left (DsRuleBindersNotBound unbound orig_bndrs orig_lhs lhs2) | otherwise -> -- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs - -- , text "orig_lhs:" <+> ppr orig_lhs - -- , text "lhs1:" <+> ppr lhs1 - -- , text "extra_bndrs:" <+> ppr extra_bndrs - -- , text "fn_id:" <+> ppr fn_id - -- , text "args:" <+> ppr args - -- , text "args fvs:" <+> ppr (exprsFreeVarsList args) - -- ]) $ - Right (trimmed_bndrs ++ extra_bndrs, fn_id, args) + -- , text "orig_lhs:" <+> ppr orig_lhs + -- , text "lhs1:" <+> ppr lhs1 + -- , text "trimmed_bndrs:" <+> ppr trimmed_bndrs + -- , text "extra_dicts:" <+> ppr extra_dicts + -- , text "fn_id:" <+> ppr fn_id + -- , text "args:" <+> ppr args + -- , text "args fvs:" <+> ppr (exprsFreeVarsList args) + -- ]) $ + Right (trimmed_bndrs ++ extra_dicts, fn_id, args) where -- See Note [Variables unbound on the LHS] - lhs_fvs = exprsFreeVars args + lhs_fvs = exprsFreeVars args all_fvs = lhs_fvs `unionVarSet` rhs_fvs trimmed_bndrs = filter (`elemVarSet` all_fvs) orig_bndrs unbound = filterOut (`elemVarSet` lhs_fvs) trimmed_bndrs -- Needed on RHS but not bound on LHS - -- Add extra tyvar binders: Note [Free tyvars on rule LHS] - -- and extra dict binders: Note [Free dictionaries on rule LHS] - extra_bndrs = scopedSort extra_tvs ++ extra_dicts - where - extra_tvs = [ v | v <- extra_vars, isTyVar v ] + -- extra_dicts: see Note [Free dictionaries on rule LHS] +-- ToDo: extra_dicts is needed. E.g. the SPECIALISE rules for `ap` in GHC.Base + extra_dicts + = [ mkLocalIdOrCoVar (localiseName (idName d)) ManyTy (idType d) + | d <- exprsSomeFreeVarsList is_extra args ] - -- isEvVar: this includes coercions, matching what - -- happens in `split_lets` (isDictId, isCoVar) - extra_dicts = - [ mkLocalIdOrCoVar (localiseName (idName d)) ManyTy (idType d) - | d <- extra_vars, isEvVar d ] - extra_vars = - [ v - | v <- exprsFreeVarsList args - , not (v `elemVarSet` orig_bndr_set) - , not (v == fn_id) ] - -- fn_id: do not quantify over the function itself, which may - -- itself be a dictionary (in pathological cases, #10251) + is_extra v + = isSimplePredTy (idType v) + -- isSimplePredTy: includes coercions and dictionaries + -- But NOT dictionary functions; and in particular not + -- superclass-selector fuctions + && not (v `elemVarSet` orig_bndr_set) + && not (v == fn_id) + -- fn_id: do not quantify over the function itself, which may + -- itself be a dictionary (in pathological cases, #10251) + where simpl_opts = initSimpleOpts dflags orig_bndr_set = mkVarSet orig_bndrs @@ -1079,9 +1367,10 @@ split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr) split_lets (Let (NonRec d r) body) - | isDictId d -- Catches dictionaries, yes, but also catches dictionary - -- /functions/ arising from solving a - -- quantified contraint (#24370) + | isPredTy (idType d) + -- isPredTy: catches dictionaries, yes, but also catches + -- dictionary /functions/ arising from solving a + -- quantified contraint (see #24370) = ((d,r):bs, body') where (bs, body') = split_lets body @@ -1116,7 +1405,7 @@ We get two dicts on the LHS, one from `1` and one from `+`. For reasons described in Note [The SimplifyRule Plan] in -GHC.Tc.Gen.Rule, we quantify separately over those dictionaries: +GHC.Tc.Gen.Sig, we quantify separately over those dictionaries: forall f (d1::Num Int) (d2 :: Num Int). foo (\xs. (+) d1 (fromInteger d2 1) xs) = ... @@ -1131,32 +1420,6 @@ * simpleOptExpr: see Note [Simplify rule LHS] * extra_dict_bndrs: see Note [Free dictionaries on rule LHS] -Note [Free tyvars on rule LHS] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - data T a = C - - foo :: T a -> Int - foo C = 1 - - {-# RULES "myrule" foo C = 1 #-} - -After type checking the LHS becomes (foo alpha (C alpha)), where alpha -is an unbound meta-tyvar. The zonker in GHC.Tc.Zonk.Type is careful not to -turn the free alpha into Any (as it usually does). Instead it turns it -into a TyVar 'a'. See Note [Zonking the LHS of a RULE] in "GHC.Tc.Zonk.Type". - -Now we must quantify over that 'a'. It's /really/ inconvenient to do that -in the zonker, because the HsExpr data type is very large. But it's /easy/ -to do it here in the desugarer. - -Moreover, we have to do something rather similar for dictionaries; -see Note [Free dictionaries on rule LHS]. So that's why we look for -type variables free on the LHS, and quantify over them. - -This relies on there not being any in-scope tyvars, which is true for -user-defined RULEs, which are always top-level. - Note [Free dictionaries on rule LHS] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When the LHS of a specialisation rule, (/\as\ds. f es) has a free dict, @@ -1191,9 +1454,9 @@ quantify over it. That makes 'd' free in the LHS, but that is later picked up by extra_dict_bndrs (see Note [Unused spec binders]). - NB 1: We can only drop the binding if the RHS doesn't bind - one of the orig_bndrs, which we assume occur on RHS. - Example + NB 1: We can only drop the binding if the RHS of the binding doesn't + mention one of the orig_bndrs, which we assume occur on RHS of + the rule. Example f :: (Eq a) => b -> a -> a {-# SPECIALISE f :: Eq a => b -> [a] -> [a] #-} Here we want to end up with @@ -1201,7 +1464,7 @@ Of course, the ($dfEqlist d) in the pattern makes it less likely to match, but there is no other way to get d:Eq a - NB 2: We do drop_dicts *before* simplOptEpxr, so that we expect all + NB 2: We do drop_dicts *before* simplOptExpr, so that we expect all the evidence bindings to be wrapped around the outside of the LHS. (After simplOptExpr they'll usually have been inlined.) dsHsWrapper does dependency analysis, so that civilised ones @@ -1312,49 +1575,6 @@ This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). - -Note [Desugaring non-canonical evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is canonical, we desugar WpEvApp by simply passing -core_tm directly to k: - - k core_tm - -If the evidence is not canonical, we mark the application with nospec: - - nospec @(cls => a) k core_tm - -where nospec :: forall a. a -> a ensures that the typeclass specialiser -doesn't attempt to common up this evidence term with other evidence terms -of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). - -See Note [Coherence and specialisation: overview] for why we shouldn't -specialise incoherent evidence. - -We can find out if a given evidence is canonical or not during the -desugaring of its WpLet wrapper: an evidence is non-canonical if its -own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other non-canonical evidence. dsEvBinds is -the convenient place to compute this, since it already needs to do -inter-evidence dependency analysis to generate well-scoped -bindings. We then record this specialisability information in the -dsl_unspecables field of DsM's local environment. - -Wrinkle: - -(NC1) Don't do this in the LHS of a RULE. In paritcular, if we have - f :: (Num a, HasCallStack) => a -> a - {-# SPECIALISE f :: Int -> Int #-} - then making a rule like - RULE forall d1:Num Int, d2:HasCallStack. - f @Int d1 d2 = $sf - is pretty dodgy, because $sf won't get the call stack passed in d2. - But that's what you asked for in the SPECIALISE pragma, so we'll obey. - - We definitely can't desugar that LHS into this! - nospec (f @Int d1) d2 - - Hence the `is_rule_lhs` flag in `ds_hs_wrapper`. -} dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a @@ -1362,17 +1582,22 @@ dsHsWrappers [] k = k [] dsHsWrapper :: HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a -dsHsWrapper = ds_hs_wrapper False - -dsHsWrapperForRuleLHS :: HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a -dsHsWrapperForRuleLHS = ds_hs_wrapper True +dsHsWrapper hs_wrap thing_inside + = ds_hs_wrapper hs_wrap $ \ core_wrap -> + addTyCs FromSource (hsWrapDictBinders hs_wrap) $ + -- addTyCs: Add type evidence to the refinement type + -- predicate of the coverage checker + -- See Note [Long-distance information] in "GHC.HsToCore.Pmc" + -- FromSource might not be accurate (we don't have any + -- origin annotations for things in this module), but at + -- worst we do superfluous calls to the pattern match + -- oracle. + thing_inside core_wrap -ds_hs_wrapper :: Bool -- True <=> LHS of a RULE - -- See (NC1) in Note [Desugaring non-canonical evidence] - -> HsWrapper +ds_hs_wrapper :: HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a -ds_hs_wrapper is_rule_lhs wrap = go wrap +ds_hs_wrapper wrap = go wrap where go WpHole k = k $ \e -> e go (WpTyApp ty) k = k $ \e -> App e (Type ty) @@ -1380,6 +1605,8 @@ go (WpTyLam tv) k = k $ Lam tv go (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co + go (WpEvApp tm) k = do { core_tm <- dsEvTerm tm + ; k $ \e -> e `App` core_tm } go (WpLet ev_binds) k = dsTcEvBinds ev_binds $ \bs -> k (mkCoreLets bs) go (WpCompose c1 c2) k = go c1 $ \w1 -> @@ -1389,38 +1616,10 @@ do { x <- newSysLocalDs st ; go c1 $ \w1 -> go c2 $ \w2 -> - let app f a = mkCoreAppDs (text "dsHsWrapper") f a + let app f a = mkCoreApp (text "dsHsWrapper") f a arg = w1 (Var x) in k (\e -> (Lam x (w2 (app e arg)))) } - go (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - -- See Note [Desugaring non-canonical evidence] - ; unspecables <- getUnspecables - ; let vs = exprFreeVarsList core_tm - is_unspecable_var v = v `S.member` unspecables - is_specable - | is_rule_lhs = True - | otherwise = not $ any (is_unspecable_var) vs - - ; k (\e -> app_ev is_specable e core_tm) } - - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - go (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ - diagnosticDs DsMultiplicityCoercionsNotSupported - ; k $ \e -> e } - --- We are about to construct an evidence application `f dict`. If the dictionary is --- non-specialisable, instead construct --- nospec f dict --- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. -app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_specable k core_tm - | not is_specable - = Var nospecId `App` Type (exprType k) `App` k `App` core_tm - - | otherwise - = k `App` core_tm - -------------------------------------- dsTcEvBinds_s :: [TcEvBinds] -> ([CoreBind] -> DsM a) -> DsM a dsTcEvBinds_s [] k = k [] @@ -1449,29 +1648,34 @@ thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) + ds_component mb_unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where ((v, rhs), (this_canonical, deps)) = unpack_node node - transitively_unspecable = is_unspecable this_canonical || any is_unspecable_dep deps - is_unspecable_dep dep = dep `S.member` unspecables - new_unspecables - | transitively_unspecable = S.singleton v - | otherwise = mempty - ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) + new_unspecables = case mb_unspecables of + Nothing -> [] + Just unspecs | transitively_unspecable -> [v] + | otherwise -> [] + where + transitively_unspecable = is_unspecable this_canonical + || any (`elemVarSet` unspecs) deps + + ds_component mb_unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_unspecable_remote dep = dep `S.member` unspecables - transitively_unspecable = or [ is_unspecable this_canonical || any is_unspecable_remote deps - | (this_canonical, deps) <- direct_canonicity ] + new_unspecables = case mb_unspecables of + Nothing -> [] + Just unspecs | transitively_unspecable -> map fst pairs + | otherwise -> [] + where + transitively_unspecable + = or [ is_unspecable this_canonical + || any (`elemVarSet` unspecs) deps + | (this_canonical, deps) <- direct_canonicity ] -- Bindings from a given SCC are transitively specialisable if -- all are specialisable and all their remote dependencies are -- also specialisable; see Note [Desugaring non-canonical evidence] - new_unspecables - | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] - | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) @@ -1520,10 +1724,10 @@ dsEvTerm (EvTypeable ty ev) = dsEvTypeable ty ev dsEvTerm (EvFun { et_tvs = tvs, et_given = given , et_binds = ev_binds, et_body = wanted_id }) - = do { dsTcEvBinds ev_binds $ \ds_ev_binds -> do - { return $ (mkLams (tvs ++ given) $ + = do { dsTcEvBinds ev_binds $ \ds_ev_binds -> + return $ (mkLams (tvs ++ given) $ mkCoreLets ds_ev_binds $ - Var wanted_id) } } + Var wanted_id) } {-********************************************************************** diff --git a/GHC/HsToCore/Breakpoints.hs b/GHC/HsToCore/Breakpoints.hs --- a/GHC/HsToCore/Breakpoints.hs +++ b/GHC/HsToCore/Breakpoints.hs @@ -1,24 +1,70 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | Information attached to Breakpoints generated from Ticks +-- +-- The breakpoint information stored in 'ModBreaks' is generated during +-- desugaring from the ticks annotating the source expressions. +-- +-- This information can be queried per-breakpoint using the 'BreakpointId' +-- datatype, which indexes tick-level breakpoint information. +-- +-- 'ModBreaks' and 'BreakpointId's are not to be confused with +-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed +-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'. +-- +-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers] module GHC.HsToCore.Breakpoints - ( mkModBreaks + ( -- * ModBreaks + mkModBreaks, ModBreaks(..) + + -- ** Re-exports BreakpointId + , BreakpointId(..), BreakTickIndex ) where import GHC.Prelude - -import qualified GHC.Runtime.Interpreter as GHCi -import GHC.Runtime.Interpreter.Types -import GHCi.RemoteTypes -import GHC.ByteCode.Types -import GHC.Stack.CCS -import GHC.Unit +import Data.Array import GHC.HsToCore.Ticks (Tick (..)) - import GHC.Data.SizedSeq -import GHC.Utils.Outputable as Outputable - +import GHC.Types.SrcLoc (SrcSpan) +import GHC.Types.Name (OccName) +import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..)) +import GHC.Unit.Module (Module) +import GHC.Utils.Outputable import Data.List (intersperse) -import Data.Array +-------------------------------------------------------------------------------- +-- ModBreaks +-------------------------------------------------------------------------------- + +-- | All the information about the source-relevant breakpoints for a module +-- +-- This information is constructed once during desugaring (with `mkModBreaks`) +-- from breakpoint ticks and fixed/unchanged from there on forward. It could be +-- exported as an abstract datatype because it should never be updated after +-- construction, only queried. +-- +-- The arrays can be indexed using the int in the corresponding 'BreakpointId' +-- (i.e. the 'BreakpointId' whose 'Module' matches the 'Module' corresponding +-- to these 'ModBreaks') with the accessors 'modBreaks_locs', 'modBreaks_vars', +-- and 'modBreaks_decls'. +data ModBreaks + = ModBreaks + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + -- ^ An array giving the source span of each breakpoint. + , modBreaks_vars :: !(Array BreakTickIndex [OccName]) + -- ^ An array giving the names of the free variables at each breakpoint. + , modBreaks_decls :: !(Array BreakTickIndex [String]) + -- ^ An array giving the names of the declarations enclosing each breakpoint. + -- See Note [Field modBreaks_decls] + , modBreaks_ccs :: !(Array BreakTickIndex (String, String)) + -- ^ Array pointing to cost centre info for each breakpoint; + -- actual 'CostCentre' allocation is done at link-time. + , modBreaks_module :: !Module + -- ^ The module to which this ModBreaks is associated. + -- We also cache this here for internal sanity checks. + } + -- | Initialize memory for breakpoint data that is shared between the bytecode -- generator and the interpreter. -- @@ -26,38 +72,37 @@ -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -} + -> Module -> SizedSeq Tick -> ModBreaks +mkModBreaks interpreterProfiled modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - - breakArray <- GHCi.newBreakArray interp count - ccs <- mkCCSArray interp mod count entries - mod_ptr <- GHCi.newModuleName interp (moduleName mod) - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - return $ emptyModBreaks - { modBreaks_flags = breakArray - , modBreaks_locs = locsTicks - , modBreaks_vars = varsTicks - , modBreaks_decls = declsTicks - , modBreaks_ccs = ccs - , modBreaks_module = mod_ptr - } + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + ccs + | interpreterProfiled = + listArray + (0, count - 1) + [ ( concat $ intersperse "." $ tick_path t, + renderWithContext defaultSDocContext $ ppr $ tick_loc t + ) + | t <- entries + ] + | otherwise = listArray (0, -1) [] + in ModBreaks + { modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_module = modl + } -mkCCSArray - :: Interp -> Module -> Int -> [Tick] - -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre)) -mkCCSArray interp modul count entries - | GHCi.interpreterProfiled interp = do - let module_str = moduleNameString (moduleName modul) - costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries) - return (listArray (0,count-1) costcentres) - | otherwise = return (listArray (0,-1) []) - where - mk_one t = (name, src) - where name = concat $ intersperse "." $ tick_path t - src = renderWithContext defaultSDocContext $ ppr $ tick_loc t +{- +Note [Field modBreaks_decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A value of eg ["foo", "bar", "baz"] in a `modBreaks_decls` field means: +The breakpoint is in the function called "baz" that is declared in a `let` +or `where` clause of a declaration called "bar", which itself is declared +in a `let` or `where` clause of the top-level function called "foo". +-} diff --git a/GHC/HsToCore/Docs.hs b/GHC/HsToCore/Docs.hs --- a/GHC/HsToCore/Docs.hs +++ b/GHC/HsToCore/Docs.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} module GHC.HsToCore.Docs where @@ -29,7 +30,7 @@ import qualified Data.Map as M import qualified Data.Set as Set import Data.Maybe -import Data.Semigroup +import qualified Data.Semigroup as S import GHC.IORef (readIORef) import GHC.Unit.Types import GHC.Hs @@ -41,6 +42,8 @@ import GHC.Types.TypeEnv import GHC.Types.Id import GHC.Types.Unique.Map +import GHC.Utils.Outputable +import GHC.Utils.Panic -- | Extract docs from renamer output. -- This is monadic since we need to be able to read documentation added from @@ -184,7 +187,7 @@ -- Map from aliases to true module names. aliasMap :: Map ModuleName (NonEmpty ModuleName) aliasMap = - M.fromListWith (<>) $ + M.fromListWith (S.<>) $ (this_mdl_name, this_mdl_name :| []) : (flip concatMap (M.toList imported) $ \(mdl, imvs) -> [(imv_name imv, moduleName mdl :| []) | imv <- imvs]) @@ -257,7 +260,7 @@ -> (UniqMap Name [HsDoc GhcRn], UniqMap Name (IntMap (HsDoc GhcRn))) mkMaps env instances decls = ( listsToMapWith (++) (map (nubByName fst) decls') - , listsToMapWith (<>) (filterMapping (not . IM.null) args) + , listsToMapWith (S.<>) (filterMapping (not . IM.null) args) ) where (decls', args) = unzip (map mappings decls) @@ -377,8 +380,8 @@ InstD _ (DataFamInstD _ (DataFamInstDecl d)) -> dataSubs (feqn_rhs d) - TyClD _ d | isClassDecl d -> classSubs d - | isDataDecl d -> dataSubs (tcdDataDefn d) + TyClD _ d | ClassDecl{} <- d -> classSubs d + | DataDecl{} <- d -> dataSubs (tcdDataDefn d) _ -> [] where classSubs dd = [ (name, doc, declTypeDocs d) @@ -396,7 +399,7 @@ | c <- toList cons, cname <- getConNames c ] fields = [ (unLoc $ foLabel n, maybeToList $ fmap unLoc doc, IM.empty) | Just flds <- toList $ fmap getRecConArgs_maybe cons - , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) + , (L _ (HsConDeclRecField _ ns (CDF { cdf_doc = doc }))) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], IM.empty) | (l, doc) <- concatMap (extract_deriv_clause_tys . @@ -427,21 +430,23 @@ h98ConArgDocs :: HsConDeclH98Details GhcRn -> IntMap (HsDoc GhcRn) h98ConArgDocs con_args = case con_args of - PrefixCon _ args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args - InfixCon arg1 arg2 -> con_arg_docs 0 [ unLoc (hsScaledThing arg1) - , unLoc (hsScaledThing arg2) ] + PrefixCon args -> con_arg_docs 0 $ map cdf_doc args + InfixCon arg1 arg2 -> con_arg_docs 0 [ cdf_doc arg1, cdf_doc arg2 ] RecCon _ -> IM.empty gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn) gadtConArgDocs con_args res_ty = case con_args of - PrefixConGADT _ args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty] - RecConGADT _ _ -> con_arg_docs 1 [res_ty] + PrefixConGADT _ args -> con_arg_docs 0 $ map cdf_doc args ++ [res_doc] + RecConGADT _ _ -> con_arg_docs 1 [res_doc] + where + res_doc = case res_ty of + HsDocTy _ _ lds -> Just lds + _ -> Nothing -con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn) +con_arg_docs :: Int -> [Maybe (LHsDoc GhcRn)] -> IntMap (HsDoc GhcRn) con_arg_docs n = IM.fromList . catMaybes . zipWith f [n..] where - f n (HsDocTy _ _ lds) = Just (n, unLoc lds) - f n (HsBangTy _ _ (L _ (HsDocTy _ _ lds))) = Just (n, unLoc lds) + f n (Just lds) = Just (n, unLoc lds) f _ _ = Nothing isValD :: HsDecl a -> Bool @@ -450,15 +455,21 @@ -- | All the sub declarations of a class (that we handle), ordered by -- source location, with documentation attached if it exists. -classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDoc GhcRn])] -classDecls class_ = filterDecls . collectDocs . sortLocatedA $ decls - where - decls = docs ++ defs ++ sigs ++ ats - docs = mkDecls tcdDocs (DocD noExtField) class_ - defs = mkDecls tcdMeths (ValD noExtField) class_ - sigs = mkDecls tcdSigs (SigD noExtField) class_ - ats = mkDecls tcdATs (TyClD noExtField . FamDecl noExtField) class_ +classDecls :: TyClDecl GhcRn -- Always a ClassDecl + -> [(LHsDecl GhcRn, [HsDoc GhcRn])] +classDecls decl + | ClassDecl { .. } <- decl + , let decls = docs ++ defs ++ sigs ++ ats + docs = mkDecls (DocD noExtField) tcdDocs + defs = mkDecls (ValD noExtField) tcdMeths + sigs = mkDecls (SigD noExtField) tcdSigs + ats = mkDecls (TyClD noExtField . FamDecl noExtField) tcdATs + = filterDecls . collectDocs . sortLocatedA $ decls + + | otherwise + = pprPanic "classDecls" (ppr decl) + -- | Extract function argument docs from inside top-level decls. declTypeDocs :: HsDecl GhcRn -> IntMap (HsDoc GhcRn) declTypeDocs = \case @@ -503,15 +514,15 @@ -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'. ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn] -ungroup group_ = - mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExtField) group_ ++ - mkDecls hs_derivds (DerivD noExtField) group_ ++ - mkDecls hs_defds (DefD noExtField) group_ ++ - mkDecls hs_fords (ForD noExtField) group_ ++ - mkDecls hs_docs (DocD noExtField) group_ ++ - mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExtField) group_ ++ - mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++ - mkDecls (valbinds . hs_valds) (ValD noExtField) group_ +ungroup (HsGroup {..}) = + mkDecls (TyClD noExtField) (tyClGroupTyClDecls hs_tyclds) ++ + mkDecls (DerivD noExtField) hs_derivds ++ + mkDecls (DefD noExtField) hs_defds ++ + mkDecls (ForD noExtField) hs_fords ++ + mkDecls (DocD noExtField) hs_docs ++ + mkDecls (InstD noExtField) (tyClGroupInstDecls hs_tyclds) ++ + mkDecls (SigD noExtField) (typesigs hs_valds) ++ + mkDecls (ValD noExtField) (valbinds hs_valds) where typesigs :: HsValBinds GhcRn -> [LSig GhcRn] typesigs (XValBindsLR (NValBinds _ sig)) = filter (isUserSig . unLoc) sig @@ -573,11 +584,10 @@ -- | Take a field of declarations from a data structure and create HsDecls -- using the given constructor -mkDecls :: (struct -> [GenLocated l decl]) - -> (decl -> hsDecl) - -> struct +mkDecls :: (decl -> hsDecl) + -> [GenLocated l decl] -> [GenLocated l hsDecl] -mkDecls field con = map (fmap con) . field +mkDecls con = map (fmap con) -- | Extracts out individual maps of documentation added via Template Haskell's -- @putDoc@. diff --git a/GHC/HsToCore/Errors/Ppr.hs b/GHC/HsToCore/Errors/Ppr.hs --- a/GHC/HsToCore/Errors/Ppr.hs +++ b/GHC/HsToCore/Errors/Ppr.hs @@ -7,7 +7,7 @@ module GHC.HsToCore.Errors.Ppr where -import GHC.Core.Predicate (isEvVar) +import GHC.Core.Predicate (isEvId) import GHC.Core.Type import GHC.Driver.Flags import GHC.Hs @@ -27,7 +27,7 @@ instance Diagnostic DsMessage where type DiagnosticOpts DsMessage = NoDiagnosticOpts diagnosticMessage opts = \case - DsUnknownMessage (UnknownDiagnostic f m) + DsUnknownMessage (UnknownDiagnostic f _ m) -> diagnosticMessage (f opts) m DsEmptyEnumeration -> mkSimpleDecorated $ text "Enumeration is empty" @@ -83,14 +83,46 @@ StrictBinds -> "strict bindings" in mkSimpleDecorated $ hang (text "Top-level" <+> text desc <+> text "aren't allowed:") 2 (ppr bind) - DsUselessSpecialiseForClassMethodSelector poly_id - -> mkSimpleDecorated $ - text "Ignoring useless SPECIALISE pragma for class selector:" <+> quotes (ppr poly_id) - DsUselessSpecialiseForNoInlineFunction poly_id - -> mkSimpleDecorated $ - text "Ignoring useless SPECIALISE pragma for NOINLINE function:" <+> quotes (ppr poly_id) - DsMultiplicityCoercionsNotSupported - -> mkSimpleDecorated $ text "GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities" + DsUselessSpecialisePragma poly_nm is_dfun rea -> + mkSimpleDecorated $ + vcat [ what <+> pragma <+> text "pragma" <> why + , additional ] + where + quoted_nm = quotes (ppr poly_nm) + what + | uselessSpecialisePragmaKeepAnyway rea + = text "Dubious" + | otherwise + = text "Ignoring useless" + pragma = if is_dfun + then text "SPECIALISE instance" + else text "SPECIALISE" + why = case rea of + UselessSpecialiseForClassMethodSelector -> + text " for class selector:" <+> quoted_nm + UselessSpecialiseForNoInlineFunction -> + text " for NOINLINE function:" <+> quoted_nm + UselessSpecialiseNoSpecialisation -> + -- Omit the Name for a DFunId, as it will be internal and not + -- very illuminating to users who don't know what a DFunId is. + (if is_dfun then empty else text " for" <+> quoted_nm) <> dot + + additional + | uselessSpecialisePragmaKeepAnyway rea + = -- No specialisation happening, but the pragma may still be useful. + -- For example (#25389): + -- + -- data G a where { G1 :: G Int, G2 :: G Bool } + -- f :: G a -> a + -- f G1 = ; f G2 = + -- {-# SPECIALISE f :: G Int -> Int #-} + -- -- In $sf, we get rid of dead code in + vcat + [ text "The pragma does not specialise away any class dictionaries," + , text "and neither is there any value specialisation." + ] + | otherwise + = empty DsOrphanRule rule -> mkSimpleDecorated $ text "Orphan rule:" <+> ppr rule DsRuleLhsTooComplicated orig_lhs lhs2 @@ -111,11 +143,11 @@ , text "is not bound in RULE lhs"]) 2 (vcat [ text "Orig bndrs:" <+> ppr orig_bndrs , text "Orig lhs:" <+> ppr orig_lhs - , text "optimised lhs:" <+> ppr lhs2 ]) + , text "Optimised lhs:" <+> ppr lhs2 ]) pp_bndr b | isTyVar b = text "type variable" <+> quotes (ppr b) - | isEvVar b = text "constraint" <+> quotes (ppr (varType b)) + | isEvId b = text "constraint" <+> quotes (ppr (varType b)) | otherwise = text "variable" <+> quotes (ppr b) DsLazyPatCantBindVarsOfUnliftedType unlifted_bndrs -> mkSimpleDecorated $ @@ -167,6 +199,8 @@ -> mkMsg "Splices within declaration brackets" empty ThNonLinearDataCon -> mkMsg "Non-linear fields in data constructors" empty + ThDataConVisibleForall + -> mkMsg "Visible forall in data constructors" empty where mkMsg what doc = mkSimpleDecorated $ @@ -207,10 +241,12 @@ <+> text "for"<+> quotes (ppr lhs_id) <+> text "might fire first") ] - DsIncompleteRecordSelector name cons_wo_field not_full_examples -> mkSimpleDecorated $ - text "The application of the record field" <+> quotes (ppr name) - <+> text "may fail for the following constructors:" - <+> vcat (map ppr cons_wo_field ++ [text "..." | not_full_examples]) + DsIncompleteRecordSelector name cons maxCons -> mkSimpleDecorated $ + hang (text "Selecting the record field" <+> quotes (ppr name) + <+> text "may fail for the following constructors:") + 2 + (hsep $ punctuate comma $ + map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ]) diagnosticReason = \case DsUnknownMessage m -> diagnosticReason m @@ -224,9 +260,7 @@ DsNonExhaustivePatterns _ (ExhaustivityCheckType mb_flag) _ _ _ -> maybe WarningWithoutFlag WarningWithFlag mb_flag DsTopLevelBindsNotAllowed{} -> ErrorWithoutFlag - DsUselessSpecialiseForClassMethodSelector{} -> WarningWithoutFlag - DsUselessSpecialiseForNoInlineFunction{} -> WarningWithoutFlag - DsMultiplicityCoercionsNotSupported{} -> ErrorWithoutFlag + DsUselessSpecialisePragma{} -> WarningWithFlag Opt_WarnUselessSpecialisations DsOrphanRule{} -> WarningWithFlag Opt_WarnOrphans DsRuleLhsTooComplicated{} -> WarningWithoutFlag DsRuleIgnoredDueToConstructor{} -> WarningWithoutFlag @@ -261,9 +295,7 @@ DsMaxPmCheckModelsReached{} -> [SuggestIncreaseMaxPmCheckModels] DsNonExhaustivePatterns{} -> noHints DsTopLevelBindsNotAllowed{} -> noHints - DsUselessSpecialiseForClassMethodSelector{} -> noHints - DsUselessSpecialiseForNoInlineFunction{} -> noHints - DsMultiplicityCoercionsNotSupported -> noHints + DsUselessSpecialisePragma{} -> noHints DsOrphanRule{} -> noHints DsRuleLhsTooComplicated{} -> noHints DsRuleIgnoredDueToConstructor{} -> noHints @@ -280,7 +312,7 @@ DsAnotherRuleMightFireFirst _ bad_rule _ -> [SuggestAddPhaseToCompetingRule bad_rule] DsIncompleteRecordSelector{} -> noHints - diagnosticCode = constructorCode + diagnosticCode = constructorCode @GHC {- Note [Suggest NegativeLiterals] diff --git a/GHC/HsToCore/Errors/Types.hs b/GHC/HsToCore/Errors/Types.hs --- a/GHC/HsToCore/Errors/Types.hs +++ b/GHC/HsToCore/Errors/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} module GHC.HsToCore.Errors.Types where @@ -31,7 +32,7 @@ -- | Diagnostics messages emitted during desugaring. data DsMessage -- | Simply wraps a generic 'Diagnostic' message. - = DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage)) + = DsUnknownMessage (UnknownDiagnosticFor DsMessage) {-| DsEmptyEnumeration is a warning (controlled by the -Wempty-enumerations flag) that is emitted if an enumeration is empty. @@ -105,11 +106,18 @@ | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) - | DsUselessSpecialiseForClassMethodSelector !Id + {-| DsUselessSpecialisePragma is a warning (controlled by the -Wuseless-specialisations flag) + that is emitted for SPECIALISE pragmas that (most likely) don't do anything. - | DsUselessSpecialiseForNoInlineFunction !Id + Examples: - | DsMultiplicityCoercionsNotSupported + foo :: forall a. a -> a + {-# SPECIALISE foo :: Int -> Int #-} + -} + | DsUselessSpecialisePragma + !Name + !Bool -- ^ is this a @SPECIALISE instance@ pragma? + !UselessSpecialisePragmaReason | DsOrphanRule !CoreRule @@ -163,7 +171,9 @@ DsIncompleteRecSel2 DsIncompleteRecSel3 -} - | DsIncompleteRecordSelector !Name ![ConLike] !Bool + | DsIncompleteRecordSelector !Name -- ^ The selector + ![ConLike] -- ^ The partial constructors + !Int -- ^ The max number of constructors reported deriving Generic @@ -194,6 +204,26 @@ | ThWarningAndDeprecationPragmas [LIdP GhcRn] | ThSplicesWithinDeclBrackets | ThNonLinearDataCon + | ThDataConVisibleForall + +-- | Why is a @SPECIALISE@ pragmas useless? +data UselessSpecialisePragmaReason + -- | Useless @SPECIALISE@ pragma for a class method + = UselessSpecialiseForClassMethodSelector + -- | Useless @SPECIALISE@ pragma for a function with NOINLINE + | UselessSpecialiseForNoInlineFunction + -- | Useless @SPECIALISE@ pragma which generates a specialised function + -- which is identical to the original function at runtime. + | UselessSpecialiseNoSpecialisation + deriving Generic + +uselessSpecialisePragmaKeepAnyway :: UselessSpecialisePragmaReason -> Bool +uselessSpecialisePragmaKeepAnyway = \case + UselessSpecialiseForClassMethodSelector -> False + UselessSpecialiseForNoInlineFunction -> False + UselessSpecialiseNoSpecialisation -> True + -- See #25389/T25389 for why we might want to keep this specialisation + -- around even if it seemingly does nothing. data NegLiteralExtEnabled = YesUsingNegLiterals diff --git a/GHC/HsToCore/Expr.hs b/GHC/HsToCore/Expr.hs --- a/GHC/HsToCore/Expr.hs +++ b/GHC/HsToCore/Expr.hs @@ -1,6 +1,6 @@ - {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE LambdaCase #-} @@ -30,44 +30,53 @@ import GHC.HsToCore.Arrows import GHC.HsToCore.Monad import GHC.HsToCore.Pmc +import GHC.HsToCore.Pmc.Utils import GHC.HsToCore.Errors.Types -import GHC.Types.SourceText -import GHC.Types.Name hiding (varName) -import GHC.Core.FamInstEnv( topNormaliseType ) import GHC.HsToCore.Quote import GHC.HsToCore.Ticks (stripTicksTopHsExpr) import GHC.Hs + -- NB: The desugarer, which straddles the source and Core worlds, sometimes -- needs to see source types import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad +import GHC.Tc.Instance.Class (lookupHasFieldLabel) + +import GHC.Core +import GHC.Core.FVs( exprsFreeVarsList ) +import GHC.Core.FamInstEnv( topNormaliseType ) import GHC.Core.Type import GHC.Core.TyCo.Rep -import GHC.Core import GHC.Core.Utils import GHC.Core.Make +import GHC.Core.PatSyn import GHC.Driver.Session + +import GHC.Types.SourceText +import GHC.Types.Name hiding (varName) import GHC.Types.CostCentre import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.Id.Make +import GHC.Types.Var( isInvisibleAnonPiTyBinder ) +import GHC.Types.Var.Set( isEmptyVarSet, elemVarSet ) +import GHC.Types.Basic +import GHC.Types.SrcLoc +import GHC.Types.Tickish + import GHC.Unit.Module import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types import GHC.Builtin.Names -import GHC.Types.Basic -import GHC.Types.SrcLoc -import GHC.Types.Tickish + import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic -import GHC.Core.PatSyn import Control.Monad -import GHC.Types.Error {- ************************************************************************ @@ -101,9 +110,12 @@ ; foldrM ds_ip_bind inner ip_binds } } where ds_ip_bind :: LIPBind GhcTc -> CoreExpr -> DsM CoreExpr + -- Given (IPBind n s e), we have + -- n :: IP s ty, e :: ty + -- Use evWrapIP to convert `e` (the user-written RHS) to an IP dictionary ds_ip_bind (L _ (IPBind n _ e)) body = do e' <- dsLExpr e - return (Let (NonRec n e') body) + return (Let (NonRec n (evWrapIPE (idType n) e')) body) ------------------------- -- caller sets location @@ -226,8 +238,8 @@ -- so must be simply unboxed = do { (args, rhs) <- matchWrapper (mkPrefixFunRhs (L l $ idName fun) noAnn) Nothing matches ; massert (null args) -- Functions aren't unlifted - ; dsHsWrapper co_fn $ \core_wrap -> do -- Can be non-identity (#21516) - { let rhs' = core_wrap (mkOptTickBox tick rhs) + ; dsHsWrapper co_fn $ \core_wrap -> -- Can be non-identity (#21516) + do { let rhs' = core_wrap (mkOptTickBox tick rhs) ; return (bindNonRec fun rhs' body) } } dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss @@ -259,23 +271,20 @@ -- | Desugar a typechecked expression. dsExpr :: HsExpr GhcTc -> DsM CoreExpr -dsExpr (HsVar _ (L _ id)) = dsHsVar id +dsExpr e@(HsVar {}) = dsApp e +dsExpr e@(HsApp {}) = dsApp e +dsExpr e@(HsAppType {}) = dsApp e -dsExpr (HsUnboundVar (HER ref _ _) _) = dsEvTerm =<< readMutVar ref - -- See Note [Holes] in GHC.Tc.Types.Constraint +dsExpr (HsHole (_, (HER ref _ _))) = dsEvTerm =<< readMutVar ref + -- See Note [Holes in expressions] in GHC.Tc.Types.Constraint. dsExpr (HsPar _ e) = dsLExpr e dsExpr (ExprWithTySig _ e _) = dsLExpr e -dsExpr (HsIPVar x _) = dataConCantHappen x - -dsExpr (HsGetField x _ _) = dataConCantHappen x -dsExpr (HsProjection x _) = dataConCantHappen x - dsExpr (HsLit _ lit) = do { warnAboutOverflowedLit lit - ; dsLit (convertLit lit) } + ; dsLit lit } dsExpr (HsOverLit _ lit) = do { warnAboutOverflowedOverLit lit @@ -283,12 +292,14 @@ dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of + HsRecSelTc {} -> dsApp e + WrapExpr {} -> dsApp e + ConLikeTc {} -> dsApp e + ExpandedThingTc o e | OrigStmt (L loc _) <- o -> putSrcSpanDsA loc $ dsExpr e | otherwise -> dsExpr e - WrapExpr {} -> dsHsWrapped e - ConLikeTc con tvs tys -> dsConLike con tvs tys -- Hpc Support HsTick tickish e -> do e' <- dsLExpr e @@ -306,36 +317,9 @@ do { assert (exprType e2 `eqType` boolTy) mkBinaryTickBox ixT ixF e2 } - {- Record selectors are warned about if they are not - present in all of the parent data type's constructor, - or always in case of pattern synonym record selectors - (regulated by a flag). However, this only produces - a warning if it's not a part of a record selector - application. For example: - data T = T1 | T2 {s :: Bool} - f x = s x -- the warning from this case will be supressed - See the `HsApp` case for where it is filtered out - -} - (HsRecSelTc (FieldOcc _ (L _ id))) -> - do { let name = getName id - RecSelId {sel_cons = (_, cons_wo_field)} = idDetails id - ; cons_trimmed <- trim_cons cons_wo_field - ; unless (null cons_wo_field) $ diagnosticDs - $ DsIncompleteRecordSelector name cons_trimmed (cons_trimmed /= cons_wo_field) - -- This only produces a warning if it's not a part of a - -- record selector application (e.g. `s a` where `s` is a selector) - -- See the `HsApp` case for where it is filtered out - ; dsHsVar id } - where - trim_cons :: [ConLike] -> DsM [ConLike] - trim_cons cons_wo_field = do - dflags <- getDynFlags - let maxConstructors = maxUncoveredPatterns dflags - return $ take maxConstructors cons_wo_field - -- Strip ticks due to #21701, need to be invariant about warnings we produce whether -- this is enabled or not. dsExpr (NegApp _ (L loc @@ -346,7 +330,6 @@ -- See Note [Checking "negative literals"] (lit { ol_val = HsIntegral (negateIntegralLit i) }) ; dsOverLit lit } - ; ; dsSyntaxExpr neg_expr [mkTicks ts expr'] } dsExpr (NegApp _ expr neg_expr) @@ -356,32 +339,7 @@ dsExpr (HsLam _ variant a_Match) = uncurry mkCoreLams <$> matchWrapper (LamAlt variant) Nothing a_Match -dsExpr e@(HsApp _ fun arg) - -- We want to have a special case that uses the PMC information to filter - -- out some of the incomplete record selectors warnings and not trigger - -- the warning emitted during the desugaring of dsExpr(HsRecSel) - -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc - = do { (msgs, fun') <- captureMessagesDs $ dsLExpr fun - -- Make sure to filter out the generic incomplete record selector warning - -- if it's a raw record selector - ; arg' <- dsLExpr arg - ; case getIdFromTrivialExpr_maybe fun' of - Just fun_id | isRecordSelector fun_id - -> do { let msgs' = filterMessages is_incomplete_rec_sel_msg msgs - ; addMessagesDs msgs' - ; pmcRecSel fun_id arg' } - _ -> addMessagesDs msgs - ; warnUnusedBindValue fun arg (exprType arg') - ; return $ mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg' } - where - is_incomplete_rec_sel_msg :: MsgEnvelope DsMessage -> Bool - is_incomplete_rec_sel_msg (MsgEnvelope {errMsgDiagnostic = DsIncompleteRecordSelector{}}) - = False - is_incomplete_rec_sel_msg _ = True - -dsExpr e@(HsAppType {}) = dsHsWrapped e - {- Note [Checking "negative literals"] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -441,13 +399,17 @@ dsExpr (ExplicitSum types alt arity expr) = mkCoreUnboxedSum arity alt types <$> dsLExpr expr -dsExpr (HsPragE _ prag expr) = - ds_prag_expr prag expr - -dsExpr (HsEmbTy x _) = dataConCantHappen x -dsExpr (HsQual x _ _) = dataConCantHappen x -dsExpr (HsForAll x _ _) = dataConCantHappen x -dsExpr (HsFunArr x _ _ _) = dataConCantHappen x +dsExpr (HsPragE _ (HsPragSCC _ cc) expr) + = do { dflags <- getDynFlags + ; if sccProfilingEnabled dflags && gopt Opt_ProfManualCcs dflags + then do + mod_name <- getModule + count <- goptM Opt_ProfCountEntries + let nm = sl_fs cc + flavour <- mkExprCCFlavour <$> getCCIndexDsM nm + Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True) + <$> dsLExpr expr + else dsLExpr expr } dsExpr (HsCase ctxt discrim matches) = do { core_discrim <- dsLExpr discrim @@ -463,11 +425,11 @@ -- We need the `ListComp' form to use `deListComp' (rather than the "do" form) -- because the interpretation of `stmts' depends on what sort of thing it is. -- -dsExpr (HsDo res_ty ListComp (L _ stmts)) = dsListComp stmts res_ty +dsExpr (HsDo res_ty ListComp (L _ stmts)) = dsListComp stmts res_ty +dsExpr (HsDo _ MonadComp (L _ stmts)) = dsMonadComp stmts dsExpr (HsDo res_ty ctx@DoExpr{} (L _ stmts)) = dsDo ctx stmts res_ty dsExpr (HsDo res_ty ctx@GhciStmtCtxt (L _ stmts)) = dsDo ctx stmts res_ty dsExpr (HsDo res_ty ctx@MDoExpr{} (L _ stmts)) = dsDo ctx stmts res_ty -dsExpr (HsDo _ MonadComp (L _ stmts)) = dsMonadComp stmts dsExpr (HsIf _ guard_expr then_expr else_expr) = do { pred <- dsLExpr guard_expr @@ -476,10 +438,6 @@ ; return $ mkIfThenElse pred b1 b2 } dsExpr (HsMultiIf res_ty alts) - | null alts - = mkErrorExpr - - | otherwise = do { let grhss = GRHSs emptyComments alts emptyLocalBinds ; rhss_nablas <- pmcGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas @@ -489,12 +447,6 @@ mkErrorExpr = mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID res_ty (text "multi-way if") -{- -\noindent -\underline{\bf Various data construction things} - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --} - dsExpr (ExplicitList elt_ty xs) = dsExplicitList elt_ty xs dsExpr (ArithSeq expr witness seq) @@ -503,41 +455,35 @@ Just fl -> do { newArithSeq <- dsArithSeq expr seq ; dsSyntaxExpr fl [newArithSeq] } -{- -Static Pointers -~~~~~~~~~~~~~~~ - -See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview. - +{- Note [Desugaring static pointers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable +for an overview. g = ... static f ... ==> g = ... makeStatic loc f ... -} -dsExpr (HsStatic (_, whole_ty) expr@(L loc _)) = do - expr_ds <- dsLExpr expr - let (_, [ty]) = splitTyConApp whole_ty - makeStaticId <- dsLookupGlobalId makeStaticName +dsExpr (HsStatic (_, whole_ty) expr@(L loc _)) + = do { expr_ds <- dsLExpr expr + ; let (_, [ty]) = splitTyConApp whole_ty + ; makeStaticId <- dsLookupGlobalId makeStaticName - dflags <- getDynFlags - let platform = targetPlatform dflags - let (line, col) = case locA loc of - RealSrcSpan r _ -> - ( srcLocLine $ realSrcSpanStart r - , srcLocCol $ realSrcSpanStart r - ) - _ -> (0, 0) - srcLoc = mkCoreTup [ mkIntExprInt platform line - , mkIntExprInt platform col - ] + ; dflags <- getDynFlags + ; let platform = targetPlatform dflags + (line, col) = case locA loc of + RealSrcSpan r _ -> ( srcLocLine $ realSrcSpanStart r + , srcLocCol $ realSrcSpanStart r ) + _ -> (0, 0) + srcLoc = mkCoreTup [ mkIntExprInt platform line + , mkIntExprInt platform col + ] - putSrcSpanDsA loc $ return $ - mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, expr_ds ] + ; putSrcSpanDsA loc $ return $ + mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, expr_ds ] } -{- -\noindent -\underline{\bf Record construction and update} - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Desugaring record construction] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For record construction we do this (assuming T has three arguments) \begin{verbatim} T { op2 = e } @@ -560,6 +506,7 @@ dsExpr (RecordCon { rcon_con = L _ con_like , rcon_flds = rbinds , rcon_ext = con_expr }) +-- See Note [Desugaring record construction] = do { con_expr' <- dsExpr con_expr ; let (arg_tys, _) = tcSplitFunTys (exprType con_expr') @@ -577,11 +524,10 @@ ; con_args <- if null labels then mapM unlabelled_bottom (map scaledThing arg_tys) - else mapM mk_arg (zipEqual "dsExpr:RecordCon" (map scaledThing arg_tys) labels) + else mapM mk_arg (zipEqual (map scaledThing arg_tys) labels) ; return (mkCoreApps con_expr' con_args) } -dsExpr (RecordUpd x _ _) = dataConCantHappen x -- Here is where we desugar the Template Haskell brackets and escapes @@ -596,39 +542,368 @@ -- Arrow notation extension dsExpr (HsProc _ pat cmd) = dsProcExpr pat cmd - -- HsSyn constructs that just shouldn't be here, because --- the renamer removed them. See GHC.Rename.Expr. +-- the renamer or typechecker removed them. See GHC.Rename.Expr. -- Note [Handling overloaded and rebindable constructs] -dsExpr (HsOverLabel x _) = dataConCantHappen x -dsExpr (OpApp x _ _ _) = dataConCantHappen x -dsExpr (SectionL x _ _) = dataConCantHappen x -dsExpr (SectionR x _ _) = dataConCantHappen x +dsExpr (HsIPVar x _) = dataConCantHappen x +dsExpr (HsGetField x _ _) = dataConCantHappen x +dsExpr (HsProjection x _) = dataConCantHappen x +dsExpr (RecordUpd x _ _) = dataConCantHappen x +dsExpr (HsEmbTy x _) = dataConCantHappen x +dsExpr (HsQual x _ _) = dataConCantHappen x +dsExpr (HsForAll x _ _) = dataConCantHappen x +dsExpr (HsFunArr x _ _ _) = dataConCantHappen x +dsExpr (HsOverLabel x _) = dataConCantHappen x +dsExpr (OpApp x _ _ _) = dataConCantHappen x +dsExpr (SectionL x _ _) = dataConCantHappen x +dsExpr (SectionR x _ _) = dataConCantHappen x -ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr -ds_prag_expr (HsPragSCC _ cc) expr = do - dflags <- getDynFlags - if sccProfilingEnabled dflags && gopt Opt_ProfManualCcs dflags - then do - mod_name <- getModule - count <- goptM Opt_ProfCountEntries - let nm = sl_fs cc - flavour <- mkExprCCFlavour <$> getCCIndexDsM nm - Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True) - <$> dsLExpr expr - else dsLExpr expr +{- ********************************************************************* +* * +* Desugaring applications +* * +********************************************************************* -} + +{- Note [Desugaring applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we come across an application (f e1 .. en) we collect up +all the desugared arguments, and then dispatch on the function f. +(Including the nullary case where n=0.) + +There are several special cases to handle + +* HsRecSel: a record selector gets warnings if it might fail. +* HsVar: special magic for `noinline` +* HsVar: special magic for `seq` + +Note [Desugaring seq] +~~~~~~~~~~~~~~~~~~~~~ +There are a few subtleties in the desugaring of `seq`, all +implemented in the `seqId` case of `ds_app_var`: + + 1. (as described in #1031) + + Consider, + f x y = x `seq` (y `seq` (# x,y #)) + + Because the argument to the outer 'seq' has an unlifted type, we'll use + call-by-value, and compile it as if we had + + f x y = case (y `seq` (# x,y #)) of v -> x `seq` v + + But that is bad, because we now evaluate y before x! + + Seq is very, very special! So we recognise it right here, and desugar to + case x of _ -> case y of _ -> (# x,y #) + + 2. (as described in #2273) + + Consider + let chp = case b of { True -> fst x; False -> 0 } + in chp `seq` ...chp... + Here the seq is designed to plug the space leak of retaining (snd x) + for too long. + + If we rely on the ordinary inlining of seq, we'll get + let chp = case b of { True -> fst x; False -> 0 } + case chp of _ { I# -> ...chp... } + + But since chp is cheap, and the case is an alluring context, we'll + inline chp into the case scrutinee. Now there is only one use of chp, + so we'll inline a second copy. Alas, we've now ruined the purpose of + the seq, by re-introducing the space leak: + case (case b of {True -> fst x; False -> 0}) of + I# _ -> ...case b of {True -> fst x; False -> 0}... + + We can try to avoid doing this by ensuring that the binder-swap in the + case happens, so we get this at an early stage: + case chp of chp2 { I# -> ...chp2... } + But this is fragile. The real culprit is the source program. Perhaps we + should have said explicitly + let !chp2 = chp in ...chp2... + + But that's painful. So the code here does a little hack to make seq + more robust: a saturated application of 'seq' is turned *directly* into + the case expression, thus: + x `seq` e2 ==> case x of x -> e2 -- Note shadowing! + e1 `seq` e2 ==> case x of _ -> e2 + + So we desugar our example to: + let chp = case b of { True -> fst x; False -> 0 } + case chp of chp { I# -> ...chp... } + And now all is well. + + The reason it's a hack is because if you define mySeq=seq, the hack + won't work on mySeq. + + 3. (as described in #2409) + + The isInternalName ensures that we don't turn + True `seq` e + into + case True of True { ... } + which stupidly tries to bind the datacon 'True'. +-} + +dsApp :: HsExpr GhcTc -> DsM CoreExpr +dsApp e = ds_app e [] [] + +---------------------- +ds_lapp :: LHsExpr GhcTc -> [LHsExpr GhcTc] -> [CoreExpr] -> DsM CoreExpr +-- The [LHsExpr] args correspond to the [CoreExpr] args, +-- but there may be more of the latter because they include +-- type and dictionary arguments +ds_lapp (L loc e) hs_args core_args + = putSrcSpanDsA loc $ + ds_app e hs_args core_args + +ds_app :: HsExpr GhcTc -> [LHsExpr GhcTc] -> [CoreExpr] -> DsM CoreExpr +-- The work-horse +ds_app (HsPar _ e) hs_args core_args = ds_lapp e hs_args core_args + +ds_app (HsApp _ fun arg) hs_args core_args + = do { core_arg <- dsLExpr arg + ; ds_lapp fun (arg : hs_args) (core_arg : core_args) } + +ds_app (HsAppType arg_ty fun _) hs_args core_args + = ds_lapp fun hs_args (Type arg_ty : core_args) + +ds_app (XExpr (WrapExpr hs_wrap fun)) hs_args core_args + = do { (fun_wrap, all_args) <- splitHsWrapperArgs hs_wrap core_args + ; if isIdHsWrapper fun_wrap + then ds_app fun hs_args all_args + else do { core_fun <- dsHsWrapper fun_wrap $ \core_wrap -> + do { core_fun <- dsExpr fun + ; return (core_wrap core_fun) } + ; return (mkCoreApps core_fun all_args) } } + +ds_app (XExpr (ConLikeTc con tvs tys)) _hs_args core_args +-- Desugar desugars 'ConLikeTc': it eta-expands +-- data constructors to make linear types work. +-- See Note [Typechecking data constructors] in GHC.Tc.Gen.Head + = do { ds_con <- dsHsConLike con + ; ids <- newSysLocalsDs tys + -- NB: these 'Id's may be representation-polymorphic; + -- see Wrinkle [Representation-polymorphic lambda] in + -- Note [Typechecking data constructors] in GHC.Tc.Gen.Head. + ; let core_fun = mkLams tvs $ mkLams ids $ + ds_con `mkTyApps` mkTyVarTys tvs + `mkVarApps` ids + ; return (mkApps core_fun core_args) } + +ds_app (XExpr (HsRecSelTc (FieldOcc { foLabel = L _ sel_id }))) _hs_args core_args + = ds_app_rec_sel sel_id sel_id core_args + +ds_app (HsVar _ lfun) hs_args core_args + = ds_app_var lfun hs_args core_args + +ds_app e _hs_args core_args + = do { core_e <- dsExpr e + ; return (mkCoreApps core_e core_args) } + +--------------- +ds_app_var :: LocatedN Id -> [LHsExpr GhcTc] -> [CoreExpr] -> DsM CoreExpr +-- Desugar an application with HsVar at the head +ds_app_var (L loc fun_id) hs_args core_args + + ----------------------- + -- Deal with getField applications. General form: + -- getField + -- @GHC.Types.Symbol {k} + -- @"sel" x_ty + -- @T r_ty + -- @Int a_ty + -- ($dHasField :: HasField "sel" T Int) dict + -- :: T -> Int + -- where + -- $dHasField = sel |> (co :: T -> Int ~R# HasField "sel" T Int) + -- Alas, we cannot simply look at the unfolding of $dHasField below because it + -- has not been set yet, so we have to reconstruct the selector Id from the types. + | fun_id `hasKey` getFieldClassOpKey + = do { -- Look up the field named x/"sel" in the type r/T + fam_inst_envs <- dsGetFamInstEnvs + ; rdr_env <- dsGetGlobalRdrEnv + ; let core_arg_tys :: [Type] = [ty | Type ty <- core_args] + ; case lookupHasFieldLabel fam_inst_envs rdr_env core_arg_tys of + Just (sel_name,_,_,_) + -> do { sel_id <- dsLookupGlobalId sel_name + ; tracePm "getfield2" (ppr sel_id) + ; ds_app_rec_sel sel_id fun_id core_args } + _ -> ds_app_finish fun_id core_args } + + ----------------------- + -- Warn about identities for (fromInteger :: Integer -> Integer) etc + -- They all have a type like: forall . => arg_ty -> res_ty + | idName fun_id `elem` numericConversionNames + , let (conv_ty, _) = apply_invis_args fun_id core_args + , Just (arg_ty, res_ty) <- splitVisibleFunTy_maybe conv_ty + = do { dflags <- getDynFlags + ; when (wopt Opt_WarnIdentities dflags + && arg_ty `eqType` res_ty) $ + -- So we are converting ty -> ty + diagnosticDs (DsIdentitiesFound fun_id conv_ty) + + ; ds_app_finish fun_id core_args } + + ----------------------- + -- Warn about unused return value in + -- do { ...; e; ... } when e returns (say) an Int + | fun_id `hasKey` thenMClassOpKey -- It is the built-in Prelude.(>>) + -- (>>) :: forall m. Monad m => forall a b. m a -> (b->m b) -> m b + , Type m_ty : _dict : Type arg_ty : _ <- core_args + , hs_arg : _ <- hs_args + = do { tracePm ">>" (ppr loc $$ ppr arg_ty $$ ppr (isGeneratedSrcSpan (locA loc))) + ; when (isGeneratedSrcSpan (locA loc)) $ -- It is a compiler-generated (>>) + warnDiscardedDoBindings hs_arg m_ty arg_ty + ; ds_app_finish fun_id core_args } + + ----------------------- + -- Deal with `noinline` + -- See Note [noinlineId magic] in GHC.Types.Id.Make + | fun_id `hasKey` noinlineIdKey + , Type _ : arg1 : rest_args <- core_args + , (inner_fun, inner_args) <- collectArgs arg1 + = return (Var fun_id `App` Type (exprType inner_fun) `App` inner_fun + `mkCoreApps` inner_args `mkCoreApps` rest_args) + + ----------------------- + -- Deal with `seq` + -- See Note [Desugaring seq], points (1) and (2) + | fun_id `hasKey` seqIdKey + , Type _r : Type ty1 : Type ty2 : arg1 : arg2 : rest_args <- core_args + , let case_bndr = case arg1 of + Var v1 | isInternalName (idName v1) + -> v1 -- Note [Desugaring seq], points (2) and (3) + _ -> mkWildValBinder ManyTy ty1 + = return (Case arg1 case_bndr ty2 [Alt DEFAULT [] arg2] + `mkCoreApps` rest_args) + + ----------------------- + -- Phew! No more special cases. Just build an applications + | otherwise + = ds_app_finish fun_id core_args + +--------------- +ds_app_finish :: Id -> [CoreExpr] -> DsM CoreExpr +-- We are about to construct an application that may include evidence applications +-- `f dict`. If the dictionary is non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. +-- See Note [Desugaring non-canonical evidence] +ds_app_finish fun_id core_args + = do { mb_unspecables <- getUnspecables + ; let fun_ty = idType fun_id + free_dicts = exprsFreeVarsList + [ e | (e,pi_bndr) <- core_args `zip` fst (splitPiTys fun_ty) + , isInvisibleAnonPiTyBinder pi_bndr ] + + fun | Just unspecables <- mb_unspecables + , not (isEmptyVarSet unspecables) -- Fast path + , any (`elemVarSet` unspecables) free_dicts + = Var nospecId `App` Type fun_ty `App` Var fun_id + | otherwise + = Var fun_id + + ; return (mkCoreApps fun core_args) } + +--------------- +ds_app_rec_sel :: Id -- The record selector Id itself + -> Id -- The function at the the head + -> [CoreExpr] -- Its arguments + -> DsM CoreExpr +-- Desugar an application with HsRecSelId at the head +ds_app_rec_sel sel_id fun_id core_args + | RecSelId{ sel_cons = rec_sel_info } <- idDetails sel_id + , RSI { rsi_undef = cons_wo_field } <- rec_sel_info + = do { -- Record selectors are warned about if they are not present in all of the + -- parent data type's constructors, or always in case of pattern synonym record + -- selectors (regulated by a flag). However, this only produces a warning if + -- it's not a part of a record selector application. For example: + -- data T = T1 | T2 {s :: Bool} + -- g y = map s y -- Warn here + -- f x = s x -- No warning here + ; let (fun_ty, val_args) = apply_invis_args fun_id core_args + + ; tracePm "ds_app_rec_sel" (ppr fun_ty $$ ppr val_args) + ; case val_args of + + -- There is a value argument + -- See (IRS2) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + (arg:_) -> pmcRecSel sel_id arg + + -- No value argument, but the selector is + -- applied to all its type arguments + -- See (IRS3) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + [] | Just (val_arg_ty, _) <- splitVisibleFunTy_maybe fun_ty + -> do { dummy <- newSysLocalDs (Scaled ManyTy val_arg_ty) + ; pmcRecSel sel_id (Var dummy) } + + -- Not even applied to all its type args + -- See (IRS4) of Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + _ -> unless (null cons_wo_field) $ + do { dflags <- getDynFlags + ; let maxCons = maxUncoveredPatterns dflags + ; diagnosticDs $ DsIncompleteRecordSelector (idName sel_id) cons_wo_field maxCons } + + ; ds_app_finish fun_id core_args } + + | otherwise + = pprPanic "ds_app_rec_sel" (ppr sel_id $$ ppr (idDetails sel_id)) + where + +apply_invis_args :: Id -> [CoreExpr] -> (Type, [CoreExpr]) +-- Apply function to the initial /type/ args; +-- return the type of the instantiated function, +-- and the remaining args +-- e.g. apply_type_args (++) [Type Int, Var xs] +-- = ([Int] -> [Int] -> [Int], [Var xs]) +apply_invis_args fun_id args + = (applyTypeToArgs fun_ty invis_args, rest_args) + where + fun_ty = idType fun_id + (invis_args, rest_args) = splitAt (invisibleBndrCount fun_ty) args + ------------------------------ +splitHsWrapperArgs :: HsWrapper -> [CoreArg] -> DsM (HsWrapper, [CoreArg]) +-- Splits the wrapper into the trailing arguments, and leftover bit +splitHsWrapperArgs wrap args = go wrap args + where + go (WpTyApp ty) args = return (WpHole, Type ty : args) + go (WpEvApp tm) args = do { core_tm <- dsEvTerm tm + ; return (WpHole, core_tm : args)} + go (WpCompose w1 w2) args + = do { (w1', args') <- go w1 args + ; if isIdHsWrapper w1' + then go w2 args' + else return (w1' <.> w2, args') } + go wrap args = return (wrap, args) + +------------------------------ +dsHsConLike :: ConLike -> DsM CoreExpr +dsHsConLike (RealDataCon dc) + = return (varToCoreExpr (dataConWrapId dc)) +dsHsConLike (PatSynCon ps) + | Just (builder_name, _, add_void) <- patSynBuilder ps + = do { builder_id <- dsLookupGlobalId builder_name + ; return (if add_void + then mkCoreApp (text "dsConLike" <+> ppr ps) + (Var builder_id) unboxedUnitExpr + else Var builder_id) } + | otherwise + = pprPanic "dsConLike" (ppr ps) + +------------------------------ dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr dsSyntaxExpr (SyntaxExprTc { syn_expr = expr , syn_arg_wraps = arg_wraps , syn_res_wrap = res_wrap }) arg_exprs - = do { fun <- dsExpr expr - ; dsHsWrappers arg_wraps $ \core_arg_wraps -> do - { dsHsWrapper res_wrap $ \core_res_wrap -> do - { let wrapped_args = zipWithEqual "dsSyntaxExpr" ($) core_arg_wraps arg_exprs - ; return $ core_res_wrap (mkCoreApps fun wrapped_args) } } } + = do { fun <- dsExpr expr + ; dsHsWrappers arg_wraps $ \core_arg_wraps -> + dsHsWrapper res_wrap $ \core_res_wrap -> + do { let wrapped_args = zipWithEqual ($) core_arg_wraps arg_exprs + ; return $ core_res_wrap (mkCoreApps fun wrapped_args) } } dsSyntaxExpr NoSyntaxExprTc _ = panic "dsSyntaxExpr" findField :: [LHsRecField GhcTc arg] -> Name -> [arg] @@ -639,6 +914,53 @@ {- %-------------------------------------------------------------------- +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When constructing an application + f @ty1 ty2 .. dict1 dict2 .. arg1 arg2 .. +if the evidence `dict_i` is canonical, we simply build that application. +But if any of the `dict_i` are /non-canonical/, we wrap the application +in `nospec`, thus + nospec @fty f @ty1 @ty2 .. dict1 dict2 .. arg1 arg2 .. +where nospec :: forall a. a -> a ensures that the typeclass specialiser +doesn't attempt to common up this evidence term with other evidence terms +of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). + +See Note [Coherence and specialisation: overview] in GHC.Core.InstEnv for +what a "non-canonical" dictionary is, and whe shouldn't specialise on it. + +How do we decide if the arguments are non-canonical dictionaries? + +* In `ds_app_finish` we look for dictionary arguments (invisible value args) + +* In the DsM monad we track the "unspecables" (i.e. non-canonical dictionaries) + in the `dsl_unspecable` field of `DsLclEnv` + +* We extend that unspecable set via `addUnspecables`, in `dsEvBinds`. + A dictionary is non-canonical if its own resolution was incoherent (see + Note [Incoherent instances]), or if its definition refers to other non-canonical + evidence. `dsEvBinds` is the convenient place to compute this, since it already + needs to do inter-evidence dependency analysis to generate well-scoped + bindings. + +Wrinkle: + +(NC1) We don't do this in the LHS of a RULE. In particular, if we have + f :: (Num a, HasCallStack) => a -> a + {-# SPECIALISE f :: Int -> Int #-} + then making a rule like + RULE forall d1:Num Int, d2:HasCallStack. + f @Int d1 d2 = $sf + is pretty dodgy, because $sf won't get the call stack passed in d2. + But that's what you asked for in the SPECIALISE pragma, so we'll obey. + + We definitely can't desugar that LHS into this! + nospec (f @Int d1) d2 + + This is done by zapping the unspecables in `dsRule` to Nothing. That `Nothing` + says not to collect unspecables at all. + + Note [Desugaring explicit lists] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Explicit lists are desugared in a cleverer way to prevent some @@ -745,10 +1067,12 @@ -} dsDo :: HsDoFlavour -> [ExprLStmt GhcTc] -> Type -> DsM CoreExpr --- SG: Surprisingly, this code path seems inactive for regular Do, +-- This code path seems inactive for regular Do, -- which is expanded in GHC.Tc.Gen.Do. --- It's all used for ApplicativeDo (even the BindStmt case), which is *very* +-- It is used only for ApplicativeDo (even the BindStmt case), which is *very* -- annoying because it is a lot of duplicated code that is seldomly tested. +-- But we are on course to expane Applicative in GHC.Tc.Gen.Do, at which +-- point all this will go away dsDo ctx stmts res_ty = goL stmts where @@ -761,7 +1085,9 @@ go _ (BodyStmt _ rhs then_expr _) stmts = do { rhs2 <- dsLExpr rhs - ; warnDiscardedDoBindings rhs (exprType rhs2) + ; case tcSplitAppTy_maybe (exprType rhs2) of + Just (m_ty, elt_ty) -> warnDiscardedDoBindings rhs m_ty elt_ty + Nothing -> return () -- Odd, but not warning ; rest <- goL stmts ; dsSyntaxExpr then_expr [rhs2, rest] } @@ -904,49 +1230,7 @@ because we already know 'y' is of the form "Just ...". See test case T21360b. -************************************************************************ -* * - Desugaring Variables -* * -************************************************************************ --} -dsHsVar :: Id -> DsM CoreExpr --- We could just call dsHsUnwrapped; but this is a short-cut --- for the very common case of a variable with no wrapper. -dsHsVar var - = return (varToCoreExpr var) -- See Note [Desugaring vars] - -dsHsConLike :: ConLike -> DsM CoreExpr -dsHsConLike (RealDataCon dc) - = return (varToCoreExpr (dataConWrapId dc)) -dsHsConLike (PatSynCon ps) - | Just (builder_name, _, add_void) <- patSynBuilder ps - = do { builder_id <- dsLookupGlobalId builder_name - ; return (if add_void - then mkCoreApp (text "dsConLike" <+> ppr ps) - (Var builder_id) unboxedUnitExpr - else Var builder_id) } - | otherwise - = pprPanic "dsConLike" (ppr ps) - --- | This function desugars 'ConLikeTc': it eta-expands --- data constructors to make linear types work. --- --- See Note [Typechecking data constructors] in GHC.Tc.Gen.Head -dsConLike :: ConLike -> [TcTyVar] -> [Scaled Type] -> DsM CoreExpr -dsConLike con tvs tys - = do { ds_con <- dsHsConLike con - ; ids <- newSysLocalsDs tys - -- NB: these 'Id's may be representation-polymorphic; - -- see Wrinkle [Representation-polymorphic lambda] in - -- Note [Typechecking data constructors] in GHC.Tc.Gen.Head. - ; return (mkLams tvs $ - mkLams ids $ - ds_con `mkTyApps` mkTyVarTys tvs - `mkVarApps` ids) } - -{- ************************************************************************ * * \subsection{Errors and contexts} @@ -955,84 +1239,30 @@ -} -- Warn about certain types of values discarded in monadic bindings (#3263) -warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM () -warnUnusedBindValue fun arg@(L loc _) arg_ty - | Just (l, f) <- fish_var fun - , f `hasKey` thenMClassOpKey -- it is a (>>) - = when (isGeneratedSrcSpan l) $ -- it is compiler generated (>>) - putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty - where - -- Retrieve the location info and the head of the application - -- It is important that we /do not/ look through HsApp to avoid - -- generating duplicate warnings - -- See Part 2. of Note [Expanding HsDo with XXExprGhcRn] - fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id) - fish_var (L l (HsVar _ id)) = return (locA l, unLoc id) - fish_var (L _ (HsAppType _ e _)) = fish_var e - fish_var (L l (XExpr (WrapExpr _ e))) = do (l, e') <- fish_var (L l e) - return (l, e') - fish_var (L l (XExpr (ExpandedThingTc _ e))) = fish_var (L l e) - fish_var _ = Nothing - -warnUnusedBindValue _ _ _ = return () - --- Warn about certain types of values discarded in monadic bindings (#3263) -warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> DsM () -warnDiscardedDoBindings rhs rhs_ty - | Just (m_ty, elt_ty) <- tcSplitAppTy_maybe rhs_ty +warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> Type -> DsM () +warnDiscardedDoBindings rhs m_ty elt_ty = do { warn_unused <- woptM Opt_WarnUnusedDoBind ; warn_wrong <- woptM Opt_WarnWrongDoBind ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty - - -- Warn about discarding non-() things in 'monadic' binding - ; if warn_unused && not (isUnitTy norm_elt_ty) + supressible_ty = + isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty + -- Warn about discarding things in 'monadic' binding, + -- however few types are excluded: + -- * Unit type `()` + -- * `ZonkAny` or `Any` type see (Any8) of Note [Any types] + ; if warn_unused && not supressible_ty then diagnosticDs (DsUnusedDoBind rhs elt_ty) else -- Warn about discarding m a things in 'monadic' binding of the same type, -- but only if we didn't already warn due to Opt_WarnUnusedDoBind + -- Example: do { return 3; blah } + -- We get (>>) @m d @(m Int) (return 3) blah when warn_wrong $ - case tcSplitAppTy_maybe norm_elt_ty of - Just (elt_m_ty, _) - | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty - -> diagnosticDs (DsWrongDoBind rhs elt_ty) - _ -> return () } } - - | otherwise -- RHS does have type of form (m ty), which is weird - = return () -- but at least this warning is irrelevant - -{- -************************************************************************ -* * - dsHsWrapped -* * -************************************************************************ --} - ------------------------------- -dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr -dsHsWrapped orig_hs_expr - = go idHsWrapper orig_hs_expr - where - go wrap (HsPar _ (L _ hs_e)) - = go wrap hs_e - go wrap1 (XExpr (WrapExpr wrap2 hs_e)) - = go (wrap1 <.> wrap2) hs_e - go wrap (HsAppType ty (L _ hs_e) _) - = go (wrap <.> WpTyApp ty) hs_e - - go wrap (HsVar _ (L _ var)) - = do { dsHsWrapper wrap $ \wrap' -> do - { let expr = wrap' (varToCoreExpr var) - ty = exprType expr - ; dflags <- getDynFlags - ; warnAboutIdentities dflags var ty - ; return expr } } - - go wrap hs_e - = do { dsHsWrapper wrap $ \wrap' -> do - { addTyCs FromSource (hsWrapDictBinders wrap) $ - do { e <- dsExpr hs_e - ; return (wrap' e) } } } + case tcSplitAppTy_maybe norm_elt_ty of + Just (elt_m_ty, _) + | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty + -> diagnosticDs (DsWrongDoBind rhs elt_ty) + _ -> return () } } diff --git a/GHC/HsToCore/Foreign/Call.hs b/GHC/HsToCore/Foreign/Call.hs --- a/GHC/HsToCore/Foreign/Call.hs +++ b/GHC/HsToCore/Foreign/Call.hs @@ -22,32 +22,37 @@ import GHC.Prelude import GHC.Core - -import GHC.HsToCore.Monad import GHC.Core.Utils import GHC.Core.Make -import GHC.Types.SourceText -import GHC.Types.Id.Make -import GHC.Types.ForeignCall import GHC.Core.DataCon -import GHC.HsToCore.Utils - -import GHC.Tc.Utils.TcType import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.Coercion -import GHC.Builtin.Types.Prim import GHC.Core.TyCon -import GHC.Builtin.Types +import GHC.Core.Predicate( tyCoVarsOfTypeWellScoped ) + +import GHC.HsToCore.Monad +import GHC.HsToCore.Utils + +import GHC.Types.SourceText +import GHC.Types.Id.Make +import GHC.Types.ForeignCall import GHC.Types.Basic import GHC.Types.Literal +import GHC.Types.RepType (typePrimRep1) + +import GHC.Tc.Utils.TcType + +import GHC.Builtin.Types.Prim +import GHC.Builtin.Types import GHC.Builtin.Names + import GHC.Driver.DynFlags + import GHC.Utils.Outputable import GHC.Utils.Panic import Data.Maybe -import GHC.Types.RepType (typePrimRep1) {- Desugaring of @ccall@s consists of adding some state manipulation, @@ -143,7 +148,7 @@ (isUnboxedTupleType arg_ty && typePrimRep1 arg_ty == VoidRep) = return (arg, \body -> body) - -- Recursive newtypes + -- Possibly-recursive newtypes | Just(co, _rep_ty) <- topNormaliseNewType_maybe arg_ty = unboxArg (mkCastDs arg co) @@ -336,8 +341,10 @@ -- Data types with a single constructor, which has a single arg -- This includes types like Ptr and ForeignPtr | Just (tycon, tycon_arg_tys) <- maybe_tc_app - , Just data_con <- tyConSingleAlgDataCon_maybe tycon -- One constructor - , null (dataConExTyCoVars data_con) -- no existentials + , not (isNewTyCon tycon) -- Newtypes should have been dealt with above, but + -- a recursive one might fall through here, I think + , Just data_con <- tyConSingleDataCon_maybe tycon -- One constructor + , null (dataConExTyCoVars data_con) -- no existentials , [Scaled _ unwrapped_res_ty] <- dataConInstOrigArgTys data_con tycon_arg_tys -- One argument = do { (maybe_ty, wrapper) <- resultWrapper unwrapped_res_ty ; let marshal_con e = Var (dataConWrapId data_con) diff --git a/GHC/HsToCore/Foreign/JavaScript.hs b/GHC/HsToCore/Foreign/JavaScript.hs --- a/GHC/HsToCore/Foreign/JavaScript.hs +++ b/GHC/HsToCore/Foreign/JavaScript.hs @@ -265,7 +265,7 @@ (tvs,sans_foralls) = tcSplitForAllTyVars ty ([scaled_arg_ty], fn_res_ty) = tcSplitFunTys sans_foralls arg_ty = scaledThing scaled_arg_ty - (io_tc, res_ty) = expectJust "dsJsFExportDynamic: IO type expected" + (io_tc, res_ty) = expectJust -- Must have an IO type; hence Just $ tcSplitIOType_maybe fn_res_ty mod <- getModule @@ -647,6 +647,6 @@ mkJsCall u tgt args t = mkFCall u ccall args t where ccall = CCall $ CCallSpec - (StaticTarget NoSourceText tgt (Just primUnit) True) + (StaticTarget NoSourceText tgt (Just ghcInternalUnit) True) JavaScriptCallConv PlayRisky diff --git a/GHC/HsToCore/GuardedRHSs.hs b/GHC/HsToCore/GuardedRHSs.hs --- a/GHC/HsToCore/GuardedRHSs.hs +++ b/GHC/HsToCore/GuardedRHSs.hs @@ -24,13 +24,12 @@ import GHC.HsToCore.Utils import GHC.HsToCore.Pmc.Types ( Nablas ) import GHC.Core.Type ( Type ) -import GHC.Utils.Misc import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.Multiplicity -import Control.Monad ( zipWithM ) -import Data.List.NonEmpty ( NonEmpty, toList ) +import Data.List.NonEmpty ( NonEmpty ) +import qualified GHC.Data.List.NonEmpty as NE {- @dsGuarded@ is used for GRHSs. @@ -62,9 +61,8 @@ -- one for each GRHS. -> DsM (MatchResult CoreExpr) dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_nablas - = assert (notNull grhss) $ - do { match_results <- assert (length grhss == length rhss_nablas) $ - zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_nablas) grhss + = do { match_results <- assert (length grhss == length rhss_nablas) $ + NE.zipWithM (dsGRHS hs_ctx rhs_ty) rhss_nablas grhss ; nablas <- getPmNablas -- We need to remember the Nablas from the particular match context we -- are in, which might be different to when dsLocalBinds is actually diff --git a/GHC/HsToCore/ListComp.hs b/GHC/HsToCore/ListComp.hs --- a/GHC/HsToCore/ListComp.hs +++ b/GHC/HsToCore/ListComp.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {- @@ -36,6 +36,8 @@ import GHC.Tc.Utils.TcType import GHC.Data.List.SetOps( getNth ) +import Data.Foldable ( toList ) + {- List comprehensions may be desugared in one of two ways: ``ordinary'' (as you would expect if you read SLPJ's book) and ``with foldr/build @@ -243,13 +245,13 @@ = do { exps_and_qual_tys <- mapM dsInnerListComp stmtss_w_bndrs ; let (exps, qual_tys) = unzip exps_and_qual_tys - ; (zip_fn, zip_rhs) <- mkZipBind qual_tys + ; (zip_fn, zip_rhs) <- mkZipBind (toList qual_tys) -- Deal with [e | pat <- zip l1 .. ln] in example above - ; deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps)) + ; deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) (toList exps))) quals list } where - bndrs_s = [bs | ParStmtBlock _ _ bs _ <- stmtss_w_bndrs] + bndrs_s = [bs | ParStmtBlock _ _ bs _ <- toList stmtss_w_bndrs] -- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above pat = mkBigLHsPatTupId pats @@ -563,8 +565,11 @@ = do { exps_w_tys <- mapM ds_inner blocks -- Pairs (exp :: m ty, ty) ; mzip_op' <- dsExpr mzip_op - ; let -- The pattern variables - pats = [ mkBigLHsVarPatTupId bs | ParStmtBlock _ _ bs _ <- blocks] + ; let parStmtBlockIds :: ParStmtBlock GhcTc GhcTc -> [Id] + parStmtBlockIds = \ case + ParStmtBlock _ _ bs _ -> bs + -- The pattern variables + pats = fmap (mkBigLHsVarPatTupId . parStmtBlockIds) blocks -- Pattern with tuples of variables -- [v1,v2,v3] => (v1, (v2, v3)) pat = foldr1 (\p1 p2 -> mkLHsPatTup [p1, p2]) pats diff --git a/GHC/HsToCore/Match.hs b/GHC/HsToCore/Match.hs --- a/GHC/HsToCore/Match.hs +++ b/GHC/HsToCore/Match.hs @@ -77,7 +77,7 @@ import GHC.Types.Unique.DFM import Control.Monad ( zipWithM, unless ) -import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map @@ -194,9 +194,7 @@ -> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below) -> DsM (MatchResult CoreExpr) -- ^ Desugared result! -match [] ty eqns - = assertPpr (not (null eqns)) (ppr ty) $ - combineEqnRhss (NE.fromList eqns) +match [] ty eqns = maybe (assertPprPanic (ppr ty)) combineEqnRhss $ nonEmpty eqns match (v:vs) ty eqns -- Eqns can be empty, but each equation is nonempty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -303,7 +301,7 @@ -- compile the view expressions ; viewExpr' <- dsExpr viewExpr ; return (mkViewMatchResult var' - (mkCoreAppDs (text "matchView") viewExpr' (Var var)) + (mkCoreApp (text "matchView") viewExpr' (Var var)) match_result) } -- decompose the first pattern and leave the rest alone @@ -529,7 +527,7 @@ mk_match lpat body = noLocA $ Match noExtField CaseAlt (noLocA [lpat]) (single_grhs body) hs_var :: Var -> LHsExpr GhcTc - hs_var v = (noLocA $ HsVar noExtField (noLocA v)) + hs_var v = noLocA $ mkHsVar (noLocA v) single_grhs :: LHsExpr GhcTc -> GRHSs GhcTc (LHsExpr GhcTc) single_grhs e = GRHSs emptyComments [noLocA $ GRHS noAnn [] e] (EmptyLocalBinds noExtField) @@ -599,9 +597,9 @@ -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc -- See Note [Bang patterns and newtypes] -- We are transforming !(N p) into (N !p) -push_bang_into_newtype_arg l _ty (PrefixCon ts (arg:args)) +push_bang_into_newtype_arg l _ty (PrefixCon (arg:args)) = assert (null args) $ - PrefixCon ts [L l (BangPat noExtField arg)] + PrefixCon [L l (BangPat noExtField arg)] push_bang_into_newtype_arg l _ty (RecCon rf) | HsRecFields { rec_flds = L lf fld : flds } <- rf , HsFieldBind { hfbRHS = arg } <- fld @@ -610,7 +608,7 @@ = L l (BangPat noExtField arg) })] }) push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {}) | HsRecFields { rec_flds = [] } <- rf - = PrefixCon [] [L l (BangPat noExtField (noLocA (WildPat ty)))] + = PrefixCon [L l (BangPat noExtField (noLocA (WildPat ty)))] push_bang_into_newtype_arg _ _ cd = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd) @@ -801,7 +799,7 @@ ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys (m:_) -> - selectMatchVars (zipWithEqual "matchWrapper" + selectMatchVars (zipWithEqual (\a b -> (scaledMult a, unLoc b)) arg_tys (hsLMatchPats m)) @@ -859,10 +857,7 @@ = map (\(L _ m) -> (ldi_nablas, initNablasGRHSs ldi_nablas (m_grhss m))) ms initNablasGRHSs :: Nablas -> GRHSs GhcTc b -> NonEmpty Nablas - initNablasGRHSs ldi_nablas m - = expectJust "GRHSs non-empty" - $ NE.nonEmpty - $ replicate (length (grhssGRHSs m)) ldi_nablas + initNablasGRHSs ldi_nablas m = ldi_nablas <$ grhssGRHSs m {- Note [Long-distance information in matchWrapper] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1225,7 +1220,7 @@ , syn_arg_wraps = arg_wraps2 , syn_res_wrap = res_wrap2 }) = exp expr1 expr2 && - and (zipWithEqual "viewLExprEq" wrap arg_wraps1 arg_wraps2) && + and (zipWithEqual wrap arg_wraps1 arg_wraps2) && wrap res_wrap1 res_wrap2 syn_exp NoSyntaxExprTc NoSyntaxExprTc = True syn_exp _ _ = False diff --git a/GHC/HsToCore/Match/Constructor.hs b/GHC/HsToCore/Match/Constructor.hs --- a/GHC/HsToCore/Match/Constructor.hs +++ b/GHC/HsToCore/Match/Constructor.hs @@ -182,7 +182,7 @@ -- Divide into sub-groups; see Note [Record patterns] ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfoNE)) groups = NE.groupBy1 compatible_pats - $ fmap (\eqn -> (pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) + $ fmap (\eqn -> (con_pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) ; match_results <- mapM (match_group arg_vars) groups @@ -191,6 +191,10 @@ alt_wrapper = wrapper1, alt_result = foldr1 combineMatchResults match_results } } where + con_pat_args :: Pat GhcTc -> HsConPatDetails GhcTc + con_pat_args (ConPat { pat_args = args }) = args + con_pat_args p = pprPanic "matchOneConLike" (ppr p) -- All patterns are ConPats + ConPat { pat_con = L _ con1 , pat_args = args1 , pat_con_ext = ConPatTc @@ -217,7 +221,7 @@ | otherwise = arg_vars where - fld_var_env = mkNameEnv $ zipEqual "get_arg_vars" fields1 arg_vars + fld_var_env = mkNameEnv $ zipEqual fields1 arg_vars lookup_fld (L _ rpat) = lookupNameEnv_NF fld_var_env (idName (hsRecFieldId rpat)) @@ -243,17 +247,17 @@ selectConMatchVars arg_tys con = case con of RecCon {} -> newSysLocalsDs arg_tys - PrefixCon _ ps -> selectMatchVars (zipMults arg_tys ps) + PrefixCon ps -> selectMatchVars (zipMults arg_tys ps) InfixCon p1 p2 -> selectMatchVars (zipMults arg_tys [p1, p2]) where - zipMults = zipWithEqual "selectConMatchVar" (\a b -> (scaledMult a, unLoc b)) + zipMults = zipWithEqual (\a b -> (scaledMult a, unLoc b)) conArgPats :: [Scaled Type]-- Instantiated argument types -- Used only to fill in the types of WildPats, which -- are probably never looked at anyway -> ConArgPats -> [LPat GhcTc] -conArgPats _arg_tys (PrefixCon _ ps) = ps +conArgPats _arg_tys (PrefixCon ps) = ps conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2] conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats })) | null rpats = map (noLocA . WildPat . scaledThing) arg_tys diff --git a/GHC/HsToCore/Match/Literal.hs b/GHC/HsToCore/Match/Literal.hs --- a/GHC/HsToCore/Match/Literal.hs +++ b/GHC/HsToCore/Match/Literal.hs @@ -18,7 +18,7 @@ ( dsLit, dsOverLit, hsLitKey , tidyLitPat, tidyNPat , matchLiterals, matchNPlusKPats, matchNPats - , warnAboutIdentities + , numericConversionNames , warnAboutOverflowedOverLit, warnAboutOverflowedLit , warnAboutEmptyEnumerations ) @@ -61,16 +61,15 @@ import GHC.Driver.DynFlags import GHC.Utils.Outputable as Outputable -import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Unique (sameUnique) import GHC.Data.FastString +import qualified GHC.Data.List.NonEmpty as NEL import Control.Monad import Data.Int import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NEL import Data.Word import GHC.Real ( Ratio(..), numerator, denominator ) @@ -97,7 +96,7 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc. -} -dsLit :: HsLit GhcRn -> DsM CoreExpr +dsLit :: forall p. IsPass p => HsLit (GhcPass p) -> DsM CoreExpr dsLit l = do dflags <- getDynFlags let platform = targetPlatform dflags @@ -122,9 +121,11 @@ HsChar _ c -> return (mkCharExpr c) HsString _ str -> mkStringExprFS str HsMultilineString _ str -> mkStringExprFS str - HsInteger _ i _ -> return (mkIntegerExpr platform i) HsInt _ i -> return (mkIntExpr platform (il_value i)) - HsRat _ fl ty -> dsFractionalLitToRational fl ty + XLit x -> case ghcPass @p of + GhcTc -> case x of + HsInteger _ i _ -> return (mkIntegerExpr platform i) + HsRat fl ty -> dsFractionalLitToRational fl ty {- Note [FractionalLit representation] @@ -275,23 +276,13 @@ same. Then it's probably (albeit not definitely) the identity -} -warnAboutIdentities :: DynFlags -> Id -> Type -> DsM () -warnAboutIdentities dflags conv_fn type_of_conv - | wopt Opt_WarnIdentities dflags - , idName conv_fn `elem` conversionNames - , Just (_, _, arg_ty, res_ty) <- splitFunTy_maybe type_of_conv - , arg_ty `eqType` res_ty -- So we are converting ty -> ty - = diagnosticDs (DsIdentitiesFound conv_fn type_of_conv) -warnAboutIdentities _ _ _ = return () - -conversionNames :: [Name] -conversionNames +numericConversionNames :: [Name] +numericConversionNames = [ toIntegerName, toRationalName , fromIntegralName, realToFracName ] -- We can't easily add fromIntegerName, fromRationalName, -- because they are generated by literals - -- | Emit warnings on overloaded integral literals which overflow the bounds -- implied by their type. warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM () @@ -460,24 +451,24 @@ -- | If 'Integral', extract the value and type of the non-overloaded literal. getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Type) getSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTy) -getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTy) -getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTy) -getSimpleIntegralLit (HsInt8Prim _ i) = Just (i, int8PrimTy) -getSimpleIntegralLit (HsInt16Prim _ i) = Just (i, int16PrimTy) -getSimpleIntegralLit (HsInt32Prim _ i) = Just (i, int32PrimTy) -getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTy) -getSimpleIntegralLit (HsWord8Prim _ i) = Just (i, word8PrimTy) -getSimpleIntegralLit (HsWord16Prim _ i) = Just (i, word16PrimTy) -getSimpleIntegralLit (HsWord32Prim _ i) = Just (i, word32PrimTy) -getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTy) -getSimpleIntegralLit (HsInteger _ i ty) = Just (i, ty) +getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTy) +getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTy) +getSimpleIntegralLit (HsInt8Prim _ i) = Just (i, int8PrimTy) +getSimpleIntegralLit (HsInt16Prim _ i) = Just (i, int16PrimTy) +getSimpleIntegralLit (HsInt32Prim _ i) = Just (i, int32PrimTy) +getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTy) +getSimpleIntegralLit (HsWord8Prim _ i) = Just (i, word8PrimTy) +getSimpleIntegralLit (HsWord16Prim _ i) = Just (i, word16PrimTy) +getSimpleIntegralLit (HsWord32Prim _ i) = Just (i, word32PrimTy) +getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTy) +getSimpleIntegralLit (XLit (HsInteger _ i ty)) = Just (i, ty) getSimpleIntegralLit HsChar{} = Nothing getSimpleIntegralLit HsCharPrim{} = Nothing getSimpleIntegralLit HsString{} = Nothing getSimpleIntegralLit HsMultilineString{} = Nothing getSimpleIntegralLit HsStringPrim{} = Nothing -getSimpleIntegralLit HsRat{} = Nothing +getSimpleIntegralLit (XLit (HsRat{})) = Nothing getSimpleIntegralLit HsFloatPrim{} = Nothing getSimpleIntegralLit HsDoublePrim{} = Nothing @@ -721,8 +712,8 @@ ; lit2_expr <- dsOverLit lit2 ; pred_expr <- dsSyntaxExpr ge [Var var, lit1_expr] ; minusk_expr <- dsSyntaxExpr minus [Var var, lit2_expr] - ; let (wraps, eqns') = mapAndUnzip (shift n1) (eqn1:eqns) - ; match_result <- match vars ty eqns' + ; let (wraps, eqns') = NEL.mapAndUnzip (shift n1) (eqn1:|eqns) + ; match_result <- match vars ty (NEL.toList eqns') ; return (mkGuardedMatchResult pred_expr $ mkCoLetMatchResult (NonRec n1 minusk_expr) $ fmap (foldr1 (.) wraps) $ diff --git a/GHC/HsToCore/Monad.hs b/GHC/HsToCore/Monad.hs --- a/GHC/HsToCore/Monad.hs +++ b/GHC/HsToCore/Monad.hs @@ -26,7 +26,7 @@ mkNamePprCtxDs, newUnique, UniqSupply, newUniqueSupply, - getGhcModeDs, dsGetFamInstEnvs, + getGhcModeDs, dsGetFamInstEnvs, dsGetGlobalRdrEnv, dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon, dsLookupConLike, getCCIndexDsM, @@ -37,7 +37,7 @@ getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addUnspecables, getUnspecables, + addUnspecables, getUnspecables, zapUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -45,7 +45,6 @@ -- Warnings and errors DsWarning, diagnosticDs, errDsCoreExpr, failWithDs, failDs, discardWarningsDs, - addMessagesDs, captureMessagesDs, -- Data types DsMatchContext(..), @@ -95,7 +94,8 @@ import GHC.Types.Name.Reader import GHC.Types.SourceFile import GHC.Types.Id -import GHC.Types.Var (EvId) +import GHC.Types.Var (EvVar) +import GHC.Types.Var.Set( VarSet, emptyVarSet, extendVarSetList ) import GHC.Types.SrcLoc import GHC.Types.TypeEnv import GHC.Types.Unique.Supply @@ -118,7 +118,6 @@ import Data.IORef import GHC.Driver.Env.KnotVars -import qualified Data.Set as S import GHC.IO.Unsafe (unsafeInterleaveIO) {- @@ -157,6 +156,7 @@ type EquationInfoNE = EquationInfo -- An EquationInfo which has at least one pattern +-- i.e. it's an EqnMatch, not EqnDone prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo prependPats [] eqn = eqn @@ -266,17 +266,20 @@ ptc = initPromotionTickContext (hsc_dflags hsc_env) -- re-use existing next_wrapper_num to ensure uniqueness next_wrapper_num_var = tcg_next_wrapper_num tcg_env + tcg_comp_env = tcg_complete_match_env tcg_env ; ds_complete_matches <- liftIO $ unsafeInterleaveIO $ + -- Note [Lazily loading COMPLETE pragmas] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- This call to 'unsafeInterleaveIO' ensures we only do this work -- when we need to look at the COMPLETE pragmas, avoiding doing work -- when we don't need them. -- -- Relevant test case: MultiLayerModulesTH_Make, which regresses -- in allocations by ~5% if we don't do this. - traverse (lookupCompleteMatch type_env hsc_env) $ - localAndImportedCompleteMatches (tcg_complete_matches tcg_env) hsc_env eps + traverse (lookupCompleteMatch type_env hsc_env) =<< + localAndImportedCompleteMatches tcg_comp_env eps ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num_var ds_complete_matches } @@ -333,8 +336,8 @@ bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds ids = concatMap bindsToIds binds - ; ds_complete_matches <- traverse (lookupCompleteMatch type_env hsc_env) $ - localAndImportedCompleteMatches local_complete_matches hsc_env eps + ; ds_complete_matches <- traverse (lookupCompleteMatch type_env hsc_env) =<< + localAndImportedCompleteMatches local_complete_matches eps ; let envs = mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var @@ -406,7 +409,7 @@ lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_unspecables = mempty + , dsl_unspecables = Just emptyVarSet } in (gbl_env, lcl_env) @@ -469,10 +472,17 @@ updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addUnspecables :: S.Set EvId -> DsM a -> DsM a -addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) +addUnspecables :: [EvVar] -> DsM a -> DsM a +addUnspecables new_unspecables + = updLclEnv (\env -> case dsl_unspecables env of + Nothing -> env + Just us -> env { dsl_unspecables + = Just (us `extendVarSetList` new_unspecables) }) -getUnspecables :: DsM (S.Set EvId) +zapUnspecables :: DsM a -> DsM a +zapUnspecables = updLclEnv (\env -> env{ dsl_unspecables = Nothing }) + +getUnspecables :: DsM (Maybe VarSet) getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan @@ -499,12 +509,6 @@ ; let msg = mkMsgEnvelope diag_opts loc (ds_name_ppr_ctx env) dsMessage ; updMutVar (ds_msgs env) (\ msgs -> msg `addMessage` msgs) } -addMessagesDs :: Messages DsMessage -> DsM () -addMessagesDs msgs1 - = do { msg_var <- ds_msgs <$> getGblEnv - ; msgs0 <- liftIO $ readIORef msg_var - ; liftIO $ writeIORef msg_var (msgs0 `unionMessages` msgs1) } - -- | Issue an error, but return the expression for (), so that we can continue -- reporting errors. errDsCoreExpr :: DsMessage -> DsM CoreExpr @@ -520,13 +524,6 @@ failDs :: DsM a failDs = failM -captureMessagesDs :: DsM a -> DsM (Messages DsMessage, a) -captureMessagesDs thing_inside - = do { msg_var <- liftIO $ newIORef emptyMessages - ; res <- updGblEnv (\gbl -> gbl {ds_msgs = msg_var}) thing_inside - ; msgs <- liftIO $ readIORef msg_var - ; return (msgs, res) } - mkNamePprCtxDs :: DsM NamePprCtx mkNamePprCtxDs = ds_name_ppr_ctx <$> getGblEnv @@ -566,6 +563,9 @@ dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } + +dsGetGlobalRdrEnv :: DsM GlobalRdrEnv +dsGetGlobalRdrEnv = ds_gbl_rdr_env <$> getGblEnv -- | The @COMPLETE@ pragmas that are in scope. dsGetCompleteMatches :: DsM DsCompleteMatches diff --git a/GHC/HsToCore/Pmc.hs b/GHC/HsToCore/Pmc.hs --- a/GHC/HsToCore/Pmc.hs +++ b/GHC/HsToCore/Pmc.hs @@ -133,7 +133,7 @@ -> DsM (NonEmpty Nablas) -- ^ Covered 'Nablas' for each RHS, for long -- distance info pmcGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do - let combined_loc = foldl1 combineSrcSpans (map getLocA grhss) + let combined_loc = foldl1 combineSrcSpans (NE.map getLocA grhss) ctxt = DsMatchContext hs_ctxt combined_loc !missing <- getLdiNablas matches <- noCheckDs $ desugarGRHSs combined_loc empty guards @@ -201,85 +201,197 @@ {- Note [Detecting incomplete record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A record selector occurrence is incomplete iff. it could fail due to -being applied to a data type constructor not present for this record field. +This Note describes the implementation of +GHC proposal 516 "Add warning for incomplete record selectors". -e.g. - data T = T1 | T2 {x :: Int} - d = x someComputation -- `d` may fail +A **partial field** is a field that does not belong to every constructor of the +corresponding datatype. +A **partial selector occurrence** is a use of a record selector for a partial +field, either as a selector function in an expression, or as the solution to a +HasField constraint. -There are 4 parts to detecting and warning about -incomplete record selectors to consider: +Partial selector occurrences desugar to case expressions which may crash at +runtime: - - Computing which constructors a general application of a record field will succeed on, - and which ones it will fail on. This is stored in the `sel_cons` field of - `IdDetails` datatype, which is a part of an `Id` and calculated when renaming a - record selector in `mkOneRecordSelector` + data T a where + T1 :: T Int + T2 {sel :: Int} :: T Bool - - Emitting a warning whenever a `HasField` constraint is solved. - This is checked in `matchHasField` and emitted only for when - the constraint is resolved with an implicit instance rather than a - custom one (since otherwise the warning will be emitted in - the custom implementation anyways) + urgh :: T a -> Int + urgh x = sel x + ===> + urgh x = case x of + T1 -> error "no record field sel" + T2 f -> f - e.g. - g :: HasField "x" t Int => t -> Int - g = getField @"x" +As such, it makes sense to warn about such potential crashes. +We do so whenever -Wincomplete-record-selectors is present, and we utilise +the pattern-match coverage checker for precise results, because there are many +uses of selectors for partial fields which are in fact dynamically safe. - f :: T -> Int - f = g -- warning will be emitted here +Pmc can detect two very common safe uses for which we will not warn: - - Emitting a warning for a general occurrence of the record selector - This is done during the renaming of a `HsRecSel` expression in `dsExpr` - and simply pulls the information about incompleteness from the `Id` + (LDI) Ambient pattern-matches unleash Note [Long-distance information] that + render a naively flagged partial selector occurrence safe, as in + ldi :: T a -> Int + ldi T1 = 0 + ldi arg = sel arg + We should not warn here, because `arg` cannot be `T1`. - e.g. - l :: T -> Int - l a = x a -- warning will be emitted here + (RES) Constraining the result type of a GADT such as T might render + naively flagged partial selector occurrences safe, as in + resTy :: T Bool -> Int + resTy = sel + Here, `T1 :: T Int` is ruled out because it has the wrong result type. - - Emitting a warning for a record selector `sel` applied to a variable `y`. - In that case we want to use the long-distance information from the - pattern match checker to rule out impossible constructors - (See Note [Long-distance information]). We first add constraints to - the long-distance `Nablas` that `y` cannot be one of the constructors that - contain `sel` (function `checkRecSel` in GHC.HsToCore.Pmc.Check). If the - `Nablas` are still inhabited, we emit a warning with the inhabiting constructors - as examples of where `sel` may fail. +Additionally, we want to support incomplete -XOverloadedRecordDot access as +well, in either the (LDI) use case or the (RES) use case: - e.g. - z :: T -> Int - z T1 = 0 - z a = x a -- warning will not be emitted here since `a` can only be `T2` + data Dot = No | Yes { sel2 :: Int } + dot d = d.sel2 -- should warn + ldiDot No = 0 + ldiDot d = d.sel2 -- should not warn + resTyDot :: T Bool -> Int + resTyDot x = x.sel -- should not warn + +From a user's point of view, function `ldiDot` looks very like example `ldi` and +`resTyDot` looks very like `resTy`. But from an /implementation/ point of view +they are very different: both `ldiDot` and `resTyDot` simply emit `HasField` +constraints, and it is those constraints that the implementation must use to +determine incompleteness. + +Furthermore, HasField constraints allow to delay the completeness check from +the field access site to a caller, as in test cases TcIncompleteRecSel and T24891: + + accessDot :: HasField "sel2" t Int => t -> Int + accessDot x = x.sel2 -- getField @Symbol @"sel2" @t @Int x + solveDot :: Dot -> Int + solveDot = accessDot + +We should warn in `solveDot`, but not in `accessDot`. + +Here is how we achieve all this in the implementation: + +(IRS1) When renaming a record selector in `mkOneRecordSelector`, + we precompute the constructors the selector succeeds on. + That would be `T2` for `sel` because `sel (T2 42)` succeeds, + and `Yes` for `sel2` because `sel2 (Yes 13)` succeeds. + We store this information in the `sel_cons` field of `RecSelId`. + (Remember, the same field may occur in several constructors of the data + type; hence the selector may succeed on more than one constructor.) + +We generate warnings for incomplete record selectors in two places: +* Mainly: in GHC.HsToCore.Expr.ds_app (see (IRS2-5) below) +* Plus: in GHC.Tc.Instance.Class.matchHassField (see (IRS6-7) below) + +(IRS2) In function `ldi`, we have a record selector application `sel arg`. + This situation is detected `GHC.HsToCore.Expr.ds_app_rec_sel`, when the + record selector is applied to at least one argument. We call out to the + pattern-match checker to determine whether use of the selector is safe, + by calling GHC.HsToCore.Pmc.pmcRecSel, passing the `RecSelId` `sel` as + well as `arg`. + + The pattern-match checker reduces the partial-selector-occurrence problem to + a complete-match problem by adding a negative constructor constraint such as + `arg /~ T2` for every constructor in the precomputed `rsi_def . sel_cons` of + `sel`. (Recall that these were exactly the constructors which define a field + `sel`.) `pmcRecSel` then tests + case arg of {} + for completeness. Any incomplete match, such as in the original `urgh`, must + reference a constructor that does not have field `sel`, such as `T1`. + + In case of `urgh`, `T1` is indeed the case that we report as inexhaustive. + + However, in function `ldi`, we have *both* the result type of + `arg::T a` (boring, but see (IRS3)) as well as Note [Long-distance information] + about `arg` from the ambient match, and the latter lists the constraint + `arg /~ T1`. Consequently, since `arg` is neither `T1` nor `T2` in the + reduced problem, the match is exhaustive and the use of the record selector + safe. + +(IRS3) In function `resTy`, the record selector is unsaturated, but the result type + ensures a safe use of the selector. + + This situation is also detected in `GHC.HsToCore.Expr.ds_app_rec_sel`. + THe selector is elaborated with its type arguments; we simply match on + desugared Core `sel @Bool :: T Bool -> Int` to learn the result type `T Bool`. + We again call `pmcRecSel`, but this time with a fresh dummy Id `ds::T Bool`. + +(IRS4) In case of an unsaturated record selector that is *not* applied to any type + argument after elaboration (e.g. in `urgh2 = sel2 :: Dot -> Int`), we simply + produce a warning about all `sel_cons`; no need to call `pmcRecSel`. + This happens in `ds_app_rec_sel` + +Finally, there are two more items addressing -XOverloadedRecordDot: + +(IRS5) With -XOverloadedDot, all occurrences of (r.x), such as in `ldiDot` and + `accessDot` above, are warned about as follows. `r.x` is parsed as + `HsGetField` in `HsExpr`; which is then expanded (in `rnExpr`) to a call to + `getField`. For example, consider: + ldiDot No = 0 + ldiDot x = x.sel2 -- should not warn + The `d.sel2` in the RHS generates + getField @GHC.Types.Symbol @"sel2" @Dot @Int + ($dHasField :: HasField "sel2" Dot Int) x + where + $dHasField = sel2 |> (co :: Dot -> Int ~R# HasField "sel2" Dot Int) + We spot this `getField` application in `GHC.HsToCore.Expr.ds_app_var`, + and treat it exactly like (IRS2) and (IRS3). + + Note carefully that doing this in the desugarer allows us to account for the + long-distance info about `x`; even though `sel2` is partial, we don't want + to warn about `x.sel2` in this example. + +(IRS6) Finally we have + solveDot :: Dot -> Int + solveDot = accessDot + No field-accesses or selectors in sight! From the RHS we get the constraint + [W] HasField @"sel2" @Dot @Int` + The only time we can generate a warning is when we solve this constraint, + in `GHC.Tc.Instance.Class.matchHasField`, generating a call to the (partial) + selector. We have no hope of exploiting long-distance info here. + +(IRS7) BUT, look back at `ldiDot`. Doesn't `matchHasField` /also/ generate a + warning for the `HasField` constraint arising from `x.sel2`? We don't + want that, because the desugarer will catch it: see (IRS5). So we suppress + the (IRS6) warning in the typechecker for a `HasField` constraint that + arises from a record-dot HsGetField occurrence. Happily, this is easy to do + by looking at its `CtOrigin`. Tested in T24891. -} pmcRecSel :: Id -- ^ Id of the selector -> CoreExpr -- ^ Core expression of the argument to the selector -> DsM () +-- See (IRS2,3) in Note [Detecting incomplete record selectors] pmcRecSel sel_id arg - | RecSelId{ sel_cons = (cons_w_field, _ : _) } <- idDetails sel_id = do - !missing <- getLdiNablas + | RecSelId{ sel_cons = rec_sel_info } <- idDetails sel_id + , RSI { rsi_def = cons_w_field, rsi_undef = cons_wo_field } <- rec_sel_info + , not (null cons_wo_field) + = do { !missing <- getLdiNablas - tracePm "pmcRecSel {" (ppr sel_id) - CheckResult{ cr_ret = PmRecSel{ pr_arg_var = arg_id }, cr_uncov = uncov_nablas } - <- unCA (checkRecSel (PmRecSel () arg cons_w_field)) missing - tracePm "}: " $ ppr uncov_nablas + ; tracePm "pmcRecSel {" (ppr sel_id) + ; CheckResult{ cr_ret = PmRecSel{ pr_arg_var = arg_id }, cr_uncov = uncov_nablas } + <- unCA (checkRecSel (PmRecSel () arg cons_w_field)) missing + ; tracePm "}: " $ ppr uncov_nablas - inhabited <- isInhabited uncov_nablas - when inhabited $ warn_incomplete arg_id uncov_nablas - where - sel_name = varName sel_id - warn_incomplete arg_id uncov_nablas = do - dflags <- getDynFlags - let maxConstructors = maxUncoveredPatterns dflags - unc_examples <- getNFirstUncovered MinimalCover [arg_id] (maxConstructors + 1) uncov_nablas - let cons = [con | unc_example <- unc_examples - , Just (PACA (PmAltConLike con) _ _) <- [lookupSolution unc_example arg_id]] - not_full_examples = length cons == (maxConstructors + 1) - cons' = take maxConstructors cons - diagnosticDs $ DsIncompleteRecordSelector sel_name cons' not_full_examples + ; inhabited <- isInhabited uncov_nablas + ; when inhabited $ warn_incomplete arg_id uncov_nablas } -pmcRecSel _ _ = return () + | otherwise + = return () + where + sel_name = varName sel_id + warn_incomplete arg_id uncov_nablas = do + dflags <- getDynFlags + let maxPatterns = maxUncoveredPatterns dflags + unc_examples <- getNFirstUncovered MinimalCover [arg_id] (maxPatterns + 1) uncov_nablas + let cons = [con | unc_example <- unc_examples + , Just (PACA (PmAltConLike con) _ _) <- [lookupSolution unc_example arg_id]] + tracePm "unc-ex" (ppr cons $$ ppr unc_examples) + diagnosticDs $ DsIncompleteRecordSelector sel_name cons maxPatterns + + {- Note [pmcPatBind doesn't warn on pattern guards] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @pmcPatBind@'s main purpose is to check vanilla pattern bindings, like @@ -512,8 +624,8 @@ -- | Locally update 'dsl_nablas' with the given action, but defer evaluation -- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmNablas :: (Nablas -> DsM Nablas) -> DsM a -> DsM a -locallyExtendPmNablas ext k = do +locallyExtendPmNablas :: DsM a -> (Nablas -> DsM Nablas) -> DsM a +locallyExtendPmNablas k ext = do nablas <- getLdiNablas nablas' <- unsafeInterleaveM $ ext nablas updPmNablas nablas' k @@ -521,12 +633,15 @@ -- | Add in-scope type constraints if the coverage checker might run and then -- run the given action. addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a -addTyCs origin ev_vars m = do - dflags <- getDynFlags - applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmNablas $ \nablas -> - addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars)) - m +addTyCs origin ev_vars thing_inside + | isEmptyBag ev_vars + = thing_inside -- Very common fast path + | otherwise + = do { dflags <- getDynFlags + ; if needToRunPmCheck dflags origin + then locallyExtendPmNablas thing_inside $ \nablas -> + addPhiCtsNablas nablas (PhiTyCt . evVarPred <$> ev_vars) + else thing_inside } -- | Add equalities for the 'CoreExpr' scrutinees to the local 'DsM' environment, -- e.g. when checking a case expression: @@ -537,8 +652,8 @@ -- to be added for multiple scrutinees rather than just one. addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k -addCoreScrutTmCs (scr:scrs) (x:xs) k = - flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> +addCoreScrutTmCs (scr:scrs) (x:xs) k + = locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" diff --git a/GHC/HsToCore/Pmc/Desugar.hs b/GHC/HsToCore/Pmc/Desugar.hs --- a/GHC/HsToCore/Pmc/Desugar.hs +++ b/GHC/HsToCore/Pmc/Desugar.hs @@ -37,7 +37,7 @@ import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr) import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper) -import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar, decideBangHood, checkMultiplicityCoercions) +import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar, decideBangHood) import GHC.HsToCore.Match.Literal (dsLit, dsOverLit) import GHC.HsToCore.Monad import GHC.Core.TyCo.Rep @@ -48,7 +48,6 @@ import Control.Monad (zipWithM, replicateM) import Data.List (elemIndex) import Data.List.NonEmpty ( NonEmpty(..) ) -import qualified Data.List.NonEmpty as NE -- import GHC.Driver.Ppr @@ -220,13 +219,13 @@ Just l -> l Nothing -> pprPanic "failed to detect OverLit" (ppr olit) let lit' = case mb_neg of - Just _ -> expectJust "failed to negate lit" (negatePmLit lit) + Just _ -> expectJust (negatePmLit lit) Nothing -> lit mkPmLitGrds x lit' LitPat _ lit -> do - core_expr <- dsLit (convertLit lit) - let lit = expectJust "failed to detect Lit" (coreExprAsPmLit core_expr) + core_expr <- dsLit lit + let lit = expectJust (coreExprAsPmLit core_expr) mkPmLitGrds x lit TuplePat _tys pats boxity -> do @@ -271,11 +270,9 @@ desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdDag desugarConPatOut x con univ_tys ex_tvs dicts = \case - PrefixCon _ ps -> go_field_pats (zip [0..] ps) - InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) - RecCon (HsRecFields mult_cos fs _) -> do - checkMultiplicityCoercions mult_cos - go_field_pats (rec_field_ps fs) + PrefixCon ps -> go_field_pats (zip [0..] ps) + InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) + RecCon (HsRecFields NoExtField fs _) -> go_field_pats (rec_field_ps fs) where -- The actual argument types (instantiated) arg_tys = map scaledThing $ conLikeInstOrigArgTys con (univ_tys ++ mkTyVarTys ex_tvs) @@ -288,7 +285,7 @@ -- Unfortunately the label info is empty when the DataCon wasn't defined -- with record field labels, hence we desugar to field index. orig_lbls = map flSelector $ conLikeFieldLabels con - lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls + lbl_to_index lbl = expectJust $ elemIndex lbl orig_lbls go_field_pats tagged_pats = do -- The fields that appear might not be in the correct order. So @@ -346,10 +343,7 @@ desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (PmGRHSs Pre) desugarGRHSs match_loc pp_pats grhss = do lcls <- desugarLocalBinds (grhssLocalBinds grhss) - grhss' <- traverse (desugarLGRHS match_loc pp_pats) - . expectJust "desugarGRHSs" - . NE.nonEmpty - $ grhssGRHSs grhss + grhss' <- traverse (desugarLGRHS match_loc pp_pats) (grhssGRHSs grhss) return PmGRHSs { pgs_lcls = lcls, pgs_grhss = grhss' } -- | Desugar a guarded right-hand side to a single 'GrdTree' @@ -394,7 +388,7 @@ -- See Note [Long-distance information for HsLocalBinds] for why this -- pattern match is so very specific. | L _ [L _ Match{m_pats = L _ [], m_grhss = grhss}] <- mg_alts mg - , GRHSs{grhssGRHSs = [L _ (GRHS _ _grds rhs)]} <- grhss = do + , GRHSs{grhssGRHSs = L _ (GRHS _ _grds rhs) :| []} <- grhss = do core_rhs <- dsLExpr rhs return (GdOne (PmLet x core_rhs)) go (L _ (XHsBindsLR (AbsBinds diff --git a/GHC/HsToCore/Pmc/Solver.hs b/GHC/HsToCore/Pmc/Solver.hs --- a/GHC/HsToCore/Pmc/Solver.hs +++ b/GHC/HsToCore/Pmc/Solver.hs @@ -64,7 +64,7 @@ import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Map.Expr -import GHC.Core.Predicate (typeDeterminesValue) +import GHC.Core.Predicate (typeDeterminesValue, mkNomEqPred) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) import GHC.Core.Make (mkListExpr, mkCharExpr, mkImpossibleExpr) @@ -95,7 +95,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict import Data.Coerce -import Data.Foldable (foldlM, minimumBy, toList) +import Data.Foldable (foldlM, toList) import Data.Monoid (Any(..)) import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE @@ -363,7 +363,7 @@ eq_src_ty ty tys = maybe ty id (find is_closed_or_data_family tys) is_closed_or_data_family :: Type -> Bool - is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyAppType ty + is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyApp ty -- For efficiency, represent both lists as difference lists. -- comb performs the concatenation, for both lists. @@ -679,7 +679,7 @@ filterUnliftedFields :: PmAltCon -> [Id] -> [Id] filterUnliftedFields con args = - [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + [ arg | (arg, bang) <- zipEqual args (pmAltConImplBangs con) , isBanged bang || definitelyUnliftedType (idType arg) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ @@ -786,7 +786,7 @@ let ty_cts = equateTys (map mkTyVarTy tvs) (map mkTyVarTy other_tvs) nabla' <- MaybeT $ addPhiCts nabla (listToBag ty_cts) let add_var_ct nabla (a, b) = addVarCt nabla a b - foldlM add_var_ct nabla' $ zipEqual "addConCt" args other_args + foldlM add_var_ct nabla' $ zipEqual args other_args Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = @@ -803,8 +803,8 @@ equateTys :: [Type] -> [Type] -> [PhiCt] equateTys ts us = - [ PhiTyCt (mkPrimEqPred t u) - | (t, u) <- zipEqual "equateTys" ts us + [ PhiTyCt (mkNomEqPred t u) + | (t, u) <- zipEqual ts us -- The following line filters out trivial Refl constraints, so that we don't -- need to initialise the type oracle that often , not (eqType t u) diff --git a/GHC/HsToCore/Pmc/Solver/Types.hs b/GHC/HsToCore/Pmc/Solver/Types.hs --- a/GHC/HsToCore/Pmc/Solver/Types.hs +++ b/GHC/HsToCore/Pmc/Solver/Types.hs @@ -63,8 +63,8 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Tc.Solver.InertSet (InertSet, emptyInert) -import GHC.Tc.Utils.TcType (isStringTy) +import GHC.Tc.Solver.InertSet (InertSet, emptyInertSet) +import GHC.Tc.Utils.TcType (isStringTy, topTcLevel) import GHC.Types.CompleteMatch import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit , fractionalLitFromRational @@ -129,7 +129,7 @@ ppr (TySt n inert) = ppr n <+> ppr inert initTyState :: TyState -initTyState = TySt 0 emptyInert +initTyState = TySt 0 (emptyInertSet topTcLevel) -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be diff --git a/GHC/HsToCore/Quote.hs b/GHC/HsToCore/Quote.hs --- a/GHC/HsToCore/Quote.hs +++ b/GHC/HsToCore/Quote.hs @@ -12,8 +12,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2006 @@ -48,6 +46,7 @@ import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence +import GHC.Tc.TyCl ( IsPrefixConGADT(..), unannotatedMultIsLinear ) import GHC.Core.Class import GHC.Core.DataCon @@ -71,6 +70,7 @@ import GHC.Data.FastString import GHC.Data.Maybe +import qualified GHC.Data.List.NonEmpty as NE import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Unique @@ -98,7 +98,7 @@ import Data.Function import Control.Monad.Trans.Reader import Control.Monad.Trans.Class -import GHC.Types.Name.Reader (RdrName(..)) +import GHC.Types.Name.Reader (RdrName(..), WithUserRdr (..)) data MetaWrappers = MetaWrappers { -- Applies its argument to a type argument `m` and dictionary `Quote m` @@ -120,15 +120,15 @@ -- to be used to construct the monadWrapper. quote_tc <- dsLookupTyCon quoteClassName monad_tc <- dsLookupTyCon monadClassName - let Just cls = tyConClass_maybe quote_tc - Just monad_cls = tyConClass_maybe monad_tc + let cls = expectJust $ tyConClass_maybe quote_tc + monad_cls = expectJust $ tyConClass_maybe monad_tc -- Quote m -> Monad m monad_sel = classSCSelId cls 0 -- Only used for the defensive assertion that the selector has -- the expected type tyvars = dataConUserTyVarBinders (classDataCon cls) - expected_ty = mkInvisForAllTys tyvars $ + expected_ty = mkForAllTys tyvars $ mkFunTy invisArgConstraintLike ManyTy (mkClassPred cls (mkTyVarTys (binderVars tyvars))) (mkClassPred monad_cls (mkTyVarTys (binderVars tyvars))) @@ -176,7 +176,7 @@ DecBrG _ gp -> runOverloaded $ do { MkC ds1 <- repTopDs gp ; return ds1 } DecBrL {} -> panic "dsUntypedBracket: unexpected DecBrL" where - Just wrap = mb_wrap -- Not used in VarBr case + wrap = expectJust mb_wrap -- Not used in VarBr case -- In the overloaded case we have to get given a wrapper, it is just -- the VarBr case that there is no wrapper, because they -- have a simple type. @@ -800,29 +800,37 @@ repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec)) repRuleD (L loc (HsRule { rd_name = n , rd_act = act - , rd_tyvs = m_ty_bndrs - , rd_tmvs = tm_bndrs + , rd_bndrs = bndrs , rd_lhs = lhs , rd_rhs = rhs })) + = fmap (locA loc, ) <$> + repRuleBinders bndrs $ \ ty_bndrs' tm_bndrs' -> + do { n' <- coreStringLit $ unLoc n + ; act' <- repPhases act + ; lhs' <- repLE lhs + ; rhs' <- repLE rhs + ; repPragRule n' ty_bndrs' tm_bndrs' lhs' rhs' act' } + +repRuleBinders :: RuleBndrs GhcRn + -> (Core (Maybe [M (TH.TyVarBndr ())]) -> Core [M TH.RuleBndr] -> MetaM (Core (M a))) + -> MetaM (Core (M a)) +repRuleBinders (RuleBndrs { rb_tyvs = m_ty_bndrs, rb_tmvs = tm_bndrs }) thing_inside = do { let ty_bndrs = fromMaybe [] m_ty_bndrs - ; rule <- addHsTyVarBinds FreshNamesOnly ty_bndrs $ \ ex_bndrs -> - do { let tm_bndr_names = concatMap ruleBndrNames tm_bndrs - ; ss <- mkGenSyms tm_bndr_names - ; rule <- addBinds ss $ - do { elt_ty <- wrapName tyVarBndrUnitTyConName - ; ty_bndrs' <- return $ case m_ty_bndrs of - Nothing -> coreNothing' (mkListTy elt_ty) - Just _ -> coreJust' (mkListTy elt_ty) ex_bndrs - ; tm_bndrs' <- repListM ruleBndrTyConName - repRuleBndr - tm_bndrs - ; n' <- coreStringLit $ unLoc n - ; act' <- repPhases act - ; lhs' <- repLE lhs - ; rhs' <- repLE rhs - ; repPragRule n' ty_bndrs' tm_bndrs' lhs' rhs' act' } - ; wrapGenSyms ss rule } - ; return (locA loc, rule) } + ; addHsTyVarBinds FreshNamesOnly ty_bndrs $ \ ex_bndrs -> + do { let tm_bndr_names = concatMap ruleBndrNames tm_bndrs + ; ss <- mkGenSyms tm_bndr_names + ; x <- addBinds ss $ + do { elt_ty <- wrapName tyVarBndrUnitTyConName + ; ty_bndrs' <- return $ case m_ty_bndrs of + Nothing -> coreNothing' (mkListTy elt_ty) + Just _ -> coreJust' (mkListTy elt_ty) ex_bndrs + ; tm_bndrs' <- repListM ruleBndrTyConName + repRuleBndr + tm_bndrs + ; thing_inside ty_bndrs' tm_bndrs' + } + ; wrapGenSyms ss x } + } ruleBndrNames :: LRuleBndr GhcRn -> [Name] ruleBndrNames (L _ (RuleBndr _ n)) = [unLoc n] @@ -883,29 +891,46 @@ else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c']) } -repC (L _ (ConDeclGADT { con_names = cons - , con_bndrs = L _ outer_bndrs +repC (L l (ConDeclGADT { con_names = cons + , con_outer_bndrs = L _ outer_bndrs + , con_inner_bndrs = inner_bndrs , con_mb_cxt = mcxt , con_g_args = args , con_res_ty = res_ty })) - | null_outer_imp_tvs && null_outer_exp_tvs - -- No implicit or explicit variables - , Nothing <- mcxt -- No context - -- ==> no need for a forall - = repGadtDataCons cons args res_ty + | no_explicit_forall, no_context + -- No explicit variables, no context ==> No need for a ForallC + -- See Note [Don't quantify implicit type variables in quotes] + = addSimpleTyVarBinds FreshNamesOnly (hsOuterTyVarNames outer_bndrs) $ + repGadtDataCons cons args res_ty - | otherwise + | Just invis_inner_bndrs <- m_invis_inner_bndrs = addHsOuterSigTyVarBinds outer_bndrs $ \ outer_bndrs' -> - -- See Note [Don't quantify implicit type variables in quotes] - do { c' <- repGadtDataCons cons args res_ty - ; ctxt' <- repMbContext mcxt - ; if null_outer_exp_tvs && isNothing mcxt - then return c' - else rep2 forallCName ([unC outer_bndrs', unC ctxt', unC c']) } + -- the context is attached to the innermost ForallC + let loop last_bndrs' [] = do + ctxt' <- repMbContext mcxt + c' <- repGadtDataCons cons args res_ty + rep2 forallCName ([unC last_bndrs', unC ctxt', unC c']) + loop last_bndrs' (bndrs : bndrs_s) = + addHsTyVarBinds FreshNamesOnly bndrs $ \bndrs' -> do + body_c' <- loop bndrs' bndrs_s + ctxt' <- repContext [] + rep2 forallCName [unC last_bndrs', unC ctxt', unC body_c'] + in loop outer_bndrs' invis_inner_bndrs + + | Nothing <- m_invis_inner_bndrs + = notHandledL (locA l) ThDataConVisibleForall + where - null_outer_imp_tvs = nullOuterImplicit outer_bndrs - null_outer_exp_tvs = nullOuterExplicit outer_bndrs + no_explicit_forall = nullOuterExplicit outer_bndrs && null inner_bndrs + no_context = isNothing mcxt + m_invis_inner_bndrs :: Maybe [[LHsTyVarBndr Specificity GhcRn]] + m_invis_inner_bndrs = traverse get_invis_bndrs inner_bndrs + + get_invis_bndrs :: HsForAllTelescope GhcRn -> Maybe [LHsTyVarBndr Specificity GhcRn] + get_invis_bndrs HsForAllVis{} = Nothing + get_invis_bndrs HsForAllInvis { hsf_invis_bndrs = tvbs } = Just tvbs + repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt)) repMbContext Nothing = repContext [] repMbContext (Just (L _ cxt)) = repContext cxt @@ -920,17 +945,13 @@ repSrcStrictness SrcStrict = rep2 sourceStrictName [] repSrcStrictness NoSrcStrict = rep2 noSourceStrictnessName [] -repBangTy :: LBangType GhcRn -> MetaM (Core (M TH.BangType)) -repBangTy ty = do - MkC u <- repSrcUnpackedness su' - MkC s <- repSrcStrictness ss' +repConDeclField :: HsConDeclField GhcRn -> MetaM (Core (M TH.BangType)) +repConDeclField (CDF { cdf_unpack, cdf_bang, cdf_type }) = do + MkC u <- repSrcUnpackedness cdf_unpack + MkC s <- repSrcStrictness cdf_bang MkC b <- rep2 bangName [u, s] - MkC t <- repLTy ty' + MkC t <- repLTy cdf_type rep2 bangTypeName [b, t] - where - (su', ss', ty') = case unLoc ty of - HsBangTy _ (HsBang su ss) ty -> (su, ss, ty) - _ -> (NoSrcUnpack, NoSrcStrict, ty) ------------------------------------------------------- -- Deriving clauses @@ -993,8 +1014,11 @@ rep_sig (L loc (InlineSig _ nm ispec))= rep_inline nm ispec (locA loc) rep_sig (L loc (SpecSig _ nm tys ispec)) = concatMapM (\t -> rep_specialise nm t ispec (locA loc)) tys -rep_sig (L loc (SpecInstSig _ ty)) = rep_specialiseInst ty (locA loc) -rep_sig (L _ (MinimalSig {})) = notHandled ThMinimalPragmas +rep_sig (L loc (SpecSigE _nm bndrs expr ispec)) + = fmap (\ d -> [(locA loc, d)]) $ + rep_specialiseE bndrs expr ispec +rep_sig (L loc (SpecInstSig _ ty)) = rep_specialiseInst ty (locA loc) +rep_sig (L _ (MinimalSig {})) = notHandled ThMinimalPragmas rep_sig (L loc (SCCFunSig _ nm str)) = rep_sccFun nm str (locA loc) rep_sig (L loc (CompleteMatchSig _ cls mty)) = rep_complete_sig cls mty (locA loc) @@ -1095,23 +1119,38 @@ ; return [(loc, pragma)] } +rep_inline_phases :: InlinePragma -> MetaM (Maybe (Core TH.Inline), Core TH.Phases) +rep_inline_phases (InlinePragma { inl_act = act, inl_inline = inl }) + = do { phases <- repPhases act + ; inl <- if noUserInlineSpec inl + -- SPECIALISE + then return Nothing + -- SPECIALISE INLINE + else Just <$> repInline inl + ; return (inl, phases) } + rep_specialise :: LocatedN Name -> LHsSigType GhcRn -> InlinePragma -> SrcSpan -> MetaM [(SrcSpan, Core (M TH.Dec))] rep_specialise nm ty ispec loc + -- Old form SPECIALISE pragmas = do { nm1 <- lookupLOcc nm ; ty1 <- repHsSigType ty - ; phases <- repPhases $ inl_act ispec - ; let inline = inl_inline ispec - ; pragma <- if noUserInlineSpec inline - then -- SPECIALISE - repPragSpec nm1 ty1 phases - else -- SPECIALISE INLINE - do { inline1 <- repInline inline - ; repPragSpecInl nm1 ty1 inline1 phases } + ; (inl, phases) <- rep_inline_phases ispec + ; pragma <- repPragSpec nm1 ty1 inl phases ; return [(loc, pragma)] } +rep_specialiseE :: RuleBndrs GhcRn -> LHsExpr GhcRn -> InlinePragma + -> MetaM (Core (M TH.Dec)) +rep_specialiseE bndrs e ispec + -- New form SPECIALISE pragmas + = repRuleBinders bndrs $ \ ty_bndrs tm_bndrs -> + do { (inl, phases) <- rep_inline_phases ispec + ; exp <- repLE e + ; repPragSpecE ty_bndrs tm_bndrs exp inl phases + } + rep_specialiseInst :: LHsSigType GhcRn -> SrcSpan -> MetaM [(SrcSpan, Core (M TH.Dec))] rep_specialiseInst ty loc @@ -1228,17 +1267,6 @@ HsOuterExplicit{hso_bndrs = exp_bndrs} -> addHsTyVarBinds FreshNamesOnly exp_bndrs thing_inside --- | If a type implicitly quantifies its outermost type variables, return --- 'True' if the list of implicitly bound type variables is empty. If a type --- explicitly quantifies its outermost type variables, always return 'True'. --- --- This is used in various places to determine if a Template Haskell 'Type' --- should be headed by a 'ForallT' or not. -nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool -nullOuterImplicit (HsOuterImplicit{hso_ximplicit = imp_tvs}) = null imp_tvs -nullOuterImplicit (HsOuterExplicit{}) = True - -- Vacuously true, as there is no implicit quantification - -- | If a type explicitly quantifies its outermost type variables, return -- 'True' if the list of explicitly bound type variables is empty. If a type -- implicitly quantifies its outermost type variables, always return 'True'. @@ -1402,7 +1430,7 @@ repTForallVis bndrs body1 repTy ty@(HsQualTy {}) = repForallT ty -repTy (HsTyVar _ _ (L _ n)) +repTy (HsTyVar _ _ (L _ (WithUserRdr _ n))) | n `hasKey` liftedTypeKindTyConKey = repTStar | n `hasKey` constraintKindTyConKey = repTConstraint | n `hasKey` unrestrictedFunTyConKey = repArrowTyCon @@ -1427,16 +1455,17 @@ ty1 <- repLTy ty ki1 <- repLTy ki repTappKind ty1 ki1 -repTy (HsFunTy _ w f a) | isUnrestricted w = do - f1 <- repLTy f - a1 <- repLTy a +repTy (HsFunTy _ w f a) = do + f1 <- repLTy f + a1 <- repLTy a + case multAnnToHsType w of + Nothing -> do tcon <- repArrowTyCon repTapps tcon [f1, a1] -repTy (HsFunTy _ w f a) = do w1 <- repLTy (arrowToHsType w) - f1 <- repLTy f - a1 <- repLTy a - tcon <- repMulArrowTyCon - repTapps tcon [w1, f1, a1] + Just m -> do + w1 <- repLTy m + tcon <- repMulArrowTyCon + repTapps tcon [w1, f1, a1] repTy (HsListTy _ t) = do t1 <- repLTy t tcon <- repListTyCon @@ -1451,7 +1480,7 @@ repTy (HsSumTy _ tys) = do tys1 <- repLTys tys tcon <- repUnboxedSumTyCon (length tys) repTapps tcon tys1 -repTy (HsOpTy _ prom ty1 n ty2) = repLTy ((nlHsTyVar prom (unLoc n) `nlHsAppTy` ty1) +repTy (HsOpTy _ prom ty1 n ty2) = repLTy ((nlHsTyVar prom (getName n) `nlHsAppTy` ty1) `nlHsAppTy` ty2) repTy (HsParTy _ t) = repLTy t repTy (HsStarTy _ _) = repTStar @@ -1533,7 +1562,7 @@ repLE (L loc e) = mapReaderT (putSrcSpanDs (locA loc)) (repE e) repE :: HsExpr GhcRn -> MetaM (Core (M TH.Exp)) -repE (HsVar _ (L _ x)) = +repE (HsVar _ (L _ (WithUserRdr _ x))) = do { mb_val <- lift $ dsLookupMetaEnv x ; case mb_val of Nothing -> do { str <- lift $ globalVar x @@ -1541,6 +1570,10 @@ Just (DsBound y) -> repVarOrCon x (coreVar y) Just (DsSplice e) -> do { e' <- lift $ dsExpr e ; return (MkC e') } } +repE (HsHole (HoleVar (L _ uv))) = do + name <- repRdrName uv + repUnboundVar name +repE (HsHole HoleError) = panic "repE: HoleError" repE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar repE (HsOverLabel _ s) = repOverLabel s @@ -1587,8 +1620,8 @@ c <- repLE z repCond a b c repE (HsMultiIf _ alts) - = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts - ; expr' <- repMultiIf (nonEmptyCoreList alts') + = do { (binds, alts') <- NE.unzip <$> mapM repLGRHS alts + ; expr' <- repMultiIf (nonEmptyCoreList' alts') ; wrapGenSyms (concat binds) expr' } repE (HsLet _ bs e) = do { (ss,ds) <- repBinds bs ; e2 <- addBinds ss (repLE e) @@ -1637,7 +1670,7 @@ ; repUnboxedSum e1 alt arity } repE (RecordCon { rcon_con = c, rcon_flds = flds }) - = do { x <- lookupLOcc c; + = do { x <- lookupWithUserRdrLOcc c; fs <- repFields flds; repRecCon x fs } repE (RecordUpd { rupd_expr = e, rupd_flds = RegularRecUpdFields { recUpdFields = flds } }) @@ -1675,13 +1708,11 @@ ds3 <- repLE e3 repFromThenTo ds1 ds2 ds3 -repE (HsTypedSplice n _) = rep_splice n +repE (HsTypedSplice (HsTypedSpliceNested n) _) = rep_splice n repE (HsUntypedSplice (HsUntypedSpliceNested n) _) = rep_splice n repE e@(HsUntypedSplice (HsUntypedSpliceTop _ _) _) = pprPanic "repE: top level splice" (ppr e) +repE e@(HsTypedSplice HsTypedSpliceTop _) = pprPanic "repE: top level splice" (ppr e) repE (HsStatic _ e) = repLE e >>= rep2 staticEName . (:[]) . unC -repE (HsUnboundVar _ uv) = do - name <- repRdrName uv - repUnboundVar name repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do e1 <- repLE e repGetField e1 f @@ -1704,7 +1735,7 @@ body' <- repLE body rep2 forall_name [unC bndrs, unC body'] repE (HsFunArr _ mult arg res) = do - fun <- repFunArr mult + fun <- repFunArrMult mult arg' <- repLE arg res' <- repLE res repApps fun [arg', res'] @@ -1718,19 +1749,19 @@ = notHandled (ThExpressionForm e) repE (XExpr (PopErrCtxt (L _ e))) = repE e -repE (XExpr (HsRecSelRn (FieldOcc _ (L _ x)))) = repE (HsVar noExtField (noLocA x)) +repE (XExpr (HsRecSelRn (FieldOcc _ (L _ x)))) = repE (mkHsVar (noLocA x)) repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsProc{}) = notHandled (ThExpressionForm e) -repFunArr :: HsArrowOf (LocatedA (HsExpr GhcRn)) GhcRn -> MetaM (Core (M TH.Exp)) -repFunArr HsUnrestrictedArrow{} = repConName unrestrictedFunTyConName -repFunArr mult - = do { fun <- repConName fUNTyConName - ; mult' <- repLE (arrowToHsExpr mult) - ; repApp fun mult' } +repFunArrMult :: HsMultAnnOf (LocatedA (HsExpr GhcRn)) GhcRn -> MetaM (Core (M TH.Exp)) +repFunArrMult mult = case multAnnToHsExpr mult of + Nothing -> repConName unrestrictedFunTyConName + Just e -> do { fun <- repConName fUNTyConName + ; mult' <- repLE e + ; repApp fun mult' } repConName :: Name -> MetaM (Core (M TH.Exp)) repConName n = do @@ -1788,13 +1819,13 @@ ; clause <- repClause ps1 gs ds ; wrapGenSyms (ss1++ss2) clause }}} -repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M TH.Body)) -repGuards [L _ (GRHS _ [] e)] +repGuards :: NonEmpty (LGRHS GhcRn (LHsExpr GhcRn)) -> MetaM (Core (M TH.Body)) +repGuards (L _ (GRHS _ [] e) :| []) = do {a <- repLE e; repNormal a } repGuards other = do { zs <- mapM repLGRHS other - ; let (xs, ys) = unzip zs - ; gd <- repGuarded (nonEmptyCoreList ys) + ; let (xs, ys) = NE.unzip zs + ; gd <- repGuarded (nonEmptyCoreList' ys) ; wrapGenSyms (concat xs) gd } repLGRHS :: LGRHS GhcRn (LHsExpr GhcRn) @@ -1887,8 +1918,8 @@ ; (ss2,zs) <- repSts ss ; return (ss2, z : zs) } repSts (ParStmt _ stmt_blocks _ _ : ss) = - do { (ss_s, stmt_blocks1) <- mapAndUnzipM rep_stmt_block stmt_blocks - ; let stmt_blocks2 = nonEmptyCoreList stmt_blocks1 + do { (ss_s, stmt_blocks1) <- unzip <$> traverse rep_stmt_block stmt_blocks + ; let stmt_blocks2 = nonEmptyCoreList' stmt_blocks1 ss1 = concat ss_s ; z <- repParSt stmt_blocks2 ; (ss2, zs) <- addBinds ss1 (repSts ss) @@ -2033,7 +2064,7 @@ -- their pattern-only bound right hand sides have different names, -- we want to treat them the same in TH. This is the reason why we -- need an adjusted mkGenArgSyms in the `RecCon` case below. - mkGenArgSyms (PrefixCon _ args) = mkGenSyms (map unLoc args) + mkGenArgSyms (PrefixCon args) = mkGenSyms (map unLoc args) mkGenArgSyms (InfixCon arg1 arg2) = mkGenSyms [unLoc arg1, unLoc arg2] mkGenArgSyms (RecCon fields) = do { let pats = map (unLoc . recordPatSynPatVar) fields @@ -2061,7 +2092,7 @@ = rep2 patSynDName [syn, args, dir, pat] repPatSynArgs :: HsPatSynDetails GhcRn -> MetaM (Core (M TH.PatSynArgs)) -repPatSynArgs (PrefixCon _ args) +repPatSynArgs (PrefixCon args) = do { args' <- repList nameTyConName lookupLOcc args ; repPrefixPatSynArgs args' } repPatSynArgs (InfixCon arg1 arg2) @@ -2120,7 +2151,7 @@ repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> MetaM (Core (M TH.Exp)) repLambda (L _ (Match { m_pats = L _ ps - , m_grhss = GRHSs _ [L _ (GRHS _ [] e)] + , m_grhss = GRHSs _ (L _ (GRHS _ [] e) :| []) (EmptyLocalBinds _) } )) = do { let bndrs = collectPatsBinders CollNoDictBinders ps ; ; ss <- mkGenSyms bndrs @@ -2164,12 +2195,11 @@ repP (SumPat _ p alt arity) = do { p1 <- repLP p ; repPunboxedSum p1 alt arity } repP (ConPat NoExtField dc details) - = do { con_str <- lookupLOcc dc + = do { con_str <- lookupWithUserRdrLOcc dc ; case details of - PrefixCon tyargs ps -> do { qs <- repLPs ps - ; let unwrapTyArg (HsConPatTyArg _ t) = unLoc (hstp_body t) - ; ts <- repListM typeTyConName (repTy . unwrapTyArg) tyargs - ; repPcon con_str ts qs } + PrefixCon ps -> do { ts' <- repListM typeTyConName (repTy . unLoc . hstp_body) (takeHsConPatTyArgs ps) + ; ps' <- repLPs (dropHsConPatTyArgs ps) + ; repPcon con_str ts' ps' } RecCon rec -> do { fps <- repListM fieldPatTyConName rep_fld (rec_flds rec) ; repPrec con_str fps } InfixCon p1 p2 -> do { p1' <- repLP p1; @@ -2267,6 +2297,9 @@ -- Use the in-scope bindings if they exist lookupLOcc n = lookupOcc (unLoc n) +lookupWithUserRdrLOcc :: GenLocated l (WithUserRdr Name) -> MetaM (Core TH.Name) +lookupWithUserRdrLOcc (L _loc (WithUserRdr _rdr n)) = lookupOcc n + lookupOcc :: Name -> MetaM (Core TH.Name) lookupOcc = lift . lookupOccDsM @@ -2749,15 +2782,26 @@ repPragOpaque :: Core TH.Name -> MetaM (Core (M TH.Dec)) repPragOpaque (MkC nm) = rep2 pragOpaqueDName [nm] -repPragSpec :: Core TH.Name -> Core (M TH.Type) -> Core TH.Phases +repPragSpec :: Core TH.Name -> Core (M TH.Type) -> Maybe (Core (TH.Inline)) + -> Core TH.Phases -> MetaM (Core (M TH.Dec)) -repPragSpec (MkC nm) (MkC ty) (MkC phases) - = rep2 pragSpecDName [nm, ty, phases] +repPragSpec (MkC nm) (MkC ty) mb_inl (MkC phases) + = case mb_inl of + Nothing -> + rep2 pragSpecDName [nm, ty, phases] + Just (MkC inl) -> + rep2 pragSpecInlDName [nm, ty, inl, phases] -repPragSpecInl :: Core TH.Name -> Core (M TH.Type) -> Core TH.Inline - -> Core TH.Phases -> MetaM (Core (M TH.Dec)) -repPragSpecInl (MkC nm) (MkC ty) (MkC inline) (MkC phases) - = rep2 pragSpecInlDName [nm, ty, inline, phases] +repPragSpecE :: Core (Maybe [M (TH.TyVarBndr ())]) -> Core [(M TH.RuleBndr)] + -> Core (M TH.Exp) + -> Maybe (Core TH.Inline) -> Core TH.Phases + -> MetaM (Core (M TH.Dec)) +repPragSpecE (MkC ty_bndrs) (MkC tm_bndrs) (MkC expr) mb_inl (MkC phases) + = case mb_inl of + Nothing -> + rep2 pragSpecEDName [ty_bndrs, tm_bndrs, expr, phases] + Just (MkC inl) -> + rep2 pragSpecInlEDName [ty_bndrs, tm_bndrs, expr, inl, phases] repPragSpecInst :: Core (M TH.Type) -> MetaM (Core (M TH.Dec)) repPragSpecInst (MkC ty) = rep2 pragSpecInstDName [ty] @@ -2832,13 +2876,13 @@ repH98DataCon con details = do con' <- lookupLOcc con -- See Note [Binders and occurrences] case details of - PrefixCon _ ps -> do - arg_tys <- repPrefixConArgs ps + PrefixCon ps -> do + arg_tys <- repPrefixConArgs IsNotPrefixConGADT ps rep2 normalCName [unC con', unC arg_tys] InfixCon st1 st2 -> do - verifyLinearFields [st1, st2] - arg1 <- repBangTy (hsScaledThing st1) - arg2 <- repBangTy (hsScaledThing st2) + verifyLinearFields IsNotPrefixConGADT [st1, st2] + arg1 <- repConDeclField st1 + arg2 <- repConDeclField st2 rep2 infixCName [unC arg1, unC con', unC arg2] RecCon ips -> do arg_vtys <- repRecConArgs ips @@ -2852,7 +2896,7 @@ = do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences] case details of PrefixConGADT _ ps -> do - arg_tys <- repPrefixConArgs ps + arg_tys <- repPrefixConArgs IsPrefixConGADT ps res_ty' <- repLTy res_ty rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty'] RecConGADT _ ips -> do @@ -2864,36 +2908,37 @@ -- TH currently only supports linear constructors. -- We also accept the (->) arrow when -XLinearTypes is off, because this -- denotes a linear field. --- This check is not performed in repRecConArgs, since the GADT record --- syntax currently does not have a way to mark fields as nonlinear. -verifyLinearFields :: [HsScaled GhcRn (LHsType GhcRn)] -> MetaM () -verifyLinearFields ps = do - linear <- lift $ xoptM LangExt.LinearTypes - let allGood = all (\st -> case hsMult st of - HsUnrestrictedArrow _ -> not linear - HsLinearArrow _ -> True - _ -> False) ps +verifyLinearFields :: IsPrefixConGADT -> [HsConDeclField GhcRn] -> MetaM () +verifyLinearFields isPrefixConGADT ps = do + linear <- lift $ unannotatedMultIsLinear isPrefixConGADT + let allGood = all (hsMultIsLinear linear . cdf_multiplicity) ps unless allGood $ notHandled ThNonLinearDataCon + where + hsMultIsLinear linear HsUnannotated{} = linear + hsMultIsLinear _ HsLinearAnn{} = True + hsMultIsLinear _ (HsExplicitMult _ (L _ (HsTyVar _ _ (L _ n)))) = getName n == oneDataConName + hsMultIsLinear _ _ = False -- Desugar the arguments in a data constructor declared with prefix syntax. -repPrefixConArgs :: [HsScaled GhcRn (LHsType GhcRn)] - -> MetaM (Core [M TH.BangType]) -repPrefixConArgs ps = do - verifyLinearFields ps - repListM bangTypeTyConName repBangTy (map hsScaledThing ps) +repPrefixConArgs :: IsPrefixConGADT -> [HsConDeclField GhcRn] -> MetaM (Core [M TH.BangType]) +repPrefixConArgs isPrefixConGADT ps = do + verifyLinearFields isPrefixConGADT ps + repListM bangTypeTyConName repConDeclField ps -- Desugar the arguments in a data constructor declared with record syntax. -repRecConArgs :: LocatedL [LConDeclField GhcRn] +repRecConArgs :: LocatedL [LHsConDeclRecField GhcRn] -> MetaM (Core [M TH.VarBangType]) -repRecConArgs ips = do - args <- concatMapM rep_ip (unLoc ips) +repRecConArgs lips = do + let ips = map unLoc (unLoc lips) + verifyLinearFields IsNotPrefixConGADT (map cdrf_spec ips) + args <- concatMapM rep_ip ips coreListM varBangTypeTyConName args where - rep_ip (L _ ip) = mapM (rep_one_ip (cd_fld_type ip)) (cd_fld_names ip) + rep_ip ip = mapM (rep_one_ip (cdrf_spec ip)) (cdrf_names ip) - rep_one_ip :: LBangType GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType)) + rep_one_ip :: HsConDeclField GhcRn -> LFieldOcc GhcRn -> MetaM (Core (M TH.VarBangType)) rep_one_ip t n = do { MkC v <- lookupOcc (unLoc . foLabel $ unLoc n) - ; MkC ty <- repBangTy t + ; MkC ty <- repConDeclField t ; rep2 varBangTypeName [v,ty] } ------------ Types ------------------- @@ -3010,7 +3055,7 @@ ---------------------------------------------------------- -- Literals -repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit) +repLiteral :: HsLit GhcRn -> MetaM (Core TH.Lit) repLiteral (HsStringPrim _ bs) = do word8_ty <- lookupType word8TyConName let w8s = unpack bs @@ -3019,20 +3064,19 @@ rep2_nw stringPrimLName [mkListExpr word8_ty w8s_expr] repLiteral lit = do lit' <- case lit of - HsIntPrim _ i -> mk_integer i - HsWordPrim _ w -> mk_integer w - HsInt _ i -> mk_integer (il_value i) - HsFloatPrim _ r -> mk_rational r - HsDoublePrim _ r -> mk_rational r - HsCharPrim _ c -> mk_char c - _ -> return lit - lit_expr <- lift $ dsLit lit' + HsIntPrim _ i -> lift . dsLit <$> mk_integer i + HsWordPrim _ w -> lift . dsLit <$> mk_integer w + HsInt _ i -> lift . dsLit <$> mk_integer (il_value i) + HsFloatPrim _ r -> lift . dsLit <$> mk_rational r + HsDoublePrim _ r -> lift . dsLit <$> mk_rational r + HsCharPrim _ c -> lift . dsLit <$> mk_char c + _ -> return . lift . dsLit $ lit + lit_expr <- lit' case mb_lit_name of Just lit_name -> rep2_nw lit_name [lit_expr] Nothing -> notHandled (ThExoticLiteral lit) where mb_lit_name = case lit of - HsInteger _ _ _ -> Just integerLName HsInt _ _ -> Just integerLName HsIntPrim _ _ -> Just intPrimLName HsWordPrim _ _ -> Just wordPrimLName @@ -3042,15 +3086,15 @@ HsCharPrim _ _ -> Just charPrimLName HsString _ _ -> Just stringLName HsMultilineString _ _ -> Just stringLName - HsRat _ _ _ -> Just rationalLName _ -> Nothing -mk_integer :: Integer -> MetaM (HsLit GhcRn) -mk_integer i = return $ HsInteger NoSourceText i integerTy +mk_integer :: Integer -> MetaM (HsLit GhcTc) +mk_integer i = return $ XLit $ HsInteger NoSourceText i integerTy -mk_rational :: FractionalLit -> MetaM (HsLit GhcRn) +mk_rational :: FractionalLit -> MetaM (HsLit GhcTc) mk_rational r = do rat_ty <- lookupType rationalTyConName - return $ HsRat noExtField r rat_ty + return $ XLit $ HsRat r rat_ty + mk_string :: FastString -> MetaM (HsLit GhcRn) mk_string s = return $ HsString NoSourceText s @@ -3059,15 +3103,25 @@ repOverloadedLiteral :: HsOverLit GhcRn -> MetaM (Core TH.Lit) repOverloadedLiteral (OverLit { ol_val = val}) - = do { lit <- mk_lit val; repLiteral lit } - -- The type Rational will be in the environment, because - -- the smart constructor 'TH.Syntax.rationalL' uses it in its type, - -- and rationalL is sucked in when any TH stuff is used + = repOverLiteralVal val + -- The type Rational will be in the environment, because + -- the smart constructor 'TH.Syntax.rationalL' uses it in its type, + -- and rationalL is sucked in when any TH stuff is used -mk_lit :: OverLitVal -> MetaM (HsLit GhcRn) -mk_lit (HsIntegral i) = mk_integer (il_value i) -mk_lit (HsFractional f) = mk_rational f -mk_lit (HsIsString _ s) = mk_string s +repOverLiteralVal :: OverLitVal -> MetaM (Core TH.Lit) +repOverLiteralVal lit = do + lit' <- case lit of + (HsIntegral i) -> lift . dsLit <$> mk_integer (il_value i) + (HsFractional f) -> lift . dsLit <$> mk_rational f + (HsIsString _ s) -> lift . dsLit <$> mk_string s + lit_expr <- lit' + + let lit_name = case lit of + (HsIntegral _ ) -> integerLName + (HsFractional _) -> rationalLName + (HsIsString _ _) -> stringLName + + rep2_nw lit_name [lit_expr] repRdrName :: RdrName -> MetaM (Core TH.Name) repRdrName rdr_name = do diff --git a/GHC/HsToCore/Ticks.hs b/GHC/HsToCore/Ticks.hs --- a/GHC/HsToCore/Ticks.hs +++ b/GHC/HsToCore/Ticks.hs @@ -1,12 +1,11 @@ -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {- (c) Galois, 2006 (c) University of Glasgow, 2007 +(c) Florian Ragwitz, 2025 -} module GHC.HsToCore.Ticks @@ -38,7 +37,9 @@ import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.Var.Set +import GHC.Types.Var.Env import GHC.Types.Name.Set hiding (FreeVars) import GHC.Types.Name import GHC.Types.CostCentre @@ -48,10 +49,12 @@ import Control.Monad import Data.List (isSuffixOf, intersperse) +import Data.Foldable (toList) import Trace.Hpc.Mix import Data.Bifunctor (second) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Set (Set) import qualified Data.Set as Set @@ -86,7 +89,6 @@ , tick_label :: BoxLabel -- ^ Label for the tick counter } - addTicksToBinds :: Logger -> TicksConfig @@ -123,6 +125,7 @@ , density = mkDensity tickish $ ticks_profAuto cfg , this_mod = mod , tickishType = tickish + , recSelBinds = emptyVarEnv } (binds',_,st') = unTM (addTickLHsBinds binds) env st in (binds', st') @@ -224,8 +227,7 @@ addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds , abs_exports = abs_exports }))) = - withEnv add_exports $ - withEnv add_inlines $ do + withEnv (add_rec_sels . add_inlines . add_exports) $ do binds' <- addTickLHsBinds binds return $ L pos $ XHsBindsLR $ bind { abs_binds = binds' } where @@ -247,7 +249,13 @@ | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports , isInlinePragma (idInlinePragma pid) ] } -addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id }))) = do + add_rec_sels env = + env{ recSelBinds = recSelBinds env `extendVarEnvList` + [ (abe_mono, abe_poly) + | ABE{ abe_poly, abe_mono } <- abs_exports + , RecSelId{} <- [idDetails abe_poly] ] } + +addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches }))) = do let name = getOccString id decl_path <- getPathEntry density <- getDensity @@ -261,10 +269,14 @@ tickish <- tickishType `liftM` getEnv case tickish of { ProfNotes | inline -> return (L pos funBind); _ -> do + -- See Note [Record-selector ticks] + selTick <- recSelTick id + case selTick of { Just tick -> tick_rec_sel tick; _ -> do + (fvs, mg) <- getFreeVars $ addPathEntry name $ - addTickMatchGroup False (fun_matches funBind) + addTickMatchGroup False matches blackListed <- isBlackListed (locA pos) exported_names <- liftM exports getEnv @@ -272,7 +284,9 @@ -- We don't want to generate code for blacklisted positions -- We don't want redundant ticks on simple pattern bindings -- We don't want to tick non-exported bindings in TickExportedFunctions - let simple = isSimplePatBind funBind + let simple = matchGroupArity matches == 0 + -- A binding is a "simple pattern binding" if it is a + -- funbind with zero patterns toplev = null decl_path exported = idName id `elemNameSet` exported_names @@ -286,17 +300,45 @@ let mbCons = maybe Prelude.id (:) return $ L pos $ funBind { fun_matches = mg , fun_ext = second (tick `mbCons`) (fun_ext funBind) } - } + } } + where + -- See Note [Record-selector ticks] + tick_rec_sel tick = + pure $ L pos $ funBind { fun_ext = second (tick :) (fun_ext funBind) } - where - -- a binding is a simple pattern binding if it is a funbind with - -- zero patterns - isSimplePatBind :: HsBind GhcTc -> Bool - isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0 +-- Note [Record-selector ticks] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Users expect (see #17834) that accessing a record field by its name using +-- NamedFieldPuns or RecordWildCards will mark it as covered. This is very +-- reasonable, because otherwise the use of those two language features will +-- produce unnecessary noise in coverage reports, distracting from real +-- coverage problems. +-- +-- Because of that, GHC chooses to treat record selectors specially for +-- coverage purposes to improve the developer experience. +-- +-- This is done by keeping track of which 'Id's are effectively bound to +-- record fields (using NamedFieldPuns or RecordWildCards) in 'TickTransEnv's +-- 'recSelBinds', and making 'HsVar's corresponding to those fields tick the +-- appropriate box when executed. +-- +-- To enable that, we also treat 'FunBind's for record selector functions +-- specially. We only create a TopLevelBox for the record selector function, +-- skipping the ExpBox that'd normally be created. This simplifies the re-use +-- of ticks for the same record selector, and is done by not recursing into +-- the fun_matches match group for record selector functions. +-- +-- This scheme could be extended further in the future, making coverage for +-- constructor fields (named or even positional) mean that the field was +-- accessed at run-time. For the time being, we only cover NamedFieldPuns and +-- RecordWildCards binds to cover most practical use-cases while keeping it +-- simple. + -- TODO: Revisit this addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs - , pat_rhs = rhs }))) = do + , pat_rhs = rhs + , pat_ext = (grhs_ty, initial_ticks)}))) = do let simplePatId = isSimplePat lhs @@ -314,15 +356,13 @@ then return (L pos pat') else do - let mbCons = maybe id (:) - - let (initial_rhs_ticks, initial_patvar_tickss) = snd $ pat_ext pat' - -- Allocate the ticks - rhs_tick <- bindTick density name (locA pos) fvs - let rhs_ticks = rhs_tick `mbCons` initial_rhs_ticks + let mbCons = maybe id (:) + (initial_rhs_ticks, initial_patvar_tickss) = initial_ticks + rhs_ticks = rhs_tick `mbCons` initial_rhs_ticks + patvar_tickss <- case simplePatId of Just{} -> return initial_patvar_tickss Nothing -> do @@ -332,7 +372,7 @@ (zipWith mbCons patvar_ticks (initial_patvar_tickss ++ repeat [])) - return $ L pos $ pat' { pat_ext = second (const (rhs_ticks, patvar_tickss)) (pat_ext pat') } + return $ L pos $ pat' { pat_ext = (grhs_ty, (rhs_ticks, patvar_tickss)) } -- Only internal stuff, not from source, uses VarBind, so we ignore it. addTickLHsBind var_bind@(L _ (VarBind {})) = return var_bind @@ -427,6 +467,8 @@ _other -> addTickLHsExprEvalInner e where tick_it = allocTickBox (ExpBox False) False False (locA pos) + -- don't allow duplicates of this forced bp + $ withBlackListed (locA pos) $ addTickHsExpr e0 dont_tick_it = addTickLHsExprNever e @@ -474,14 +516,16 @@ -- in the addTickLHsExpr family of functions.) addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc) -addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e -addTickHsExpr e@(HsUnboundVar {}) = return e - +-- See Note [Record-selector ticks] +addTickHsExpr e@(HsVar _ (L _ id)) = + freeVar id >> recSelTick id >>= pure . maybe e wrap + where wrap tick = XExpr . HsTick tick . noLocA $ e addTickHsExpr e@(HsIPVar {}) = return e addTickHsExpr e@(HsOverLit {}) = return e addTickHsExpr e@(HsOverLabel{}) = return e addTickHsExpr e@(HsLit {}) = return e addTickHsExpr e@(HsEmbTy {}) = return e +addTickHsExpr e@(HsHole {}) = return e addTickHsExpr e@(HsQual {}) = return e addTickHsExpr e@(HsForAll {}) = return e addTickHsExpr e@(HsFunArr {}) = return e @@ -532,11 +576,11 @@ (addTickLHsExprOptAlt True e2) (addTickLHsExprOptAlt True e3) addTickHsExpr (HsMultiIf ty alts) - = do { let isOneOfMany = case alts of [_] -> False; _ -> True + = do { let isOneOfMany = case alts of { (_ :| []) -> False; _ -> True; } ; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False False) alts ; return $ HsMultiIf ty alts' } addTickHsExpr (HsLet x binds e) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + bindLocals binds $ do binds' <- addTickHsLocalBinds binds -- to think about: !patterns. e' <- addTickLHsExprLetBody e return (HsLet x binds' e') @@ -584,6 +628,7 @@ addTickHsExpr e@(HsGetField {}) = return e addTickHsExpr e@(HsProjection {}) = return e addTickHsExpr (HsProc x pat cmdtop) = + bindLocals pat $ liftM2 (HsProc x) (addTickLPat pat) (traverse (addTickHsCmdTop) cmdtop) @@ -614,19 +659,23 @@ _ -> Nothing addTickHsExpanded :: HsThingRn -> HsExpr GhcTc -> TM (HsExpr GhcTc) -addTickHsExpanded o@(OrigStmt (L pos LastStmt{})) e - -- LastStmt always gets a tick for breakpoint and hpc coverage - = do d <- getDensity - case d of - TickForCoverage -> liftM (XExpr . ExpandedThingTc o) $ tick_it e - TickForBreakPoints -> liftM (XExpr . ExpandedThingTc o) $ tick_it e - _ -> liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e +addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of + -- We always want statements to get a tick, so we can step over each one. + -- To avoid duplicates we blacklist SrcSpans we already inserted here. + OrigStmt (L pos _) -> do_tick_black pos + _ -> skip where - tick_it e = unLoc <$> allocTickBox (ExpBox False) False False (locA pos) - (addTickHsExpr e) -addTickHsExpanded o e - = liftM (XExpr . ExpandedThingTc o) $ addTickHsExpr e - + skip = addTickHsExpr e + do_tick_black pos = do + d <- getDensity + case d of + TickForCoverage -> tick_it_black pos + TickForBreakPoints -> tick_it_black pos + _ -> skip + tick_it_black pos = + unLoc <$> allocTickBox (ExpBox False) False False (locA pos) + (withBlackListed (locA pos) $ + addTickHsExpr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e @@ -646,19 +695,17 @@ -> TM (Match GhcTc (LHsExpr GhcTc)) addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L _ pats , m_grhss = gRHSs }) = - bindLocals (collectPatsBinders CollNoDictBinders pats) $ do + bindLocals pats $ do gRHSs' <- addTickGRHSs isOneOfMany isLambda isDoExp gRHSs return $ match { m_grhss = gRHSs' } addTickGRHSs :: Bool -> Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc)) addTickGRHSs isOneOfMany isLambda isDoExp (GRHSs x guarded local_binds) = - bindLocals binders $ do + bindLocals local_binds $ do local_binds' <- addTickHsLocalBinds local_binds guarded' <- mapM (traverse (addTickGRHS isOneOfMany isLambda isDoExp)) guarded return $ GRHSs x guarded' local_binds' - where - binders = collectLocalBinders CollNoDictBinders local_binds addTickGRHS :: Bool -> Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)) @@ -697,7 +744,7 @@ addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a) addTickLStmts' isGuard lstmts res - = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $ + = bindLocals lstmts $ do { lstmts' <- mapM (traverse (addTickStmt isGuard)) lstmts ; a <- res ; return (lstmts', a) } @@ -710,6 +757,7 @@ (pure noret) (addTickSyntaxExpr hpcSrcSpan ret) addTickStmt _isGuard (BindStmt xbs pat e) = + bindLocals pat $ liftM4 (\b f -> BindStmt $ XBindStmtTc { xbstc_bindOp = b , xbstc_boundResultType = xbstc_boundResultType xbs @@ -770,17 +818,19 @@ liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg) where addTickArg (ApplicativeArgOne m_fail pat expr isBody) = - ApplicativeArgOne - <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail - <*> addTickLPat pat - <*> addTickLHsExpr expr - <*> pure isBody + bindLocals pat $ + ApplicativeArgOne + <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail + <*> addTickLPat pat + <*> addTickLHsExpr expr + <*> pure isBody addTickArg (ApplicativeArgMany x stmts ret pat ctxt) = - (ApplicativeArgMany x) - <$> addTickLStmts isGuard stmts - <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret)) - <*> addTickLPat pat - <*> pure ctxt + bindLocals pat $ + ApplicativeArgMany x + <$> addTickLStmts isGuard stmts + <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret)) + <*> addTickLPat pat + <*> pure ctxt addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc) @@ -871,7 +921,7 @@ (addTickLHsCmd c2) (addTickLHsCmd c3) addTickHsCmd (HsCmdLet x binds c) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + bindLocals binds $ do binds' <- addTickHsLocalBinds binds -- to think about: !patterns. c' <- addTickLHsCmd c return (HsCmdLet x binds' c') @@ -907,18 +957,16 @@ addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc)) addTickCmdMatch match@(Match { m_pats = L _ pats, m_grhss = gRHSs }) = - bindLocals (collectPatsBinders CollNoDictBinders pats) $ do + bindLocals pats $ do gRHSs' <- addTickCmdGRHSs gRHSs return $ match { m_grhss = gRHSs' } addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc)) addTickCmdGRHSs (GRHSs x guarded local_binds) = - bindLocals binders $ do + bindLocals local_binds $ do local_binds' <- addTickHsLocalBinds local_binds guarded' <- mapM (traverse addTickCmdGRHS) guarded return $ GRHSs x guarded' local_binds' - where - binders = collectLocalBinders CollNoDictBinders local_binds addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc)) -- The *guards* are *not* Cmds, although the body is @@ -937,15 +985,14 @@ addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a) addTickLCmdStmts' lstmts res - = bindLocals binders $ do + = bindLocals lstmts $ do lstmts' <- mapM (traverse addTickCmdStmt) lstmts a <- res return (lstmts', a) - where - binders = collectLStmtsBinders CollNoDictBinders lstmts addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc)) addTickCmdStmt (BindStmt x pat c) = + bindLocals pat $ liftM2 (BindStmt x) (addTickLPat pat) (addTickLHsCmd c) @@ -1006,11 +1053,13 @@ data TickTransState = TT { ticks :: !(SizedSeq Tick) , ccIndices :: !CostCentreState + , recSelTicks :: !(IdEnv CoreTickish) } initTTState :: TickTransState initTTState = TT { ticks = emptySS , ccIndices = newCostCentreState + , recSelTicks = emptyVarEnv } addMixEntry :: Tick -> TM Int @@ -1021,6 +1070,10 @@ } return c +addRecSelTick :: Id -> CoreTickish -> TM () +addRecSelTick sel tick = + setState $ \s -> s{ recSelTicks = extendVarEnv (recSelTicks s) sel tick } + data TickTransEnv = TTE { fileName :: FastString , density :: TickDensity , tte_countEntries :: !Bool @@ -1033,6 +1086,7 @@ , blackList :: Set RealSrcSpan , this_mod :: Module , tickishType :: TickishType + , recSelBinds :: IdEnv Id } -- deriving Show @@ -1146,20 +1200,26 @@ tickish <- tickishType `liftM` getEnv let need_same_file = tickSameFileOnly tickish same_file = Just file_name == srcSpanFileName_maybe pos - return (isGoodSrcSpan' pos && (not need_same_file || same_file)) + isBL <- isBlackListed pos + return (isGoodSrcSpan' pos && not isBL && (not need_same_file || same_file)) ifGoodTickSrcSpan :: SrcSpan -> TM a -> TM a -> TM a ifGoodTickSrcSpan pos then_code else_code = do good <- isGoodTickSrcSpan pos if good then then_code else else_code -bindLocals :: [Id] -> TM a -> TM a -bindLocals new_ids (TM m) - = TM $ \ env st -> - case m env{ inScope = inScope env `extendVarSetList` new_ids } st of - (r, fv, st') -> (r, fv `delListFromOccEnv` occs, st') - where occs = [ nameOccName (idName id) | id <- new_ids ] +bindLocals :: (CollectBinders bndr, CollectFldBinders bndr) => bndr -> TM a -> TM a +bindLocals from (TM m) = TM $ \env st -> + case m (with_bnds env) st of + (r, fv, st') -> (r, fv `delListFromOccEnv` (map (nameOccName . idName) new_bnds), st') + where with_bnds e = e{ inScope = inScope e `extendVarSetList` new_bnds + , recSelBinds = recSelBinds e `plusVarEnv` collectFldBinds from } + new_bnds = collectBinds from +withBlackListed :: SrcSpan -> TM a -> TM a +withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) }) +withBlackListed (UnhelpfulSpan _) = id + isBlackListed :: SrcSpan -> TM Bool isBlackListed (RealSrcSpan pos _) = TM $ \ env st -> (Set.member pos (blackList env), noFVs, st) isBlackListed (UnhelpfulSpan _) = return False @@ -1168,17 +1228,30 @@ -- expression argument to support nested box allocations allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc) -allocTickBox boxLabel countEntries topOnly pos m = - ifGoodTickSrcSpan pos (do - (fvs, e) <- getFreeVars m - env <- getEnv - tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env) - return (L (noAnnSrcSpan pos) (XExpr $ HsTick tickish $ L (noAnnSrcSpan pos) e))) - (do - e <- m - return (L (noAnnSrcSpan pos) e) - ) +allocTickBox boxLabel countEntries topOnly pos m + = ifGoodTickSrcSpan pos good_case skip_case + where + this_loc = L (noAnnSrcSpan pos) + skip_case = do + e <- m + return (this_loc e) + good_case = do + (fvs, e) <- getFreeVars m + env <- getEnv + tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env) + return (this_loc (XExpr $ HsTick tickish $ this_loc e)) +recSelTick :: Id -> TM (Maybe CoreTickish) +recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing) + where + maybe_tick = getEnv >>= + maybe (pure Nothing) tick . (`lookupVarEnv` id) . recSelBinds + tick sel = getState >>= + maybe (alloc sel) (pure . Just) . (`lookupVarEnv` sel) . recSelTicks + alloc sel = allocATickBox (box sel) False False (getSrcSpan sel) noFVs + >>= traverse (\t -> t <$ addRecSelTick sel t) + box sel = TopLevelBox [getOccString sel] + -- the tick application inherits the source position of its -- expression argument to support nested box allocations allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars @@ -1228,7 +1301,7 @@ Breakpoints -> do i <- addMixEntry me - pure (Breakpoint noExtField i ids (this_mod env)) + pure (Breakpoint noExtField (BreakpointId (this_mod env) i) ids) SourceNotes | RealSrcSpan pos' _ <- pos -> return $ SourceNote pos' $ LexicalFastString cc_name @@ -1281,3 +1354,98 @@ matchCount :: LMatch GhcTc body -> Int matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ })) = length grhss + +-- | Convenience class used by 'bindLocals' to collect new bindings from +-- various parts of he AST. Just delegates to +-- 'collect{Pat,Pats,Local,LStmts}Binders' from 'GHC.Hs.Utils' as appropriate. +class CollectBinders a where + collectBinds :: a -> [Id] + +-- | Variant of 'CollectBinders' which collects information on which locals +-- are bound to record fields (currently only via 'RecordWildCards' or +-- 'NamedFieldPuns') to enable better coverage support for record selectors. +-- +-- See Note [Record-selector ticks]. +class CollectFldBinders a where + collectFldBinds :: a -> IdEnv Id + +instance CollectBinders (LocatedA (Pat GhcTc)) where + collectBinds = collectPatBinders CollNoDictBinders +instance CollectBinders [LocatedA (Pat GhcTc)] where + collectBinds = collectPatsBinders CollNoDictBinders +instance CollectBinders (HsLocalBinds GhcTc) where + collectBinds = collectLocalBinders CollNoDictBinders +instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsExpr GhcTc)))] where + collectBinds = collectLStmtsBinders CollNoDictBinders +instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsCmd GhcTc)))] where + collectBinds = collectLStmtsBinders CollNoDictBinders + +instance (CollectFldBinders a) => CollectFldBinders [a] where + collectFldBinds = foldr (flip plusVarEnv . collectFldBinds) emptyVarEnv +instance (CollectFldBinders e) => CollectFldBinders (GenLocated l e) where + collectFldBinds = collectFldBinds . unLoc +instance CollectFldBinders (Pat GhcTc) where + collectFldBinds ConPat{ pat_args = RecCon HsRecFields{ rec_flds, rec_dotdot } } = + collectFldBinds rec_flds `plusVarEnv` plusVarEnvList (zipWith fld_bnds [0..] rec_flds) + where n_explicit | Just (L _ (RecFieldsDotDot n)) <- rec_dotdot = n + | otherwise = length rec_flds + fld_bnds n (L _ HsFieldBind{ hfbLHS = L _ FieldOcc{ foLabel = L _ sel } + , hfbRHS = L _ (VarPat _ (L _ var)) + , hfbPun }) + | hfbPun || n >= n_explicit = unitVarEnv var sel + fld_bnds _ _ = emptyVarEnv + collectFldBinds ConPat{ pat_args = PrefixCon pats } = collectFldBinds pats + collectFldBinds ConPat{ pat_args = InfixCon p1 p2 } = collectFldBinds [p1, p2] + collectFldBinds (LazyPat _ pat) = collectFldBinds pat + collectFldBinds (BangPat _ pat) = collectFldBinds pat + collectFldBinds (AsPat _ _ pat) = collectFldBinds pat + collectFldBinds (ViewPat _ _ pat) = collectFldBinds pat + collectFldBinds (ParPat _ pat) = collectFldBinds pat + collectFldBinds (ListPat _ pats) = collectFldBinds pats + collectFldBinds (TuplePat _ pats _) = collectFldBinds pats + collectFldBinds (SumPat _ pats _ _) = collectFldBinds pats + collectFldBinds (SigPat _ pat _) = collectFldBinds pat + collectFldBinds (XPat exp) = collectFldBinds exp + collectFldBinds VarPat{} = emptyVarEnv + collectFldBinds WildPat{} = emptyVarEnv + collectFldBinds OrPat{} = emptyVarEnv + collectFldBinds LitPat{} = emptyVarEnv + collectFldBinds NPat{} = emptyVarEnv + collectFldBinds NPlusKPat{} = emptyVarEnv + collectFldBinds SplicePat{} = emptyVarEnv + collectFldBinds EmbTyPat{} = emptyVarEnv + collectFldBinds InvisPat{} = emptyVarEnv +instance (CollectFldBinders r) => CollectFldBinders (HsFieldBind l r) where + collectFldBinds = collectFldBinds . hfbRHS +instance CollectFldBinders XXPatGhcTc where + collectFldBinds (CoPat _ pat _) = collectFldBinds pat + collectFldBinds (ExpansionPat _ pat) = collectFldBinds pat +instance CollectFldBinders (HsLocalBinds GhcTc) where + collectFldBinds (HsValBinds _ bnds) = collectFldBinds bnds + collectFldBinds HsIPBinds{} = emptyVarEnv + collectFldBinds EmptyLocalBinds{} = emptyVarEnv +instance CollectFldBinders (HsValBinds GhcTc) where + collectFldBinds (ValBinds _ bnds _) = collectFldBinds bnds + collectFldBinds (XValBindsLR (NValBinds bnds _)) = collectFldBinds (map snd bnds) +instance CollectFldBinders (HsBind GhcTc) where + collectFldBinds PatBind{ pat_lhs } = collectFldBinds pat_lhs + collectFldBinds (XHsBindsLR AbsBinds{ abs_exports, abs_binds }) = + mkVarEnv [ (abe_poly, sel) + | ABE{ abe_poly, abe_mono } <- abs_exports + , Just sel <- [lookupVarEnv monos abe_mono] ] + where monos = collectFldBinds abs_binds + collectFldBinds VarBind{} = emptyVarEnv + collectFldBinds FunBind{} = emptyVarEnv + collectFldBinds PatSynBind{} = emptyVarEnv +instance CollectFldBinders (Stmt GhcTc e) where + collectFldBinds (BindStmt _ pat _) = collectFldBinds pat + collectFldBinds (LetStmt _ bnds) = collectFldBinds bnds + collectFldBinds (ParStmt _ xs _ _) = collectFldBinds [s | ParStmtBlock _ ss _ _ <- toList xs, s <- ss] + collectFldBinds TransStmt{ trS_stmts } = collectFldBinds trS_stmts + collectFldBinds RecStmt{ recS_stmts } = collectFldBinds recS_stmts + collectFldBinds (XStmtLR (ApplicativeStmt _ args _)) = collectFldBinds (map snd args) + collectFldBinds LastStmt{} = emptyVarEnv + collectFldBinds BodyStmt{} = emptyVarEnv +instance CollectFldBinders (ApplicativeArg GhcTc) where + collectFldBinds ApplicativeArgOne{ app_arg_pattern } = collectFldBinds app_arg_pattern + collectFldBinds ApplicativeArgMany{ bv_pattern } = collectFldBinds bv_pattern diff --git a/GHC/HsToCore/Types.hs b/GHC/HsToCore/Types.hs --- a/GHC/HsToCore/Types.hs +++ b/GHC/HsToCore/Types.hs @@ -14,27 +14,34 @@ import GHC.Prelude (Int) import Data.IORef -import qualified Data.Set as S import GHC.Types.CostCentre.State import GHC.Types.Error import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Var +import GHC.Types.Var.Set import GHC.Types.Name.Reader (GlobalRdrEnv) + import GHC.Hs (LForeignDecl, HsExpr, GhcTc) + import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv) + import GHC.HsToCore.Pmc.Types (Nablas) import GHC.HsToCore.Errors.Types + import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Outputable as Outputable import GHC.Unit.Module import GHC.Driver.Hooks (DsForeignsHook) import GHC.Data.OrdList (OrdList) + import GHC.Types.ForeignStubs (ForeignStubs) import GHC.Types.CompleteMatch +import Data.Maybe( Maybe ) + {- ************************************************************************ * * @@ -80,9 +87,11 @@ -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_unspecables :: S.Set EvVar - -- ^ See Note [Desugaring non-canonical evidence]: this field collects - -- all un-specialisable evidence variables in scope. + + , dsl_unspecables :: Maybe VarSet + -- ^ See Note [Desugaring non-canonical evidence] + -- This field collects all un-specialisable evidence variables in scope. + -- Nothing <=> don't collect this info (used for the LHS of Rules) } -- Inside [| |] brackets, the desugarer looks diff --git a/GHC/HsToCore/Usage.hs b/GHC/HsToCore/Usage.hs --- a/GHC/HsToCore/Usage.hs +++ b/GHC/HsToCore/Usage.hs @@ -1,7 +1,3 @@ - - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module GHC.HsToCore.Usage ( -- * Dependency/fingerprinting code (used by GHC.Iface.Make) mkUsageInfo, mkUsedNames, @@ -23,8 +19,10 @@ import GHC.Utils.Panic import GHC.Utils.Monad +import GHC.Types.Avail import GHC.Types.Name -import GHC.Types.Name.Set ( NameSet, allUses ) +import GHC.Types.Name.Reader (ImpDeclSpec(..)) +import GHC.Types.Name.Set ( NameSet, allUses, emptyNameSet, unionNameSet ) import GHC.Types.Unique.Set import GHC.Unit @@ -48,10 +46,10 @@ import GHC.Unit.Finder import GHC.Types.Unique.DFM import GHC.Driver.Plugins +import qualified GHC.Unit.Home.Graph as HUG {- Note [Module self-dependency] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC.Rename.Names.calculateAvails asserts the invariant that a module must not occur in its own dep_orphs or dep_finsts. However, if we aren't careful this can occur in the presence of hs-boot files: Consider that we have two modules, A and B, @@ -75,19 +73,23 @@ { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? } -mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> NameSet -> [FilePath] - -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IfG [Usage] -mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_files merged needed_links needed_pkgs +mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv + -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet + -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded + -> IfG [Usage] +mkUsageInfo uc plugins fc unit_env + this_mod dir_imp_mods imp_decls used_names + dependent_files merged needed_links needed_pkgs = do eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env)) hashes <- liftIO $ mapM getFileHash dependent_files - let hu = unsafeGetHomeUnit unit_env + let hu = ue_unsafeHomeUnit unit_env hug = ue_home_unit_graph unit_env -- Dependencies on object files due to TH and plugins object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs - let all_home_ids = ue_all_home_unit_ids unit_env + let all_home_ids = HUG.allUnits (ue_home_unit_graph unit_env) mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod - dir_imp_mods used_names + dir_imp_mods imp_decls used_names let usages = mod_usages ++ [ UsageFile { usg_file_path = mkFastString f , usg_file_hash = hash , usg_file_label = Nothing } @@ -104,8 +106,7 @@ -- the entire collection of Ifaces. {- Note [Plugin dependencies] - ~~~~~~~~~~~~~~~~~~~~~~~~~~ - +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Modules for which plugins were used in the compilation process, should be recompiled whenever one of those plugins changes. But how do we know if a plugin changed from the previous time a module was compiled? @@ -184,11 +185,11 @@ Nothing -> do -- This should only happen for home package things but oneshot puts -- home package ifaces in the PIT. - let miface = lookupIfaceByModule hug pit m + miface <- lookupIfaceByModule hug pit m case miface of Nothing -> pprPanic "mkObjectUsage" (ppr m) Just iface -> - return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash (mi_final_exts iface)) + return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash iface) librarySpecToUsage :: LibrarySpec -> IO [Usage] librarySpecToUsage (Objects os) = traverse (fing Nothing) os @@ -201,9 +202,10 @@ -> Set.Set UnitId -> Module -> ImportedMods + -> [ImportUserSpec] -> NameSet -> IfG [Usage] -mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports used_names +mk_mod_usage_info uc home_unit home_unit_ids this_mod direct_imports imp_decls used_names = mapMaybeM mkUsageM usage_mods where safe_implicit_imps_req = uc_safe_implicit_imps_req uc @@ -264,7 +266,7 @@ -- for package modules, we record the module hash only | (null used_occs - && isNothing export_hash + && isNothing imported_exports && not is_direct_import && not finsts_mod) = Nothing -- Record no usage info @@ -277,15 +279,24 @@ usg_mod_name = moduleName mod, usg_unit_id = toUnitId (moduleUnit mod), usg_mod_hash = mod_hash, - usg_exports = export_hash, + usg_exports = imported_exports, usg_entities = Map.toList ent_hashs, usg_safe = imp_safe } where - finsts_mod = mi_finsts (mi_final_exts iface) - hash_env = mi_hash_fn (mi_final_exts iface) - mod_hash = mi_mod_hash (mi_final_exts iface) - export_hash | depend_on_exports = Just (mi_exp_hash (mi_final_exts iface)) - | otherwise = Nothing + finsts_mod = mi_finsts iface + hash_env = mi_hash_fn iface + mod_hash = mi_mod_hash iface + imported_exports + = if not depend_on_exports + then Nothing + else + Just $ + HomeModImport + { hmiu_orphanLikeHash + = mi_orphan_like_hash iface + , hmiu_importedAvails + = moduleImportedAvails mod (mi_export_avails_hash iface) imp_decls + } by_is_safe (ImportedByUser imv) = imv_is_safe imv by_is_safe _ = False @@ -334,9 +345,30 @@ one-shot mode), but that's even more bogus! -} -{- -Note [Internal used_names] -~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- | Compute the avails that we are importing from a home module. +-- +-- See 'HomeModImportedAvails'. +moduleImportedAvails :: Module -> Fingerprint -> [ImportUserSpec] -> HomeModImportedAvails +moduleImportedAvails mod vis_exp_hash = go [] emptyNameSet + where + go :: Avails -> NameSet -> [ImportUserSpec] -> HomeModImportedAvails + go avails_acc parents_acc [] = + HMIA_Explicit + { hmia_imported_avails = sortAvails avails_acc + , hmia_parents_with_implicits = parents_acc + } + go avails_acc parents_acc (ImpUserSpec (ImpDeclSpec { is_mod = mod' }) decl : imp_decls) + | mod' == mod + = case decl of + ImpUserExplicit avails parents_of_implicits + -> go (avails ++ avails_acc) (parents_acc `unionNameSet` parents_of_implicits) + imp_decls + _ -> HMIA_Implicit vis_exp_hash + | otherwise + = go avails_acc parents_acc imp_decls + +{- Note [Internal used_names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Most of the used_names are External Names, but we can have System Names too. Two examples: diff --git a/GHC/HsToCore/Utils.hs b/GHC/HsToCore/Utils.hs --- a/GHC/HsToCore/Utils.hs +++ b/GHC/HsToCore/Utils.hs @@ -28,8 +28,7 @@ mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult, mkCoSynCaseMatchResult, wrapBind, wrapBinds, - mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs, - mkFailExpr, + mkErrorAppDs, mkCastDs, mkFailExpr, seqVar, @@ -42,9 +41,6 @@ selectSimpleMatchVarL, selectMatchVars, selectMatchVar, mkOptTickBox, mkBinaryTickBox, decideBangHood, isTrueLHsExpr, - - -- Multiplicity - checkMultiplicityCoercions, ) where import GHC.Prelude @@ -58,7 +54,6 @@ import GHC.Hs.Syn.Type import GHC.Core import GHC.HsToCore.Monad -import GHC.HsToCore.Errors.Types import GHC.Core.Utils import GHC.Core.Make @@ -77,7 +72,6 @@ import GHC.Types.Unique.Supply import GHC.Unit.Module import GHC.Builtin.Names -import GHC.Types.Name( isInternalName ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SrcLoc @@ -90,7 +84,7 @@ import GHC.Rename.Env ( irrefutableConLikeTc ) import GHC.Tc.Types.Evidence -import Control.Monad ( unless, zipWithM ) +import Control.Monad ( zipWithM ) import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (maybeToList) import qualified Data.List.NonEmpty as NEL @@ -205,10 +199,13 @@ shiftEqns :: Functor f => f EquationInfoNE -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap eqn_rest +shiftEqns = fmap shift + where + shift (EqnMatch { eqn_rest = rest }) = rest + shift eqn@(EqnDone {}) = pprPanic "shiftEqns" (ppr eqn) combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) +combineEqnRhss = pure . foldr1 combineMatchResults . fmap eqnMatchResult -- Functions on MatchResult CoreExprs @@ -337,7 +334,7 @@ matcher <- dsLExpr $ mkLHsWrap wrapper $ nlHsTyApp matcher_id [getRuntimeRep ty, ty] cont <- mkCoreLams bndrs <$> runMatchResult fail match_result - return $ mkCoreAppsDs (text "patsyn" <+> ppr var) matcher [Var var, ensure_unstrict cont, Lam voidArgId fail] + return $ mkCoreApps matcher [Var var, ensure_unstrict cont, Lam voidArgId fail] where MkCaseAlt{ alt_pat = psyn, alt_bndrs = bndrs, @@ -469,102 +466,6 @@ mkFailExpr ctxt ty = mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString ctxt) -{- -'mkCoreAppDs' and 'mkCoreAppsDs' handle the special-case desugaring of 'seq'. - -Note [Desugaring seq] -~~~~~~~~~~~~~~~~~~~~~ - -There are a few subtleties in the desugaring of `seq`: - - 1. (as described in #1031) - - Consider, - f x y = x `seq` (y `seq` (# x,y #)) - - Because the argument to the outer 'seq' has an unlifted type, we'll use - call-by-value, and compile it as if we had - - f x y = case (y `seq` (# x,y #)) of v -> x `seq` v - - But that is bad, because we now evaluate y before x! - - Seq is very, very special! So we recognise it right here, and desugar to - case x of _ -> case y of _ -> (# x,y #) - - 2. (as described in #2273) - - Consider - let chp = case b of { True -> fst x; False -> 0 } - in chp `seq` ...chp... - Here the seq is designed to plug the space leak of retaining (snd x) - for too long. - - If we rely on the ordinary inlining of seq, we'll get - let chp = case b of { True -> fst x; False -> 0 } - case chp of _ { I# -> ...chp... } - - But since chp is cheap, and the case is an alluring context, we'll - inline chp into the case scrutinee. Now there is only one use of chp, - so we'll inline a second copy. Alas, we've now ruined the purpose of - the seq, by re-introducing the space leak: - case (case b of {True -> fst x; False -> 0}) of - I# _ -> ...case b of {True -> fst x; False -> 0}... - - We can try to avoid doing this by ensuring that the binder-swap in the - case happens, so we get this at an early stage: - case chp of chp2 { I# -> ...chp2... } - But this is fragile. The real culprit is the source program. Perhaps we - should have said explicitly - let !chp2 = chp in ...chp2... - - But that's painful. So the code here does a little hack to make seq - more robust: a saturated application of 'seq' is turned *directly* into - the case expression, thus: - x `seq` e2 ==> case x of x -> e2 -- Note shadowing! - e1 `seq` e2 ==> case x of _ -> e2 - - So we desugar our example to: - let chp = case b of { True -> fst x; False -> 0 } - case chp of chp { I# -> ...chp... } - And now all is well. - - The reason it's a hack is because if you define mySeq=seq, the hack - won't work on mySeq. - - 3. (as described in #2409) - - The isInternalName ensures that we don't turn - True `seq` e - into - case True of True { ... } - which stupidly tries to bind the datacon 'True'. --} - --- NB: Make sure the argument is not representation-polymorphic -mkCoreAppDs :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr -mkCoreAppDs _ (Var f `App` Type _r `App` Type ty1 `App` Type ty2 `App` arg1) arg2 - | f `hasKey` seqIdKey -- Note [Desugaring seq], points (1) and (2) - = Case arg1 case_bndr ty2 [Alt DEFAULT [] arg2] - where - case_bndr = case arg1 of - Var v1 | isInternalName (idName v1) - -> v1 -- Note [Desugaring seq], points (2) and (3) - _ -> mkWildValBinder ManyTy ty1 - -mkCoreAppDs _ (Var f `App` Type _r) arg - | f `hasKey` noinlineIdKey -- See Note [noinlineId magic] in GHC.Types.Id.Make - , (fun, args) <- collectArgs arg - , not (null args) - = (Var f `App` Type (exprType fun) `App` fun) - `mkCoreApps` args - -mkCoreAppDs s fun arg = mkCoreApp s fun arg -- The rest is done in GHC.Core.Make - --- NB: No argument can be representation-polymorphic -mkCoreAppsDs :: SDoc -> CoreExpr -> [CoreExpr] -> CoreExpr -mkCoreAppsDs s fun args = foldl' (mkCoreAppDs s) fun args - mkCastDs :: CoreExpr -> Coercion -> CoreExpr -- We define a desugarer-specific version of GHC.Core.Utils.mkCast, -- because in the immediate output of the desugarer, we can have @@ -1109,9 +1010,3 @@ isTrueLHsExpr (L _ (HsPar _ e)) = isTrueLHsExpr e isTrueLHsExpr _ = Nothing - --- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. -checkMultiplicityCoercions :: MultiplicityCheckCoercions -> DsM () -checkMultiplicityCoercions cos = - unless (all isReflexiveCo cos) $ - diagnosticDs DsMultiplicityCoercionsNotSupported diff --git a/GHC/Iface/Binary.hs b/GHC/Iface/Binary.hs --- a/GHC/Iface/Binary.hs +++ b/GHC/Iface/Binary.hs @@ -43,14 +43,12 @@ import GHC.Utils.Panic import GHC.Utils.Binary as Binary import GHC.Data.FastMutInt -import GHC.Data.FastString (FastString) import GHC.Types.Unique import GHC.Utils.Outputable import GHC.Types.Name.Cache import GHC.Types.SrcLoc import GHC.Platform import GHC.Settings.Constants -import GHC.Utils.Fingerprint import GHC.Iface.Type (IfaceType(..), getIfaceType, putIfaceType, ifaceTypeSharedByte) import Control.Monad @@ -115,7 +113,7 @@ -> CheckHiWay -> TraceBinIFace -> FilePath - -> IO (Fingerprint, ReadBinHandle) + -> IO ReadBinHandle readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do let platform = profilePlatform profile @@ -157,8 +155,7 @@ when (checkHiWay == CheckHiWay) $ errorOnMismatch "mismatched interface file profile tag" tag check_tag - src_hash <- get bh - pure (src_hash, bh) + pure bh -- | Read an interface file. -- @@ -171,12 +168,11 @@ -> FilePath -> IO ModIface readBinIface profile name_cache checkHiWay traceBinIface hi_path = do - (src_hash, bh) <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path + bh <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path mod_iface <- getIfaceWithExtFields name_cache bh return $ mod_iface - & addSourceFingerprint src_hash getIfaceWithExtFields :: NameCache -> ReadBinHandle -> IO ModIface @@ -260,7 +256,6 @@ put_ bh (show hiVersion) let tag = profileBuildTag profile put_ bh tag - put_ bh (mi_src_hash mod_iface) putIfaceWithExtFields traceBinIface compressionLevel bh mod_iface @@ -321,18 +316,21 @@ (ifaceType_wt, ifaceTypeWriter) <- initWriteIfaceType compressionLevel -- Initialise the 'WriterUserData'. - let writerUserData = mkWriterUserData - [ mkSomeBinaryWriter @FastString fsWriter - , mkSomeBinaryWriter @Name nameWriter - -- We sometimes serialise binding and non-binding names differently, but - -- not during 'ModIface' serialisation. Here, we serialise both to the same - -- deduplication table. - -- - -- See Note [Binary UserData] - , mkSomeBinaryWriter @BindingName $ mkWriter (\bh name -> putEntry nameWriter bh (getBindingName name)) - , mkSomeBinaryWriter @IfaceType ifaceTypeWriter - ] - let bh = setWriterUserData bh' writerUserData + -- + -- Similar to how 'getTables' calls 'addReaderToUserData', here we + -- call 'addWriterToUserData' instead of 'setWriterUserData', to + -- avoid overwriting existing writers of other types in bh'. + let bh = + addWriterToUserData fsWriter + $ addWriterToUserData nameWriter + -- We sometimes serialise binding and non-binding names differently, but + -- not during 'ModIface' serialisation. Here, we serialise both to the same + -- deduplication table. + -- + -- See Note [Binary UserData] + $ addWriterToUserData + (mkWriter $ \bh name -> putEntry nameWriter bh $ getBindingName name) + $ addWriterToUserData ifaceTypeWriter bh' ([fs_count, name_count, ifacetype_count] , r) <- -- The order of these entries matters! diff --git a/GHC/Iface/Decl.hs b/GHC/Iface/Decl.hs --- a/GHC/Iface/Decl.hs +++ b/GHC/Iface/Decl.hs @@ -13,7 +13,6 @@ module GHC.Iface.Decl ( coAxiomToIfaceDecl , tyThingToIfaceDecl -- Converting things to their Iface equivalents - , toIfaceBooleanFormula ) where @@ -32,7 +31,7 @@ import GHC.Core.DataCon import GHC.Core.Type import GHC.Core.Multiplicity - +import GHC.Core.TyCo.Tidy import GHC.Types.Id import GHC.Types.Var.Env @@ -40,14 +39,11 @@ import GHC.Types.Name import GHC.Types.Basic import GHC.Types.TyThing -import GHC.Types.SrcLoc import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.Maybe -import GHC.Data.BooleanFormula - import Data.List ( findIndex, mapAccumL ) {- @@ -120,7 +116,7 @@ , ifaxbRHS = toIfaceType rhs , ifaxbIncomps = iface_incomps } where - iface_incomps = map (expectJust "iface_incomps" + iface_incomps = map (expectJust . flip findIndex lhs_s . eqTypes . coAxBranchLHS) incomps @@ -209,18 +205,20 @@ ibr = map (coAxBranchToIfaceBranch tycon lhss) defs axn = coAxiomName ax - ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con) ifaceConDecls (DataTyCon { data_cons = cons, is_type_data = type_data }) = IfDataTyCon type_data (map ifaceConDecl cons) - ifaceConDecls (TupleTyCon { data_con = con }) = IfDataTyCon False [ifaceConDecl con] - ifaceConDecls (SumTyCon { data_cons = cons }) = IfDataTyCon False (map ifaceConDecl cons) - ifaceConDecls AbstractTyCon = IfAbstractTyCon - -- The AbstractTyCon case happens when a TyCon has been trimmed - -- during tidying. - -- Furthermore, tyThingToIfaceDecl is also used in GHC.Tc.Module - -- for GHCi, when browsing a module, in which case the - -- AbstractTyCon and TupleTyCon cases are perfectly sensible. - -- (Tuple declarations are not serialised into interface files.) + ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con) + ifaceConDecls (UnaryClassTyCon { data_con = con}) = IfDataTyCon False [ifaceConDecl con] + ifaceConDecls (TupleTyCon { data_con = con }) = IfDataTyCon False [ifaceConDecl con] + ifaceConDecls (SumTyCon { data_cons = cons }) = IfDataTyCon False (map ifaceConDecl cons) + ifaceConDecls AbstractTyCon = IfAbstractTyCon + -- The AbstractTyCon case happens when a TyCon has been trimmed during tidying. + -- + -- NB: TupleTyCon/SumTyCon/UnaryClassTyCon are never serialised into interface files + -- But tyThingToIfaceDecl is also used in GHC.Tc.Module + -- for GHCi, when browsing a module, in which case the + -- AbstractTyCon, TupleTyCon, SumTyCon are perfectly sensible. + -- (Not sure about UnaryClassTyCon, but easier to treat it uniformly.) ifaceConDecl data_con = IfCon { ifConName = dataConName data_con, @@ -250,7 +248,7 @@ -- we know that the type variables will line up -- The latter (b) is important because we pretty-print type constructors -- by converting to Iface syntax and pretty-printing that - con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars)) + con_env1 = (fst tc_env1, mkVarEnv (zipEqual univ_tvs tc_tyvars)) -- A bit grimy, perhaps, but it's simple! (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs @@ -264,7 +262,7 @@ -- tidying produced. Therefore, tidying the user-written tyvars is a -- simple matter of looking up each variable in the substitution, -- which tidyTyCoVarOcc accomplishes. - tidyUserForAllTyBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder + tidyUserForAllTyBinder :: TidyEnv -> TyVarBinder -> TyVarBinder tidyUserForAllTyBinder env (Bndr tv vis) = Bndr (tidyTyCoVarOcc env tv) vis @@ -287,7 +285,8 @@ ifClassCtxt = tidyToIfaceContext env1 sc_theta, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = toIfaceBooleanFormula $ fmap (mkIfLclName . getOccFS) (classMinimalDef clas) + ifMinDef = toIfaceBooleanFormula (classMinimalDef clas), + ifUnary = isUnaryClassTyCon tycon } (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon) @@ -335,10 +334,3 @@ tidyTyVar :: TidyEnv -> TyVar -> IfLclName tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv) - -toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula -toIfaceBooleanFormula = \case - Var nm -> IfVar nm - And bfs -> IfAnd (map (toIfaceBooleanFormula . unLoc) bfs) - Or bfs -> IfOr (map (toIfaceBooleanFormula . unLoc) bfs) - Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf) diff --git a/GHC/Iface/Env.hs b/GHC/Iface/Env.hs --- a/GHC/Iface/Env.hs +++ b/GHC/Iface/Env.hs @@ -15,7 +15,7 @@ ifaceExportNames, - trace_if, trace_hi_diffs, + trace_if, trace_hi_diffs, trace_hi_diffs_io, -- Name-cache stuff allocateGlobalBinder, @@ -272,6 +272,12 @@ {-# INLINE trace_if #-} -- see Note [INLINE conditional tracing utilities] trace_if logger doc = when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger doc +trace_hi_diffs_io :: Logger -> IO SDoc -> IO () +{-# INLINE trace_hi_diffs_io #-} -- see Note [INLINE conditional tracing utilities] +trace_hi_diffs_io logger doc = + when (logHasDumpFlag logger Opt_D_dump_hi_diffs) $ + doc >>= putMsg logger + trace_hi_diffs :: Logger -> SDoc -> IO () {-# INLINE trace_hi_diffs #-} -- see Note [INLINE conditional tracing utilities] -trace_hi_diffs logger doc = when (logHasDumpFlag logger Opt_D_dump_hi_diffs) $ putMsg logger doc +trace_hi_diffs logger doc = trace_hi_diffs_io logger (pure doc) diff --git a/GHC/Iface/Errors.hs b/GHC/Iface/Errors.hs --- a/GHC/Iface/Errors.hs +++ b/GHC/Iface/Errors.hs @@ -87,7 +87,7 @@ cannotFindModule' :: UnitEnv -> Profile -> ModuleName -> FindResult -> MissingInterfaceError cannotFindModule' unit_env profile mod res = - CantFindErr (ue_units unit_env) FindingModule $ + CantFindErr (ue_homeUnitState unit_env) FindingModule $ cantFindErr unit_env profile mod @@ -131,7 +131,7 @@ | otherwise -> GenericMissing - (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + (map ((\uid -> (uid, lookupUnit (ue_homeUnitState unit_env) uid))) pkg_hiddens) mod_hiddens unusables files _ -> panic "cantFindErr" diff --git a/GHC/Iface/Errors/Ppr.hs b/GHC/Iface/Errors/Ppr.hs --- a/GHC/Iface/Errors/Ppr.hs +++ b/GHC/Iface/Errors/Ppr.hs @@ -59,7 +59,7 @@ diagnosticHints = interfaceErrorHints - diagnosticCode = constructorCode + diagnosticCode = constructorCode @GHC interfaceErrorHints :: IfaceMessage -> [GhcHint] interfaceErrorHints = \ case @@ -336,8 +336,9 @@ ] ] | otherwise = - -- ToDo: This will fail to have enough qualification when the package IDs - -- are the same + -- Display fully qualified unit names. Otherwise we may not have enough + -- qualification and the printed names could look exactly the same. + pprRawUnitIds $ withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ -- we want the Modules below to be qualified with package names, -- so reset the NamePprCtx setting. @@ -345,7 +346,6 @@ , ppr requested_mod , text "differs from name found in the interface file" , ppr read_mod - , parens (text "if these names look the same, try again with -dppr-debug") ] dynamicHashMismatchError :: Module -> ModLocation -> SDoc diff --git a/GHC/Iface/Ext/Ast.hs b/GHC/Iface/Ext/Ast.hs --- a/GHC/Iface/Ext/Ast.hs +++ b/GHC/Iface/Ext/Ast.hs @@ -14,7 +14,6 @@ {-# LANGUAGE UndecidableSuperClasses #-} {-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} -- For the HasLoc instances {- @@ -33,21 +32,21 @@ import GHC.Data.BooleanFormula import GHC.Core.Class ( className, classSCSelIds ) import GHC.Core.ConLike ( conLikeName ) -import GHC.Core.FVs import GHC.Core.DataCon ( dataConNonlinearType ) import GHC.Types.FieldLabel import GHC.Hs import GHC.Hs.Syn.Type import GHC.Utils.Monad ( concatMapM, MonadIO(liftIO) ) +import GHC.Utils.FV ( fvVarList, filterFV ) import GHC.Types.Id ( isDataConId_maybe ) -import GHC.Types.Name ( Name, nameSrcSpan, nameUnique, wiredInNameTyThing_maybe ) +import GHC.Types.Name ( Name, nameSrcSpan, nameUnique, wiredInNameTyThing_maybe, getName ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) -import GHC.Types.Name.Reader ( RecFieldInfo(..) ) +import GHC.Types.Name.Reader ( RecFieldInfo(..), WithUserRdr(..) ) import GHC.Types.SrcLoc -import GHC.Core.Type ( Type ) +import GHC.Core.Type ( Type, ForAllTyFlag(..) ) import GHC.Core.TyCon ( TyCon, tyConClass_maybe ) -import GHC.Core.Predicate import GHC.Core.InstEnv +import GHC.Core.Predicate ( isEvId ) import GHC.Tc.Types import GHC.Tc.Types.Evidence import GHC.Types.Var ( Id, Var, EvId, varName, varType, varUnique ) @@ -55,10 +54,10 @@ import GHC.Builtin.Uniques import GHC.Iface.Make ( mkIfaceExports ) import GHC.Utils.Panic -import GHC.Utils.Misc import GHC.Data.Maybe import GHC.Data.FastString import qualified GHC.Data.Strict as Strict +import GHC.Data.Pair import GHC.Iface.Ext.Types import GHC.Iface.Ext.Utils @@ -83,6 +82,7 @@ import Control.Applicative ( (<|>) ) import GHC.Types.TypeEnv ( TypeEnv ) import Control.Arrow ( second ) +import Data.Traversable ( mapAccumR ) {- Note [Updating HieAst for changes in the GHC AST] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -305,7 +305,7 @@ -> TcGblEnv -> RenamedSource -> m HieFile mkHieFile ms ts rs = do - let src_file = expectJust "mkHieFile" (ml_hs_file $ ms_location ms) + let src_file = expectJust (ml_hs_file $ ms_location ms) src <- liftIO $ BS.readFile src_file pure $ mkHieFileWithSource src_file src ms ts rs @@ -432,7 +432,7 @@ grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnn NoEpAnns) => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan -grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (spanHsLocaLBinds bs) (map getLocA xs) +grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (spanHsLocaLBinds bs) (NE.map getLocA xs) bindingsOnly :: [Context Name] -> HieM [HieAST a] bindingsOnly [] = pure [] @@ -508,36 +508,19 @@ -- things to its right, ala RScoped -- | Each element scopes over the elements to the right -listScopes :: Scope -> [LocatedA a] -> [RScoped (LocatedA a)] -listScopes _ [] = [] -listScopes rhsScope [pat] = [RS rhsScope pat] -listScopes rhsScope (pat : pats) = RS sc pat : pats' - where - pats'@((RS scope p):_) = listScopes rhsScope pats - sc = combineScopes scope $ mkScope $ getLocA p +listScopes :: Traversable f => Scope -> f (LocatedA a) -> f (RScoped (LocatedA a)) +listScopes = fmap snd . mapAccumR (\ (scope :: Scope) pat -> let scope' = combineScopes scope $ mkScope $ getLocA pat in (scope', RS scope pat)) -- | 'listScopes' specialised to 'PScoped' things patScopes - :: Maybe Span + :: Traversable f + => Maybe Span -> Scope -> Scope - -> [LPat (GhcPass p)] - -> [PScoped (LPat (GhcPass p))] -patScopes rsp useScope patScope xs = - map (\(RS sc a) -> PS rsp useScope sc a) $ - listScopes patScope xs - --- | 'listScopes' specialised to 'HsConPatTyArg' -taScopes - :: Scope - -> Scope - -> [HsConPatTyArg (GhcPass a)] - -> [TScoped (HsTyPat (GhcPass a))] -taScopes scope rhsScope xs = - map (\(RS sc a) -> TS (ResolvedScopes [scope, sc]) (unLoc a)) $ - listScopes rhsScope (map (\(HsConPatTyArg _ hstp) -> L (getLoc $ hstp_body hstp) hstp) xs) - -- We make the HsTyPat into a Located one by using the location of the underlying LHsType. - -- We then strip off the redundant location information afterward, and take the union of the given scope and those to the right when forming the TS. + -> f (LPat (GhcPass p)) + -> f (PScoped (LPat (GhcPass p))) +patScopes rsp useScope patScope = + fmap (\(RS sc a) -> PS rsp useScope sc a) . listScopes patScope -- | 'listScopes' specialised to 'TVScoped' things tvScopes @@ -576,9 +559,9 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where getHasLoc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of HsOuterImplicit{} -> - foldl1' combineSrcSpans [getHasLoc a, getHasLocList b, getHasLoc c] + foldl1' combineSrcSpans (getHasLoc a :| getHasLocList b : getHasLoc c : []) HsOuterExplicit{hso_bndrs = tvs} -> - foldl1' combineSrcSpans [getHasLoc a, getHasLocList tvs, getHasLocList b, getHasLoc c] + foldl1' combineSrcSpans (getHasLoc a :| getHasLocList tvs : getHasLocList b : getHasLoc c : []) instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg (GhcPass p) tm ty) where getHasLoc (HsValArg _ tm) = getHasLoc tm @@ -686,22 +669,19 @@ []] _ -> pure [] -evVarsOfTermList :: EvTerm -> [EvId] -evVarsOfTermList (EvExpr e) = exprSomeFreeVarsList isEvVar e -evVarsOfTermList (EvTypeable _ ev) = - case ev of - EvTypeableTyCon _ e -> concatMap evVarsOfTermList e - EvTypeableTyApp e1 e2 -> concatMap evVarsOfTermList [e1,e2] - EvTypeableTrFun e1 e2 e3 -> concatMap evVarsOfTermList [e1,e2,e3] - EvTypeableTyLit e -> evVarsOfTermList e -evVarsOfTermList (EvFun{}) = [] +instance ToHie (Context (Located (WithUserRdr Name))) where + toHie (C c (L l (WithUserRdr _ n))) = toHie $ C c (L l n) +hieEvIdsOfTerm :: EvTerm -> [EvId] +-- Returns only EvIds satisfying relevantEvId +hieEvIdsOfTerm tm = fvVarList (filterFV isEvId (evTermFVs tm)) + instance ToHie (EvBindContext (LocatedA TcEvBinds)) where toHie (EvBindContext sc sp (L span (EvBinds bs))) = concatMapM go $ bagToList bs where go evbind = do - let evDeps = evVarsOfTermList $ eb_rhs evbind + let evDeps = hieEvIdsOfTerm $ eb_rhs evbind depNames = EvBindDeps $ map varName evDeps concatM $ [ toHie (C (EvidenceVarBind (EvLetBind depNames) (combineScopes sc (mkScope span)) sp) @@ -722,7 +702,7 @@ toHie $ C (EvidenceVarBind EvWrapperBind (mkScope osp) (getRealSpanA osp)) $ L osp a (WpEvApp a) -> - concatMapM (toHie . C EvidenceVarUse . L osp) $ evVarsOfTermList a + concatMapM (toHie . C EvidenceVarUse . L osp) $ hieEvIdsOfTerm a _ -> pure [] instance HiePass p => HasType (LocatedA (HsBind (GhcPass p))) where @@ -831,13 +811,17 @@ , Data (HsCmdTop (GhcPass p)) , Data (GRHS (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) , Data (HsUntypedSplice (GhcPass p)) + , Data (HsTypedSplice (GhcPass p)) , Data (HsLocalBinds (GhcPass p)) , Data (FieldOcc (GhcPass p)) , Data (HsTupArg (GhcPass p)) , Data (IPBind (GhcPass p)) , ToHie (Context (Located (IdGhcP p))) + , ToHie (Context (Located (IdOccGhcP p))) , Anno (IdGhcP p) ~ SrcSpanAnnN + , Anno (IdOccGhcP p) ~ SrcSpanAnnN , Typeable p + , IsPass p ) => HiePass p where hiePass :: HiePassEv p @@ -935,18 +919,21 @@ varScope = mkScope var patScope = mkScope $ getLoc pat detScope = case dets of - (PrefixCon _ args) -> foldr combineScopes NoScope $ map mkScope args + (PrefixCon args) -> foldr combineScopes NoScope $ map mkScope args (InfixCon a b) -> combineScopes (mkScope a) (mkScope b) (RecCon r) -> foldr go NoScope r - go (RecordPatSynField a b) c = combineScopes c + go (RecordPatSynField (a :: FieldOcc (GhcPass p)) b) c = combineScopes c $ combineScopes (mkScope (foLabel a)) (mkScope b) detSpan = case detScope of LocalScope a -> Just a _ -> Nothing - toBind (PrefixCon ts args) = assert (null ts) $ PrefixCon ts $ map (C Use) args + toBind (PrefixCon args) = PrefixCon $ map (C Use) args toBind (InfixCon a b) = InfixCon (C Use a) (C Use b) toBind (RecCon r) = RecCon $ map (PSC detSpan) r +instance ToHie a => ToHie (WithUserRdr a) where + toHie (WithUserRdr _ a) = toHie a + instance HiePass p => ToHie (HsPatSynDir (GhcPass p)) where toHie dir = case dir of ExplicitBidirectional mg -> toHie mg @@ -1039,7 +1026,7 @@ ] ] HieRn -> - [ toHie $ C Use con + [ toHie $ C Use (fmap getName con) , toHie $ contextify dets ] ViewPat _ expr pat -> @@ -1086,14 +1073,12 @@ ] ExpansionPat _ p -> [ toHie $ PS rsp scope pscope (L ospan p) ] where - contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a) - -> HsConDetails (TScoped (HsTyPat GhcRn)) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a))) - contextify (PrefixCon tyargs args) = - PrefixCon (taScopes scope argscope tyargs) - (patScopes rsp scope pscope args) - where argscope = foldr combineScopes NoScope $ map mkScope args + contextify :: a ~ LPat (GhcPass p) => HsConDetails a (HsRecFields (GhcPass p) a) + -> HsConDetails (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a))) + contextify (PrefixCon args) = + PrefixCon (patScopes rsp scope pscope args) contextify (InfixCon a b) = InfixCon a' b' - where [a', b'] = patScopes rsp scope pscope [a,b] + where Pair a' b' = patScopes rsp scope pscope (Pair a b) contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r contextify_rec (HsRecFields x fds a) = HsRecFields x (map go scoped_fds) a where @@ -1203,7 +1188,6 @@ [ toHie $ C Use (L mspan var) -- Patch up var location since typechecker removes it ] - HsUnboundVar _ _ -> [] -- there is an unbound name here, but that causes trouble HsOverLabel {} -> [] HsIPVar _ _ -> [] HsOverLit _ o -> @@ -1276,7 +1260,7 @@ where con_name :: LocatedN Name con_name = case hiePass @p of -- Like ConPat - HieRn -> con + HieRn -> fmap getName con HieTc -> fmap conLikeName con RecordUpd { rupd_expr = expr , rupd_flds = RegularRecUpdFields { recUpdFields = upds } }-> @@ -1321,7 +1305,7 @@ HieTc -> dataConCantHappen x HsFunArr x mult arg res -> case hiePass @p of HieRn -> - [ toHie (arrowToHsExpr mult) + [ toHie (multAnnToHsExpr mult) , toHie arg , toHie res ] @@ -1344,13 +1328,14 @@ , toHie p ] HsTypedSplice _ x -> - [ toHie x + [ toHie $ L mspan x ] HsUntypedSplice _ x -> [ toHie $ L mspan x ] HsGetField {} -> [] HsProjection {} -> [] + HsHole _ -> [] -- there is a hole here, but that causes trouble XExpr x -> case hiePass @p of HieTc -> case x of WrapExpr w a @@ -1531,8 +1516,8 @@ , toHie $ PS Nothing sc NoScope pat ] -instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg rec) where - toHie (PrefixCon tyargs args) = concatM [ toHie tyargs, toHie args ] +instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where + toHie (PrefixCon args) = toHie args toHie (RecCon rec) = toHie rec toHie (InfixCon a b) = concatM [ toHie a, toHie b] @@ -1639,8 +1624,8 @@ ] where context_scope = mkScope $ fromMaybe (noLocA []) context - rhs_scope = foldl1' combineScopes $ map mkScope - [ getHasLocList deps, getHasLocList sigs, getHasLocList meths, getHasLocList typs, getHasLocList deftyps] + rhs_scope = foldl1' combineScopes $ NE.map mkScope + ( getHasLocList deps :| getHasLocList sigs : getHasLocList meths : getHasLocList typs : getHasLocList deftyps : []) instance ToHie (LocatedA (FamilyDecl GhcRn)) where toHie (L span decl) = concatM $ makeNodeA decl span : case decl of @@ -1745,21 +1730,20 @@ instance ToHie (LocatedP OverlapMode) where toHie (L span _) = locOnly (locA span) -instance ToHie a => ToHie (HsScaled GhcRn a) where - toHie (HsScaled w t) = concatM [toHie (arrowToHsType w), toHie t] - instance ToHie (LocatedA (ConDecl GhcRn)) where toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of - ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs - , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ + ConDeclGADT { con_names = names + , con_outer_bndrs = L outer_bndrs_loc outer_bndrs + , con_inner_bndrs = inner_bndrs + , con_mb_cxt = ctx + , con_g_args = args + , con_res_ty = typ , con_doc = doc} -> [ toHie $ C (Decl ConDec $ getRealSpanA span) <$> names - , case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_vars} -> - bindingsOnly $ map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope) - imp_vars - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - toHie $ tvScopes resScope NoScope exp_bndrs + , bindingsOnly $ -- implicit forall + map (C $ TyVarBind (mkScope outer_bndrs_loc) (ResolvedScopes [sigmaScope])) + imp_vars + , toHie $ tvScopes (ResolvedScopes [phiScope]) NoScope exp_bndrs , toHie ctx , toHie args , toHie typ @@ -1772,7 +1756,14 @@ PrefixConGADT _ xs -> scaled_args_scope xs RecConGADT _ x -> mkScope x tyScope = mkScope typ - resScope = ResolvedScopes [ctxScope, rhsScope] + phiScope = combineScopes ctxScope rhsScope + sigmaScope = foldr combineScopes phiScope (map (mkScope . getLoc) exp_bndrs) + imp_vars = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_vars} -> imp_vars + HsOuterExplicit{} -> [] + exp_bndrs = + [ L l (updateHsTyVarBndrFlag Invisible b) | L l b <- hsOuterExplicitBndrs outer_bndrs ] + ++ concatMap hsForAllTelescopeBndrs inner_bndrs ConDeclH98 { con_name = name, con_ex_tvs = qvars , con_mb_cxt = ctx, con_args = dets , con_doc = doc} -> @@ -1786,18 +1777,25 @@ rhsScope = combineScopes ctxScope argsScope ctxScope = maybe NoScope mkScope ctx argsScope = case dets of - PrefixCon _ xs -> scaled_args_scope xs - InfixCon a b -> scaled_args_scope [a, b] - RecCon x -> mkScope x - where scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope - scaled_args_scope = foldr combineScopes NoScope . map (mkScope . hsScaledThing) + PrefixCon xs -> scaled_args_scope xs + InfixCon a b -> scaled_args_scope [a, b] + RecCon x -> mkScope x + where scaled_args_scope :: [HsConDeclField GhcRn] -> Scope + scaled_args_scope = foldr combineScopes NoScope . map (mkScope . cdf_type) -instance ToHie (LocatedL [LocatedA (ConDeclField GhcRn)]) where +instance ToHie (LocatedL [LocatedA (HsConDeclRecField GhcRn)]) where toHie (L span decls) = concatM $ [ locOnly (locA span) , toHie decls ] +instance ToHie (HsConDeclField GhcRn) where + toHie (CDF { cdf_multiplicity, cdf_type, cdf_doc }) = concatM + [ toHie (multAnnToHsType cdf_multiplicity) + , toHie cdf_type + , toHie cdf_doc + ] + instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) where toHie (TS sc (HsWC names a)) = concatM $ [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names @@ -1851,6 +1849,10 @@ [ toHie $ (C Use) name , toHie $ map (TS (ResolvedScopes [])) typs ] + SpecSigE _ bndrs spec_e _ -> + [ toHieRuleBndrs (locA sp) (mkScope spec_e) bndrs + , toHie spec_e + ] SpecInstSig _ typ -> [ toHie $ TS (ResolvedScopes []) typ ] @@ -1907,7 +1909,7 @@ , toHie ki ] HsFunTy _ w a b -> - [ toHie (arrowToHsType w) + [ toHie (multAnnToHsType w) , toHie a , toHie b ] @@ -1943,12 +1945,6 @@ [ toHie a , toHie doc ] - HsBangTy _ _ ty -> - [ toHie ty - ] - HsRecTy _ fields -> - [ toHie fields - ] HsExplicitListTy _ _ tys -> [ toHie tys ] @@ -1997,12 +1993,11 @@ , toHie exprs ] -instance ToHie (LocatedA (ConDeclField GhcRn)) where +instance ToHie (LocatedA (HsConDeclRecField GhcRn)) where toHie (L span field) = concatM $ makeNode field (locA span) : case field of - ConDeclField _ fields typ doc -> - [ toHie $ map (RFC RecFieldDecl (getRealSpan $ getHasLoc typ)) fields + HsConDeclRecField _ fields typ -> + [ toHie $ map (RFC RecFieldDecl (getRealSpan $ getHasLoc $ cdf_type typ)) fields , toHie typ - , toHie doc ] instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where @@ -2035,14 +2030,23 @@ toHie (TypBr _ ty) = toHie ty toHie (VarBr {} ) = pure [] -instance ToHie PendingRnSplice where - toHie (PendingRnSplice _ _ e) = toHie e +instance forall pass . HiePass pass => ToHie (HsUntypedSplice (GhcPass pass)) where + toHie (HsUntypedSpliceExpr _ext e) = toHie e + toHie (HsQuasiQuote _ext quoter _ispanFs) = toHie (C Use quoter) + toHie (XUntypedSplice ext) = + case ghcPass @pass of + GhcRn -> case ext of + HsImplicitLiftSplice _ _ _ lid -> toHie (C Use lid) instance ToHie PendingTcSplice where toHie (PendingTcSplice _ e) = toHie e -instance ToHie (LBooleanFormula (LocatedN Name)) where - toHie (L span form) = concatM $ makeNode form (locA span) : case form of +instance ToHie PendingRnSplice where + toHie (PendingRnSplice _ e) = toHie e + +instance (HiePass p, Data (IdGhcP p)) + => ToHie (GenLocated SrcSpanAnnL (BooleanFormula (GhcPass p))) where + toHie (L span form) = concatM $ makeNode form (locA span) : case form of Var a -> [ toHie $ C Use a ] @@ -2059,7 +2063,7 @@ instance ToHie (LocatedAn NoEpAnns HsIPName) where toHie (L span e) = makeNodeA e span -instance HiePass p => ToHie (LocatedA (HsUntypedSplice (GhcPass p))) where +instance (HiePass p) => ToHie (LocatedA (HsUntypedSplice (GhcPass p))) where toHie (L span sp) = concatM $ makeNodeA sp span : case sp of HsUntypedSpliceExpr _ expr -> [ toHie expr @@ -2067,7 +2071,28 @@ HsQuasiQuote _ _ ispanFs -> [ locOnly (getLocA ispanFs) ] + XUntypedSplice x -> + case ghcPass @p of + GhcRn -> case x of + HsImplicitLiftSplice _ _ _ lid -> + [ toHie $ C Use lid + ] +instance HiePass p => ToHie (LocatedA (HsTypedSplice (GhcPass p))) where + toHie (L span sp) = concatM $ makeNodeA sp span : case sp of + HsTypedSpliceExpr _ expr -> + [ toHie expr + ] + XTypedSplice x -> + case ghcPass @p of + GhcRn -> case x of + HsImplicitLiftSplice _ _ _ lid -> + [ toHie $ C Use lid + ] + + + + instance ToHie (LocatedA (RoleAnnotDecl GhcRn)) where toHie (L span annot) = concatM $ makeNodeA annot span : case annot of RoleAnnotDecl _ var roles -> @@ -2108,7 +2133,6 @@ instance HiePass p => ToHie (Context (FieldOcc (GhcPass p))) where toHie (C c (FieldOcc _ l)) = toHie (C c l) - toHie (C _ (XFieldOcc _)) = concatM [] instance HiePass p => ToHie (PatSynFieldContext (RecordPatSynField (GhcPass p))) where toHie (PSC sp (RecordPatSynField a b)) = concatM $ @@ -2194,19 +2218,26 @@ ] instance ToHie (LocatedA (RuleDecl GhcRn)) where - toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM + toHie (L span r@(HsRule { rd_name = rname, rd_bndrs = bndrs + , rd_lhs = exprA, rd_rhs = exprB })) + = concatM [ makeNodeA r span , locOnly $ getLocA rname - , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs - , toHie $ map (RS $ mkScope (locA span)) bndrs + , toHieRuleBndrs (locA span) scope bndrs , toHie exprA , toHie exprB ] - where scope = bndrs_sc `combineScopes` exprA_sc `combineScopes` exprB_sc - bndrs_sc = maybe NoScope mkScope (listToMaybe bndrs) - exprA_sc = mkScope exprA - exprB_sc = mkScope exprB + where + scope = mkScope exprA `combineScopes` mkScope exprB +toHieRuleBndrs :: SrcSpan -> Scope -> RuleBndrs GhcRn -> HieM [HieAST Type] +toHieRuleBndrs span body_sc (RuleBndrs { rb_tyvs = tybndrs, rb_tmvs = bndrs }) + = concatM [ toHie $ fmap (tvScopes (ResolvedScopes []) full_sc) tybndrs + , toHie $ map (RS $ mkScope (locA span)) bndrs ] + where + full_sc = bndrs_sc `combineScopes` body_sc + bndrs_sc = maybe NoScope mkScope (listToMaybe bndrs) + instance ToHie (RScoped (LocatedAn NoEpAnns (RuleBndr GhcRn))) where toHie (RS sc (L span bndr)) = concatM $ makeNodeA bndr span : case bndr of RuleBndr _ var -> @@ -2271,6 +2302,9 @@ [ toHie $ C (IEThing c) (L l p) ] IEType _ (L l n) -> + [ toHie $ C (IEThing c) (L l n) + ] + IEData _ (L l n) -> [ toHie $ C (IEThing c) (L l n) ] diff --git a/GHC/Iface/Flags.hs b/GHC/Iface/Flags.hs new file mode 100644 --- /dev/null +++ b/GHC/Iface/Flags.hs @@ -0,0 +1,194 @@ +-- | Datatype definitions for the flag representation stored in interface files +module GHC.Iface.Flags ( + IfaceDynFlags(..) + , IfaceGeneralFlag(..) + , IfaceProfAuto(..) + , IfaceExtension(..) + , IfaceLanguage(..) + , IfaceCppOptions(..) + , pprIfaceDynFlags + , missingExtraFlagInfo + ) where + +import GHC.Prelude + +import GHC.Utils.Outputable +import Control.DeepSeq +import GHC.Utils.Fingerprint +import GHC.Utils.Binary + +import GHC.Driver.DynFlags +import GHC.Types.SafeHaskell +import GHC.Core.Opt.CallerCC.Types + +import qualified GHC.LanguageExtensions as LangExt + +-- The part of DynFlags which recompilation information needs +data IfaceDynFlags = IfaceDynFlags + { ifaceMainIs :: Maybe (Maybe String) + , ifaceSafeMode :: IfaceTrustInfo + , ifaceLang :: Maybe IfaceLanguage + , ifaceExts :: [IfaceExtension] + , ifaceCppOptions :: IfaceCppOptions + , ifaceJsOptions :: IfaceCppOptions + , ifaceCmmOptions :: IfaceCppOptions + , ifacePaths :: [String] + , ifaceProf :: Maybe IfaceProfAuto + , ifaceTicky :: [IfaceGeneralFlag] + , ifaceCodeGen :: [IfaceGeneralFlag] + , ifaceFatIface :: Bool + , ifaceDebugLevel :: Int + , ifaceCallerCCFilters :: [CallerCcFilter] + } + +pprIfaceDynFlags :: IfaceDynFlags -> SDoc +pprIfaceDynFlags (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) = + vcat [ text "main-is:" <+> (ppr $ fmap (fmap (text @SDoc)) a1) + , text "safe-mode:" <+> ppr a2 + , text "lang:" <+> ppr a3 + , text "exts:" <+> ppr a4 + , text "cpp-options:" + , nest 2 $ ppr a5 + , text "js-options:" + , nest 2 $ ppr a6 + , text "cmm-options:" + , nest 2 $ ppr a7 + , text "paths:" <+> hcat (map text a8) + , text "prof:" <+> ppr a9 + , text "ticky:" + , nest 2 $ vcat (map ppr a10) + , text "codegen:" + , nest 2 $ vcat (map ppr a11) + , text "fat-iface:" <+> ppr a12 + , text "debug-level:" <+> ppr a13 + , text "caller-cc-filters:" <+> ppr a14 + ] + +missingExtraFlagInfo :: SDoc +missingExtraFlagInfo = text "flags: no detailed info, recompile with -fwrite-if-self-recomp-flags" + where + -- If you modify the name of this flag, you have to modify this string. + _placeholder = Opt_WriteSelfRecompFlags + +instance Binary IfaceDynFlags where + put_ bh (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) = do + put_ bh a1 + put_ bh a2 + put_ bh a3 + put_ bh a4 + put_ bh a5 + put_ bh a6 + put_ bh a7 + put_ bh a8 + put_ bh a9 + put_ bh a10 + put_ bh a11 + put_ bh a12 + put_ bh a13 + put_ bh a14 + get bh = IfaceDynFlags <$> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + <*> get bh + +instance NFData IfaceDynFlags where + rnf (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) = + rnf a1 + `seq` rnf a2 + `seq` rnf a3 + `seq` rnf a4 + `seq` rnf a5 + `seq` rnf a6 + `seq` rnf a7 + `seq` rnf a8 + `seq` rnf a9 + `seq` rnf a10 + `seq` rnf a11 + `seq` rnf a12 + `seq` rnf a13 + `seq` rnf a14 + +newtype IfaceGeneralFlag = IfaceGeneralFlag GeneralFlag + +instance NFData IfaceGeneralFlag where + rnf (IfaceGeneralFlag !_) = () + +instance Binary IfaceGeneralFlag where + put_ bh (IfaceGeneralFlag f) = put_ bh (fromEnum f) + get bh = IfaceGeneralFlag . toEnum <$> get bh + +instance Outputable IfaceGeneralFlag where + ppr (IfaceGeneralFlag f) = text (show f) + +newtype IfaceProfAuto = IfaceProfAuto ProfAuto + +instance NFData IfaceProfAuto where + rnf (IfaceProfAuto !_) = () + +instance Binary IfaceProfAuto where + put_ bh (IfaceProfAuto f) = put_ bh (fromEnum f) + get bh = IfaceProfAuto . toEnum <$> get bh + +instance Outputable IfaceProfAuto where + ppr (IfaceProfAuto f) = text (show f) + + +newtype IfaceExtension = IfaceExtension LangExt.Extension + +instance NFData IfaceExtension where + rnf (IfaceExtension !_) = () + +instance Binary IfaceExtension where + put_ bh (IfaceExtension f) = put_ bh (fromEnum f) + get bh = IfaceExtension . toEnum <$> get bh + +instance Outputable IfaceExtension where + ppr (IfaceExtension f) = text (show f) + +newtype IfaceLanguage = IfaceLanguage Language + +instance NFData IfaceLanguage where + rnf (IfaceLanguage !_) = () + +instance Binary IfaceLanguage where + put_ bh (IfaceLanguage f) = put_ bh (fromEnum f) + get bh = IfaceLanguage . toEnum <$> get bh + +instance Outputable IfaceLanguage where + ppr (IfaceLanguage f) = text (show f) + +data IfaceCppOptions = IfaceCppOptions { ifaceCppIncludes :: [FilePath] + , ifaceCppOpts :: [String] + , ifaceCppSig :: ([String], Fingerprint) + } + +instance NFData IfaceCppOptions where + rnf (IfaceCppOptions is os s) = rnf is `seq` rnf os `seq` rnf s + +instance Binary IfaceCppOptions where + put_ bh (IfaceCppOptions is os s) = do + put_ bh is + put_ bh os + put_ bh s + get bh = IfaceCppOptions <$> get bh <*> get bh <*> get bh + +instance Outputable IfaceCppOptions where + ppr (IfaceCppOptions is os (wos, fp)) = + vcat [text "includes:" + , nest 2 $ hcat (map text is) + , text "opts:" + , nest 2 $ hcat (map text os) + , text "signature:" + , nest 2 $ parens (ppr fp) <+> ppr (map (text @SDoc) wos) + + ] diff --git a/GHC/Iface/Load.hs b/GHC/Iface/Load.hs --- a/GHC/Iface/Load.hs +++ b/GHC/Iface/Load.hs @@ -35,6 +35,8 @@ pprModIfaceSimple, ifaceStats, pprModIface, showIface, + getGhcPrimIface, + module Iface_Errors -- avoids boot files in Ppr modules ) where @@ -46,7 +48,6 @@ ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst , tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceDefaults) -import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Driver.DynFlags @@ -104,7 +105,7 @@ import GHC.Unit.Module.Deps import GHC.Unit.State import GHC.Unit.Home -import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable import GHC.Unit.Finder import GHC.Unit.Env @@ -118,6 +119,8 @@ import {-# source #-} GHC.Driver.Main (loadIfaceByteCode) import GHC.Iface.Errors.Types import Data.Function ((&)) +import GHC.Unit.Module.Graph +import qualified GHC.Unit.Home.Graph as HUG {- ************************************************************************ @@ -442,7 +445,7 @@ -- Check whether we have the interface already ; hsc_env <- getTopEnv ; let mhome_unit = ue_homeUnit (hsc_unit_env hsc_env) - ; case lookupIfaceByModule hug (eps_PIT eps) mod of { + ; liftIO (lookupIfaceByModule hug (eps_PIT eps) mod) >>= \case { Just iface -> return (Succeeded iface) ; -- Already loaded _ -> do { @@ -504,7 +507,7 @@ ((isOneShot (ghcMode (hsc_dflags hsc_env))) || moduleUnitId mod `notElem` hsc_all_home_unit_ids hsc_env || mod == gHC_PRIM) - (text "Attempting to load home package interface into the EPS" $$ ppr hug $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) + (text "Attempting to load home package interface into the EPS" $$ ppr (HUG.allUnits hug) $$ doc_str $$ ppr mod $$ ppr (moduleUnitId mod)) ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ; new_eps_decls <- tcIfaceDecls ignore_prags (mi_decls iface) ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface) @@ -522,7 +525,7 @@ & set_mi_fam_insts (panic "No mi_fam_insts in PIT") & set_mi_rules (panic "No mi_rules in PIT") & set_mi_anns (panic "No mi_anns in PIT") - & set_mi_extra_decls (panic "No mi_extra_decls in PIT") + & set_mi_simplified_core (panic "No mi_simplified_core in PIT") bad_boot = mi_boot iface == IsBoot && isJust (lookupKnotVars (if_rec_types gbl_env) mod) @@ -652,38 +655,55 @@ | otherwise = gbl_env { if_rec_types = emptyKnotVars } cleanTopEnv hsc_env = - let - !maybe_type_vars | inOneShot = Just (hsc_type_env_vars env) - | otherwise = Nothing - -- wrinkle: when we're typechecking in --backpack mode, the - -- instantiation of a signature might reside in the HPT, so - -- this case breaks the assumption that EPS interfaces only - -- refer to other EPS interfaces. - -- As a temporary (MP Oct 2021 #20509) we only keep the HPT if it - -- contains any hole modules. - -- Quite a few tests in testsuite/tests/backpack break without this - -- tweak. - old_unit_env = hsc_unit_env hsc_env - keepFor20509 hmi - | isHoleModule (mi_semantic_module (hm_iface hmi)) = True - | otherwise = False - pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable } - !unit_env - = old_unit_env - { ue_home_unit_graph = if anyHpt keepFor20509 (ue_hpt old_unit_env) then ue_home_unit_graph old_unit_env - else unitEnv_map pruneHomeUnitEnv (ue_home_unit_graph old_unit_env) - } - in - hsc_env { hsc_targets = panic "cleanTopEnv: hsc_targets" - , hsc_mod_graph = panic "cleanTopEnv: hsc_mod_graph" - , hsc_IC = panic "cleanTopEnv: hsc_IC" - , hsc_type_env_vars = case maybe_type_vars of - Just vars -> vars - Nothing -> panic "cleanTopEnv: hsc_type_env_vars" - , hsc_unit_env = unit_env - } + let + !maybe_type_vars | inOneShot = Just (hsc_type_env_vars env) + | otherwise = Nothing + -- wrinkle: when we're typechecking in --backpack mode, the + -- instantiation of a signature might reside in the HPT, so + -- this case breaks the assumption that EPS interfaces only + -- refer to other EPS interfaces. + -- As a temporary (MP Oct 2021 #20509) we only keep the HPT if it + -- contains any hole modules. + -- Quite a few tests in testsuite/tests/backpack break without this + -- tweak. + old_unit_env = hsc_unit_env hsc_env + keepFor20509 + -- oneshot mode does not support backpack + -- and we want to avoid prodding the hsc_mod_graph thunk + | isOneShot (ghcMode (hsc_dflags hsc_env)) = False + | mgHasHoles (ue_module_graph old_unit_env) = True + | otherwise = False + pruneHomeUnitEnv hme = do + -- NB: These are empty HPTs because Iface/Load first consults the HPT + emptyHPT <- liftIO emptyHomePackageTable + return $! hme{ homeUnitEnv_hpt = emptyHPT } + unit_env_io + | keepFor20509 + = return old_unit_env + | otherwise + = do + hug' <- traverse pruneHomeUnitEnv (ue_home_unit_graph old_unit_env) + let !new_mod_graph = emptyMG { mg_mss = panic "cleanTopEnv: mg_mss" + , mg_graph = panic "cleanTopEnv: mg_graph" + , mg_has_holes = keepFor20509 } + return old_unit_env + { ue_home_unit_graph = hug' + , ue_module_graph = new_mod_graph + } + in do + !unit_env <- unit_env_io + -- mg_has_holes will be checked again, but nothing else about the module graph + pure $ + hsc_env + { hsc_targets = panic "cleanTopEnv: hsc_targets" + , hsc_IC = panic "cleanTopEnv: hsc_IC" + , hsc_type_env_vars = case maybe_type_vars of + Just vars -> vars + Nothing -> panic "cleanTopEnv: hsc_type_env_vars" + , hsc_unit_env = unit_env + } - updTopEnv cleanTopEnv $ updGblEnv cleanGblEnv $ do + updTopEnvIO cleanTopEnv $ updGblEnv cleanGblEnv $ do !_ <- getTopEnv -- force the updTopEnv !_ <- getGblEnv thing_inside @@ -758,13 +778,14 @@ liftIO $ trace_if logger (text "Considering whether to load" <+> ppr mod <+> text "to compute precise free module holes") (eps, hpt) <- getEpsAndHug - case tryEpsAndHpt eps hpt `firstJust` tryDepsCache eps imod insts of - Just r -> return (Succeeded r) - Nothing -> readAndCache imod insts + result <- tryEpsAndHpt eps hpt + case result `firstJust` tryDepsCache eps imod insts of + Just r -> return (Succeeded r) + Nothing -> readAndCache imod insts (_, Nothing) -> return (Succeeded emptyUniqDSet) where tryEpsAndHpt eps hpt = - fmap mi_free_holes (lookupIfaceByModule hpt (eps_PIT eps) mod) + fmap mi_free_holes <$> liftIO (lookupIfaceByModule hpt (eps_PIT eps) mod) tryDepsCache eps imod insts = case lookupInstalledModuleEnv (eps_free_holes eps) imod of Just ifhs -> Just (renameFreeHoles ifhs insts) @@ -870,13 +891,11 @@ let profile = targetProfile dflags unit_state = hsc_units hsc_env - fc = hsc_FC hsc_env name_cache = hsc_NC hsc_env mhome_unit = hsc_home_unit_maybe hsc_env dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env - other_fopts = initFinderOpts . homeUnitEnv_dflags <$> (hsc_HUG hsc_env) trace_if logger (sep [hsep [text "Reading", @@ -887,66 +906,53 @@ ppr mod <> semi], nest 4 (text "reason:" <+> doc_str)]) - -- Check for GHC.Prim, and return its static interface - -- See Note [GHC.Prim] in primops.txt.pp. - -- TODO: make this check a function - if mod `installedModuleEq` gHC_PRIM - then do - let iface = case ghcPrimIfaceHook hooks of - Nothing -> ghcPrimIface - Just h -> h - return (Succeeded (iface, panic "GHC.Prim ModLocation (findAndReadIface)")) - else do - let fopts = initFinderOpts dflags - -- Look for the file - mb_found <- liftIO (findExactModule fc fopts other_fopts unit_state mhome_unit mod) - case mb_found of - InstalledFound (addBootSuffixLocn_maybe hi_boot_file -> loc) mod -> do - -- See Note [Home module load error] - case mhome_unit of - Just home_unit - | isHomeInstalledModule home_unit mod - , not (isOneShot (ghcMode dflags)) - -> return (Failed (HomeModError mod loc)) - _ -> do - r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) - case r of - Failed err - -> return (Failed $ BadIfaceFile err) - Succeeded (iface,_fp) - -> do - r2 <- load_dynamic_too_maybe logger name_cache unit_state - (setDynamicNow dflags) wanted_mod - iface loc - case r2 of - Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return $ Succeeded (iface, loc) - err -> do - trace_if logger (text "...not found") - return $ Failed $ cannotFindInterface - unit_state - mhome_unit - profile - (moduleName mod) - err + -- Look for the file + mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file) + case mb_found of + InstalledFound loc -> do + -- See Note [Home module load error] + if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env) + && not (isOneShot (ghcMode dflags)) + then return (Failed (HomeModError mod loc)) + else do + r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) + case r of + Failed err + -> return (Failed $ BadIfaceFile err) + Succeeded (iface,_fp) + -> do + r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state + (setDynamicNow dflags) wanted_mod + iface loc + case r2 of + Failed sdoc -> return (Failed sdoc) + Succeeded {} -> return $ Succeeded (iface, loc) + err -> do + trace_if logger (text "...not found") + return $ Failed $ cannotFindInterface + unit_state + mhome_unit + profile + (moduleName mod) + err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags +load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) -load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc +load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) - | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc + | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags +load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr MissingInterfaceError ()) -load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do - read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case +load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do + read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) - | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) + | mi_mod_hash iface == mi_mod_hash dynIface -> return (Succeeded ()) | otherwise -> do return $ (Failed $ DynamicHashMismatchError wanted_mod loc) @@ -958,11 +964,10 @@ -read_file :: Logger -> NameCache -> UnitState -> DynFlags +read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) -read_file logger name_cache unit_state dflags wanted_mod file_path = do - trace_if logger (text "readIFace" <+> text file_path) +read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do -- Figure out what is recorded in mi_module. If this is -- a fully definite interface, it'll match exactly, but @@ -973,7 +978,7 @@ (_, Just indef_mod) -> instModuleToModule unit_state (uninstantiateInstantiatedModule indef_mod) - read_result <- readIface dflags name_cache wanted_mod' file_path + read_result <- readIface hooks logger dflags name_cache wanted_mod' file_path case read_result of Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) @@ -1000,12 +1005,15 @@ -- Failed err <=> file not found, or unreadable, or illegible -- Succeeded iface <=> successfully found and parsed readIface - :: DynFlags + :: Hooks + -> Logger + -> DynFlags -> NameCache -> Module -> FilePath -> IO (MaybeErr ReadInterfaceError ModIface) -readIface dflags name_cache wanted_mod file_path = do +readIface hooks logger dflags name_cache wanted_mod file_path = do + trace_if logger (text "readIFace" <+> text file_path) let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path case res of @@ -1014,9 +1022,14 @@ -- critical for correctness of recompilation checking -- (it lets us tell when -this-unit-id has changed.) | wanted_mod == actual_mod - -> return (Succeeded iface) + -> return (Succeeded final_iface) | otherwise -> return (Failed err) where + final_iface + -- Check for GHC.Prim, and return its static interface + -- See Note [GHC.Prim] in primops.txt.pp. + | wanted_mod == gHC_PRIM = getGhcPrimIface hooks + | otherwise = iface actual_mod = mi_module iface err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod @@ -1037,11 +1050,10 @@ & set_mi_exports ghcPrimExports & set_mi_decls [] & set_mi_fixities ghcPrimFixities - & set_mi_final_exts ((mi_final_exts empty_iface) - { mi_fix_fn = mkIfaceFixCache ghcPrimFixities - , mi_decl_warn_fn = mkIfaceDeclWarnCache ghcPrimWarns - , mi_export_warn_fn = mkIfaceExportWarnCache ghcPrimWarns - }) + & set_mi_fix_fn (mkIfaceFixCache ghcPrimFixities) + & set_mi_decl_warn_fn (mkIfaceDeclWarnCache ghcPrimWarns) + & set_mi_export_warn_fn (mkIfaceExportWarnCache ghcPrimWarns) + & set_mi_fix_fn (mkIfaceFixCache ghcPrimFixities) & set_mi_docs (Just ghcPrimDeclDocs) -- See Note [GHC.Prim Docs] in GHC.Builtin.Utils & set_mi_warns (toIfaceWarnings ghcPrimWarns) -- See Note [GHC.Prim Deprecations] in GHC.Builtin.Utils @@ -1099,7 +1111,7 @@ iface <- readBinIface profile name_cache IgnoreHiWay (TraceBinIFace printer) filename let -- See Note [Name qualification with --show-iface] - qualifyImportedNames mod _ + qualifyImportedNames mod _user_qual _ | mod == mi_module iface = NameUnqual | otherwise = NameNotInScope1 name_ppr_ctx = QueryQualify qualifyImportedNames @@ -1123,37 +1135,36 @@ -- The UnitState is used to pretty-print units pprModIface :: UnitState -> ModIface -> SDoc pprModIface unit_state iface - = vcat [ text "interface" + = vcat $ [ text "interface" <+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src iface) - <+> (if mi_orphan exts then text "[orphan module]" else Outputable.empty) - <+> (if mi_finsts exts then text "[family instance module]" else Outputable.empty) - <+> (if mi_hpc iface then text "[hpc]" else Outputable.empty) + <+> (withSelfRecomp iface empty $ \_ -> text "[self-recomp]") + <+> (if mi_orphan iface then text "[orphan module]" else Outputable.empty) + <+> (if mi_finsts iface then text "[family instance module]" else Outputable.empty) <+> integer hiVersion - , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash exts)) - , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts)) - , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash exts)) - , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash exts)) - , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash exts)) - , nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash exts)) - , nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash exts)) - , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash exts)) - , nest 2 (text "src_hash:" <+> ppr (mi_src_hash iface)) + , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface)) + , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface)) + , nest 2 (text "export avails hash:" <+> ppr (mi_export_avails_hash iface)) + , nest 2 (text "orphan-like hash:" <+> ppr (mi_orphan_like_hash iface)) + , withSelfRecomp iface empty ppr + , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface)) , nest 2 (text "sig of:" <+> ppr (mi_sig_of iface)) - , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface)) , nest 2 (text "where") , text "exports:" , nest 2 (vcat (map pprExport (mi_exports iface))) , text "defaults:" , nest 2 (vcat (map ppr (mi_defaults iface))) , pprDeps unit_state (mi_deps iface) - , vcat (map pprUsage (mi_usages iface)) , vcat (map pprIfaceAnnotation (mi_anns iface)) , pprFixities (mi_fixities iface) , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface] - , case mi_extra_decls iface of + , case mi_simplified_core iface of Nothing -> empty - Just eds -> text "extra decls:" - $$ nest 2 (vcat ([ppr bs | bs <- eds])) + Just (IfaceSimplifiedCore eds fs) -> + vcat [ text "extra decls:" + $$ nest 2 (vcat ([ppr bs | bs <- eds])) + , text "foreign stubs:" + $$ nest 2 (ppr fs) + ] , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) @@ -1165,11 +1176,12 @@ , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface)) ] where - exts = mi_final_exts iface + pp_hsc_src HsBootFile = text "[boot]" pp_hsc_src HsigFile = text "[hsig]" pp_hsc_src HsSrcFile = Outputable.empty + {- When printing export lists, we print like this: Avail f f @@ -1189,34 +1201,7 @@ pp_export [] = Outputable.empty pp_export names = braces (hsep (map ppr names)) -pprUsage :: Usage -> SDoc -pprUsage usage@UsagePackageModule{} - = pprUsageImport usage usg_mod -pprUsage usage@UsageHomeModule{} - = pprUsageImport usage (\u -> mkModule (usg_unit_id u) (usg_mod_name u)) $$ - nest 2 ( - maybe Outputable.empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$ - vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ] - ) -pprUsage usage@UsageFile{} - = hsep [text "addDependentFile", - doubleQuotes (ftext (usg_file_path usage)), - ppr (usg_file_hash usage)] -pprUsage usage@UsageMergedRequirement{} - = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)] -pprUsage usage@UsageHomeModuleInterface{} - = hsep [text "implementation", ppr (usg_mod_name usage) - , ppr (usg_unit_id usage) - , ppr (usg_iface_hash usage)] -pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc -pprUsageImport usage usg_mod' - = hsep [text "import", safe, ppr (usg_mod' usage), - ppr (usg_mod_hash usage)] - where - safe | usg_safe usage = text "safe" - | otherwise = text " -/ " - pprFixities :: [(OccName, Fixity)] -> SDoc pprFixities [] = Outputable.empty pprFixities fixes = text "fixities" <+> pprWithCommas pprFix fixes @@ -1252,3 +1237,15 @@ ppr (ImportByUser NotBoot) = empty ppr ImportBySystem = text "{- SYSTEM -}" ppr ImportByPlugin = text "{- PLUGIN -}" + + +-- | Get gHC_PRIM interface file +-- +-- This is a helper function that takes into account the hook allowing ghc-prim +-- interface to be extended via the ghc-api. Afaik it was introduced for GHCJS +-- so that it can add its own primitive types. +getGhcPrimIface :: Hooks -> ModIface +getGhcPrimIface hooks = + case ghcPrimIfaceHook hooks of + Nothing -> ghcPrimIface + Just h -> h diff --git a/GHC/Iface/Make.hs b/GHC/Iface/Make.hs --- a/GHC/Iface/Make.hs +++ b/GHC/Iface/Make.hs @@ -13,6 +13,7 @@ ( mkPartialIface , mkFullIface , mkIfaceTc + , mkRecompUsageInfo , mkIfaceExports ) where @@ -21,7 +22,7 @@ import GHC.Hs -import GHC.Stg.InferTags.TagSig (StgCgInfos) +import GHC.Stg.EnforceEpt.TagSig (StgCgInfos) import GHC.StgToCmm.Types (CmmCgInfos (..)) import GHC.Tc.Utils.TcType @@ -47,7 +48,6 @@ import GHC.Driver.Config.HsToCore.Usage import GHC.Driver.Env -import GHC.Driver.Backend import GHC.Driver.DynFlags import GHC.Driver.Plugins @@ -66,7 +66,6 @@ import GHC.Types.TypeEnv import GHC.Types.SourceFile import GHC.Types.TyThing -import GHC.Types.HpcInfo import GHC.Types.CompleteMatch import GHC.Types.Name.Cache @@ -89,13 +88,13 @@ import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModSummary import GHC.Unit.Module.Deps -import GHC.Unit.Module.WholeCoreBindings (encodeIfaceForeign) +import GHC.Unit.Module.WholeCoreBindings (encodeIfaceForeign, emptyIfaceForeign) import Data.Function import Data.List ( sortBy ) import Data.Ord import Data.IORef - +import Data.Traversable {- ************************************************************************ @@ -111,23 +110,23 @@ -> ModSummary -> [ImportUserSpec] -> ModGuts - -> PartialModIface + -> IO PartialModIface mkPartialIface hsc_env core_prog mod_details mod_summary import_decls ModGuts{ mg_module = this_mod , mg_hsc_src = hsc_src , mg_usages = usages - , mg_used_th = used_th , mg_deps = deps , mg_rdr_env = rdr_env , mg_fix_env = fix_env , mg_warns = warns - , mg_hpc_info = hpc_info , mg_safe_haskell = safe_mode , mg_trust_pkg = self_trust , mg_docs = docs } - = mkIface_ hsc_env this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env warns hpc_info self_trust - safe_mode usages docs mod_summary mod_details + = do + self_recomp <- traverse (mkSelfRecomp hsc_env this_mod (ms_hs_hash mod_summary)) usages + return $ mkIface_ hsc_env this_mod core_prog hsc_src deps rdr_env import_decls fix_env warns self_trust + safe_mode self_recomp docs mod_details -- | Fully instantiate an interface. Adds fingerprints and potentially code -- generator produced information. @@ -144,11 +143,13 @@ = updateDecl (mi_decls partial_iface) mb_stg_infos mb_cmm_infos -- See Note [Foreign stubs and TH bytecode linking] - foreign_ <- encodeIfaceForeign (hsc_logger hsc_env) (hsc_dflags hsc_env) stubs foreign_files + mi_simplified_core <- for (mi_simplified_core partial_iface) $ \simpl_core -> do + fs <- encodeIfaceForeign (hsc_logger hsc_env) (hsc_dflags hsc_env) stubs foreign_files + return $ (simpl_core { mi_sc_foreign = fs }) full_iface <- {-# SCC "addFingerprints" #-} - addFingerprints hsc_env $ set_mi_foreign foreign_ $ set_mi_decls decls partial_iface + addFingerprints hsc_env $ set_mi_simplified_core mi_simplified_core $ set_mi_decls decls partial_iface -- Debug printing let unit_state = hsc_units hsc_env @@ -182,9 +183,8 @@ rbh <- shrinkBinBuffer bh seekBinReader rbh start res <- getIfaceWithExtFields nc rbh - let resiface = restoreFromOldModIface mi res - forceModIface resiface - return resiface + forceModIface res + return res -- | Initial ram buffer to allocate for writing interface files. initBinMemSize :: Int @@ -237,64 +237,76 @@ tcg_import_decls = import_decls, tcg_rdr_env = rdr_env, tcg_fix_env = fix_env, - tcg_merged = merged, - tcg_warns = warns, - tcg_hpc = other_hpc_info, - tcg_th_splice_used = tc_splice_used, - tcg_dependent_files = dependent_files + tcg_warns = warns } = do - let used_names = mkUsedNames tc_result let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) let home_unit = hsc_home_unit hsc_env let deps = mkDependencies home_unit (tcg_mod tc_result) (tcg_imports tc_result) (map mi_module pluginModules) - let hpc_info = emptyHpcInfo other_hpc_info - used_th <- readIORef tc_splice_used - dep_files <- (readIORef dependent_files) - (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result) - let uc = initUsageConfig hsc_env - plugins = hsc_plugins hsc_env - fc = hsc_FC hsc_env - unit_env = hsc_unit_env hsc_env - -- Do NOT use semantic module here; this_mod in mkUsageInfo - -- is used solely to decide if we should record a dependency - -- or not. When we instantiate a signature, the semantic - -- module is something we want to record dependencies for, - -- but if you pass that in here, we'll decide it's the local - -- module and does not need to be recorded as a dependency. - -- See Note [Identity versus semantic module] - usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names - dep_files merged needed_links needed_pkgs + usage <- mkRecompUsageInfo hsc_env tc_result docs <- extractDocs (ms_hspp_opts mod_summary) tc_result + self_recomp <- traverse (mkSelfRecomp hsc_env this_mod (ms_hs_hash mod_summary)) usage let partial_iface = mkIface_ hsc_env this_mod (fromMaybe [] mb_program) hsc_src - used_th deps rdr_env import_decls - fix_env warns hpc_info - (imp_trust_own_pkg imports) safe_mode usages - docs mod_summary + deps rdr_env import_decls + fix_env warns + (imp_trust_own_pkg imports) safe_mode self_recomp + docs mod_details mkFullIface hsc_env partial_iface Nothing Nothing NoStubs [] +mkRecompUsageInfo :: HscEnv -> TcGblEnv -> IO (Maybe [Usage]) +mkRecompUsageInfo hsc_env tc_result = do + let dflags = hsc_dflags hsc_env + if not (gopt Opt_WriteSelfRecompInfo dflags) + then return Nothing + else do + let used_names = mkUsedNames tc_result + dep_files <- (readIORef (tcg_dependent_files tc_result)) + (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result) + let uc = initUsageConfig hsc_env + plugins = hsc_plugins hsc_env + fc = hsc_FC hsc_env + unit_env = hsc_unit_env hsc_env + + -- Do NOT use semantic module here; this_mod in mkUsageInfo + -- is used solely to decide if we should record a dependency + -- or not. When we instantiate a signature, the semantic + -- module is something we want to record dependencies for, + -- but if you pass that in here, we'll decide it's the local + -- module and does not need to be recorded as a dependency. + -- See Note [Identity versus semantic module] + usages <- initIfaceLoad hsc_env $ + mkUsageInfo uc plugins fc unit_env + (tcg_mod tc_result) + (imp_mods (tcg_imports tc_result)) + (tcg_import_decls tc_result) + used_names + dep_files + (tcg_merged tc_result) + needed_links + needed_pkgs + return (Just usages) + mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource - -> Bool -> Dependencies -> GlobalRdrEnv -> [ImportUserSpec] - -> NameEnv FixItem -> Warnings GhcRn -> HpcInfo + -> Dependencies -> GlobalRdrEnv -> [ImportUserSpec] + -> NameEnv FixItem -> Warnings GhcRn -> Bool -> SafeHaskellMode - -> [Usage] + -> Maybe IfaceSelfRecomp -> Maybe Docs - -> ModSummary -> ModDetails -> PartialModIface mkIface_ hsc_env - this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env src_warns - hpc_info pkg_trust_req safe_mode usages - docs mod_summary + this_mod core_prog hsc_src deps rdr_env import_decls fix_env src_warns + pkg_trust_req safe_mode self_recomp + docs ModDetails{ md_defaults = defaults, md_insts = insts, md_fam_insts = fam_insts, @@ -314,8 +326,8 @@ entities = typeEnvElts type_env show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env) - extra_decls = if gopt Opt_WriteIfSimplifiedCore dflags then Just [ toIfaceTopBind b | b <- core_prog ] - else Nothing + simplified_core = if gopt Opt_WriteIfSimplifiedCore dflags then Just (IfaceSimplifiedCore [ toIfaceTopBind b | b <- core_prog ] emptyIfaceForeign) + else Nothing decls = [ tyThingToIfaceDecl show_linear_types entity | entity <- entities, let name = getName entity, @@ -342,7 +354,7 @@ trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns icomplete_matches = map mkIfaceCompleteMatch complete_matches - !rdrs = maybeGlobalRdrEnv rdr_env + !rdrs = mkIfaceTopEnv rdr_env emptyPartialModIface this_mod -- Need to record this because it depends on the -instantiated-with flag @@ -351,8 +363,8 @@ then Nothing else Just semantic_mod) & set_mi_hsc_src hsc_src + & set_mi_self_recomp self_recomp & set_mi_deps deps - & set_mi_usages usages & set_mi_exports (mkIfaceExports exports) & set_mi_defaults (defaultsToIfaceDefaults defaults) @@ -367,17 +379,14 @@ & set_mi_warns warns & set_mi_anns annotations & set_mi_top_env rdrs - & set_mi_used_th used_th & set_mi_decls decls - & set_mi_extra_decls extra_decls - & set_mi_hpc (isHpcUsed hpc_info) + & set_mi_simplified_core simplified_core & set_mi_trust trust_info & set_mi_trust_pkg pkg_trust_req & set_mi_complete_matches (icomplete_matches) & set_mi_docs docs - & set_mi_final_exts () + & set_mi_abi_hashes () & set_mi_ext_fields emptyExtensibleFields - & set_mi_src_hash (ms_hs_hash mod_summary) & set_mi_hi_bytes PartialIfaceBinHandle where @@ -395,15 +404,11 @@ -- Desugar.addExportFlagsAndRules). The mi_top_env field is used -- by GHCi to decide whether the module has its full top-level -- scope available. (#5534) - maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe IfaceTopEnv - maybeGlobalRdrEnv rdr_env - | backendWantsGlobalBindings (backend dflags) - = Just $! let !exports = forceGlobalRdrEnv (globalRdrEnvLocal rdr_env) - !imports = mkIfaceImports import_decls - in IfaceTopEnv exports imports - -- See Note [Forcing GREInfo] in GHC.Types.GREInfo. - | otherwise - = Nothing + mkIfaceTopEnv :: GlobalRdrEnv -> IfaceTopEnv + mkIfaceTopEnv rdr_env + = let !exports = sortAvails $ gresToAvailInfo $ globalRdrEnvElts $ globalRdrEnvLocal rdr_env + !imports = mkIfaceImports import_decls + in IfaceTopEnv exports imports ifFamInstTcName = ifFamInstFam @@ -492,7 +497,9 @@ mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch mkIfaceCompleteMatch (CompleteMatch cls mtc) = - IfaceCompleteMatch (uniqDSetToList cls) mtc + -- NB: Sorting here means that COMPLETE {P, Q} and COMPLETE {Q, P} are + -- considered identical, in particular for recompilation checking. + IfaceCompleteMatch (sortBy stableNameCmp $ uniqDSetToList cls) mtc {- @@ -514,9 +521,12 @@ mkIfaceImports :: [ImportUserSpec] -> [IfaceImport] mkIfaceImports = map go where - go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll - go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env)) - go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns) + go (ImpUserSpec decl ImpUserAll) + = IfaceImport decl ImpIfaceAll + go (ImpUserSpec decl (ImpUserExplicit env parents_of_implicits)) + = IfaceImport decl (ImpIfaceExplicit (sortAvails env) (nameSetElemsStable parents_of_implicits)) + go (ImpUserSpec decl (ImpUserEverythingBut ns)) + = IfaceImport decl (ImpIfaceEverythingBut (nameSetElemsStable ns)) mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical mkIfaceExports as = case sortAvails as of DefinitelyDeterministicAvails sas -> sas diff --git a/GHC/Iface/Recomp.hs b/GHC/Iface/Recomp.hs --- a/GHC/Iface/Recomp.hs +++ b/GHC/Iface/Recomp.hs @@ -15,1654 +15,1990 @@ , CompileReason(..) , recompileRequired , addFingerprints - ) -where - -import GHC.Prelude -import GHC.Data.FastString - -import GHC.Driver.Backend -import GHC.Driver.Config.Finder -import GHC.Driver.Env -import GHC.Driver.DynFlags -import GHC.Driver.Ppr -import GHC.Driver.Plugins - -import GHC.Iface.Syntax -import GHC.Iface.Recomp.Binary -import GHC.Iface.Load -import GHC.Iface.Recomp.Flags -import GHC.Iface.Env - -import GHC.Core -import GHC.Tc.Utils.Monad -import GHC.Hs - -import GHC.Data.Graph.Directed -import GHC.Data.Maybe - -import GHC.Utils.Error -import GHC.Utils.Panic -import GHC.Utils.Outputable as Outputable -import GHC.Utils.Misc as Utils -import GHC.Utils.Binary -import GHC.Utils.Fingerprint -import GHC.Utils.Exception -import GHC.Utils.Logger -import GHC.Utils.Constants (debugIsOn) - -import GHC.Types.Annotations -import GHC.Types.Name -import GHC.Types.Name.Set -import GHC.Types.SrcLoc -import GHC.Types.Unique.Set -import GHC.Types.Fixity.Env -import GHC.Types.Unique.Map -import GHC.Unit.External -import GHC.Unit.Finder -import GHC.Unit.State -import GHC.Unit.Home -import GHC.Unit.Module -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModSummary -import GHC.Unit.Module.Warnings -import GHC.Unit.Module.Deps - -import Control.Monad -import Data.List (sortBy, sort, sortOn) -import qualified Data.Map as Map -import qualified Data.Set as Set -import Data.Word (Word64) -import Data.Either - ---Qualified import so we can define a Semigroup instance --- but it doesn't clash with Outputable.<> -import qualified Data.Semigroup -import GHC.List (uncons) -import Data.Ord -import Data.Containers.ListUtils -import Data.Bifunctor -import GHC.Iface.Errors.Ppr - -{- - ----------------------------------------------- - Recompilation checking - ----------------------------------------------- - -A complete description of how recompilation checking works can be -found in the wiki commentary: - - https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance - -Please read the above page for a top-down description of how this all -works. Notes below cover specific issues related to the implementation. - -Basic idea: - - * In the mi_usages information in an interface, we record the - fingerprint of each free variable of the module - - * In mkIface, we compute the fingerprint of each exported thing A.f. - For each external thing that A.f refers to, we include the fingerprint - of the external reference when computing the fingerprint of A.f. So - if anything that A.f depends on changes, then A.f's fingerprint will - change. - Also record any dependent files added with - * addDependentFile - * #include - * -optP-include - - * In checkOldIface we compare the mi_usages for the module with - the actual fingerprint for all each thing recorded in mi_usages --} - -data RecompileRequired - -- | everything is up to date, recompilation is not required - = UpToDate - -- | Need to compile the module - | NeedsRecompile !CompileReason - deriving (Eq) - -needsRecompileBecause :: RecompReason -> RecompileRequired -needsRecompileBecause = NeedsRecompile . RecompBecause - -data MaybeValidated a - -- | The item contained is validated to be up to date - = UpToDateItem a - -- | The item is are absent altogether or out of date, for the reason given. - | OutOfDateItem - !CompileReason - -- ^ the reason we need to recompile. - (Maybe a) - -- ^ The old item, if it exists - deriving (Functor) - -instance Outputable a => Outputable (MaybeValidated a) where - ppr (UpToDateItem a) = text "UpToDate" <+> ppr a - ppr (OutOfDateItem r _) = text "OutOfDate: " <+> ppr r - -outOfDateItemBecause :: RecompReason -> Maybe a -> MaybeValidated a -outOfDateItemBecause reason item = OutOfDateItem (RecompBecause reason) item - -data CompileReason - -- | The .hs file has been touched, or the .o/.hi file does not exist - = MustCompile - -- | The .o/.hi files are up to date, but something else has changed - -- to force recompilation; the String says what (one-line summary) - | RecompBecause !RecompReason - deriving (Eq) - -instance Outputable RecompileRequired where - ppr UpToDate = text "UpToDate" - ppr (NeedsRecompile reason) = ppr reason - -instance Outputable CompileReason where - ppr MustCompile = text "MustCompile" - ppr (RecompBecause r) = text "RecompBecause" <+> ppr r - -instance Semigroup RecompileRequired where - UpToDate <> r = r - mc <> _ = mc - -instance Monoid RecompileRequired where - mempty = UpToDate - -data RecompReason - = UnitDepRemoved UnitId - | ModulePackageChanged FastString - | SourceFileChanged - | ThisUnitIdChanged - | ImpurePlugin - | PluginsChanged - | PluginFingerprintChanged - | ModuleInstChanged - | HieMissing - | HieOutdated - | SigsMergeChanged - | ModuleChanged ModuleName - | ModuleRemoved (UnitId, ModuleName) - | ModuleAdded (UnitId, ModuleName) - | ModuleChangedRaw ModuleName - | ModuleChangedIface ModuleName - | FileChanged FilePath - | CustomReason String - | FlagsChanged - | OptimFlagsChanged - | HpcFlagsChanged - | MissingBytecode - | MissingObjectFile - | MissingDynObjectFile - | MissingDynHiFile - | MismatchedDynHiFile - | ObjectsChanged - | LibraryChanged - | THWithJS - deriving (Eq) - -instance Outputable RecompReason where - ppr = \case - UnitDepRemoved uid -> ppr uid <+> text "removed" - ModulePackageChanged s -> ftext s <+> text "package changed" - SourceFileChanged -> text "Source file changed" - ThisUnitIdChanged -> text "-this-unit-id changed" - ImpurePlugin -> text "Impure plugin forced recompilation" - PluginsChanged -> text "Plugins changed" - PluginFingerprintChanged -> text "Plugin fingerprint changed" - ModuleInstChanged -> text "Implementing module changed" - HieMissing -> text "HIE file is missing" - HieOutdated -> text "HIE file is out of date" - SigsMergeChanged -> text "Signatures to merge in changed" - ModuleChanged m -> ppr m <+> text "changed" - ModuleChangedRaw m -> ppr m <+> text "changed (raw)" - ModuleChangedIface m -> ppr m <+> text "changed (interface)" - ModuleRemoved (_uid, m) -> ppr m <+> text "removed" - ModuleAdded (_uid, m) -> ppr m <+> text "added" - FileChanged fp -> text fp <+> text "changed" - CustomReason s -> text s - FlagsChanged -> text "Flags changed" - OptimFlagsChanged -> text "Optimisation flags changed" - HpcFlagsChanged -> text "HPC flags changed" - MissingBytecode -> text "Missing bytecode" - MissingObjectFile -> text "Missing object file" - MissingDynObjectFile -> text "Missing dynamic object file" - MissingDynHiFile -> text "Missing dynamic interface file" - MismatchedDynHiFile -> text "Mismatched dynamic interface file" - ObjectsChanged -> text "Objects changed" - LibraryChanged -> text "Library changed" - THWithJS -> text "JS backend always recompiles modules using Template Haskell for now (#23013)" - -recompileRequired :: RecompileRequired -> Bool -recompileRequired UpToDate = False -recompileRequired _ = True - -recompThen :: Monad m => m RecompileRequired -> m RecompileRequired -> m RecompileRequired -recompThen ma mb = ma >>= \case - UpToDate -> mb - rr@(NeedsRecompile _) -> pure rr - -checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired -checkList = \case - [] -> return UpToDate - (check : checks) -> check `recompThen` checkList checks - ----------------------- - --- | Top level function to check if the version of an old interface file --- is equivalent to the current source file the user asked us to compile. --- If the same, we can avoid recompilation. --- --- We return on the outside whether the interface file is up to date, providing --- evidence that is with a `ModIface`. In the case that it isn't, we may also --- return a found or provided `ModIface`. Why we don't always return the old --- one, if it exists, is unclear to me, except that I tried it and some tests --- failed (see #18205). -checkOldIface - :: HscEnv - -> ModSummary - -> Maybe ModIface -- Old interface from compilation manager, if any - -> IO (MaybeValidated ModIface) - -checkOldIface hsc_env mod_summary maybe_iface - = do let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - showPass logger $ - "Checking old interface for " ++ - (showPpr dflags $ ms_mod mod_summary) ++ - " (use -ddump-hi-diffs for more details)" - initIfaceCheck (text "checkOldIface") hsc_env $ - check_old_iface hsc_env mod_summary maybe_iface - -check_old_iface - :: HscEnv - -> ModSummary - -> Maybe ModIface - -> IfG (MaybeValidated ModIface) - -check_old_iface hsc_env mod_summary maybe_iface - = let dflags = hsc_dflags hsc_env - logger = hsc_logger hsc_env - getIface = - case maybe_iface of - Just _ -> do - trace_if logger (text "We already have the old interface for" <+> - ppr (ms_mod mod_summary)) - return maybe_iface - Nothing -> loadIface dflags (msHiFilePath mod_summary) - - loadIface read_dflags iface_path = do - let ncu = hsc_NC hsc_env - read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path - case read_result of - Failed err -> do - let msg = readInterfaceErrorDiagnostic err - trace_if logger - $ vcat [ text "FYI: cannot read old interface file:" - , nest 4 msg ] - trace_hi_diffs logger $ - vcat [ text "Old interface file was invalid:" - , nest 4 msg ] - return Nothing - Succeeded iface -> do - trace_if logger (text "Read the interface file" <+> text iface_path) - return $ Just iface - check_dyn_hi :: ModIface - -> IfG (MaybeValidated ModIface) - -> IfG (MaybeValidated ModIface) - check_dyn_hi normal_iface recomp_check | gopt Opt_BuildDynamicToo dflags = do - res <- recomp_check - case res of - UpToDateItem _ -> do - maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary) - case maybe_dyn_iface of - Nothing -> return $ outOfDateItemBecause MissingDynHiFile Nothing - Just dyn_iface | mi_iface_hash (mi_final_exts dyn_iface) - /= mi_iface_hash (mi_final_exts normal_iface) - -> return $ outOfDateItemBecause MismatchedDynHiFile Nothing - Just {} -> return res - _ -> return res - check_dyn_hi _ recomp_check = recomp_check - - - src_changed - | gopt Opt_ForceRecomp dflags = True - | otherwise = False - in do - when src_changed $ - liftIO $ trace_hi_diffs logger (nest 4 $ text "Recompilation check turned off") - - case src_changed of - -- If the source has changed and we're in interactive mode, - -- avoid reading an interface; just return the one we might - -- have been supplied with. - True | not (backendWritesFiles $ backend dflags) -> - return $ OutOfDateItem MustCompile maybe_iface - - -- Try and read the old interface for the current module - -- from the .hi file left from the last time we compiled it - True -> do - maybe_iface' <- liftIO $ getIface - return $ OutOfDateItem MustCompile maybe_iface' - - False -> do - maybe_iface' <- liftIO $ getIface - case maybe_iface' of - -- We can't retrieve the iface - Nothing -> return $ OutOfDateItem MustCompile Nothing - - -- We have got the old iface; check its versions - -- even in the SourceUnmodifiedAndStable case we - -- should check versions because some packages - -- might have changed or gone away. - Just iface -> - check_dyn_hi iface $ checkVersions hsc_env mod_summary iface - --- | Check if a module is still the same 'version'. --- --- This function is called in the recompilation checker after we have --- determined that the module M being checked hasn't had any changes --- to its source file since we last compiled M. So at this point in general --- two things may have changed that mean we should recompile M: --- * The interface export by a dependency of M has changed. --- * The compiler flags specified this time for M have changed --- in a manner that is significant for recompilation. --- We return not just if we should recompile the object file but also --- if we should rebuild the interface file. -checkVersions :: HscEnv - -> ModSummary - -> ModIface -- Old interface - -> IfG (MaybeValidated ModIface) -checkVersions hsc_env mod_summary iface - = do { liftIO $ trace_hi_diffs logger - (text "Considering whether compilation is required for" <+> - ppr (mi_module iface) <> colon) - - -- readIface will have verified that the UnitId matches, - -- but we ALSO must make sure the instantiation matches up. See - -- test case bkpcabal04! - ; hsc_env <- getTopEnv - ; if mi_src_hash iface /= ms_hs_hash mod_summary - then return $ outOfDateItemBecause SourceFileChanged Nothing else do { - ; if not (isHomeModule home_unit (mi_module iface)) - then return $ outOfDateItemBecause ThisUnitIdChanged Nothing else do { - ; recomp <- liftIO $ checkFlagHash hsc_env iface - `recompThen` checkOptimHash hsc_env iface - `recompThen` checkHpcHash hsc_env iface - `recompThen` checkMergedSignatures hsc_env mod_summary iface - `recompThen` checkHsig logger home_unit mod_summary iface - `recompThen` pure (checkHie dflags mod_summary) - ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do { - ; recomp <- checkDependencies hsc_env mod_summary iface - ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do { - ; recomp <- checkPlugins (hsc_plugins hsc_env) iface - ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do { - - - -- Source code unchanged and no errors yet... carry on - -- - -- First put the dependent-module info, read from the old - -- interface, into the envt, so that when we look for - -- interfaces we look for the right one (.hi or .hi-boot) - -- - -- It's just temporary because either the usage check will succeed - -- (in which case we are done with this module) or it'll fail (in which - -- case we'll compile the module from scratch anyhow). - - when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do { - ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) } - } - ; recomp <- checkList [checkModUsage (hsc_FC hsc_env) u - | u <- mi_usages iface] - ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do { - ; return $ UpToDateItem iface - }}}}}}} - where - logger = hsc_logger hsc_env - dflags = hsc_dflags hsc_env - home_unit = hsc_home_unit hsc_env - - - --- | Check if any plugins are requesting recompilation -checkPlugins :: Plugins -> ModIface -> IfG RecompileRequired -checkPlugins plugins iface = liftIO $ do - recomp <- recompPlugins plugins - let new_fingerprint = fingerprintPluginRecompile recomp - let old_fingerprint = mi_plugin_hash (mi_final_exts iface) - return $ pluginRecompileToRecompileRequired old_fingerprint new_fingerprint recomp - -recompPlugins :: Plugins -> IO PluginRecompile -recompPlugins plugins = mconcat <$> mapM pluginRecompile' (pluginsWithArgs plugins) - -fingerprintPlugins :: Plugins -> IO Fingerprint -fingerprintPlugins plugins = fingerprintPluginRecompile <$> recompPlugins plugins - -fingerprintPluginRecompile :: PluginRecompile -> Fingerprint -fingerprintPluginRecompile recomp = case recomp of - NoForceRecompile -> fingerprintString "NoForceRecompile" - ForceRecompile -> fingerprintString "ForceRecompile" - -- is the chance of collision worth worrying about? - -- An alternative is to fingerprintFingerprints [fingerprintString - -- "maybeRecompile", fp] - MaybeRecompile fp -> fp - - -pluginRecompileToRecompileRequired - :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired -pluginRecompileToRecompileRequired old_fp new_fp pr - | old_fp == new_fp = - case pr of - NoForceRecompile -> UpToDate - - -- we already checked the fingerprint above so a mismatch is not possible - -- here, remember that: `fingerprint (MaybeRecomp x) == x`. - MaybeRecompile _ -> UpToDate - - -- when we have an impure plugin in the stack we have to unconditionally - -- recompile since it might integrate all sorts of crazy IO results into - -- its compilation output. - ForceRecompile -> needsRecompileBecause ImpurePlugin - - | old_fp `elem` magic_fingerprints || - new_fp `elem` magic_fingerprints - -- The fingerprints do not match either the old or new one is a magic - -- fingerprint. This happens when non-pure plugins are added for the first - -- time or when we go from one recompilation strategy to another: (force -> - -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.) - -- - -- For example when we go from ForceRecomp to NoForceRecomp - -- recompilation is triggered since the old impure plugins could have - -- changed the build output which is now back to normal. - = needsRecompileBecause PluginsChanged - - | otherwise = - case pr of - -- even though a plugin is forcing recompilation the fingerprint changed - -- which would cause recompilation anyways so we report the fingerprint - -- change instead. - ForceRecompile -> needsRecompileBecause PluginFingerprintChanged - - _ -> needsRecompileBecause PluginFingerprintChanged - - where - magic_fingerprints = - [ fingerprintString "NoForceRecompile" - , fingerprintString "ForceRecompile" - ] - - --- | Check if an hsig file needs recompilation because its --- implementing module has changed. -checkHsig :: Logger -> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired -checkHsig logger home_unit mod_summary iface = do - let outer_mod = ms_mod mod_summary - inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod) - massert (isHomeModule home_unit outer_mod) - case inner_mod == mi_semantic_module iface of - True -> up_to_date logger (text "implementing module unchanged") - False -> return $ needsRecompileBecause ModuleInstChanged - --- | Check if @.hie@ file is out of date or missing. -checkHie :: DynFlags -> ModSummary -> RecompileRequired -checkHie dflags mod_summary = - let hie_date_opt = ms_hie_date mod_summary - hi_date = ms_iface_date mod_summary - in if not (gopt Opt_WriteHie dflags) - then UpToDate - else case (hie_date_opt, hi_date) of - (Nothing, _) -> needsRecompileBecause HieMissing - (Just hie_date, Just hi_date) - | hie_date < hi_date - -> needsRecompileBecause HieOutdated - _ -> UpToDate - --- | Check the flags haven't changed -checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired -checkFlagHash hsc_env iface = do - let logger = hsc_logger hsc_env - let old_hash = mi_flag_hash (mi_final_exts iface) - new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally - case old_hash == new_hash of - True -> up_to_date logger (text "Module flags unchanged") - False -> out_of_date_hash logger FlagsChanged - (text " Module flags have changed") - old_hash new_hash - --- | Check the optimisation flags haven't changed -checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired -checkOptimHash hsc_env iface = do - let logger = hsc_logger hsc_env - let old_hash = mi_opt_hash (mi_final_exts iface) - new_hash <- fingerprintOptFlags (hsc_dflags hsc_env) - putNameLiterally - if | old_hash == new_hash - -> up_to_date logger (text "Optimisation flags unchanged") - | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) - -> up_to_date logger (text "Optimisation flags changed; ignoring") - | otherwise - -> out_of_date_hash logger OptimFlagsChanged - (text " Optimisation flags have changed") - old_hash new_hash - --- | Check the HPC flags haven't changed -checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired -checkHpcHash hsc_env iface = do - let logger = hsc_logger hsc_env - let old_hash = mi_hpc_hash (mi_final_exts iface) - new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env) - putNameLiterally - if | old_hash == new_hash - -> up_to_date logger (text "HPC flags unchanged") - | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) - -> up_to_date logger (text "HPC flags changed; ignoring") - | otherwise - -> out_of_date_hash logger HpcFlagsChanged - (text " HPC flags have changed") - old_hash new_hash - --- Check that the set of signatures we are merging in match. --- If the -unit-id flags change, this can change too. -checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired -checkMergedSignatures hsc_env mod_summary iface = do - let logger = hsc_logger hsc_env - let unit_state = hsc_units hsc_env - let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ] - new_merged = case lookupUniqMap (requirementContext unit_state) - (ms_mod_name mod_summary) of - Nothing -> [] - Just r -> sort $ map (instModuleToModule unit_state) r - if old_merged == new_merged - then up_to_date logger (text "signatures to merge in unchanged" $$ ppr new_merged) - else return $ needsRecompileBecause SigsMergeChanged - --- If the direct imports of this module are resolved to targets that --- are not among the dependencies of the previous interface file, --- then we definitely need to recompile. This catches cases like --- - an exposed package has been upgraded --- - we are compiling with different package flags --- - a home module that was shadowing a package module has been removed --- - a new home module has been added that shadows a package module --- See bug #1372. --- --- Returns (RecompBecause ) if recompilation is required. -checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired -checkDependencies hsc_env summary iface - = do - res_normal <- classify_import (findImportedModule hsc_env) (ms_textual_imps summary ++ ms_srcimps summary) - res_plugin <- classify_import (\mod _ -> findPluginModule fc fopts units mhome_unit mod) (ms_plugin_imps summary) - case sequence (res_normal ++ res_plugin ++ [Right (fake_ghc_prim_import)| ms_ghc_prim_import summary]) of - Left recomp -> return $ NeedsRecompile recomp - Right es -> do - let (hs, ps) = partitionEithers es - liftIO $ - check_mods (sort hs) prev_dep_mods - `recompThen` - let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd ps - in check_packages allPkgDeps prev_dep_pkgs - where - - classify_import :: (ModuleName -> t -> IO FindResult) - -> [(t, GenLocated l ModuleName)] - -> IfG - [Either - CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))] - classify_import find_import imports = - liftIO $ traverse (\(mb_pkg, L _ mod) -> - let reason = ModuleChanged mod - in classify reason <$> find_import mod mb_pkg) - imports - dflags = hsc_dflags hsc_env - fopts = initFinderOpts dflags - logger = hsc_logger hsc_env - fc = hsc_FC hsc_env - mhome_unit = hsc_home_unit_maybe hsc_env - all_home_units = hsc_all_home_unit_ids hsc_env - units = hsc_units hsc_env - prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) - prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) - (dep_plugin_pkgs (mi_deps iface))) - - -- GHC.Prim is very special and doesn't appear in ms_textual_imps but - -- ghc-prim will appear in the package dependencies still. In order to not confuse - -- the recompilation logic we need to not forget we imported GHC.Prim. - fake_ghc_prim_import = case mhome_unit of - Just home_unit - | homeUnitId home_unit == primUnitId - -> Left (primUnitId, mkModuleName "GHC.Prim") - _ -> Right (fsLit "GHC.Prim", primUnitId) - - - classify _ (Found _ mod) - | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) - | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) - classify reason _ = Left (RecompBecause reason) - - check_mods :: [(UnitId, ModuleName)] -> [(UnitId, ModuleName)] -> IO RecompileRequired - check_mods [] [] = return UpToDate - check_mods [] (old:_) = do - -- This case can happen when a module is change from HPT to package import - trace_hi_diffs logger $ - text "module no longer" <+> quotes (ppr old) <+> - text "in dependencies" - - return $ needsRecompileBecause $ ModuleRemoved old - check_mods (new:news) olds - | Just (old, olds') <- uncons olds - , new == old = check_mods (dropWhile (== new) news) olds' - | otherwise = do - trace_hi_diffs logger $ - text "imported module " <> quotes (ppr new) <> - text " not among previous dependencies" - return $ needsRecompileBecause $ ModuleAdded new - - check_packages :: [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired - check_packages [] [] = return UpToDate - check_packages [] (old:_) = do - trace_hi_diffs logger $ - text "package " <> quotes (ppr old) <> - text "no longer in dependencies" - return $ needsRecompileBecause $ UnitDepRemoved old - check_packages ((new_name, new_unit):news) olds - | Just (old, olds') <- uncons olds - , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds' - | otherwise = do - trace_hi_diffs logger $ - text "imported package" <+> ftext new_name <+> ppr new_unit <+> - text "not among previous dependencies" - return $ needsRecompileBecause $ ModulePackageChanged new_name - - -needInterface :: Module -> (ModIface -> IO RecompileRequired) - -> IfG RecompileRequired -needInterface mod continue - = do - mb_recomp <- tryGetModIface - "need version info for" - mod - case mb_recomp of - Nothing -> return $ NeedsRecompile MustCompile - Just iface -> liftIO $ continue iface - -tryGetModIface :: String -> Module -> IfG (Maybe ModIface) -tryGetModIface doc_msg mod - = do -- Load the imported interface if possible - logger <- getLogger - let doc_str = sep [text doc_msg, ppr mod] - liftIO $ trace_hi_diffs logger (text "Checking interface for module" <+> ppr mod <+> ppr (moduleUnit mod)) - - mb_iface <- loadInterface doc_str mod ImportBySystem - -- Load the interface, but don't complain on failure; - -- Instead, get an Either back which we can test - - case mb_iface of - Failed _ -> do - liftIO $ trace_hi_diffs logger (sep [text "Couldn't load interface for module", ppr mod]) - return Nothing - -- Couldn't find or parse a module mentioned in the - -- old interface file. Don't complain: it might - -- just be that the current module doesn't need that - -- import and it's been deleted - Succeeded iface -> pure $ Just iface - --- | Given the usage information extracted from the old --- M.hi file for the module being compiled, figure out --- whether M needs to be recompiled. -checkModUsage :: FinderCache -> Usage -> IfG RecompileRequired -checkModUsage _ UsagePackageModule{ - usg_mod = mod, - usg_mod_hash = old_mod_hash } = do - logger <- getLogger - needInterface mod $ \iface -> do - let reason = ModuleChanged (moduleName mod) - checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface)) - -- We only track the ABI hash of package modules, rather than - -- individual entity usages, so if the ABI hash changes we must - -- recompile. This is safe but may entail more recompilation when - -- a dependent package has changed. - -checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do - logger <- getLogger - needInterface mod $ \iface -> do - let reason = ModuleChangedRaw (moduleName mod) - checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash (mi_final_exts iface)) -checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name - , usg_unit_id = uid - , usg_iface_hash = old_mod_hash } = do - let mod = mkModule (RealUnit (Definite uid)) mod_name - logger <- getLogger - needInterface mod $ \iface -> do - let reason = ModuleChangedIface mod_name - checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash (mi_final_exts iface)) - -checkModUsage _ UsageHomeModule{ - usg_mod_name = mod_name, - usg_unit_id = uid, - usg_mod_hash = old_mod_hash, - usg_exports = maybe_old_export_hash, - usg_entities = old_decl_hash } - = do - let mod = mkModule (RealUnit (Definite uid)) mod_name - logger <- getLogger - needInterface mod $ \iface -> do - let - new_mod_hash = mi_mod_hash (mi_final_exts iface) - new_decl_hash = mi_hash_fn (mi_final_exts iface) - new_export_hash = mi_exp_hash (mi_final_exts iface) - - reason = ModuleChanged (moduleName mod) - - liftIO $ do - -- CHECK MODULE - recompile <- checkModuleFingerprint logger reason old_mod_hash new_mod_hash - if not (recompileRequired recompile) - then return UpToDate - else checkList - [ -- CHECK EXPORT LIST - checkMaybeHash logger reason maybe_old_export_hash new_export_hash - (text " Export list changed") - , -- CHECK ITEMS ONE BY ONE - checkList [ checkEntityUsage logger reason new_decl_hash u - | u <- old_decl_hash] - , up_to_date logger (text " Great! The bits I use are up to date") - ] - -checkModUsage fc UsageFile{ usg_file_path = file, - usg_file_hash = old_hash, - usg_file_label = mlabel } = - liftIO $ - handleIO handler $ do - new_hash <- lookupFileCache fc $ unpackFS file - if (old_hash /= new_hash) - then return recomp - else return UpToDate - where - reason = FileChanged $ unpackFS file - recomp = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel - handler = if debugIsOn - then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp - else \_ -> return recomp -- if we can't find the file, just recompile, don't fail - ------------------------- -checkModuleFingerprint - :: Logger - -> RecompReason - -> Fingerprint - -> Fingerprint - -> IO RecompileRequired -checkModuleFingerprint logger reason old_mod_hash new_mod_hash - | new_mod_hash == old_mod_hash - = up_to_date logger (text "Module fingerprint unchanged") - - | otherwise - = out_of_date_hash logger reason (text " Module fingerprint has changed") - old_mod_hash new_mod_hash - -checkIfaceFingerprint - :: Logger - -> RecompReason - -> Fingerprint - -> Fingerprint - -> IO RecompileRequired -checkIfaceFingerprint logger reason old_mod_hash new_mod_hash - | new_mod_hash == old_mod_hash - = up_to_date logger (text "Iface fingerprint unchanged") - - | otherwise - = out_of_date_hash logger reason (text " Iface fingerprint has changed") - old_mod_hash new_mod_hash - ------------------------- -checkMaybeHash - :: Logger - -> RecompReason - -> Maybe Fingerprint - -> Fingerprint - -> SDoc - -> IO RecompileRequired -checkMaybeHash logger reason maybe_old_hash new_hash doc - | Just hash <- maybe_old_hash, hash /= new_hash - = out_of_date_hash logger reason doc hash new_hash - | otherwise - = return UpToDate - ------------------------- -checkEntityUsage :: Logger - -> RecompReason - -> (OccName -> Maybe (OccName, Fingerprint)) - -> (OccName, Fingerprint) - -> IO RecompileRequired -checkEntityUsage logger reason new_hash (name,old_hash) = do - case new_hash name of - -- We used it before, but it ain't there now - Nothing -> out_of_date logger reason (sep [text "No longer exported:", ppr name]) - -- It's there, but is it up to date? - Just (_, new_hash) - | new_hash == old_hash - -> do trace_hi_diffs logger (text " Up to date" <+> ppr name <+> parens (ppr new_hash)) - return UpToDate - | otherwise - -> out_of_date_hash logger reason (text " Out of date:" <+> ppr name) old_hash new_hash - -up_to_date :: Logger -> SDoc -> IO RecompileRequired -up_to_date logger msg = trace_hi_diffs logger msg >> return UpToDate - -out_of_date :: Logger -> RecompReason -> SDoc -> IO RecompileRequired -out_of_date logger reason msg = trace_hi_diffs logger msg >> return (needsRecompileBecause reason) - -out_of_date_hash :: Logger -> RecompReason -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired -out_of_date_hash logger reason msg old_hash new_hash - = out_of_date logger reason (hsep [msg, ppr old_hash, text "->", ppr new_hash]) - --- --------------------------------------------------------------------------- --- Compute fingerprints for the interface - -{- -Note [Fingerprinting IfaceDecls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The general idea here is that we first examine the 'IfaceDecl's and determine -the recursive groups of them. We then walk these groups in dependency order, -serializing each contained 'IfaceDecl' to a "Binary" buffer which we then -hash using MD5 to produce a fingerprint for the group. - -However, the serialization that we use is a bit funny: we override the @putName@ -operation with our own which serializes the hash of a 'Name' instead of the -'Name' itself. This ensures that the fingerprint of a decl changes if anything -in its transitive closure changes. This trick is why we must be careful about -traversing in dependency order: we need to ensure that we have hashes for -everything referenced by the decl which we are fingerprinting. - -Moreover, we need to be careful to distinguish between serialization of binding -Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls -field of a IfaceClsInst): only in the non-binding case should we include the -fingerprint; in the binding case we shouldn't since it is merely the name of the -thing that we are currently fingerprinting. - - -Note [Fingerprinting recursive groups] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The fingerprinting of a single recursive group is a rather subtle affair, as -seen in #18733. - -How not to fingerprint ----------------------- - -Prior to fixing #18733 we used the following (flawed) scheme to fingerprint a -group in hash environment `hash_env0`: - - 1. extend hash_env0, giving each declaration in the group the fingerprint 0 - 2. use this environment to hash the declarations' ABIs, resulting in - group_fingerprint - 3. produce the final hash environment by extending hash_env0, mapping each - declaration of the group to group_fingerprint - -However, this is wrong. Consider, for instance, a program like: - - data A = ARecu B | ABase String deriving (Show) - data B = BRecu A | BBase Int deriving (Show) - - info :: B - info = BBase 1 - -A consequence of (3) is that A and B will have the same fingerprint. This means -that if the user changes `info` to: - - info :: A - info = ABase "hello" - -The program's ABI fingerprint will not change despite `info`'s type, and -therefore ABI, being clearly different. - -However, the incorrectness doesn't end there: (1) means that all recursive -occurrences of names within the group will be given the same fingerprint. This -means that the group's fingerprint won't change if we change an occurrence of A -to B. - -Surprisingly, this bug (#18733) lurked for many years before being uncovered. - -How we now fingerprint ----------------------- - -As seen above, the fingerprinting function must ensure that a groups -fingerprint captures the structure of within-group occurrences. The scheme that -we use is: - - 0. To ensure determinism, sort the declarations into a stable order by - declaration name - - 1. Extend hash_env0, giving each declaration in the group a sequential - fingerprint (e.g. 0, 1, 2, ...). - - 2. Use this environment to hash the declarations' ABIs, resulting in - group_fingerprint. - - Since we included the sequence number in step (1) programs identical up to - transposition of recursive occurrences are distinguishable, avoiding the - second issue mentioned above. - - 3. Produce the final environment by extending hash_env, mapping each - declaration of the group to the hash of (group_fingerprint, i), where - i is the position of the declaration in the stable ordering. - - Including i in the hash ensures that the first issue noted above is - avoided. - --} - --- | Add fingerprints for top-level declarations to a 'ModIface'. --- --- See Note [Fingerprinting IfaceDecls] -addFingerprints - :: HscEnv - -> PartialModIface - -> IO ModIface -addFingerprints hsc_env iface0 - = do - eps <- hscEPS hsc_env - let - decls = mi_decls iface0 - decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings $ mi_warns iface0) - export_warn_fn = mkIfaceExportWarnCache (fromIfaceWarnings $ mi_warns iface0) - fix_fn = mkIfaceFixCache (mi_fixities iface0) - - -- The ABI of a declaration represents everything that is made - -- visible about the declaration that a client can depend on. - -- see IfaceDeclABI below. - declABI :: IfaceDecl -> IfaceDeclABI - -- TODO: I'm not sure if this should be semantic_mod or this_mod. - -- See also Note [Identity versus semantic module] - declABI decl = (this_mod, decl, extras) - where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts - non_orph_fis top_lvl_name_env decl - - -- This is used for looking up the Name of a default method - -- from its OccName. See Note [default method Name] - top_lvl_name_env = - mkOccEnv [ (nameOccName nm, nm) - | IfaceId { ifName = nm } <- decls ] - - -- Dependency edges between declarations in the current module. - -- This is computed by finding the free external names of each - -- declaration, including IfaceDeclExtras (things that a - -- declaration implicitly depends on). - edges :: [ Node OccName IfaceDeclABI ] - edges = [ DigraphNode abi (getOccName decl) out - | decl <- decls - , let abi = declABI decl - , let out = localOccs $ freeNamesDeclABI abi - ] - - name_module n = assertPpr (isExternalName n) (ppr n) (nameModule n) - localOccs = - map (getParent . getOccName) - -- NB: names always use semantic module, so - -- filtering must be on the semantic module! - -- See Note [Identity versus semantic module] - . filter ((== semantic_mod) . name_module) - . nonDetEltsUniqSet - -- It's OK to use nonDetEltsUFM as localOccs is only - -- used to construct the edges and - -- stronglyConnCompFromEdgedVertices is deterministic - -- even with non-deterministic order of edges as - -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. - where getParent :: OccName -> OccName - getParent occ = lookupOccEnv parent_map occ `orElse` occ - - -- maps OccNames to their parents in the current module. - -- e.g. a reference to a constructor must be turned into a reference - -- to the TyCon for the purposes of calculating dependencies. - parent_map :: OccEnv OccName - parent_map = foldl' extend emptyOccEnv decls - where extend env d = - extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ] - where n = getOccName d - - -- Strongly-connected groups of declarations, in dependency order - groups :: [SCC IfaceDeclABI] - groups = stronglyConnCompFromEdgedVerticesOrd edges - - global_hash_fn = mkHashFun hsc_env eps - - -- How to output Names when generating the data to fingerprint. - -- Here we want to output the fingerprint for each top-level - -- Name, whether it comes from the current module or another - -- module. In this way, the fingerprint for a declaration will - -- change if the fingerprint for anything it refers to (transitively) - -- changes. - mk_put_name :: OccEnv (OccName,Fingerprint) - -> WriteBinHandle -> Name -> IO () - mk_put_name local_env bh name - | isWiredInName name = putNameLiterally bh name - -- wired-in names don't have fingerprints - | otherwise - = assertPpr (isExternalName name) (ppr name) $ - let hash | nameModule name /= semantic_mod = global_hash_fn name - -- Get it from the REAL interface!! - -- This will trigger when we compile an hsig file - -- and we know a backing impl for it. - -- See Note [Identity versus semantic module] - | semantic_mod /= this_mod - , not (isHoleModule semantic_mod) = global_hash_fn name - | otherwise = return (snd (lookupOccEnv local_env (getOccName name) - `orElse` pprPanic "urk! lookup local fingerprint" - (ppr name $$ ppr local_env))) - -- This panic indicates that we got the dependency - -- analysis wrong, because we needed a fingerprint for - -- an entity that wasn't in the environment. To debug - -- it, turn the panic into a trace, uncomment the - -- pprTraces below, run the compile again, and inspect - -- the output and the generated .hi file with - -- --show-iface. - in hash >>= put_ bh - - -- take a strongly-connected group of declarations and compute - -- its fingerprint. - - fingerprint_group :: (OccEnv (OccName,Fingerprint), - [(Fingerprint,IfaceDecl)]) - -> SCC IfaceDeclABI - -> IO (OccEnv (OccName,Fingerprint), - [(Fingerprint,IfaceDecl)]) - - fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi) - = do let hash_fn = mk_put_name local_env - decl = abiDecl abi - --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do - hash <- computeFingerprint hash_fn abi - env' <- extend_hash_env local_env (hash,decl) - return (env', (hash,decl) : decls_w_hashes) - - fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis) - = do let stable_abis = sortBy cmp_abiNames abis - stable_decls = map abiDecl stable_abis - local_env1 <- foldM extend_hash_env local_env - (zip (map mkRecFingerprint [0..]) stable_decls) - -- See Note [Fingerprinting recursive groups] - let hash_fn = mk_put_name local_env1 - -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do - -- put the cycle in a canonical order - hash <- computeFingerprint hash_fn stable_abis - let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls - -- See Note [Fingerprinting recursive groups] - local_env2 <- foldM extend_hash_env local_env pairs - return (local_env2, pairs ++ decls_w_hashes) - - -- Make a fingerprint from the ordinal position of a binding in its group. - mkRecFingerprint :: Word64 -> Fingerprint - mkRecFingerprint i = Fingerprint 0 i - - bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint - bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ] - - -- we have fingerprinted the whole declaration, but we now need - -- to assign fingerprints to all the OccNames that it binds, to - -- use when referencing those OccNames in later declarations. - -- - extend_hash_env :: OccEnv (OccName,Fingerprint) - -> (Fingerprint,IfaceDecl) - -> IO (OccEnv (OccName,Fingerprint)) - extend_hash_env env0 (hash,d) = - return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0 - (ifaceDeclFingerprints hash d)) - - -- - (local_env, decls_w_hashes) <- - foldM fingerprint_group (emptyOccEnv, []) groups - - -- when calculating fingerprints, we always need to use canonical ordering - -- for lists of things. The mi_deps has various lists of modules and - -- suchlike, which are stored in canonical order: - let sorted_deps :: Dependencies - sorted_deps = mi_deps iface0 - - -- The export hash of a module depends on the orphan hashes of the - -- orphan modules below us in the dependency tree. This is the way - -- that changes in orphans get propagated all the way up the - -- dependency tree. - -- - -- Note [A bad dep_orphs optimization] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- In a previous version of this code, we filtered out orphan modules which - -- were not from the home package, justifying it by saying that "we'd - -- pick up the ABI hashes of the external module instead". This is wrong. - -- Suppose that we have: - -- - -- module External where - -- instance Show (a -> b) - -- - -- module Home1 where - -- import External - -- - -- module Home2 where - -- import Home1 - -- - -- The export hash of Home1 needs to reflect the orphan instances of - -- External. It's true that Home1 will get rebuilt if the orphans - -- of External, but we also need to make sure Home2 gets rebuilt - -- as well. See #12733 for more details. - let orph_mods - = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot] - $ dep_orphs sorted_deps - dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods - - -- Note [Do not update EPS with your own hi-boot] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- (See also #10182). When your hs-boot file includes an orphan - -- instance declaration, you may find that the dep_orphs of a module you - -- import contains reference to yourself. DO NOT actually load this module - -- or add it to the orphan hashes: you're going to provide the orphan - -- instances yourself, no need to consult hs-boot; if you do load the - -- interface into EPS, you will see a duplicate orphan instance. - - orphan_hash <- computeFingerprint (mk_put_name local_env) - (map ifDFun orph_insts, orph_rules, orph_fis) - - -- Hash of the transitive things in dependencies - dep_hash <- computeFingerprint putNameLiterally - (dep_sig_mods (mi_deps iface0), - dep_boot_mods (mi_deps iface0), - -- Trusted packages are like orphans - dep_trusted_pkgs (mi_deps iface0), - -- See Note [Export hash depends on non-orphan family instances] - dep_finsts (mi_deps iface0) ) - - -- the export list hash doesn't depend on the fingerprints of - -- the Names it mentions, only the Names themselves, hence putNameLiterally. - export_hash <- computeFingerprint putNameLiterally - (mi_exports iface0, - orphan_hash, - dep_hash, - dep_orphan_hashes, - mi_trust iface0) - -- Make sure change of Safe Haskell mode causes recomp. - - -- Note [Export hash depends on non-orphan family instances] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- - -- Suppose we have: - -- - -- module A where - -- type instance F Int = Bool - -- - -- module B where - -- import A - -- - -- module C where - -- import B - -- - -- The family instance consistency check for C depends on the dep_finsts of - -- B. If we rename module A to A2, when the dep_finsts of B changes, we need - -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of - -- the exports of B, because C always considers them when checking - -- consistency. - -- - -- A full discussion is in #12723. - -- - -- We do NOT need to hash dep_orphs, because this is implied by - -- dep_orphan_hashes, and we do not need to hash ordinary class instances, - -- because there is no eager consistency check as there is with type families - -- (also we didn't store it anywhere!) - -- - - -- put the declarations in a canonical order, sorted by OccName - let sorted_decls :: [(Fingerprint, IfaceDecl)] - sorted_decls = Map.elems $ Map.fromList $ - [(getOccName d, e) | e@(_, d) <- decls_w_hashes] - - -- This key is safe because mi_extra_decls contains tidied things. - getOcc (IfGblTopBndr b) = getOccName b - getOcc (IfLclTopBndr fs _ _ details) = - case details of - IfRecSelId { ifRecSelFirstCon = first_con } - -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs) - _ -> mkVarOccFS (ifLclNameFS fs) - - binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) () - binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs) - - sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] - sorted_extra_decls = sortOn binding_key <$> mi_extra_decls iface0 - - -- the flag hash depends on: - -- - (some of) dflags - -- it returns two hashes, one that shouldn't change - -- the abi hash and one that should - flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally - - opt_hash <- fingerprintOptFlags dflags putNameLiterally - - hpc_hash <- fingerprintHpcFlags dflags putNameLiterally - - plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) - - -- the ABI hash depends on: - -- - decls - -- - export list - -- - orphans - -- - deprecations - -- - flag abi hash - -- - foreign stubs and files - mod_hash <- computeFingerprint putNameLiterally - (map fst sorted_decls, - export_hash, -- includes orphan_hash - mi_warns iface0, - mi_foreign iface0) - - -- The interface hash depends on: - -- - the ABI hash, plus - -- - the source file hash, - -- - the module level annotations, - -- - usages - -- - deps (home and external packages, dependent files) - -- - hpc - iface_hash <- computeFingerprint putNameLiterally - (mod_hash, - mi_src_hash iface0, - ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache - mi_usages iface0, - sorted_deps, - mi_hpc iface0) - - let - final_iface_exts = ModIfaceBackend - { mi_iface_hash = iface_hash - , mi_mod_hash = mod_hash - , mi_flag_hash = flag_hash - , mi_opt_hash = opt_hash - , mi_hpc_hash = hpc_hash - , mi_plugin_hash = plugin_hash - , mi_orphan = not ( all ifRuleAuto orph_rules - -- See Note [Orphans and auto-generated rules] - && null orph_insts - && null orph_fis) - , mi_finsts = not (null (mi_fam_insts iface0)) - , mi_exp_hash = export_hash - , mi_orphan_hash = orphan_hash - , mi_decl_warn_fn = decl_warn_fn - , mi_export_warn_fn = export_warn_fn - , mi_fix_fn = fix_fn - , mi_hash_fn = lookupOccEnv local_env - } - final_iface = completePartialModIface iface0 - sorted_decls sorted_extra_decls final_iface_exts - -- - return final_iface - - where - this_mod = mi_module iface0 - semantic_mod = mi_semantic_module iface0 - dflags = hsc_dflags hsc_env - (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0) - (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0) - (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0) - ann_fn = mkIfaceAnnCache (mi_anns iface0) - --- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules --- (in particular, the orphan modules which are transitively imported by the --- current module). --- --- Q: Why do we need the hash at all, doesn't the list of transitively --- imported orphan modules suffice? --- --- A: If one of our transitive imports adds a new orphan instance, our --- export hash must change so that modules which import us rebuild. If we just --- hashed the [Module], the hash would not change even when a new instance was --- added to a module that already had an orphan instance. --- --- Q: Why don't we just hash the orphan hashes of our direct dependencies? --- Why the full transitive closure? --- --- A: Suppose we have these modules: --- --- module A where --- instance Show (a -> b) where --- module B where --- import A -- ** --- module C where --- import A --- import B --- --- Whether or not we add or remove the import to A in B affects the --- orphan hash of B. But it shouldn't really affect the orphan hash --- of C. If we hashed only direct dependencies, there would be no --- way to tell that the net effect was a wash, and we'd be forced --- to recompile C and everything else. -getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint] -getOrphanHashes hsc_env mods = do - let - dflags = hsc_dflags hsc_env - ctx = initSDocContext dflags defaultUserStyle - get_orph_hash mod = do - iface <- initIfaceLoad hsc_env . withIfaceErr ctx - $ loadInterface (text "getOrphanHashes") mod ImportBySystem - return (mi_orphan_hash (mi_final_exts iface)) - - mapM get_orph_hash mods - - -{- -************************************************************************ -* * - The ABI of an IfaceDecl -* * -************************************************************************ - -Note [The ABI of an IfaceDecl] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The ABI of a declaration consists of: - - (a) the full name of the identifier (inc. module and package, - because these are used to construct the symbol name by which - the identifier is known externally). - - (b) the declaration itself, as exposed to clients. That is, the - definition of an Id is included in the fingerprint only if - it is made available as an unfolding in the interface. - - (c) the fixity of the identifier (if it exists) - (d) for Ids: rules - (e) for classes: instances, fixity & rules for methods - (f) for datatypes: instances, fixity & rules for constrs - -Items (c)-(f) are not stored in the IfaceDecl, but instead appear -elsewhere in the interface file. But they are *fingerprinted* with -the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras, -and fingerprinting that as part of the declaration. --} - -type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras) - -data IfaceDeclExtras - = IfaceIdExtras IfaceIdExtras - - | IfaceDataExtras - (Maybe Fixity) -- Fixity of the tycon itself (if it exists) - [IfaceInstABI] -- Local class and family instances of this tycon - -- See Note [Orphans] in GHC.Core.InstEnv - [AnnPayload] -- Annotations of the type itself - [IfaceIdExtras] -- For each constructor: fixity, RULES and annotations - - | IfaceClassExtras - (Maybe Fixity) -- Fixity of the class itself (if it exists) - [IfaceInstABI] -- Local instances of this class *or* - -- of its associated data types - -- See Note [Orphans] in GHC.Core.InstEnv - [AnnPayload] -- Annotations of the type itself - [IfaceIdExtras] -- For each class method: fixity, RULES and annotations - [IfExtName] -- Default methods. If a module - -- mentions a class, then it can - -- instantiate the class and thereby - -- use the default methods, so we must - -- include these in the fingerprint of - -- a class. - - | IfaceSynonymExtras (Maybe Fixity) [AnnPayload] - - | IfaceFamilyExtras (Maybe Fixity) [IfaceInstABI] [AnnPayload] - - | IfaceOtherDeclExtras - -data IfaceIdExtras - = IdExtras - (Maybe Fixity) -- Fixity of the Id (if it exists) - [IfaceRule] -- Rules for the Id - [AnnPayload] -- Annotations for the Id - --- When hashing a class or family instance, we hash only the --- DFunId or CoAxiom, because that depends on all the --- information about the instance. --- -type IfaceInstABI = IfExtName -- Name of DFunId or CoAxiom that is evidence for the instance - -abiDecl :: IfaceDeclABI -> IfaceDecl -abiDecl (_, decl, _) = decl - -cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering -cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare` - getOccName (abiDecl abi2) - -freeNamesDeclABI :: IfaceDeclABI -> NameSet -freeNamesDeclABI (_mod, decl, extras) = - freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras - -freeNamesDeclExtras :: IfaceDeclExtras -> NameSet -freeNamesDeclExtras (IfaceIdExtras id_extras) - = freeNamesIdExtras id_extras -freeNamesDeclExtras (IfaceDataExtras _ insts _ subs) - = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs) -freeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms) - = unionNameSets $ - mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs -freeNamesDeclExtras (IfaceSynonymExtras _ _) - = emptyNameSet -freeNamesDeclExtras (IfaceFamilyExtras _ insts _) - = mkNameSet insts -freeNamesDeclExtras IfaceOtherDeclExtras - = emptyNameSet - -freeNamesIdExtras :: IfaceIdExtras -> NameSet -freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules) - -instance Outputable IfaceDeclExtras where - ppr IfaceOtherDeclExtras = Outputable.empty - ppr (IfaceIdExtras extras) = ppr_id_extras extras - ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns] - ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns] - ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns, - ppr_id_extras_s stuff] - ppr (IfaceClassExtras fix insts anns stuff defms) = - vcat [ppr fix, ppr_insts insts, ppr anns, - ppr_id_extras_s stuff, ppr defms] - -ppr_insts :: [IfaceInstABI] -> SDoc -ppr_insts _ = text "" - -ppr_id_extras_s :: [IfaceIdExtras] -> SDoc -ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff) - -ppr_id_extras :: IfaceIdExtras -> SDoc -ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns) - --- This instance is used only to compute fingerprints -instance Binary IfaceDeclExtras where - get _bh = panic "no get for IfaceDeclExtras" - put_ bh (IfaceIdExtras extras) = do - putByte bh 1; put_ bh extras - put_ bh (IfaceDataExtras fix insts anns cons) = do - putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons - put_ bh (IfaceClassExtras fix insts anns methods defms) = do - putByte bh 3 - put_ bh fix - put_ bh insts - put_ bh anns - put_ bh methods - put_ bh defms - put_ bh (IfaceSynonymExtras fix anns) = do - putByte bh 4; put_ bh fix; put_ bh anns - put_ bh (IfaceFamilyExtras fix finsts anns) = do - putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns - put_ bh IfaceOtherDeclExtras = putByte bh 6 - -instance Binary IfaceIdExtras where - get _bh = panic "no get for IfaceIdExtras" - put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns } - -declExtras :: (OccName -> Maybe Fixity) - -> (OccName -> [AnnPayload]) - -> OccEnv [IfaceRule] - -> OccEnv [IfaceClsInst] - -> OccEnv [IfaceFamInst] - -> OccEnv IfExtName -- lookup default method names - -> IfaceDecl - -> IfaceDeclExtras - -declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl - = case decl of - IfaceId{} -> IfaceIdExtras (id_extras n) - IfaceData{ifCons=cons} -> - IfaceDataExtras (fix_fn n) - (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++ - map ifDFun (lookupOccEnvL inst_env n)) - (ann_fn n) - (map (id_extras . occName . ifConName) (visibleIfConDecls cons)) - IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} -> - IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms - where - insts = - let (atFamInsts, atClsInsts) = foldMap at_extras ats - in (ifFamInstAxiom <$> atFamInsts) ++ (ifDFun <$> atClsInsts) - ++ (ifDFun <$> lookupOccEnvL inst_env n) - -- Include instances and axioms of the associated types - -- as well as instances of the class (#5147) (#26183) - meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs] - -- Names of all the default methods (see Note [default method Name]) - defms = [ dmName - | IfaceClassOp bndr _ (Just _) <- sigs - , let dmOcc = mkDefaultMethodOcc (nameOccName bndr) - , Just dmName <- [lookupOccEnv dm_env dmOcc] ] - IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n) - (ann_fn n) - IfaceFamily{} -> IfaceFamilyExtras (fix_fn n) - (map ifFamInstAxiom (lookupOccEnvL fi_env n) - ++ map ifDFun (lookupOccEnvL inst_env n) - ) - (ann_fn n) - _other -> IfaceOtherDeclExtras - where - n = getOccName decl - id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ) - at_extras (IfaceAT decl _) = - ( lookupOccEnvL fi_env (getOccName decl) -- Axioms - , lookupOccEnvL inst_env (getOccName decl) -- Class instances - ) - - -{- Note [default method Name] (see also #15970) - ~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The Names for the default methods aren't available in Iface syntax. - -* We originally start with a DefMethInfo from the class, contain a - Name for the default method - -* We turn that into Iface syntax as a DefMethSpec which lacks a Name - entirely. Why? Because the Name can be derived from the method name - (in GHC.IfaceToCore), so doesn't need to be serialised into the interface - file. - -But now we have to get the Name back, because the class declaration's -fingerprint needs to depend on it (this was the bug in #15970). This -is done in a slightly convoluted way: - -* Then, in addFingerprints we build a map that maps OccNames to Names - -* We pass that map to declExtras which laboriously looks up in the map - (using the derived occurrence name) to recover the Name we have just - thrown away. --} - -lookupOccEnvL :: OccEnv [v] -> OccName -> [v] -lookupOccEnvL env k = lookupOccEnv env k `orElse` [] - -{- --- for testing: use the md5sum command to generate fingerprints and --- compare the results against our built-in version. - fp' <- oldMD5 dflags bh - if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp') - else return fp - -oldMD5 dflags bh = do - tmp <- newTempName dflags CurrentModule "bin" - writeBinMem bh tmp - tmp2 <- newTempName dflags CurrentModule "md5" - let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2 - r <- system cmd - case r of - ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r) - ExitSuccess -> do - hash_str <- readFile tmp2 - return $! readHexFingerprint hash_str --} - ----------------------- --- mkOrphMap partitions instance decls or rules into --- (a) an OccEnv for ones that are not orphans, --- mapping the local OccName to a list of its decls --- (b) a list of orphan decls -mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl - -> [decl] -- Sorted into canonical order - -> (OccEnv [decl], -- Non-orphan decls associated with their key; - -- each sublist in canonical order - [decl]) -- Orphan decls; in canonical order -mkOrphMap get_key decls - = foldl' go (emptyOccEnv, []) decls - where - go (non_orphs, orphs) d - | NotOrphan occ <- get_key d - = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) - | otherwise = (non_orphs, d:orphs) - --- ----------------------------------------------------------------------------- --- Look up parents and versions of Names - --- This is like a global version of the mi_hash_fn field in each ModIface. --- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get --- the parent and version info. - -mkHashFun - :: HscEnv -- needed to look up versions - -> ExternalPackageState -- ditto - -> (Name -> IO Fingerprint) -mkHashFun hsc_env eps name - | isHoleModule orig_mod - = lookup (mkHomeModule home_unit (moduleName orig_mod)) - | otherwise - = lookup orig_mod - where - home_unit = hsc_home_unit hsc_env - dflags = hsc_dflags hsc_env - hpt = hsc_HUG hsc_env - pit = eps_PIT eps - ctx = initSDocContext dflags defaultUserStyle - occ = nameOccName name - orig_mod = nameModule name - lookup mod = do - massertPpr (isExternalName name) (ppr name) - iface <- case lookupIfaceByModule hpt pit mod of - Just iface -> return iface - Nothing -> - -- This can occur when we're writing out ifaces for - -- requirements; we didn't do any /real/ typechecking - -- so there's no guarantee everything is loaded. - -- Kind of a heinous hack. - initIfaceLoad hsc_env . withIfaceErr ctx - $ withoutDynamicNow - -- If you try and load interfaces when dynamic-too - -- enabled then it attempts to load the dyn_hi and hi - -- interface files. Backpack doesn't really care about - -- dynamic object files as it isn't doing any code - -- generation so -dynamic-too is turned off. - -- Some tests fail without doing this (such as T16219), - -- but they fail because dyn_hi files are not found for - -- one of the dependencies (because they are deliberately turned off) - -- Why is this check turned off here? That is unclear but - -- just one of the many horrible hacks in the backpack - -- implementation. - $ loadInterface (text "lookupVers2") mod ImportBySystem - return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse` - pprPanic "lookupVers1" (ppr mod <+> ppr occ)) - - --- | Creates cached lookup for the 'mi_anns' field of ModIface --- Hackily, we use "module" as the OccName for any module-level annotations -mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload] -mkIfaceAnnCache anns - = \n -> lookupOccEnv env n `orElse` [] - where - pair (IfaceAnnotation target value) = - (case target of - NamedTarget occn -> occn - ModuleTarget _ -> mkVarOccFS (fsLit "module") - , [value]) - -- flipping (++), so the first argument is always short - env = mkOccEnv_C (flip (++)) (map pair anns) + , mkSelfRecomp + ) +where + +import GHC.Prelude +import GHC.Data.FastString + +import GHC.Driver.Backend +import GHC.Driver.Env +import GHC.Driver.DynFlags +import GHC.Driver.Ppr +import GHC.Driver.Plugins + + +import GHC.Iface.Syntax +import GHC.Iface.Recomp.Binary +import GHC.Iface.Recomp.Types +import GHC.Iface.Load +import GHC.Iface.Recomp.Flags +import GHC.Iface.Env + +import GHC.Core +import GHC.Tc.Utils.Monad +import GHC.Hs + +import GHC.Data.Graph.Directed +import GHC.Data.Maybe + +import GHC.Utils.Error +import GHC.Utils.Panic +import GHC.Utils.Outputable as Outputable +import GHC.Utils.Misc as Utils +import GHC.Utils.Binary +import GHC.Utils.Fingerprint +import GHC.Utils.Exception +import GHC.Utils.Logger +import GHC.Utils.Constants (debugIsOn) + +import GHC.Types.Annotations +import GHC.Types.Avail +import GHC.Types.Basic ( ImportLevel(..) ) +import GHC.Types.Name +import GHC.Types.Name.Env +import GHC.Types.Name.Set +import GHC.Types.SrcLoc +import GHC.Types.Unique.Set +import GHC.Types.Fixity.Env +import GHC.Types.Unique.Map +import GHC.Unit.External +import GHC.Unit.Finder +import GHC.Unit.State +import GHC.Unit.Home +import GHC.Unit.Module +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.Warnings +import GHC.Unit.Module.Deps + +import Control.Monad +import Control.Monad.Trans.State +import Data.List (sortBy, sort, sortOn) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Word (Word64) +import Data.Either + +--Qualified import so we can define a Semigroup instance +-- but it doesn't clash with Outputable.<> +import qualified Data.Semigroup +import GHC.List (uncons) +import Data.Ord +import Data.Containers.ListUtils +import GHC.Iface.Errors.Ppr +import Data.Functor +import Data.Bifunctor (first) +import GHC.Types.PkgQual + +{- + ----------------------------------------------- + Recompilation checking + ----------------------------------------------- + +A complete description of how recompilation checking works can be +found in the wiki commentary: + + https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance + +Please read the above page for a top-down description of how this all +works. Notes below cover specific issues related to the implementation. + +Basic idea: + + * In the mi_usages information in an interface, we record the + fingerprint of each free variable of the module + + * In mkIface, we compute the fingerprint of each exported thing A.f. + For each external thing that A.f refers to, we include the fingerprint + of the external reference when computing the fingerprint of A.f. So + if anything that A.f depends on changes, then A.f's fingerprint will + change. + Also record any dependent files added with + * addDependentFile + * #include + * -optP-include + + * In checkOldIface we compare the mi_usages for the module with + the actual fingerprint for all each thing recorded in mi_usages +-} + +data RecompileRequired + -- | everything is up to date, recompilation is not required + = UpToDate + -- | Need to compile the module + | NeedsRecompile !CompileReason + deriving (Eq) + +needsRecompileBecause :: RecompReason -> RecompileRequired +needsRecompileBecause = NeedsRecompile . RecompBecause + +data MaybeValidated a + -- | The item contained is validated to be up to date + = UpToDateItem a + -- | The item is are absent altogether or out of date, for the reason given. + | OutOfDateItem + !CompileReason + -- ^ the reason we need to recompile. + (Maybe a) + -- ^ The old item, if it exists + deriving (Functor) + +instance Outputable a => Outputable (MaybeValidated a) where + ppr (UpToDateItem a) = text "UpToDate" <+> ppr a + ppr (OutOfDateItem r _) = text "OutOfDate: " <+> ppr r + +outOfDateItemBecause :: RecompReason -> Maybe a -> MaybeValidated a +outOfDateItemBecause reason item = OutOfDateItem (RecompBecause reason) item + +data CompileReason + -- | The .hs file has been touched, or the .o/.hi file does not exist + = MustCompile + -- | The .o/.hi files are up to date, but something else has changed + -- to force recompilation; the String says what (one-line summary) + | RecompBecause !RecompReason + deriving (Eq) + +instance Outputable RecompileRequired where + ppr UpToDate = text "UpToDate" + ppr (NeedsRecompile reason) = ppr reason + +instance Outputable CompileReason where + ppr MustCompile = text "MustCompile" + ppr (RecompBecause r) = text "RecompBecause" <+> ppr r + +instance Semigroup RecompileRequired where + UpToDate <> r = r + mc <> _ = mc + +instance Monoid RecompileRequired where + mempty = UpToDate + +data RecompReason + = UnitDepRemoved (ImportLevel, UnitId) + | ModulePackageChanged FastString + | SourceFileChanged + | NoSelfRecompInfo + | ThisUnitIdChanged + | ImpurePlugin + | PluginsChanged + | PluginFingerprintChanged + | ModuleInstChanged + | HieMissing + | HieOutdated + | SigsMergeChanged + | ModuleChanged ModuleName + | ModuleRemoved (ImportLevel, UnitId, ModuleName) + | ModuleAdded (ImportLevel, UnitId, ModuleName) + | ModuleChangedRaw ModuleName + | ModuleChangedIface ModuleName + | FileChanged FilePath + | CustomReason String + | FlagsChanged + | LinkFlagsChanged + | OptimFlagsChanged + | HpcFlagsChanged + | MissingBytecode + | MissingObjectFile + | MissingDynObjectFile + | MissingDynHiFile + | MismatchedDynHiFile + | ObjectsChanged + | LibraryChanged + | THWithJS + deriving (Eq) + + +instance Outputable RecompReason where + ppr = \case + UnitDepRemoved (_lvl, uid) -> ppr uid <+> text "removed" + ModulePackageChanged s -> ftext s <+> text "package changed" + SourceFileChanged -> text "Source file changed" + NoSelfRecompInfo -> text "Old interface lacks recompilation info" + ThisUnitIdChanged -> text "-this-unit-id changed" + ImpurePlugin -> text "Impure plugin forced recompilation" + PluginsChanged -> text "Plugins changed" + PluginFingerprintChanged -> text "Plugin fingerprint changed" + ModuleInstChanged -> text "Implementing module changed" + HieMissing -> text "HIE file is missing" + HieOutdated -> text "HIE file is out of date" + SigsMergeChanged -> text "Signatures to merge in changed" + ModuleChanged m -> ppr m <+> text "changed" + ModuleChangedRaw m -> ppr m <+> text "changed (raw)" + ModuleChangedIface m -> ppr m <+> text "changed (interface)" + ModuleRemoved (_st, _uid, m) -> ppr m <+> text "removed" + ModuleAdded (_st, _uid, m) -> ppr m <+> text "added" + FileChanged fp -> text fp <+> text "changed" + CustomReason s -> text s + FlagsChanged -> text "Flags changed" + LinkFlagsChanged -> text "Flags changed" + OptimFlagsChanged -> text "Optimisation flags changed" + HpcFlagsChanged -> text "HPC flags changed" + MissingBytecode -> text "Missing bytecode" + MissingObjectFile -> text "Missing object file" + MissingDynObjectFile -> text "Missing dynamic object file" + MissingDynHiFile -> text "Missing dynamic interface file" + MismatchedDynHiFile -> text "Mismatched dynamic interface file" + ObjectsChanged -> text "Objects changed" + LibraryChanged -> text "Library changed" + THWithJS -> text "JS backend always recompiles modules using Template Haskell for now (#23013)" + +recompileRequired :: RecompileRequired -> Bool +recompileRequired UpToDate = False +recompileRequired _ = True + +recompThen :: Monad m => m RecompileRequired -> m RecompileRequired -> m RecompileRequired +recompThen ma mb = ma >>= \case + UpToDate -> mb + rr@(NeedsRecompile _) -> pure rr + +checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired +checkList = \case + [] -> return UpToDate + (check : checks) -> check `recompThen` checkList checks + +---------------------- + +-- | Top level function to check if the version of an old interface file +-- is equivalent to the current source file the user asked us to compile. +-- If the same, we can avoid recompilation. +-- +-- We return on the outside whether the interface file is up to date, providing +-- evidence that is with a `ModIface`. In the case that it isn't, we may also +-- return a found or provided `ModIface`. Why we don't always return the old +-- one, if it exists, is unclear to me, except that I tried it and some tests +-- failed (see #18205). +checkOldIface + :: HscEnv + -> ModSummary + -> Maybe ModIface -- Old interface from compilation manager, if any + -> IO (MaybeValidated ModIface) + +checkOldIface hsc_env mod_summary maybe_iface + = do let dflags = hsc_dflags hsc_env + let logger = hsc_logger hsc_env + showPass logger $ + "Checking old interface for " ++ + (showPpr dflags $ ms_mod mod_summary) ++ + " (use -ddump-hi-diffs for more details)" + initIfaceCheck (text "checkOldIface") hsc_env $ + check_old_iface hsc_env mod_summary maybe_iface + +check_old_iface + :: HscEnv + -> ModSummary + -> Maybe ModIface + -> IfG (MaybeValidated ModIface) + +check_old_iface hsc_env mod_summary maybe_iface + = let dflags = hsc_dflags hsc_env + logger = hsc_logger hsc_env + getIface = + case maybe_iface of + Just {} -> do + trace_if logger (text "We already have the old interface for" <+> + ppr (ms_mod mod_summary)) + return maybe_iface + Nothing -> loadIface dflags (msHiFilePath mod_summary) + + loadIface read_dflags iface_path = do + let ncu = hsc_NC hsc_env + read_result <- readIface (hsc_hooks hsc_env) logger read_dflags ncu (ms_mod mod_summary) iface_path + case read_result of + Failed err -> do + let msg = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 msg ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 msg ] + return Nothing + Succeeded iface -> do + trace_if logger (text "Read the interface file" <+> text iface_path) + return $ Just iface + check_dyn_hi :: ModIface + -> IfG (MaybeValidated ModIface) + -> IfG (MaybeValidated ModIface) + check_dyn_hi normal_iface recomp_check | gopt Opt_BuildDynamicToo dflags = do + res <- recomp_check + case res of + UpToDateItem _ -> do + maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary) + case maybe_dyn_iface of + Nothing -> return $ outOfDateItemBecause MissingDynHiFile Nothing + Just dyn_iface | mi_iface_hash dyn_iface + /= mi_iface_hash normal_iface + -> return $ outOfDateItemBecause MismatchedDynHiFile Nothing + Just {} -> return res + _ -> return res + check_dyn_hi _ recomp_check = recomp_check + + + src_changed + | gopt Opt_ForceRecomp dflags = True + | otherwise = False + in do + when src_changed $ + liftIO $ trace_hi_diffs logger (nest 4 $ text "Recompilation check turned off") + + case src_changed of + -- If the source has changed and we're in interactive mode, + -- avoid reading an interface; just return the one we might + -- have been supplied with. + True | not (backendWritesFiles $ backend dflags) -> + return $ OutOfDateItem MustCompile maybe_iface + + -- Try and read the old interface for the current module + -- from the .hi file left from the last time we compiled it + True -> do + maybe_iface' <- liftIO $ getIface + return $ OutOfDateItem MustCompile maybe_iface' + + False -> do + maybe_iface' <- liftIO $ getIface + case maybe_iface' of + -- We can't retrieve the iface + Nothing -> return $ OutOfDateItem MustCompile Nothing + + -- We have got the old iface; check its versions + -- even in the SourceUnmodifiedAndStable case we + -- should check versions because some packages + -- might have changed or gone away. + Just iface -> + case mi_self_recomp_info iface of + Nothing -> return $ outOfDateItemBecause NoSelfRecompInfo Nothing + Just sr_info -> check_dyn_hi iface $ checkVersions hsc_env mod_summary iface sr_info + +-- | Check if a module is still the same 'version'. +-- +-- This function is called in the recompilation checker after we have +-- determined that the module M being checked hasn't had any changes +-- to its source file since we last compiled M. So at this point in general +-- two things may have changed that mean we should recompile M: +-- * The interface export by a dependency of M has changed. +-- * The compiler flags specified this time for M have changed +-- in a manner that is significant for recompilation. +-- We return not just if we should recompile the object file but also +-- if we should rebuild the interface file. +checkVersions :: HscEnv + -> ModSummary + -> ModIface -- Old interface + -> IfaceSelfRecomp + -> IfG (MaybeValidated ModIface) +checkVersions hsc_env mod_summary iface self_recomp + = do { liftIO $ trace_hi_diffs logger + (text "Considering whether compilation is required for" <+> + ppr (mi_module iface) <> colon) + + -- readIface will have verified that the UnitId matches, + -- but we ALSO must make sure the instantiation matches up. See + -- test case bkpcabal04! + ; hsc_env <- getTopEnv + ; if mi_sr_src_hash self_recomp /= ms_hs_hash mod_summary + then return $ outOfDateItemBecause SourceFileChanged Nothing else do { + ; if not (isHomeModule home_unit (mi_module iface)) + then return $ outOfDateItemBecause ThisUnitIdChanged Nothing else do { + ; recomp <- liftIO $ checkFlagHash hsc_env (mi_module iface) self_recomp + `recompThen` checkOptimHash hsc_env self_recomp + `recompThen` checkHpcHash hsc_env self_recomp + `recompThen` checkMergedSignatures hsc_env mod_summary self_recomp + `recompThen` checkHsig logger home_unit mod_summary iface + `recompThen` pure (checkHie dflags mod_summary) + ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do { + ; recomp <- checkDependencies hsc_env mod_summary iface + ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do { + ; recomp <- checkPlugins (hsc_plugins hsc_env) self_recomp + ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason Nothing ; _ -> do { + + -- Source code unchanged and no errors yet... carry on + -- + -- First put the dependent-module info, read from the old + -- interface, into the envt, so that when we look for + -- interfaces we look for the right one (.hi or .hi-boot) + -- + -- It's just temporary because either the usage check will succeed + -- (in which case we are done with this module) or it'll fail (in which + -- case we'll compile the module from scratch anyhow). + + when (isOneShot (ghcMode (hsc_dflags hsc_env))) $ do { + ; updateEps_ $ \eps -> eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) } + } + ; recomp <- checkList [checkModUsage (hsc_FC hsc_env) u + | u <- mi_sr_usages self_recomp] + ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do { + ; return $ UpToDateItem iface + }}}}}}} + where + logger = hsc_logger hsc_env + dflags = hsc_dflags hsc_env + home_unit = hsc_home_unit hsc_env + + + +-- | Check if any plugins are requesting recompilation +checkPlugins :: Plugins -> IfaceSelfRecomp -> IfG RecompileRequired +checkPlugins plugins self_recomp = liftIO $ do + recomp <- recompPlugins plugins + let new_fingerprint = fingerprintPluginRecompile recomp + let old_fingerprint = mi_sr_plugin_hash self_recomp + return $ pluginRecompileToRecompileRequired old_fingerprint new_fingerprint recomp + +recompPlugins :: Plugins -> IO PluginRecompile +recompPlugins plugins = mconcat <$> mapM pluginRecompile' (pluginsWithArgs plugins) + +fingerprintPlugins :: Plugins -> IO Fingerprint +fingerprintPlugins plugins = fingerprintPluginRecompile <$> recompPlugins plugins + +fingerprintPluginRecompile :: PluginRecompile -> Fingerprint +fingerprintPluginRecompile recomp = case recomp of + NoForceRecompile -> fingerprintString "NoForceRecompile" + ForceRecompile -> fingerprintString "ForceRecompile" + -- is the chance of collision worth worrying about? + -- An alternative is to fingerprintFingerprints [fingerprintString + -- "maybeRecompile", fp] + MaybeRecompile fp -> fp + + +pluginRecompileToRecompileRequired + :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired +pluginRecompileToRecompileRequired old_fp new_fp pr + | old_fp == new_fp = + case pr of + NoForceRecompile -> UpToDate + + -- we already checked the fingerprint above so a mismatch is not possible + -- here, remember that: `fingerprint (MaybeRecomp x) == x`. + MaybeRecompile _ -> UpToDate + + -- when we have an impure plugin in the stack we have to unconditionally + -- recompile since it might integrate all sorts of crazy IO results into + -- its compilation output. + ForceRecompile -> needsRecompileBecause ImpurePlugin + + | old_fp `elem` magic_fingerprints || + new_fp `elem` magic_fingerprints + -- The fingerprints do not match either the old or new one is a magic + -- fingerprint. This happens when non-pure plugins are added for the first + -- time or when we go from one recompilation strategy to another: (force -> + -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.) + -- + -- For example when we go from ForceRecomp to NoForceRecomp + -- recompilation is triggered since the old impure plugins could have + -- changed the build output which is now back to normal. + = needsRecompileBecause PluginsChanged + + | otherwise = + case pr of + -- even though a plugin is forcing recompilation the fingerprint changed + -- which would cause recompilation anyways so we report the fingerprint + -- change instead. + ForceRecompile -> needsRecompileBecause PluginFingerprintChanged + + _ -> needsRecompileBecause PluginFingerprintChanged + + where + magic_fingerprints = + [ fingerprintString "NoForceRecompile" + , fingerprintString "ForceRecompile" + ] + + +-- | Check if an hsig file needs recompilation because its +-- implementing module has changed. +checkHsig :: Logger -> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired +checkHsig logger home_unit mod_summary iface = do + let outer_mod = ms_mod mod_summary + inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod) + massert (isHomeModule home_unit outer_mod) + case inner_mod == mi_semantic_module iface of + True -> up_to_date logger (text "implementing module unchanged") + False -> return $ needsRecompileBecause ModuleInstChanged + +-- | Check if @.hie@ file is out of date or missing. +checkHie :: DynFlags -> ModSummary -> RecompileRequired +checkHie dflags mod_summary = + let hie_date_opt = ms_hie_date mod_summary + hi_date = ms_iface_date mod_summary + in if not (gopt Opt_WriteHie dflags) + then UpToDate + else case (hie_date_opt, hi_date) of + (Nothing, _) -> needsRecompileBecause HieMissing + (Just hie_date, Just hi_date) + | hie_date < hi_date + -> needsRecompileBecause HieOutdated + _ -> UpToDate + +-- | Check the flags haven't changed +checkFlagHash :: HscEnv -> Module -> IfaceSelfRecomp -> IO RecompileRequired +checkFlagHash hsc_env iface_mod self_recomp = do + let logger = hsc_logger hsc_env + let FingerprintWithValue old_fp old_flags = mi_sr_flag_hash self_recomp + let (new_fp, new_flags) = fingerprintDynFlags hsc_env iface_mod putNameLiterally + if old_fp == new_fp + then up_to_date logger (text "Module flags unchanged") + else do + -- Do not perform this computation unless -ddump-hi-diffs is on + let diffs = case old_flags of + Nothing -> pure [missingExtraFlagInfo] + Just old_flags -> checkIfaceFlags old_flags new_flags + out_of_date logger FlagsChanged (fmap vcat diffs) + + +checkIfaceFlags :: IfaceDynFlags -> IfaceDynFlags -> IO [SDoc] +checkIfaceFlags (IfaceDynFlags a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) + (IfaceDynFlags b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14) = + flip execStateT [] $ do + check_one "main is" (ppr . fmap (fmap (text @SDoc))) a1 b1 + check_one_simple "safemode" a2 b2 + check_one_simple "lang" a3 b3 + check_one_simple "exts" a4 b4 + check_one_simple "cpp option" a5 b5 + check_one_simple "js option" a6 b6 + check_one_simple "cmm option" a7 b7 + check_one "paths" (ppr . map (text @SDoc)) a8 b8 + check_one_simple "prof" a9 b9 + check_one_simple "ticky" a10 b10 + check_one_simple "codegen" a11 b11 + check_one_simple "fat iface" a12 b12 + check_one_simple "debug level" a13 b13 + check_one_simple "caller cc filter" a14 b14 + where + diffSimple p a b = vcat [text "before:" <+> p a + , text "after:" <+> p b ] + + check_one_simple s a b = check_one s ppr a b + + check_one s p a b = do + let a' = computeFingerprint putNameLiterally a + let b' = computeFingerprint putNameLiterally b + if a' == b' then pure () else modify (([ text s <+> text "flags changed"] ++ [diffSimple p a b]) ++) + +-- | Check the optimisation flags haven't changed +checkOptimHash :: HscEnv -> IfaceSelfRecomp -> IO RecompileRequired +checkOptimHash hsc_env iface = do + let logger = hsc_logger hsc_env + let old_hash = mi_sr_opt_hash iface + let !new_hash = fingerprintOptFlags (hsc_dflags hsc_env) + putNameLiterally + if | old_hash == new_hash + -> up_to_date logger (text "Optimisation flags unchanged") + | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env) + -> up_to_date logger (text "Optimisation flags changed; ignoring") + | otherwise + -> out_of_date_hash logger OptimFlagsChanged + (text " Optimisation flags have changed") + old_hash new_hash + +-- | Check the HPC flags haven't changed +checkHpcHash :: HscEnv -> IfaceSelfRecomp -> IO RecompileRequired +checkHpcHash hsc_env self_recomp = do + let logger = hsc_logger hsc_env + let old_hash = mi_sr_hpc_hash self_recomp + let !new_hash = fingerprintHpcFlags (hsc_dflags hsc_env) + putNameLiterally + if | old_hash == new_hash + -> up_to_date logger (text "HPC flags unchanged") + | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env) + -> up_to_date logger (text "HPC flags changed; ignoring") + | otherwise + -> out_of_date_hash logger HpcFlagsChanged + (text " HPC flags have changed") + old_hash new_hash + +-- Check that the set of signatures we are merging in match. +-- If the -unit-id flags change, this can change too. +checkMergedSignatures :: HscEnv -> ModSummary -> IfaceSelfRecomp -> IO RecompileRequired +checkMergedSignatures hsc_env mod_summary self_recomp = do + let logger = hsc_logger hsc_env + let unit_state = hsc_units hsc_env + let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_sr_usages self_recomp ] + new_merged = case lookupUniqMap (requirementContext unit_state) + (ms_mod_name mod_summary) of + Nothing -> [] + Just r -> sort $ map (instModuleToModule unit_state) r + if old_merged == new_merged + then up_to_date logger (text "signatures to merge in unchanged" $$ ppr new_merged) + else return $ needsRecompileBecause SigsMergeChanged + +-- If the direct imports of this module are resolved to targets that +-- are not among the dependencies of the previous interface file, +-- then we definitely need to recompile. This catches cases like +-- - an exposed package has been upgraded +-- - we are compiling with different package flags +-- - a home module that was shadowing a package module has been removed +-- - a new home module has been added that shadows a package module +-- See bug #1372. +-- +-- Returns (RecompBecause ) if recompilation is required. +checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired +checkDependencies hsc_env summary iface + = do + res_normal <- classify_import (findImportedModule hsc_env) + ([(st, p, m) | (st, p, m) <- (ms_textual_imps summary)] + ++ + [(NormalLevel, NoPkgQual, m) | m <- ms_srcimps summary ]) + res_plugin <- classify_import (\mod _ -> findPluginModule hsc_env mod) + [(st, p, m) | (st, p, m) <- (ms_plugin_imps summary) ] + case sequence (res_normal ++ res_plugin) of + Left recomp -> return $ NeedsRecompile recomp + Right es -> do + let (hs, ps) = partitionEithers es + liftIO $ + check_mods (sort hs) prev_dep_mods + `recompThen` + let allPkgDeps = sortBy (comparing snd) $ nubOrdOn snd ps + in check_packages allPkgDeps prev_dep_pkgs + where + + classify_import :: (ModuleName -> t -> IO FindResult) + -> [(ImportLevel, t, GenLocated l ModuleName)] + -> IfG + [Either + CompileReason (Either (ImportLevel, UnitId, ModuleName) (FastString, (ImportLevel, UnitId)))] + classify_import find_import imports = + liftIO $ traverse (\(st, mb_pkg, L _ mod) -> + let reason = ModuleChanged mod + in classify st reason <$> find_import mod mb_pkg) + imports + logger = hsc_logger hsc_env + all_home_units = hsc_all_home_unit_ids hsc_env + prev_dep_mods = map (\(IfaceImportLevel s,u, a) -> (s, u, gwib_mod a)) $ Set.toAscList $ dep_direct_mods (mi_deps iface) + prev_dep_pkgs = Set.toAscList (Set.union (Set.map (first tcImportLevel) (dep_direct_pkgs (mi_deps iface))) + (Set.map ((SpliceLevel),) (dep_plugin_pkgs (mi_deps iface)))) + + classify st _ (Found _ mod) + | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((st, toUnitId $ moduleUnit mod, moduleName mod))) + | otherwise = Right (Right (moduleNameFS (moduleName mod), (st, toUnitId $ moduleUnit mod))) + classify _ reason _ = Left (RecompBecause reason) + + check_mods :: [(ImportLevel, UnitId, ModuleName)] -> [(ImportLevel, UnitId, ModuleName)] -> IO RecompileRequired + check_mods [] [] = return UpToDate + check_mods [] (old:_) = do + -- This case can happen when a module is change from HPT to package import + trace_hi_diffs logger $ + text "module no longer" <+> quotes (ppr old) <+> + text "in dependencies" + + return $ needsRecompileBecause $ ModuleRemoved old + check_mods (new:news) olds + | Just (old, olds') <- uncons olds + , new == old = check_mods (dropWhile (== new) news) olds' + | otherwise = do + trace_hi_diffs logger $ + text "imported module " <> quotes (ppr new) <> + text " not among previous dependencies" + return $ needsRecompileBecause $ ModuleAdded new + + check_packages :: [(FastString, (ImportLevel, UnitId))] -> [(ImportLevel, UnitId)] -> IO RecompileRequired + check_packages [] [] = return UpToDate + check_packages [] (old:_) = do + trace_hi_diffs logger $ + text "package " <> quotes (ppr old) <> + text "no longer in dependencies" + return $ needsRecompileBecause $ UnitDepRemoved old + check_packages ((new_name, (new_unit)):news) olds + | Just (old, olds') <- uncons olds + , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds' + | otherwise = do + trace_hi_diffs logger $ + text "imported package" <+> ftext new_name <+> ppr new_unit <+> + text "not among previous dependencies" + return $ needsRecompileBecause $ ModulePackageChanged new_name + + +needInterface :: Module -> (ModIface -> IO RecompileRequired) + -> IfG RecompileRequired +needInterface mod continue + = do + mb_recomp <- tryGetModIface + "need version info for" + mod + case mb_recomp of + Nothing -> return $ NeedsRecompile MustCompile + Just iface -> liftIO $ continue iface + +tryGetModIface :: String -> Module -> IfG (Maybe ModIface) +tryGetModIface doc_msg mod + = do -- Load the imported interface if possible + logger <- getLogger + let doc_str = sep [text doc_msg, ppr mod] + liftIO $ trace_hi_diffs logger (text "Checking interface for module" <+> ppr mod <+> ppr (moduleUnit mod)) + + mb_iface <- loadInterface doc_str mod ImportBySystem + -- Load the interface, but don't complain on failure; + -- Instead, get an Either back which we can test + + case mb_iface of + Failed _ -> do + liftIO $ trace_hi_diffs logger (sep [text "Couldn't load interface for module", ppr mod]) + return Nothing + -- Couldn't find or parse a module mentioned in the + -- old interface file. Don't complain: it might + -- just be that the current module doesn't need that + -- import and it's been deleted + Succeeded iface -> pure $ Just iface + +-- | Given the usage information extracted from the old +-- M.hi file for the module being compiled, figure out +-- whether M needs to be recompiled. +checkModUsage :: FinderCache -> Usage -> IfG RecompileRequired +checkModUsage _ UsagePackageModule{ + usg_mod = mod, + usg_mod_hash = old_mod_hash } = do + logger <- getLogger + needInterface mod $ \iface -> do + let reason = ModuleChanged (moduleName mod) + checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) + -- We only track the ABI hash of package modules, rather than + -- individual entity usages, so if the ABI hash changes we must + -- recompile. This is safe but may entail more recompilation when + -- a dependent package has changed. + +checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do + logger <- getLogger + needInterface mod $ \iface -> do + let reason = ModuleChangedRaw (moduleName mod) + checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) +checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name + , usg_unit_id = uid + , usg_iface_hash = old_mod_hash } = do + let mod = mkModule (RealUnit (Definite uid)) mod_name + logger <- getLogger + needInterface mod $ \iface -> do + let reason = ModuleChangedIface mod_name + checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash iface) + +checkModUsage _ UsageHomeModule{ + usg_mod_name = mod_name, + usg_unit_id = uid, + usg_mod_hash = old_mod_hash, + usg_exports = maybe_imported_exports, + usg_entities = old_decl_hash } + = do + let mod = mkModule (RealUnit (Definite uid)) mod_name + logger <- getLogger + needInterface mod $ \iface -> do + let + new_mod_hash = mi_mod_hash iface + new_decl_hash = mi_hash_fn iface + reason = ModuleChanged (moduleName mod) + + liftIO $ do + -- CHECK MODULE + recompile <- checkModuleFingerprint logger reason old_mod_hash new_mod_hash + if not (recompileRequired recompile) + then return UpToDate + else checkList + [ -- CHECK EXPORT LIST; see Note [When to recompile when export lists change?] + checkHomeModImport logger reason maybe_imported_exports iface + , -- CHECK USED ITEMS ONE BY ONE + checkList [ checkEntityUsage logger reason new_decl_hash u + | u <- old_decl_hash] + , up_to_date logger (text " Great! The bits I use are up to date") + ] + +checkModUsage fc UsageFile{ usg_file_path = file, + usg_file_hash = old_hash, + usg_file_label = mlabel } = + liftIO $ + handleIO handler $ do + new_hash <- lookupFileCache fc $ unpackFS file + if (old_hash /= new_hash) + then return recomp + else return UpToDate + where + reason = FileChanged $ unpackFS file + recomp = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel + handler = if debugIsOn + then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp + else \_ -> return recomp -- if we can't find the file, just recompile, don't fail + +-- | We are importing a module whose exports have changed. +-- Does this require recompilation? +-- +-- See Note [When to recompile when export lists change?] +checkHomeModImport :: Logger -> RecompReason -> Maybe HomeModImport -> ModIface -> IO RecompileRequired +checkHomeModImport _ _ Nothing _ = return UpToDate +checkHomeModImport logger reason + (Just (HomeModImport old_orphan_like_hash old_avails)) + iface + -- (1) Orphans (of the module we are importing or of its dependencies) + -- have changed: recompilation is required. + -- + -- See Note [Orphan-like hash]. + | old_orphan_like_hash /= new_orphan_like_hash + = out_of_date_hash logger reason (text " Orphan-likes changed") + old_orphan_like_hash new_orphan_like_hash + | otherwise + -- (2) Is there a change in the set of entities we are importing? + = case old_avails of + -- (a) Whole module import: recompile if the export hash + -- of the module we are importing has changed. + HMIA_Implicit old_avails_hash + | old_avails_hash /= new_avails_hash + -> out_of_date_hash logger reason (text " Export list changed") + old_orphan_like_hash new_orphan_like_hash + | otherwise + -> return UpToDate + -- (b) Explicit imports: recompile if there is a change in the + -- set of imported items. + HMIA_Explicit + { hmia_imported_avails = DetOrdAvails imps + , hmia_parents_with_implicits = parents_of_implicits + } -> + case checkNewExportedAvails new_exports parents_of_implicits imps of + [] -> return UpToDate + changes@(_:_) -> + do trace_hi_diffs logger $ + hang (text "Export list changed") + 2 (ppr changes) + return $ needsRecompileBecause reason + where + new_orphan_like_hash = mi_orphan_like_hash iface + new_avails_hash = mi_export_avails_hash iface + new_exports = mi_exports iface + +-- | The exported avails of a module have changed. Should this cause recompilation +-- of a module that imports it? +-- +-- This is only about export/import lists; checking for changes in the definitions +-- of used identifiers is done later (see 'checkEntityUsage'). +-- +-- See Note [When to recompile when export lists change?]. +checkNewExportedAvails :: [AvailInfo] -> NameSet -> [AvailInfo] -> [AvailInfo] +checkNewExportedAvails new_avails parents_of_implicits imported_avails + = concatMap go imported_avails + where + go a@(Avail n) = + case lookupNameEnv env n of + Nothing -> [a] + Just {} -> [] + go a@(AvailTC n ns) = + case lookupNameEnv env n of + Nothing -> [a] + Just a' -> + case a' of + Avail {} -> [a] + AvailTC _ ns' + | n `elemNameSet` parents_of_implicits + -> + -- We are dealing with an export item of the form @T(..)@. + -- If the set of subordinate names has changed at all, we must + -- recompile. + if mkNameSet ns == mkNameSet ns' + then [] + else [a] + | otherwise + -> + -- We are dealing with an import item of the form @T(K,x,y)@. + -- Just check that all the names we are explicitly importing + -- continue to be exported. It's OK if T has more children + -- than it used to. + if all (`elem` ns') ns + then [] + else [a] + + env = availsToNameEnv new_avails + +{- Note [When to recompile when export lists change?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose module N imports module M, and the exports of M change. Does this +require recompiling N? + +Suppose for example that we have: + + module M (foo) where + foo = 3 + + module N where + import M + bar = foo + 1 + baz = 2 * bar + +If we add an identifier to the export list of M, we must recompile N because +this might introduce name clashes, e.g. changing M to: + + module M (foo, bar) where + foo = 3 + bar = 7 + +will cause N to no longer compile because of a name clash involving 'bar'. + +However, if N had an explicit import list: + + module N where + import M(foo) + bar = foo + 1 + baz = 2 * bar + +then it *does not matter* that 'M' starts exporting 'bar'; 'N' is unaffected. + +This justifies the following approach for deciding whether a change in exports +should lead to recompilation. + + (1) If the orphan instances exported by M change, or if the orphans of + dependencies of M change, we must recompile N. + See Note [Orphan-like hash] + + (2) Otherwise, look at all the import declarations that import M. + + (a) If there is a whole module import, or an "import hiding" import, + then we must recompile N when the avails exported from M change + (such a change is detected by using the 'mi_export_avails_hash'). + + (b) Otherwise, all imports are explicit imports, but not every identifier + is necessarily explicitly imported, as we might have an import of + the form @import M(T(..))@. + + We proceed by comparing what we are importing from M against the + new exports of M. We recompile unless the following two conditions + are both satisfied: + + C1. Every explicitly imported identifier continues to be exported. + C2. For every parent P in an import item of the form @P(..)@, + the set of subordinates exported by P has not changed. + +Note that this import check is done purely on the basis of the Names involved, +unlike the subsequent recompilation check done in 'checkEntityUsage' which +checks that the definitions of used identifiers have not changed. + +Note [Orphan-like hash] +~~~~~~~~~~~~~~~~~~~~~~~ +The orphan-like hash extends the orphan hash to include other entities that +also cause recompilation downstream upon changing. + +The hash includes: + + (1) orphan class and family instances + (2) exported named defaults (these are very similar to orphan instances) + (3) non-orphan type family instances, including those of dependencies + (4) the Safe Haskell safety of the module + +Why do we need to do this? For (3), suppose we have: + + module A where + type instance F Int = Bool + + module B where + import A + + module C where + import B + +The family instance consistency check for C depends on the dep_finsts of +B. If we rename module A to A2, when the dep_finsts of B changes, we need +to make sure that C gets rebuilt. Effectively, the dep_finsts are part of +the exports of B, because C always considers them when checking +consistency. + +A full discussion is in #12723. + +We do NOT need to hash dep_orphs, because this is implied by +dep_orphan_hashes, and we do not need to hash ordinary (non-orphan) class +instances, because there is no eager consistency check as there is with type +families. For this reason, we don't currently store a hash of non-orphan class +instances. +-} + +------------------------ +checkModuleFingerprint + :: Logger + -> RecompReason + -> Fingerprint + -> Fingerprint + -> IO RecompileRequired +checkModuleFingerprint logger reason old_mod_hash new_mod_hash + | new_mod_hash == old_mod_hash + = up_to_date logger (text "Module fingerprint unchanged") + + | otherwise + = out_of_date_hash logger reason (text " Module fingerprint has changed") + old_mod_hash new_mod_hash + +checkIfaceFingerprint + :: Logger + -> RecompReason + -> Fingerprint + -> Fingerprint + -> IO RecompileRequired +checkIfaceFingerprint logger reason old_mod_hash new_mod_hash + | new_mod_hash == old_mod_hash + = up_to_date logger (text "Iface fingerprint unchanged") + + | otherwise + = out_of_date_hash logger reason (text " Iface fingerprint has changed") + old_mod_hash new_mod_hash + +------------------------ +checkEntityUsage :: Logger + -> RecompReason + -> (OccName -> Maybe (OccName, Fingerprint)) + -> (OccName, Fingerprint) + -> IO RecompileRequired +checkEntityUsage logger reason new_hash (name,old_hash) = do + case new_hash name of + -- We used it before, but it ain't there now + Nothing -> out_of_date logger reason (pure $ sep [text "No longer exported:", ppr name]) + -- It's there, but is it up to date? + Just (_, new_hash) + | new_hash == old_hash + -> do trace_hi_diffs logger (text " Up to date" <+> ppr name <+> parens (ppr new_hash)) + return UpToDate + | otherwise + -> out_of_date_hash logger reason (text " Out of date:" <+> ppr name) old_hash new_hash + +up_to_date :: Logger -> SDoc -> IO RecompileRequired +up_to_date logger msg = trace_hi_diffs logger msg >> return UpToDate + +out_of_date :: Logger -> RecompReason -> IO SDoc -> IO RecompileRequired +out_of_date logger reason msg = trace_hi_diffs_io logger msg >> return (needsRecompileBecause reason) + +out_of_date_hash :: Logger -> RecompReason -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired +out_of_date_hash logger reason msg old_hash new_hash + = out_of_date logger reason (pure $ hsep [msg, ppr old_hash, text "->", ppr new_hash]) + +-- --------------------------------------------------------------------------- +-- Compute fingerprints for the interface + +{- Note [Fingerprinting IfaceDecls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The general idea here is that we first examine the 'IfaceDecl's and determine +the recursive groups of them. We then walk these groups in dependency order, +serializing each contained 'IfaceDecl' to a "Binary" buffer which we then +hash using MD5 to produce a fingerprint for the group. + +However, the serialization that we use is a bit funny: we override the @putName@ +operation with our own which serializes the hash of a 'Name' instead of the +'Name' itself. This ensures that the fingerprint of a decl changes if anything +in its transitive closure changes. This trick is why we must be careful about +traversing in dependency order: we need to ensure that we have hashes for +everything referenced by the decl which we are fingerprinting. + +Moreover, we need to be careful to distinguish between serialization of binding +Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls +field of a IfaceClsInst): only in the non-binding case should we include the +fingerprint; in the binding case we shouldn't since it is merely the name of the +thing that we are currently fingerprinting. + + +Note [Fingerprinting recursive groups] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The fingerprinting of a single recursive group is a rather subtle affair, as +seen in #18733. + +How not to fingerprint +---------------------- + +Prior to fixing #18733 we used the following (flawed) scheme to fingerprint a +group in hash environment `hash_env0`: + + 1. extend hash_env0, giving each declaration in the group the fingerprint 0 + 2. use this environment to hash the declarations' ABIs, resulting in + group_fingerprint + 3. produce the final hash environment by extending hash_env0, mapping each + declaration of the group to group_fingerprint + +However, this is wrong. Consider, for instance, a program like: + + data A = ARecu B | ABase String deriving (Show) + data B = BRecu A | BBase Int deriving (Show) + + info :: B + info = BBase 1 + +A consequence of (3) is that A and B will have the same fingerprint. This means +that if the user changes `info` to: + + info :: A + info = ABase "hello" + +The program's ABI fingerprint will not change despite `info`'s type, and +therefore ABI, being clearly different. + +However, the incorrectness doesn't end there: (1) means that all recursive +occurrences of names within the group will be given the same fingerprint. This +means that the group's fingerprint won't change if we change an occurrence of A +to B. + +Surprisingly, this bug (#18733) lurked for many years before being uncovered. + +How we now fingerprint +---------------------- + +As seen above, the fingerprinting function must ensure that a groups +fingerprint captures the structure of within-group occurrences. The scheme that +we use is: + + 0. To ensure determinism, sort the declarations into a stable order by + declaration name + + 1. Extend hash_env0, giving each declaration in the group a sequential + fingerprint (e.g. 0, 1, 2, ...). + + 2. Use this environment to hash the declarations' ABIs, resulting in + group_fingerprint. + + Since we included the sequence number in step (1) programs identical up to + transposition of recursive occurrences are distinguishable, avoiding the + second issue mentioned above. + + 3. Produce the final environment by extending hash_env, mapping each + declaration of the group to the hash of (group_fingerprint, i), where + i is the position of the declaration in the stable ordering. + + Including i in the hash ensures that the first issue noted above is + avoided. + +-} + +-- | Compute the information needed for self-recompilation checking. This +-- information can be computed before the backend phase. +mkSelfRecomp :: HscEnv -> Module -> Fingerprint -> [Usage] -> IO IfaceSelfRecomp +mkSelfRecomp hsc_env this_mod src_hash usages = do + let dflags = hsc_dflags hsc_env + + let dyn_flags_info = fingerprintDynFlags hsc_env this_mod putNameLiterally + + let opt_hash = fingerprintOptFlags dflags putNameLiterally + + let hpc_hash = fingerprintHpcFlags dflags putNameLiterally + + plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) + + let include_detailed_flags (flag_hash, flags) = + if gopt Opt_WriteSelfRecompFlags dflags + then FingerprintWithValue flag_hash (Just flags) + else FingerprintWithValue flag_hash Nothing + + return (IfaceSelfRecomp + { mi_sr_flag_hash = include_detailed_flags dyn_flags_info + , mi_sr_hpc_hash = hpc_hash + , mi_sr_opt_hash = opt_hash + , mi_sr_plugin_hash = plugin_hash + , mi_sr_src_hash = src_hash + , mi_sr_usages = usages }) + +-- | Add fingerprints for top-level declarations to a 'ModIface'. +-- +-- See Note [Fingerprinting IfaceDecls] +addFingerprints + :: HscEnv + -> PartialModIface + -> IO ModIface +addFingerprints hsc_env iface0 = do + (abiHashes, caches, decls_w_hashes) <- addAbiHashes hsc_env (mi_mod_info iface0) (mi_public iface0) (mi_deps iface0) + + -- put the declarations in a canonical order, sorted by OccName + let sorted_decls :: [(Fingerprint, IfaceDecl)] + sorted_decls = Map.elems $ Map.fromList $ + [(getOccName d, e) | e@(_, d) <- decls_w_hashes] + + -- This key is safe because mi_extra_decls contains tidied things. + getOcc (IfGblTopBndr b) = getOccName b + getOcc (IfLclTopBndr fs _ _ details) = + case details of + IfRecSelId { ifRecSelFirstCon = first_con } + -> mkRecFieldOccFS (getOccFS first_con) (ifLclNameFS fs) + _ -> mkVarOccFS (ifLclNameFS fs) + + binding_key (IfaceNonRec b _) = IfaceNonRec (getOcc b) () + binding_key (IfaceRec bs) = IfaceRec (map (\(b, _) -> (getOcc b, ())) bs) + + sorted_extra_decls :: Maybe IfaceSimplifiedCore + sorted_extra_decls = mi_simplified_core iface0 <&> \simpl_core -> + IfaceSimplifiedCore (sortOn binding_key (mi_sc_extra_decls simpl_core)) (mi_sc_foreign simpl_core) + + -- The interface hash depends on: + -- - the ABI hash, plus + -- - the things which can affect whether a module is recompiled + -- - the module level annotations, + -- - deps (home and external packages, dependent files) + let !iface_hash = computeFingerprint putNameLiterally + (mi_abi_mod_hash abiHashes, + mi_self_recomp_info iface0, + mi_deps iface0) + + let final_iface = completePartialModIface iface0 iface_hash + sorted_decls sorted_extra_decls abiHashes caches + -- + return final_iface + + + +-- The ABI hash should depend on everything in IfacePublic +-- This is however computed in a very convoluted way, so be careful your +-- addition ends up in the right place. In essence all this function does is +-- compute a hash of the arguments. +-- +-- Why the convoluted way? Hashing individual declarations allows us to do fine-grained +-- recompilation checking for home package modules, which record precisely what they use +-- from each module. +addAbiHashes :: HscEnv -> IfaceModInfo -> PartialIfacePublic -> Dependencies -> IO (IfaceAbiHashes, IfaceCache, [(Fingerprint, IfaceDecl)]) +addAbiHashes hsc_env info + iface_public + deps = do + eps <- hscEPS hsc_env + let + -- If you have arrived here by accident then congratulations, + -- you have discovered the ABI hash. Your reward is to update the ABI hash to + -- account for your change to the interface file. Omitting your field using a + -- wildcard may lead to some unfortunate consequences. + IfacePublic + exports fixities warns anns decls + defaults insts fam_insts rules + trust _trust_pkg -- TODO: trust_pkg ignored + complete + _cache + () + = iface_public + -- And these fields of deps should be in IfacePublic, but in good time. + Dependencies _ _ _ sig_mods trusted_pkgs boot_mods orph_mods fis_mods = deps + decl_warn_fn = mkIfaceDeclWarnCache (fromIfaceWarnings warns) + export_warn_fn = mkIfaceExportWarnCache (fromIfaceWarnings $ warns) + fix_fn = mkIfaceFixCache fixities + + this_mod = mi_mod_info_module info + semantic_mod = mi_mod_info_semantic_module info + (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph insts + (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph rules + (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph fam_insts + complete_matches = mkIfaceCompleteMap complete + ann_fn = mkIfaceAnnCache anns + + -- The ABI of a declaration represents everything that is made + -- visible about the declaration that a client can depend on. + -- see IfaceDeclABI below. + declABI :: IfaceDecl -> IfaceDeclABI + -- TODO: I'm not sure if this should be semantic_mod or this_mod. + -- See also Note [Identity versus semantic module] + declABI decl = (this_mod, decl, extras) + where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts + non_orph_fis top_lvl_name_env complete_matches decl + + -- This is used for looking up the Name of a default method + -- from its OccName. See Note [default method Name] + top_lvl_name_env = + mkOccEnv [ (nameOccName nm, nm) + | IfaceId { ifName = nm } <- decls ] + + -- Dependency edges between declarations in the current module. + -- This is computed by finding the free external names of each + -- declaration, including IfaceDeclExtras (things that a + -- declaration implicitly depends on). + edges :: [ Node OccName IfaceDeclABI ] + edges = [ DigraphNode abi (getOccName decl) out + | decl <- decls + , let abi = declABI decl + , let out = localOccs $ freeNamesDeclABI abi + ] + + name_module n = assertPpr (isExternalName n) (ppr n) (nameModule n) + localOccs = + map (getParent . getOccName) + -- NB: names always use semantic module, so + -- filtering must be on the semantic module! + -- See Note [Identity versus semantic module] + . filter ((== semantic_mod) . name_module) + . nonDetEltsUniqSet + -- It's OK to use nonDetEltsUFM as localOccs is only + -- used to construct the edges and + -- stronglyConnCompFromEdgedVertices is deterministic + -- even with non-deterministic order of edges as + -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. + where getParent :: OccName -> OccName + getParent occ = lookupOccEnv parent_map occ `orElse` occ + + -- maps OccNames to their parents in the current module. + -- e.g. a reference to a constructor must be turned into a reference + -- to the TyCon for the purposes of calculating dependencies. + parent_map :: OccEnv OccName + parent_map = foldl' extend emptyOccEnv decls + where extend env d = + extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ] + where n = getOccName d + + -- Strongly-connected groups of declarations, in dependency order + groups :: [SCC IfaceDeclABI] + groups = stronglyConnCompFromEdgedVerticesOrd edges + + global_hash_fn = mkHashFun hsc_env eps + + -- How to output Names when generating the data to fingerprint. + -- Here we want to output the fingerprint for each top-level + -- Name, whether it comes from the current module or another + -- module. In this way, the fingerprint for a declaration will + -- change if the fingerprint for anything it refers to (transitively) + -- changes. + mk_put_name :: OccEnv (OccName,Fingerprint) + -> WriteBinHandle -> Name -> IO () + mk_put_name local_env bh name + | isWiredInName name = putNameLiterally bh name + -- wired-in names don't have fingerprints + | otherwise + = assertPpr (isExternalName name) (ppr name) $ + let hash | nameModule name /= semantic_mod = global_hash_fn name + -- Get it from the REAL interface!! + -- This will trigger when we compile an hsig file + -- and we know a backing impl for it. + -- See Note [Identity versus semantic module] + | semantic_mod /= this_mod + , not (isHoleModule semantic_mod) = global_hash_fn name + | otherwise = return (snd (lookupOccEnv local_env (getOccName name) + `orElse` pprPanic "urk! lookup local fingerprint" + (ppr name $$ ppr local_env))) + -- This panic indicates that we got the dependency + -- analysis wrong, because we needed a fingerprint for + -- an entity that wasn't in the environment. To debug + -- it, turn the panic into a trace, uncomment the + -- pprTraces below, run the compile again, and inspect + -- the output and the generated .hi file with + -- --show-iface. + in hash >>= put_ bh + + -- take a strongly-connected group of declarations and compute + -- its fingerprint. + + fingerprint_group :: (OccEnv (OccName,Fingerprint), + [(Fingerprint,IfaceDecl)]) + -> SCC IfaceDeclABI + -> IO (OccEnv (OccName,Fingerprint), + [(Fingerprint,IfaceDecl)]) + + fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi) + = do let hash_fn = mk_put_name local_env + decl = abiDecl abi + --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do + let !hash = computeFingerprint hash_fn abi + env' <- extend_hash_env local_env (hash,decl) + return (env', (hash,decl) : decls_w_hashes) + + fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis) + = do let stable_abis = sortBy cmp_abiNames abis + stable_decls = map abiDecl stable_abis + local_env1 <- foldM extend_hash_env local_env + (zip (map mkRecFingerprint [0..]) stable_decls) + -- See Note [Fingerprinting recursive groups] + let hash_fn = mk_put_name local_env1 + -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do + -- put the cycle in a canonical order + let !hash = computeFingerprint hash_fn stable_abis + let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls + -- See Note [Fingerprinting recursive groups] + local_env2 <- foldM extend_hash_env local_env pairs + return (local_env2, pairs ++ decls_w_hashes) + + -- Make a fingerprint from the ordinal position of a binding in its group. + mkRecFingerprint :: Word64 -> Fingerprint + mkRecFingerprint i = Fingerprint 0 i + + bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint + bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ] + + -- we have fingerprinted the whole declaration, but we now need + -- to assign fingerprints to all the OccNames that it binds, to + -- use when referencing those OccNames in later declarations. + -- + extend_hash_env :: OccEnv (OccName,Fingerprint) + -> (Fingerprint,IfaceDecl) + -> IO (OccEnv (OccName,Fingerprint)) + extend_hash_env env0 (hash,d) = + return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0 + (ifaceDeclFingerprints hash d)) + + -- + (local_env, decls_w_hashes) <- + foldM fingerprint_group (emptyOccEnv, []) groups + + -- The export hash of a module depends on the orphan hashes of the + -- orphan modules below us in the dependency tree. This is the way + -- that changes in orphans get propagated all the way up the + -- dependency tree. + -- + -- NB: do not filter out non-home-package modules! + -- See Note [Take into account non-home package orphan modules]. + let orph_mods_no_self + = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot] + $ orph_mods + dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods_no_self + + let !orphan_hash = computeFingerprint (mk_put_name local_env) + (map ifDFun orph_insts, orph_rules, orph_fis) + + -- Hash of the transitive things in dependencies + let !dep_hash = computeFingerprint putNameLiterally + ( sig_mods, boot_mods + , trusted_pkgs -- Trusted packages are like orphans + , fis_mods -- See Note [Orphan-like hash] + ) + + -- The export list hash doesn't depend on the fingerprints of + -- the Names it mentions, only the Names themselves, hence putNameLiterally. + -- + -- As per Note [When to recompile when export lists change?], there are two + -- separate considerations: + -- + -- (1) If there is a change in exported orphan instances, we must recompile. + -- + -- In fact, we must include slightly more items here than only the orphan + -- instances defined in the current module; see Note [Orphan-like hash]. + -- + -- (2) If there is a change in the exported avails, this may or may not + -- require recompilation downstream, depending on what is imported. + -- In the case that the downstream module has a whole module import, + -- then we recompile when any exports change, by looking at export_hash. + let + -- (1) Orphan-like information, see Note [Orphan-like hash]. + !orphan_like_hash = + computeFingerprint putNameLiterally + ( orphan_hash, dep_hash, dep_orphan_hashes + , defaults -- Changes in exported named defaults cause recompilation + , trust -- Change of Safe Haskell mode causes recompilation + ) + -- (2) Exported avails + !exported_avails_hash = computeFingerprint putNameLiterally exports + + -- the ABI hash depends on: + -- - decls + -- - export list + -- - orphans + -- - deprecations + -- - flag abi hash + let !mod_hash = computeFingerprint putNameLiterally + (sort (map fst decls_w_hashes), + exported_avails_hash, + orphan_like_hash, -- includes orphan_hash + ann_fn AnnModule, + warns) + + -- Surely the ABI depends on "module" annotations? + -- Also named defaults + + + + let + final_iface_exts = IfaceAbiHashes + { mi_abi_mod_hash = mod_hash + , mi_abi_orphan = not ( all ifRuleAuto orph_rules + -- See Note [Orphans and auto-generated rules] + && null orph_insts + && null orph_fis) + , mi_abi_finsts = not (null fam_insts) + , mi_abi_export_avails_hash = exported_avails_hash + , mi_abi_orphan_like_hash = orphan_like_hash + , mi_abi_orphan_hash = orphan_hash + } + + caches = IfaceCache + { mi_cache_decl_warn_fn = decl_warn_fn + , mi_cache_export_warn_fn = export_warn_fn + , mi_cache_fix_fn = fix_fn + , mi_cache_hash_fn = lookupOccEnv local_env + } + return (final_iface_exts, caches, decls_w_hashes) + where + +{- Note [Take into account non-home package orphan modules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We need to take into account all orphan modules, not just those that are from +the home package. + +Historically, we filtered out orphan modules which were not from the home +package, justifying it by saying that "we'd pick up the ABI hashes of the +external module instead". This is wrong. + +Suppose that we have: + + module External where + instance Show (a -> b) + + module Home1 where + import External + + module Home2 where + import Home1 + +The export hash of Home1 needs to reflect the orphan instances of +External. It's true that Home1 will get rebuilt if the orphans +of External, but we also need to make sure Home2 gets rebuilt +as well. See #12733 for more details. + +Note [Do not update EPS with your own hi-boot] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When your hs-boot file includes an orphan instance declaration, you may find +that the dep_orphs of a module you import contains reference to yourself. +DO NOT actually load this module or add it to the orphan hashes: you're going +to provide the orphan instances yourself, no need to consult hs-boot; if you do +load the interface into EPS, you will see a duplicate orphan instance. + +See also #10182. +-} + +-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules +-- (in particular, the orphan modules which are transitively imported by the +-- current module). +-- +-- Q: Why do we need the hash at all, doesn't the list of transitively +-- imported orphan modules suffice? +-- +-- A: If one of our transitive imports adds a new orphan instance, our +-- export hash must change so that modules which import us rebuild. If we just +-- hashed the [Module], the hash would not change even when a new instance was +-- added to a module that already had an orphan instance. +-- +-- Q: Why don't we just hash the orphan hashes of our direct dependencies? +-- Why the full transitive closure? +-- +-- A: Suppose we have these modules: +-- +-- module A where +-- instance Show (a -> b) where +-- module B where +-- import A -- ** +-- module C where +-- import A +-- import B +-- +-- Whether or not we add or remove the import to A in B affects the +-- orphan hash of B. But it shouldn't really affect the orphan hash +-- of C. If we hashed only direct dependencies, there would be no +-- way to tell that the net effect was a wash, and we'd be forced +-- to recompile C and everything else. +getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint] +getOrphanHashes hsc_env mods = do + let + dflags = hsc_dflags hsc_env + ctx = initSDocContext dflags defaultUserStyle + get_orph_hash mod = do + iface <- initIfaceLoad hsc_env . withIfaceErr ctx + $ loadInterface (text "getOrphanHashes") mod ImportBySystem + return (mi_orphan_hash iface) + + mapM get_orph_hash mods + + +{- +************************************************************************ +* * + The ABI of an IfaceDecl +* * +************************************************************************ + +Note [The ABI of an IfaceDecl] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The ABI of a declaration consists of: + + (a) the full name of the identifier (inc. module and package, + because these are used to construct the symbol name by which + the identifier is known externally). + + (b) the declaration itself, as exposed to clients. That is, the + definition of an Id is included in the fingerprint only if + it is made available as an unfolding in the interface. + + (c) the fixity of the identifier (if it exists) + (d) for Ids: rules + (e) for classes: instances, fixity & rules for methods + (f) for datatypes: instances, fixity & rules for constrs + +Items (c)-(f) are not stored in the IfaceDecl, but instead appear +elsewhere in the interface file. But they are *fingerprinted* with +the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras, +and fingerprinting that as part of the declaration. +-} + +type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras) + +data IfaceDeclExtras + = IfaceIdExtras IfaceIdExtras + + | IfaceDataExtras + (Maybe Fixity) -- Fixity of the tycon itself (if it exists) + [IfaceInstABI] -- Local class and family instances of this tycon + -- See Note [Orphans] in GHC.Core.InstEnv + [AnnPayload] -- Annotations of the type itself + [IfaceIdExtras] -- For each constructor: fixity, RULES and annotations + + | IfaceClassExtras + (Maybe Fixity) -- Fixity of the class itself (if it exists) + [IfaceInstABI] -- Local instances of this class *or* + -- of its associated data types + -- See Note [Orphans] in GHC.Core.InstEnv + [AnnPayload] -- Annotations of the type itself + [IfaceIdExtras] -- For each class method: fixity, RULES and annotations + [IfExtName] -- Default methods. If a module + -- mentions a class, then it can + -- instantiate the class and thereby + -- use the default methods, so we must + -- include these in the fingerprint of + -- a class. + + | IfaceSynonymExtras (Maybe Fixity) [AnnPayload] + + | IfaceFamilyExtras (Maybe Fixity) [IfaceInstABI] [AnnPayload] + + | IfacePatSynExtras (Maybe Fixity) [IfaceCompleteMatchABI] -- ^ COMPLETE pragmas that this PatSyn appears in + + | IfaceOtherDeclExtras + +data IfaceIdExtras + = IdExtras + (Maybe Fixity) -- Fixity of the Id (if it exists) + [IfaceRule] -- Rules for the Id + [AnnPayload] -- Annotations for the Id + [IfaceCompleteMatchABI] -- See Note [Fingerprinting complete matches] for why this is in IdExtras + +-- When hashing a class or family instance, we hash only the +-- DFunId or CoAxiom, because that depends on all the +-- information about the instance. +-- +type IfaceInstABI = IfExtName -- Name of DFunId or CoAxiom that is evidence for the instance + +-- See Note [Fingerprinting complete matches] +type IfaceCompleteMatchABI = (Fingerprint, Maybe IfExtName) + +abiDecl :: IfaceDeclABI -> IfaceDecl +abiDecl (_, decl, _) = decl + +cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering +cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare` + getOccName (abiDecl abi2) + +freeNamesDeclABI :: IfaceDeclABI -> NameSet +freeNamesDeclABI (_mod, decl, extras) = + freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras + +freeNamesDeclExtras :: IfaceDeclExtras -> NameSet +freeNamesDeclExtras (IfaceIdExtras id_extras) + = freeNamesIdExtras id_extras +freeNamesDeclExtras (IfaceDataExtras _ insts _ subs) + = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs) +freeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms) + = unionNameSets $ + mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs +freeNamesDeclExtras (IfaceSynonymExtras _ _) + = emptyNameSet +freeNamesDeclExtras (IfaceFamilyExtras _ insts _) + = mkNameSet insts +freeNamesDeclExtras (IfacePatSynExtras _ complete) + = unionNameSets (map freeNamesIfaceCompleteABI complete) +freeNamesDeclExtras IfaceOtherDeclExtras + = emptyNameSet + +freeNamesIdExtras :: IfaceIdExtras -> NameSet +freeNamesIdExtras (IdExtras _ rules _ complete) = + unionNameSets (map freeNamesIfRule rules ++ map freeNamesIfaceCompleteABI complete) + +-- | Extract free names from a COMPLETE pragma ABI +freeNamesIfaceCompleteABI :: IfaceCompleteMatchABI -> NameSet +freeNamesIfaceCompleteABI (_, mb_ty) = case mb_ty of + Nothing -> emptyNameSet + Just ty -> unitNameSet ty + + +instance Outputable IfaceDeclExtras where + ppr IfaceOtherDeclExtras = Outputable.empty + ppr (IfaceIdExtras extras) = ppr_id_extras extras + ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns] + ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns] + ppr (IfaceDataExtras fix insts anns stuff) + = vcat [ppr fix, ppr_insts insts, ppr anns, + ppr_id_extras_s stuff] + ppr (IfaceClassExtras fix insts anns stuff defms) = + vcat [ppr fix, ppr_insts insts, ppr anns, + ppr_id_extras_s stuff, ppr defms] + ppr (IfacePatSynExtras fix complete) = vcat [ppr fix, ppr complete] + +ppr_insts :: [IfaceInstABI] -> SDoc +ppr_insts _ = text "" + +ppr_id_extras_s :: [IfaceIdExtras] -> SDoc +ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff) + +ppr_id_extras :: IfaceIdExtras -> SDoc +ppr_id_extras (IdExtras fix rules anns complete) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns) $$ vcat (map ppr complete) + +-- This instance is used only to compute fingerprints +instance Binary IfaceDeclExtras where + get _bh = panic "no get for IfaceDeclExtras" + put_ bh (IfaceIdExtras extras) = do + putByte bh 1; put_ bh extras + put_ bh (IfaceDataExtras fix insts anns cons) = do + putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons + put_ bh (IfaceClassExtras fix insts anns methods defms) = do + putByte bh 3 + put_ bh fix + put_ bh insts + put_ bh anns + put_ bh methods + put_ bh defms + put_ bh (IfaceSynonymExtras fix anns) = do + putByte bh 4; put_ bh fix; put_ bh anns + put_ bh (IfaceFamilyExtras fix finsts anns) = do + putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns + put_ bh (IfacePatSynExtras fix complete) = do + putByte bh 6; put_ bh fix; put_ bh complete + put_ bh IfaceOtherDeclExtras = putByte bh 7 + +instance Binary IfaceIdExtras where + get _bh = panic "no get for IfaceIdExtras" + put_ bh (IdExtras fix rules anns complete) = do { put_ bh fix; put_ bh rules; put_ bh anns; put_ bh complete } + +declExtras :: (OccName -> Maybe Fixity) + -> (AnnCacheKey -> [AnnPayload]) + -> OccEnv [IfaceRule] + -> OccEnv [IfaceClsInst] + -> OccEnv [IfaceFamInst] + -> OccEnv IfExtName -- lookup default method names + -> OccEnv [IfaceCompleteMatchABI] -- lookup complete matches + -> IfaceDecl + -> IfaceDeclExtras + +declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env complete_env decl + = case decl of + IfaceId{} -> IfaceIdExtras (id_extras n) + IfaceData{ifCons=cons} -> + IfaceDataExtras (fix_fn n) + (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++ + map ifDFun (lookupOccEnvL inst_env n)) + (ann_fn (AnnOccName n)) + (map (id_extras . occName . ifConName) (visibleIfConDecls cons)) + IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} -> + IfaceClassExtras (fix_fn n) insts (ann_fn (AnnOccName n)) meths defms + where + insts = (map ifDFun $ (concatMap at_extras ats) + ++ lookupOccEnvL inst_env n) + -- Include instances of the associated types + -- as well as instances of the class (#5147) + meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs] + -- Names of all the default methods (see Note [default method Name]) + defms = [ dmName + | IfaceClassOp bndr _ (Just _) <- sigs + , let dmOcc = mkDefaultMethodOcc (nameOccName bndr) + , Just dmName <- [lookupOccEnv dm_env dmOcc] ] + IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n) + (ann_fn (AnnOccName n)) + IfaceFamily{} -> IfaceFamilyExtras (fix_fn n) + (map ifFamInstAxiom (lookupOccEnvL fi_env n)) + (ann_fn (AnnOccName n)) + IfacePatSyn{} -> IfacePatSynExtras (fix_fn n) (lookup_complete_match n) + _other -> IfaceOtherDeclExtras + where + n = getOccName decl + id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn (AnnOccName occ)) (lookup_complete_match occ) + at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl) + + lookup_complete_match occ = lookupOccEnvL complete_env occ + +{- Note [default method Name] (see also #15970) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The Names for the default methods aren't available in Iface syntax. + +* We originally start with a DefMethInfo from the class, contain a + Name for the default method + +* We turn that into Iface syntax as a DefMethSpec which lacks a Name + entirely. Why? Because the Name can be derived from the method name + (in GHC.IfaceToCore), so doesn't need to be serialised into the interface + file. + +But now we have to get the Name back, because the class declaration's +fingerprint needs to depend on it (this was the bug in #15970). This +is done in a slightly convoluted way: + +* Then, in addFingerprints we build a map that maps OccNames to Names + +* We pass that map to declExtras which laboriously looks up in the map + (using the derived occurrence name) to recover the Name we have just + thrown away. +-} + +lookupOccEnvL :: OccEnv [v] -> OccName -> [v] +lookupOccEnvL env k = lookupOccEnv env k `orElse` [] + +{- +-- for testing: use the md5sum command to generate fingerprints and +-- compare the results against our built-in version. + fp' <- oldMD5 dflags bh + if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp') + else return fp + +oldMD5 dflags bh = do + tmp <- newTempName dflags CurrentModule "bin" + writeBinMem bh tmp + tmp2 <- newTempName dflags CurrentModule "md5" + let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2 + r <- system cmd + case r of + ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r) + ExitSuccess -> do + hash_str <- readFile tmp2 + return $! readHexFingerprint hash_str +-} + +---------------------- +-- mkOrphMap partitions instance decls or rules into +-- (a) an OccEnv for ones that are not orphans, +-- mapping the local OccName to a list of its decls +-- (b) a list of orphan decls +mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl + -> [decl] -- Sorted into canonical order + -> (OccEnv [decl], -- Non-orphan decls associated with their key; + -- each sublist in canonical order + [decl]) -- Orphan decls; in canonical order +mkOrphMap get_key decls + = foldl' go (emptyOccEnv, []) decls + where + go (non_orphs, orphs) d + | NotOrphan occ <- get_key d + = (extendOccEnv_Acc (:) Utils.singleton non_orphs occ d, orphs) + | otherwise = (non_orphs, d:orphs) + +-- ----------------------------------------------------------------------------- +-- Look up parents and versions of Names + +-- This is like a global version of the mi_hash_fn field in each ModIface. +-- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get +-- the parent and version info. + +mkHashFun + :: HscEnv -- needed to look up versions + -> ExternalPackageState -- ditto + -> (Name -> IO Fingerprint) +mkHashFun hsc_env eps name + | isHoleModule orig_mod + = lookup (mkHomeModule home_unit (moduleName orig_mod)) + | otherwise + = lookup orig_mod + where + home_unit = hsc_home_unit hsc_env + dflags = hsc_dflags hsc_env + hpt = hsc_HUG hsc_env + pit = eps_PIT eps + ctx = initSDocContext dflags defaultUserStyle + occ = nameOccName name + orig_mod = nameModule name + lookup mod = do + massertPpr (isExternalName name) (ppr name) + iface <- lookupIfaceByModule hpt pit mod >>= \case + Just iface -> return iface + Nothing -> + -- This can occur when we're writing out ifaces for + -- requirements; we didn't do any /real/ typechecking + -- so there's no guarantee everything is loaded. + -- Kind of a heinous hack. + initIfaceLoad hsc_env . withIfaceErr ctx + $ withoutDynamicNow + -- If you try and load interfaces when dynamic-too + -- enabled then it attempts to load the dyn_hi and hi + -- interface files. Backpack doesn't really care about + -- dynamic object files as it isn't doing any code + -- generation so -dynamic-too is turned off. + -- Some tests fail without doing this (such as T16219), + -- but they fail because dyn_hi files are not found for + -- one of the dependencies (because they are deliberately turned off) + -- Why is this check turned off here? That is unclear but + -- just one of the many horrible hacks in the backpack + -- implementation. + $ loadInterface (text "lookupVers2") mod ImportBySystem + return $ snd (mi_hash_fn iface occ `orElse` + pprPanic "lookupVers1" (ppr mod <+> ppr occ)) + +{- Note [Fingerprinting complete matches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The presence or absence of COMPLETE pragmas influences the programs we generate, +and not just error messages, because pattern fallibility information feeds into +the desugaring of do notation (e.g. whether to use 'fail' from 'MonadFail'). + +As far as recompilation checking is concerned, there are two questions we need +to answer: + + Usage: When is a COMPLETE pragma used? + Fingerprinting: What is the Fingerprint of a COMPLETE pragma, i.e. when + do we consider a COMPLETE pragma to have changed? + +Usage + + There isn't a straightforward way to compute which COMPLETE pragmas are + "used" during pattern-match checking. So we have to come up with a conservative + approximation. + + The most conservative option is to consider a COMPLETE pragma to always be + used, much like we treat orphan class instances today. This means that any + change at all would require recompilation. + + A slightly finer grained option, which is what is currently implemented, is to + consider a COMPLETE pragma to be used only when the importing module actually + mentions at least one of the constructors in the COMPLETE pragma. + + Tested in: RecompCompletePragma + +Fingerprinting + + Most conservatively, the fingerprint of a COMPLETE pragma would be the hash of + all the constructors it mentions (together with the hash of the result TyCon, + if any). + + However, for the purposes of the pattern-match checker, we only really care + about the Names of the constructors in a COMPLETE pragma; it doesn't matter + what the definitions of the constructors are. The above criterion would + pessimistically lead to recompilation in the following scenario: + + module M where + pattern MyJust :: a -> Maybe a + pattern MyJust a = Just a + pattern MyNothing :: Maybe a + pattern MyNothing = Nothing + {-# COMPLETE MyJust, MyNothing #-} + + module N where + import M + f :: Maybe Int -> Int + f (MyJust x) = x; f _ = 0 + + In this example, if we change the definition of the 'MyNothing' pattern, then + we will recompile 'M', because 'N' uses the 'MyJust' constructor, 'MyJust' + appears in the imported {-# COMPLETE MyJust, MyNothing #-} pragma, and + 'MyNothing' has changed. + + However, this is needless: the RHS of the pattern synonym declaration for + 'MyNothing' is completely irrelevant to 'N'. So, to avoid this extraneous + recompilation, we implement the following finer-grained criterion: the + Fingerprint of a COMPLETE pragma is the hash of the 'Name's of the mentioned + constructors (hashed together with the Fingerprint of the result TyCon, if any). + + Tested in: RecompCompleteIndependence. +-} + +-- | Make a map from OccNames of pattern synonyms or data constructors to a list +-- of COMPLETE pragmas relevant for that OccName. +-- See Note [Fingerprinting complete matches] +mkIfaceCompleteMap :: [IfaceCompleteMatch] -> OccEnv [IfaceCompleteMatchABI] +mkIfaceCompleteMap complete = + mkOccEnv_C (++) $ + concatMap (\m@(IfaceCompleteMatch syns _) -> + let complete_abi = mkIfaceCompleteMatchABI m + in [(getOccName syn, [complete_abi]) | syn <- syns] + ) complete + where + mkIfaceCompleteMatchABI (IfaceCompleteMatch syns ty) = + (computeFingerprint putNameLiterally syns, ty) + +data AnnCacheKey = AnnModule | AnnOccName OccName + +-- | Creates cached lookup for the 'mi_anns' field of ModIface +mkIfaceAnnCache :: [IfaceAnnotation] -> AnnCacheKey -> [AnnPayload] +mkIfaceAnnCache anns + = \n -> case n of + AnnModule -> module_anns + AnnOccName occn -> lookupOccEnv env occn `orElse` [] + where + (module_anns, occ_anns) = partitionEithers $ map classify anns + classify (IfaceAnnotation target value) = + case target of + NamedTarget occn -> Right (occn, [value]) + ModuleTarget _ -> Left value + + -- flipping (++), so the first argument is always short + env = mkOccEnv_C (flip (++)) occ_anns diff --git a/GHC/Iface/Recomp/Binary.hs b/GHC/Iface/Recomp/Binary.hs --- a/GHC/Iface/Recomp/Binary.hs +++ b/GHC/Iface/Recomp/Binary.hs @@ -15,6 +15,7 @@ import GHC.Types.Name import GHC.Utils.Panic.Plain import GHC.Iface.Type (putIfaceType) +import System.IO.Unsafe (unsafePerformIO) fingerprintBinMem :: WriteBinHandle -> IO Fingerprint fingerprintBinMem bh = withBinBuffer bh f @@ -29,8 +30,8 @@ computeFingerprint :: (Binary a) => (WriteBinHandle -> Name -> IO ()) -> a - -> IO Fingerprint -computeFingerprint put_nonbinding_name a = do + -> Fingerprint +computeFingerprint put_nonbinding_name a = unsafePerformIO $ do bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block put_ bh a fingerprintBinMem bh diff --git a/GHC/Iface/Recomp/Flags.hs b/GHC/Iface/Recomp/Flags.hs --- a/GHC/Iface/Recomp/Flags.hs +++ b/GHC/Iface/Recomp/Flags.hs @@ -19,11 +19,14 @@ import GHC.Types.SafeHaskell import GHC.Utils.Fingerprint import GHC.Iface.Recomp.Binary -import GHC.Core.Opt.CallerCC () -- for Binary instances +import GHC.Iface.Flags import GHC.Data.EnumSet as EnumSet import System.FilePath (normalise) +import Data.Maybe +-- The subset of DynFlags which is used by the recompilation checker. + -- | Produce a fingerprint of a @DynFlags@ value. We only base -- the finger print on important fields in @DynFlags@ so that -- the recompilation checker can use this fingerprint. @@ -32,7 +35,7 @@ -- file, not the actual 'Module' according to our 'DynFlags'. fingerprintDynFlags :: HscEnv -> Module -> (WriteBinHandle -> Name -> IO ()) - -> IO Fingerprint + -> (Fingerprint, IfaceDynFlags) fingerprintDynFlags hsc_env this_mod nameio = let dflags@DynFlags{..} = hsc_dflags hsc_env @@ -43,53 +46,59 @@ -- oflags = sort $ filter filterOFlags $ flags dflags -- all the extension flags and the language - lang = (fmap fromEnum language, - map fromEnum $ EnumSet.toList extensionFlags) + lang = fmap IfaceLanguage language + exts = map IfaceExtension $ EnumSet.toList extensionFlags -- avoid fingerprinting the absolute path to the directory of the source file -- see Note [Implicit include paths] includePathsMinusImplicit = includePaths { includePathsQuoteImplicit = [] } -- -I, -D and -U flags affect Haskell C/CPP Preprocessor - cpp = ( map normalise $ flattenIncludes includePathsMinusImplicit - -- normalise: eliminate spurious differences due to "./foo" vs "foo" - , picPOpts dflags - , opt_P_signature dflags) + cpp = IfaceCppOptions + { ifaceCppIncludes = map normalise $ flattenIncludes includePathsMinusImplicit + -- normalise: eliminate spurious differences due to "./foo" vs "foo" + , ifaceCppOpts = picPOpts dflags + , ifaceCppSig = opt_P_signature dflags + } -- See Note [Repeated -optP hashing] + -- -I, -D and -U flags affect JavaScript C/CPP Preprocessor - js = ( map normalise $ flattenIncludes includePathsMinusImplicit + js = IfaceCppOptions + { ifaceCppIncludes = map normalise $ flattenIncludes includePathsMinusImplicit -- normalise: eliminate spurious differences due to "./foo" vs "foo" - , picPOpts dflags - , opt_JSP_signature dflags) + , ifaceCppOpts = picPOpts dflags + , ifaceCppSig = opt_JSP_signature dflags + } -- See Note [Repeated -optP hashing] -- -I, -D and -U flags affect C-- CPP Preprocessor - cmm = ( map normalise $ flattenIncludes includePathsMinusImplicit + cmm = IfaceCppOptions { + ifaceCppIncludes = map normalise $ flattenIncludes includePathsMinusImplicit -- normalise: eliminate spurious differences due to "./foo" vs "foo" - , picPOpts dflags - , opt_CmmP_signature dflags) + , ifaceCppOpts = picPOpts dflags + , ifaceCppSig = ([], opt_CmmP_signature dflags) + } -- Note [path flags and recompilation] paths = [ hcSuf ] -- -fprof-auto etc. - prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0 + prof = if sccProfilingEnabled dflags then Just (IfaceProfAuto profAuto) else Nothing -- Ticky ticky = - map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] + mapMaybe (\f -> (if f `gopt` dflags then Just (IfaceGeneralFlag f) else Nothing)) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] -- Other flags which affect code generation - codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + codegen = mapMaybe (\f -> (if f `gopt` dflags then Just (IfaceGeneralFlag f) else Nothing)) (EnumSet.toList codeGenFlags) -- Did we include core for all bindings? fat_iface = gopt Opt_WriteIfSimplifiedCore dflags - flags = ((mainis, safeHs, lang, cpp, js, cmm), (paths, prof, ticky, codegen, debugLevel, callerCcFilters, fat_iface)) + f = IfaceDynFlags mainis safeHs lang exts cpp js cmm paths prof ticky codegen fat_iface debugLevel callerCcFilters - in -- pprTrace "flags" (ppr flags) $ - computeFingerprint nameio flags + in (computeFingerprint nameio f, f) -- Fingerprint the optimisation info. We keep this separate from the rest of -- the flags because GHCi users (especially) may wish to ignore changes in @@ -98,7 +107,7 @@ -- See Note [Ignoring some flag changes] fingerprintOptFlags :: DynFlags -> (WriteBinHandle -> Name -> IO ()) - -> IO Fingerprint + -> Fingerprint fingerprintOptFlags DynFlags{..} nameio = let -- See https://gitlab.haskell.org/ghc/ghc/issues/10923 @@ -116,7 +125,7 @@ -- See Note [Ignoring some flag changes] fingerprintHpcFlags :: DynFlags -> (WriteBinHandle -> Name -> IO ()) - -> IO Fingerprint + -> Fingerprint fingerprintHpcFlags dflags@DynFlags{..} nameio = let -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798 diff --git a/GHC/Iface/Recomp/Types.hs b/GHC/Iface/Recomp/Types.hs new file mode 100644 --- /dev/null +++ b/GHC/Iface/Recomp/Types.hs @@ -0,0 +1,156 @@ +module GHC.Iface.Recomp.Types ( + IfaceSelfRecomp(..), + IfaceDynFlags(..), + pprIfaceDynFlags, + missingExtraFlagInfo, +) where + +import GHC.Prelude +import GHC.Fingerprint +import GHC.Utils.Outputable +import GHC.Iface.Flags +import GHC.Types.SafeHaskell +import GHC.Unit.Module.Deps +import GHC.Unit.Module + +import GHC.Utils.Binary + +import Control.DeepSeq + +{- +Note [Self recompilation information in interface files] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The flag -fwrite-if-self-recomp controls whether +interface files contain the information necessary to answer the +question: + + Is the interface file up-to-date, relative to: + * the source file it corresponds to, + * the flags passed to the GHC invocation to compile it, + * its dependencies (e.g. imported items, watched files added by addDependentFile, ...) + +If there is no self-recompilation information stored, then we always re-generate +the interface file from scratch. + +Why? Most packages are only built once either by a distribution or cabal +and then placed into an immutable store, after which we will never ask +this question. Therefore we can derive two benefits from omitting this +information. + +* Primary motivation: It vastly reduces the surface area for creating + non-deterministic interface files. See issue #10424 which motivated a + proper fix to that issue. Distributions have long contained versions + of GHC which just have broken self-recompilation checking (in order to + get deterministic interface files). + +* Secondary motivation: This reduces the size of interface files + slightly.. the `mi_usages` field can be quite big but probably this + isn't such a great benefit. + +* Third motivation: Conceptually clarity about which parts of an + interface file are used in order to **communicate** with subsequent + packages about the **interface** for a module. And which parts are + used to self-communicate during recompilation checking. + +The main tracking issue is #22188 but fixes issues such as #10424 in a +proper way. + +-} + +-- | The information for a module which is only used when deciding whether to recompile +-- itself. +-- +-- See Note [Self recompilation information in interface files] +data IfaceSelfRecomp = + IfaceSelfRecomp { mi_sr_src_hash :: !Fingerprint + -- ^ Hash of the .hs source, used for recompilation checking. + , mi_sr_usages :: [Usage] + -- ^ Usages; kept sorted so that it's easy to decide + -- whether to write a new iface file (changing usages + -- doesn't affect the hash of this module) + -- NOT STRICT! we read this field lazily from the interface file + -- It is *only* consulted by the recompilation checker + + , mi_sr_flag_hash :: !(FingerprintWithValue IfaceDynFlags) + -- ^ Hash of the important flags used when compiling the module, excluding + -- optimisation flags + , mi_sr_opt_hash :: !Fingerprint + -- ^ Hash of optimisation flags + , mi_sr_hpc_hash :: !Fingerprint + -- ^ Hash of hpc flags + , mi_sr_plugin_hash :: !Fingerprint + -- ^ Hash of plugins + } + + +instance Binary IfaceSelfRecomp where + put_ bh (IfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages, mi_sr_flag_hash, mi_sr_opt_hash, mi_sr_hpc_hash, mi_sr_plugin_hash}) = do + put_ bh mi_sr_src_hash + lazyPut bh mi_sr_usages + put_ bh mi_sr_flag_hash + put_ bh mi_sr_opt_hash + put_ bh mi_sr_hpc_hash + put_ bh mi_sr_plugin_hash + + get bh = do + src_hash <- get bh + usages <- lazyGet bh + flag_hash <- get bh + opt_hash <- get bh + hpc_hash <- get bh + plugin_hash <- get bh + return $ IfaceSelfRecomp { mi_sr_src_hash = src_hash, mi_sr_usages = usages, mi_sr_flag_hash = flag_hash, mi_sr_opt_hash = opt_hash, mi_sr_hpc_hash = hpc_hash, mi_sr_plugin_hash = plugin_hash } + +instance Outputable IfaceSelfRecomp where + ppr (IfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages, mi_sr_flag_hash, mi_sr_opt_hash, mi_sr_hpc_hash, mi_sr_plugin_hash}) + = vcat [text "Self-Recomp" + , nest 2 (vcat [ text "src hash:" <+> ppr mi_sr_src_hash + , text "flags:" <+> pprFingerprintWithValue missingExtraFlagInfo (fmap pprIfaceDynFlags mi_sr_flag_hash) + , text "opt hash:" <+> ppr mi_sr_opt_hash + , text "hpc hash:" <+> ppr mi_sr_hpc_hash + , text "plugin hash:" <+> ppr mi_sr_plugin_hash + , text "usages:" <+> ppr (map pprUsage mi_sr_usages) + ])] + +instance NFData IfaceSelfRecomp where + rnf (IfaceSelfRecomp src_hash usages flag_hash opt_hash hpc_hash plugin_hash) + = rnf src_hash `seq` rnf usages `seq` rnf flag_hash `seq` rnf opt_hash `seq` rnf hpc_hash `seq` rnf plugin_hash `seq` () + +pprFingerprintWithValue :: SDoc -> FingerprintWithValue SDoc -> SDoc +pprFingerprintWithValue missingInfo (FingerprintWithValue fp mflags) + = vcat $ + [ text "fingerprint:" <+> (ppr fp) + ] + ++ case mflags of + Nothing -> [missingInfo] + Just doc -> [doc] + +pprUsage :: Usage -> SDoc +pprUsage UsagePackageModule{ usg_mod = mod, usg_mod_hash = hash, usg_safe = safe } + = pprUsageImport mod hash safe +pprUsage UsageHomeModule{ usg_unit_id = unit_id, usg_mod_name = mod_name + , usg_mod_hash = hash, usg_safe = safe + , usg_exports = exports, usg_entities = entities } + = pprUsageImport (mkModule unit_id mod_name) hash safe $$ + nest 2 ( + maybe empty (\v -> text "exports: " <> ppr v) exports $$ + vcat [ ppr n <+> ppr v | (n,v) <- entities ] + ) +pprUsage usage@UsageFile{} + = hsep [text "addDependentFile", + doubleQuotes (ftext (usg_file_path usage)), + ppr (usg_file_hash usage)] +pprUsage usage@UsageMergedRequirement{} + = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)] +pprUsage usage@UsageHomeModuleInterface{} + = hsep [text "implementation", ppr (usg_mod_name usage) + , ppr (usg_unit_id usage) + , ppr (usg_iface_hash usage)] + +pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc +pprUsageImport mod hash safe + = hsep [ text "import", pp_safe, ppr mod + , ppr hash ] + where + pp_safe | safe = text "safe" + | otherwise = text " -/ " diff --git a/GHC/Iface/Syntax.hs b/GHC/Iface/Syntax.hs --- a/GHC/Iface/Syntax.hs +++ b/GHC/Iface/Syntax.hs @@ -26,7 +26,8 @@ IfaceCompleteMatch(..), IfaceLFInfo(..), IfaceTopBndrInfo(..), IfaceImport(..), - ImpIfaceList(..), + ifImpModule, + ImpIfaceList(..), IfaceExport, -- * Binding names IfaceTopBndr, @@ -35,10 +36,8 @@ -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, - fromIfaceBooleanFormula, fromIfaceWarnings, fromIfaceWarningTxt, - -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, freeNamesIfConDecls, @@ -51,7 +50,10 @@ import GHC.Prelude +import GHC.Builtin.Names(mkUnboundName) import GHC.Data.FastString +import GHC.Data.BooleanFormula (pprBooleanFormula, isTrue) + import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey, constraintKindTyConKey ) import GHC.Types.Unique ( hasKey ) @@ -62,25 +64,26 @@ import GHC.Types.Cpr import GHC.Core.Class import GHC.Types.FieldLabel -import GHC.Types.Name.Set import GHC.Core.Coercion.Axiom ( BranchIndex ) import GHC.Types.Name +import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Types.CostCentre import GHC.Types.Literal +import GHC.Types.Avail import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic +import GHC.Types.Tickish import GHC.Unit.Module import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc import GHC.Types.SourceText -import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) -import GHC.Stg.InferTags.TagSig +import GHC.Stg.EnforceEpt.TagSig import GHC.Parser.Annotation (noLocA) import GHC.Hs.Extension ( GhcRn ) import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) @@ -92,12 +95,14 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, - seqList, zipWithEqual ) + zipWithEqual ) +import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..)) + import Control.Monad -import System.IO.Unsafe import Control.DeepSeq import Data.Proxy +import qualified Data.Set as Set infixl 3 &&& @@ -109,13 +114,53 @@ ************************************************************************ -} +type IfaceExport = AvailInfo + data IfaceImport = IfaceImport ImpDeclSpec ImpIfaceList data ImpIfaceList = ImpIfaceAll -- ^ no user import list - | ImpIfaceExplicit !IfGlobalRdrEnv - | ImpIfaceEverythingBut !NameSet + | ImpIfaceExplicit + { iil_avails :: !DetOrdAvails + , iil_non_explicit_parents :: ![Name] + } + | ImpIfaceEverythingBut ![Name] +-- | Extract the imported module from an IfaceImport +ifImpModule :: IfaceImport -> Module +ifImpModule (IfaceImport declSpec _) = is_mod declSpec + +instance Binary IfaceImport where + put_ bh (IfaceImport declSpec ifaceList) = do + put_ bh declSpec + put_ bh ifaceList + get bh = do + declSpec <- get bh + ifaceList <- get bh + return (IfaceImport declSpec ifaceList) + +instance Binary ImpIfaceList where + put_ bh ImpIfaceAll = putByte bh 0 + put_ bh (ImpIfaceExplicit env implicit_parents) = do + putByte bh 1 + put_ bh env + put_ bh implicit_parents + put_ bh (ImpIfaceEverythingBut ns) = do + putByte bh 2 + put_ @[Name] bh ns + get bh = do + tag <- getByte bh + case tag of + 0 -> return ImpIfaceAll + 1 -> do + env <- get bh + implicit_parents <- get bh + return $ ImpIfaceExplicit env implicit_parents + 2 -> do + ns <- get @[Name] bh + return $ ImpIfaceEverythingBut ns + _ -> fail $ "instance Binary ImpIfaceList: Invalid tag " ++ show tag + -- | A binding top-level 'Name' in an interface file (e.g. the name of an -- 'IfaceDecl'). type IfaceTopBndr = Name @@ -210,21 +255,24 @@ ifClassCtxt :: IfaceContext, -- Super classes ifATs :: [IfaceAT], -- Associated type families ifSigs :: [IfaceClassOp], -- Method signatures - ifMinDef :: IfaceBooleanFormula -- Minimal complete definition + ifMinDef :: IfaceBooleanFormula, -- Minimal complete definition + ifUnary :: Bool -- This is a unary class + -- NB: in principle ifUnary is redundant; it can be deduced from + -- the number and types of class ops. In practice, in interface + -- files those types are knot tied, and it's very easy to get a + -- black hole. Easiest thing: let the definition module decide if + -- it is a unary class, and communicate that through IfaceClassBody + -- See (UCM12) in Note [Unary class magic] in GHC.Core.TyCon } +-- See also 'BooleanFormula' data IfaceBooleanFormula = IfVar IfLclName | IfAnd [IfaceBooleanFormula] | IfOr [IfaceBooleanFormula] | IfParens IfaceBooleanFormula + deriving Eq -fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName -fromIfaceBooleanFormula = \case - IfVar nm -> Var nm - IfAnd ibfs -> And (map (noLocA . fromIfaceBooleanFormula) ibfs) - IfOr ibfs -> Or (map (noLocA . fromIfaceBooleanFormula) ibfs) - IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf) data IfaceTyConParent = IfNoParent @@ -293,7 +341,7 @@ -- So this guarantee holds for IfaceConDecl, but *not* for DataCon ifConExTCvs :: [IfaceBndr], -- Existential ty/covars - ifConUserTvBinders :: [IfaceForAllSpecBndr], + ifConUserTvBinders :: [IfaceForAllBndr], -- The tyvars, in the order the user wrote them -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the -- set of tyvars (*not* covars) of ifConExTCvs, unioned @@ -502,6 +550,14 @@ 4 -> pure IfLFUnlifted _ -> panic "Invalid byte" +instance NFData IfaceLFInfo where + rnf = \case + IfLFReEntrant arity -> rnf arity + IfLFThunk updatable mb_fun -> rnf updatable `seq` rnf mb_fun + IfLFCon con -> rnf con + IfLFUnknown fun_flag -> rnf fun_flag + IfLFUnlifted -> () + {- Note [Versioning of instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -553,9 +609,7 @@ ifSigs = sigs, ifATs = ats }}) - = -- (possibly) newtype coercion - co_occs ++ - -- data constructor (DataCon namespace) + = -- data constructor (DataCon namespace) -- data worker (Id namespace) -- no wrapper (class dictionaries never have a wrapper) [dc_occ, dcww_occ] ++ @@ -568,12 +622,8 @@ where cls_tc_occ = occName cls_tc_name n_ctxt = length sc_ctxt - n_sigs = length sigs - co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ] - | otherwise = [] dcww_occ = mkDataConWorkerOcc dc_occ dc_occ = mkClassDataConOcc cls_tc_occ - is_newtype = n_sigs + n_ctxt == 1 -- Sigh (keep this synced with buildClass) ifaceDeclImplicitBndrs _ = [] @@ -600,9 +650,7 @@ [ (occ, computeFingerprint' (hash,occ)) | occ <- ifaceDeclImplicitBndrs decl ] where - computeFingerprint' = - unsafeDupablePerformIO - . computeFingerprint (panic "ifaceDeclFingerprints") + computeFingerprint' = computeFingerprint (panic "ifaceDeclFingerprints") fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn fromIfaceWarnings = \case @@ -653,7 +701,7 @@ = IfaceHpcTick Module Int -- from HpcTick x | IfaceSCC CostCentre Bool Bool -- from ProfNote | IfaceSource RealSrcSpan FastString -- from SourceNote - | IfaceBreakpoint Int [IfaceExpr] Module -- from Breakpoint + | IfaceBreakpoint BreakpointId [IfaceExpr] -- from Breakpoint data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr -- Note: IfLclName, not IfaceBndr (and same with the case binder) @@ -914,15 +962,226 @@ constraintIfaceKind = IfaceTyConApp (IfaceTyCon constraintKindTyConName (mkIfaceTyConInfo NotPromoted IfaceNormalTyCon)) IA_Nil +{- Note [Print invisible binders in interface declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Starting from GHC 9.8 it is possible to write invisible @-binders +in type-level declarations. That feature introduced several challenges +in interface declaration pretty printing (e.g. using the :info command +inside GHCi) to overcome. + +Consider this example with a redundant type variable `a`: + + type Id :: forall a b. b -> b + type Id x = x + +GHC will create system binders for kinds there to meet typechecking +and compilation needs and that will turn that declaration into a less +straightforward form with multiple @-binders: + + type Id :: forall {k} (a :: k) b. b -> b + type Id @{k} @a @b x = x :: b + +This information isn't required for understanding in most cases, +so GHC will hide it unless -fprint-explicit-kinds flag is supplied by the user. +And here is what we get: + + type Id :: forall {k} (a :: k) b. b -> b + type Id x = x + +However, there are several cases involving user-written @-binders +when it is cruicial to show them to provide understanding of what's going on. +First of all it can plainly appear on the right-hand side: + + type T :: forall (a :: Type). Type + type T @x = Tuple2 x x + +Not only that, an invisible binder can be unused by itself, but have an +impact on invisible binder positioning, e.g.: + + type T :: forall (a :: Type) (b :: Type). Type + type T @x @y = Tuple2 y y + +Here `x` is unused, but it is required to display, as `y` corresponds +to `b` in the standalone kind signature. + +The last problem is related to non-generative type declarations (type +synonyms and type families) only. It is not possible to partially +apply them, hence it's important to understand what parts of a declaration's +kind are related to the declaration itself. Here is a simple example: + + type T1 :: forall k. k -> Maybe k + type T1 = Just + + type T2 :: forall k. k -> Maybe k + type T2 @k = Just + +Both these type synonyms have the same kind signature, but they aren't +the same! `T1` can be used in strictly more cases, for example, as +an argument for a higher-order type: + + type F :: (forall k. k -> Maybe k) -> Type + + type R1 = F T1 -- Yes! + type R2 = F T2 -- No, that will not compile :( + +User-written invisible binders and "system" binders introduced by GHC +are indistinguishable at this stage, hence we try to only print +semantically significant binders by default. + +An invisible binder is considered significant when it meets at least +one of the following two criteria: + - It visibly occurs in the declaration's body (See more about that below) + - It is followed by a significant binder, + so it affects positioning +For non-generative type declarations (type synonyms and type families), +there is one additional criterion: + - It is not followed by a visible binder, so it + affects the arity of a type declaration + +The overall solution consists of three functions: +- `iface_decl_non_generative` decides whether the current declaration is + generative or not + +- `iface_decl_mentioned_vars` gives a Set of variables that + visibly occur in the declaration's body + +- `suppressIfaceInvisibles` uses information provided + by the first two functions to actually filter out insignificant + @-binders + +Here is what we consider "visibly occurs" in general and for +each declaration type: + +- Variables that visibly occur in IfaceType are collected by the + `visibleTypeVarOccurencies` function. + +- Variables that visibly occur in IfaceAT are collected by `iface_at_mentioned_vars` + function. It accounts visible binders for associated data and type + families and for type families only, it counts invisible binders. + Associated types can't have definitions, so it's safe to drop all other + binders. + +- None of the type variables in IfaceData declared using GADT syntax doesn't are considered + as visibe occurrences. This is because each constructor has its own variables, e.g.: + + type D :: forall (a :: Type). Type + data D @a where + MkD :: D @b + -- This is shorthand for: + -- MkD :: forall b. D @b + +- For IfaceData declared using Haskell98 syntax, a variable is considered visible + if it visibly occurs in at least one argument's type in at least one constructor. + +- For IfaceSynonym, a variable is considered visible if it visibly occurs + in the RHS type. + +- For IfaceFamily, a variable is considered visible if i occurs inside + an injectivity annotation, e.g. + + type family F @a = r | r -> a + +- For IfaceClass, a variable is considered visible if it occurs at least + once inside a functional dependency annotation or in at least one method's + type signature, or if it visibly occurs in at least one associated type's + declaration (Visible occurrences in associated types are described above.) + +- IfacePatSyn, IfaceId and IfaceAxiom are irrelevant to this problem. +-} + +iface_decl_generative :: IfaceDecl -> Bool +iface_decl_generative IfaceSynonym{} = False +iface_decl_generative IfaceFamily{ifFamFlav = rhs} + | IfaceDataFamilyTyCon <- rhs = True + | otherwise = False +iface_decl_generative IfaceData{} = True +iface_decl_generative IfaceId{} = True +iface_decl_generative IfaceClass{} = True +iface_decl_generative IfaceAxiom{} = True +iface_decl_generative IfacePatSyn{} = True + +iface_at_mentioned_vars :: IfaceAT -> Set.Set IfLclName +iface_at_mentioned_vars (IfaceAT decl _) + = Set.fromList . map ifTyConBinderName . suppress_vars $ binders + where + -- ifBinders is not total, so we assume here that associated types + -- cannot be IfaceId, IfaceAxiom or IfacePatSyn + binders = case decl of + IfaceFamily {ifBinders} -> ifBinders + IfaceData{ifBinders} -> ifBinders + IfaceSynonym{ifBinders} -> ifBinders + IfaceClass{ifBinders} -> ifBinders + IfaceId{} -> panic "IfaceId shoudn't be an associated type!" + IfaceAxiom{} -> panic "IfaceAxiom shoudn't be an associated type!" + IfacePatSyn {} -> panic "IfacePatSyn shoudn't be an associated type!" + + suppress_arity = not (iface_decl_generative decl) + + suppress_vars binders = + suppressIfaceInvisibles + -- We need to count trailing invisible binders for type families + (MkPrintArityInvisibles suppress_arity) + -- But this setting will simply count all invisible binderss + (PrintExplicitKinds False) + -- ...and associated types can't have a RHS + mempty + binders binders + +-- See Note [Print invisible binders in interface declarations] +-- in particular, the parts about collecting visible occurrences +iface_decl_mentioned_vars :: IfaceDecl -> Set.Set IfLclName +iface_decl_mentioned_vars (IfaceData { ifCons = condecls, ifGadtSyntax = gadt }) + | gadt = mempty + -- Get visible occurrences in each constructor in each alternative + | otherwise = Set.unions (map mentioned_con_vars cons) + where + mentioned_con_vars = Set.unions . map (visibleTypeVarOccurencies . snd) . ifConArgTys + cons = visibleIfConDecls condecls + +iface_decl_mentioned_vars (IfaceClass { ifFDs = fds, ifBody = IfAbstractClass }) + = Set.unions (map fundep_names fds) + where + fundep_names fd = Set.fromList (fst fd) `Set.union` Set.fromList (snd fd) + +iface_decl_mentioned_vars + (IfaceClass { ifFDs = fds + , ifBody = IfConcreteClass { + ifATs = ats, + ifSigs = sigs + }}) + = Set.unions + [ Set.unions (map fundep_names fds) + , Set.unions (map iface_at_mentioned_vars ats) + , Set.unions (map (visibleTypeVarOccurencies . class_op_type) sigs) + ] + where + class_op_type (IfaceClassOp _bndr ty _default) = ty + + fundep_names fd = Set.fromList (fst fd) `Set.union` Set.fromList (snd fd) + +iface_decl_mentioned_vars (IfaceSynonym {ifSynRhs = poly_ty}) + = visibleTypeVarOccurencies poly_ty + +-- Consider a binder to be a visible occurrence if it occurs inside an injectivity annotation. +iface_decl_mentioned_vars (IfaceFamily { ifBinders = binders, ifResVar = res_var, ifFamInj = inj }) + | Just{} <- res_var + , Injective injectivity <- inj + = Set.fromList . map (ifTyConBinderName . snd) . filter fst $ zip injectivity binders + | otherwise = mempty + +iface_decl_mentioned_vars IfacePatSyn{} = mempty +iface_decl_mentioned_vars IfaceId{} = mempty +iface_decl_mentioned_vars IfaceAxiom{} = mempty + pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc -- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi -- See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr -pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, - ifCtxt = context, ifResKind = kind, - ifRoles = roles, ifCons = condecls, - ifParent = parent, - ifGadtSyntax = gadt, - ifBinders = binders }) +pprIfaceDecl ss decl@(IfaceData { ifName = tycon, ifCType = ctype, + ifCtxt = context, ifResKind = kind, + ifRoles = roles, ifCons = condecls, + ifParent = parent, + ifGadtSyntax = gadt, + ifBinders = binders }) | gadt = vcat [ pp_roles , pp_ki_sig @@ -948,8 +1207,10 @@ pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) + decl_head = pprIfaceDeclHead decl suppress_bndr_sig context ss tycon binders + pp_lhs = case parent of - IfNoParent -> pprIfaceDeclHead suppress_bndr_sig context ss tycon binders + IfNoParent -> decl_head IfDataInstance{} -> text "instance" <+> pp_data_inst_forall <+> pprIfaceTyConParent parent @@ -996,36 +1257,40 @@ pp_extra = vcat [pprCType ctype] -pprIfaceDecl ss (IfaceClass { ifName = clas - , ifRoles = roles - , ifFDs = fds - , ifBinders = binders - , ifBody = IfAbstractClass }) +pprIfaceDecl ss decl@(IfaceClass { ifName = clas + , ifRoles = roles + , ifFDs = fds + , ifBinders = binders + , ifBody = IfAbstractClass }) = vcat [ pprClassRoles ss clas binders roles , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind) - , text "class" <+> pprIfaceDeclHead suppress_bndr_sig [] ss clas binders <+> pprFundeps fds ] + , text "class" <+> decl_head <+> pprFundeps fds ] where + decl_head = pprIfaceDeclHead decl suppress_bndr_sig [] ss clas binders + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True -pprIfaceDecl ss (IfaceClass { ifName = clas - , ifRoles = roles - , ifFDs = fds - , ifBinders = binders - , ifBody = IfConcreteClass { - ifATs = ats, - ifSigs = sigs, - ifClassCtxt = context, - ifMinDef = minDef - }}) +pprIfaceDecl ss decl@(IfaceClass { ifName = clas + , ifRoles = roles + , ifFDs = fds + , ifBinders = binders + , ifBody = IfConcreteClass { + ifATs = ats, + ifSigs = sigs, + ifClassCtxt = context, + ifMinDef = minDef + }}) = vcat [ pprClassRoles ss clas binders roles , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind) - , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where + , text "class" <+> decl_head <+> pprFundeps fds <+> pp_where , nest 2 (vcat [ vcat asocs, vcat dsigs , ppShowAllSubs ss (pprMinDef $ fromIfaceBooleanFormula minDef)])] where pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where") + decl_head = pprIfaceDeclHead decl suppress_bndr_sig context ss clas binders + asocs = ppr_trim $ map maybeShowAssoc ats dsigs = ppr_trim $ map maybeShowSig sigs @@ -1039,29 +1304,38 @@ | showSub ss sg = Just $ pprIfaceClassOp ss sg | otherwise = Nothing - pprMinDef :: BooleanFormula IfLclName -> SDoc + pprMinDef :: BooleanFormula GhcRn -> SDoc pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions text "{-# MINIMAL" <+> pprBooleanFormula - (\_ def -> cparen (isLexSym def) (ppr def)) 0 (fmap ifLclNameFS minDef) <+> + (\_ def -> let fs = getOccFS def in cparen (isLexSym fs) (ppr fs)) 0 minDef <+> text "#-}" + fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula GhcRn + -- `mkUnboundName` here is fine because the Name generated is only used for pretty printing and nothing else. + fromIfaceBooleanFormula (IfVar nm ) = Var $ noLocA . mkUnboundName . mkVarOccFS . ifLclNameFS $ nm + fromIfaceBooleanFormula (IfAnd bfs ) = And $ map (noLocA . fromIfaceBooleanFormula) bfs + fromIfaceBooleanFormula (IfOr bfs ) = Or $ map (noLocA . fromIfaceBooleanFormula) bfs + fromIfaceBooleanFormula (IfParens bf) = Parens $ (noLocA . fromIfaceBooleanFormula) bf + + -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True -pprIfaceDecl ss (IfaceSynonym { ifName = tc - , ifBinders = binders - , ifSynRhs = mono_ty - , ifResKind = res_kind}) +pprIfaceDecl ss decl@(IfaceSynonym { ifName = tc + , ifBinders = binders + , ifSynRhs = poly_ty + , ifResKind = res_kind}) = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind) - , hang (text "type" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tc binders <+> equals) - 2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr_tau - , ppUnless (isIfaceLiftedTypeKind res_kind) (dcolon <+> ppr res_kind) ]) + , hang (text "type" <+> decl_head <+> equals) + 2 (sep [ pprIfaceForAll tvs, pprIfaceContextArr theta, ppr_tau ]) ] where - (tvs, theta, tau) = splitIfaceSigmaTy mono_ty + (tvs, theta, tau) = splitIfaceSigmaTy poly_ty name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tc) + decl_head = pprIfaceDeclHead decl suppress_bndr_sig [] ss tc binders + -- See Note [Printing type abbreviations] in GHC.Iface.Type ppr_tau | tc `hasKey` liftedTypeKindTyConKey || tc `hasKey` unrestrictedFunTyConKey || @@ -1072,20 +1346,18 @@ -- See Note [Suppressing binder signatures] in GHC.Iface.Type suppress_bndr_sig = SuppressBndrSig True -pprIfaceDecl ss (IfaceFamily { ifName = tycon - , ifFamFlav = rhs, ifBinders = binders - , ifResKind = res_kind - , ifResVar = res_var, ifFamInj = inj }) +pprIfaceDecl ss decl@(IfaceFamily { ifName = tycon + , ifFamFlav = rhs, ifBinders = binders + , ifResKind = res_kind + , ifResVar = res_var, ifFamInj = inj }) | IfaceDataFamilyTyCon <- rhs = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind) - , text "data family" <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders + , text "data family" <+> decl_head ] | otherwise = vcat [ pprStandaloneKindSig name_doc (mkIfaceTyConKind binders res_kind) - , hang (text "type family" - <+> pprIfaceDeclHead suppress_bndr_sig [] ss tycon binders - <+> pp_inj res_var inj + , hang (text "type family" <+> decl_head <+> pp_inj res_var inj <+> ppShowRhs ss (pp_where rhs)) 2 (ppShowRhs ss (pp_rhs rhs)) $$ @@ -1094,6 +1366,8 @@ where name_doc = pprPrefixIfDeclBndr (ss_how_much ss) (occName tycon) + decl_head = pprIfaceDeclHead decl suppress_bndr_sig [] ss tycon binders + pp_where (IfaceClosedSynFamilyTyCon {}) = text "where" pp_where _ = empty @@ -1105,7 +1379,7 @@ pp_inj_cond res inj = case filterByList inj binders of [] -> empty - tvs -> hsep [vbar, ppr res, text "->", interppSP (map ifTyConBinderName tvs)] + tvs -> hsep [vbar, ppr res, arrow, interppSP (map ifTyConBinderName tvs)] pp_rhs IfaceDataFamilyTyCon = ppShowIface ss (text "data") @@ -1182,12 +1456,17 @@ -> [Role] -> SDoc pprRoles suppress_if tyCon bndrs roles = sdocOption sdocPrintExplicitKinds $ \print_kinds -> - let froles = suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs roles + let froles = + suppressIfaceInvisibles + (MkPrintArityInvisibles False) + (PrintExplicitKinds print_kinds) + mempty + bndrs roles in ppUnless (all suppress_if froles || null froles) $ text "type role" <+> tyCon <+> hsep (map ppr froles) pprStandaloneKindSig :: SDoc -> IfaceType -> SDoc -pprStandaloneKindSig tyCon ty = text "type" <+> tyCon <+> text "::" <+> ppr ty +pprStandaloneKindSig tyCon ty = text "type" <+> tyCon <+> dcolon <+> ppr ty pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name @@ -1239,16 +1518,25 @@ pprIfaceTyConParent (IfDataInstance _ tc tys) = pprIfaceTypeApp topPrec tc tys -pprIfaceDeclHead :: SuppressBndrSig +pprIfaceDeclHead :: IfaceDecl + -> SuppressBndrSig -> IfaceContext -> ShowSub -> Name -> [IfaceTyConBinder] -- of the tycon, for invisible-suppression -> SDoc -pprIfaceDeclHead suppress_sig context ss tc_occ bndrs +pprIfaceDeclHead decl suppress_sig context ss tc_occ bndrs = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sep [ pprIfaceContextArr context , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ) <+> pprIfaceTyConBinders suppress_sig - (suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs bndrs) ] + (suppressIfaceInvisibles + (MkPrintArityInvisibles print_arity) + (PrintExplicitKinds print_kinds) + mentioned_vars + bndrs bndrs) ] + where + -- See Note [Print invisible binders in interface declarations] + mentioned_vars = iface_decl_mentioned_vars decl + print_arity = not (iface_decl_generative decl) pprIfaceConDecl :: ShowSub -> Bool -> IfaceTopBndr @@ -1283,15 +1571,15 @@ -- the visibilities of the existential tyvar binders, we can simply drop -- the universal tyvar binders from user_tvbs. ex_tvbs = dropList tc_binders user_tvbs - ppr_ex_quant = pprIfaceForAllPartMust (ifaceForAllSpecToBndrs ex_tvbs) ctxt + ppr_ex_quant = pprIfaceForAllPartMust ex_tvbs ctxt pp_gadt_res_ty = mk_user_con_res_ty eq_spec - ppr_gadt_ty = pprIfaceForAllPart (ifaceForAllSpecToBndrs user_tvbs) ctxt pp_tau + ppr_gadt_ty = pprIfaceForAllPart user_tvbs ctxt pp_tau -- A bit gruesome this, but we can't form the full con_tau, and ppr it, -- because we don't have a Name for the tycon, only an OccName pp_tau | null fields = case pp_args ++ [pp_gadt_res_ty] of - (t:ts) -> fsep (t : zipWithEqual "pprIfaceConDecl" (\(w,_) d -> ppr_arr w <+> d) + (t:ts) -> fsep (t : zipWithEqual (\(w,_) d -> ppr_arr w <+> d) arg_tys ts) [] -> panic "pp_con_taus" | otherwise @@ -1306,9 +1594,9 @@ ppr_bang IfNoBang = whenPprDebug $ char '_' ppr_bang IfStrict = char '!' - ppr_bang IfUnpack = text "{-# UNPACK #-}" - ppr_bang (IfUnpackCo co) = text "! {-# UNPACK #-}" <> - pprParendIfaceCoercion co + ppr_bang IfUnpack = text "{-# UNPACK #-} !" + ppr_bang (IfUnpackCo co) = text "{-# UNPACK #-} !" <> + whenPprDebug (pprParendIfaceCoercion co) pprFieldArgTy, pprArgTy :: (IfaceBang, IfaceType) -> SDoc -- If using record syntax, the only reason one would need to parenthesize @@ -1562,7 +1850,7 @@ = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope) pprIfaceTickish (IfaceSource src _names) = braces (pprUserRealSpan True src) -pprIfaceTickish (IfaceBreakpoint m ix fvs) +pprIfaceTickish (IfaceBreakpoint (BreakpointId m ix) fvs) = braces (text "break" <+> ppr m <+> ppr ix <+> ppr fvs) ------------------ @@ -1912,7 +2200,7 @@ = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys freeNamesIfTickish :: IfaceTickish -> NameSet -freeNamesIfTickish (IfaceBreakpoint _ fvs _) = +freeNamesIfTickish (IfaceBreakpoint _ fvs) = fnList freeNamesIfExpr fvs freeNamesIfTickish _ = emptyNameSet @@ -2008,9 +2296,10 @@ ifFDs = a5, ifBody = IfConcreteClass { ifClassCtxt = a1, - ifATs = a6, - ifSigs = a7, - ifMinDef = a8 + ifATs = a6, + ifSigs = a7, + ifMinDef = a8, + ifUnary = a9 }}) = do putByte bh 5 put_ bh a1 @@ -2021,6 +2310,7 @@ put_ bh a6 put_ bh a7 put_ bh a8 + put_ bh a9 put_ bh (IfaceAxiom a1 a2 a3 a4) = do putByte bh 6 @@ -2094,6 +2384,7 @@ a6 <- get bh a7 <- get bh a8 <- get bh + a9 <- get bh return (IfaceClass { ifName = a2, ifRoles = a3, @@ -2101,9 +2392,10 @@ ifFDs = a5, ifBody = IfConcreteClass { ifClassCtxt = a1, - ifATs = a6, - ifSigs = a7, - ifMinDef = a8 + ifATs = a6, + ifSigs = a7, + ifMinDef = a8, + ifUnary = a9 }}) 6 -> do a1 <- getIfaceTopBndr bh a2 <- get bh @@ -2490,6 +2782,10 @@ return (UnfoldingCache { uf_is_value = hnf, uf_is_conlike = conlike , uf_is_work_free = wf, uf_expandable = exp }) +seqUnfoldingCache :: IfUnfoldingCache -> () +seqUnfoldingCache (UnfoldingCache hnf conlike wf exp) = + rnf hnf `seq` rnf conlike `seq` rnf wf `seq` rnf exp `seq` () + infixl 9 .<<|. (.<<|.) :: (Num a, Bits a) => a -> Bool -> a x .<<|. b = (if b then (`setBit` 0) else id) (x `shiftL` 1) @@ -2560,12 +2856,10 @@ putByte bh 13 put_ bh a put_ bh b - put_ bh (IfaceLitRubbish TypeLike r) = do + put_ bh (IfaceLitRubbish torc r) = do putByte bh 14 put_ bh r - put_ bh (IfaceLitRubbish ConstraintLike r) = do - putByte bh 15 - put_ bh r + put_ bh torc get bh = do h <- getByte bh case h of @@ -2609,9 +2903,8 @@ b <- get bh return (IfaceECase a b) 14 -> do r <- get bh - return (IfaceLitRubbish TypeLike r) - 15 -> do r <- get bh - return (IfaceLitRubbish ConstraintLike r) + torc <- get bh + return (IfaceLitRubbish torc r) _ -> panic ("get IfaceExpr " ++ show h) instance Binary IfaceTickish where @@ -2632,7 +2925,7 @@ put_ bh (srcSpanEndLine src) put_ bh (srcSpanEndCol src) put_ bh name - put_ bh (IfaceBreakpoint m ix fvs) = do + put_ bh (IfaceBreakpoint (BreakpointId m ix) fvs) = do putByte bh 3 put_ bh m put_ bh ix @@ -2660,7 +2953,7 @@ 3 -> do m <- get bh ix <- get bh fvs <- get bh - return (IfaceBreakpoint m ix fvs) + return (IfaceBreakpoint (BreakpointId m ix) fvs) _ -> panic ("get IfaceTickish " ++ show h) instance Binary IfaceConAlt where @@ -2762,7 +3055,7 @@ instance NFData ImpIfaceList where rnf ImpIfaceAll = () rnf (ImpIfaceEverythingBut ns) = rnf ns - rnf (ImpIfaceExplicit gre) = rnf gre + rnf (ImpIfaceExplicit gre explicit) = rnf gre `seq` rnf explicit instance NFData IfaceDecl where rnf = \case @@ -2770,36 +3063,36 @@ rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 IfaceData f1 f2 f3 f4 f5 f6 f7 f8 f9 -> - f1 `seq` seqList f2 `seq` f3 `seq` f4 `seq` f5 `seq` + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` rnf f9 IfaceSynonym f1 f2 f3 f4 f5 -> - rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5 + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 IfaceFamily f1 f2 f3 f4 f5 f6 -> - rnf f1 `seq` rnf f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5 `seq` f6 `seq` () + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` () IfaceClass f1 f2 f3 f4 f5 -> - rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5 + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 IfaceAxiom nm tycon role ax -> rnf nm `seq` rnf tycon `seq` - role `seq` + rnf role `seq` rnf ax IfacePatSyn f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 -> - rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` f6 `seq` - rnf f7 `seq` rnf f8 `seq` rnf f9 `seq` rnf f10 `seq` f11 `seq` () + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` + rnf f7 `seq` rnf f8 `seq` rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` () instance NFData IfaceAxBranch where rnf (IfaceAxBranch f1 f2 f3 f4 f5 f6 f7) = - rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq` rnf f7 + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 instance NFData IfaceClassBody where rnf = \case IfAbstractClass -> () - IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` () + IfConcreteClass f1 f2 f3 f4 f5 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` () instance NFData IfaceBooleanFormula where rnf = \case @@ -2812,7 +3105,7 @@ rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2 instance NFData IfaceClassOp where - rnf (IfaceClassOp f1 f2 f3) = rnf f1 `seq` rnf f2 `seq` f3 `seq` () + rnf (IfaceClassOp f1 f2 f3) = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` () instance NFData IfaceTyConParent where rnf = \case @@ -2827,19 +3120,22 @@ instance NFData IfaceConDecl where rnf (IfCon f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11) = - rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq` - rnf f7 `seq` rnf f8 `seq` f9 `seq` rnf f10 `seq` rnf f11 + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` + rnf f7 `seq` rnf f8 `seq` rnf f9 `seq` rnf f10 `seq` rnf f11 instance NFData IfaceSrcBang where - rnf (IfSrcBang f1 f2) = f1 `seq` f2 `seq` () + rnf (IfSrcBang f1 f2) = rnf f1 `seq` rnf f2 `seq` () instance NFData IfaceBang where - rnf x = x `seq` () + rnf IfNoBang = () + rnf IfStrict = () + rnf IfUnpack = () + rnf (IfUnpackCo co) = rnf co instance NFData IfaceIdDetails where rnf = \case IfVanillaId -> () - IfWorkerLikeId dmds -> dmds `seqList` () + IfWorkerLikeId dmds -> rnf dmds `seq` () IfRecSelId (Left tycon) b c d -> rnf tycon `seq` rnf b `seq` rnf c `seq` rnf d IfRecSelId (Right decl) b c d -> rnf decl `seq` rnf b `seq` rnf c `seq` rnf d IfDFunId -> () @@ -2848,23 +3144,22 @@ rnf = \case HsArity a -> rnf a HsDmdSig str -> seqDmdSig str - HsInline p -> p `seq` () -- TODO: seq further? + HsInline p -> rnf p `seq` () HsUnfold b unf -> rnf b `seq` rnf unf HsNoCafRefs -> () - HsCprSig cpr -> cpr `seq` () - HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further? - HsTagSig sig -> sig `seq` () + HsCprSig cpr -> seqCprSig cpr `seq` () + HsLFInfo lf_info -> rnf lf_info `seq` () + HsTagSig sig -> seqTagSig sig `seq` () instance NFData IfGuidance where rnf = \case IfNoGuidance -> () - IfWhen a b c -> a `seq` b `seq` c `seq` () + IfWhen a b c -> rnf a `seq` rnf b `seq` rnf c `seq` () instance NFData IfaceUnfolding where rnf = \case - IfCoreUnfold src cache guidance expr -> src `seq` cache `seq` rnf guidance `seq` rnf expr + IfCoreUnfold src cache guidance expr -> rnf src `seq` seqUnfoldingCache cache `seq` rnf guidance `seq` rnf expr IfDFunUnfold bndrs exprs -> rnf bndrs `seq` rnf exprs - -- See Note [UnfoldingCache] in GHC.Core for why it suffices to merely `seq` on cache instance NFData IfaceExpr where rnf = \case @@ -2872,16 +3167,16 @@ IfaceExt nm -> rnf nm IfaceType ty -> rnf ty IfaceCo co -> rnf co - IfaceTuple sort exprs -> sort `seq` rnf exprs + IfaceTuple sort exprs -> rnf sort `seq` rnf exprs IfaceLam bndr expr -> rnf bndr `seq` rnf expr IfaceApp e1 e2 -> rnf e1 `seq` rnf e2 - IfaceCase e nm alts -> rnf e `seq` nm `seq` rnf alts + IfaceCase e nm alts -> rnf e `seq` rnf nm `seq` rnf alts IfaceECase e ty -> rnf e `seq` rnf ty IfaceLet bind e -> rnf bind `seq` rnf e IfaceCast e co -> rnf e `seq` rnf co - IfaceLit l -> l `seq` () -- FIXME - IfaceLitRubbish tc r -> tc `seq` rnf r `seq` () - IfaceFCall fc ty -> fc `seq` rnf ty + IfaceLit l -> rnf l `seq` () + IfaceLitRubbish tc r -> rnf tc `seq` rnf r `seq` () + IfaceFCall fc ty -> rnf fc `seq` rnf ty IfaceTick tick e -> rnf tick `seq` rnf e instance NFData IfaceAlt where @@ -2893,7 +3188,7 @@ IfaceRec binds -> rnf binds instance NFData IfaceTopBndrInfo where - rnf (IfGblTopBndr n) = n `seq` () + rnf (IfGblTopBndr n) = rnf n `seq` () rnf (IfLclTopBndr fs ty info dets) = rnf fs `seq` rnf ty `seq` rnf info `seq` rnf dets `seq` () instance NFData IfaceMaybeRhs where @@ -2915,22 +3210,22 @@ instance NFData IfaceTickish where rnf = \case IfaceHpcTick m i -> rnf m `seq` rnf i - IfaceSCC cc b1 b2 -> cc `seq` rnf b1 `seq` rnf b2 - IfaceSource src str -> src `seq` rnf str - IfaceBreakpoint m i fvs -> rnf m `seq` rnf i `seq` rnf fvs + IfaceSCC cc b1 b2 -> rnf cc `seq` rnf b1 `seq` rnf b2 + IfaceSource src str -> rnf src `seq` rnf str + IfaceBreakpoint i fvs -> rnf i `seq` rnf fvs instance NFData IfaceConAlt where rnf = \case IfaceDefaultAlt -> () IfaceDataAlt nm -> rnf nm - IfaceLitAlt lit -> lit `seq` () + IfaceLitAlt lit -> rnf lit `seq` () instance NFData IfaceCompleteMatch where rnf (IfaceCompleteMatch f1 mtc) = rnf f1 `seq` rnf mtc instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = - rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` f8 `seq` () + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` () instance NFData IfaceDefault where rnf (IfaceDefault f1 f2 f3) = @@ -2938,11 +3233,11 @@ instance NFData IfaceFamInst where rnf (IfaceFamInst f1 f2 f3 f4) = - rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` () + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` () instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5 f6) = - f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` rnf f6 + rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 instance NFData IfaceWarnings where rnf = \case @@ -2950,12 +3245,12 @@ IfWarnSome vs ds -> rnf vs `seq` rnf ds instance NFData IfaceWarningTxt where - rnf = \case - IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 - IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 instance NFData IfaceStringLiteral where - rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 instance NFData IfaceAnnotation where - rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () + rnf (IfaceAnnotation f1 f2) = rnf f1 `seq` rnf f2 `seq` () diff --git a/GHC/Iface/Tidy.hs b/GHC/Iface/Tidy.hs --- a/GHC/Iface/Tidy.hs +++ b/GHC/Iface/Tidy.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DeriveFunctor #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE NamedFieldPuns #-} {- @@ -51,16 +49,14 @@ import GHC.Core import GHC.Core.Unfold --- import GHC.Core.Unfold.Make import GHC.Core.FVs import GHC.Core.Tidy import GHC.Core.Seq ( seqBinds ) import GHC.Core.Opt.Arity ( exprArity, typeArity, exprBotStrictness_maybe ) import GHC.Core.InstEnv import GHC.Core.Type -import GHC.Core.DataCon import GHC.Core.TyCon -import GHC.Core.Class +import GHC.Core.TyCo.Tidy import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Iface.Tidy.StaticPtrTable @@ -77,10 +73,10 @@ import GHC.Types.Var.Set import GHC.Types.Var import GHC.Types.Id -import GHC.Types.Id.Make ( mkDictSelRhs ) import GHC.Types.Id.Info import GHC.Types.Demand ( isDeadEndAppSig, isNopSig, nopSig, isDeadEndSig ) import GHC.Types.Basic +import GHC.Types.TyThing( implicitTyConThings ) import GHC.Types.Name hiding (varName) import GHC.Types.Name.Set import GHC.Types.Name.Cache @@ -411,11 +407,8 @@ , mg_boot_exports = boot_exports }) = do - let implicit_binds = concatMap getImplicitBinds tcs - all_binds = implicit_binds ++ binds - - (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod all_binds imp_rules - let (trimmed_binds, trimmed_rules) = findExternalRules opts all_binds imp_rules unfold_env + (unfold_env, tidy_occ_env) <- chooseExternalIds opts mod tcs binds imp_rules + let (trimmed_binds, trimmed_rules) = findExternalRules opts binds imp_rules unfold_env (tidy_env, tidy_binds) <- tidyTopBinds unfold_env boot_exports tidy_occ_env trimmed_binds @@ -478,7 +471,10 @@ , cg_ccs = S.toList local_ccs , cg_foreign = all_foreign_stubs , cg_foreign_files = foreign_files - , cg_dep_pkgs = dep_direct_pkgs deps + -- TODO: Check whether we need to account for levels here. + -- It seems that this field just gets used to write a comment + -- in C codegen, so it's value doesn't affect an important result. + , cg_dep_pkgs = S.map snd (dep_direct_pkgs deps) , cg_modBreaks = modBreaks , cg_spt_entries = spt_entries } @@ -528,7 +524,6 @@ do_binder cs b = maybe cs (go cs) (get_unf b) - -- Unfoldings may have cost centres that in the original definion are -- optimized away, see #5889. get_unf = maybeUnfoldingTemplate . realIdUnfolding @@ -590,80 +585,8 @@ modest cost in interface file growth, which is limited to the bits reqd to describe those data constructors. -************************************************************************ -* * - Implicit bindings -* * -************************************************************************ - -Note [Injecting implicit bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We inject the implicit bindings right at the end, in GHC.Core.Tidy. -Some of these bindings, notably record selectors, are not -constructed in an optimised form. E.g. record selector for - data T = MkT { x :: {-# UNPACK #-} !Int } -Then the unfolding looks like - x = \t. case t of MkT x1 -> let x = I# x1 in x -This generates bad code unless it's first simplified a bit. That is -why GHC.Core.Unfold.mkImplicitUnfolding uses simpleOptExpr to do a bit of -optimisation first. (Only matters when the selector is used curried; -eg map x ys.) See #2070. - -[Oct 09: in fact, record selectors are no longer implicit Ids at all, -because we really do want to optimise them properly. They are treated -much like any other Id. But doing "light" optimisation on an implicit -Id still makes sense.] - -At one time I tried injecting the implicit bindings *early*, at the -beginning of SimplCore. But that gave rise to real difficulty, -because GlobalIds are supposed to have *fixed* IdInfo, but the -simplifier and other core-to-core passes mess with IdInfo all the -time. The straw that broke the camels back was when a class selector -got the wrong arity -- ie the simplifier gave it arity 2, whereas -importing modules were expecting it to have arity 1 (#2844). -It's much safer just to inject them right at the end, after tidying. - -Oh: two other reasons for injecting them late: - - - If implicit Ids are already in the bindings when we start tidying, - we'd have to be careful not to treat them as external Ids (in - the sense of chooseExternalIds); else the Ids mentioned in *their* - RHSs will be treated as external and you get an interface file - saying a18 = - but nothing referring to a18 (because the implicit Id is the - one that does, and implicit Ids don't appear in interface files). - - - More seriously, the tidied type-envt will include the implicit - Id replete with a18 in its unfolding; but we won't take account - of a18 when computing a fingerprint for the class; result chaos. - -There is one sort of implicit binding that is injected still later, -namely those for data constructor workers. Reason (I think): it's -really just a code generation trick.... binding itself makes no sense. -See Note [Data constructor workers] in "GHC.CoreToStg.Prep". -} -getImplicitBinds :: TyCon -> [CoreBind] -getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc - where - cls_binds = maybe [] getClassImplicitBinds (tyConClass_maybe tc) - -getTyConImplicitBinds :: TyCon -> [CoreBind] -getTyConImplicitBinds tc - | isDataTyCon tc = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc)) - | otherwise = [] - -- The 'otherwise' includes family TyCons of course, but also (less obviously) - -- * Newtypes: see Note [Compulsory newtype unfolding] in GHC.Types.Id.Make - -- * type data: we don't want any code for type-only stuff (#24620) - -getClassImplicitBinds :: Class -> [CoreBind] -getClassImplicitBinds cls - = [ NonRec op (mkDictSelRhs cls val_index) - | (op, val_index) <- classAllSelIds cls `zip` [0..] ] - -get_defn :: Id -> CoreBind -get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) - {- ************************************************************************ * * @@ -683,12 +606,13 @@ chooseExternalIds :: TidyOpts -> Module + -> [TyCon] -> [CoreBind] -> [CoreRule] -> IO (UnfoldEnv, TidyOccEnv) -- Step 1 from the notes above -chooseExternalIds opts mod binds imp_id_rules +chooseExternalIds opts mod tcs binds imp_id_rules = do { (unfold_env1,occ_env1) <- search init_work_list emptyVarEnv init_occ_env ; let internal_ids = filter (not . (`elemVarEnv` unfold_env1)) binders ; tidy_internal internal_ids unfold_env1 occ_env1 } @@ -719,17 +643,16 @@ binders = map fst $ flattenBinds binds binder_set = mkVarSet binders - avoids = [getOccName name | bndr <- binders, - let name = idName bndr, - isExternalName name ] + avoids = [ getOccName name | bndr <- binders, + let name = idName bndr, + isExternalName name ] + ++ [ getOccName thing | tc <- tcs + , thing <- implicitTyConThings tc ] -- In computing our "avoids" list, we must include -- all implicit Ids -- all things with global names (assigned once and for -- all by the renamer) -- since their names are "taken". - -- The type environment is a convenient source of such things. - -- In particular, the set of binders doesn't include - -- implicit Ids at this stage. -- We also make sure to avoid any exported binders. Consider -- f{-u1-} = 1 -- Local decl @@ -950,7 +873,7 @@ dffvExpr (Var v) = insert v dffvExpr (App e1 e2) = dffvExpr e1 >> dffvExpr e2 dffvExpr (Lam v e) = extendScope v (dffvExpr e) -dffvExpr (Tick (Breakpoint _ _ ids _) e) = mapM_ insert ids >> dffvExpr e +dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e dffvExpr (Tick _other e) = dffvExpr e dffvExpr (Cast e _) = dffvExpr e dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e) @@ -1310,7 +1233,9 @@ (bndr1, rhs1) where - Just (name',show_unfold) = lookupVarEnv unfold_env bndr + (name',show_unfold) = case lookupVarEnv unfold_env bndr of + Just stuff -> stuff + Nothing -> pprPanic "tidyTopPair" (ppr bndr) !cbv_bndr = tidyCbvInfoTop boot_exports bndr rhs bndr1 = mkGlobalId details name' ty' idinfo' details = idDetails cbv_bndr -- Preserve the IdDetails @@ -1362,7 +1287,7 @@ sig = dmdSigInfo idinfo final_sig | not (isNopSig sig) - = warnPprTrace (_bottom_hidden sig) "tidyTopIdInfo" (ppr name) sig + = warnPprTrace (bottom_hidden sig) "tidyTopIdInfo" (ppr name <+> ppr sig) sig -- No demand signature, so try a -- cheap-and-cheerful bottom analyser @@ -1378,7 +1303,7 @@ | otherwise = cpr - _bottom_hidden id_sig + bottom_hidden id_sig = case mb_bot_str of Nothing -> False Just (arity, _, _) -> not (isDeadEndAppSig id_sig arity) diff --git a/GHC/Iface/Type.hs b/GHC/Iface/Type.hs --- a/GHC/Iface/Type.hs +++ b/GHC/Iface/Type.hs @@ -44,6 +44,7 @@ SuppressBndrSig(..), UseBndrParens(..), PrintExplicitKinds(..), + PrintArityInvisibles(..), pprIfaceType, pprParendIfaceType, pprPrecIfaceType, pprIfaceContext, pprIfaceContextArr, pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders, @@ -56,6 +57,7 @@ isIfaceRhoType, suppressIfaceInvisibles, + visibleTypeVarOccurencies, stripIfaceInvisVars, stripInvisArgs, @@ -98,6 +100,9 @@ import Control.Arrow (first) import Control.DeepSeq import Control.Monad ((<$!>)) +import Data.List (dropWhileEnd) +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Set as Set {- ************************************************************************ @@ -609,9 +614,21 @@ = case splitIfaceReqForallTy ty of { (bndrs, rho) -> (bndr:bndrs, rho) } splitIfaceReqForallTy rho = ([], rho) -suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a] -suppressIfaceInvisibles (PrintExplicitKinds True) _tys xs = xs -suppressIfaceInvisibles (PrintExplicitKinds False) tys xs = suppress tys xs +newtype PrintArityInvisibles = MkPrintArityInvisibles Bool + +-- See Note [Print invisible binders in interface declarations] +-- for the definition of what binders are considered insignificant +suppressIfaceInvisibles :: PrintArityInvisibles + -> PrintExplicitKinds + -> Set.Set IfLclName + -> [IfaceTyConBinder] + -> [a] + -> [a] +suppressIfaceInvisibles _ (PrintExplicitKinds True) _ _tys xs = xs + +suppressIfaceInvisibles -- This case is semantically the same as the third case, but it should be way f + (MkPrintArityInvisibles False) (PrintExplicitKinds False) mentioned_vars tys xs + | Set.null mentioned_vars = suppress tys xs where suppress _ [] = [] suppress [] a = a @@ -619,6 +636,44 @@ | isInvisibleTyConBinder k = suppress ks xs | otherwise = x : suppress ks xs +suppressIfaceInvisibles + (MkPrintArityInvisibles arity_invisibles) + (PrintExplicitKinds False) mentioned_vars tys xs + = map snd (suppress (zip tys xs)) + where + -- Consider this example: + -- type T :: forall k1 k2. Type + -- type T @a @b = b + -- `@a` is not mentioned on the RHS. However, we can't just + -- drop it because implicit argument positioning matters. + -- + -- Hence just drop the end + only_mentioned_binders = dropWhileEnd (not . is_binder_mentioned) + + is_binder_mentioned (bndr, _) = ifTyConBinderName bndr `Set.member` mentioned_vars + + suppress_invisibles group = + applyWhen invis_group only_mentioned_binders bndrs + where + bndrs = NonEmpty.toList group + invis_group = is_invisible_bndr (NonEmpty.head group) + + suppress_invisible_groups [] = [] + suppress_invisible_groups [group] = + if arity_invisibles + then NonEmpty.toList group -- the last group affects arity + else suppress_invisibles group + suppress_invisible_groups (group : groups) + = suppress_invisibles group ++ suppress_invisible_groups groups + + suppress + = suppress_invisible_groups -- Filter out insignificant invisible binders + . NonEmpty.groupWith is_invisible_bndr -- Find chunks of @-binders + . filterOut is_inferred_bndr -- We don't want to display @{binders} + + is_inferred_bndr = isInferredTyConBinder . fst + is_invisible_bndr = isInvisibleTyConBinder . fst + stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder] stripIfaceInvisVars (PrintExplicitKinds True) tyvars = tyvars stripIfaceInvisVars (PrintExplicitKinds False) tyvars @@ -659,6 +714,29 @@ go_args IA_Nil = True go_args (IA_Arg arg _ args) = go arg && go_args args +visibleTypeVarOccurencies :: IfaceType -> Set.Set IfLclName +-- Returns True if the type contains this name. Doesn't count +-- invisible application +-- Just used to control pretty printing +visibleTypeVarOccurencies = go + where + (<>) = Set.union + + go (IfaceTyVar var) = Set.singleton var + go (IfaceFreeTyVar {}) = mempty + go (IfaceAppTy fun args) = go fun <> go_args args + go (IfaceFunTy _ w arg res) = go w <> go arg <> go res + go (IfaceForAllTy bndr ty) = go (ifaceBndrType $ binderVar bndr) <> go ty + go (IfaceTyConApp _ args) = go_args args + go (IfaceTupleTy _ _ args) = go_args args + go (IfaceLitTy _) = mempty + go (IfaceCastTy {}) = mempty -- Safe + go (IfaceCoercionTy {}) = mempty -- Safe + + go_args IA_Nil = mempty + go_args (IA_Arg arg Required args) = go arg <> go_args args + go_args (IA_Arg _arg _ args) = go_args args + {- Note [Substitution on IfaceType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Substitutions on IfaceType are done only during pretty-printing to @@ -1669,7 +1747,7 @@ , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) Required (IA_Arg ty Required IA_Nil) <- tys -> maybeParen ctxt_prec funPrec - $ char '?' <> ftext (getLexicalFastString n) <> text "::" <> ppr_ty topPrec ty + $ char '?' <> ftext (getLexicalFastString n) <> dcolon <> ppr_ty topPrec ty | IfaceTupleTyCon arity sort <- ifaceTyConSort info , not debug @@ -2499,18 +2577,23 @@ 0 -> return VanillaDM _ -> do { t <- get bh; return (GenericDM t) } +instance NFData (DefMethSpec IfaceType) where + rnf = \case + VanillaDM -> () + GenericDM t -> rnf t + instance NFData IfaceType where rnf = \case IfaceFreeTyVar f1 -> f1 `seq` () IfaceTyVar f1 -> rnf f1 IfaceLitTy f1 -> rnf f1 IfaceAppTy f1 f2 -> rnf f1 `seq` rnf f2 - IfaceFunTy f1 f2 f3 f4 -> f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 - IfaceForAllTy f1 f2 -> f1 `seq` rnf f2 + IfaceFunTy f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 + IfaceForAllTy f1 f2 -> rnf f1 `seq` rnf f2 IfaceTyConApp f1 f2 -> rnf f1 `seq` rnf f2 IfaceCastTy f1 f2 -> rnf f1 `seq` rnf f2 IfaceCoercionTy f1 -> rnf f1 - IfaceTupleTy f1 f2 f3 -> f1 `seq` f2 `seq` rnf f3 + IfaceTupleTy f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 instance NFData IfaceTyLit where rnf = \case @@ -2521,21 +2604,25 @@ instance NFData IfaceCoercion where rnf = \case IfaceReflCo f1 -> rnf f1 - IfaceGReflCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 - IfaceFunCo f1 f2 f3 f4 -> f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 - IfaceTyConAppCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 + IfaceGReflCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfaceFunCo f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 + IfaceTyConAppCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 IfaceAppCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceForAllCo f1 f2 f3 f4 f5 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 IfaceCoVarCo f1 -> rnf f1 IfaceAxiomCo f1 f2 -> rnf f1 `seq` rnf f2 - IfaceUnivCo f1 f2 f3 f4 deps -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf deps + IfaceUnivCo f1 f2 f3 f4 deps -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf deps IfaceSymCo f1 -> rnf f1 IfaceTransCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceSelCo f1 f2 -> rnf f1 `seq` rnf f2 - IfaceLRCo f1 f2 -> f1 `seq` rnf f2 + IfaceLRCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceInstCo f1 f2 -> rnf f1 `seq` rnf f2 IfaceKindCo f1 -> rnf f1 IfaceSubCo f1 -> rnf f1 + -- These are not deeply forced because they are not used in ModIface, + -- these constructors are for pretty-printing. + -- See Note [Free TyVars and CoVars in IfaceType] + -- See Note [Holes in IfaceCoercion] IfaceFreeCoVar f1 -> f1 `seq` () IfaceHoleCo f1 -> f1 `seq` () @@ -2546,15 +2633,17 @@ IfaceAR_B n i -> rnf n `seq` rnf i instance NFData IfaceMCoercion where - rnf x = seq x () + rnf IfaceMRefl = () + rnf (IfaceMCo c) = rnf c instance NFData IfaceOneShot where - rnf x = seq x () + rnf IfaceOneShot = () + rnf IfaceNoOneShot = () instance NFData IfaceTyConSort where rnf = \case IfaceNormalTyCon -> () - IfaceTupleTyCon arity sort -> rnf arity `seq` sort `seq` () + IfaceTupleTyCon arity sort -> rnf arity `seq` rnf sort `seq` () IfaceSumTyCon arity -> rnf arity IfaceEqualityTyCon -> () @@ -2562,7 +2651,7 @@ rnf (IfLclName lfs) = rnf lfs instance NFData IfaceTyConInfo where - rnf (IfaceTyConInfo f s) = f `seq` rnf s + rnf (IfaceTyConInfo f s) = rnf f `seq` rnf s instance NFData IfaceTyCon where rnf (IfaceTyCon nm info) = rnf nm `seq` rnf info @@ -2575,4 +2664,4 @@ instance NFData IfaceAppArgs where rnf = \case IA_Nil -> () - IA_Arg f1 f2 f3 -> rnf f1 `seq` f2 `seq` rnf f3 + IA_Arg f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 diff --git a/GHC/IfaceToCore.hs b/GHC/IfaceToCore.hs --- a/GHC/IfaceToCore.hs +++ b/GHC/IfaceToCore.hs @@ -13,6 +13,7 @@ {-# LANGUAGE RecursiveDo #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RecordWildCards #-} @@ -33,6 +34,7 @@ hydrateCgBreakInfo ) where + import GHC.Prelude import GHC.ByteCode.Types @@ -44,7 +46,6 @@ import GHC.Builtin.Types.Literals(typeNatCoAxiomRules) import GHC.Builtin.Types -import GHC.Iface.Decl (toIfaceBooleanFormula) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env @@ -74,18 +75,19 @@ import GHC.Core.Lint import GHC.Core.Make import GHC.Core.Class +import GHC.Core.Predicate( isUnaryClass ) import GHC.Core.TyCon import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Core.Ppr -import GHC.Unit.Env import GHC.Unit.External import GHC.Unit.Module import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModIface import GHC.Unit.Home.ModInfo +import qualified GHC.Unit.Home.Graph as HUG import GHC.Utils.Outputable import GHC.Utils.Misc @@ -104,6 +106,7 @@ import GHC.Types.Basic hiding ( SuccessFlag(..) ) import GHC.Types.CompleteMatch import GHC.Types.SrcLoc +import GHC.Types.Avail import GHC.Types.TypeEnv import GHC.Types.Unique.FM import GHC.Types.Unique.DSet ( mkUniqDSet ) @@ -114,9 +117,9 @@ import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Name -import GHC.Types.Name.Reader +import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv ) +import GHC.Types.DefaultEnv ( ClassDefaults(..), DefaultEnv, mkDefaultEnv, DefaultProvenance(..) ) import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -124,17 +127,23 @@ import GHC.Types.TyThing import GHC.Types.Error +import GHC.Parser.Annotation (noLocA) + +import GHC.Hs.Extension ( GhcRn ) + import GHC.Fingerprint -import qualified GHC.Data.BooleanFormula as BF import Control.Monad -import GHC.Parser.Annotation import GHC.Driver.Env.KnotVars import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable +import Data.List(nub) import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) import GHC.Iface.Errors.Types + +import Language.Haskell.Syntax.BooleanFormula (BooleanFormula) +import Language.Haskell.Syntax.BooleanFormula qualified as BF(BooleanFormula(..)) import Language.Haskell.Syntax.Extension (NoExtField (NoExtField)) {- @@ -295,14 +304,38 @@ plusNameEnv_C mergeIfaceClassOp (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ]) (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ]) + in d1 { ifBody = (ifBody d1) { ifSigs = ops, - ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2] + ifMinDef = mkOr [ bf1, bf2] } } `withRolesFrom` d2 -- It doesn't matter; we'll check for consistency later when -- we merge, see 'mergeSignatures' | otherwise = d1 `withRolesFrom` d2 + where + -- The reason we need to duplicate mkOr here, instead of + -- using BooleanFormula's mkOr and just doing the loop like: + -- `toIfaceBooleanFormula . mkOr . fromIfaceBooleanFormula` + -- is quite subtle. Say we have the following minimal pragma: + -- {-# MINIMAL f | g #-}. If we use fromIfaceBooleanFormula + -- first, we will end up doing + -- `nub [Var (mkUnboundName f), Var (mkUnboundName g)]`, + -- which might seem fine, but Name equallity is decided by + -- their Unique, which will be identical since mkUnboundName + -- just stuffs the mkUnboundKey unqiue into both. + -- So the result will be {-# MINIMAL f #-}, oopsie. + -- Duplication it is. + mkOr :: [IfaceBooleanFormula] -> IfaceBooleanFormula + mkOr = maybe (IfAnd []) (mkOr' . nub . concat) . mapM fromOr + where + -- See Note [Simplification of BooleanFormulas] + fromOr bf = case bf of + (IfOr xs) -> Just xs + (IfAnd []) -> Nothing + _ -> Just [bf] + mkOr' [x] = x + mkOr' xs = IfOr xs -- Note [Role merging] -- ~~~~~~~~~~~~~~~~~~~ @@ -351,7 +384,7 @@ = d1 { ifRoles = mergeRoles roles1 roles2 } | otherwise = d1 where - mergeRoles roles1 roles2 = zipWithEqual "mergeRoles" max roles1 roles2 + mergeRoles roles1 roles2 = zipWithEqual max roles1 roles2 isRepInjectiveIfaceDecl :: IfaceDecl -> Bool isRepInjectiveIfaceDecl IfaceData{ ifCons = IfDataTyCon{} } = True @@ -577,10 +610,11 @@ -- And that's fine, because if M's ModInfo is in the HPT, then -- it's been compiled once, and we don't need to check the boot iface then do { (_, hug) <- getEpsAndHug - ; case lookupHugByModule mod hug of + ; liftIO $ + HUG.lookupHugByModule mod hug >>= pure . \case Just info | mi_boot (hm_iface info) == IsBoot - -> return $ SelfBoot { sb_mds = hm_details info } - _ -> return NoSelfBoot } + -> SelfBoot { sb_mds = hm_details info } + _ -> NoSelfBoot } else do -- OK, so we're in one-shot mode. @@ -773,7 +807,7 @@ ifBody = IfAbstractClass}) = bindIfaceTyConBinders binders $ \ binders' -> do { fds <- mapM tc_fd rdr_fds - ; cls <- buildClass tc_name binders' roles fds Nothing + ; cls <- buildAbstractClass tc_name binders' roles fds ; return (ATyCon (classTyCon cls)) } tc_iface_decl _parent ignore_prags @@ -784,7 +818,7 @@ ifBody = IfConcreteClass { ifClassCtxt = rdr_ctxt, ifATs = rdr_ats, ifSigs = rdr_sigs, - ifMinDef = if_mindef + ifMinDef = if_mindef, ifUnary = unary }}) = bindIfaceTyConBinders binders $ \ binders' -> do { traceIf (text "tc-iface-class1" <+> ppr tc_name) @@ -793,12 +827,11 @@ ; sigs <- mapM tc_sig rdr_sigs ; fds <- mapM tc_fd rdr_fds ; traceIf (text "tc-iface-class3" <+> ppr tc_name) - ; let mindef_occ = fromIfaceBooleanFormula if_mindef - ; mindef <- traverse (lookupIfaceTop . mkVarOccFS . ifLclNameFS) mindef_occ + ; mindef <- tc_boolean_formula if_mindef ; cls <- fixM $ \ cls -> do { ats <- mapM (tc_at cls) rdr_ats ; traceIf (text "tc-iface-class4" <+> ppr tc_name) - ; buildClass tc_name binders' roles fds (Just (ctxt, ats, sigs, mindef)) } + ; buildClass tc_name binders' roles fds ctxt ats sigs mindef unary } ; return (ATyCon (classTyCon cls)) } where tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred) @@ -843,6 +876,12 @@ -- e.g. type AT a; type AT b = AT [b] #8002 return (ATI tc mb_def) + tc_boolean_formula :: IfaceBooleanFormula -> IfL (BooleanFormula GhcRn) + tc_boolean_formula (IfAnd ibfs ) = BF.And . map noLocA <$> traverse tc_boolean_formula ibfs + tc_boolean_formula (IfOr ibfs ) = BF.Or . map noLocA <$> traverse tc_boolean_formula ibfs + tc_boolean_formula (IfParens ibf) = BF.Parens . noLocA <$> tc_boolean_formula ibf + tc_boolean_formula (IfVar nm ) = BF.Var . noLocA <$> (lookupIfaceTop . mkVarOccFS . ifLclNameFS $ nm) + mk_sc_doc pred = text "Superclass" <+> ppr pred mk_at_doc tc = text "Associated type" <+> ppr tc mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty] @@ -1198,7 +1237,7 @@ ; return (HsUnpack (Just co)) } src_strict :: IfaceSrcBang -> HsSrcBang - src_strict (IfSrcBang unpk bang) = mkHsSrcBang NoSourceText unpk bang + src_strict (IfSrcBang unpk bang) = HsSrcBang NoSourceText unpk bang tcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec] tcIfaceEqSpec spec @@ -1295,7 +1334,7 @@ ; let warn = fmap fromIfaceWarningTxt iface_warn ; return ClassDefaults { cd_class = cls , cd_types = tys' - , cd_module = Just this_mod + , cd_provenance = DP_Imported this_mod , cd_warn = warn } } where tyThingConClass :: TyThing -> Class @@ -1694,9 +1733,9 @@ tcIfaceTickish (IfaceHpcTick modl ix) = return (HpcTick modl ix) tcIfaceTickish (IfaceSCC cc tick push) = return (ProfNote cc tick push) tcIfaceTickish (IfaceSource src name) = return (SourceNote src (LexicalFastString name)) -tcIfaceTickish (IfaceBreakpoint ix fvs modl) = do +tcIfaceTickish (IfaceBreakpoint bid fvs) = do fvs' <- mapM tcIfaceExpr fvs - return (Breakpoint NoExtField ix [f | Var f <- fvs'] modl) + return (Breakpoint NoExtField bid [f | Var f <- fvs']) ------------------------- tcIfaceLit :: Literal -> IfL Literal @@ -1747,10 +1786,9 @@ -} tcIdDetails :: Name -> Type -> IfaceIdDetails -> IfL IdDetails -tcIdDetails _ _ IfVanillaId = return VanillaId +tcIdDetails _ _ IfVanillaId = return VanillaId tcIdDetails _ _ (IfWorkerLikeId dmds) = return $ WorkerLikeId dmds -tcIdDetails _ ty IfDFunId - = return (DFunId (isNewTyCon (classTyCon cls))) +tcIdDetails _ ty IfDFunId = return (DFunId (isUnaryClass cls)) where (_, _, cls, _) = tcSplitDFunTy ty @@ -1758,14 +1796,13 @@ = do { tc' <- either (fmap RecSelData . tcIfaceTyCon) (fmap (RecSelPatSyn . tyThingPatSyn) . tcIfaceDecl False) tc - ; let all_cons = recSelParentCons tc' - cons_partitioned - = conLikesWithFields all_cons [flLabel fl] + ; let all_cons = recSelParentCons tc' + cons_partitioned = conLikesRecSelInfo all_cons [flLabel fl] ; return (RecSelId - { sel_tycon = tc' - , sel_naughty = naughty + { sel_tycon = tc' + , sel_naughty = naughty , sel_fieldLabel = fl { flSelector = nm } - , sel_cons = cons_partitioned } + , sel_cons = cons_partitioned } -- Reconstructed here since we don't want Uniques in the Iface file ) } where @@ -2251,9 +2288,10 @@ -- | This function is only used to construct the environment for GHCi, -- so we make up fake locations -tcIfaceImport :: HscEnv -> IfaceImport -> ImportUserSpec -tcIfaceImport _ (IfaceImport spec ImpIfaceAll) = ImpUserSpec spec ImpUserAll -tcIfaceImport _ (IfaceImport spec (ImpIfaceEverythingBut ns)) = ImpUserSpec spec (ImpUserEverythingBut ns) -tcIfaceImport hsc_env (IfaceImport spec (ImpIfaceExplicit gre)) = ImpUserSpec spec (ImpUserExplicit (hydrateGlobalRdrEnv get_GRE_info gre)) - where - get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm +tcIfaceImport :: IfaceImport -> ImportUserSpec +tcIfaceImport (IfaceImport spec ImpIfaceAll) + = ImpUserSpec spec ImpUserAll +tcIfaceImport (IfaceImport spec (ImpIfaceEverythingBut ns)) + = ImpUserSpec spec (ImpUserEverythingBut (mkNameSet ns)) +tcIfaceImport (IfaceImport spec (ImpIfaceExplicit gre implicit_parents)) + = ImpUserSpec spec (ImpUserExplicit (getDetOrdAvails gre) $ mkNameSet implicit_parents) diff --git a/GHC/JS/Make.hs b/GHC/JS/Make.hs --- a/GHC/JS/Make.hs +++ b/GHC/JS/Make.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -135,9 +134,6 @@ -- * Statement helpers , Solo(..) , decl -#if __GLASGOW_HASKELL__ < 905 - , pattern MkSolo -#endif ) where @@ -603,7 +599,7 @@ infixl 8 .! assignAllEqual :: HasDebugCallStack => [JStgExpr] -> [JStgExpr] -> JStgStat -assignAllEqual xs ys = mconcat (zipWithEqual "assignAllEqual" (|=) xs ys) +assignAllEqual xs ys = mconcat (zipWithEqual (|=) xs ys) assignAll :: [JStgExpr] -> [JStgExpr] -> JStgStat assignAll xs ys = mconcat (zipWith (|=) xs ys) @@ -714,12 +710,6 @@ fromRational x = ValExpr (JDouble (realToFrac x)) --- The Solo constructor was renamed to MkSolo in ghc 9.5 -#if __GLASGOW_HASKELL__ < 905 -pattern MkSolo :: a -> Solo a -pattern MkSolo a = Solo a -{-# COMPLETE MkSolo #-} -#endif -------------------------------------------------------------------------------- -- New Identifiers diff --git a/GHC/JS/Opt/Expr.hs b/GHC/JS/Opt/Expr.hs --- a/GHC/JS/Opt/Expr.hs +++ b/GHC/JS/Opt/Expr.hs diff --git a/GHC/JS/Opt/Simple.hs b/GHC/JS/Opt/Simple.hs --- a/GHC/JS/Opt/Simple.hs +++ b/GHC/JS/Opt/Simple.hs diff --git a/GHC/JS/Ppr.hs b/GHC/JS/Ppr.hs --- a/GHC/JS/Ppr.hs +++ b/GHC/JS/Ppr.hs @@ -74,6 +74,7 @@ import Numeric(showHex) +import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Data.FastString import GHC.Types.Unique.Map @@ -170,7 +171,7 @@ SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases where l' = map (\(c,s) -> (text "case" <+?> parens (jsToDocR r c) <> colon) $$$ jnest (optBlock r s)) l ++ [(text "default:") $$$ jnest (optBlock r d)] - cases = foldl1 ($$$) l' + cases = foldl1 ($$$) $ expectNonEmpty l' ReturnStat e -> text "return" <+> jsToDocR r e ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i diff --git a/GHC/Linker/Config.hs b/GHC/Linker/Config.hs --- a/GHC/Linker/Config.hs +++ b/GHC/Linker/Config.hs @@ -22,6 +22,6 @@ , linkerOptionsPre :: [Option] -- ^ Linker options (before user options) , linkerOptionsPost :: [Option] -- ^ Linker options (after user options) , linkerTempDir :: TempDir -- ^ Temporary directory to use - , linkerFilter :: String -> String -- ^ Output filter + , linkerFilter :: [String] -> [String] -- ^ Output filter } diff --git a/GHC/Linker/Deps.hs b/GHC/Linker/Deps.hs --- a/GHC/Linker/Deps.hs +++ b/GHC/Linker/Deps.hs @@ -22,7 +22,6 @@ import GHC.Linker.Types -import GHC.Types.SourceFile import GHC.Types.SrcLoc import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM @@ -34,24 +33,17 @@ import GHC.Unit.Env import GHC.Unit.Finder import GHC.Unit.Module -import GHC.Unit.Module.ModIface import GHC.Unit.Module.WholeCoreBindings -import GHC.Unit.Module.Deps -import GHC.Unit.Module.Graph import GHC.Unit.Home.ModInfo import GHC.Iface.Errors.Types -import GHC.Iface.Errors.Ppr import GHC.Utils.Misc -import GHC.Unit.Home +import qualified GHC.Unit.Home.Graph as HUG import GHC.Data.Maybe -import Control.Monad import Control.Applicative -import qualified Data.Set as Set -import qualified Data.Map as M import Data.List (isSuffixOf) import System.FilePath @@ -60,8 +52,6 @@ data LinkDepsOpts = LinkDepsOpts { ldObjSuffix :: !String -- ^ Suffix of .o files , ldForceDyn :: !Bool -- ^ Always use .dyn_o? - , ldOneShotMode :: !Bool -- ^ Is the driver in one-shot mode? - , ldModuleGraph :: !ModuleGraph , ldUnitEnv :: !UnitEnv , ldPprOpts :: !SDocContext -- ^ Rendering options for error messages , ldUseByteCode :: !Bool -- ^ Use bytecode rather than objects @@ -69,8 +59,8 @@ , ldWays :: !Ways -- ^ Enabled ways , ldFinderCache :: !FinderCache , ldFinderOpts :: !FinderOpts - , ldLoadIface :: !(SDoc -> Module -> IO (MaybeErr MissingInterfaceError ModIface)) , ldLoadByteCode :: !(Module -> IO (Maybe Linkable)) + , ldGetDependencies :: !([Module] -> IO ([Module], UniqDSet UnitId)) } data LinkDeps = LinkDeps @@ -103,7 +93,6 @@ get_link_deps opts pls maybe_normal_osuf span mods - get_link_deps :: LinkDepsOpts -> LoaderState @@ -112,31 +101,25 @@ -> [Module] -> IO LinkDeps get_link_deps opts pls maybe_normal_osuf span mods = do - -- 1. Find the dependent home-pkg-modules/packages from each iface + + -- Three step process: + + -- 1. Find the dependent home-pkg-modules/packages from each iface -- (omitting modules from the interactive package, which is already linked) - (mods_s, pkgs_s) <- - -- Why two code paths here? There is a significant amount of repeated work - -- performed calculating transitive dependencies - -- if --make uses the oneShot code path (see MultiLayerModulesTH_* tests) - if ldOneShotMode opts - then follow_deps (filterOut isInteractiveModule mods) - emptyUniqDSet emptyUniqDSet; - else do - (pkgs, mmods) <- unzip <$> mapM get_mod_info all_home_mods - return (catMaybes mmods, unionManyUniqDSets (init_pkg_set : pkgs)) + (mods_s, pkgs_s) <- ldGetDependencies opts relevant_mods let -- 2. Exclude ones already linked -- Main reason: avoid findModule calls in get_linkable - (mods_needed, links_got) = partitionWith split_mods mods_s - pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls + (mods_needed, links_got) = partitionWith split_mods mods_s + pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls - split_mods mod = - let is_linked = lookupModuleEnv (objs_loaded pls) mod - <|> lookupModuleEnv (bcos_loaded pls) mod - in case is_linked of - Just linkable -> Right linkable - Nothing -> Left mod + split_mods mod = + let is_linked = lookupModuleEnv (objs_loaded pls) mod + <|> lookupModuleEnv (bcos_loaded pls) mod + in case is_linked of + Just linkable -> Right linkable + Nothing -> Left mod -- 3. For each dependent module, find its linkable -- This will either be in the HPT or (in the case of one-shot @@ -150,106 +133,8 @@ , ldNeededUnits = pkgs_s } where - mod_graph = ldModuleGraph opts - unit_env = ldUnitEnv opts - - -- This code is used in `--make` mode to calculate the home package and unit dependencies - -- for a set of modules. - -- - -- It is significantly more efficient to use the shared transitive dependency - -- calculation than to compute the transitive dependency set in the same manner as oneShot mode. - - -- It is also a matter of correctness to use the module graph so that dependencies between home units - -- is resolved correctly. - make_deps_loop :: (UniqDSet UnitId, Set.Set NodeKey) -> [ModNodeKeyWithUid] -> (UniqDSet UnitId, Set.Set NodeKey) - make_deps_loop found [] = found - make_deps_loop found@(found_units, found_mods) (nk:nexts) - | NodeKey_Module nk `Set.member` found_mods = make_deps_loop found nexts - | otherwise = - case M.lookup (NodeKey_Module nk) (mgTransDeps mod_graph) of - Just trans_deps -> - let deps = Set.insert (NodeKey_Module nk) trans_deps - -- See #936 and the ghci.prog007 test for why we have to continue traversing through - -- boot modules. - todo_boot_mods = [ModNodeKeyWithUid (GWIB mn NotBoot) uid | NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid) <- Set.toList trans_deps] - in make_deps_loop (found_units, deps `Set.union` found_mods) (todo_boot_mods ++ nexts) - Nothing -> - let (ModNodeKeyWithUid _ uid) = nk - in make_deps_loop (addOneToUniqDSet found_units uid, found_mods) nexts - - mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) - (init_pkg_set, all_deps) = make_deps_loop (emptyUniqDSet, Set.empty) $ map mkNk (filterOut isInteractiveModule mods) - - all_home_mods = [with_uid | NodeKey_Module with_uid <- Set.toList all_deps] - - get_mod_info (ModNodeKeyWithUid gwib uid) = - case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of - Just hmi -> - let iface = (hm_iface hmi) - mmod = case mi_hsc_src iface of - HsBootFile -> link_boot_mod_error (mi_module iface) - _ -> return $ Just (mi_module iface) - - in (mkUniqDSet $ Set.toList $ dep_direct_pkgs (mi_deps iface),) <$> mmod - Nothing -> throwProgramError opts $ - text "getLinkDeps: Home module not loaded" <+> ppr (gwib_mod gwib) <+> ppr uid - - - -- This code is used in one-shot mode to traverse downwards through the HPT - -- to find all link dependencies. - -- The ModIface contains the transitive closure of the module dependencies - -- within the current package, *except* for boot modules: if we encounter - -- a boot module, we have to find its real interface and discover the - -- dependencies of that. Hence we need to traverse the dependency - -- tree recursively. See bug #936, testcase ghci/prog007. - follow_deps :: [Module] -- modules to follow - -> UniqDSet Module -- accum. module dependencies - -> UniqDSet UnitId -- accum. package dependencies - -> IO ([Module], UniqDSet UnitId) -- result - follow_deps [] acc_mods acc_pkgs - = return (uniqDSetToList acc_mods, acc_pkgs) - follow_deps (mod:mods) acc_mods acc_pkgs - = do - mb_iface <- ldLoadIface opts msg mod - iface <- case mb_iface of - Failed err -> throwProgramError opts $ - missingInterfaceErrorDiagnostic (ldMsgOpts opts) err - Succeeded iface -> return iface - - when (mi_boot iface == IsBoot) $ link_boot_mod_error mod - - let - pkg = moduleUnit mod - deps = mi_deps iface - - pkg_deps = dep_direct_pkgs deps - (boot_deps, mod_deps) = flip partitionWith (Set.toList (dep_direct_mods deps)) $ - \case - (_, GWIB m IsBoot) -> Left m - (_, GWIB m NotBoot) -> Right m - - mod_deps' = case ue_homeUnit unit_env of - Nothing -> [] - Just home_unit -> filter (not . (`elementOfUniqDSet` acc_mods)) (map (mkHomeModule home_unit) $ (boot_deps ++ mod_deps)) - acc_mods' = case ue_homeUnit unit_env of - Nothing -> acc_mods - Just home_unit -> addListToUniqDSet acc_mods (mod : map (mkHomeModule home_unit) mod_deps) - acc_pkgs' = addListToUniqDSet acc_pkgs (Set.toList pkg_deps) - - case ue_homeUnit unit_env of - Just home_unit | isHomeUnit home_unit pkg -> follow_deps (mod_deps' ++ mods) - acc_mods' acc_pkgs' - _ -> follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toUnitId pkg)) - where - msg = text "need to link module" <+> ppr mod <+> - text "due to use of Template Haskell" - - - - link_boot_mod_error :: Module -> IO a - link_boot_mod_error mod = throwProgramError opts $ - text "module" <+> ppr mod <+> - text "cannot be linked; it is only available as a boot module" + unit_env = ldUnitEnv opts + relevant_mods = filterOut isInteractiveModule mods no_obj :: Outputable a => a -> IO b no_obj mod = dieWith opts span $ @@ -268,16 +153,16 @@ else homeModInfoObject hmi <|> homeModInfoByteCode hmi get_linkable osuf mod -- A home-package module - | Just mod_info <- lookupHugByModule mod (ue_home_unit_graph unit_env) - = adjust_linkable (expectJust "getLinkDeps" (homeModLinkable mod_info)) - | otherwise - = do -- It's not in the HPT because we are in one shot mode, - -- so use the Finder to get a ModLocation... - case ue_homeUnit unit_env of - Nothing -> no_obj mod - Just home_unit -> do - from_bc <- ldLoadByteCode opts mod - maybe (fallback_no_bytecode home_unit mod) pure from_bc + = HUG.lookupHugByModule mod (ue_home_unit_graph unit_env) >>= \case + Just mod_info -> adjust_linkable (expectJust (homeModLinkable mod_info)) + Nothing -> do + -- It's not in the HPT because we are in one shot mode, + -- so use the Finder to get a ModLocation... + case ue_homeUnit unit_env of + Nothing -> no_obj mod + Just home_unit -> do + from_bc <- ldLoadByteCode opts mod + maybe (fallback_no_bytecode home_unit mod) pure from_bc where fallback_no_bytecode home_unit mod = do @@ -319,6 +204,8 @@ CoreBindings WholeCoreBindings {wcb_module} -> pprPanic "Unhydrated core bindings" (ppr wcb_module) + + {- Note [Using Byte Code rather than Object Code for Template Haskell] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -341,7 +228,6 @@ The only other place where the flag is consulted is when enabling code generation with `-fno-code`, which does so to anticipate what decision we will make at the splice point about what we would prefer. - -} dieWith :: LinkDepsOpts -> SrcSpan -> SDoc -> IO a diff --git a/GHC/Linker/ExtraObj.hs b/GHC/Linker/ExtraObj.hs --- a/GHC/Linker/ExtraObj.hs +++ b/GHC/Linker/ExtraObj.hs @@ -159,7 +159,7 @@ else return [] where - unit_state = ue_units unit_env + unit_state = ue_homeUnitState unit_env platform = ue_platform unit_env link_opts info = hcat [ -- "link info" section (see Note [LinkInfo section]) diff --git a/GHC/Linker/Loader.hs b/GHC/Linker/Loader.hs --- a/GHC/Linker/Loader.hs +++ b/GHC/Linker/Loader.hs @@ -17,7 +17,6 @@ , showLoaderState , getLoaderState -- * Load & Unload - , loadExpr , loadDecls , loadPackages , loadModule @@ -29,6 +28,7 @@ , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -53,14 +53,17 @@ import GHC.Tc.Utils.Monad import GHC.Runtime.Interpreter +import GHCi.BreakArray import GHCi.RemoteTypes import GHC.Iface.Load -import GHCi.Message (LoadedDLL) +import GHCi.Message (ConInfoTable(..), LoadedDLL) +import GHC.ByteCode.Breakpoints import GHC.ByteCode.Linker import GHC.ByteCode.Asm import GHC.ByteCode.Types +import GHC.Stack.CCS import GHC.SysTools import GHC.Types.Basic @@ -77,8 +80,12 @@ import GHC.Utils.TmpFs import GHC.Unit.Env -import GHC.Unit.External (ExternalPackageState (EPS, eps_iface_bytecode)) +import GHC.Unit.Home.ModInfo +import GHC.Unit.External (ExternalPackageState (..)) import GHC.Unit.Module +import GHC.Unit.Module.ModNodeKey +import GHC.Unit.Module.Graph +import GHC.Unit.Module.ModIface import GHC.Unit.State as Packages import qualified GHC.Data.ShortText as ST @@ -92,12 +99,15 @@ -- Standard libraries import Control.Monad +import Data.Array +import Data.ByteString (ByteString) import qualified Data.Set as Set import Data.Char (isSpace) import qualified Data.Foldable as Foldable import Data.IORef import Data.List (intercalate, isPrefixOf, nub, partition) import Data.Maybe +import Data.Either import Control.Concurrent.MVar import qualified Control.Monad.Catch as MC import qualified Data.List.NonEmpty as NE @@ -112,6 +122,12 @@ #endif import GHC.Utils.Exception +import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) +import GHC.Driver.Downsweep +import qualified GHC.Runtime.Interpreter as GHCi +import qualified Data.IntMap.Strict as IM +import qualified Data.Map.Strict as M +import Foreign.Ptr (nullPtr) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -170,6 +186,10 @@ , bcos_loaded = emptyModuleEnv , objs_loaded = emptyModuleEnv , temp_sos = [] + , linked_breaks = LinkedBreaks + { breakarray_env = emptyModuleEnv + , ccs_env = emptyModuleEnv + } } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -210,12 +230,12 @@ case lookupNameEnv (closure_env (linker_env pls)) name of Just (_,aa) -> return (pls,(aa, links, pkgs)) Nothing -> assertPpr (isExternalName name) (ppr name) $ - do let sym_to_find = nameToCLabel name "closure" - m <- lookupClosure interp (unpackFS sym_to_find) + do let sym_to_find = IClosureSymbol name + m <- lookupClosure interp sym_to_find r <- case m of Just hvref -> mkFinalizedHValue interp hvref Nothing -> linkFail "GHC.Linker.Loader.loadName" - (unpackFS sym_to_find) + (ppr sym_to_find) return (pls,(r, links, pkgs)) loadDependencies @@ -589,60 +609,12 @@ , "Try using a dynamic library instead." ] - -{- ********************************************************************** - - Link a byte-code expression - - ********************************************************************* -} - --- | Load a single expression, /including/ first loading packages and --- modules that this expression depends on. --- --- Raises an IO exception ('ProgramError') if it can't find a compiled --- version of the dependents to load. --- -loadExpr :: Interp -> HscEnv -> SrcSpan -> UnlinkedBCO -> IO ForeignHValue -loadExpr interp hsc_env span root_ul_bco = do - -- Initialise the linker (if it's not been done already) - initLoaderState interp hsc_env - - -- Take lock for the actual work. - modifyLoaderState interp $ \pls0 -> do - -- Load the packages and modules required - (pls, ok, _, _) <- loadDependencies interp hsc_env pls0 span needed_mods - if failed ok - then throwGhcExceptionIO (ProgramError "") - else do - -- Load the expression itself - -- Load the necessary packages and linkables - let le = linker_env pls - bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)] - resolved <- linkBCO interp (pkgs_loaded pls) le bco_ix root_ul_bco - [root_hvref] <- createBCOs interp [resolved] - fhv <- mkFinalizedHValue interp root_hvref - return (pls, fhv) - where - free_names = uniqDSetToList (bcoFreeNames root_ul_bco) - - needed_mods :: [Module] - needed_mods = [ nameModule n | n <- free_names, - isExternalName n, -- Names from other modules - not (isWiredInName n) -- Exclude wired-in names - ] -- (see note below) - -- Exclude wired-in names because we may not have read - -- their interface files, so getLinkDeps will fail - -- All wired-in names are in the base package, which we link - -- by default, so we can safely ignore them here. - initLinkDepsOpts :: HscEnv -> LinkDepsOpts initLinkDepsOpts hsc_env = opts where opts = LinkDepsOpts { ldObjSuffix = objectSuf dflags , ldForceDyn = sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags - , ldOneShotMode = isOneShot (ghcMode dflags) - , ldModuleGraph = hsc_mod_graph hsc_env , ldUnitEnv = hsc_unit_env hsc_env , ldPprOpts = initSDocContext dflags defaultUserStyle , ldFinderCache = hsc_FC hsc_env @@ -650,19 +622,60 @@ , ldUseByteCode = gopt Opt_UseBytecodeRatherThanObjects dflags , ldMsgOpts = initIfaceMessageOpts dflags , ldWays = ways dflags - , ldLoadIface + , ldGetDependencies = get_reachable_nodes hsc_env , ldLoadByteCode } dflags = hsc_dflags hsc_env - ldLoadIface msg mod = initIfaceCheck (text "loader") hsc_env - $ loadInterface msg mod (ImportByUser NotBoot) ldLoadByteCode mod = do + _ <- initIfaceLoad hsc_env $ + loadInterface (text "get_reachable_nodes" <+> parens (ppr mod)) + mod ImportBySystem EPS {eps_iface_bytecode} <- hscEPS hsc_env sequence (lookupModuleEnv eps_iface_bytecode mod) +get_reachable_nodes :: HscEnv -> [Module] -> IO ([Module], UniqDSet UnitId) +get_reachable_nodes hsc_env mods + -- Fallback case if the ModuleGraph has not been initialised by the user. + -- This can happen if is the user is loading plugins or doing something else very + -- early in the compiler pipeline. + | isEmptyMG (hsc_mod_graph hsc_env) + = do + mg <- downsweepInstalledModules hsc_env mods + go mg + + | otherwise + = go (hsc_mod_graph hsc_env) + + where + unit_env = hsc_unit_env hsc_env + mkModuleNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m) + + hmgModKey mg m + | let k = NodeKey_Module (mkModuleNk m) + , mgMember mg k = k + | otherwise = NodeKey_ExternalUnit (moduleUnitId m) + + -- The main driver for getting dependencies, which calls the given + -- functions to compute the reachable nodes. + go :: ModuleGraph -> IO ([Module], UniqDSet UnitId) + go mg = do + let mod_keys = map (hmgModKey mg) mods + all_reachable = mod_keys ++ map mkNodeKey (mgReachableLoop mg mod_keys) + (mods_s, pkgs_s) <- partitionEithers <$> mapMaybeM get_mod_info all_reachable + return (mods_s, mkUniqDSet pkgs_s) + + get_mod_info :: NodeKey -> IO (Maybe (Either Module UnitId)) + get_mod_info (NodeKey_Module m@(ModNodeKeyWithUid gwib uid)) = + lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) >>= \case + Just hmi -> return $ Just (Left (mi_module (hm_iface hmi))) + Nothing -> return (Just (Left (mnkToModule m))) + get_mod_info (NodeKey_ExternalUnit uid) = return (Just (Right uid)) + get_mod_info _ = return Nothing + + {- ********************************************************************** Loading a Decls statement @@ -687,14 +700,22 @@ else do -- Link the expression itself let le = linker_env pls - le2 = le { itbl_env = foldl' (\acc cbc -> plusNameEnv acc (bc_itbls cbc)) (itbl_env le) cbcs - , addr_env = foldl' (\acc cbc -> plusNameEnv acc (bc_strs cbc)) (addr_env le) cbcs } + let lb = linked_breaks pls + le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs) + le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs + le2_breakarray_env <- allocateBreakArrays interp (breakarray_env lb) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env lb) (catMaybes $ map bc_breaks cbcs) + let le2 = le { itbl_env = le2_itbl_env + , addr_env = le2_addr_env } + let lb2 = lb { breakarray_env = le2_breakarray_env + , ccs_env = le2_ccs_env } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs - !pls2 = pls { linker_env = le2 { closure_env = ce2 } } + !pls2 = pls { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -873,7 +894,7 @@ m <- loadDLL interp soFile case m of Right _ -> return $! pls { temp_sos = (libPath, libName) : temp_sos } - Left err -> linkFail msg err + Left err -> linkFail msg (text err) where msg = "GHC.Linker.Loader.dynLoadObjs: Loading temp shared object failed" @@ -910,11 +931,15 @@ le1 = linker_env pls - ie2 = foldr plusNameEnv (itbl_env le1) (map bc_itbls cbcs) - ae2 = foldr plusNameEnv (addr_env le1) (map bc_strs cbcs) - le2 = le1 { itbl_env = ie2, addr_env = ae2 } + lb1 = linked_breaks pls + ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs) + ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs + be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs) + let le2 = le1 { itbl_env = ie2, addr_env = ae2 } + let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 } - names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -925,19 +950,21 @@ new_binds <- makeForeignNamedHValueRefs interp to_add let ce2 = extendClosureEnv (closure_env le2) new_binds - return $! pls1 { linker_env = le2 { closure_env = ce2 } } + return $! pls1 { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> [CompiledByteCode] -> IO [(Name,HValueRef)] -- The returned HValueRefs are associated 1-1 with -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le lb mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (Foldable.toList bc_bcos : accum) @@ -947,7 +974,7 @@ let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le lb bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -957,6 +984,11 @@ makeForeignNamedHValueRefs interp bindings = mapM (\(n, hvref) -> (n,) <$> mkFinalizedHValue interp hvref) bindings +linkITbls :: Interp -> ItblEnv -> [(Name, ConInfoTable)] -> IO ItblEnv +linkITbls interp = foldlM $ \env (nm, itbl) -> do + r <- interpCmd interp $ MkConInfoTable itbl + evaluate $ extendNameEnv env nm (nm, ItblPtr r) + {- ********************************************************************** Unload some object modules @@ -1040,10 +1072,14 @@ keep_name n = isExternalName n && nameModule n `elemModuleEnv` remaining_bcos_loaded - !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, - bcos_loaded = remaining_bcos_loaded, - objs_loaded = remaining_objs_loaded } + keep_mod :: Module -> Bool + keep_mod m = m `elemModuleEnv` remaining_bcos_loaded + !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, + linked_breaks = filterLinkedBreaks keep_mod linked_breaks, + bcos_loaded = remaining_bcos_loaded, + objs_loaded = remaining_objs_loaded } + return new_pls where unloadObjs :: Linkable -> IO () @@ -1613,3 +1649,84 @@ maybePutStrLn :: Logger -> String -> IO () maybePutStrLn logger s = maybePutSDoc logger (text s <> text "\n") + +-- | see Note [Generating code for top-level string literal bindings] +allocateTopStrings :: + Interp -> [(Name, ByteString)] -> AddrEnv -> IO AddrEnv +allocateTopStrings interp topStrings prev_env = do + let (bndrs, strings) = unzip topStrings + ptrs <- interpCmd interp $ MallocStrings strings + evaluate $ extendNameEnvList prev_env (zipWith mk_entry bndrs ptrs) + where + mk_entry nm ptr = (nm, (nm, AddrPtr ptr)) + +-- | Given a list of 'InternalModBreaks' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. +allocateBreakArrays :: + Interp -> + ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> + IO (ModuleEnv (ForeignRef BreakArray)) +allocateBreakArrays interp = + foldlM + ( \be0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks {..}} -> do + -- If no BreakArray is assigned to this module yet, create one + if not $ elemModuleEnv modBreaks_module be0 then do + let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module breakArray + else + return be0 + ) + +-- | Given a list of 'InternalModBreaks' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. +-- +-- Note that the resulting arrays are indexed by 'BreakInfoIndex' (internal +-- breakpoint index), not by tick index +allocateCCS :: + Interp -> + ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> + IO (ModuleEnv (Array BreakInfoIndex (RemotePtr CostCentre))) +allocateCCS interp ce mbss + | interpreterProfiled interp = do + -- 1. Create a mapping from source BreakpointId to CostCentre ptr + ccss <- M.unions <$> mapM + ( \InternalModBreaks{imodBreaks_modBreaks=ModBreaks{..}} -> do + ccs <- {- one ccs ptr per tick index -} + mkCostCentres + interp + (moduleNameString $ moduleName modBreaks_module) + (elems modBreaks_ccs) + return $ M.fromList $ + zipWith (\el ix -> (BreakpointId modBreaks_module ix, el)) ccs [0..] + ) + mbss + -- 2. Create an array with one element for every InternalBreakpointId, + -- where every element has the CCS for the corresponding BreakpointId + foldlM + (\ce0 InternalModBreaks{imodBreaks_breakInfo, imodBreaks_modBreaks=ModBreaks{..}} -> do + if not $ elemModuleEnv modBreaks_module ce then do + let count = maybe 0 ((+1) . fst) $ IM.lookupMax imodBreaks_breakInfo + let ccs = IM.map + (\info -> + fromMaybe (toRemotePtr nullPtr) + (M.lookup (either internalBreakLoc id (cgb_tick_id info)) ccss) + ) + imodBreaks_breakInfo + assertPpr (count == length ccs) + (text "expected CgBreakInfo map to have one entry per valid ix") $ + evaluate $ + extendModuleEnv ce0 modBreaks_module $ + listArray + (0, count) + (IM.elems ccs) + else + return ce0 + ) + ce + mbss + + | otherwise = pure ce diff --git a/GHC/Linker/Static.hs b/GHC/Linker/Static.hs --- a/GHC/Linker/Static.hs +++ b/GHC/Linker/Static.hs @@ -71,7 +71,7 @@ linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO () linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do let platform = ue_platform unit_env - unit_state = ue_units unit_env + unit_state = ue_homeUnitState unit_env toolSettings' = toolSettings dflags verbFlags = getVerbFlags dflags arch_os = platformArchOS platform diff --git a/GHC/Linker/Types.hs b/GHC/Linker/Types.hs --- a/GHC/Linker/Types.hs +++ b/GHC/Linker/Types.hs @@ -18,6 +18,8 @@ , ClosureEnv , emptyClosureEnv , extendClosureEnv + , LinkedBreaks(..) + , filterLinkedBreaks , LinkableSet , mkLinkableSet , unionLinkableSet @@ -50,10 +52,12 @@ import GHC.Prelude import GHC.Unit ( UnitId, Module ) -import GHC.ByteCode.Types ( ItblEnv, AddrEnv, CompiledByteCode ) -import GHCi.RemoteTypes ( ForeignHValue, RemotePtr ) +import GHC.ByteCode.Types +import GHCi.BreakArray +import GHCi.RemoteTypes import GHCi.Message ( LoadedDLL ) +import GHC.Stack.CCS import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnvList, filterNameEnv ) import GHC.Types.Name ( Name ) import GHC.Types.SptEntry @@ -61,6 +65,7 @@ import GHC.Utils.Outputable import Control.Concurrent.MVar +import Data.Array import Data.Time ( UTCTime ) import GHC.Unit.Module.Env import GHC.Types.Unique.DSet @@ -156,6 +161,9 @@ , temp_sos :: ![(FilePath, String)] -- ^ We need to remember the name of previous temporary DLL/.so -- libraries so we can link them (see #10322) + + , linked_breaks :: !LinkedBreaks + -- ^ Mapping from loaded modules to their breakpoint arrays } uninitializedLoader :: IO Loader @@ -184,10 +192,10 @@ } filterLinkerEnv :: (Name -> Bool) -> LinkerEnv -> LinkerEnv -filterLinkerEnv f le = LinkerEnv - { closure_env = filterNameEnv (f . fst) (closure_env le) - , itbl_env = filterNameEnv (f . fst) (itbl_env le) - , addr_env = filterNameEnv (f . fst) (addr_env le) +filterLinkerEnv f (LinkerEnv closure_e itbl_e addr_e) = LinkerEnv + { closure_env = filterNameEnv (f . fst) closure_e + , itbl_env = filterNameEnv (f . fst) itbl_e + , addr_env = filterNameEnv (f . fst) addr_e } type ClosureEnv = NameEnv (Name, ForeignHValue) @@ -198,6 +206,29 @@ extendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv extendClosureEnv cl_env pairs = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs] + +-- | 'BreakArray's and CCSs are allocated per-module at link-time. +-- +-- Specifically, a module's 'BreakArray' is allocated either: +-- - When a BCO for that module is linked +-- - When :break is used on a given module *before* the BCO has been linked. +-- +-- We keep this structure in the 'LoaderState' +data LinkedBreaks + = LinkedBreaks + { breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) + -- ^ Each 'Module's remote pointer of 'BreakArray'. + + , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) + -- ^ Each 'Module's array of remote pointers of 'CostCentre'. + -- Untouched when not profiling. + } + +filterLinkedBreaks :: (Module -> Bool) -> LinkedBreaks -> LinkedBreaks +filterLinkedBreaks f (LinkedBreaks ba_e ccs_e) = LinkedBreaks + { breakarray_env = filterModuleEnv (\m _ -> f m) ba_e + , ccs_env = filterModuleEnv (\m _ -> f m) ccs_e + } type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo diff --git a/GHC/Parser.hs b/GHC/Parser.hs --- a/GHC/Parser.hs +++ b/GHC/Parser.hs @@ -9,13501 +9,13655 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} - --- | This module provides the generated Happy parser for Haskell. It exports --- a number of parsers which may be used in any library that uses the GHC API. --- A common usage pattern is to initialize the parser state with a given string --- and then parse that string: --- --- @ --- runParser :: ParserOpts -> String -> P a -> ParseResult a --- runParser opts str parser = unP parser parseState --- where --- filename = "\" --- location = mkRealSrcLoc (mkFastString filename) 1 1 --- buffer = stringToStringBuffer str --- parseState = initParserState opts buffer location --- @ -module GHC.Parser - ( parseModule, parseSignature, parseImport, parseStatement, parseBackpack - , parseDeclaration, parseExpression, parsePattern - , parseTypeSignature - , parseStmt, parseIdentifier - , parseType, parseHeader - , parseModuleNoHaddock - ) -where - --- base -import Control.Monad ( unless, liftM, when, (<=<) ) -import GHC.Exts -import Data.Maybe ( maybeToList ) -import Data.List.NonEmpty ( NonEmpty(..) ) -import qualified Data.List.NonEmpty as NE -import qualified Prelude -- for happy-generated code - -import GHC.Hs - -import GHC.Driver.Backpack.Syntax - -import GHC.Unit.Info -import GHC.Unit.Module -import GHC.Unit.Module.Warnings - -import GHC.Data.OrdList -import GHC.Data.BooleanFormula ( BooleanFormula(..), LBooleanFormula, mkTrue ) -import GHC.Data.FastString -import GHC.Data.Maybe ( orElse ) - -import GHC.Utils.Outputable -import GHC.Utils.Error -import GHC.Utils.Misc ( looksLikePackageName, fstOf3, sndOf3, thdOf3 ) -import GHC.Utils.Panic -import GHC.Prelude -import qualified GHC.Data.Strict as Strict - -import GHC.Types.Name.Reader -import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOccFS) -import GHC.Types.SrcLoc -import GHC.Types.Basic -import GHC.Types.Error ( GhcHint(..) ) -import GHC.Types.Fixity -import GHC.Types.ForeignCall -import GHC.Types.SourceFile -import GHC.Types.SourceText -import GHC.Types.PkgQual - -import GHC.Core.Type ( Specificity(..) ) -import GHC.Core.Class ( FunDep ) -import GHC.Core.DataCon ( DataCon, dataConName ) - -import GHC.Parser.PostProcess -import GHC.Parser.PostProcess.Haddock -import GHC.Parser.Lexer -import GHC.Parser.HaddockLex -import GHC.Parser.Annotation -import GHC.Parser.Errors.Types -import GHC.Parser.Errors.Ppr () - -import GHC.Builtin.Types ( unitTyCon, unitDataCon, sumTyCon, - tupleTyCon, tupleDataCon, nilDataCon, - unboxedUnitTyCon, unboxedUnitDataCon, - listTyCon_RDR, consDataCon_RDR, - unrestrictedFunTyCon ) - -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) - -import qualified Data.Semigroup as Semi -import qualified Data.Array as Happy_Data_Array -import qualified Data.Bits as Bits -import qualified GHC.Exts as Happy_GHC_Exts -import Control.Applicative(Applicative(..)) -import Control.Monad (ap) - --- parser produced by Happy Version 1.20.1.1 - -newtype HappyAbsSyn = HappyAbsSyn HappyAny -#if __GLASGOW_HASKELL__ >= 607 -type HappyAny = Happy_GHC_Exts.Any -#else -type HappyAny = forall a . a -#endif -newtype HappyWrap16 = HappyWrap16 (LocatedN RdrName) -happyIn16 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn16 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap16 x) -{-# INLINE happyIn16 #-} -happyOut16 :: (HappyAbsSyn ) -> HappyWrap16 -happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut16 #-} -newtype HappyWrap17 = HappyWrap17 ([LHsUnit PackageName]) -happyIn17 :: ([LHsUnit PackageName]) -> (HappyAbsSyn ) -happyIn17 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap17 x) -{-# INLINE happyIn17 #-} -happyOut17 :: (HappyAbsSyn ) -> HappyWrap17 -happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut17 #-} -newtype HappyWrap18 = HappyWrap18 (OrdList (LHsUnit PackageName)) -happyIn18 :: (OrdList (LHsUnit PackageName)) -> (HappyAbsSyn ) -happyIn18 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap18 x) -{-# INLINE happyIn18 #-} -happyOut18 :: (HappyAbsSyn ) -> HappyWrap18 -happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut18 #-} -newtype HappyWrap19 = HappyWrap19 (LHsUnit PackageName) -happyIn19 :: (LHsUnit PackageName) -> (HappyAbsSyn ) -happyIn19 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap19 x) -{-# INLINE happyIn19 #-} -happyOut19 :: (HappyAbsSyn ) -> HappyWrap19 -happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut19 #-} -newtype HappyWrap20 = HappyWrap20 (LHsUnitId PackageName) -happyIn20 :: (LHsUnitId PackageName) -> (HappyAbsSyn ) -happyIn20 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap20 x) -{-# INLINE happyIn20 #-} -happyOut20 :: (HappyAbsSyn ) -> HappyWrap20 -happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut20 #-} -newtype HappyWrap21 = HappyWrap21 (OrdList (LHsModuleSubst PackageName)) -happyIn21 :: (OrdList (LHsModuleSubst PackageName)) -> (HappyAbsSyn ) -happyIn21 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap21 x) -{-# INLINE happyIn21 #-} -happyOut21 :: (HappyAbsSyn ) -> HappyWrap21 -happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut21 #-} -newtype HappyWrap22 = HappyWrap22 (LHsModuleSubst PackageName) -happyIn22 :: (LHsModuleSubst PackageName) -> (HappyAbsSyn ) -happyIn22 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap22 x) -{-# INLINE happyIn22 #-} -happyOut22 :: (HappyAbsSyn ) -> HappyWrap22 -happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut22 #-} -newtype HappyWrap23 = HappyWrap23 (LHsModuleId PackageName) -happyIn23 :: (LHsModuleId PackageName) -> (HappyAbsSyn ) -happyIn23 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap23 x) -{-# INLINE happyIn23 #-} -happyOut23 :: (HappyAbsSyn ) -> HappyWrap23 -happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut23 #-} -newtype HappyWrap24 = HappyWrap24 (Located PackageName) -happyIn24 :: (Located PackageName) -> (HappyAbsSyn ) -happyIn24 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap24 x) -{-# INLINE happyIn24 #-} -happyOut24 :: (HappyAbsSyn ) -> HappyWrap24 -happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut24 #-} -newtype HappyWrap25 = HappyWrap25 (Located FastString) -happyIn25 :: (Located FastString) -> (HappyAbsSyn ) -happyIn25 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap25 x) -{-# INLINE happyIn25 #-} -happyOut25 :: (HappyAbsSyn ) -> HappyWrap25 -happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut25 #-} -newtype HappyWrap26 = HappyWrap26 (()) -happyIn26 :: (()) -> (HappyAbsSyn ) -happyIn26 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap26 x) -{-# INLINE happyIn26 #-} -happyOut26 :: (HappyAbsSyn ) -> HappyWrap26 -happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut26 #-} -newtype HappyWrap27 = HappyWrap27 (Located FastString) -happyIn27 :: (Located FastString) -> (HappyAbsSyn ) -happyIn27 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap27 x) -{-# INLINE happyIn27 #-} -happyOut27 :: (HappyAbsSyn ) -> HappyWrap27 -happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut27 #-} -newtype HappyWrap28 = HappyWrap28 (Maybe [LRenaming]) -happyIn28 :: (Maybe [LRenaming]) -> (HappyAbsSyn ) -happyIn28 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap28 x) -{-# INLINE happyIn28 #-} -happyOut28 :: (HappyAbsSyn ) -> HappyWrap28 -happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut28 #-} -newtype HappyWrap29 = HappyWrap29 (OrdList LRenaming) -happyIn29 :: (OrdList LRenaming) -> (HappyAbsSyn ) -happyIn29 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap29 x) -{-# INLINE happyIn29 #-} -happyOut29 :: (HappyAbsSyn ) -> HappyWrap29 -happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut29 #-} -newtype HappyWrap30 = HappyWrap30 (LRenaming) -happyIn30 :: (LRenaming) -> (HappyAbsSyn ) -happyIn30 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap30 x) -{-# INLINE happyIn30 #-} -happyOut30 :: (HappyAbsSyn ) -> HappyWrap30 -happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut30 #-} -newtype HappyWrap31 = HappyWrap31 (OrdList (LHsUnitDecl PackageName)) -happyIn31 :: (OrdList (LHsUnitDecl PackageName)) -> (HappyAbsSyn ) -happyIn31 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap31 x) -{-# INLINE happyIn31 #-} -happyOut31 :: (HappyAbsSyn ) -> HappyWrap31 -happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut31 #-} -newtype HappyWrap32 = HappyWrap32 (OrdList (LHsUnitDecl PackageName)) -happyIn32 :: (OrdList (LHsUnitDecl PackageName)) -> (HappyAbsSyn ) -happyIn32 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap32 x) -{-# INLINE happyIn32 #-} -happyOut32 :: (HappyAbsSyn ) -> HappyWrap32 -happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut32 #-} -newtype HappyWrap33 = HappyWrap33 (LHsUnitDecl PackageName) -happyIn33 :: (LHsUnitDecl PackageName) -> (HappyAbsSyn ) -happyIn33 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap33 x) -{-# INLINE happyIn33 #-} -happyOut33 :: (HappyAbsSyn ) -> HappyWrap33 -happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut33 #-} -newtype HappyWrap34 = HappyWrap34 (Located (HsModule GhcPs)) -happyIn34 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) -happyIn34 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap34 x) -{-# INLINE happyIn34 #-} -happyOut34 :: (HappyAbsSyn ) -> HappyWrap34 -happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut34 #-} -newtype HappyWrap35 = HappyWrap35 (Located (HsModule GhcPs)) -happyIn35 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) -happyIn35 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap35 x) -{-# INLINE happyIn35 #-} -happyOut35 :: (HappyAbsSyn ) -> HappyWrap35 -happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut35 #-} -newtype HappyWrap36 = HappyWrap36 (()) -happyIn36 :: (()) -> (HappyAbsSyn ) -happyIn36 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap36 x) -{-# INLINE happyIn36 #-} -happyOut36 :: (HappyAbsSyn ) -> HappyWrap36 -happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut36 #-} -newtype HappyWrap37 = HappyWrap37 (()) -happyIn37 :: (()) -> (HappyAbsSyn ) -happyIn37 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap37 x) -{-# INLINE happyIn37 #-} -happyOut37 :: (HappyAbsSyn ) -> HappyWrap37 -happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut37 #-} -newtype HappyWrap38 = HappyWrap38 (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,EpLayout)) -happyIn38 :: (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,EpLayout)) -> (HappyAbsSyn ) -happyIn38 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap38 x) -{-# INLINE happyIn38 #-} -happyOut38 :: (HappyAbsSyn ) -> HappyWrap38 -happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut38 #-} -newtype HappyWrap39 = HappyWrap39 (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,EpLayout)) -happyIn39 :: (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,EpLayout)) -> (HappyAbsSyn ) -happyIn39 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap39 x) -{-# INLINE happyIn39 #-} -happyOut39 :: (HappyAbsSyn ) -> HappyWrap39 -happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut39 #-} -newtype HappyWrap40 = HappyWrap40 (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]))) -happyIn40 :: (([TrailingAnn] - ,([LImportDecl GhcPs], [LHsDecl GhcPs]))) -> (HappyAbsSyn ) -happyIn40 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap40 x) -{-# INLINE happyIn40 #-} -happyOut40 :: (HappyAbsSyn ) -> HappyWrap40 -happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut40 #-} -newtype HappyWrap41 = HappyWrap41 (([LImportDecl GhcPs], [LHsDecl GhcPs])) -happyIn41 :: (([LImportDecl GhcPs], [LHsDecl GhcPs])) -> (HappyAbsSyn ) -happyIn41 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap41 x) -{-# INLINE happyIn41 #-} -happyOut41 :: (HappyAbsSyn ) -> HappyWrap41 -happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut41 #-} -newtype HappyWrap42 = HappyWrap42 (Located (HsModule GhcPs)) -happyIn42 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) -happyIn42 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap42 x) -{-# INLINE happyIn42 #-} -happyOut42 :: (HappyAbsSyn ) -> HappyWrap42 -happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut42 #-} -newtype HappyWrap43 = HappyWrap43 ([LImportDecl GhcPs]) -happyIn43 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn43 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap43 x) -{-# INLINE happyIn43 #-} -happyOut43 :: (HappyAbsSyn ) -> HappyWrap43 -happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut43 #-} -newtype HappyWrap44 = HappyWrap44 ([LImportDecl GhcPs]) -happyIn44 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn44 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap44 x) -{-# INLINE happyIn44 #-} -happyOut44 :: (HappyAbsSyn ) -> HappyWrap44 -happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut44 #-} -newtype HappyWrap45 = HappyWrap45 ([LImportDecl GhcPs]) -happyIn45 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn45 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap45 x) -{-# INLINE happyIn45 #-} -happyOut45 :: (HappyAbsSyn ) -> HappyWrap45 -happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut45 #-} -newtype HappyWrap46 = HappyWrap46 ([LImportDecl GhcPs]) -happyIn46 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn46 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap46 x) -{-# INLINE happyIn46 #-} -happyOut46 :: (HappyAbsSyn ) -> HappyWrap46 -happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut46 #-} -newtype HappyWrap47 = HappyWrap47 ((Maybe (LocatedLI [LIE GhcPs]))) -happyIn47 :: ((Maybe (LocatedLI [LIE GhcPs]))) -> (HappyAbsSyn ) -happyIn47 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap47 x) -{-# INLINE happyIn47 #-} -happyOut47 :: (HappyAbsSyn ) -> HappyWrap47 -happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut47 #-} -newtype HappyWrap48 = HappyWrap48 (([EpToken ","], OrdList (LIE GhcPs))) -happyIn48 :: (([EpToken ","], OrdList (LIE GhcPs))) -> (HappyAbsSyn ) -happyIn48 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap48 x) -{-# INLINE happyIn48 #-} -happyOut48 :: (HappyAbsSyn ) -> HappyWrap48 -happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut48 #-} -newtype HappyWrap49 = HappyWrap49 (OrdList (LIE GhcPs)) -happyIn49 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) -happyIn49 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap49 x) -{-# INLINE happyIn49 #-} -happyOut49 :: (HappyAbsSyn ) -> HappyWrap49 -happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut49 #-} -newtype HappyWrap50 = HappyWrap50 (OrdList (LIE GhcPs)) -happyIn50 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) -happyIn50 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap50 x) -{-# INLINE happyIn50 #-} -happyOut50 :: (HappyAbsSyn ) -> HappyWrap50 -happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut50 #-} -newtype HappyWrap51 = HappyWrap51 (LIE GhcPs) -happyIn51 :: (LIE GhcPs) -> (HappyAbsSyn ) -happyIn51 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap51 x) -{-# INLINE happyIn51 #-} -happyOut51 :: (HappyAbsSyn ) -> HappyWrap51 -happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut51 #-} -newtype HappyWrap52 = HappyWrap52 (Located ((EpToken "(", EpToken ")"), ImpExpSubSpec)) -happyIn52 :: (Located ((EpToken "(", EpToken ")"), ImpExpSubSpec)) -> (HappyAbsSyn ) -happyIn52 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap52 x) -{-# INLINE happyIn52 #-} -happyOut52 :: (HappyAbsSyn ) -> HappyWrap52 -happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut52 #-} -newtype HappyWrap53 = HappyWrap53 ([LocatedA ImpExpQcSpec]) -happyIn53 :: ([LocatedA ImpExpQcSpec]) -> (HappyAbsSyn ) -happyIn53 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap53 x) -{-# INLINE happyIn53 #-} -happyOut53 :: (HappyAbsSyn ) -> HappyWrap53 -happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut53 #-} -newtype HappyWrap54 = HappyWrap54 ([LocatedA ImpExpQcSpec]) -happyIn54 :: ([LocatedA ImpExpQcSpec]) -> (HappyAbsSyn ) -happyIn54 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap54 x) -{-# INLINE happyIn54 #-} -happyOut54 :: (HappyAbsSyn ) -> HappyWrap54 -happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut54 #-} -newtype HappyWrap55 = HappyWrap55 (LocatedA ImpExpQcSpec) -happyIn55 :: (LocatedA ImpExpQcSpec) -> (HappyAbsSyn ) -happyIn55 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap55 x) -{-# INLINE happyIn55 #-} -happyOut55 :: (HappyAbsSyn ) -> HappyWrap55 -happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut55 #-} -newtype HappyWrap56 = HappyWrap56 (LocatedA ImpExpQcSpec) -happyIn56 :: (LocatedA ImpExpQcSpec) -> (HappyAbsSyn ) -happyIn56 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap56 x) -{-# INLINE happyIn56 #-} -happyOut56 :: (HappyAbsSyn ) -> HappyWrap56 -happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut56 #-} -newtype HappyWrap57 = HappyWrap57 (LocatedN RdrName) -happyIn57 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn57 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap57 x) -{-# INLINE happyIn57 #-} -happyOut57 :: (HappyAbsSyn ) -> HappyWrap57 -happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut57 #-} -newtype HappyWrap58 = HappyWrap58 (Located [TrailingAnn]) -happyIn58 :: (Located [TrailingAnn]) -> (HappyAbsSyn ) -happyIn58 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap58 x) -{-# INLINE happyIn58 #-} -happyOut58 :: (HappyAbsSyn ) -> HappyWrap58 -happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut58 #-} -newtype HappyWrap59 = HappyWrap59 ([TrailingAnn]) -happyIn59 :: ([TrailingAnn]) -> (HappyAbsSyn ) -happyIn59 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap59 x) -{-# INLINE happyIn59 #-} -happyOut59 :: (HappyAbsSyn ) -> HappyWrap59 -happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut59 #-} -newtype HappyWrap60 = HappyWrap60 ([LImportDecl GhcPs]) -happyIn60 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn60 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap60 x) -{-# INLINE happyIn60 #-} -happyOut60 :: (HappyAbsSyn ) -> HappyWrap60 -happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut60 #-} -newtype HappyWrap61 = HappyWrap61 ([LImportDecl GhcPs]) -happyIn61 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) -happyIn61 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap61 x) -{-# INLINE happyIn61 #-} -happyOut61 :: (HappyAbsSyn ) -> HappyWrap61 -happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut61 #-} -newtype HappyWrap62 = HappyWrap62 (LImportDecl GhcPs) -happyIn62 :: (LImportDecl GhcPs) -> (HappyAbsSyn ) -happyIn62 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap62 x) -{-# INLINE happyIn62 #-} -happyOut62 :: (HappyAbsSyn ) -> HappyWrap62 -happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut62 #-} -newtype HappyWrap63 = HappyWrap63 (((Maybe (EpaLocation,EpToken "#-}"),SourceText),IsBootInterface)) -happyIn63 :: (((Maybe (EpaLocation,EpToken "#-}"),SourceText),IsBootInterface)) -> (HappyAbsSyn ) -happyIn63 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap63 x) -{-# INLINE happyIn63 #-} -happyOut63 :: (HappyAbsSyn ) -> HappyWrap63 -happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut63 #-} -newtype HappyWrap64 = HappyWrap64 ((Maybe (EpToken "safe"),Bool)) -happyIn64 :: ((Maybe (EpToken "safe"),Bool)) -> (HappyAbsSyn ) -happyIn64 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap64 x) -{-# INLINE happyIn64 #-} -happyOut64 :: (HappyAbsSyn ) -> HappyWrap64 -happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut64 #-} -newtype HappyWrap65 = HappyWrap65 ((Maybe EpaLocation, RawPkgQual)) -happyIn65 :: ((Maybe EpaLocation, RawPkgQual)) -> (HappyAbsSyn ) -happyIn65 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap65 x) -{-# INLINE happyIn65 #-} -happyOut65 :: (HappyAbsSyn ) -> HappyWrap65 -happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut65 #-} -newtype HappyWrap66 = HappyWrap66 (Located (Maybe (EpToken "qualified"))) -happyIn66 :: (Located (Maybe (EpToken "qualified"))) -> (HappyAbsSyn ) -happyIn66 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap66 x) -{-# INLINE happyIn66 #-} -happyOut66 :: (HappyAbsSyn ) -> HappyWrap66 -happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut66 #-} -newtype HappyWrap67 = HappyWrap67 ((Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName)))) -happyIn67 :: ((Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName)))) -> (HappyAbsSyn ) -happyIn67 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap67 x) -{-# INLINE happyIn67 #-} -happyOut67 :: (HappyAbsSyn ) -> HappyWrap67 -happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut67 #-} -newtype HappyWrap68 = HappyWrap68 (Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs]))) -happyIn68 :: (Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs]))) -> (HappyAbsSyn ) -happyIn68 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap68 x) -{-# INLINE happyIn68 #-} -happyOut68 :: (HappyAbsSyn ) -> HappyWrap68 -happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut68 #-} -newtype HappyWrap69 = HappyWrap69 (Located (ImportListInterpretation, LocatedLI [LIE GhcPs])) -happyIn69 :: (Located (ImportListInterpretation, LocatedLI [LIE GhcPs])) -> (HappyAbsSyn ) -happyIn69 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap69 x) -{-# INLINE happyIn69 #-} -happyOut69 :: (HappyAbsSyn ) -> HappyWrap69 -happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut69 #-} -newtype HappyWrap70 = HappyWrap70 (([EpToken ","], OrdList (LIE GhcPs))) -happyIn70 :: (([EpToken ","], OrdList (LIE GhcPs))) -> (HappyAbsSyn ) -happyIn70 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap70 x) -{-# INLINE happyIn70 #-} -happyOut70 :: (HappyAbsSyn ) -> HappyWrap70 -happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut70 #-} -newtype HappyWrap71 = HappyWrap71 (OrdList (LIE GhcPs)) -happyIn71 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) -happyIn71 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap71 x) -{-# INLINE happyIn71 #-} -happyOut71 :: (HappyAbsSyn ) -> HappyWrap71 -happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut71 #-} -newtype HappyWrap72 = HappyWrap72 (OrdList (LIE GhcPs)) -happyIn72 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) -happyIn72 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap72 x) -{-# INLINE happyIn72 #-} -happyOut72 :: (HappyAbsSyn ) -> HappyWrap72 -happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut72 #-} -newtype HappyWrap73 = HappyWrap73 (Maybe (Located (SourceText,Int))) -happyIn73 :: (Maybe (Located (SourceText,Int))) -> (HappyAbsSyn ) -happyIn73 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap73 x) -{-# INLINE happyIn73 #-} -happyOut73 :: (HappyAbsSyn ) -> HappyWrap73 -happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut73 #-} -newtype HappyWrap74 = HappyWrap74 (Located FixityDirection) -happyIn74 :: (Located FixityDirection) -> (HappyAbsSyn ) -happyIn74 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap74 x) -{-# INLINE happyIn74 #-} -happyOut74 :: (HappyAbsSyn ) -> HappyWrap74 -happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut74 #-} -newtype HappyWrap75 = HappyWrap75 (Located (OrdList (LocatedN RdrName))) -happyIn75 :: (Located (OrdList (LocatedN RdrName))) -> (HappyAbsSyn ) -happyIn75 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap75 x) -{-# INLINE happyIn75 #-} -happyOut75 :: (HappyAbsSyn ) -> HappyWrap75 -happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut75 #-} -newtype HappyWrap76 = HappyWrap76 (OrdList (LHsDecl GhcPs)) -happyIn76 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) -happyIn76 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap76 x) -{-# INLINE happyIn76 #-} -happyOut76 :: (HappyAbsSyn ) -> HappyWrap76 -happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut76 #-} -newtype HappyWrap77 = HappyWrap77 (OrdList (LHsDecl GhcPs)) -happyIn77 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) -happyIn77 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap77 x) -{-# INLINE happyIn77 #-} -happyOut77 :: (HappyAbsSyn ) -> HappyWrap77 -happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut77 #-} -newtype HappyWrap78 = HappyWrap78 (OrdList (LHsDecl GhcPs)) -happyIn78 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) -happyIn78 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap78 x) -{-# INLINE happyIn78 #-} -happyOut78 :: (HappyAbsSyn ) -> HappyWrap78 -happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut78 #-} -newtype HappyWrap79 = HappyWrap79 (OrdList (LHsDecl GhcPs)) -happyIn79 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) -happyIn79 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap79 x) -{-# INLINE happyIn79 #-} -happyOut79 :: (HappyAbsSyn ) -> HappyWrap79 -happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut79 #-} -newtype HappyWrap80 = HappyWrap80 (LHsDecl GhcPs) -happyIn80 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn80 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap80 x) -{-# INLINE happyIn80 #-} -happyOut80 :: (HappyAbsSyn ) -> HappyWrap80 -happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut80 #-} -newtype HappyWrap81 = HappyWrap81 (LHsDecl GhcPs) -happyIn81 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn81 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap81 x) -{-# INLINE happyIn81 #-} -happyOut81 :: (HappyAbsSyn ) -> HappyWrap81 -happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut81 #-} -newtype HappyWrap82 = HappyWrap82 (LTyClDecl GhcPs) -happyIn82 :: (LTyClDecl GhcPs) -> (HappyAbsSyn ) -happyIn82 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap82 x) -{-# INLINE happyIn82 #-} -happyOut82 :: (HappyAbsSyn ) -> HappyWrap82 -happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut82 #-} -newtype HappyWrap83 = HappyWrap83 (LDefaultDecl GhcPs) -happyIn83 :: (LDefaultDecl GhcPs) -> (HappyAbsSyn ) -happyIn83 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap83 x) -{-# INLINE happyIn83 #-} -happyOut83 :: (HappyAbsSyn ) -> HappyWrap83 -happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut83 #-} -newtype HappyWrap84 = HappyWrap84 (LTyClDecl GhcPs) -happyIn84 :: (LTyClDecl GhcPs) -> (HappyAbsSyn ) -happyIn84 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap84 x) -{-# INLINE happyIn84 #-} -happyOut84 :: (HappyAbsSyn ) -> HappyWrap84 -happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut84 #-} -newtype HappyWrap85 = HappyWrap85 (LStandaloneKindSig GhcPs) -happyIn85 :: (LStandaloneKindSig GhcPs) -> (HappyAbsSyn ) -happyIn85 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap85 x) -{-# INLINE happyIn85 #-} -happyOut85 :: (HappyAbsSyn ) -> HappyWrap85 -happyOut85 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut85 #-} -newtype HappyWrap86 = HappyWrap86 (Located [LocatedN RdrName]) -happyIn86 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn86 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap86 x) -{-# INLINE happyIn86 #-} -happyOut86 :: (HappyAbsSyn ) -> HappyWrap86 -happyOut86 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut86 #-} -newtype HappyWrap87 = HappyWrap87 (LInstDecl GhcPs) -happyIn87 :: (LInstDecl GhcPs) -> (HappyAbsSyn ) -happyIn87 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap87 x) -{-# INLINE happyIn87 #-} -happyOut87 :: (HappyAbsSyn ) -> HappyWrap87 -happyOut87 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut87 #-} -newtype HappyWrap88 = HappyWrap88 (Maybe (LocatedP OverlapMode)) -happyIn88 :: (Maybe (LocatedP OverlapMode)) -> (HappyAbsSyn ) -happyIn88 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap88 x) -{-# INLINE happyIn88 #-} -happyOut88 :: (HappyAbsSyn ) -> HappyWrap88 -happyOut88 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut88 #-} -newtype HappyWrap89 = HappyWrap89 (LDerivStrategy GhcPs) -happyIn89 :: (LDerivStrategy GhcPs) -> (HappyAbsSyn ) -happyIn89 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap89 x) -{-# INLINE happyIn89 #-} -happyOut89 :: (HappyAbsSyn ) -> HappyWrap89 -happyOut89 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut89 #-} -newtype HappyWrap90 = HappyWrap90 (LDerivStrategy GhcPs) -happyIn90 :: (LDerivStrategy GhcPs) -> (HappyAbsSyn ) -happyIn90 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap90 x) -{-# INLINE happyIn90 #-} -happyOut90 :: (HappyAbsSyn ) -> HappyWrap90 -happyOut90 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut90 #-} -newtype HappyWrap91 = HappyWrap91 (Maybe (LDerivStrategy GhcPs)) -happyIn91 :: (Maybe (LDerivStrategy GhcPs)) -> (HappyAbsSyn ) -happyIn91 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap91 x) -{-# INLINE happyIn91 #-} -happyOut91 :: (HappyAbsSyn ) -> HappyWrap91 -happyOut91 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut91 #-} -newtype HappyWrap92 = HappyWrap92 (Maybe (LIdP GhcPs)) -happyIn92 :: (Maybe (LIdP GhcPs)) -> (HappyAbsSyn ) -happyIn92 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap92 x) -{-# INLINE happyIn92 #-} -happyOut92 :: (HappyAbsSyn ) -> HappyWrap92 -happyOut92 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut92 #-} -newtype HappyWrap93 = HappyWrap93 (Located (EpToken "|", Maybe (LInjectivityAnn GhcPs))) -happyIn93 :: (Located (EpToken "|", Maybe (LInjectivityAnn GhcPs))) -> (HappyAbsSyn ) -happyIn93 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap93 x) -{-# INLINE happyIn93 #-} -happyOut93 :: (HappyAbsSyn ) -> HappyWrap93 -happyOut93 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut93 #-} -newtype HappyWrap94 = HappyWrap94 (LInjectivityAnn GhcPs) -happyIn94 :: (LInjectivityAnn GhcPs) -> (HappyAbsSyn ) -happyIn94 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap94 x) -{-# INLINE happyIn94 #-} -happyOut94 :: (HappyAbsSyn ) -> HappyWrap94 -happyOut94 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut94 #-} -newtype HappyWrap95 = HappyWrap95 (Located [LocatedN RdrName]) -happyIn95 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn95 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap95 x) -{-# INLINE happyIn95 #-} -happyOut95 :: (HappyAbsSyn ) -> HappyWrap95 -happyOut95 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut95 #-} -newtype HappyWrap96 = HappyWrap96 (Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs)) -happyIn96 :: (Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs)) -> (HappyAbsSyn ) -happyIn96 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap96 x) -{-# INLINE happyIn96 #-} -happyOut96 :: (HappyAbsSyn ) -> HappyWrap96 -happyOut96 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut96 #-} -newtype HappyWrap97 = HappyWrap97 (Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs])) -happyIn97 :: (Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs])) -> (HappyAbsSyn ) -happyIn97 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap97 x) -{-# INLINE happyIn97 #-} -happyOut97 :: (HappyAbsSyn ) -> HappyWrap97 -happyOut97 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut97 #-} -newtype HappyWrap98 = HappyWrap98 (Located [LTyFamInstEqn GhcPs]) -happyIn98 :: (Located [LTyFamInstEqn GhcPs]) -> (HappyAbsSyn ) -happyIn98 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap98 x) -{-# INLINE happyIn98 #-} -happyOut98 :: (HappyAbsSyn ) -> HappyWrap98 -happyOut98 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut98 #-} -newtype HappyWrap99 = HappyWrap99 (LTyFamInstEqn GhcPs) -happyIn99 :: (LTyFamInstEqn GhcPs) -> (HappyAbsSyn ) -happyIn99 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap99 x) -{-# INLINE happyIn99 #-} -happyOut99 :: (HappyAbsSyn ) -> HappyWrap99 -happyOut99 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut99 #-} -newtype HappyWrap100 = HappyWrap100 (LHsDecl GhcPs) -happyIn100 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn100 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap100 x) -{-# INLINE happyIn100 #-} -happyOut100 :: (HappyAbsSyn ) -> HappyWrap100 -happyOut100 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut100 #-} -newtype HappyWrap101 = HappyWrap101 (EpToken "family") -happyIn101 :: (EpToken "family") -> (HappyAbsSyn ) -happyIn101 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap101 x) -{-# INLINE happyIn101 #-} -happyOut101 :: (HappyAbsSyn ) -> HappyWrap101 -happyOut101 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut101 #-} -newtype HappyWrap102 = HappyWrap102 (EpToken "instance") -happyIn102 :: (EpToken "instance") -> (HappyAbsSyn ) -happyIn102 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap102 x) -{-# INLINE happyIn102 #-} -happyOut102 :: (HappyAbsSyn ) -> HappyWrap102 -happyOut102 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut102 #-} -newtype HappyWrap103 = HappyWrap103 (LInstDecl GhcPs) -happyIn103 :: (LInstDecl GhcPs) -> (HappyAbsSyn ) -happyIn103 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap103 x) -{-# INLINE happyIn103 #-} -happyOut103 :: (HappyAbsSyn ) -> HappyWrap103 -happyOut103 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut103 #-} -newtype HappyWrap104 = HappyWrap104 (Located ((EpToken "data", EpToken "newtype", EpToken "type") - , Bool, NewOrData)) -happyIn104 :: (Located ((EpToken "data", EpToken "newtype", EpToken "type") - , Bool, NewOrData)) -> (HappyAbsSyn ) -happyIn104 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap104 x) -{-# INLINE happyIn104 #-} -happyOut104 :: (HappyAbsSyn ) -> HappyWrap104 -happyOut104 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut104 #-} -newtype HappyWrap105 = HappyWrap105 (Located ((EpToken "data", EpToken "newtype"), NewOrData)) -happyIn105 :: (Located ((EpToken "data", EpToken "newtype"), NewOrData)) -> (HappyAbsSyn ) -happyIn105 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap105 x) -{-# INLINE happyIn105 #-} -happyOut105 :: (HappyAbsSyn ) -> HappyWrap105 -happyOut105 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut105 #-} -newtype HappyWrap106 = HappyWrap106 (Located (TokDcolon, Maybe (LHsKind GhcPs))) -happyIn106 :: (Located (TokDcolon, Maybe (LHsKind GhcPs))) -> (HappyAbsSyn ) -happyIn106 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap106 x) -{-# INLINE happyIn106 #-} -happyOut106 :: (HappyAbsSyn ) -> HappyWrap106 -happyOut106 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut106 #-} -newtype HappyWrap107 = HappyWrap107 (Located (TokDcolon, LFamilyResultSig GhcPs)) -happyIn107 :: (Located (TokDcolon, LFamilyResultSig GhcPs)) -> (HappyAbsSyn ) -happyIn107 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap107 x) -{-# INLINE happyIn107 #-} -happyOut107 :: (HappyAbsSyn ) -> HappyWrap107 -happyOut107 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut107 #-} -newtype HappyWrap108 = HappyWrap108 (Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs)) -happyIn108 :: (Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs)) -> (HappyAbsSyn ) -happyIn108 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap108 x) -{-# INLINE happyIn108 #-} -happyOut108 :: (HappyAbsSyn ) -> HappyWrap108 -happyOut108 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut108 #-} -newtype HappyWrap109 = HappyWrap109 (Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs - , Maybe (LInjectivityAnn GhcPs)))) -happyIn109 :: (Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs - , Maybe (LInjectivityAnn GhcPs)))) -> (HappyAbsSyn ) -happyIn109 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap109 x) -{-# INLINE happyIn109 #-} -happyOut109 :: (HappyAbsSyn ) -> HappyWrap109 -happyOut109 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut109 #-} -newtype HappyWrap110 = HappyWrap110 (Located (Maybe (LHsContext GhcPs), LHsType GhcPs)) -happyIn110 :: (Located (Maybe (LHsContext GhcPs), LHsType GhcPs)) -> (HappyAbsSyn ) -happyIn110 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap110 x) -{-# INLINE happyIn110 #-} -happyOut110 :: (HappyAbsSyn ) -> HappyWrap110 -happyOut110 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut110 #-} -newtype HappyWrap111 = HappyWrap111 (Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs)) -happyIn111 :: (Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs)) -> (HappyAbsSyn ) -happyIn111 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap111 x) -{-# INLINE happyIn111 #-} -happyOut111 :: (HappyAbsSyn ) -> HappyWrap111 -happyOut111 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut111 #-} -newtype HappyWrap112 = HappyWrap112 (Maybe (LocatedP CType)) -happyIn112 :: (Maybe (LocatedP CType)) -> (HappyAbsSyn ) -happyIn112 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap112 x) -{-# INLINE happyIn112 #-} -happyOut112 :: (HappyAbsSyn ) -> HappyWrap112 -happyOut112 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut112 #-} -newtype HappyWrap113 = HappyWrap113 (LDerivDecl GhcPs) -happyIn113 :: (LDerivDecl GhcPs) -> (HappyAbsSyn ) -happyIn113 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap113 x) -{-# INLINE happyIn113 #-} -happyOut113 :: (HappyAbsSyn ) -> HappyWrap113 -happyOut113 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut113 #-} -newtype HappyWrap114 = HappyWrap114 (LRoleAnnotDecl GhcPs) -happyIn114 :: (LRoleAnnotDecl GhcPs) -> (HappyAbsSyn ) -happyIn114 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap114 x) -{-# INLINE happyIn114 #-} -happyOut114 :: (HappyAbsSyn ) -> HappyWrap114 -happyOut114 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut114 #-} -newtype HappyWrap115 = HappyWrap115 (Located [Located (Maybe FastString)]) -happyIn115 :: (Located [Located (Maybe FastString)]) -> (HappyAbsSyn ) -happyIn115 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap115 x) -{-# INLINE happyIn115 #-} -happyOut115 :: (HappyAbsSyn ) -> HappyWrap115 -happyOut115 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut115 #-} -newtype HappyWrap116 = HappyWrap116 (Located [Located (Maybe FastString)]) -happyIn116 :: (Located [Located (Maybe FastString)]) -> (HappyAbsSyn ) -happyIn116 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap116 x) -{-# INLINE happyIn116 #-} -happyOut116 :: (HappyAbsSyn ) -> HappyWrap116 -happyOut116 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut116 #-} -newtype HappyWrap117 = HappyWrap117 (Located (Maybe FastString)) -happyIn117 :: (Located (Maybe FastString)) -> (HappyAbsSyn ) -happyIn117 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap117 x) -{-# INLINE happyIn117 #-} -happyOut117 :: (HappyAbsSyn ) -> HappyWrap117 -happyOut117 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut117 #-} -newtype HappyWrap118 = HappyWrap118 (LHsDecl GhcPs) -happyIn118 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn118 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap118 x) -{-# INLINE happyIn118 #-} -happyOut118 :: (HappyAbsSyn ) -> HappyWrap118 -happyOut118 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut118 #-} -newtype HappyWrap119 = HappyWrap119 ((LocatedN RdrName, HsPatSynDetails GhcPs, (Maybe (EpToken "{"), Maybe (EpToken "}")))) -happyIn119 :: ((LocatedN RdrName, HsPatSynDetails GhcPs, (Maybe (EpToken "{"), Maybe (EpToken "}")))) -> (HappyAbsSyn ) -happyIn119 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap119 x) -{-# INLINE happyIn119 #-} -happyOut119 :: (HappyAbsSyn ) -> HappyWrap119 -happyOut119 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut119 #-} -newtype HappyWrap120 = HappyWrap120 ([LocatedN RdrName]) -happyIn120 :: ([LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn120 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap120 x) -{-# INLINE happyIn120 #-} -happyOut120 :: (HappyAbsSyn ) -> HappyWrap120 -happyOut120 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut120 #-} -newtype HappyWrap121 = HappyWrap121 ([RecordPatSynField GhcPs]) -happyIn121 :: ([RecordPatSynField GhcPs]) -> (HappyAbsSyn ) -happyIn121 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap121 x) -{-# INLINE happyIn121 #-} -happyOut121 :: (HappyAbsSyn ) -> HappyWrap121 -happyOut121 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut121 #-} -newtype HappyWrap122 = HappyWrap122 (LocatedLW (OrdList (LHsDecl GhcPs))) -happyIn122 :: (LocatedLW (OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn122 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap122 x) -{-# INLINE happyIn122 #-} -happyOut122 :: (HappyAbsSyn ) -> HappyWrap122 -happyOut122 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut122 #-} -newtype HappyWrap123 = HappyWrap123 (LSig GhcPs) -happyIn123 :: (LSig GhcPs) -> (HappyAbsSyn ) -happyIn123 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap123 x) -{-# INLINE happyIn123 #-} -happyOut123 :: (HappyAbsSyn ) -> HappyWrap123 -happyOut123 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut123 #-} -newtype HappyWrap124 = HappyWrap124 (LocatedN RdrName) -happyIn124 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn124 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap124 x) -{-# INLINE happyIn124 #-} -happyOut124 :: (HappyAbsSyn ) -> HappyWrap124 -happyOut124 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut124 #-} -newtype HappyWrap125 = HappyWrap125 (LHsDecl GhcPs) -happyIn125 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn125 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap125 x) -{-# INLINE happyIn125 #-} -happyOut125 :: (HappyAbsSyn ) -> HappyWrap125 -happyOut125 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut125 #-} -newtype HappyWrap126 = HappyWrap126 (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -happyIn126 :: (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn126 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap126 x) -{-# INLINE happyIn126 #-} -happyOut126 :: (HappyAbsSyn ) -> HappyWrap126 -happyOut126 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut126 #-} -newtype HappyWrap127 = HappyWrap127 (Located ((EpToken "{", [EpToken ";"], EpToken "}") - , OrdList (LHsDecl GhcPs) - , EpLayout)) -happyIn127 :: (Located ((EpToken "{", [EpToken ";"], EpToken "}") - , OrdList (LHsDecl GhcPs) - , EpLayout)) -> (HappyAbsSyn ) -happyIn127 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap127 x) -{-# INLINE happyIn127 #-} -happyOut127 :: (HappyAbsSyn ) -> HappyWrap127 -happyOut127 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut127 #-} -newtype HappyWrap128 = HappyWrap128 (Located ((EpToken "where", (EpToken "{", [EpToken ";"], EpToken "}")) - ,(OrdList (LHsDecl GhcPs)) -- Reversed - ,EpLayout)) -happyIn128 :: (Located ((EpToken "where", (EpToken "{", [EpToken ";"], EpToken "}")) - ,(OrdList (LHsDecl GhcPs)) -- Reversed - ,EpLayout)) -> (HappyAbsSyn ) -happyIn128 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap128 x) -{-# INLINE happyIn128 #-} -happyOut128 :: (HappyAbsSyn ) -> HappyWrap128 -happyOut128 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut128 #-} -newtype HappyWrap129 = HappyWrap129 (Located (OrdList (LHsDecl GhcPs))) -happyIn129 :: (Located (OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn129 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap129 x) -{-# INLINE happyIn129 #-} -happyOut129 :: (HappyAbsSyn ) -> HappyWrap129 -happyOut129 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut129 #-} -newtype HappyWrap130 = HappyWrap130 (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -happyIn130 :: (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn130 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap130 x) -{-# INLINE happyIn130 #-} -happyOut130 :: (HappyAbsSyn ) -> HappyWrap130 -happyOut130 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut130 #-} -newtype HappyWrap131 = HappyWrap131 (Located ((EpToken "{", EpToken "}", [EpToken ";"]) - , OrdList (LHsDecl GhcPs))) -happyIn131 :: (Located ((EpToken "{", EpToken "}", [EpToken ";"]) - , OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn131 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap131 x) -{-# INLINE happyIn131 #-} -happyOut131 :: (HappyAbsSyn ) -> HappyWrap131 -happyOut131 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut131 #-} -newtype HappyWrap132 = HappyWrap132 (Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"])) - , OrdList (LHsDecl GhcPs))) -happyIn132 :: (Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"])) - , OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn132 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap132 x) -{-# INLINE happyIn132 #-} -happyOut132 :: (HappyAbsSyn ) -> HappyWrap132 -happyOut132 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut132 #-} -newtype HappyWrap133 = HappyWrap133 (Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs))) -happyIn133 :: (Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) -happyIn133 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap133 x) -{-# INLINE happyIn133 #-} -happyOut133 :: (HappyAbsSyn ) -> HappyWrap133 -happyOut133 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut133 #-} -newtype HappyWrap134 = HappyWrap134 (Located (AnnList (),Located (OrdList (LHsDecl GhcPs)))) -happyIn134 :: (Located (AnnList (),Located (OrdList (LHsDecl GhcPs)))) -> (HappyAbsSyn ) -happyIn134 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap134 x) -{-# INLINE happyIn134 #-} -happyOut134 :: (HappyAbsSyn ) -> HappyWrap134 -happyOut134 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut134 #-} -newtype HappyWrap135 = HappyWrap135 (Located (HsLocalBinds GhcPs)) -happyIn135 :: (Located (HsLocalBinds GhcPs)) -> (HappyAbsSyn ) -happyIn135 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap135 x) -{-# INLINE happyIn135 #-} -happyOut135 :: (HappyAbsSyn ) -> HappyWrap135 -happyOut135 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut135 #-} -newtype HappyWrap136 = HappyWrap136 (Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments ))) -happyIn136 :: (Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments ))) -> (HappyAbsSyn ) -happyIn136 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap136 x) -{-# INLINE happyIn136 #-} -happyOut136 :: (HappyAbsSyn ) -> HappyWrap136 -happyOut136 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut136 #-} -newtype HappyWrap137 = HappyWrap137 ([LRuleDecl GhcPs]) -happyIn137 :: ([LRuleDecl GhcPs]) -> (HappyAbsSyn ) -happyIn137 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap137 x) -{-# INLINE happyIn137 #-} -happyOut137 :: (HappyAbsSyn ) -> HappyWrap137 -happyOut137 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut137 #-} -newtype HappyWrap138 = HappyWrap138 (LRuleDecl GhcPs) -happyIn138 :: (LRuleDecl GhcPs) -> (HappyAbsSyn ) -happyIn138 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap138 x) -{-# INLINE happyIn138 #-} -happyOut138 :: (HappyAbsSyn ) -> HappyWrap138 -happyOut138 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut138 #-} -newtype HappyWrap139 = HappyWrap139 ((ActivationAnn, Maybe Activation)) -happyIn139 :: ((ActivationAnn, Maybe Activation)) -> (HappyAbsSyn ) -happyIn139 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap139 x) -{-# INLINE happyIn139 #-} -happyOut139 :: (HappyAbsSyn ) -> HappyWrap139 -happyOut139 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut139 #-} -newtype HappyWrap140 = HappyWrap140 ((Maybe (EpToken "~"))) -happyIn140 :: ((Maybe (EpToken "~"))) -> (HappyAbsSyn ) -happyIn140 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap140 x) -{-# INLINE happyIn140 #-} -happyOut140 :: (HappyAbsSyn ) -> HappyWrap140 -happyOut140 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut140 #-} -newtype HappyWrap141 = HappyWrap141 (( ActivationAnn - , Activation)) -happyIn141 :: (( ActivationAnn - , Activation)) -> (HappyAbsSyn ) -happyIn141 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap141 x) -{-# INLINE happyIn141 #-} -happyOut141 :: (HappyAbsSyn ) -> HappyWrap141 -happyOut141 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut141 #-} -newtype HappyWrap142 = HappyWrap142 ((EpToken "=" -> ActivationAnn -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs])) -happyIn142 :: ((EpToken "=" -> ActivationAnn -> HsRuleAnn, Maybe [LHsTyVarBndr () GhcPs], [LRuleBndr GhcPs])) -> (HappyAbsSyn ) -happyIn142 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap142 x) -{-# INLINE happyIn142 #-} -happyOut142 :: (HappyAbsSyn ) -> HappyWrap142 -happyOut142 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut142 #-} -newtype HappyWrap143 = HappyWrap143 ([LRuleTyTmVar]) -happyIn143 :: ([LRuleTyTmVar]) -> (HappyAbsSyn ) -happyIn143 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap143 x) -{-# INLINE happyIn143 #-} -happyOut143 :: (HappyAbsSyn ) -> HappyWrap143 -happyOut143 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut143 #-} -newtype HappyWrap144 = HappyWrap144 (LRuleTyTmVar) -happyIn144 :: (LRuleTyTmVar) -> (HappyAbsSyn ) -happyIn144 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap144 x) -{-# INLINE happyIn144 #-} -happyOut144 :: (HappyAbsSyn ) -> HappyWrap144 -happyOut144 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut144 #-} -newtype HappyWrap145 = HappyWrap145 (Maybe (LWarningTxt GhcPs)) -happyIn145 :: (Maybe (LWarningTxt GhcPs)) -> (HappyAbsSyn ) -happyIn145 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap145 x) -{-# INLINE happyIn145 #-} -happyOut145 :: (HappyAbsSyn ) -> HappyWrap145 -happyOut145 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut145 #-} -newtype HappyWrap146 = HappyWrap146 (Maybe (LocatedE InWarningCategory)) -happyIn146 :: (Maybe (LocatedE InWarningCategory)) -> (HappyAbsSyn ) -happyIn146 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap146 x) -{-# INLINE happyIn146 #-} -happyOut146 :: (HappyAbsSyn ) -> HappyWrap146 -happyOut146 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut146 #-} -newtype HappyWrap147 = HappyWrap147 (OrdList (LWarnDecl GhcPs)) -happyIn147 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) -happyIn147 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap147 x) -{-# INLINE happyIn147 #-} -happyOut147 :: (HappyAbsSyn ) -> HappyWrap147 -happyOut147 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut147 #-} -newtype HappyWrap148 = HappyWrap148 (OrdList (LWarnDecl GhcPs)) -happyIn148 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) -happyIn148 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap148 x) -{-# INLINE happyIn148 #-} -happyOut148 :: (HappyAbsSyn ) -> HappyWrap148 -happyOut148 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut148 #-} -newtype HappyWrap149 = HappyWrap149 (Located NamespaceSpecifier) -happyIn149 :: (Located NamespaceSpecifier) -> (HappyAbsSyn ) -happyIn149 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap149 x) -{-# INLINE happyIn149 #-} -happyOut149 :: (HappyAbsSyn ) -> HappyWrap149 -happyOut149 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut149 #-} -newtype HappyWrap150 = HappyWrap150 (OrdList (LWarnDecl GhcPs)) -happyIn150 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) -happyIn150 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap150 x) -{-# INLINE happyIn150 #-} -happyOut150 :: (HappyAbsSyn ) -> HappyWrap150 -happyOut150 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut150 #-} -newtype HappyWrap151 = HappyWrap151 (OrdList (LWarnDecl GhcPs)) -happyIn151 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) -happyIn151 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap151 x) -{-# INLINE happyIn151 #-} -happyOut151 :: (HappyAbsSyn ) -> HappyWrap151 -happyOut151 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut151 #-} -newtype HappyWrap152 = HappyWrap152 (Located ((EpToken "[", EpToken "]"),[Located StringLiteral])) -happyIn152 :: (Located ((EpToken "[", EpToken "]"),[Located StringLiteral])) -> (HappyAbsSyn ) -happyIn152 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap152 x) -{-# INLINE happyIn152 #-} -happyOut152 :: (HappyAbsSyn ) -> HappyWrap152 -happyOut152 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut152 #-} -newtype HappyWrap153 = HappyWrap153 (Located (OrdList (Located StringLiteral))) -happyIn153 :: (Located (OrdList (Located StringLiteral))) -> (HappyAbsSyn ) -happyIn153 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap153 x) -{-# INLINE happyIn153 #-} -happyOut153 :: (HappyAbsSyn ) -> HappyWrap153 -happyOut153 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut153 #-} -newtype HappyWrap154 = HappyWrap154 (LHsDecl GhcPs) -happyIn154 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn154 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap154 x) -{-# INLINE happyIn154 #-} -happyOut154 :: (HappyAbsSyn ) -> HappyWrap154 -happyOut154 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut154 #-} -newtype HappyWrap155 = HappyWrap155 (Located (EpToken "foreign" -> HsDecl GhcPs)) -happyIn155 :: (Located (EpToken "foreign" -> HsDecl GhcPs)) -> (HappyAbsSyn ) -happyIn155 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap155 x) -{-# INLINE happyIn155 #-} -happyOut155 :: (HappyAbsSyn ) -> HappyWrap155 -happyOut155 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut155 #-} -newtype HappyWrap156 = HappyWrap156 (Located CCallConv) -happyIn156 :: (Located CCallConv) -> (HappyAbsSyn ) -happyIn156 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap156 x) -{-# INLINE happyIn156 #-} -happyOut156 :: (HappyAbsSyn ) -> HappyWrap156 -happyOut156 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut156 #-} -newtype HappyWrap157 = HappyWrap157 (Located Safety) -happyIn157 :: (Located Safety) -> (HappyAbsSyn ) -happyIn157 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap157 x) -{-# INLINE happyIn157 #-} -happyOut157 :: (HappyAbsSyn ) -> HappyWrap157 -happyOut157 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut157 #-} -newtype HappyWrap158 = HappyWrap158 (Located (TokDcolon - ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs))) -happyIn158 :: (Located (TokDcolon - ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs))) -> (HappyAbsSyn ) -happyIn158 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap158 x) -{-# INLINE happyIn158 #-} -happyOut158 :: (HappyAbsSyn ) -> HappyWrap158 -happyOut158 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut158 #-} -newtype HappyWrap159 = HappyWrap159 (Maybe (EpUniToken "::" "∷", LHsType GhcPs)) -happyIn159 :: (Maybe (EpUniToken "::" "∷", LHsType GhcPs)) -> (HappyAbsSyn ) -happyIn159 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap159 x) -{-# INLINE happyIn159 #-} -happyOut159 :: (HappyAbsSyn ) -> HappyWrap159 -happyOut159 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut159 #-} -newtype HappyWrap160 = HappyWrap160 ((Maybe (EpUniToken "::" "∷"), Maybe (LocatedN RdrName))) -happyIn160 :: ((Maybe (EpUniToken "::" "∷"), Maybe (LocatedN RdrName))) -> (HappyAbsSyn ) -happyIn160 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap160 x) -{-# INLINE happyIn160 #-} -happyOut160 :: (HappyAbsSyn ) -> HappyWrap160 -happyOut160 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut160 #-} -newtype HappyWrap161 = HappyWrap161 (LHsSigType GhcPs) -happyIn161 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) -happyIn161 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap161 x) -{-# INLINE happyIn161 #-} -happyOut161 :: (HappyAbsSyn ) -> HappyWrap161 -happyOut161 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut161 #-} -newtype HappyWrap162 = HappyWrap162 (LHsSigType GhcPs) -happyIn162 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) -happyIn162 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap162 x) -{-# INLINE happyIn162 #-} -happyOut162 :: (HappyAbsSyn ) -> HappyWrap162 -happyOut162 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut162 #-} -newtype HappyWrap163 = HappyWrap163 (Located [LocatedN RdrName]) -happyIn163 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn163 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap163 x) -{-# INLINE happyIn163 #-} -happyOut163 :: (HappyAbsSyn ) -> HappyWrap163 -happyOut163 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut163 #-} -newtype HappyWrap164 = HappyWrap164 (OrdList (LHsSigType GhcPs)) -happyIn164 :: (OrdList (LHsSigType GhcPs)) -> (HappyAbsSyn ) -happyIn164 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap164 x) -{-# INLINE happyIn164 #-} -happyOut164 :: (HappyAbsSyn ) -> HappyWrap164 -happyOut164 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut164 #-} -newtype HappyWrap165 = HappyWrap165 (Located UnpackednessPragma) -happyIn165 :: (Located UnpackednessPragma) -> (HappyAbsSyn ) -happyIn165 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap165 x) -{-# INLINE happyIn165 #-} -happyOut165 :: (HappyAbsSyn ) -> HappyWrap165 -happyOut165 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut165 #-} -newtype HappyWrap166 = HappyWrap166 (Located (HsForAllTelescope GhcPs)) -happyIn166 :: (Located (HsForAllTelescope GhcPs)) -> (HappyAbsSyn ) -happyIn166 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap166 x) -{-# INLINE happyIn166 #-} -happyOut166 :: (HappyAbsSyn ) -> HappyWrap166 -happyOut166 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut166 #-} -newtype HappyWrap167 = HappyWrap167 (LHsType GhcPs) -happyIn167 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn167 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap167 x) -{-# INLINE happyIn167 #-} -happyOut167 :: (HappyAbsSyn ) -> HappyWrap167 -happyOut167 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut167 #-} -newtype HappyWrap168 = HappyWrap168 (LHsType GhcPs) -happyIn168 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn168 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap168 x) -{-# INLINE happyIn168 #-} -happyOut168 :: (HappyAbsSyn ) -> HappyWrap168 -happyOut168 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut168 #-} -newtype HappyWrap169 = HappyWrap169 (LHsContext GhcPs) -happyIn169 :: (LHsContext GhcPs) -> (HappyAbsSyn ) -happyIn169 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap169 x) -{-# INLINE happyIn169 #-} -happyOut169 :: (HappyAbsSyn ) -> HappyWrap169 -happyOut169 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut169 #-} -newtype HappyWrap170 = HappyWrap170 (forall b. DisambECP b => PV (LocatedC [LocatedA b])) -happyIn170 :: (forall b. DisambECP b => PV (LocatedC [LocatedA b])) -> (HappyAbsSyn ) -happyIn170 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap170 x) -{-# INLINE happyIn170 #-} -happyOut170 :: (HappyAbsSyn ) -> HappyWrap170 -happyOut170 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut170 #-} -newtype HappyWrap171 = HappyWrap171 (LHsType GhcPs) -happyIn171 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn171 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap171 x) -{-# INLINE happyIn171 #-} -happyOut171 :: (HappyAbsSyn ) -> HappyWrap171 -happyOut171 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut171 #-} -newtype HappyWrap172 = HappyWrap172 (Located (EpUniToken "->" "\8594" -> HsArrow GhcPs)) -happyIn172 :: (Located (EpUniToken "->" "\8594" -> HsArrow GhcPs)) -> (HappyAbsSyn ) -happyIn172 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap172 x) -{-# INLINE happyIn172 #-} -happyOut172 :: (HappyAbsSyn ) -> HappyWrap172 -happyOut172 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut172 #-} -newtype HappyWrap173 = HappyWrap173 (forall b. DisambECP b => PV (Located (EpUniToken "->" "\8594" -> HsArrowOf (LocatedA b) GhcPs))) -happyIn173 :: (forall b. DisambECP b => PV (Located (EpUniToken "->" "\8594" -> HsArrowOf (LocatedA b) GhcPs))) -> (HappyAbsSyn ) -happyIn173 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap173 x) -{-# INLINE happyIn173 #-} -happyOut173 :: (HappyAbsSyn ) -> HappyWrap173 -happyOut173 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut173 #-} -newtype HappyWrap174 = HappyWrap174 (LHsType GhcPs) -happyIn174 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn174 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap174 x) -{-# INLINE happyIn174 #-} -happyOut174 :: (HappyAbsSyn ) -> HappyWrap174 -happyOut174 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut174 #-} -newtype HappyWrap175 = HappyWrap175 (forall b. DisambTD b => PV (LocatedA b)) -happyIn175 :: (forall b. DisambTD b => PV (LocatedA b)) -> (HappyAbsSyn ) -happyIn175 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap175 x) -{-# INLINE happyIn175 #-} -happyOut175 :: (HappyAbsSyn ) -> HappyWrap175 -happyOut175 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut175 #-} -newtype HappyWrap176 = HappyWrap176 (forall b. DisambTD b => PV (LocatedA b)) -happyIn176 :: (forall b. DisambTD b => PV (LocatedA b)) -> (HappyAbsSyn ) -happyIn176 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap176 x) -{-# INLINE happyIn176 #-} -happyOut176 :: (HappyAbsSyn ) -> HappyWrap176 -happyOut176 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut176 #-} -newtype HappyWrap177 = HappyWrap177 (LHsType GhcPs) -happyIn177 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn177 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap177 x) -{-# INLINE happyIn177 #-} -happyOut177 :: (HappyAbsSyn ) -> HappyWrap177 -happyOut177 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut177 #-} -newtype HappyWrap178 = HappyWrap178 ((LocatedN RdrName, PromotionFlag)) -happyIn178 :: ((LocatedN RdrName, PromotionFlag)) -> (HappyAbsSyn ) -happyIn178 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap178 x) -{-# INLINE happyIn178 #-} -happyOut178 :: (HappyAbsSyn ) -> HappyWrap178 -happyOut178 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut178 #-} -newtype HappyWrap179 = HappyWrap179 (LHsType GhcPs) -happyIn179 :: (LHsType GhcPs) -> (HappyAbsSyn ) -happyIn179 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap179 x) -{-# INLINE happyIn179 #-} -happyOut179 :: (HappyAbsSyn ) -> HappyWrap179 -happyOut179 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut179 #-} -newtype HappyWrap180 = HappyWrap180 (LHsSigType GhcPs) -happyIn180 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) -happyIn180 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap180 x) -{-# INLINE happyIn180 #-} -happyOut180 :: (HappyAbsSyn ) -> HappyWrap180 -happyOut180 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut180 #-} -newtype HappyWrap181 = HappyWrap181 ([LHsSigType GhcPs]) -happyIn181 :: ([LHsSigType GhcPs]) -> (HappyAbsSyn ) -happyIn181 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap181 x) -{-# INLINE happyIn181 #-} -happyOut181 :: (HappyAbsSyn ) -> HappyWrap181 -happyOut181 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut181 #-} -newtype HappyWrap182 = HappyWrap182 ([LHsType GhcPs]) -happyIn182 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) -happyIn182 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap182 x) -{-# INLINE happyIn182 #-} -happyOut182 :: (HappyAbsSyn ) -> HappyWrap182 -happyOut182 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut182 #-} -newtype HappyWrap183 = HappyWrap183 ([LHsType GhcPs]) -happyIn183 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) -happyIn183 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap183 x) -{-# INLINE happyIn183 #-} -happyOut183 :: (HappyAbsSyn ) -> HappyWrap183 -happyOut183 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut183 #-} -newtype HappyWrap184 = HappyWrap184 ([LHsType GhcPs]) -happyIn184 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) -happyIn184 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap184 x) -{-# INLINE happyIn184 #-} -happyOut184 :: (HappyAbsSyn ) -> HappyWrap184 -happyOut184 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut184 #-} -newtype HappyWrap185 = HappyWrap185 ([LHsTyVarBndr Specificity GhcPs]) -happyIn185 :: ([LHsTyVarBndr Specificity GhcPs]) -> (HappyAbsSyn ) -happyIn185 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap185 x) -{-# INLINE happyIn185 #-} -happyOut185 :: (HappyAbsSyn ) -> HappyWrap185 -happyOut185 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut185 #-} -newtype HappyWrap186 = HappyWrap186 (LHsTyVarBndr Specificity GhcPs) -happyIn186 :: (LHsTyVarBndr Specificity GhcPs) -> (HappyAbsSyn ) -happyIn186 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap186 x) -{-# INLINE happyIn186 #-} -happyOut186 :: (HappyAbsSyn ) -> HappyWrap186 -happyOut186 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut186 #-} -newtype HappyWrap187 = HappyWrap187 (LHsTyVarBndr Specificity GhcPs) -happyIn187 :: (LHsTyVarBndr Specificity GhcPs) -> (HappyAbsSyn ) -happyIn187 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap187 x) -{-# INLINE happyIn187 #-} -happyOut187 :: (HappyAbsSyn ) -> HappyWrap187 -happyOut187 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut187 #-} -newtype HappyWrap188 = HappyWrap188 (Located (HsBndrVar GhcPs)) -happyIn188 :: (Located (HsBndrVar GhcPs)) -> (HappyAbsSyn ) -happyIn188 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap188 x) -{-# INLINE happyIn188 #-} -happyOut188 :: (HappyAbsSyn ) -> HappyWrap188 -happyOut188 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut188 #-} -newtype HappyWrap189 = HappyWrap189 (Located (EpToken "|",[LHsFunDep GhcPs])) -happyIn189 :: (Located (EpToken "|",[LHsFunDep GhcPs])) -> (HappyAbsSyn ) -happyIn189 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap189 x) -{-# INLINE happyIn189 #-} -happyOut189 :: (HappyAbsSyn ) -> HappyWrap189 -happyOut189 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut189 #-} -newtype HappyWrap190 = HappyWrap190 (Located [LHsFunDep GhcPs]) -happyIn190 :: (Located [LHsFunDep GhcPs]) -> (HappyAbsSyn ) -happyIn190 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap190 x) -{-# INLINE happyIn190 #-} -happyOut190 :: (HappyAbsSyn ) -> HappyWrap190 -happyOut190 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut190 #-} -newtype HappyWrap191 = HappyWrap191 (LHsFunDep GhcPs) -happyIn191 :: (LHsFunDep GhcPs) -> (HappyAbsSyn ) -happyIn191 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap191 x) -{-# INLINE happyIn191 #-} -happyOut191 :: (HappyAbsSyn ) -> HappyWrap191 -happyOut191 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut191 #-} -newtype HappyWrap192 = HappyWrap192 (Located [LocatedN RdrName]) -happyIn192 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn192 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap192 x) -{-# INLINE happyIn192 #-} -happyOut192 :: (HappyAbsSyn ) -> HappyWrap192 -happyOut192 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut192 #-} -newtype HappyWrap193 = HappyWrap193 (LHsKind GhcPs) -happyIn193 :: (LHsKind GhcPs) -> (HappyAbsSyn ) -happyIn193 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap193 x) -{-# INLINE happyIn193 #-} -happyOut193 :: (HappyAbsSyn ) -> HappyWrap193 -happyOut193 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut193 #-} -newtype HappyWrap194 = HappyWrap194 (Located ((EpToken "where", EpToken "{", EpToken "}") - ,[LConDecl GhcPs])) -happyIn194 :: (Located ((EpToken "where", EpToken "{", EpToken "}") - ,[LConDecl GhcPs])) -> (HappyAbsSyn ) -happyIn194 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap194 x) -{-# INLINE happyIn194 #-} -happyOut194 :: (HappyAbsSyn ) -> HappyWrap194 -happyOut194 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut194 #-} -newtype HappyWrap195 = HappyWrap195 (Located [LConDecl GhcPs]) -happyIn195 :: (Located [LConDecl GhcPs]) -> (HappyAbsSyn ) -happyIn195 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap195 x) -{-# INLINE happyIn195 #-} -happyOut195 :: (HappyAbsSyn ) -> HappyWrap195 -happyOut195 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut195 #-} -newtype HappyWrap196 = HappyWrap196 (LConDecl GhcPs) -happyIn196 :: (LConDecl GhcPs) -> (HappyAbsSyn ) -happyIn196 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap196 x) -{-# INLINE happyIn196 #-} -happyOut196 :: (HappyAbsSyn ) -> HappyWrap196 -happyOut196 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut196 #-} -newtype HappyWrap197 = HappyWrap197 (Located (EpToken "=",[LConDecl GhcPs])) -happyIn197 :: (Located (EpToken "=",[LConDecl GhcPs])) -> (HappyAbsSyn ) -happyIn197 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap197 x) -{-# INLINE happyIn197 #-} -happyOut197 :: (HappyAbsSyn ) -> HappyWrap197 -happyOut197 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut197 #-} -newtype HappyWrap198 = HappyWrap198 (Located [LConDecl GhcPs]) -happyIn198 :: (Located [LConDecl GhcPs]) -> (HappyAbsSyn ) -happyIn198 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap198 x) -{-# INLINE happyIn198 #-} -happyOut198 :: (HappyAbsSyn ) -> HappyWrap198 -happyOut198 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut198 #-} -newtype HappyWrap199 = HappyWrap199 (LConDecl GhcPs) -happyIn199 :: (LConDecl GhcPs) -> (HappyAbsSyn ) -happyIn199 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap199 x) -{-# INLINE happyIn199 #-} -happyOut199 :: (HappyAbsSyn ) -> HappyWrap199 -happyOut199 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut199 #-} -newtype HappyWrap200 = HappyWrap200 (Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs])) -happyIn200 :: (Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs])) -> (HappyAbsSyn ) -happyIn200 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap200 x) -{-# INLINE happyIn200 #-} -happyOut200 :: (HappyAbsSyn ) -> HappyWrap200 -happyOut200 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut200 #-} -newtype HappyWrap201 = HappyWrap201 (Located (LocatedN RdrName, HsConDeclH98Details GhcPs)) -happyIn201 :: (Located (LocatedN RdrName, HsConDeclH98Details GhcPs)) -> (HappyAbsSyn ) -happyIn201 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap201 x) -{-# INLINE happyIn201 #-} -happyOut201 :: (HappyAbsSyn ) -> HappyWrap201 -happyOut201 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut201 #-} -newtype HappyWrap202 = HappyWrap202 ((LHsType GhcPs, Int, Int)) -happyIn202 :: ((LHsType GhcPs, Int, Int)) -> (HappyAbsSyn ) -happyIn202 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap202 x) -{-# INLINE happyIn202 #-} -happyOut202 :: (HappyAbsSyn ) -> HappyWrap202 -happyOut202 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut202 #-} -newtype HappyWrap203 = HappyWrap203 ([LConDeclField GhcPs]) -happyIn203 :: ([LConDeclField GhcPs]) -> (HappyAbsSyn ) -happyIn203 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap203 x) -{-# INLINE happyIn203 #-} -happyOut203 :: (HappyAbsSyn ) -> HappyWrap203 -happyOut203 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut203 #-} -newtype HappyWrap204 = HappyWrap204 ([LConDeclField GhcPs]) -happyIn204 :: ([LConDeclField GhcPs]) -> (HappyAbsSyn ) -happyIn204 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap204 x) -{-# INLINE happyIn204 #-} -happyOut204 :: (HappyAbsSyn ) -> HappyWrap204 -happyOut204 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut204 #-} -newtype HappyWrap205 = HappyWrap205 (LConDeclField GhcPs) -happyIn205 :: (LConDeclField GhcPs) -> (HappyAbsSyn ) -happyIn205 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap205 x) -{-# INLINE happyIn205 #-} -happyOut205 :: (HappyAbsSyn ) -> HappyWrap205 -happyOut205 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut205 #-} -newtype HappyWrap206 = HappyWrap206 (Located (HsDeriving GhcPs)) -happyIn206 :: (Located (HsDeriving GhcPs)) -> (HappyAbsSyn ) -happyIn206 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap206 x) -{-# INLINE happyIn206 #-} -happyOut206 :: (HappyAbsSyn ) -> HappyWrap206 -happyOut206 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut206 #-} -newtype HappyWrap207 = HappyWrap207 (Located (HsDeriving GhcPs)) -happyIn207 :: (Located (HsDeriving GhcPs)) -> (HappyAbsSyn ) -happyIn207 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap207 x) -{-# INLINE happyIn207 #-} -happyOut207 :: (HappyAbsSyn ) -> HappyWrap207 -happyOut207 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut207 #-} -newtype HappyWrap208 = HappyWrap208 (LHsDerivingClause GhcPs) -happyIn208 :: (LHsDerivingClause GhcPs) -> (HappyAbsSyn ) -happyIn208 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap208 x) -{-# INLINE happyIn208 #-} -happyOut208 :: (HappyAbsSyn ) -> HappyWrap208 -happyOut208 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut208 #-} -newtype HappyWrap209 = HappyWrap209 (LDerivClauseTys GhcPs) -happyIn209 :: (LDerivClauseTys GhcPs) -> (HappyAbsSyn ) -happyIn209 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap209 x) -{-# INLINE happyIn209 #-} -happyOut209 :: (HappyAbsSyn ) -> HappyWrap209 -happyOut209 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut209 #-} -newtype HappyWrap210 = HappyWrap210 (LHsDecl GhcPs) -happyIn210 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn210 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap210 x) -{-# INLINE happyIn210 #-} -happyOut210 :: (HappyAbsSyn ) -> HappyWrap210 -happyOut210 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut210 #-} -newtype HappyWrap211 = HappyWrap211 (LHsDecl GhcPs) -happyIn211 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn211 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap211 x) -{-# INLINE happyIn211 #-} -happyOut211 :: (HappyAbsSyn ) -> HappyWrap211 -happyOut211 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut211 #-} -newtype HappyWrap212 = HappyWrap212 (Located (GRHSs GhcPs (LHsExpr GhcPs))) -happyIn212 :: (Located (GRHSs GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) -happyIn212 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap212 x) -{-# INLINE happyIn212 #-} -happyOut212 :: (HappyAbsSyn ) -> HappyWrap212 -happyOut212 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut212 #-} -newtype HappyWrap213 = HappyWrap213 (Located [LGRHS GhcPs (LHsExpr GhcPs)]) -happyIn213 :: (Located [LGRHS GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) -happyIn213 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap213 x) -{-# INLINE happyIn213 #-} -happyOut213 :: (HappyAbsSyn ) -> HappyWrap213 -happyOut213 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut213 #-} -newtype HappyWrap214 = HappyWrap214 (LGRHS GhcPs (LHsExpr GhcPs)) -happyIn214 :: (LGRHS GhcPs (LHsExpr GhcPs)) -> (HappyAbsSyn ) -happyIn214 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap214 x) -{-# INLINE happyIn214 #-} -happyOut214 :: (HappyAbsSyn ) -> HappyWrap214 -happyOut214 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut214 #-} -newtype HappyWrap215 = HappyWrap215 (LHsDecl GhcPs) -happyIn215 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) -happyIn215 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap215 x) -{-# INLINE happyIn215 #-} -happyOut215 :: (HappyAbsSyn ) -> HappyWrap215 -happyOut215 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut215 #-} -newtype HappyWrap216 = HappyWrap216 ((ActivationAnn,Maybe Activation)) -happyIn216 :: ((ActivationAnn,Maybe Activation)) -> (HappyAbsSyn ) -happyIn216 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap216 x) -{-# INLINE happyIn216 #-} -happyOut216 :: (HappyAbsSyn ) -> HappyWrap216 -happyOut216 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut216 #-} -newtype HappyWrap217 = HappyWrap217 ((ActivationAnn, Activation)) -happyIn217 :: ((ActivationAnn, Activation)) -> (HappyAbsSyn ) -happyIn217 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap217 x) -{-# INLINE happyIn217 #-} -happyOut217 :: (HappyAbsSyn ) -> HappyWrap217 -happyOut217 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut217 #-} -newtype HappyWrap218 = HappyWrap218 (Located (HsUntypedSplice GhcPs)) -happyIn218 :: (Located (HsUntypedSplice GhcPs)) -> (HappyAbsSyn ) -happyIn218 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap218 x) -{-# INLINE happyIn218 #-} -happyOut218 :: (HappyAbsSyn ) -> HappyWrap218 -happyOut218 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut218 #-} -newtype HappyWrap219 = HappyWrap219 (ECP) -happyIn219 :: (ECP) -> (HappyAbsSyn ) -happyIn219 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap219 x) -{-# INLINE happyIn219 #-} -happyOut219 :: (HappyAbsSyn ) -> HappyWrap219 -happyOut219 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut219 #-} -newtype HappyWrap220 = HappyWrap220 (ECP) -happyIn220 :: (ECP) -> (HappyAbsSyn ) -happyIn220 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap220 x) -{-# INLINE happyIn220 #-} -happyOut220 :: (HappyAbsSyn ) -> HappyWrap220 -happyOut220 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut220 #-} -newtype HappyWrap221 = HappyWrap221 (ECP) -happyIn221 :: (ECP) -> (HappyAbsSyn ) -happyIn221 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap221 x) -{-# INLINE happyIn221 #-} -happyOut221 :: (HappyAbsSyn ) -> HappyWrap221 -happyOut221 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut221 #-} -newtype HappyWrap222 = HappyWrap222 (ECP) -happyIn222 :: (ECP) -> (HappyAbsSyn ) -happyIn222 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap222 x) -{-# INLINE happyIn222 #-} -happyOut222 :: (HappyAbsSyn ) -> HappyWrap222 -happyOut222 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut222 #-} -newtype HappyWrap223 = HappyWrap223 (ECP) -happyIn223 :: (ECP) -> (HappyAbsSyn ) -happyIn223 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap223 x) -{-# INLINE happyIn223 #-} -happyOut223 :: (HappyAbsSyn ) -> HappyWrap223 -happyOut223 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut223 #-} -newtype HappyWrap224 = HappyWrap224 (ECP) -happyIn224 :: (ECP) -> (HappyAbsSyn ) -happyIn224 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap224 x) -{-# INLINE happyIn224 #-} -happyOut224 :: (HappyAbsSyn ) -> HappyWrap224 -happyOut224 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut224 #-} -newtype HappyWrap225 = HappyWrap225 ((Maybe (EpToken ";"),Bool)) -happyIn225 :: ((Maybe (EpToken ";"),Bool)) -> (HappyAbsSyn ) -happyIn225 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap225 x) -{-# INLINE happyIn225 #-} -happyOut225 :: (HappyAbsSyn ) -> HappyWrap225 -happyOut225 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut225 #-} -newtype HappyWrap226 = HappyWrap226 (Located (HsPragE GhcPs)) -happyIn226 :: (Located (HsPragE GhcPs)) -> (HappyAbsSyn ) -happyIn226 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap226 x) -{-# INLINE happyIn226 #-} -happyOut226 :: (HappyAbsSyn ) -> HappyWrap226 -happyOut226 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut226 #-} -newtype HappyWrap227 = HappyWrap227 (ECP) -happyIn227 :: (ECP) -> (HappyAbsSyn ) -happyIn227 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap227 x) -{-# INLINE happyIn227 #-} -happyOut227 :: (HappyAbsSyn ) -> HappyWrap227 -happyOut227 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut227 #-} -newtype HappyWrap228 = HappyWrap228 (ECP) -happyIn228 :: (ECP) -> (HappyAbsSyn ) -happyIn228 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap228 x) -{-# INLINE happyIn228 #-} -happyOut228 :: (HappyAbsSyn ) -> HappyWrap228 -happyOut228 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut228 #-} -newtype HappyWrap229 = HappyWrap229 (ECP) -happyIn229 :: (ECP) -> (HappyAbsSyn ) -happyIn229 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap229 x) -{-# INLINE happyIn229 #-} -happyOut229 :: (HappyAbsSyn ) -> HappyWrap229 -happyOut229 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut229 #-} -newtype HappyWrap230 = HappyWrap230 (ECP) -happyIn230 :: (ECP) -> (HappyAbsSyn ) -happyIn230 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap230 x) -{-# INLINE happyIn230 #-} -happyOut230 :: (HappyAbsSyn ) -> HappyWrap230 -happyOut230 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut230 #-} -newtype HappyWrap231 = HappyWrap231 (Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)))) -happyIn231 :: (Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)))) -> (HappyAbsSyn ) -happyIn231 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap231 x) -{-# INLINE happyIn231 #-} -happyOut231 :: (HappyAbsSyn ) -> HappyWrap231 -happyOut231 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut231 #-} -newtype HappyWrap232 = HappyWrap232 (LHsExpr GhcPs) -happyIn232 :: (LHsExpr GhcPs) -> (HappyAbsSyn ) -happyIn232 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap232 x) -{-# INLINE happyIn232 #-} -happyOut232 :: (HappyAbsSyn ) -> HappyWrap232 -happyOut232 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut232 #-} -newtype HappyWrap233 = HappyWrap233 (Located (HsUntypedSplice GhcPs)) -happyIn233 :: (Located (HsUntypedSplice GhcPs)) -> (HappyAbsSyn ) -happyIn233 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap233 x) -{-# INLINE happyIn233 #-} -happyOut233 :: (HappyAbsSyn ) -> HappyWrap233 -happyOut233 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut233 #-} -newtype HappyWrap234 = HappyWrap234 (Located (EpToken "$$", LHsExpr GhcPs)) -happyIn234 :: (Located (EpToken "$$", LHsExpr GhcPs)) -> (HappyAbsSyn ) -happyIn234 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap234 x) -{-# INLINE happyIn234 #-} -happyOut234 :: (HappyAbsSyn ) -> HappyWrap234 -happyOut234 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut234 #-} -newtype HappyWrap235 = HappyWrap235 ([LHsCmdTop GhcPs]) -happyIn235 :: ([LHsCmdTop GhcPs]) -> (HappyAbsSyn ) -happyIn235 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap235 x) -{-# INLINE happyIn235 #-} -happyOut235 :: (HappyAbsSyn ) -> HappyWrap235 -happyOut235 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut235 #-} -newtype HappyWrap236 = HappyWrap236 (LHsCmdTop GhcPs) -happyIn236 :: (LHsCmdTop GhcPs) -> (HappyAbsSyn ) -happyIn236 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap236 x) -{-# INLINE happyIn236 #-} -happyOut236 :: (HappyAbsSyn ) -> HappyWrap236 -happyOut236 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut236 #-} -newtype HappyWrap237 = HappyWrap237 (((EpToken "{", EpToken "}"),[LHsDecl GhcPs])) -happyIn237 :: (((EpToken "{", EpToken "}"),[LHsDecl GhcPs])) -> (HappyAbsSyn ) -happyIn237 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap237 x) -{-# INLINE happyIn237 #-} -happyOut237 :: (HappyAbsSyn ) -> HappyWrap237 -happyOut237 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut237 #-} -newtype HappyWrap238 = HappyWrap238 ([LHsDecl GhcPs]) -happyIn238 :: ([LHsDecl GhcPs]) -> (HappyAbsSyn ) -happyIn238 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap238 x) -{-# INLINE happyIn238 #-} -happyOut238 :: (HappyAbsSyn ) -> HappyWrap238 -happyOut238 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut238 #-} -newtype HappyWrap239 = HappyWrap239 (ECP) -happyIn239 :: (ECP) -> (HappyAbsSyn ) -happyIn239 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap239 x) -{-# INLINE happyIn239 #-} -happyOut239 :: (HappyAbsSyn ) -> HappyWrap239 -happyOut239 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut239 #-} -newtype HappyWrap240 = HappyWrap240 (forall b. DisambECP b => PV (SumOrTuple b)) -happyIn240 :: (forall b. DisambECP b => PV (SumOrTuple b)) -> (HappyAbsSyn ) -happyIn240 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap240 x) -{-# INLINE happyIn240 #-} -happyOut240 :: (HappyAbsSyn ) -> HappyWrap240 -happyOut240 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut240 #-} -newtype HappyWrap241 = HappyWrap241 (forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)])) -happyIn241 :: (forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)])) -> (HappyAbsSyn ) -happyIn241 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap241 x) -{-# INLINE happyIn241 #-} -happyOut241 :: (HappyAbsSyn ) -> HappyWrap241 -happyOut241 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut241 #-} -newtype HappyWrap242 = HappyWrap242 (forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)]) -happyIn242 :: (forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)]) -> (HappyAbsSyn ) -happyIn242 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap242 x) -{-# INLINE happyIn242 #-} -happyOut242 :: (HappyAbsSyn ) -> HappyWrap242 -happyOut242 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut242 #-} -newtype HappyWrap243 = HappyWrap243 (forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b)) -happyIn243 :: (forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b)) -> (HappyAbsSyn ) -happyIn243 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap243 x) -{-# INLINE happyIn243 #-} -happyOut243 :: (HappyAbsSyn ) -> HappyWrap243 -happyOut243 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut243 #-} -newtype HappyWrap244 = HappyWrap244 (forall b. DisambECP b => PV [LocatedA b]) -happyIn244 :: (forall b. DisambECP b => PV [LocatedA b]) -> (HappyAbsSyn ) -happyIn244 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap244 x) -{-# INLINE happyIn244 #-} -happyOut244 :: (HappyAbsSyn ) -> HappyWrap244 -happyOut244 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut244 #-} -newtype HappyWrap245 = HappyWrap245 (Located [LStmt GhcPs (LHsExpr GhcPs)]) -happyIn245 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) -happyIn245 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap245 x) -{-# INLINE happyIn245 #-} -happyOut245 :: (HappyAbsSyn ) -> HappyWrap245 -happyOut245 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut245 #-} -newtype HappyWrap246 = HappyWrap246 (Located [[LStmt GhcPs (LHsExpr GhcPs)]]) -happyIn246 :: (Located [[LStmt GhcPs (LHsExpr GhcPs)]]) -> (HappyAbsSyn ) -happyIn246 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap246 x) -{-# INLINE happyIn246 #-} -happyOut246 :: (HappyAbsSyn ) -> HappyWrap246 -happyOut246 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut246 #-} -newtype HappyWrap247 = HappyWrap247 (Located [LStmt GhcPs (LHsExpr GhcPs)]) -happyIn247 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) -happyIn247 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap247 x) -{-# INLINE happyIn247 #-} -happyOut247 :: (HappyAbsSyn ) -> HappyWrap247 -happyOut247 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut247 #-} -newtype HappyWrap248 = HappyWrap248 (Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs))) -happyIn248 :: (Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) -happyIn248 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap248 x) -{-# INLINE happyIn248 #-} -happyOut248 :: (HappyAbsSyn ) -> HappyWrap248 -happyOut248 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut248 #-} -newtype HappyWrap249 = HappyWrap249 (Located [LStmt GhcPs (LHsExpr GhcPs)]) -happyIn249 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) -happyIn249 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap249 x) -{-# INLINE happyIn249 #-} -happyOut249 :: (HappyAbsSyn ) -> HappyWrap249 -happyOut249 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut249 #-} -newtype HappyWrap250 = HappyWrap250 (Located [LStmt GhcPs (LHsExpr GhcPs)]) -happyIn250 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) -happyIn250 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap250 x) -{-# INLINE happyIn250 #-} -happyOut250 :: (HappyAbsSyn ) -> HappyWrap250 -happyOut250 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut250 #-} -newtype HappyWrap251 = HappyWrap251 (forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b)))) -happyIn251 :: (forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b)))) -> (HappyAbsSyn ) -happyIn251 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap251 x) -{-# INLINE happyIn251 #-} -happyOut251 :: (HappyAbsSyn ) -> HappyWrap251 -happyOut251 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut251 #-} -newtype HappyWrap252 = HappyWrap252 (forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)])) -happyIn252 :: (forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)])) -> (HappyAbsSyn ) -happyIn252 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap252 x) -{-# INLINE happyIn252 #-} -happyOut252 :: (HappyAbsSyn ) -> HappyWrap252 -happyOut252 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut252 #-} -newtype HappyWrap253 = HappyWrap253 (forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)])) -happyIn253 :: (forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)])) -> (HappyAbsSyn ) -happyIn253 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap253 x) -{-# INLINE happyIn253 #-} -happyOut253 :: (HappyAbsSyn ) -> HappyWrap253 -happyOut253 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut253 #-} -newtype HappyWrap254 = HappyWrap254 (Located ((EpToken "{", EpToken "}"), [LGRHS GhcPs (LHsExpr GhcPs)])) -happyIn254 :: (Located ((EpToken "{", EpToken "}"), [LGRHS GhcPs (LHsExpr GhcPs)])) -> (HappyAbsSyn ) -happyIn254 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap254 x) -{-# INLINE happyIn254 #-} -happyOut254 :: (HappyAbsSyn ) -> HappyWrap254 -happyOut254 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut254 #-} -newtype HappyWrap255 = HappyWrap255 (forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b))) -happyIn255 :: (forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b))) -> (HappyAbsSyn ) -happyIn255 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap255 x) -{-# INLINE happyIn255 #-} -happyOut255 :: (HappyAbsSyn ) -> HappyWrap255 -happyOut255 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut255 #-} -newtype HappyWrap256 = HappyWrap256 (LPat GhcPs) -happyIn256 :: (LPat GhcPs) -> (HappyAbsSyn ) -happyIn256 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap256 x) -{-# INLINE happyIn256 #-} -happyOut256 :: (HappyAbsSyn ) -> HappyWrap256 -happyOut256 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut256 #-} -newtype HappyWrap257 = HappyWrap257 (LPat GhcPs) -happyIn257 :: (LPat GhcPs) -> (HappyAbsSyn ) -happyIn257 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap257 x) -{-# INLINE happyIn257 #-} -happyOut257 :: (HappyAbsSyn ) -> HappyWrap257 -happyOut257 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut257 #-} -newtype HappyWrap258 = HappyWrap258 ([LPat GhcPs]) -happyIn258 :: ([LPat GhcPs]) -> (HappyAbsSyn ) -happyIn258 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap258 x) -{-# INLINE happyIn258 #-} -happyOut258 :: (HappyAbsSyn ) -> HappyWrap258 -happyOut258 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut258 #-} -newtype HappyWrap259 = HappyWrap259 (LPat GhcPs) -happyIn259 :: (LPat GhcPs) -> (HappyAbsSyn ) -happyIn259 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap259 x) -{-# INLINE happyIn259 #-} -happyOut259 :: (HappyAbsSyn ) -> HappyWrap259 -happyOut259 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut259 #-} -newtype HappyWrap260 = HappyWrap260 (LPat GhcPs) -happyIn260 :: (LPat GhcPs) -> (HappyAbsSyn ) -happyIn260 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap260 x) -{-# INLINE happyIn260 #-} -happyOut260 :: (HappyAbsSyn ) -> HappyWrap260 -happyOut260 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut260 #-} -newtype HappyWrap261 = HappyWrap261 ([LPat GhcPs]) -happyIn261 :: ([LPat GhcPs]) -> (HappyAbsSyn ) -happyIn261 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap261 x) -{-# INLINE happyIn261 #-} -happyOut261 :: (HappyAbsSyn ) -> HappyWrap261 -happyOut261 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut261 #-} -newtype HappyWrap262 = HappyWrap262 (LPat GhcPs) -happyIn262 :: (LPat GhcPs) -> (HappyAbsSyn ) -happyIn262 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap262 x) -{-# INLINE happyIn262 #-} -happyOut262 :: (HappyAbsSyn ) -> HappyWrap262 -happyOut262 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut262 #-} -newtype HappyWrap263 = HappyWrap263 (forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))])) -happyIn263 :: (forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))])) -> (HappyAbsSyn ) -happyIn263 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap263 x) -{-# INLINE happyIn263 #-} -happyOut263 :: (HappyAbsSyn ) -> HappyWrap263 -happyOut263 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut263 #-} -newtype HappyWrap264 = HappyWrap264 (forall b. DisambECP b => PV (Located (OrdList (EpToken ";"),[LStmt GhcPs (LocatedA b)]))) -happyIn264 :: (forall b. DisambECP b => PV (Located (OrdList (EpToken ";"),[LStmt GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) -happyIn264 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap264 x) -{-# INLINE happyIn264 #-} -happyOut264 :: (HappyAbsSyn ) -> HappyWrap264 -happyOut264 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut264 #-} -newtype HappyWrap265 = HappyWrap265 (Maybe (LStmt GhcPs (LHsExpr GhcPs))) -happyIn265 :: (Maybe (LStmt GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) -happyIn265 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap265 x) -{-# INLINE happyIn265 #-} -happyOut265 :: (HappyAbsSyn ) -> HappyWrap265 -happyOut265 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut265 #-} -newtype HappyWrap266 = HappyWrap266 (LStmt GhcPs (LHsExpr GhcPs)) -happyIn266 :: (LStmt GhcPs (LHsExpr GhcPs)) -> (HappyAbsSyn ) -happyIn266 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap266 x) -{-# INLINE happyIn266 #-} -happyOut266 :: (HappyAbsSyn ) -> HappyWrap266 -happyOut266 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut266 #-} -newtype HappyWrap267 = HappyWrap267 (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -happyIn267 :: (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -> (HappyAbsSyn ) -happyIn267 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap267 x) -{-# INLINE happyIn267 #-} -happyOut267 :: (HappyAbsSyn ) -> HappyWrap267 -happyOut267 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut267 #-} -newtype HappyWrap268 = HappyWrap268 (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -happyIn268 :: (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -> (HappyAbsSyn ) -happyIn268 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap268 x) -{-# INLINE happyIn268 #-} -happyOut268 :: (HappyAbsSyn ) -> HappyWrap268 -happyOut268 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut268 #-} -newtype HappyWrap269 = HappyWrap269 (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -happyIn269 :: (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -> (HappyAbsSyn ) -happyIn269 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap269 x) -{-# INLINE happyIn269 #-} -happyOut269 :: (HappyAbsSyn ) -> HappyWrap269 -happyOut269 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut269 #-} -newtype HappyWrap270 = HappyWrap270 (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -happyIn270 :: (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -> (HappyAbsSyn ) -happyIn270 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap270 x) -{-# INLINE happyIn270 #-} -happyOut270 :: (HappyAbsSyn ) -> HappyWrap270 -happyOut270 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut270 #-} -newtype HappyWrap271 = HappyWrap271 (forall b. DisambECP b => PV (Fbind b)) -happyIn271 :: (forall b. DisambECP b => PV (Fbind b)) -> (HappyAbsSyn ) -happyIn271 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap271 x) -{-# INLINE happyIn271 #-} -happyOut271 :: (HappyAbsSyn ) -> HappyWrap271 -happyOut271 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut271 #-} -newtype HappyWrap272 = HappyWrap272 (Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]) -happyIn272 :: (Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]) -> (HappyAbsSyn ) -happyIn272 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap272 x) -{-# INLINE happyIn272 #-} -happyOut272 :: (HappyAbsSyn ) -> HappyWrap272 -happyOut272 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut272 #-} -newtype HappyWrap273 = HappyWrap273 (Located [LIPBind GhcPs]) -happyIn273 :: (Located [LIPBind GhcPs]) -> (HappyAbsSyn ) -happyIn273 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap273 x) -{-# INLINE happyIn273 #-} -happyOut273 :: (HappyAbsSyn ) -> HappyWrap273 -happyOut273 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut273 #-} -newtype HappyWrap274 = HappyWrap274 (LIPBind GhcPs) -happyIn274 :: (LIPBind GhcPs) -> (HappyAbsSyn ) -happyIn274 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap274 x) -{-# INLINE happyIn274 #-} -happyOut274 :: (HappyAbsSyn ) -> HappyWrap274 -happyOut274 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut274 #-} -newtype HappyWrap275 = HappyWrap275 (Located HsIPName) -happyIn275 :: (Located HsIPName) -> (HappyAbsSyn ) -happyIn275 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap275 x) -{-# INLINE happyIn275 #-} -happyOut275 :: (HappyAbsSyn ) -> HappyWrap275 -happyOut275 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut275 #-} -newtype HappyWrap276 = HappyWrap276 (Located (SourceText, FastString)) -happyIn276 :: (Located (SourceText, FastString)) -> (HappyAbsSyn ) -happyIn276 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap276 x) -{-# INLINE happyIn276 #-} -happyOut276 :: (HappyAbsSyn ) -> HappyWrap276 -happyOut276 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut276 #-} -newtype HappyWrap277 = HappyWrap277 (LBooleanFormula (LocatedN RdrName)) -happyIn277 :: (LBooleanFormula (LocatedN RdrName)) -> (HappyAbsSyn ) -happyIn277 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap277 x) -{-# INLINE happyIn277 #-} -happyOut277 :: (HappyAbsSyn ) -> HappyWrap277 -happyOut277 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut277 #-} -newtype HappyWrap278 = HappyWrap278 (LBooleanFormula (LocatedN RdrName)) -happyIn278 :: (LBooleanFormula (LocatedN RdrName)) -> (HappyAbsSyn ) -happyIn278 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap278 x) -{-# INLINE happyIn278 #-} -happyOut278 :: (HappyAbsSyn ) -> HappyWrap278 -happyOut278 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut278 #-} -newtype HappyWrap279 = HappyWrap279 (LBooleanFormula (LocatedN RdrName)) -happyIn279 :: (LBooleanFormula (LocatedN RdrName)) -> (HappyAbsSyn ) -happyIn279 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap279 x) -{-# INLINE happyIn279 #-} -happyOut279 :: (HappyAbsSyn ) -> HappyWrap279 -happyOut279 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut279 #-} -newtype HappyWrap280 = HappyWrap280 ([LBooleanFormula (LocatedN RdrName)]) -happyIn280 :: ([LBooleanFormula (LocatedN RdrName)]) -> (HappyAbsSyn ) -happyIn280 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap280 x) -{-# INLINE happyIn280 #-} -happyOut280 :: (HappyAbsSyn ) -> HappyWrap280 -happyOut280 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut280 #-} -newtype HappyWrap281 = HappyWrap281 (LBooleanFormula (LocatedN RdrName)) -happyIn281 :: (LBooleanFormula (LocatedN RdrName)) -> (HappyAbsSyn ) -happyIn281 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap281 x) -{-# INLINE happyIn281 #-} -happyOut281 :: (HappyAbsSyn ) -> HappyWrap281 -happyOut281 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut281 #-} -newtype HappyWrap282 = HappyWrap282 (Located [LocatedN RdrName]) -happyIn282 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn282 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap282 x) -{-# INLINE happyIn282 #-} -happyOut282 :: (HappyAbsSyn ) -> HappyWrap282 -happyOut282 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut282 #-} -newtype HappyWrap283 = HappyWrap283 (LocatedN RdrName) -happyIn283 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn283 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap283 x) -{-# INLINE happyIn283 #-} -happyOut283 :: (HappyAbsSyn ) -> HappyWrap283 -happyOut283 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut283 #-} -newtype HappyWrap284 = HappyWrap284 (LocatedN RdrName) -happyIn284 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn284 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap284 x) -{-# INLINE happyIn284 #-} -happyOut284 :: (HappyAbsSyn ) -> HappyWrap284 -happyOut284 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut284 #-} -newtype HappyWrap285 = HappyWrap285 (LocatedN RdrName) -happyIn285 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn285 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap285 x) -{-# INLINE happyIn285 #-} -happyOut285 :: (HappyAbsSyn ) -> HappyWrap285 -happyOut285 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut285 #-} -newtype HappyWrap286 = HappyWrap286 (LocatedN RdrName) -happyIn286 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn286 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap286 x) -{-# INLINE happyIn286 #-} -happyOut286 :: (HappyAbsSyn ) -> HappyWrap286 -happyOut286 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut286 #-} -newtype HappyWrap287 = HappyWrap287 (Located (NonEmpty (LocatedN RdrName))) -happyIn287 :: (Located (NonEmpty (LocatedN RdrName))) -> (HappyAbsSyn ) -happyIn287 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap287 x) -{-# INLINE happyIn287 #-} -happyOut287 :: (HappyAbsSyn ) -> HappyWrap287 -happyOut287 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut287 #-} -newtype HappyWrap288 = HappyWrap288 ([LocatedN RdrName]) -happyIn288 :: ([LocatedN RdrName]) -> (HappyAbsSyn ) -happyIn288 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap288 x) -{-# INLINE happyIn288 #-} -happyOut288 :: (HappyAbsSyn ) -> HappyWrap288 -happyOut288 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut288 #-} -newtype HappyWrap289 = HappyWrap289 (LocatedN DataCon) -happyIn289 :: (LocatedN DataCon) -> (HappyAbsSyn ) -happyIn289 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap289 x) -{-# INLINE happyIn289 #-} -happyOut289 :: (HappyAbsSyn ) -> HappyWrap289 -happyOut289 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut289 #-} -newtype HappyWrap290 = HappyWrap290 (LocatedN RdrName) -happyIn290 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn290 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap290 x) -{-# INLINE happyIn290 #-} -happyOut290 :: (HappyAbsSyn ) -> HappyWrap290 -happyOut290 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut290 #-} -newtype HappyWrap291 = HappyWrap291 (LocatedN DataCon) -happyIn291 :: (LocatedN DataCon) -> (HappyAbsSyn ) -happyIn291 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap291 x) -{-# INLINE happyIn291 #-} -happyOut291 :: (HappyAbsSyn ) -> HappyWrap291 -happyOut291 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut291 #-} -newtype HappyWrap292 = HappyWrap292 (LocatedN RdrName) -happyIn292 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn292 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap292 x) -{-# INLINE happyIn292 #-} -happyOut292 :: (HappyAbsSyn ) -> HappyWrap292 -happyOut292 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut292 #-} -newtype HappyWrap293 = HappyWrap293 (LocatedN RdrName) -happyIn293 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn293 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap293 x) -{-# INLINE happyIn293 #-} -happyOut293 :: (HappyAbsSyn ) -> HappyWrap293 -happyOut293 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut293 #-} -newtype HappyWrap294 = HappyWrap294 (LocatedN RdrName) -happyIn294 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn294 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap294 x) -{-# INLINE happyIn294 #-} -happyOut294 :: (HappyAbsSyn ) -> HappyWrap294 -happyOut294 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut294 #-} -newtype HappyWrap295 = HappyWrap295 (LocatedN RdrName) -happyIn295 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn295 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap295 x) -{-# INLINE happyIn295 #-} -happyOut295 :: (HappyAbsSyn ) -> HappyWrap295 -happyOut295 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut295 #-} -newtype HappyWrap296 = HappyWrap296 (LocatedN RdrName) -happyIn296 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn296 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap296 x) -{-# INLINE happyIn296 #-} -happyOut296 :: (HappyAbsSyn ) -> HappyWrap296 -happyOut296 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut296 #-} -newtype HappyWrap297 = HappyWrap297 (LocatedN RdrName) -happyIn297 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn297 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap297 x) -{-# INLINE happyIn297 #-} -happyOut297 :: (HappyAbsSyn ) -> HappyWrap297 -happyOut297 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut297 #-} -newtype HappyWrap298 = HappyWrap298 (LocatedN RdrName) -happyIn298 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn298 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap298 x) -{-# INLINE happyIn298 #-} -happyOut298 :: (HappyAbsSyn ) -> HappyWrap298 -happyOut298 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut298 #-} -newtype HappyWrap299 = HappyWrap299 (LocatedN RdrName) -happyIn299 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn299 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap299 x) -{-# INLINE happyIn299 #-} -happyOut299 :: (HappyAbsSyn ) -> HappyWrap299 -happyOut299 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut299 #-} -newtype HappyWrap300 = HappyWrap300 (LocatedN RdrName) -happyIn300 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn300 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap300 x) -{-# INLINE happyIn300 #-} -happyOut300 :: (HappyAbsSyn ) -> HappyWrap300 -happyOut300 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut300 #-} -newtype HappyWrap301 = HappyWrap301 (LocatedN RdrName) -happyIn301 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn301 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap301 x) -{-# INLINE happyIn301 #-} -happyOut301 :: (HappyAbsSyn ) -> HappyWrap301 -happyOut301 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut301 #-} -newtype HappyWrap302 = HappyWrap302 (LocatedN RdrName) -happyIn302 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn302 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap302 x) -{-# INLINE happyIn302 #-} -happyOut302 :: (HappyAbsSyn ) -> HappyWrap302 -happyOut302 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut302 #-} -newtype HappyWrap303 = HappyWrap303 (LocatedN RdrName) -happyIn303 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn303 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap303 x) -{-# INLINE happyIn303 #-} -happyOut303 :: (HappyAbsSyn ) -> HappyWrap303 -happyOut303 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut303 #-} -newtype HappyWrap304 = HappyWrap304 (LocatedN RdrName) -happyIn304 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn304 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap304 x) -{-# INLINE happyIn304 #-} -happyOut304 :: (HappyAbsSyn ) -> HappyWrap304 -happyOut304 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut304 #-} -newtype HappyWrap305 = HappyWrap305 (LocatedN RdrName) -happyIn305 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn305 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap305 x) -{-# INLINE happyIn305 #-} -happyOut305 :: (HappyAbsSyn ) -> HappyWrap305 -happyOut305 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut305 #-} -newtype HappyWrap306 = HappyWrap306 (forall b. DisambInfixOp b => PV (LocatedN b)) -happyIn306 :: (forall b. DisambInfixOp b => PV (LocatedN b)) -> (HappyAbsSyn ) -happyIn306 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap306 x) -{-# INLINE happyIn306 #-} -happyOut306 :: (HappyAbsSyn ) -> HappyWrap306 -happyOut306 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut306 #-} -newtype HappyWrap307 = HappyWrap307 (forall b. DisambInfixOp b => PV (LocatedN b)) -happyIn307 :: (forall b. DisambInfixOp b => PV (LocatedN b)) -> (HappyAbsSyn ) -happyIn307 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap307 x) -{-# INLINE happyIn307 #-} -happyOut307 :: (HappyAbsSyn ) -> HappyWrap307 -happyOut307 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut307 #-} -newtype HappyWrap308 = HappyWrap308 (LocatedN (HsExpr GhcPs)) -happyIn308 :: (LocatedN (HsExpr GhcPs)) -> (HappyAbsSyn ) -happyIn308 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap308 x) -{-# INLINE happyIn308 #-} -happyOut308 :: (HappyAbsSyn ) -> HappyWrap308 -happyOut308 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut308 #-} -newtype HappyWrap309 = HappyWrap309 (LocatedN RdrName) -happyIn309 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn309 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap309 x) -{-# INLINE happyIn309 #-} -happyOut309 :: (HappyAbsSyn ) -> HappyWrap309 -happyOut309 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut309 #-} -newtype HappyWrap310 = HappyWrap310 (LocatedN RdrName) -happyIn310 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn310 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap310 x) -{-# INLINE happyIn310 #-} -happyOut310 :: (HappyAbsSyn ) -> HappyWrap310 -happyOut310 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut310 #-} -newtype HappyWrap311 = HappyWrap311 (LocatedN RdrName) -happyIn311 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn311 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap311 x) -{-# INLINE happyIn311 #-} -happyOut311 :: (HappyAbsSyn ) -> HappyWrap311 -happyOut311 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut311 #-} -newtype HappyWrap312 = HappyWrap312 (LocatedN RdrName) -happyIn312 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn312 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap312 x) -{-# INLINE happyIn312 #-} -happyOut312 :: (HappyAbsSyn ) -> HappyWrap312 -happyOut312 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut312 #-} -newtype HappyWrap313 = HappyWrap313 (LocatedN RdrName) -happyIn313 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn313 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap313 x) -{-# INLINE happyIn313 #-} -happyOut313 :: (HappyAbsSyn ) -> HappyWrap313 -happyOut313 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut313 #-} -newtype HappyWrap314 = HappyWrap314 (LocatedN RdrName) -happyIn314 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn314 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap314 x) -{-# INLINE happyIn314 #-} -happyOut314 :: (HappyAbsSyn ) -> HappyWrap314 -happyOut314 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut314 #-} -newtype HappyWrap315 = HappyWrap315 (LocatedN RdrName) -happyIn315 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn315 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap315 x) -{-# INLINE happyIn315 #-} -happyOut315 :: (HappyAbsSyn ) -> HappyWrap315 -happyOut315 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut315 #-} -newtype HappyWrap316 = HappyWrap316 (LocatedN FieldLabelString) -happyIn316 :: (LocatedN FieldLabelString) -> (HappyAbsSyn ) -happyIn316 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap316 x) -{-# INLINE happyIn316 #-} -happyOut316 :: (HappyAbsSyn ) -> HappyWrap316 -happyOut316 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut316 #-} -newtype HappyWrap317 = HappyWrap317 (LocatedN RdrName) -happyIn317 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn317 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap317 x) -{-# INLINE happyIn317 #-} -happyOut317 :: (HappyAbsSyn ) -> HappyWrap317 -happyOut317 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut317 #-} -newtype HappyWrap318 = HappyWrap318 (LocatedN RdrName) -happyIn318 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn318 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap318 x) -{-# INLINE happyIn318 #-} -happyOut318 :: (HappyAbsSyn ) -> HappyWrap318 -happyOut318 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut318 #-} -newtype HappyWrap319 = HappyWrap319 (LocatedN RdrName) -happyIn319 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn319 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap319 x) -{-# INLINE happyIn319 #-} -happyOut319 :: (HappyAbsSyn ) -> HappyWrap319 -happyOut319 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut319 #-} -newtype HappyWrap320 = HappyWrap320 (LocatedN RdrName) -happyIn320 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn320 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap320 x) -{-# INLINE happyIn320 #-} -happyOut320 :: (HappyAbsSyn ) -> HappyWrap320 -happyOut320 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut320 #-} -newtype HappyWrap321 = HappyWrap321 (LocatedN RdrName) -happyIn321 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn321 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap321 x) -{-# INLINE happyIn321 #-} -happyOut321 :: (HappyAbsSyn ) -> HappyWrap321 -happyOut321 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut321 #-} -newtype HappyWrap322 = HappyWrap322 (LocatedN RdrName) -happyIn322 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn322 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap322 x) -{-# INLINE happyIn322 #-} -happyOut322 :: (HappyAbsSyn ) -> HappyWrap322 -happyOut322 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut322 #-} -newtype HappyWrap323 = HappyWrap323 (LocatedN RdrName) -happyIn323 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn323 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap323 x) -{-# INLINE happyIn323 #-} -happyOut323 :: (HappyAbsSyn ) -> HappyWrap323 -happyOut323 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut323 #-} -newtype HappyWrap324 = HappyWrap324 (Located FastString) -happyIn324 :: (Located FastString) -> (HappyAbsSyn ) -happyIn324 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap324 x) -{-# INLINE happyIn324 #-} -happyOut324 :: (HappyAbsSyn ) -> HappyWrap324 -happyOut324 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut324 #-} -newtype HappyWrap325 = HappyWrap325 (Located FastString) -happyIn325 :: (Located FastString) -> (HappyAbsSyn ) -happyIn325 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap325 x) -{-# INLINE happyIn325 #-} -happyOut325 :: (HappyAbsSyn ) -> HappyWrap325 -happyOut325 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut325 #-} -newtype HappyWrap326 = HappyWrap326 (LocatedN RdrName) -happyIn326 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn326 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap326 x) -{-# INLINE happyIn326 #-} -happyOut326 :: (HappyAbsSyn ) -> HappyWrap326 -happyOut326 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut326 #-} -newtype HappyWrap327 = HappyWrap327 (LocatedN RdrName) -happyIn327 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn327 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap327 x) -{-# INLINE happyIn327 #-} -happyOut327 :: (HappyAbsSyn ) -> HappyWrap327 -happyOut327 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut327 #-} -newtype HappyWrap328 = HappyWrap328 (LocatedN RdrName) -happyIn328 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn328 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap328 x) -{-# INLINE happyIn328 #-} -happyOut328 :: (HappyAbsSyn ) -> HappyWrap328 -happyOut328 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut328 #-} -newtype HappyWrap329 = HappyWrap329 (LocatedN RdrName) -happyIn329 :: (LocatedN RdrName) -> (HappyAbsSyn ) -happyIn329 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap329 x) -{-# INLINE happyIn329 #-} -happyOut329 :: (HappyAbsSyn ) -> HappyWrap329 -happyOut329 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut329 #-} -newtype HappyWrap330 = HappyWrap330 (Located (HsLit GhcPs)) -happyIn330 :: (Located (HsLit GhcPs)) -> (HappyAbsSyn ) -happyIn330 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap330 x) -{-# INLINE happyIn330 #-} -happyOut330 :: (HappyAbsSyn ) -> HappyWrap330 -happyOut330 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut330 #-} -newtype HappyWrap331 = HappyWrap331 (()) -happyIn331 :: (()) -> (HappyAbsSyn ) -happyIn331 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap331 x) -{-# INLINE happyIn331 #-} -happyOut331 :: (HappyAbsSyn ) -> HappyWrap331 -happyOut331 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut331 #-} -newtype HappyWrap332 = HappyWrap332 (LocatedA ModuleName) -happyIn332 :: (LocatedA ModuleName) -> (HappyAbsSyn ) -happyIn332 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap332 x) -{-# INLINE happyIn332 #-} -happyOut332 :: (HappyAbsSyn ) -> HappyWrap332 -happyOut332 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut332 #-} -newtype HappyWrap333 = HappyWrap333 (([SrcSpan],Int)) -happyIn333 :: (([SrcSpan],Int)) -> (HappyAbsSyn ) -happyIn333 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap333 x) -{-# INLINE happyIn333 #-} -happyOut333 :: (HappyAbsSyn ) -> HappyWrap333 -happyOut333 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut333 #-} -newtype HappyWrap334 = HappyWrap334 (([EpToken "|"],Int)) -happyIn334 :: (([EpToken "|"],Int)) -> (HappyAbsSyn ) -happyIn334 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap334 x) -{-# INLINE happyIn334 #-} -happyOut334 :: (HappyAbsSyn ) -> HappyWrap334 -happyOut334 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut334 #-} -newtype HappyWrap335 = HappyWrap335 (([EpToken "|"],Int)) -happyIn335 :: (([EpToken "|"],Int)) -> (HappyAbsSyn ) -happyIn335 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap335 x) -{-# INLINE happyIn335 #-} -happyOut335 :: (HappyAbsSyn ) -> HappyWrap335 -happyOut335 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut335 #-} -newtype HappyWrap336 = HappyWrap336 (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -happyIn336 :: (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -> (HappyAbsSyn ) -happyIn336 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap336 x) -{-# INLINE happyIn336 #-} -happyOut336 :: (HappyAbsSyn ) -> HappyWrap336 -happyOut336 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut336 #-} -newtype HappyWrap337 = HappyWrap337 (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -happyIn337 :: (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -> (HappyAbsSyn ) -happyIn337 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap337 x) -{-# INLINE happyIn337 #-} -happyOut337 :: (HappyAbsSyn ) -> HappyWrap337 -happyOut337 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut337 #-} -newtype HappyWrap338 = HappyWrap338 (ECP) -happyIn338 :: (ECP) -> (HappyAbsSyn ) -happyIn338 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap338 x) -{-# INLINE happyIn338 #-} -happyOut338 :: (HappyAbsSyn ) -> HappyWrap338 -happyOut338 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut338 #-} -newtype HappyWrap339 = HappyWrap339 (ECP) -happyIn339 :: (ECP) -> (HappyAbsSyn ) -happyIn339 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap339 x) -{-# INLINE happyIn339 #-} -happyOut339 :: (HappyAbsSyn ) -> HappyWrap339 -happyOut339 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut339 #-} -newtype HappyWrap340 = HappyWrap340 (ECP) -happyIn340 :: (ECP) -> (HappyAbsSyn ) -happyIn340 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap340 x) -{-# INLINE happyIn340 #-} -happyOut340 :: (HappyAbsSyn ) -> HappyWrap340 -happyOut340 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut340 #-} -newtype HappyWrap341 = HappyWrap341 (Located (NonEmpty (LPat GhcPs))) -happyIn341 :: (Located (NonEmpty (LPat GhcPs))) -> (HappyAbsSyn ) -happyIn341 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap341 x) -{-# INLINE happyIn341 #-} -happyOut341 :: (HappyAbsSyn ) -> HappyWrap341 -happyOut341 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut341 #-} -newtype HappyWrap342 = HappyWrap342 (Located (NonEmpty (LPat GhcPs))) -happyIn342 :: (Located (NonEmpty (LPat GhcPs))) -> (HappyAbsSyn ) -happyIn342 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap342 x) -{-# INLINE happyIn342 #-} -happyOut342 :: (HappyAbsSyn ) -> HappyWrap342 -happyOut342 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut342 #-} -newtype HappyWrap343 = HappyWrap343 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -happyIn343 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) -happyIn343 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap343 x) -{-# INLINE happyIn343 #-} -happyOut343 :: (HappyAbsSyn ) -> HappyWrap343 -happyOut343 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut343 #-} -newtype HappyWrap344 = HappyWrap344 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -happyIn344 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) -happyIn344 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap344 x) -{-# INLINE happyIn344 #-} -happyOut344 :: (HappyAbsSyn ) -> HappyWrap344 -happyOut344 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut344 #-} -newtype HappyWrap345 = HappyWrap345 (ECP) -happyIn345 :: (ECP) -> (HappyAbsSyn ) -happyIn345 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap345 x) -{-# INLINE happyIn345 #-} -happyOut345 :: (HappyAbsSyn ) -> HappyWrap345 -happyOut345 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut345 #-} -newtype HappyWrap346 = HappyWrap346 (ECP) -happyIn346 :: (ECP) -> (HappyAbsSyn ) -happyIn346 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap346 x) -{-# INLINE happyIn346 #-} -happyOut346 :: (HappyAbsSyn ) -> HappyWrap346 -happyOut346 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut346 #-} -newtype HappyWrap347 = HappyWrap347 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -happyIn347 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) -happyIn347 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap347 x) -{-# INLINE happyIn347 #-} -happyOut347 :: (HappyAbsSyn ) -> HappyWrap347 -happyOut347 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut347 #-} -newtype HappyWrap348 = HappyWrap348 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -happyIn348 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) -happyIn348 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap348 x) -{-# INLINE happyIn348 #-} -happyOut348 :: (HappyAbsSyn ) -> HappyWrap348 -happyOut348 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut348 #-} -newtype HappyWrap349 = HappyWrap349 (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -happyIn349 :: (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -> (HappyAbsSyn ) -happyIn349 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap349 x) -{-# INLINE happyIn349 #-} -happyOut349 :: (HappyAbsSyn ) -> HappyWrap349 -happyOut349 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut349 #-} -newtype HappyWrap350 = HappyWrap350 (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -happyIn350 :: (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -> (HappyAbsSyn ) -happyIn350 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap350 x) -{-# INLINE happyIn350 #-} -happyOut350 :: (HappyAbsSyn ) -> HappyWrap350 -happyOut350 x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOut350 #-} -happyInTok :: ((Located Token)) -> (HappyAbsSyn ) -happyInTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> ((Located Token)) -happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x -{-# INLINE happyOutTok #-} - - -happyExpList :: HappyAddr -happyExpList = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x7f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xcd\x57\xf9\xff\xcb\xff\x7b\x06\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\xe6\x22\xf8\xff\xe5\xff\x09\x82\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xff\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x10\x10\x11\x02\x54\xd0\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x10\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x07\x00\x00\x00\x00\x00\x00\x01\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x02\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x45\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x00\x00\x10\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x80\x05\x10\x15\x38\x03\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x04\x3f\x9f\xf0\x03\x00\x00\x00\xb0\x00\xa2\x02\x67\xe0\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x40\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2e\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x71\x21\x44\x87\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x08\x2e\x84\xa8\xf1\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x30\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x80\x00\x88\x10\xa0\x82\x5e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xff\x27\xfc\x00\x00\x00\x00\x00\x00\xa8\xc2\x19\xfe\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x80\x88\x10\x00\x41\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\xc4\x0f\x00\x40\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfc\x00\x00\x00\x01\x1c\x20\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\x7f\x20\x00\x80\x04\x0f\x40\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x00\x00\x00\x58\x00\x51\x81\x33\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf0\xff\x0b\x3f\x00\x00\x40\x00\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfc\x00\x00\x00\x01\x1c\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x03\x00\x00\x1c\x70\x80\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\x7f\x00\x00\x80\x00\x0e\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xc2\x0f\x00\x00\x10\xc0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xf8\x01\x00\x00\x02\x38\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf0\xff\x0b\x3f\x00\x00\x40\x00\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x09\xf0\x21\xc0\x15\xff\xff\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xd5\xff\x2f\xfe\x40\x00\x20\x29\x3e\x0c\xe8\xf2\xff\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x1f\x08\x00\x24\xc1\x87\x00\x75\xfe\xff\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x03\x00\x00\x04\x70\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x54\xc0\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\x7f\x00\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\xfe\x3f\xe1\x07\x00\x00\x00\x00\x00\x40\x15\xce\xf0\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xcf\x27\xfc\x00\x00\x00\x00\x00\x00\xa8\x80\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x20\x42\x00\x00\x62\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x40\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xff\x27\xfc\x00\x00\x00\x00\x00\x00\x20\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x1f\x00\x00\x00\x00\x00\x00\x15\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x02\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xea\xff\x17\x7f\x20\x00\x90\x14\x1f\x06\x74\xf9\xff\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x80\x08\x01\x00\x88\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x70\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x22\x10\x82\xff\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x07\x00\x00\x00\x00\x00\x40\x05\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x90\xe2\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x54\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\xc0\x02\x88\x0a\x9c\x81\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\xc5\x1f\x00\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x00\x00\x00\x00\xa0\x02\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\x7e\x00\x00\x80\x00\x0e\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\x85\x1f\x00\x00\x20\x80\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x11\x02\x20\x08\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xff\x27\xfc\x00\x00\x00\x00\x00\x00\xa8\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x1f\x00\x00\x00\x00\x00\x10\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x10\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x02\x00\x00\x04\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf0\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x1f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x44\xff\xbf\xf8\x03\x00\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x80\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x98\x08\x11\x00\x88\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xe2\x0f\x00\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x0f\x04\x00\x12\xe0\x43\x80\x2e\xff\xff\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\xaa\xff\x5f\xfc\x81\x00\x40\x12\x7c\x08\x50\xc5\xff\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x80\x05\x10\x15\x38\x03\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xe2\x0f\x00\x00\x10\xc0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xff\x27\xfc\x00\x00\x00\x00\x00\x00\x00\x80\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x00\x00\x20\x08\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x80\x80\x88\x10\xa0\x43\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x00\x02\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x80\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x07\x00\x00\x00\x00\x00\x00\x01\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x00\x00\x00\x00\xa0\x02\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\xcc\x45\xf0\xff\xcb\xff\x13\x04\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\xb9\x08\xfe\x7f\xf9\x7f\x82\x20\x08\xf0\x00\x42\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xff\x27\xfc\x00\x00\x00\x00\x00\x00\x20\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x02\x04\x40\x10\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x84\x00\x00\xc4\x0c\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe3\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x7f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x09\xf0\x21\x40\x9d\xff\xff\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\x85\x1f\x00\x00\x20\x80\x03\x04\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\x7e\x00\x00\x80\x00\x0e\x10\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x00\x00\x00\x00\x2c\x80\xa8\xc0\x19\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x07\x00\x00\x08\xe0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x40\x00\x00\x00\x80\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\xc0\x02\x88\x0a\x9c\x81\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x1d\xfe\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x00\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x21\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x00\x00\x00\x00\x00\x41\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x3f\x9f\xf0\x03\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\x7e\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x00\x00\x00\x58\x00\x51\x81\x33\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x80\x05\x10\x15\x38\x03\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x00\x00\x00\x58\x00\x51\x81\x33\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\x1c\x7c\xc2\x0f\x00\x00\x00\x00\x00\x00\x00\x18\x00\x01\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x04\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\x3f\x00\x00\x00\x00\x00\x00\x08\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x1f\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf0\xff\x0b\x3f\x00\x00\x40\x00\x07\x48\xaa\x72\xe6\xff\xff\xff\xfa\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x07\x00\x00\x08\xe0\x00\x61\x55\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x1f\x08\x00\x20\xc0\x03\x20\x55\x39\xf3\xff\xff\x7f\x7d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xb0\x2a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\xaa\xff\x5f\xfc\x81\x00\x40\x02\x7c\x08\x50\xc5\xff\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc7\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x1f\x08\x00\x24\xc0\x87\x00\x55\xfc\xff\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x09\xf0\x21\x40\x95\xff\xff\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x03\x00\x00\x04\x70\x00\xa0\x1a\x67\xfe\xff\xff\xaf\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xdf\x7c\x95\xff\xbf\xfc\xbf\x67\x10\x04\x78\x00\xa1\x0a\x67\xfe\xff\xff\xaf\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x11\x02\x00\x10\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x88\x10\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x80\x0a\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x50\x01\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x88\x10\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x13\x21\x02\x00\x31\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe8\xff\x17\x7f\x00\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfd\xff\xe2\x0f\x00\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xf8\x01\x00\x00\x02\x38\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xd5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x54\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xea\xff\x17\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfd\xff\xe2\x0f\x00\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\x87\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x10\x20\x00\x00\x30\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\x7e\x00\x00\x00\x00\x00\x40\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x07\x00\x00\x00\x00\x00\x00\x01\x04\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x40\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\x3f\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x40\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x54\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xf8\x01\x00\x00\x02\x38\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x01\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x40\x84\x00\x00\xc4\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xcd\x57\xf9\xff\xcb\xff\x7b\x06\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x80\x0a\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf8\x03\x00\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x40\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\x00\x00\x08\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x3f\x9f\xf0\x03\x00\x00\x80\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x00\x00\x00\x00\x00\x04\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xfa\xff\xc5\x1f\x00\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\xe6\x22\xf8\xff\xe5\xff\x09\x82\x20\xc0\x03\x08\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\x7e\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x3f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xca\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfc\x00\x00\x00\x01\x1c\x20\xa8\xca\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xea\xff\x17\x7f\x20\x00\x90\x00\x1f\x02\x54\xf1\xff\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x01\x00\x00\x00\x02\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\x70\xf0\x09\x3f\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x03\x00\x00\x04\x70\x80\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x38\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc7\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x40\x44\x08\x00\x40\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\x00\x00\x08\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x04\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x73\x51\xfc\xff\xf2\xff\x04\x41\x10\xe0\x01\x84\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x66\x2e\x8a\xff\x5f\xfe\x9f\x20\x08\x02\x3c\x80\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xf3\x09\x3f\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x40\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x03\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x0f\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x01\x44\x08\x00\x40\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x04\x48\xf1\xff\x49\x3f\x00\x00\x00\x00\x00\x00\x08\x60\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x88\x10\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x73\x11\xfc\xff\xf2\xff\x04\x41\x10\xe0\x01\x84\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x2e\x82\xff\x5f\xfe\x9f\x20\x08\x02\x3c\x80\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x8b\xb9\x2a\xfe\x7f\xf9\x7f\x82\x20\x08\xf0\x00\x42\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x31\x57\xc5\xff\x2f\xff\x4f\x10\x04\x01\x1e\x40\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf8\x03\x00\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x84\xe8\xef\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x74\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x20\xb8\x10\xa2\xc6\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x0f\x04\x00\x12\xe0\x43\x80\x2a\xfe\xff\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\x83\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x03\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\x38\xf8\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x30\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x07\x30\x00\x41\x70\x21\x44\x0d\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x9b\xb9\x28\xfe\x7f\xf9\x7f\x82\x20\x08\xf0\x00\x42\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe1\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x20\x42\x00\x00\x62\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\xc0\x00\xb8\x10\xa2\x82\xff\xe1\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x18\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7c\xc2\x0f\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x1f\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf1\xff\x09\x3f\x00\x00\x04\x00\x00\x00\x08\x60\x06\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x3f\x9f\xf0\x03\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc5\x5c\x15\xff\xbf\xfc\x3f\x41\x10\x04\x78\x00\xa1\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\x7e\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\x3f\x80\x01\x08\x88\x0b\x21\x3a\xfc\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\x87\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x90\xe2\xff\x93\x7e\x00\x00\x00\x00\x00\x00\x10\xc8\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x50\xfc\x7f\xc2\x0f\x00\x00\x01\x00\x00\x00\x02\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x0a\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x48\xf1\xff\x49\x3f\x00\x00\x00\x00\x00\x00\x08\x64\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xf9\x84\x1f\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\x83\x4f\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x07\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x90\xe2\xff\x93\x7e\x00\x00\x00\x00\x00\x00\x10\xc0\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -{-# NOINLINE happyExpListPerState #-} -happyExpListPerState st = - token_strs_expected - where token_strs = ["error","%dummy","%start_parseModuleNoHaddock","%start_parseSignatureNoHaddock","%start_parseImport","%start_parseStatement","%start_parseDeclaration","%start_parseExpression","%start_parsePattern","%start_parseTypeSignature","%start_parseStmt","%start_parseIdentifier","%start_parseType","%start_parseBackpack","%start_parseHeader","identifier","backpack","units","unit","unitid","msubsts","msubst","moduleid","pkgname","litpkgname_segment","HYPHEN","litpkgname","mayberns","rns","rn","unitbody","unitdecls","unitdecl","signature","module","missing_module_keyword","implicit_top","body","body2","top","top1","header","header_body","header_body2","header_top","header_top_importdecls","maybeexports","exportlist","exportlist1","export_cs","export","export_subspec","qcnames","qcnames1","qcname_ext_w_wildcard","qcname_ext","qcname","semis1","semis","importdecls","importdecls_semi","importdecl","maybe_src","maybe_safe","maybe_pkg","optqualified","maybeas","maybeimpspec","impspec","importlist","importlist1","import","prec","infix","ops","topdecls","topdecls_semi","topdecls_cs","topdecls_cs_semi","topdecl_cs","topdecl","cl_decl","default_decl","ty_decl","standalone_kind_sig","sks_vars","inst_decl","overlap_pragma","deriv_strategy_no_via","deriv_strategy_via","deriv_standalone_strategy","opt_class","opt_injective_info","injectivity_cond","inj_varids","where_type_family","ty_fam_inst_eqn_list","ty_fam_inst_eqns","ty_fam_inst_eqn","at_decl_cls","opt_family","opt_instance","at_decl_inst","type_data_or_newtype","data_or_newtype","opt_kind_sig","opt_datafam_kind_sig","opt_tyfam_kind_sig","opt_at_kind_inj_sig","tycl_hdr","datafam_inst_hdr","capi_ctype","stand_alone_deriving","role_annot","maybe_roles","roles","role","pattern_synonym_decl","pattern_synonym_lhs","vars0","cvars1","where_decls","pattern_synonym_sig","qvarcon","decl_cls","decls_cls","decllist_cls","where_cls","decl_inst","decls_inst","decllist_inst","where_inst","decls","decllist","binds","wherebinds","rules","rule","rule_activation","rule_activation_marker","rule_explicit_activation","rule_foralls","rule_vars","rule_var","maybe_warning_pragma","warning_category","warnings","warning","namespace_spec","deprecations","deprecation","strings","stringlist","annotation","fdecl","callconv","safety","fspec","opt_sig","opt_tyconsig","sigktype","sigtype","sig_vars","sigtypes1","unpackedness","forall_telescope","ktype","ctype","context","expcontext","type","mult","expmult","btype","infixtype","ftype","tyarg","tyop","atype","inst_type","deriv_types","comma_types0","comma_types1","bar_types2","tv_bndrs","tv_bndr","tv_bndr_no_braces","tyvar_wc","fds","fds1","fd","varids0","kind","gadt_constrlist","gadt_constrs","gadt_constr","constrs","constrs1","constr","forall","constr_stuff","usum_constr","fielddecls","fielddecls1","fielddecl","maybe_derivings","derivings","deriving","deriv_clause_types","decl_no_th","decl","rhs","gdrhs","gdrh","sigdecl","activation","explicit_activation","quasiquote","exp","exp2","infixexp2","infixexp","exp10p","exp10","optSemi","prag_e","fexp","aexp","aexp1","aexp2","projection","splice_exp","splice_untyped","splice_typed","cmdargs","acmd","cvtopbody","cvtopdecls0","texp","tup_exprs","commas_tup_tail","tup_tail","list","lexps","flattenedpquals","pquals","squals","transformqual","guardquals","guardquals1","alt_rhs","ralt","gdpats","ifgdpats","gdpat","pat_syn_pat","pat","pats1","bindpat","argpat","argpats","apat","stmtlist","stmts","maybe_stmt","e_stmt","stmt","qual","fbinds","fbinds1","fbind","fieldToUpdate","dbinds","dbind","ipvar","overloaded_label","name_boolformula_opt","name_boolformula","name_boolformula_and","name_boolformula_and_list","name_boolformula_atom","namelist","name_var","qcon","gen_qcon","con","con_list","qcon_list","sysdcon_nolist","syscon","sysdcon","conop","qconop","gtycon","ntgtycon","oqtycon","oqtycon_no_varcon","qtyconop","qtycon","tycon","qtyconsym","tyconsym","otycon","op","varop","qop","qopm","hole_op","qvarop","qvaropm","tyvar","tyvarop","tyvarid","var","qvar","field","qvarid","varid","qvarsym","qvarsym_no_minus","qvarsym1","varsym","varsym_no_minus","special_id","special_sym","qconid","conid","qconsym","consym","literal","close","modid","commas","bars0","bars","altslist__argpats__","altslist__pats1__","exp_gen__infixexp__","exp_gen__infixexp2__","exp_prag__exp10p__","orpats__exp__","orpats__exp2__","alts__argpats__","alts__pats1__","exp_prag__exp_gen__infixexp2____","exp_prag__exp_gen__infixexp____","alts1__argpats__","alts1__pats1__","alt__argpats__","alt__pats1__","'_'","'as'","'case'","'class'","'data'","'default'","'deriving'","'else'","'hiding'","'if'","'import'","'in'","'infix'","'infixl'","'infixr'","'instance'","'let'","'module'","'newtype'","'of'","'qualified'","'then'","'type'","'where'","'forall'","'foreign'","'export'","'label'","'dynamic'","'safe'","'interruptible'","'unsafe'","'family'","'role'","'stdcall'","'ccall'","'capi'","'prim'","'javascript'","'proc'","'rec'","'group'","'by'","'using'","'pattern'","'static'","'stock'","'anyclass'","'via'","'unit'","'signature'","'dependency'","'{-# INLINE'","'{-# OPAQUE'","'{-# SPECIALISE'","'{-# SPECIALISE_INLINE'","'{-# SOURCE'","'{-# RULES'","'{-# SCC'","'{-# DEPRECATED'","'{-# WARNING'","'{-# UNPACK'","'{-# NOUNPACK'","'{-# ANN'","'{-# MINIMAL'","'{-# CTYPE'","'{-# OVERLAPPING'","'{-# OVERLAPPABLE'","'{-# OVERLAPS'","'{-# INCOHERENT'","'{-# COMPLETE'","'#-}'","'..'","':'","'::'","'='","'\\\\'","'lcase'","'lcases'","'|'","'<-'","'->'","'->.'","TIGHT_INFIX_AT","'=>'","'-'","PREFIX_TILDE","PREFIX_BANG","PREFIX_MINUS","'*'","'-<'","'>-'","'-<<'","'>>-'","'.'","PREFIX_PROJ","TIGHT_INFIX_PROJ","PREFIX_AT","PREFIX_PERCENT","'{'","'}'","vocurly","vccurly","'['","']'","'('","')'","'(#'","'#)'","'(|'","'|)'","';'","','","'`'","SIMPLEQUOTE","VARID","CONID","VARSYM","CONSYM","QVARID","QCONID","QVARSYM","QCONSYM","DO","MDO","IPDUPVARID","LABELVARID","CHAR","STRING","STRING_MULTI","INTEGER","RATIONAL","PRIMCHAR","PRIMSTRING","PRIMINTEGER","PRIMWORD","PRIMINTEGER8","PRIMINTEGER16","PRIMINTEGER32","PRIMINTEGER64","PRIMWORD8","PRIMWORD16","PRIMWORD32","PRIMWORD64","PRIMFLOAT","PRIMDOUBLE","'[|'","'[p|'","'[t|'","'[d|'","'|]'","'[||'","'||]'","PREFIX_DOLLAR","PREFIX_DOLLAR_DOLLAR","TH_TY_QUOTE","TH_QUASIQUOTE","TH_QQUASIQUOTE","%eof"] - bit_start = st Prelude.* 509 - bit_end = (st Prelude.+ 1) Prelude.* 509 - read_bit = readArrayBit happyExpList - bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1] - bits_indexed = Prelude.zip bits [0..508] - token_strs_expected = Prelude.concatMap f bits_indexed - f (Prelude.False, _) = [] - f (Prelude.True, nr) = [token_strs Prelude.!! nr] - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x4a\x00\x0f\x00\x7a\x00\x31\x35\x3b\x28\x5d\x3b\x5d\x3b\xb9\x32\x31\x35\x1d\x6a\xdf\x51\x72\x00\x58\x00\x1d\x6e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x04\x00\x00\x00\x00\x00\x00\x0a\x01\x00\x00\xff\x01\xff\x01\x00\x00\x86\x00\xdf\x00\xdf\x00\x9f\x57\xdf\x51\xe2\x00\x4e\x01\x63\x01\x00\x00\xf9\x19\x00\x00\xb9\x18\x00\x00\x00\x00\x00\x00\x00\x00\x58\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x19\x00\x00\x79\x17\x00\x00\x00\x00\x00\x00\x19\x18\x4c\x70\x00\x00\x00\x00\x00\x00\x8c\x01\xad\x01\x00\x00\x00\x00\x33\x5a\x33\x5a\x00\x00\x00\x00\x8a\x71\x4d\x50\x2b\x4d\xb1\x4d\x4c\x6d\x84\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x4c\x00\x00\x00\x00\xd1\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x01\x2a\x06\x92\x02\xea\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x99\x1a\x00\x00\x5d\x3b\x39\x1b\x00\x00\xe4\x03\x00\x00\x00\x00\x00\x00\x5c\x02\x87\x02\x00\x00\x00\x00\x39\x16\x00\x00\x00\x00\xef\x02\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x3b\xf5\x33\x50\x02\x33\x5a\x69\x4b\x86\x02\x69\x4b\x9f\x01\xeb\x40\x8f\x49\x69\x4b\x69\x4b\x69\x4b\xdf\x30\x77\x29\x8d\x2c\x69\x4b\xb8\x6b\x86\x02\x86\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x3b\xb5\x47\xdf\x51\x01\x03\x5d\x3b\x07\x4c\xd9\x16\xc9\x02\x00\x00\xe6\x02\x5a\x04\x1e\x03\x23\x03\x00\x00\x00\x00\x00\x00\x55\x03\x22\x03\xeb\x6b\x1d\x6e\x81\x6d\xad\x6d\x1d\x6e\xe3\x6e\xa2\x04\x77\x29\x27\x01\xfe\x02\x00\x00\xfe\x02\xfe\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x03\x92\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x07\x9f\x57\xec\x01\x5d\x02\xe0\x02\xe9\x03\x9a\x03\xbb\x4e\xb1\x01\x3e\x6f\x2e\x03\x8d\x01\xa0\x00\xb7\x6e\x33\x5a\x2b\x03\x00\x00\x2b\x03\xb6\x03\x5a\x03\xe4\x02\x5a\x03\x00\x00\x00\x00\xe4\x02\x00\x00\xa4\x03\x9e\x03\xe9\x03\x00\x00\x00\x00\x3f\x00\xe9\x03\x01\x04\xf6\x03\xb5\x47\xbe\x6c\x69\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x4b\x30\x01\xba\x0f\x4f\x01\x42\x00\x00\x00\xd7\x03\x6a\x6f\x53\x01\x00\x00\x00\x00\x00\x00\x6f\x01\x00\x00\x89\x41\xe1\x02\x52\x71\x2b\x04\xf7\xff\x69\x02\x00\x00\x30\x04\x30\x04\x1c\x00\x1e\x04\x9d\x02\x91\x00\x00\x00\x03\x55\x9f\x57\xaa\x02\xfd\x05\x03\x00\x74\x04\x00\x00\x85\x04\x00\x00\x00\x00\x00\x00\xdf\x51\x2e\x04\x00\x00\x9f\x57\x6c\x04\x55\x04\x00\x00\xa5\x03\x00\x00\x27\x42\x00\x00\x00\x00\xdf\x51\xe9\x6a\x8d\x04\x9f\x57\x46\x04\x5d\x3b\xc5\x42\xa1\x04\x72\x04\xaf\x06\xf3\x4b\xcf\x35\x20\x02\x29\x02\x93\x04\x00\x00\xb5\x47\x00\x00\x00\x00\x00\x00\xa0\x04\xa6\x04\xad\x04\xb3\x04\xc9\x2d\x7d\x31\x00\x00\xc7\x04\x00\x00\x33\x5a\x00\x00\xd4\x04\x8f\x49\x4a\x72\x00\x00\x00\x00\xe9\x6a\xd9\x04\x07\x05\xb9\x01\x1a\x05\x00\x00\x20\x05\x00\x00\xf9\x04\x00\x00\x50\x6e\x1d\x00\x1d\x6e\x00\x00\xf7\x00\x1d\x6e\xdf\x51\x1e\x05\x4d\x6c\x0d\x05\x00\x00\x87\x05\x1b\x32\x1b\x32\x8a\x71\xdf\x51\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x25\x05\xe6\x04\x17\x02\x00\x00\x00\x00\x00\x05\x2b\x05\x00\x00\x00\x00\x2e\x05\xaf\x05\x48\x05\x00\x00\x6d\x36\x6d\x36\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x02\x32\x05\x00\x00\x00\x00\x67\x2e\x00\x00\x39\x05\xc0\x01\x4e\x05\x5c\x05\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x1b\x00\x00\x2d\x4a\x9e\x05\x00\x00\x39\x04\xc9\x04\x33\x5a\xb3\x05\xb8\x05\x00\x00\x00\x00\xa5\x05\x00\x00\xfa\x05\xa3\x05\x40\x00\x00\x00\x00\x00\xfb\x3b\xc8\x05\x08\x06\x69\x4b\x99\x3c\x4a\x72\xea\x6d\x00\x00\x33\x5a\x00\x00\xdf\x51\x99\x3c\x99\x3c\x99\x3c\x99\x3c\xb9\x05\xbd\x05\xca\x03\xcd\x05\xd0\x05\xa6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x41\x4f\x20\x6d\x01\x06\x04\x06\xbc\x00\x00\x06\x25\x06\xf8\x03\xf5\x01\x00\x00\x90\x02\xa5\x4c\xa8\x02\x2e\x06\x00\x00\x90\x01\x00\x00\xd5\x00\x3a\x06\x00\x00\x3e\x06\x00\x00\xf7\x01\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x01\x4c\x70\x00\x00\x00\x00\x00\x00\x00\x00\xae\x72\x06\x71\xdf\x51\x33\x5a\x00\x00\x9f\x57\x00\x00\x33\x5a\x67\x06\xdf\x51\xdf\x51\x33\x5a\xdf\x51\xdf\x51\x00\x00\x00\x00\xed\x01\x00\x00\x0f\x69\x33\x00\x00\x00\x6c\x06\xe9\x03\xe9\x03\x00\x00\x41\x06\x41\x06\x00\x00\x00\x00\xb5\x06\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x06\xcb\x06\x46\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x06\xb8\x00\x00\x00\x00\x00\x00\x00\x81\x06\x8a\x71\x00\x00\xdf\x51\x8a\x71\x00\x00\xdf\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\xdf\x51\x00\x00\x00\x00\x84\x06\x88\x06\x99\x06\x9d\x06\xaa\x06\xae\x06\x00\x00\xb0\x06\xb6\x06\xc7\x06\xd0\x06\xcf\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x06\x00\x00\xdc\x06\x0a\x07\xf8\x06\xff\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x04\x1a\x01\x10\x07\x01\x07\x00\x00\x00\x00\x00\x00\x6f\x07\x00\x00\x99\x3c\x99\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x63\x43\x86\x26\x00\x00\x93\x34\xe7\x25\x99\x3c\x00\x00\x57\x33\x00\x00\x0b\x37\xa9\x37\x57\x33\x00\x00\x16\x07\x00\x00\x00\x00\x00\x00\x2b\x2d\x45\x07\x00\x00\xcb\x4a\x38\x00\x00\x00\x07\x02\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x28\x3f\x00\x37\x07\x00\x00\x00\x00\x00\x00\x38\x07\x00\x00\x00\x00\x47\x0d\x00\x00\x00\x00\x25\x01\x39\x00\x00\x00\x00\x00\xfa\x08\x00\x00\x05\x2f\xa3\x2f\x3b\x00\x00\x00\x41\x30\x22\x02\x4d\x02\x22\x03\x66\x07\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x07\x6c\x07\x35\x07\x00\x00\x00\x00\x51\x07\x72\x07\x00\x00\x76\x07\x54\x07\x55\x07\xc5\x6f\xc5\x6f\x00\x00\x79\x07\xdf\x04\x1b\x05\x56\x07\x61\x07\x00\x00\x00\x00\x00\x00\x00\x00\x85\x07\x65\x07\x6b\x0a\x00\x00\x00\x00\x4a\x72\x00\x00\xf3\x4b\x00\x00\x86\x07\x01\x44\x9f\x44\x9f\x44\x69\x4b\xdf\x51\x47\x38\x47\x38\x47\x38\x47\x38\x47\x38\x9f\x44\x00\x00\x00\x00\x20\x00\xb8\x03\x89\x55\x24\x04\x00\x00\x00\x00\x3d\x45\x00\x00\x00\x00\x26\x00\x00\x00\x99\x3c\x37\x3d\x9f\x57\xc4\x07\x00\x00\x93\x07\xdf\x51\x00\x00\x00\x00\x95\x07\x4c\x04\x03\x00\x99\x07\x63\x07\x00\x00\xdf\x51\x9f\x07\xa0\x07\xa1\x07\xa3\x07\x25\x00\x66\x03\x44\x04\x00\x00\x9e\x07\x4c\x70\xdf\x51\xdf\x51\xaa\x02\x5f\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\x68\x4a\x72\x00\x00\x7c\x07\xdf\x51\x00\x00\x4a\x72\x8a\x71\xd5\x3d\xd5\x3d\xdb\x45\x00\x00\x84\x01\x00\x00\x74\x07\x00\x00\x98\x01\x03\x00\x82\x07\x00\x00\x00\x00\xd4\x00\xf1\x6f\x00\x00\x69\x4b\x12\x03\xa5\x07\xb0\x07\x3a\x10\x00\x00\xe7\x07\x00\x00\x97\x07\x00\x00\x97\x07\x00\x00\x00\x00\xf4\x07\x00\x00\x92\x07\x00\x00\x3b\x28\xec\x07\x62\x01\xee\x07\x87\x07\x00\x00\x7e\x04\xdf\x51\x00\x00\x00\x00\xa6\x07\xc2\x07\x03\x00\x00\x00\xf1\x6f\x00\x00\x00\x00\x00\x00\xf0\xff\xa4\x07\xb5\x47\xb6\x71\x00\x00\xfc\x07\x00\x00\xb2\x07\xa7\x07\x00\x00\x00\x00\xa9\x07\x00\x00\xdb\x68\x00\x00\xca\x07\xd6\x07\xd7\x07\xdb\x07\xea\x71\x00\x00\x00\x00\x00\x00\x00\x00\xcd\x07\xdf\x51\xdd\x07\xdf\x51\x4c\x70\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x08\xe7\x01\x00\x00\x00\x00\xe8\x07\xfd\x05\xdf\x51\xc6\x07\x00\x00\xdf\x51\xbe\x07\x00\x00\x76\x72\x00\x00\x14\x05\x00\x00\xe6\x07\x20\x08\x00\x00\x00\x00\x49\x05\x00\x00\x8c\x04\xe4\x07\x00\x00\x4c\x70\x24\x08\x37\x08\xdf\x51\x2d\x08\x00\x00\xff\x07\x00\x00\x16\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x46\x00\x00\x00\x00\xfa\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x00\x00\xe2\x07\xdf\x51\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x07\x00\x00\x1b\x32\xd5\x3d\x00\x00\x00\x00\xdf\x51\xde\x07\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x70\x00\x00\x00\x00\xe1\x07\x00\x00\xe5\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x08\x00\x00\x00\x00\x00\x00\x24\x01\x00\x00\x00\x00\x73\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x80\x05\x00\x00\x3f\x00\xe3\x07\x00\x00\x83\x39\xef\x07\x00\x00\x80\x05\x00\x00\x3f\x00\xed\x07\x00\x00\x53\x48\xf3\x07\x00\x00\x00\x00\x00\x00\x11\x3f\xaf\x3f\x4d\x40\x00\x00\x00\x00\x4a\x72\x57\x33\xea\x6d\x00\x00\x00\x00\xdf\x51\x00\x00\x00\x00\x0c\x08\x00\x00\xf6\x07\xf5\x07\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x00\x00\xdf\x51\x00\x00\x26\x71\x00\x00\x00\x00\x00\x00\x72\x05\x00\x00\x4a\x08\x4d\x08\x86\x05\x86\x05\x00\x00\xcb\x01\xcb\x01\x00\x00\xfb\x07\x02\x08\x00\x00\x00\x00\xfd\x07\x00\x00\x00\x00\x47\x01\x00\x00\x00\x00\x00\x00\xf9\x07\x00\x00\x00\x00\x17\x47\x00\x00\x00\x00\x52\x08\x1d\x08\x4d\x40\x00\x00\x00\x00\x4d\x40\x00\x00\x00\x00\x43\x08\xd9\x28\x21\x3a\x21\x3a\xbf\x3a\x00\x00\x00\x08\x00\x00\x47\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x25\x08\x03\x08\x32\x08\x00\x00\x34\x08\x00\x00\x00\x00\x2e\x08\x00\x00\x23\x58\xa6\x70\x00\x00\x00\x00\x76\x08\x00\x00\x22\x00\x76\x08\x94\x05\x21\x08\xa7\x58\x67\x08\x7e\x08\x00\x00\x00\x00\x4d\x40\x00\x00\x15\x2a\x15\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x51\x00\x00\x00\x00\x08\x08\x00\x00\xac\x05\x00\x00\x00\x00\x00\x00\x6e\x08\xae\x72\x00\x00\xa7\x58\x46\x08\xdf\x51\x00\x00\x00\x00\xea\x71\x00\x00\x00\x00\xf1\x05\x33\x08\x16\x72\x00\x00\x4a\x72\xe9\x07\x00\x00\x00\x00\x2a\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x04\x00\x00\x19\x06\x29\x08\x2b\x08\x00\x00\x00\x00\x1c\x6b\x00\x00\x19\x06\x26\x08\x00\x00\x30\x08\x00\x00\x30\x08\x00\x00\x00\x00\x00\x00\x31\x08\x00\x00\x00\x00\x00\x00\x00\x00\x88\x04\x9d\x04\xaa\x02\x1b\x05\xad\x07\xaf\x01\x00\x00\x00\x00\x80\x08\x00\x00\x4d\x40\x4f\x08\x00\x00\x84\x08\x1b\x32\x1b\x32\x00\x00\x00\x00\xdf\x51\x5a\x08\x00\x00\x4c\x08\x00\x00\x22\x06\x00\x00\xb3\x2a\xb3\x2a\x00\x00\x00\x00\x00\x00\xae\x72\x00\x00\x00\x00\x3d\x00\x00\x00\x8c\x08\xf1\x48\xd3\x50\x07\x03\x00\x00\x00\x00\xa9\x08\x00\x00\xa7\x58\x67\x05\x67\x05\x00\x00\xde\x02\x81\x08\x00\x00\x00\x00\x00\x00\x00\x00\x59\x51\x00\x00\x54\x08\x5c\x08\x00\x00\x61\x08\x00\x00\xb1\x4d\x9e\x08\x00\x00\x00\x00\xdf\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x40\x4d\x40\x4d\x40\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x08\x57\x33\x4a\x72\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x82\x08\x9d\x04\x2f\x69\x31\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x01\x57\x08\x5b\x08\x5b\x69\xab\x04\x9d\x04\x00\x00\x00\x00\x00\x00\x4d\x40\x00\x00\x00\x00\x96\x08\x00\x00\x00\x00\xa3\x01\x58\x08\xc7\x4f\x2b\x59\x00\x00\x55\x08\x59\x08\x00\x00\x00\x00\x00\x00\x3f\x00\x5d\x08\x22\x03\x62\x08\x73\x08\x00\x00\x00\x00\x00\x00\x51\x2b\x00\x00\xd8\x04\x0f\x56\xaf\x59\x22\x11\xaf\x59\x00\x00\x00\x00\x00\x00\xbc\x08\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\xbc\x08\x3e\x03\x00\x00\x65\x52\xeb\x52\xae\x72\x71\x53\x00\x00\x5e\x00\x5c\x03\x16\x72\x71\x53\x00\x00\xce\x08\x00\x00\x6c\x08\x6f\x08\x70\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x6c\x3f\x00\x77\x08\x00\x00\x00\x00\x72\x08\x74\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x00\x9d\x04\x78\x08\x85\x08\x00\x00\x00\x00\x00\x00\xae\x72\x00\x00\x64\x00\x00\x00\x3f\x00\x68\x03\x87\x08\x00\x00\xef\x2b\x0f\x56\x00\x00\x00\x00\xaf\x08\xa8\x08\x71\x53\x36\x05\x00\x00\x00\x00\x71\x53\xf7\x53\x00\x00\xaf\x59\x00\x00\xac\x08\x67\x05\x00\x00\x00\x00\x7d\x54\x00\x00\x00\x00\xa4\x08\x00\x00\xad\x08\x7d\x54\x4d\x40\x00\x00\xb1\x04\x92\x08\x00\x00\x9d\x04\x00\x00\x9d\x04\x00\x00\x08\x03\x00\x00\xfc\x08\x55\x02\x00\x00\x13\x00\xe7\x08\x97\x08\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x54\x00\x00\xb4\x08\x25\x27\xa9\x27\x37\x4e\x00\x00\x00\x00\xd2\x70\x00\x00\x00\x00\x95\x56\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x08\x51\x6b\x80\x6c\x00\x00\x00\x00\xa7\x08\xaa\x08\xa2\x08\x00\x00\x9d\x04\x1b\x05\x00\x00\x51\x6b\x00\x00\xdc\x05\xae\x72\x00\x00\xfe\x08\x36\x06\x72\x68\x9d\x04\x00\x00\x9d\x04\x9d\x04\x00\x00\x9d\x04\x00\x00\x00\x00\x00\x00\xa1\x08\xcf\x08\x00\x00\x9d\x04\x00\x00\x36\x06\x00\x00\x02\x09\x15\x09\xb7\x08\x00\x00\x00\x00\x85\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x09\x00\x00\xb5\x08\x9d\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x36\x04\x1c\x09\x01\x09\xf1\x5c\x48\x01\xdc\x60\xc1\x5f\xb8\x06\x3b\x5d\x01\x00\xe4\x1d\xd2\x00\xb9\x02\xc7\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x04\x00\x00\x00\x00\x49\x00\x00\x00\x00\x00\x04\x08\x07\x08\xff\x02\x00\x00\x45\x06\x60\x06\x3b\x14\x8a\x21\x00\x00\x00\x00\x00\x00\x00\x00\x94\x08\x00\x00\x0b\x0e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x02\xc8\x03\x00\x00\x00\x00\x6e\x00\x02\x1e\x08\x10\xc1\x0f\x6a\x01\x88\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x07\xfe\x07\x9a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x0a\x00\x00\x77\x66\x0b\x74\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x61\xc9\x5e\x0c\x06\x1f\x04\x40\x74\x3a\x08\x80\x74\x00\x00\x12\x72\x93\x73\xb5\x74\xc6\x74\xfb\x74\x4b\x09\xd5\x07\xd1\x08\x3b\x75\x90\x09\x42\x08\x45\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x61\x23\x72\x20\x1e\x69\x08\xd3\x61\xdc\x68\xf4\x02\x0e\x09\x00\x00\x00\x00\x8f\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x06\xa4\x02\x55\x06\xcc\x03\x65\x06\x7b\x06\xc0\x04\x9b\x0b\xf5\x02\x53\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x01\x5b\x07\x00\x00\xbe\xff\x12\x07\xc8\x08\x00\x00\x1b\x01\xbf\x08\xa7\xff\xe5\x06\x43\x05\x33\x04\x0a\x0b\x50\x04\x00\x00\x00\x00\x00\x00\x1e\x09\x00\x00\x10\x08\x00\x00\x38\x01\x00\x00\x12\x08\xd9\x01\x00\x00\x98\x02\xd0\x08\x00\x00\x00\x00\x14\x08\xd2\x08\x25\x09\x00\x00\x8e\x72\xe4\x01\x70\x75\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x75\x62\x03\x3d\x02\xcd\x08\x00\x00\x00\x00\x00\x00\x63\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x06\x00\x00\xa3\xff\x00\x00\x3c\xff\x13\x04\x00\x00\xcc\x08\xd5\x08\x00\x00\x00\x00\xbe\x08\x00\x00\x00\x00\x34\x03\xb7\x23\xed\x03\x13\x09\xd4\x08\xdb\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x0b\x00\x00\x00\x00\xca\x23\xb1\x08\x00\x00\x00\x00\x8b\x05\x00\x00\xc7\x68\x00\x00\x00\x00\xc8\x12\x9a\x02\x03\x09\xa2\x07\x00\x00\x46\x60\xb9\x0f\x00\x00\x00\x00\x00\x00\x27\x05\xba\x0d\x00\x00\xa0\xff\x00\x00\x00\x00\x9f\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x09\xb9\x0a\x00\x00\x00\x00\x00\x00\xfb\x05\x00\x00\x00\x00\x93\x73\xcc\x02\x00\x00\x00\x00\x41\x03\x00\x00\xda\x08\xd9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x40\x00\x00\x30\x05\x00\x00\xe6\x08\x69\x05\x4b\x11\x00\x00\x9a\x00\x00\x00\x00\x00\x00\x00\xea\x02\x60\x03\x52\x00\xf5\x12\xe9\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x01\x8e\x05\x00\x00\x00\x00\x00\x00\x00\x00\xec\xff\xfa\xff\x00\x00\x8f\x0a\x00\x00\x00\x00\x86\x5d\xd1\x5d\x00\x00\x00\x00\x00\x00\x98\x08\x00\x00\xa0\xff\x00\x00\x00\x00\x00\x00\xc5\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x75\x00\x00\x06\x73\x00\x00\x00\x00\x2c\x08\x2f\x08\xab\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x08\x4b\xff\x00\x00\x00\x00\x44\x5e\xe4\x05\x00\x00\xf6\x75\xe4\x61\x65\x03\x65\x02\x00\x00\x05\x0e\x00\x00\x9d\x21\x88\x66\xfb\x66\x0c\x67\x7f\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x1b\xdf\x0f\xfb\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x01\x00\x00\x00\x00\x00\x00\x00\x00\x19\x02\x68\xff\xbd\x21\x17\x0f\x00\x00\xb2\x24\x00\x00\x1b\x10\x00\x00\xd0\x21\xf9\x21\x44\x11\x68\x22\xb7\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x3f\x08\x00\x00\x82\x02\xf1\x08\x0d\x09\x00\x00\x5c\x09\x5e\x09\x00\x00\x00\x00\x51\x09\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x09\x00\x00\x85\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xff\x00\x00\xa4\x22\xfb\x01\x00\x00\x3e\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x1c\x11\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x08\xa5\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x62\x68\x62\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x5b\x31\x5b\x00\x00\x19\x5a\xed\x59\xdb\x62\x00\x00\x33\x0b\x00\x00\x2c\x0d\x5d\x5c\xad\x0b\x00\x00\x5b\xff\x00\x00\x00\x00\x00\x00\x3f\x0a\x00\x00\x00\x00\xfa\x73\x5f\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x95\x01\x65\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd2\xff\x00\x00\x00\x00\x00\x00\x6d\x08\x00\x00\x00\x00\xac\x01\x00\x00\x00\x00\x00\x00\x71\x08\x00\x00\x00\x00\x00\x00\x00\x00\x97\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x0a\x74\x03\x00\x00\x00\x00\x08\x05\x30\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x06\x00\x00\x8f\x0a\x00\x00\x00\x00\x9f\x03\x00\x00\x9d\x05\x00\x00\x00\x00\xc7\x68\x73\x10\x84\x10\x2b\x76\xc4\x22\x34\x0e\x45\x0e\xbf\x0e\xd3\x0e\x1b\x0d\xf3\x10\x00\x00\x00\x00\x00\x00\x34\x00\x70\x07\x00\x00\x00\x00\x00\x00\xf3\x68\x00\x00\x00\x00\xcc\xff\x00\x00\xec\x62\xb7\x5e\xdd\x23\x23\x09\xc2\x05\x3a\x09\xf7\x1b\x00\x00\x00\x00\x00\x00\x16\x09\x10\x09\x00\x00\x20\x09\x00\x00\xb1\x11\x00\x00\x00\x00\x00\x00\x00\x00\x59\x06\x4b\x06\x52\x09\x00\x00\x00\x00\x3d\x01\xd5\x1e\xf0\x0c\x19\x04\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\xff\xab\x02\x00\x00\x7b\x08\x13\x13\x00\x00\xb6\xff\xc1\xff\x58\x60\xcb\x60\x2f\x09\x00\x00\x33\x09\x00\x00\x39\x09\x00\x00\x6e\x06\x2d\x09\x00\x00\x00\x00\x00\x00\x7a\x06\xd3\x04\x00\x00\x3c\x76\x9a\x08\x00\x00\x00\x00\x8e\x04\x00\x00\x8e\x09\x00\x00\xa4\x09\x00\x00\xa5\x09\x00\x00\x00\x00\x7b\x02\x00\x00\x9b\x09\x00\x00\xed\xff\x00\x00\x73\x00\x00\x00\x98\x09\x00\x00\x15\x06\xd7\x22\x00\x00\x00\x00\x00\x00\x00\x00\x42\x09\x00\x00\x22\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x73\x9b\xff\x00\x00\x61\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x1e\x80\x09\x11\x1f\x1f\x01\x00\x00\x67\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x09\x00\x00\x00\x00\x00\x00\x00\x00\x87\x09\xa8\x1f\x00\x00\x00\x00\xc6\x1f\x00\x00\x00\x00\x2d\x02\x00\x00\x62\x09\x00\x00\x00\x00\x58\x09\x00\x00\x00\x00\xf5\x06\x00\x00\x29\x01\x00\x00\x00\x00\x7c\x01\x24\x09\x20\x06\xe4\x1f\x32\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\x11\x00\x00\x00\x00\x0d\x12\x00\x00\x00\x00\x00\x00\x00\x00\x87\x06\x00\x00\xa3\x06\x5f\x63\x00\x00\x00\x00\x68\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\x02\x00\x00\x00\x00\xa8\x09\x00\x00\x3c\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x63\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x05\x00\x00\x9c\x08\x00\x00\x00\x00\x9e\x5a\x00\x00\x00\x00\xbb\x05\x00\x00\xa0\x08\x00\x00\x00\x00\xc7\x5b\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x63\xd3\x5f\xf4\x63\x00\x00\x00\x00\xc4\x00\x27\x0c\xb6\x00\x00\x00\x00\x00\x2f\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x20\x00\x00\x99\x20\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\xca\x09\x00\x00\x00\x00\x00\x00\xbf\x09\xc4\x09\x00\x00\x7f\x07\x83\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x09\x00\x00\x00\x00\x12\x5c\x00\x00\x00\x00\x6f\x09\xf9\x08\x67\x64\x00\x00\x00\x00\xca\x5a\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x5c\x4e\x5f\xa6\x0d\x00\x00\x00\x00\x00\x00\x13\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x23\x83\x01\x00\x00\x00\x00\x2a\x09\x00\x00\xdc\xff\x51\x06\x00\x00\x00\x00\x26\x24\x3b\x09\x7d\x06\x00\x00\x00\x00\x78\x64\x00\x00\xd9\x03\x52\x04\x00\x00\x3c\x09\xe9\x06\x00\x00\x00\x00\x00\x00\x55\x12\x00\x00\x00\x00\x00\x00\x00\x00\x78\x09\x00\x00\x00\x00\x00\x00\x9e\x09\xb8\xff\x00\x00\x6c\x24\x00\x00\xb0\x13\x00\x00\x00\x00\xeb\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc8\xff\x00\x00\xbc\x02\x8f\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x08\x00\x00\xda\x09\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x00\x00\xdb\x09\xc8\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x01\x11\x02\xcf\x09\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x06\xba\x08\x57\x04\x4d\x03\x82\x05\x3e\x00\x00\x00\x00\x00\xc7\x09\x00\x00\xeb\x64\x00\x00\x00\x00\x00\x00\xb7\x05\x2d\x06\x00\x00\x00\x00\xce\x13\x00\x00\x00\x00\x00\x00\x00\x00\xa9\x09\x00\x00\x24\x02\x71\x02\x00\x00\x00\x00\x00\x00\x2d\x02\x00\x00\x00\x00\xc0\x08\x00\x00\xab\x09\x82\x73\x26\x04\x00\x00\x00\x00\x00\x00\x8b\x06\x00\x00\x97\x23\x52\x01\x25\x02\x00\x00\x96\x00\xb3\x09\x00\x00\x00\x00\x00\x00\x00\x00\x14\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x0f\xf3\x06\x00\x00\x00\x00\xaa\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x64\x6f\x65\x80\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x0c\xad\x03\x00\x00\x00\x00\x00\x00\xd6\x08\x00\x00\xd4\x09\xd3\x08\x0e\x00\x00\x00\x00\x00\x0e\x03\x0f\x03\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x09\x01\x0a\x00\x00\x14\x00\x91\x09\xd7\x08\x00\x00\x00\x00\x00\x00\xf3\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdd\x08\x00\x00\xb7\x20\x1f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x08\x00\x00\x57\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x05\x00\x00\xb9\x09\x16\x05\x7f\x24\x8f\x0a\x92\x24\x00\x00\x00\x00\x00\x00\xcc\x09\x00\x00\xec\x08\x00\x00\x00\x00\x00\x00\xcd\x09\x00\x00\x00\x00\xee\x01\xcb\x02\xba\xff\xd5\x20\x00\x00\xed\x08\x00\x00\xdb\xff\x00\x23\x00\x00\xf6\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\xf0\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x78\x07\xf5\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\xf7\x08\x00\x00\xfd\x08\x00\x00\x00\x00\x00\x00\xc8\x04\x0e\x06\x00\x00\x00\x00\xde\x09\xe4\x09\x16\x14\xe3\x09\x00\x00\x00\x00\xf3\x20\x20\x1c\x00\x00\xc6\x24\x00\x00\x00\x00\x6d\x02\x00\x00\x00\x00\x08\x0b\x00\x00\x00\x00\x73\x06\x00\x00\x00\x00\xc6\x1d\x04\x66\x00\x00\xc0\x09\x23\x0a\x00\x00\xff\xff\x00\x00\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x14\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x08\x00\x00\x00\x00\xe5\x00\x00\x00\x00\x00\xb7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x02\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x2e\x00\x00\x00\x00\x00\x20\x0a\x00\x00\x00\x00\x00\x00\x09\x09\xd6\x04\x00\x00\x44\x00\x00\x00\x3a\x01\xb9\xff\x00\x00\x00\x00\x33\x0a\x08\x00\x11\x09\x00\x00\x02\x00\x18\x09\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x09\x00\x00\x34\x0a\x00\x00\x99\x09\x91\x06\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x06\x00\x00\x00\x00\x26\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# -happyAdjustOffset off = off - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\xc1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfd\x00\x00\x00\x00\xc0\xff\xc1\xff\x00\x00\xf2\xff\xf5\xfc\xf1\xfc\xee\xfc\xdf\xfc\xdd\xfc\xde\xfc\xdc\xfc\xdb\xfc\xda\xfc\xec\xfc\xeb\xfc\xed\xfc\xea\xfc\xe9\xfc\xd9\xfc\xd8\xfc\xd7\xfc\xd6\xfc\xd5\xfc\xd4\xfc\xd3\xfc\xd2\xfc\xd1\xfc\xd0\xfc\xce\xfc\xcf\xfc\x00\x00\xef\xfc\xf0\xfc\x91\xff\x00\x00\xb5\xff\x00\x00\x00\x00\x91\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\xfe\x00\x00\x81\xfe\x7e\xfe\x78\xfe\x77\xfe\x73\xfe\x74\xfe\x55\xfe\x54\xfe\x00\x00\x6a\xfe\x28\xfd\x6e\xfe\x23\xfd\x1a\xfd\x1d\xfd\x16\xfd\x69\xfe\x6d\xfe\xfe\xfc\xfb\xfc\x68\xfe\x43\xfe\xf9\xfc\xf8\xfc\xfa\xfc\x00\x00\x00\x00\x13\xfd\x12\xfd\x00\x00\x00\x00\x67\xfe\x11\xfd\x21\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xfc\x19\xfd\x14\xfd\x15\xfd\x4e\xfe\x1b\xfd\x17\xfd\x18\xfd\x52\xfd\x51\xfe\x50\xfe\x4f\xfe\x52\xfe\x00\x00\xf6\xfd\xf5\xfd\x00\x00\xf1\xff\x43\xfd\x33\xfd\x42\xfd\x35\xfd\xef\xff\xf0\xff\x02\xfd\xe7\xfc\xe8\xfc\xe3\xfc\xe0\xfc\x41\xfd\xcb\xfc\x2e\xfd\xc8\xfc\xc5\xfc\xee\xff\xe2\xfc\xcc\xfc\xcd\xfc\x00\x00\x00\x00\x00\x00\x00\x00\xc9\xfc\xe1\xfc\xc6\xfc\xca\xfc\xe4\xfc\xc7\xfc\xb1\xfd\x63\xfd\x9c\xfc\xec\xfd\x00\x00\xe7\xfd\xdf\xfd\xd0\xfd\xcd\xfd\xbd\xfd\xbc\xfd\x00\x00\x00\x00\x69\xfd\x66\xfd\xca\xfd\xc9\xfd\xcb\xfd\xcc\xfd\xc8\xfd\xf4\xfd\x9b\xfc\xbe\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\xfd\xc4\xfc\xc3\xfc\xc2\xfc\xc7\xfd\xc6\xfd\xb7\xfc\xb6\xfc\xc1\xfc\xc0\xfc\xbf\xfc\xbe\xfc\xbd\xfc\xbc\xfc\xbb\xfc\xba\xfc\xb9\xfc\xb8\xfc\xb5\xfc\xb4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xfd\x75\xff\x04\xfe\x00\x00\x00\x00\x00\x00\xf1\xfc\x73\xff\x72\xff\x71\xff\x00\x00\x00\x00\xfa\xfd\x00\x00\xfa\xfd\xfa\xfd\x00\x00\x4f\xfd\x00\x00\x00\x00\x90\xfc\x00\x00\x77\xfd\x00\x00\x00\x00\x67\xff\x61\xff\x66\xff\x65\xff\x64\xff\x07\xff\x00\x00\x63\xff\x62\xff\x0f\xfe\x5c\xff\x5b\xff\x12\xfe\x5a\xff\x00\x00\x1e\xff\x3d\xff\x3e\xff\xba\xfe\x1d\xff\x00\x00\x00\x00\x00\x00\xcc\xfe\xb0\xfe\xb8\xfe\x00\x00\x00\x00\x00\x00\x67\xfd\x00\x00\x8b\xff\x00\x00\x00\x00\x00\x00\x91\xff\xc2\xff\x00\x00\x91\xff\x00\x00\x8e\xff\xba\xfe\xb1\xfc\xb0\xfc\x00\x00\xba\xfe\x89\xff\x00\x00\x00\x00\x00\x00\x00\x00\x44\xfd\x3d\xfd\x45\xfd\xf7\xfc\x3f\xfd\x00\x00\x00\x00\x00\x00\xb0\xfe\x00\x00\xb5\xfe\x00\x00\x00\x00\x00\x00\xad\xfe\xb1\xfe\xb2\xfe\x00\x00\xcd\xfe\xca\xfe\x00\x00\x3c\xfd\x00\x00\x00\x00\x00\x00\x60\xff\x00\x00\x00\x00\x00\x00\x00\x00\x7e\xfe\x28\xfd\x1c\xff\x00\x00\x00\x00\x00\x00\x47\xff\x00\x00\xb8\xfe\x3f\xff\x00\x00\x40\xff\x42\xff\x41\xff\x00\x00\x00\x00\x3c\xff\x00\x00\x3b\xfe\x00\x00\x0e\xff\x00\x00\x08\xfd\x00\x00\x07\xfd\x09\xfd\x00\x00\x00\x00\x07\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\xfd\x94\xfc\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x05\xfd\x00\x00\x04\xfd\x06\xfd\x00\xfd\xe5\xfc\x00\x00\xe6\xfc\x2e\xfd\x00\x00\x00\x00\xf3\xfd\x00\x00\x93\xfc\x00\x00\xaa\xfc\x00\x00\xe2\xfc\x00\x00\x32\xfd\xae\xfc\x00\x00\x3a\xfd\x93\xfe\x00\x00\x00\x00\x50\xfd\x4e\xfd\x4c\xfd\x4b\xfd\x48\xfd\x00\x00\x00\x00\x00\x00\xf9\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfd\xd4\xfe\x00\x00\xd7\xfe\xd7\xfe\x00\x00\x00\x00\xb0\xfe\x74\xff\xb8\xfd\x2c\xfd\xb9\xfd\x00\x00\x00\x00\x00\x00\xaa\xfd\xcc\xfd\x00\x00\x00\x00\x6c\xff\x6c\xff\x00\x00\x00\x00\x00\x00\xd2\xfd\x6a\xfd\x6a\xfd\xd3\xfd\xba\xfd\xbb\xfd\xa8\xfd\xa2\xfd\x00\x00\x00\x00\xe5\xfc\xe6\xfc\x00\x00\x37\xfd\x00\x00\x97\xfd\x00\x00\x96\xfd\x31\xfd\xdb\xfd\xdc\xfd\xdd\xfd\xe8\xfd\x70\xfd\x71\xfd\x00\x00\x74\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xfd\x65\xfd\x00\x00\x9a\xfc\x62\xfd\xe5\xfd\x00\x00\xd5\xfd\x7c\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\xfd\xe2\xfd\x00\x00\x87\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\xfd\x5b\xfe\x5a\xfe\x6c\xfe\x6b\xfe\x56\xfe\x0b\xfd\x49\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x48\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x61\xfe\x00\x00\x1d\xfd\x00\x00\x00\x00\x63\xfe\x00\x00\x58\xfe\x00\x00\x00\x00\x20\xfe\x1e\xfe\x8d\xfe\x00\x00\x65\xfe\x66\xfe\x89\xfe\x8a\xfe\x00\x00\x43\xfe\x42\xfe\x3f\xfe\x3d\xfe\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x72\xfe\x00\x00\x70\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\xfe\x75\xfe\x00\x00\xe9\xff\x00\x00\x00\x00\xb2\xff\x8e\xff\xba\xfe\xba\xfe\xb1\xff\xac\xff\xac\xff\xb0\xff\xae\xff\xaf\xff\x92\xff\xed\xff\xb2\xfc\xb3\xfc\xea\xff\x00\x00\xd6\xff\xdd\xff\xda\xff\xdc\xff\xdb\xff\xde\xff\xec\xff\x34\xfe\x85\xfe\x83\xfe\x7a\xfe\x7b\xfe\x7d\xfe\x00\x00\x71\xfe\x76\xfe\x6f\xfe\x82\xfe\x00\x00\x00\x00\x44\xfe\x87\xfe\x88\xfe\x00\x00\x00\x00\x64\xfe\x00\x00\x00\x00\x5e\xfe\x00\x00\x24\xfd\x27\xfd\xaf\xfc\x22\xfd\x5d\xfe\x00\x00\xab\xfc\x25\xfd\x26\xfd\x5f\xfe\x60\xfe\x00\x00\x00\x00\xfd\xfc\x1c\xfd\x00\x00\x00\x00\x13\xfd\x12\xfd\x67\xfe\x11\xfd\x5c\xfe\x14\xfd\x15\xfd\x18\xfd\x48\xfe\x00\x00\x4a\xfe\x38\xfd\x40\xfd\xf3\xfc\x36\xfd\x2d\xfd\x01\xfd\x9d\xfc\x9e\xfc\x9f\xfc\xa0\xfc\xa1\xfc\xe1\xfd\x00\x00\x61\xfd\x5e\xfd\x5b\xfd\x00\x00\xf1\xfc\x5d\xfd\xce\xfd\xf2\xfc\x64\xfd\xde\xfd\x00\x00\x00\x00\x00\x00\x83\xfd\x81\xfd\x7d\xfd\x7a\xfd\x00\x00\xe6\xfd\x00\x00\x00\x00\xe4\xfd\xe3\xfd\x73\xfd\xd7\xfd\x71\xfd\x00\x00\xd8\xfd\x00\x00\x00\x00\x00\x00\x72\xfd\x00\x00\xbf\xfd\x95\xfd\x00\x00\x00\x00\xf4\xfc\x99\xfd\x9e\xfd\xc0\xfd\x9f\xfd\x98\xfd\x9d\xfd\xc1\xfd\x00\x00\x00\x00\x6b\xfd\x00\x00\xb6\xfd\xb3\xfd\xb4\xfd\xa3\xfd\xa4\xfd\x00\x00\x00\x00\xb2\xfd\xb5\xfd\x2a\xfd\x00\x00\x2b\xfd\x29\xfd\x00\x00\x07\xfe\x8f\xfe\x00\x00\x00\x00\x0e\xfe\xd8\xfe\x95\xfe\x0d\xfe\xad\xfd\xac\xfd\x00\x00\x54\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xfe\xf1\xfe\x01\xfe\x4d\xfe\x00\x00\x00\x00\x00\x00\xc8\xfe\xc7\xfe\x00\x00\x00\x00\x00\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\xfd\x34\xfd\x92\xfc\xc3\xfd\xac\xfc\xf4\xfc\xa0\xfd\xc4\xfd\xc5\xfd\x00\x00\xc2\xfd\xf2\xfd\x88\xfc\x00\x00\xa1\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\xfd\x8f\xfc\x00\x00\x19\xff\x00\x00\x8f\xfe\xeb\xfd\xea\xfd\x00\x00\xe9\xfd\x11\xfe\xd0\xfe\x09\xfe\x00\x00\x00\x00\x00\x00\xe5\xfe\x36\xfe\x17\xff\x49\xfe\x43\xff\x91\xfe\x8f\xfe\xba\xfe\x00\x00\x00\x00\xa6\xfe\xaa\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\xff\x00\x00\x15\xff\x4e\xff\x00\x00\x43\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x9f\xfe\x9e\xfe\x9d\xfe\x9c\xfe\x9b\xfe\x00\x00\x00\x00\x30\xfd\x00\x00\x00\x00\xfb\xfe\xf8\xfe\x00\x00\x00\x00\x00\x00\xc1\xfe\xc9\xfe\x00\x00\x5d\xff\xce\xfe\x5f\xff\xb0\xfe\x00\x00\x47\xfd\xb9\xfe\x5e\xff\xb8\xfe\x00\x00\x10\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x95\xfe\x8c\xff\x85\xff\x8a\xff\xac\xff\xbc\xff\xac\xff\xbb\xff\xb8\xff\x69\xff\xbd\xff\x90\xff\xb9\xff\xba\xff\x00\x00\xba\xfe\x00\x00\x87\xff\x86\xff\x00\x00\x00\x00\xa5\xfe\xa3\xfe\x00\x00\x00\x00\x00\x00\xb7\xfe\x00\x00\xab\xfe\xaf\xfe\xcf\xfe\x00\x00\x00\x00\x00\x00\xbf\xfe\x78\xfd\xfd\xfe\xfe\xfe\x00\x00\xf6\xfe\xf7\xfe\xf2\xfe\x00\x00\xfa\xfe\x00\x00\xa1\xfe\x00\x00\x99\xfe\x98\xfe\x9a\xfe\x00\x00\xa0\xfe\x51\xff\x52\xff\x57\xff\x00\x00\x00\x00\x3b\xff\x00\x00\x00\x00\x05\xff\x03\xff\x02\xff\xff\xfe\x00\xff\x48\xff\x49\xff\x4b\xff\x4a\xff\xdb\xfe\x00\x00\xa7\xfe\xbc\xfe\x00\x00\x47\xff\x00\x00\x00\x00\x53\xff\x00\x00\x3a\xfe\x38\xfe\x00\x00\x59\xff\x00\x00\x0f\xff\x00\x00\xd0\xfe\x0b\xfe\x0a\xfe\x00\x00\x91\xfc\x19\xff\x00\x00\x0a\xff\x43\xfe\x31\xfe\x1c\xfe\x00\x00\x26\xfe\x08\xff\x00\x00\xee\xfd\x8e\xfc\x8d\xfc\x95\xfc\x96\xfc\x97\xfc\x98\xfc\x99\xfc\x79\xfe\xef\xfd\xf1\xfd\x00\x00\xaf\xfd\x9c\xfd\xad\xfc\x03\xfd\xff\xfc\x39\xfd\x92\xfe\x03\xfe\x4d\xfd\x4a\xfd\x3e\xfd\x49\xfd\xff\xfd\x00\x00\xf8\xfd\x00\x00\x00\x00\xfc\xfd\x02\xfe\x3b\xfd\xd3\xfe\x55\xfd\xd6\xfe\xd9\xfe\x00\x00\xd2\xfe\xd5\xfe\x00\x00\x05\xfe\x0d\xfd\x6f\xff\x0e\xfd\x0c\xfd\x00\x00\xa6\xfd\xa5\xfd\x6e\xff\x6f\xfd\x6c\xfd\x6e\xfd\xa7\xfd\xa9\xfd\xb0\xfd\x9b\xfd\x9a\xfd\xa2\xfd\x8f\xfd\x91\xfd\x8e\xfd\x8c\xfd\x89\xfd\x88\xfd\x00\x00\x93\xfd\x90\xfd\xd9\xfd\x76\xfd\x00\x00\xa2\xfc\x00\x00\x8a\xfc\x81\xfc\x00\x00\x00\x00\xa3\xfc\x00\x00\xa6\xfc\x00\x00\x8c\xfc\x84\xfc\x71\xfd\x00\x00\xa7\xfc\xd1\xfd\xda\xfd\x00\x00\x00\x00\x00\x00\x7b\xfd\xd4\xfd\x00\x00\x00\x00\x00\x00\xcf\xfd\x57\xfe\x00\x00\x0a\xfd\x47\xfe\x46\xfe\x45\xfe\x00\x00\x00\x00\x8e\xfe\x1d\xfe\x1f\xfe\xf6\xfc\x00\x00\x41\xfe\x00\x00\x7c\xfe\x00\x00\xd9\xff\xd8\xff\xd7\xff\x00\x00\xeb\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe8\xff\x00\x00\x00\x00\xd5\xff\x00\x00\x00\x00\x53\xfe\x62\xfe\x00\x00\x5f\xfd\x5c\xfd\x59\xfd\x57\xfd\x79\xfd\x82\xfd\xe5\xfd\xa9\xfc\x8b\xfc\x85\xfc\xa8\xfc\x80\xfc\xd0\xfe\x7e\xfd\x00\x00\xa5\xfc\x89\xfc\x82\xfc\xa4\xfc\x7f\xfc\x87\xfd\xd4\xfc\x00\x00\x00\x00\x94\xfd\x6d\xfd\x6d\xff\x93\xff\x00\x00\x06\xfe\x53\xfd\xda\xfe\x56\xfd\x00\x00\x8c\xfe\x00\x00\xf7\xfd\x00\x00\xf0\xfd\x09\xff\x2c\xfe\x2a\xfe\x00\x00\x43\xfe\x18\xff\x55\xff\x1b\xfe\x19\xfe\x00\x00\x1c\xfe\x00\x00\x00\x00\x00\x00\x31\xfe\x1c\xfe\xd1\xfe\x0c\xfe\x00\x00\xe6\xfe\xe9\xfe\xe9\xfe\x35\xfe\x36\xfe\x36\xfe\x16\xff\x58\xff\x90\xfe\x00\x00\xbb\xfe\xa9\xfe\x00\x00\x4f\xff\x00\x00\x01\xff\x13\xff\x14\xff\x36\xff\x00\x00\x2b\xff\x00\x00\x00\x00\x00\x00\xa2\xfe\x2f\xfd\x00\x00\xf9\xfe\xfc\xfe\x00\x00\x00\x00\xbf\xfe\xbe\xfe\x00\x00\x00\x00\xc6\xfe\xc4\xfe\x00\x00\x46\xfd\xb3\xfe\xa4\xfe\x0f\xfd\x94\xfe\x10\xfe\x00\x00\x88\xff\x00\x00\x00\x00\xab\xff\xa6\xff\xa5\xff\x00\x00\xa8\xff\x00\x00\x6b\xff\x68\xff\x8f\xff\x94\xff\x6a\xff\xc3\xff\x91\xff\x91\xff\xa0\xff\x98\xff\x95\xff\x21\xfd\x96\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\xfe\xad\xff\xc4\xff\x85\xff\xc5\xfe\x00\x00\x00\x00\xc0\xfe\xc2\xfe\xd7\xfe\xd7\xfe\xf5\xfe\x96\xfe\x00\x00\x00\x00\x3a\xff\x00\x00\x56\xff\x00\x00\xdc\xfe\xdf\xfe\xdf\xfe\xa8\xfe\x06\xff\x39\xfe\x37\xfe\xef\xfe\xea\xfe\x00\x00\xee\xfe\x25\xff\x00\x00\x00\x00\x00\x00\x08\xfe\x4d\xff\x1c\xfe\x0b\xff\x00\x00\x2e\xfe\x2e\xfe\x54\xff\x00\x00\x18\xfe\x15\xfe\x44\xff\x46\xff\x45\xff\x00\x00\x1a\xfe\x00\x00\x00\x00\x80\xfe\x25\xfe\x28\xfe\x00\x00\x26\xfe\xfd\xfd\xfe\xfd\x00\x00\x70\xff\x92\xfd\x8b\xfd\x8a\xfd\x8d\xfd\x00\x00\x00\x00\x00\x00\x83\xfc\x7f\xfd\x80\xfd\x86\xfc\x00\x00\x00\x00\x00\x00\x59\xfe\x40\xfe\x3e\xfe\x00\x00\xc9\xff\x8b\xff\x00\x00\x00\x00\x00\x00\xb6\xff\x91\xff\x91\xff\xb7\xff\xb3\xff\xb4\xff\xcd\xff\xca\xff\xd4\xff\xe7\xff\xce\xfc\xba\xfe\x00\x00\xcc\xff\x58\xfd\x5a\xfd\x00\x00\x86\xfd\x85\xfd\x00\x00\x8b\xfe\x2b\xfe\x48\xfe\x00\x00\x00\x00\x00\x00\x27\xfe\x4c\xfe\x00\x00\x14\xfe\x16\xfe\x17\xfe\x00\x00\x2f\xfe\x00\x00\x00\x00\x00\x00\x0c\xff\x4c\xff\xe8\xfe\xeb\xfe\x27\xff\x12\xff\x00\x00\x00\x00\x00\x00\x00\x00\x24\xff\xe7\xfe\xe4\xfe\x23\xff\xe0\xfe\x00\x00\xe3\xfe\x1b\xff\x1a\xff\x23\xff\x00\x00\x35\xff\x2d\xff\x2d\xff\x00\x00\x00\x00\x97\xfe\x00\x00\x00\x00\xbf\xfe\x00\x00\xcb\xfe\x83\xff\xa7\xff\x00\x00\x00\x00\x00\x00\xa2\xff\x97\xff\xa3\xff\xa1\xff\xa4\xff\x9e\xff\x00\x00\x00\x00\xbf\xff\xbe\xff\x00\x00\x9d\xff\x9b\xff\x9a\xff\x99\xff\x20\xfd\x1f\xfd\x1e\xfd\x81\xff\x00\x00\x00\x00\x00\x00\xf4\xfe\xf3\xfe\x2c\xff\x39\xff\x37\xff\x00\x00\x2e\xff\x00\x00\x00\x00\x00\x00\xde\xfe\xe1\xfe\x00\x00\x22\xff\xdd\xfe\x07\xff\x17\xff\x00\x00\x12\xff\x26\xff\x29\xff\x00\x00\x00\x00\xec\xfe\x00\x00\x33\xfe\x00\x00\x2e\xfe\x32\xfe\x13\xfe\x00\x00\x25\xfe\x29\xfe\xac\xfc\x24\xfe\x23\xfe\xaa\xfc\x00\x00\xd6\xfd\xba\xfe\xac\xff\xc5\xff\x00\x00\xc6\xff\x00\x00\xcb\xff\x00\x00\xd0\xff\xce\xff\x00\x00\xe3\xff\x00\x00\x00\x00\xac\xff\x84\xfd\x22\xfe\x4b\xfe\x30\xfe\x00\x00\x0d\xff\x00\x00\x69\xfe\x68\xfe\x00\x00\x11\xff\x28\xff\x00\x00\xed\xfe\x2a\xff\x00\x00\x21\xff\xe2\xfe\x32\xff\x34\xff\x2f\xff\x31\xff\x33\xff\x38\xff\xc3\xfe\xbd\xfe\x84\xff\x8d\xff\x82\xff\x00\x00\x7d\xff\x00\x00\x9f\xff\x9c\xff\xa0\xff\x00\x00\x7e\xff\x79\xff\x00\x00\x00\x00\x7b\xff\x7d\xff\x30\xff\x19\xff\x00\x00\x2d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\xe4\xff\x00\x00\xd3\xff\xd1\xff\xd2\xff\xcf\xff\xe5\xff\x00\x00\x00\x00\xe2\xff\x00\x00\xc7\xff\x00\x00\x10\xff\x31\xfe\x1c\xfe\x00\x00\x76\xff\x77\xff\x7c\xff\x80\xff\x78\xff\x7a\xff\x7f\xff\x20\xff\x1c\xfe\xc8\xff\x00\x00\x00\x00\xe1\xff\xdf\xff\xe0\xff\x1f\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x00\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x4e\x00\x4e\x00\x06\x00\x4f\x00\x4c\x00\x68\x00\x04\x00\x3b\x00\x67\x00\x07\x00\x08\x00\x09\x00\x04\x00\x0b\x00\xac\x00\x0e\x00\x08\x00\x09\x00\x04\x00\x0b\x00\x7f\x00\x80\x00\x08\x00\x09\x00\x68\x00\x0b\x00\x08\x00\x09\x00\x09\x00\x0b\x00\x0b\x00\x49\x00\x01\x00\x3a\x00\x3c\x00\x3d\x00\x69\x00\x8d\x00\x8e\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x00\x00\x47\x00\x13\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\xef\x00\x00\x00\xe1\x00\x00\x00\x18\x00\x00\x00\x00\x00\x4a\x00\x33\x00\x00\x00\x78\x00\x58\x00\x59\x00\x7f\x00\x80\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x61\x00\x62\x00\x14\x01\x2f\x00\x30\x00\x66\x00\x69\x00\x27\x00\x28\x00\x29\x00\x6b\x00\x69\x00\x7f\x00\x80\x00\x12\x00\x00\x00\x00\x00\x4c\x00\x22\x00\x23\x00\x28\x00\x29\x00\x00\x00\x48\x00\x1d\x00\x4b\x00\x48\x00\x72\x00\x12\x00\x68\x00\x28\x00\x29\x00\x77\x00\x09\x00\x36\x00\x37\x00\x38\x00\x83\x00\x2b\x00\x39\x01\x50\x00\x8a\x00\x28\x00\x29\x00\x36\x00\x37\x00\x38\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\xe1\x00\x28\x00\x29\x00\x81\x00\x0b\x00\x3b\x01\x93\x00\x38\x00\x76\x00\x48\x00\x33\x00\x6a\x00\x71\x00\x5a\x00\x27\x01\x50\x00\x29\x01\xc6\x00\x20\x00\x21\x00\x22\x00\x23\x00\x75\x00\x3d\x01\x74\x00\x67\x00\x79\x00\x34\x01\xc1\x00\x81\x00\x67\x00\x67\x00\x81\x00\x67\x00\x70\x00\x67\x00\x8e\x00\x67\x00\x67\x00\x70\x00\x70\x00\x67\x00\x70\x00\x0c\x00\x70\x00\x64\x00\xc2\x00\xbc\x00\xbd\x00\x70\x00\x70\x00\xc7\x00\x0e\x01\x0f\x01\xca\x00\x11\x01\x12\x01\x13\x01\xce\x00\x64\x00\xd0\x00\x8e\x00\x81\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x67\x00\x67\x00\xd9\x00\xda\x00\x2a\x01\x2e\x01\xde\x00\x67\x00\x2e\x01\x70\x00\x70\x00\x34\x01\x6a\x00\x2e\x01\x34\x01\x01\x00\x70\x00\x2e\x01\x64\x00\x34\x01\xde\x00\x1b\x01\x1c\x01\x34\x01\x4b\x00\x3d\x01\x37\x01\x3f\x01\x0c\x00\x29\x01\x29\x01\x29\x01\x2e\x01\x93\x00\x14\x01\x15\x00\x48\x00\xb5\x00\x34\x01\x2a\x01\x34\x01\x34\x01\x34\x01\x2e\x01\x03\x01\x04\x01\x20\x01\x21\x01\x81\x00\x34\x01\x2e\x01\x1b\x01\x1c\x01\x0c\x01\x0d\x01\x27\x01\x34\x01\x29\x01\x11\x01\x12\x01\x13\x01\x93\x00\x71\x00\x4b\x00\x32\x01\x33\x01\x6c\x00\x35\x01\x34\x01\x2e\x01\x00\x00\x39\x01\x50\x00\x0c\x01\x0d\x01\x34\x01\x70\x00\x32\x00\x11\x01\x12\x01\x13\x01\x2a\x01\x15\x01\x2a\x01\x2b\x01\x2e\x01\x2d\x01\x2e\x01\x48\x00\x65\x00\x2a\x01\x34\x01\x4b\x00\x34\x01\x2e\x01\x36\x01\x37\x01\x9f\x00\x25\x01\x3a\x01\x34\x01\xbb\x00\xbc\x00\xbd\x00\x2b\x01\x71\x00\x2d\x01\x2e\x01\x2f\x01\x3c\x01\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3c\x01\x34\x01\x19\x01\x3c\x01\x1b\x01\x1c\x01\x2a\x01\x34\x01\x3c\x01\x70\x00\x2e\x01\x71\x00\x19\x01\x34\x01\x1b\x01\x1c\x01\x34\x01\x34\x01\x34\x01\x57\x00\x2b\x01\x18\x00\x2d\x01\x2e\x01\x19\x01\x05\x00\x1b\x01\x1c\x01\xc1\x00\x34\x01\x2b\x01\x2a\x01\x2d\x01\x2e\x01\x19\x01\x2e\x01\x1b\x01\x1c\x01\x46\x00\x34\x01\x2b\x00\x34\x01\x2b\x01\x17\x00\x2d\x01\x2e\x01\x19\x01\x50\x00\x1b\x01\x1c\x01\x76\x00\x34\x01\x2b\x01\x4b\x00\x2d\x01\x2e\x01\x19\x01\x50\x00\x1b\x01\x1c\x01\x50\x00\x34\x01\x52\x00\x83\x00\x2b\x01\x2a\x01\x2d\x01\x2e\x01\x65\x00\x2e\x01\x9f\x00\x3a\x00\x5a\x00\x34\x01\x2b\x01\x34\x01\x2d\x01\x2e\x01\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x34\x01\x47\x00\xab\x00\xac\x00\x05\x00\x4c\x00\x5a\x00\x71\x00\x71\x00\x70\x00\x2a\x01\x4b\x00\x6a\x00\x48\x00\x2e\x01\x05\x00\x3c\x00\x3d\x00\x58\x00\x59\x00\x34\x01\x4b\x00\x17\x00\x75\x00\x0c\x01\x0d\x01\x61\x00\x61\x00\x62\x00\x11\x01\x12\x01\x13\x01\x66\x00\x17\x00\x95\x00\x1b\x01\x1c\x01\x6b\x00\xfe\x00\xff\x00\x9b\x00\x48\x00\x55\x00\x9e\x00\x9f\x00\xa0\x00\x0b\x00\xa2\x00\xa3\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\x70\x00\x00\x01\x2b\x01\x9f\x00\x2d\x01\x2e\x01\xaa\x00\xab\x00\xac\x00\x1b\x00\x6b\x00\x34\x01\x3a\x00\x36\x01\x37\x01\x8a\x00\x71\x00\x48\x00\x48\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x57\x00\x47\x00\x12\x00\xb5\x00\x70\x00\x48\x00\x2b\x01\x2c\x01\x2d\x01\x2e\x01\xca\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\x34\x01\x3c\x00\x3d\x00\x58\x00\x59\x00\xb5\x00\x2c\x01\x18\x00\x2e\x01\x50\x00\xd9\x00\x48\x00\x61\x00\x62\x00\x34\x01\x69\x00\x76\x00\x66\x00\x10\x00\x70\x00\x33\x00\x34\x00\x6b\x00\x71\x00\x18\x00\x4a\x00\x2b\x00\xb3\x00\xb4\x00\x83\x00\x70\x00\x49\x00\xc2\x00\x52\x00\x27\x01\x21\x00\x29\x01\xc7\x00\x50\x00\x6b\x00\xca\x00\x74\x00\x71\x00\x2b\x00\xce\x00\x71\x00\xd0\x00\x34\x01\x6b\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x8a\x00\x81\x00\xd9\x00\xda\x00\xd1\x00\x6b\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\x18\x00\x71\x00\x69\x00\xa9\x00\xaa\x00\xab\x00\xac\x00\x77\x00\x71\x00\x17\x01\x18\x01\x7b\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x52\x00\x8f\x00\x2b\x00\x27\x01\x29\x01\x29\x01\x52\x00\x53\x00\x27\x01\x28\x01\x29\x01\x50\x00\x27\x01\x5f\x00\x29\x01\x34\x01\x34\x01\x03\x01\x04\x01\x56\x00\x51\x00\x34\x01\x69\x00\x5a\x00\x65\x00\x34\x01\x0c\x01\x0d\x01\x5f\x00\xc2\x00\x71\x00\x11\x01\x12\x01\x13\x01\xc7\x00\x70\x00\x3a\x00\xca\x00\x1d\x01\x1e\x01\x6d\x00\xce\x00\x27\x01\xd0\x00\x29\x01\x50\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x65\x00\x76\x00\xd9\x00\xda\x00\x9f\x00\x34\x01\x2a\x01\x2b\x01\x75\x00\x2d\x01\x2e\x01\x70\x00\x79\x00\x50\x00\x50\x00\x57\x00\x34\x01\x59\x00\x36\x01\x37\x01\x3d\x01\x61\x00\x3a\x01\x95\x00\x6d\x00\x1b\x01\x1c\x01\x65\x00\x71\x00\x9b\x00\x66\x00\x6b\x00\x9e\x00\x9f\x00\xa0\x00\x6b\x00\xa2\x00\xa3\x00\x70\x00\x29\x01\x6b\x00\x71\x00\x72\x00\x6d\x00\x03\x01\x04\x01\x71\x00\x71\x00\x56\x00\x00\x00\x34\x01\x59\x00\x1e\x00\x0c\x01\x0d\x01\x27\x01\x07\x00\x29\x01\x11\x01\x12\x01\x13\x01\x2e\x00\x27\x01\x3a\x00\x29\x01\x51\x00\x2c\x00\x2d\x00\x34\x01\x19\x00\x65\x00\x4a\x00\x64\x00\x18\x00\x66\x00\x34\x01\xca\x00\x3e\x00\x3f\x00\x52\x00\x76\x00\x70\x00\x69\x00\x2a\x01\x2b\x01\x15\x01\x2d\x01\x2e\x01\x2c\x00\x2d\x00\x71\x00\xd9\x00\x57\x00\x34\x01\x59\x00\x36\x01\x37\x01\x14\x00\x22\x01\x3a\x01\x24\x01\x25\x01\x75\x00\x1a\x00\x6b\x00\x1c\x00\x79\x00\x66\x00\xb3\x00\xb4\x00\x71\x00\x2f\x01\x6b\x00\x31\x01\x32\x01\x33\x01\x77\x00\x35\x01\x71\x00\x72\x00\x38\x01\x39\x01\xc2\x00\xc3\x00\x4b\x00\x4c\x00\x64\x00\xc7\x00\x66\x00\x50\x00\xca\x00\x52\x00\x53\x00\x0d\x01\xce\x00\x13\x00\xd0\x00\x11\x01\xd1\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x6b\x00\xd8\x00\xd9\x00\xda\x00\x6d\x00\x63\x00\x71\x00\x65\x00\x71\x00\x67\x00\x17\x01\x18\x01\xa3\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x70\x00\x2a\x01\x2f\x00\x30\x00\x31\x00\x2e\x01\x6b\x00\x6a\x00\x27\x01\x28\x01\x29\x01\x34\x01\x71\x00\x36\x01\x37\x01\x1d\x00\x52\x00\x53\x00\x75\x00\xb3\x00\xb4\x00\x34\x01\x79\x00\x3a\x00\x2a\x01\x9f\x00\x03\x01\x04\x01\x2e\x01\x2b\x00\x1d\x00\x1d\x00\x4c\x00\xca\x00\x34\x01\x0c\x01\x0d\x01\x51\x00\xc2\x00\xc3\x00\x11\x01\x12\x01\x13\x01\xc7\x00\x2b\x00\x2b\x00\xca\x00\x9f\x00\xd9\x00\xd1\x00\xce\x00\x27\x01\xd0\x00\x29\x01\x54\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x6a\x00\xd8\x00\xd9\x00\xda\x00\x83\x00\x34\x01\x2a\x01\x2b\x01\x66\x00\x2d\x01\x2e\x01\x75\x00\x27\x01\x6b\x00\x29\x01\x79\x00\x34\x01\x75\x00\x36\x01\x37\x01\x4a\x00\x79\x00\x3a\x01\x75\x00\x95\x00\x34\x01\xfd\x00\xfe\x00\xff\x00\x64\x00\x9b\x00\x66\x00\x56\x00\x9e\x00\x9f\x00\xa0\x00\x65\x00\xa2\x00\xa3\x00\x32\x01\x33\x01\x5f\x00\x35\x01\x6b\x00\x03\x01\x04\x01\x39\x01\x70\x00\x42\x00\x71\x00\x3d\x01\x17\x01\x18\x01\x0c\x01\x0d\x01\x1b\x01\x1c\x01\x6b\x00\x11\x01\x12\x01\x13\x01\x9f\x00\x70\x00\x53\x00\x76\x00\x77\x00\x68\x00\x27\x01\x6a\x00\x29\x01\x6c\x00\x71\x00\x2b\x01\x2c\x01\x2d\x01\x2e\x01\x71\x00\xca\x00\x65\x00\x75\x00\x34\x01\x34\x01\x3a\x00\x2a\x01\x2b\x01\x9f\x00\x2d\x01\x2e\x01\x2e\x01\x70\x00\x10\x00\x65\x00\xd9\x00\x34\x01\x34\x01\x36\x01\x37\x01\x37\x01\x10\x00\x3a\x01\xc2\x00\xc3\x00\x70\x00\x81\x00\x4a\x00\xc7\x00\x0e\x01\x0f\x01\xca\x00\x11\x01\x12\x01\x13\x01\xce\x00\x64\x00\xd0\x00\x66\x00\x56\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x65\x00\xd8\x00\xd9\x00\xda\x00\x5f\x00\x66\x00\x2d\x01\x2e\x01\x95\x00\x9f\x00\x6b\x00\x70\x00\x65\x00\x34\x01\x9b\x00\x36\x01\x37\x01\x9e\x00\x9f\x00\xa0\x00\x75\x00\xa2\x00\xa3\x00\x70\x00\x2e\x01\x2a\x01\x37\x01\x76\x00\x77\x00\x2e\x01\x34\x01\x7a\x00\x7b\x00\x17\x01\x18\x01\x34\x01\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x2e\x01\x01\x01\x02\x01\x03\x01\x04\x01\x39\x00\x34\x01\x4c\x00\x27\x01\x28\x01\x29\x01\x50\x00\x0c\x01\x0d\x01\x2c\x01\x9f\x00\x2e\x01\x11\x01\x12\x01\x13\x01\xca\x00\x34\x01\x34\x01\x0c\x01\x0d\x01\x4b\x00\x4c\x00\x10\x01\x11\x01\x12\x01\x13\x01\x65\x00\x16\x01\x17\x01\x18\x01\xd9\x00\x70\x00\x1b\x01\x1c\x01\x38\x01\x39\x01\x3a\x00\x2a\x01\x2b\x01\x3d\x01\x2d\x01\x2e\x01\x32\x01\x33\x01\x27\x01\x35\x01\x29\x01\x34\x01\x1e\x00\x36\x01\x37\x01\xc2\x00\xc3\x00\x3a\x01\x3c\x00\x3d\x00\xc7\x00\x34\x01\x2e\x01\xca\x00\x36\x01\x37\x01\x54\x00\xce\x00\x34\x01\xd0\x00\x36\x01\x37\x01\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x6d\x00\xd8\x00\xd9\x00\xda\x00\x71\x00\x0c\x01\x0d\x01\x48\x00\x66\x00\x10\x01\x11\x01\x12\x01\x13\x01\x6b\x00\x61\x00\x6d\x00\x6e\x00\x64\x00\x13\x00\x14\x00\x17\x01\x18\x01\x17\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x81\x00\x0c\x01\x0d\x01\x27\x01\x28\x01\x29\x01\x11\x01\x12\x01\x13\x01\x01\x01\x02\x01\x03\x01\x04\x01\x6d\x00\x36\x01\x37\x01\x34\x01\x71\x00\x4c\x00\xa3\x00\x0c\x01\x0d\x01\x2d\x01\x2e\x01\x4c\x00\x11\x01\x12\x01\x13\x01\x50\x00\x34\x01\x4b\x00\x36\x01\x37\x01\x53\x00\x06\x01\x07\x01\x08\x01\x09\x01\x1c\x01\x0b\x01\x0c\x00\x1f\x01\x0e\x01\x36\x01\x37\x01\x11\x01\x12\x01\x13\x01\x3c\x00\x3d\x00\x2a\x01\x2b\x01\x3a\x00\x2d\x01\x2e\x01\x4b\x00\x4c\x00\x2c\x01\xca\x00\x2e\x01\x34\x01\x10\x00\x36\x01\x37\x01\x6a\x00\x34\x01\x3a\x01\xc2\x00\xc3\x00\x64\x00\x2a\x01\x66\x00\xc7\x00\xd9\x00\x2e\x01\xca\x00\x4a\x00\x4b\x00\x54\x00\xce\x00\x34\x01\xd0\x00\x55\x00\x37\x01\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x56\x00\xd8\x00\xd9\x00\xda\x00\x5a\x00\x82\x00\x83\x00\x84\x00\x66\x00\x5f\x00\x56\x00\x95\x00\x50\x00\x6b\x00\x5a\x00\x6d\x00\x6e\x00\x9b\x00\xa3\x00\x5f\x00\x9e\x00\x9f\x00\xa0\x00\x81\x00\xa2\x00\xa3\x00\x4c\x00\x2c\x01\x72\x00\x2e\x01\x50\x00\x42\x00\x76\x00\x77\x00\x75\x00\x34\x01\x7a\x00\x7b\x00\x79\x00\x4b\x00\x4c\x00\x2c\x01\x76\x00\x2e\x01\x03\x01\x04\x01\x7a\x00\x17\x01\x18\x01\x34\x01\x70\x00\x1b\x01\x1c\x01\x0c\x01\x0d\x01\x3c\x00\x3d\x00\xca\x00\x11\x01\x12\x01\x13\x01\x3c\x00\x3d\x00\x27\x01\xca\x00\x29\x01\x2b\x01\xa3\x00\x2d\x01\x2e\x01\x55\x00\x2b\x01\xd9\x00\x2d\x01\x2e\x01\x34\x01\x34\x01\x75\x00\x6b\x00\xd9\x00\x34\x01\x79\x00\x3a\x00\x2a\x01\x2b\x01\x18\x01\x2d\x01\x2e\x01\x1b\x01\x1c\x01\x68\x00\x6b\x00\x6a\x00\x34\x01\x6c\x00\x36\x01\x37\x01\x6b\x00\x75\x00\x3a\x01\xc2\x00\xc3\x00\x79\x00\x75\x00\x6b\x00\xc7\x00\xca\x00\x79\x00\xca\x00\x8f\x00\x6b\x00\x57\x00\xce\x00\x59\x00\xd0\x00\x4b\x00\x4c\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd9\x00\xd8\x00\xd9\x00\xda\x00\x64\x00\x66\x00\x66\x00\x4a\x00\x18\x01\x6b\x00\x6b\x00\x1b\x01\x1c\x01\x17\x01\x18\x01\x52\x00\x71\x00\x1b\x01\x1c\x01\x56\x00\x17\x01\x18\x01\x6b\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x5f\x00\x27\x01\x68\x00\x29\x01\x6a\x00\x71\x00\x6c\x00\x39\x01\x27\x01\x28\x01\x29\x01\x3d\x01\x6b\x00\x4b\x00\x34\x01\x75\x00\x03\x01\x04\x01\x71\x00\x79\x00\x64\x00\x34\x01\x66\x00\x76\x00\x77\x00\x0c\x01\x0d\x01\x7a\x00\x7b\x00\x48\x00\x11\x01\x12\x01\x13\x01\x48\x00\x17\x01\x18\x01\x53\x00\x71\x00\x1b\x01\x1c\x01\x0a\x01\x0b\x01\x18\x01\x50\x00\x0e\x01\x1b\x01\x1c\x01\x11\x01\x12\x01\x13\x01\x27\x01\x64\x00\x29\x01\x66\x00\x3a\x00\x2a\x01\x2b\x01\x71\x00\x2d\x01\x2e\x01\x4b\x00\x4c\x00\x68\x00\x34\x01\x6a\x00\x34\x01\x6c\x00\x36\x01\x37\x01\xc2\x00\xc3\x00\x3a\x01\x2a\x01\x69\x00\xc7\x00\x75\x00\x2e\x01\xca\x00\x0c\x00\x79\x00\x54\x00\xce\x00\x34\x01\xd0\x00\x99\x00\x37\x01\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x6d\x00\xd8\x00\xd9\x00\xda\x00\x15\x01\x6b\x00\x0e\x01\x0f\x01\x66\x00\x11\x01\x12\x01\x13\x01\x95\x00\x6b\x00\x64\x00\x6d\x00\x66\x00\x22\x01\x9b\x00\x24\x01\x25\x01\x9e\x00\x9f\x00\xa0\x00\x69\x00\xa2\x00\xa3\x00\x31\x01\x32\x01\x33\x01\x2f\x01\x35\x01\x31\x01\x32\x01\x33\x01\x97\x00\x35\x01\x9d\x00\x97\x00\x38\x01\x39\x01\x85\x00\x86\x00\x87\x00\x03\x01\x04\x01\x71\x00\x37\x01\x68\x00\x50\x00\x6a\x00\x52\x00\x6c\x00\x0c\x01\x0d\x01\x64\x00\x70\x00\x66\x00\x11\x01\x12\x01\x13\x01\x75\x00\x0a\x01\x0b\x01\x97\x00\xca\x00\x0e\x01\x0c\x01\x0d\x01\x11\x01\x12\x01\x13\x01\x11\x01\x12\x01\x13\x01\x64\x00\x2b\x01\x66\x00\x2d\x01\x2e\x01\xd9\x00\x52\x00\x3a\x00\x2a\x01\x2b\x01\x34\x01\x2d\x01\x2e\x01\x52\x00\x64\x00\x4a\x00\x66\x00\x48\x00\x34\x01\x2a\x01\x36\x01\x37\x01\x48\x00\x2e\x01\x3a\x01\xc2\x00\xc3\x00\x56\x00\x0c\x00\x34\x01\xc7\x00\x5a\x00\x37\x01\xca\x00\x36\x01\x37\x01\x5f\x00\xce\x00\x64\x00\xd0\x00\x66\x00\x70\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x50\x00\xd8\x00\xd9\x00\xda\x00\x14\x00\x66\x00\x16\x01\x17\x01\x18\x01\x72\x00\x6b\x00\x1b\x01\x1c\x01\x76\x00\x77\x00\x4b\x00\x4c\x00\x7a\x00\x7b\x00\x72\x00\x75\x00\x17\x01\x18\x01\x72\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xeb\x00\xec\x00\xed\x00\x6b\x00\xef\x00\x9d\x00\x6b\x00\x15\x01\x27\x01\x28\x01\x29\x01\x43\x00\x44\x00\x45\x00\x46\x00\x03\x01\x04\x01\x97\x00\x02\x00\x03\x00\x22\x01\x34\x01\x24\x01\x25\x01\x0c\x01\x0d\x01\xc4\x00\xc5\x00\xc6\x00\x11\x01\x12\x01\x13\x01\x64\x00\x2f\x01\x66\x00\x31\x01\x32\x01\x33\x01\x2b\x01\x35\x01\x2d\x01\x2e\x01\x38\x01\x39\x01\x53\x00\x02\x00\x03\x00\x34\x01\x0e\x01\x0f\x01\x3a\x00\x11\x01\x12\x01\x13\x01\x2a\x01\x2b\x01\x6d\x00\x2d\x01\x2e\x01\xae\x00\xaf\x00\xb0\x00\x72\x00\x4a\x00\x34\x01\x72\x00\x36\x01\x37\x01\xc2\x00\xc3\x00\x3a\x01\x52\x00\x64\x00\xc7\x00\x66\x00\x56\x00\xca\x00\x76\x00\x77\x00\x5a\x00\xce\x00\x64\x00\xd0\x00\x66\x00\x5f\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x37\x01\xd8\x00\xd9\x00\xda\x00\x6d\x00\x66\x00\x2b\x01\x6b\x00\x2d\x01\x2e\x01\x6b\x00\x6b\x00\x64\x00\x71\x00\x66\x00\x34\x01\xa3\x00\x65\x00\x76\x00\x77\x00\x75\x00\x95\x00\x7a\x00\x7b\x00\xeb\x00\xec\x00\xed\x00\x9b\x00\xef\x00\x6a\x00\x9e\x00\x9f\x00\xa0\x00\x71\x00\xa2\x00\xa3\x00\x15\x01\x31\x01\x32\x01\x33\x01\x7b\x00\x35\x01\x7d\x00\x52\x00\x03\x01\x04\x01\x63\x00\x64\x00\x65\x00\x22\x01\x0b\x00\x24\x01\x25\x01\x0c\x01\x0d\x01\xca\x00\x76\x00\x77\x00\x11\x01\x12\x01\x13\x01\x3d\x01\x2f\x01\x3f\x01\x31\x01\x32\x01\x33\x01\xed\x00\x35\x01\xef\x00\xd9\x00\x38\x01\x39\x01\x32\x00\xca\x00\xc4\x00\xc5\x00\xc6\x00\x70\x00\x3a\x00\xbe\x00\xbf\x00\xc0\x00\x2a\x01\x2b\x01\x18\x00\x2d\x01\x2e\x01\x4b\x00\xd9\x00\xb6\x00\xb7\x00\xb8\x00\x34\x01\x6b\x00\x36\x01\x37\x01\xc2\x00\xc3\x00\x3a\x01\x3a\x00\x85\x00\xc7\x00\x87\x00\x72\x00\xca\x00\x49\x00\x71\x00\x4b\x00\xce\x00\x82\x00\xd0\x00\x84\x00\x50\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x6b\x00\xd8\x00\xd9\x00\xda\x00\x6b\x00\x66\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x6b\x00\xbe\x00\xbf\x00\xc0\x00\x17\x01\x18\x01\x65\x00\x6b\x00\x1b\x01\x1c\x01\x69\x00\x6b\x00\x6b\x00\x6b\x00\x6d\x00\xc8\x00\xc9\x00\x70\x00\x71\x00\x6b\x00\x27\x01\x6b\x00\x29\x01\x17\x01\x18\x01\x14\x01\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xc8\x00\xc9\x00\x34\x01\x03\x01\x04\x01\x6b\x00\x20\x01\x21\x01\x27\x01\x28\x01\x29\x01\x69\x00\x0c\x01\x0d\x01\xbe\x00\xbf\x00\xc0\x00\x11\x01\x12\x01\x13\x01\x71\x00\x34\x01\xc8\x00\xc9\x00\x32\x01\x33\x01\x65\x00\x35\x01\xbe\x00\xbf\x00\xc0\x00\x39\x01\x71\x00\xa3\x00\xbe\x00\xbf\x00\xc0\x00\xbe\x00\xbf\x00\xc0\x00\x53\x00\x4c\x00\x2a\x01\x2b\x01\x61\x00\x2d\x01\x2e\x01\x4a\x00\x4b\x00\x79\x00\x7a\x00\x61\x00\x34\x01\x52\x00\x36\x01\x37\x01\xc2\x00\xc3\x00\x3a\x01\x1d\x01\x1e\x01\xc7\x00\x76\x00\x77\x00\xca\x00\x4a\x00\x4b\x00\x4c\x00\xce\x00\x71\x00\xd0\x00\x50\x00\xca\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x56\x00\xd8\x00\xd9\x00\xda\x00\x5a\x00\xc7\x00\x3e\x01\x3f\x01\xca\x00\x5f\x00\xd9\x00\x16\x00\xce\x00\x71\x00\xd0\x00\x02\x01\x03\x01\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x10\x00\x11\x00\xd9\x00\xda\x00\x10\x00\x11\x00\x50\x00\x72\x00\x95\x00\xaf\x00\xb0\x00\x76\x00\x77\x00\x65\x00\x9b\x00\x7a\x00\x7b\x00\x9e\x00\x9f\x00\xa0\x00\x6b\x00\xa2\x00\xa3\x00\x03\x01\x04\x01\x1b\x01\x1c\x01\xb7\x00\xb8\x00\x34\x00\x35\x00\x48\x00\x0c\x01\x0d\x01\x3e\x01\x3f\x01\x48\x00\x11\x01\x12\x01\x13\x01\x4b\x00\x83\x00\x5e\x00\x69\x00\x03\x01\x04\x01\x4b\x00\x48\x00\x6b\x00\x6b\x00\x48\x00\x17\x01\x18\x01\x0c\x01\x0d\x01\x1b\x01\x1c\x01\x72\x00\x11\x01\x12\x01\x13\x01\xca\x00\x2a\x01\x2b\x01\x5f\x00\x2d\x01\x2e\x01\x27\x01\x72\x00\x29\x01\x50\x00\x71\x00\x34\x01\x52\x00\x36\x01\x37\x01\xd9\x00\x18\x00\x3a\x01\x4b\x00\x34\x01\x4b\x00\x48\x00\x2a\x01\x2b\x01\x81\x00\x2d\x01\x2e\x01\x48\x00\x48\x00\x48\x00\x4c\x00\x48\x00\x34\x01\x48\x00\x36\x01\x37\x01\x95\x00\x75\x00\x3a\x01\x71\x00\x99\x00\x81\x00\x9b\x00\x4a\x00\x48\x00\x9e\x00\x9f\x00\xa0\x00\x15\x00\xa2\x00\xa3\x00\x0b\x00\x5e\x00\x6a\x00\x70\x00\x56\x00\x18\x00\x95\x00\x18\x00\x5a\x00\x81\x00\x99\x00\x48\x00\x9b\x00\x5f\x00\x69\x00\x9e\x00\x9f\x00\xa0\x00\x6b\x00\xa2\x00\xa3\x00\x18\x00\x4b\x00\x5f\x00\x65\x00\x71\x00\x17\x01\x18\x01\x72\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x4b\x00\x4b\x00\x76\x00\x77\x00\xca\x00\x4b\x00\x7a\x00\x7b\x00\x27\x01\x28\x01\x29\x01\x5f\x00\x50\x00\x18\x00\x71\x00\x48\x00\x6b\x00\x4c\x00\x4a\x00\xd9\x00\x4c\x00\x34\x01\x95\x00\x18\x00\x55\x00\xca\x00\x99\x00\x18\x00\x9b\x00\x07\x00\x56\x00\x9e\x00\x9f\x00\xa0\x00\x5a\x00\xa2\x00\xa3\x00\x19\x00\x48\x00\x5f\x00\xd9\x00\x50\x00\x69\x00\x95\x00\x7e\x00\x49\x00\x71\x00\x99\x00\x70\x00\x9b\x00\x70\x00\x65\x00\x9e\x00\x9f\x00\xa0\x00\x65\x00\xa2\x00\xa3\x00\x72\x00\x50\x00\x70\x00\x69\x00\x76\x00\x77\x00\x6b\x00\x18\x00\x7a\x00\x7b\x00\x18\x00\x6b\x00\x65\x00\x6b\x00\x70\x00\x18\x00\x96\x00\xca\x00\x50\x00\x2b\x00\x9a\x00\x70\x00\x4c\x00\x17\x01\x18\x01\x71\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x48\x00\xd9\x00\x48\x00\x07\x00\x50\x00\x18\x00\x5f\x00\xca\x00\x27\x01\x28\x01\x29\x01\x07\x00\x18\x00\x17\x01\x18\x01\x81\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x34\x01\xd9\x00\x4b\x00\x5f\x00\x69\x00\x6b\x00\x15\x00\x70\x00\x27\x01\x28\x01\x29\x01\x4b\x00\x6a\x00\x71\x00\x19\x00\x52\x00\xca\x00\x70\x00\xcc\x00\xcd\x00\xce\x00\x34\x01\xd0\x00\x4c\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\x21\x00\xd9\x00\xda\x00\x07\x00\x55\x00\x31\x00\x5f\x00\xdf\x00\xe0\x00\x55\x00\x19\x00\x08\x00\x17\x01\x18\x01\x39\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x6a\x00\x2c\x00\x68\x00\x6b\x00\x6d\x00\x71\x00\x65\x00\x55\x00\x27\x01\x28\x01\x29\x01\x10\x00\x70\x00\x17\x01\x18\x01\x02\x00\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x34\x01\x6b\x00\x03\x01\x04\x01\x6b\x00\x6b\x00\x65\x00\x6b\x00\x27\x01\x28\x01\x29\x01\x0c\x01\x0d\x01\x6b\x00\x5f\x00\x71\x00\x11\x01\x12\x01\x13\x01\x96\x00\x15\x01\x34\x01\x65\x00\x9a\x00\x31\x01\x32\x01\x33\x01\x42\x00\x35\x01\x4b\x00\x50\x00\x38\x01\x39\x01\x4b\x00\x23\x01\x24\x01\x3d\x01\x26\x01\x6a\x00\x50\x00\x02\x00\x18\x00\x2b\x01\x6a\x00\x2d\x01\x2e\x01\x50\x00\x30\x01\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x6a\x00\x6a\x00\x3d\x01\x71\x00\x3f\x01\x6b\x00\x18\x00\x76\x00\x43\x01\x4a\x00\x18\x00\x46\x01\x07\x00\xca\x00\x49\x01\xcc\x00\xcd\x00\xce\x00\x6b\x00\xd0\x00\x07\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\x76\x00\xd9\x00\xda\x00\x12\x00\x2e\x00\x9c\x00\xf7\x00\xdf\x00\xe0\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xf7\x00\x9b\x00\x3d\x01\xf7\x00\x9e\x00\x9f\x00\xa0\x00\x3c\x01\xa2\x00\xa3\x00\x3c\x01\x4a\x00\x4b\x00\xdd\x00\x39\x00\x60\x00\x81\x00\x8b\x00\xac\x00\x3c\x01\x2f\x00\x3c\x01\x3b\x01\x56\x00\x81\x00\x85\x00\x81\x00\x5a\x00\x30\x00\x03\x01\x04\x01\x8c\x00\x5f\x00\x9c\x00\x48\x00\x88\x00\x82\x00\xad\x00\x0c\x01\x0d\x01\x8c\x00\x7c\x00\x60\x00\x11\x01\x12\x01\x13\x01\x96\x00\x15\x01\xca\x00\x90\x00\x9a\x00\x72\x00\x41\x01\x85\x00\x40\x01\x76\x00\x77\x00\x81\x00\xdb\x00\x7a\x00\x7b\x00\x23\x01\x24\x01\xd9\x00\x26\x01\x3b\x01\x1f\x00\xd1\x00\x1f\x00\x2b\x01\x2e\x00\x2d\x01\x2e\x01\x03\x00\x30\x01\x31\x01\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x81\x00\x0a\x00\x3d\x01\x41\x01\x3f\x01\x70\x00\xef\x00\x5b\x00\x43\x01\x81\x00\x88\x00\x46\x01\x3b\x01\xca\x00\x49\x01\xcc\x00\xcd\x00\xce\x00\x3b\x01\xd0\x00\x03\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x3b\x01\x89\x00\xd9\x00\xda\x00\x3b\x01\x7e\x00\x5c\x00\x7c\x00\xdf\x00\xe0\x00\x37\x01\x7a\x00\x95\x00\x88\x00\x17\x01\x18\x01\x1e\x01\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x9f\x00\xa0\x00\x32\x00\xa2\x00\xa3\x00\x1f\x00\x1f\x00\x2a\x00\x27\x01\x28\x01\x29\x01\x31\x00\x88\x00\x6a\x00\x65\x00\x4d\x00\x74\x00\x48\x00\x78\x00\x6f\x00\x2a\x00\x34\x01\x03\x01\x04\x01\xb2\x00\x3b\x01\xb9\x00\x0f\x00\x1b\x00\x3b\x01\x3d\x01\x0c\x01\x0d\x01\x1b\x00\xd1\x00\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\x78\x00\xef\x00\xca\x00\xc0\x00\x73\x00\xb0\x00\xb2\x00\x50\x00\x3c\x01\x16\x00\x16\x00\x2a\x00\x24\x00\x23\x01\x24\x01\x3c\x01\x26\x01\xd9\x00\x32\x00\x51\x00\x3b\x01\x2b\x01\x4a\x00\x2d\x01\x2e\x01\x55\x00\x30\x01\x31\x01\x2f\x00\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x11\x00\x0c\x00\x3d\x01\x3c\x01\x3f\x01\x3b\x01\x81\x00\x3c\x01\x43\x01\xca\x00\x5d\x00\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\x3f\x01\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x56\x00\x56\x00\xd9\x00\xda\x00\x3b\x01\x3b\x01\x3b\x01\x33\x00\xdf\x00\x3b\x01\x0a\x01\x0b\x01\xe3\x00\xe4\x00\x0e\x01\x3c\x01\x3b\x01\x11\x01\x12\x01\x13\x01\x17\x01\x18\x01\x3b\x01\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x60\x00\x5b\x00\x5d\x00\x81\x00\x1f\x00\x1f\x00\x24\x00\x3c\x01\x27\x01\x28\x01\x29\x01\x16\x00\x16\x00\xb2\x00\x2a\x01\x3c\x01\x03\x01\x04\x01\x2e\x01\xff\xff\xff\xff\x34\x01\x3c\x01\x3c\x01\x34\x01\x0c\x01\x0d\x01\x37\x01\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xff\xff\x11\x01\x12\x01\x13\x01\xdf\x00\x91\x00\x92\x00\xe2\x00\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\x4a\x00\xa2\x00\xa3\x00\xff\xff\xa5\x00\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\x34\x01\x5a\x00\x36\x01\x37\x01\x03\x01\x04\x01\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\x72\x00\xca\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xd9\x00\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\x03\x01\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\xff\xff\xff\xff\xe2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\x91\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x15\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xa5\x00\xff\xff\x08\x01\x09\x01\x22\x01\x0b\x01\x24\x01\x25\x01\x0e\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\x2f\x01\xff\xff\x31\x01\x32\x01\x33\x01\xff\xff\x35\x01\x0c\x01\x0d\x01\x38\x01\x39\x01\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\x2a\x01\xca\x00\xff\xff\xff\xff\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x23\x01\x24\x01\x37\x01\x26\x01\xff\xff\xd9\x00\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\x03\x01\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\xff\xff\xff\xff\x0b\x01\xff\xff\xff\xff\x0e\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x2a\x01\xff\xff\x03\x01\x04\x01\x2e\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x34\x01\x0c\x01\x0d\x01\x37\x01\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\x91\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\x05\x01\x06\x01\x07\x01\x08\x01\x09\x01\xff\xff\x0b\x01\xff\xff\xff\xff\x0e\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\x2a\x01\xca\x00\xff\xff\xff\xff\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x23\x01\x24\x01\x37\x01\x26\x01\xff\xff\xd9\x00\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\x03\x01\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x01\x24\x01\xff\xff\x26\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xdf\x00\x91\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\x4a\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\x03\x01\x04\x01\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\x15\x01\xff\xff\xff\xff\x72\x00\xca\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x23\x01\x24\x01\x9a\x00\x26\x01\xff\xff\xd9\x00\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x30\x01\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\x03\x01\xd9\x00\xda\x00\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x96\x00\x36\x01\x37\x01\xff\xff\x9a\x00\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\x43\x01\xff\xff\x34\x01\x46\x01\x36\x01\x37\x01\x49\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xcc\x00\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa3\x00\x03\x01\x04\x01\xff\xff\xa1\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\xca\x00\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x96\x00\x36\x01\x37\x01\xd9\x00\x9a\x00\x3a\x01\xff\xff\xff\xff\xff\xff\xd9\x00\x2b\x01\xff\xff\x2d\x01\x2e\x01\x43\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x49\x01\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x17\x01\x18\x01\xd9\x00\xda\x00\x1b\x01\x1c\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x27\x01\xff\xff\x29\x01\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\x04\x01\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x96\x00\x11\x01\x12\x01\x13\x01\x9a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x96\x00\x36\x01\x37\x01\xff\xff\x9a\x00\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\x43\x01\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x49\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x01\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\x49\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xa3\x00\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\x03\x01\x04\x01\xff\xff\xa7\x00\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xba\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xca\x00\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xd9\x00\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\x43\x01\xff\xff\x4a\x00\xff\xff\xff\xff\x34\x01\x49\x01\x36\x01\x37\x01\xff\xff\x52\x00\x3a\x01\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\x43\x01\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x49\x01\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\x17\x01\x18\x01\x76\x00\x77\x00\x1b\x01\x1c\x01\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\x27\x01\xff\xff\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\x34\x01\x9a\x00\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x3d\x01\x9b\x00\x3f\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xa7\x00\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xca\x00\x4a\x00\x4b\x00\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xca\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x56\x00\xff\xff\xd9\x00\xda\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xd9\x00\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\x72\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xd9\x00\x03\x01\xff\xff\x2b\x01\xca\x00\x2d\x01\x2e\x01\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xd9\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\x3d\x01\xff\xff\x3f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x96\x00\xff\xff\x03\x01\xff\xff\x9a\x00\xff\xff\xff\xff\xff\xff\x32\x01\x33\x01\x34\x01\x35\x01\xff\xff\xff\xff\x38\x01\x39\x01\xff\xff\x96\x00\xff\xff\x3d\x01\xff\xff\x9a\x00\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\xff\xff\x1b\x01\x1c\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\x27\x01\xd0\x00\x29\x01\x3d\x01\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\x34\x01\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\x0c\x01\x0d\x01\x5f\x00\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\x96\x00\xff\xff\xff\xff\xff\xff\x9a\x00\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x72\x00\x11\x01\x12\x01\x13\x01\x76\x00\x77\x00\xff\xff\x96\x00\x7a\x00\x7b\x00\x2b\x01\x9a\x00\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xca\x00\x3a\x01\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xca\x00\xff\xff\xff\xff\xcd\x00\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\x92\x00\xd9\x00\xda\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xa3\x00\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xca\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x03\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\xff\xff\x1b\x01\x1c\x01\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\x27\x01\xff\xff\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x34\x01\x92\x00\xff\xff\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xd9\x00\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\xff\xff\xff\xff\xff\xff\x15\x01\xff\xff\x92\x00\xff\xff\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x21\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\x2a\x01\xff\xff\x03\x01\xff\xff\x2e\x01\xff\xff\xca\x00\xff\xff\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xd9\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x03\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x34\x01\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\x94\x00\x95\x00\x96\x00\x34\x01\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\x34\x01\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xca\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\x03\x01\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\x92\x00\xff\xff\x34\x01\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\x34\x01\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x03\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x03\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\x95\x00\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\xff\xff\xff\xff\x95\x00\x96\x00\x34\x01\x98\x00\x99\x00\xca\x00\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x34\x01\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\xff\xff\x65\x00\xff\xff\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xa6\x00\xa7\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xa6\x00\xa7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xab\x00\xac\x00\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xa7\x00\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xd9\x00\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xa7\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xa7\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xa7\x00\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xd9\x00\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xb1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xca\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\xff\xff\x95\x00\x96\x00\xca\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xd9\x00\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x34\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x34\x01\xff\xff\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\x96\x00\xca\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\x03\x01\x95\x00\x96\x00\xca\x00\x98\x00\x99\x00\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\x95\x00\x96\x00\xff\xff\x98\x00\x99\x00\xff\xff\x9b\x00\x34\x01\xd9\x00\x9e\x00\x9f\x00\xa0\x00\xca\x00\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\x03\x01\xff\xff\xff\xff\xca\x00\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xd9\x00\x03\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\x03\x01\xff\xff\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\x99\x00\x34\x01\xff\xff\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xb9\x00\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\x99\x00\xff\xff\x9b\x00\xff\xff\x34\x01\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd9\x00\xff\xff\x34\x01\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\x34\x01\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xd9\x00\xff\xff\x95\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\x34\x01\xff\xff\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x95\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\x95\x00\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xff\xff\xd9\x00\xff\xff\x34\x01\x95\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\x9e\x00\x9f\x00\xa0\x00\xff\xff\xa2\x00\xa3\x00\xff\xff\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xd9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xd9\x00\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\xff\xff\x17\x01\x18\x01\xff\xff\x1a\x01\x1b\x01\x1c\x01\x1d\x01\x1e\x01\xff\xff\x34\x01\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x27\x01\x28\x01\x29\x01\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\x34\x01\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\x65\x00\xff\xff\x67\x00\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x9a\x00\x09\x00\x0a\x00\x9d\x00\x9e\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\x3d\x00\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\x61\x00\x62\x00\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x06\x01\x07\x01\x08\x01\x09\x01\xff\xff\x0b\x01\xff\xff\xff\xff\x0e\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\x2a\x01\xff\xff\xff\xff\xff\xff\x2e\x01\xff\xff\x62\x00\xff\xff\x32\x01\x33\x01\x34\x01\x35\x01\x68\x00\x37\x01\x6a\x00\x39\x01\x6c\x00\xff\xff\x6e\x00\x3d\x01\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x59\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x49\x00\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\x63\x00\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\x69\x00\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\x70\x00\x71\x00\x72\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\xff\xff\x98\x00\xff\xff\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\x53\x00\xff\xff\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\x62\x00\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x50\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9a\x00\x15\x00\xff\xff\x9d\x00\x9e\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x57\x00\x58\x00\xff\xff\x5a\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\x6a\x00\xff\xff\xff\xff\xff\xff\x9a\x00\xff\xff\xff\xff\x9d\x00\x9e\x00\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf1\x00\xf2\x00\x81\x00\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x03\x01\x04\x01\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf1\x00\xf2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x0c\x01\x0d\x01\x3a\x01\x3b\x01\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x45\x01\xff\xff\xff\xff\x48\x01\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x45\x01\xff\xff\xff\xff\x48\x01\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf1\x00\xf2\x00\xff\xff\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x03\x01\x04\x01\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf1\x00\xf2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x0c\x01\x0d\x01\x3a\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x45\x01\xff\xff\xff\xff\x48\x01\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\x42\x01\xff\xff\xff\xff\x45\x01\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\xff\xff\x4e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\x3b\x01\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\xff\xff\x4b\x01\xff\xff\x4d\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\xff\xff\x4b\x01\xff\xff\x4d\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\xff\xff\x4b\x01\xff\xff\x4d\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4d\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xe6\x00\xe7\x00\xe8\x00\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\xff\xff\xfc\x00\xff\xff\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x42\x01\xff\xff\xfa\x00\xfb\x00\xfc\x00\xff\xff\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x42\x01\xf9\x00\xff\xff\xfb\x00\xfc\x00\xff\xff\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\x42\x01\xf8\x00\xff\xff\xff\xff\xfb\x00\xfc\x00\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\x42\x01\xf8\x00\xff\xff\xff\xff\xfb\x00\xfc\x00\xff\xff\xff\xff\x4a\x01\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xd6\x00\x36\x01\x37\x01\xd9\x00\xda\x00\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe9\x00\xea\x00\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xfc\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xe9\x00\xea\x00\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfc\x00\xff\xff\xff\xff\xed\x00\xee\x00\xef\x00\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x42\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x4a\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe8\x00\xfb\x00\xfc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xfc\x00\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x42\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x4a\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xfc\x00\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x42\x01\xff\xff\xff\xff\x45\x01\x34\x01\xff\xff\x36\x01\x37\x01\x4a\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\x42\x01\xff\xff\xff\xff\x45\x01\x34\x01\xff\xff\x36\x01\x37\x01\x4a\x01\xff\xff\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xcb\x00\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x4a\x01\x3a\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\x42\x01\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x4a\x01\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\x1b\x00\x1c\x00\x1d\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\x09\x00\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x42\x01\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x01\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\x74\x00\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x81\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\x81\x00\x02\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\x09\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x15\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x81\x00\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x74\x00\x75\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x81\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\x74\x00\x75\x00\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x81\x00\xff\xff\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x03\x01\x04\x01\xd9\x00\xda\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\x81\x00\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x0c\x01\x0d\x01\x3a\x01\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x2b\x01\xff\xff\x2d\x01\x2e\x01\x44\x01\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\x02\x00\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\x02\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x72\x00\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\xff\xff\x79\x00\x15\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x6a\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x71\x00\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\xff\xff\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x09\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\x15\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\x09\x00\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\x6a\x00\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\x74\x00\x75\x00\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x09\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\x15\x00\xff\xff\x79\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\x15\x00\x78\x00\x79\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\x74\x00\x75\x00\x15\x00\xff\xff\xff\xff\x79\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x15\x00\xff\xff\xff\xff\x79\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x68\x00\xff\xff\x6a\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x02\x00\xff\xff\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\xff\xff\xff\xff\x5a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\x02\x00\x6a\x00\x6b\x00\x6c\x00\xff\xff\xff\xff\xff\xff\x09\x00\x71\x00\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x68\x00\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\x02\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\x09\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x01\x00\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x01\x00\x02\x00\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\x02\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\x09\x00\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x15\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x74\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\xff\xff\xff\xff\x4c\x00\x15\x00\xff\xff\xff\xff\xff\xff\x51\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\x64\x00\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x02\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x09\x00\x6a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xca\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\x74\x00\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x74\x00\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xca\x00\x36\x01\x37\x01\xff\xff\xce\x00\x3a\x01\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xce\x00\xff\xff\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf4\x00\xf5\x00\xf6\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xca\x00\x36\x01\x37\x01\xff\xff\xce\x00\x3a\x01\xd0\x00\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xca\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xca\x00\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xca\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xca\x00\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xca\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xca\x00\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xca\x00\xff\xff\xff\xff\xff\xff\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\x0c\x01\x0d\x01\xd9\x00\xda\x00\xca\x00\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd4\x00\xd5\x00\xd6\x00\xff\xff\xff\xff\xd9\x00\xda\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\x03\x01\x04\x01\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\x03\x01\x04\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\xff\xff\x11\x01\x12\x01\x13\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\x2b\x01\xff\xff\x2d\x01\x2e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x34\x01\xff\xff\x36\x01\x37\x01\xff\xff\xff\xff\x3a\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x71\x00\x93\x05\x94\x05\x96\x05\x97\x05\xc0\x04\xdb\x05\xd4\x05\x68\x05\x4f\x01\x30\x03\xd6\x05\xd4\x03\x36\x01\xd7\x05\x0e\x05\x34\x02\x0d\x05\x35\x02\x46\x02\xd2\x05\x0e\x05\x34\x02\x8e\x05\x35\x02\x87\x04\x88\x04\x0e\x05\x34\x02\x6f\x03\x35\x02\x33\x02\x34\x02\x34\x02\x35\x02\x29\x04\xdb\x04\x87\x03\xd7\x00\xaf\x02\xb0\x02\x6d\x03\x73\x03\x74\x03\x9f\x04\xa0\x04\xef\x00\xf0\x00\xf1\x00\xf2\x00\x31\x02\xf3\x00\xdf\x04\xaf\x02\xb0\x02\x31\x02\x31\x02\x8a\x02\x31\x02\xe4\x03\x31\x02\xa1\x03\x31\x02\x31\x02\x83\x00\x11\x01\x31\x02\x9e\x03\xf4\x00\xf5\x00\xb8\x04\x88\x04\x59\x05\x5a\x05\x5b\x05\x5c\x05\xa8\x04\xf6\x00\xf7\x00\x2c\x03\xe0\x04\xe1\x04\xf8\x00\xbc\x04\xbc\x05\x5c\x05\xa8\x04\xd8\x00\x8e\x04\x64\x05\x88\x04\x15\x01\x31\x02\x31\x02\xcc\x05\x4b\x05\x9b\x04\xbd\x05\xa8\x04\x31\x02\xd7\x02\x28\x02\x24\x03\xab\x03\x2f\x03\x30\x00\x16\x03\xbd\x05\xa8\x04\x8e\x00\xb9\x05\xbe\x05\xbf\x05\xc0\x05\x8f\x04\x25\x02\x2d\x03\x0a\x03\xf9\x00\xbd\x05\xa8\x04\xde\x05\xbf\x05\xc0\x05\x0a\x02\x0b\x02\x0c\x02\x0d\x02\xa4\x02\xa7\x04\xa8\x04\x17\x03\x0f\x01\x8b\x02\x00\x02\xe4\x05\xcd\x05\x40\x03\x31\x00\xe2\x04\x25\x03\xa6\x03\x0e\x02\xd3\x01\x4c\x00\x9f\x03\x98\x04\x99\x04\x9a\x04\x9b\x04\x63\x00\xa5\x02\x88\x03\x32\x02\x67\x00\x4d\x00\xdc\x04\xd8\x02\x32\x02\x32\x02\xac\x03\x32\x02\x33\x02\x32\x02\x7a\x03\x32\x02\x32\x02\xdf\x03\xd0\x03\x32\x02\xce\x03\x2e\x01\x2e\x05\x16\x01\xfa\x00\x16\x04\x03\x02\x41\x03\x0d\x05\xfb\x00\x37\x01\x38\x01\x91\x00\x74\x00\x23\x01\x76\x00\xfc\x00\x32\x00\x94\x00\x81\x04\x9c\x04\x96\x00\x97\x00\x98\x00\x99\x00\x32\x02\x32\x02\x9a\x00\x9b\x00\x75\x03\x89\x04\xb2\x02\x32\x02\x25\x01\x71\x05\xd0\x03\x11\x00\xba\x05\x31\x03\x11\x00\x32\x00\xb0\x05\x39\x01\x35\x00\x11\x00\xb1\x02\x50\x01\x47\x00\x11\x00\x50\xff\xa5\x02\x26\x01\xa6\x02\x2e\x01\xc1\x04\xc1\x04\x69\x05\x31\x03\xbc\x02\xd5\x03\x33\x00\xb4\xfe\xa7\x03\x11\x00\x6e\x03\x4d\x00\x4d\x00\x4d\x00\x25\x01\xa0\x00\xa1\x00\xd6\x03\xd7\x03\x9c\x04\x11\x00\x89\x04\xdd\x04\x47\x00\xa2\x00\x73\x00\x0e\x02\x11\x00\x4c\x00\x74\x00\x75\x00\x76\x00\x00\x02\x50\xff\x19\x04\xed\x01\x7c\x00\xca\x02\x7d\x00\x4d\x00\x89\x04\xff\xff\x2d\x03\x5e\x02\x72\x00\x73\x00\x11\x00\xb4\xfe\x23\x02\x74\x00\x75\x00\x76\x00\x6e\x03\x77\x00\xdb\x00\xa3\x00\x25\x01\x0f\x00\xdc\x00\xb6\xfe\x1a\x04\x04\x02\x11\x00\x4f\x02\x11\x00\x25\x01\x7e\x00\x7f\x00\xff\xff\x78\x00\xa4\x00\x11\x00\x01\x02\x02\x02\x03\x02\x0e\x00\x5f\x02\x0f\x00\x10\x00\x79\x00\x95\x05\x7a\x00\x7b\x00\x7c\x00\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x98\x05\x36\x02\xa9\x04\x98\x05\xaa\x04\x47\x00\x75\x03\x36\x02\x95\x05\xb6\xfe\x25\x01\x50\x02\xa9\x04\x36\x02\xaa\x04\x47\x00\x11\x00\x36\x02\x36\x02\xd3\x02\xab\x04\x1b\x01\x0f\x00\x10\x00\xa9\x04\x32\x01\xaa\x04\x47\x00\x24\x05\x11\x00\xab\x04\x75\x03\x0f\x00\x10\x00\xa9\x04\x25\x01\xaa\x04\x47\x00\x3e\x01\x11\x00\x17\x01\x11\x00\xab\x04\x33\x01\x0f\x00\x10\x00\xa9\x04\xd3\x01\xaa\x04\x47\x00\xd4\x02\x11\x00\xab\x04\xd4\x03\x0f\x00\x10\x00\xa9\x04\x46\x04\xaa\x04\x47\x00\x90\xfc\x11\x00\x90\xfc\xd5\x02\xab\x04\x04\x02\x0f\x00\x10\x00\x07\x04\x25\x01\xff\xff\xd7\x00\x64\x04\x11\x00\xab\x04\x11\x00\x0f\x00\x10\x00\xee\x00\xef\x00\xf0\x00\xf1\x00\xf2\x00\x11\x00\xf3\x00\xa1\x05\x0d\x02\x32\x01\xfb\x04\xdc\x05\x47\x04\x50\x02\x60\x01\x04\x02\x1e\x02\x45\x03\x3b\x03\x25\x01\x32\x01\x48\x01\x49\x01\xf4\x00\xf5\x00\x11\x00\x13\x02\x33\x01\x63\x00\xcb\x02\x73\x00\xfc\x04\xf6\x00\xf7\x00\x74\x00\x75\x00\x76\x00\xf8\x00\x33\x01\x35\x00\xdd\x04\x47\x00\xd8\x00\x2f\x04\x7c\x02\x3f\x01\x39\x03\x1d\x02\x40\x01\x3c\x00\x3d\x00\x3d\x01\x3e\x00\x3f\x00\x48\x02\x0b\x02\x0c\x02\x0d\x02\x3c\x03\x31\x04\xcc\x02\x90\xfc\x0f\x00\x10\x00\x79\x04\x0c\x02\x0d\x02\x3e\x01\xaa\xff\x11\x00\xd7\x00\x7e\x00\x7f\x00\xf9\x00\x9e\x04\x0a\x02\xac\xfe\xdc\x03\xef\x00\xf0\x00\xf1\x00\xf2\x00\xd3\x02\xf3\x00\x02\x05\x65\x04\x3a\x03\xae\xfe\x7d\x02\x7e\x02\x0f\x00\x7f\x02\x40\x00\x7e\x03\x0b\x02\x0c\x02\x0d\x02\x11\x00\x48\x01\x49\x01\xf4\x00\xf5\x00\xdd\x05\x32\x04\x16\x01\x82\x02\x8a\x05\x41\x00\x09\x02\xf6\x00\xf7\x00\x11\x00\x51\x02\xd4\x02\xf8\x00\x1b\xff\xac\xfe\x03\x05\x04\x05\xd8\x00\x52\x02\x56\x05\x83\x00\x17\x01\x28\x05\x26\x05\x68\x03\xae\xfe\x9e\x02\xfa\x00\x7a\x01\x0e\x02\x52\x01\x4c\x00\xfb\x00\x9f\x02\x6f\x02\x91\x00\xc8\x01\x5f\x02\x17\x01\xfc\x00\x55\x02\x94\x00\x4d\x00\xa9\xff\x96\x00\x97\x00\x98\x00\x99\x00\xf9\x00\xc9\x01\x9a\x00\x9b\x00\x27\x05\x7d\x01\x62\x04\x0b\x02\x0c\x02\x0d\x02\x55\x05\x7e\x01\xbc\x01\xe3\x04\x0b\x02\x0c\x02\x0d\x02\x8e\x00\xa0\x02\x43\x00\x41\x01\x91\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x02\x55\x01\x17\x01\x0e\x02\xb2\x05\x4c\x00\x6d\x05\x6b\x05\x4a\x00\x4b\x00\x4c\x00\x59\x02\x0e\x02\x4b\x02\x4c\x00\x4d\x00\x4d\x00\xa0\x00\xa1\x00\x85\x00\x75\xfd\x4d\x00\x75\x04\x86\x00\x3b\x02\x4d\x00\xa2\x00\x73\x00\x87\x00\xfa\x00\x76\x04\x74\x00\x75\x00\x76\x00\xfb\x00\x33\x02\xd7\x00\x91\x00\xb6\x02\x49\x00\x5a\x02\xfc\x00\x0e\x02\x94\x00\x4c\x00\x79\x01\x96\x00\x97\x00\x98\x00\x99\x00\xde\x03\x8d\x00\x9a\x00\x9b\x00\xff\xff\x4d\x00\xdb\x00\xa3\x00\x1a\x01\x0f\x00\xdc\x00\xdf\x03\x1b\x01\x79\x01\x79\x01\x36\x05\x11\x00\x37\x05\x7e\x00\x7f\x00\xfb\x01\xec\x02\xa4\x00\x35\x00\xb6\x02\xf1\x01\x47\x00\xcf\x03\x7e\x01\x20\x03\xf8\x00\xed\x02\x40\x01\x3c\x00\x3d\x00\xd8\x00\x3e\x00\x3f\x00\xd0\x03\xf2\x01\xeb\x02\x38\x05\x3e\x05\xa8\x02\xa0\x00\xa1\x00\x7e\x01\x7e\x01\x1e\x04\x7e\xfe\x4d\x00\x1f\x04\x2b\x02\xa2\x00\x73\x00\x0e\x02\x7e\xfe\x4c\x00\x74\x00\x75\x00\x76\x00\x52\x03\x0e\x02\xd7\x00\x4c\x00\xd7\x01\x2c\x02\x2d\x02\x4d\x00\x4e\x03\xcd\x03\x83\x00\x95\x01\x7e\xfe\x96\x01\x4d\x00\x40\x00\x53\x03\x54\x03\x7a\x01\x20\x04\xce\x03\xce\x05\xdb\x00\xa3\x00\x56\x01\x0f\x00\xdc\x00\x4f\x03\x50\x03\xcf\x05\x41\x00\x36\x05\x11\x00\x37\x05\x7e\x00\x7f\x00\x2c\x00\x57\x01\xa4\x00\x58\x01\x59\x01\x63\x00\x2d\x00\x7d\x01\x2e\x00\x67\x00\xf8\x00\x25\x05\x26\x05\x7e\x01\x79\x00\xd8\x00\x7a\x00\x7b\x00\x7c\x00\x8e\x00\x7d\x00\x38\x05\x39\x05\x80\x00\x81\x00\xbe\x02\x3a\x05\x7e\xfe\x7e\xfe\xab\x01\xfb\x00\xac\x01\x7e\xfe\x91\x00\x1a\x02\x1b\x02\xe8\x01\xc0\x02\x4c\x01\x94\x00\xe9\x01\x27\x05\x96\x00\x97\x00\x98\x00\x99\x00\x57\x02\xc1\x02\xc2\x02\xc3\x02\xb7\x01\x1c\x02\x58\x02\x7e\xfe\x7e\x01\x7e\xfe\x43\x00\x44\x00\x07\x02\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x7e\xfe\xec\x01\x4d\x01\x4e\x01\x4f\x01\x25\x01\x54\x02\x1e\x03\x4a\x00\x4b\x00\x4c\x00\x11\x00\x55\x02\x7e\x00\x7f\x00\x24\x02\x6a\x05\x6b\x05\x63\x00\x9e\x05\x26\x05\x4d\x00\x67\x00\xd7\x00\x14\x04\xff\xff\xa0\x00\xa1\x00\x25\x01\x25\x02\x0a\x05\x09\x05\x34\x03\x40\x00\x11\x00\xa2\x00\x73\x00\x35\x03\xbe\x02\x3a\x05\x74\x00\x75\x00\x76\x00\xfb\x00\x25\x02\x25\x02\x91\x00\x7e\xfe\x41\x00\x27\x05\xc0\x02\x47\x02\x94\x00\x4c\x00\xd6\x01\x96\x00\x97\x00\x98\x00\x99\x00\xe2\x04\xc1\x02\xc2\x02\xc3\x02\x9a\x01\x4d\x00\xdb\x00\xa3\x00\xf8\x00\x0f\x00\xdc\x00\x63\x00\x6c\x04\xd8\x00\x4c\x00\x67\x00\x11\x00\x1a\x01\x7e\x00\x7f\x00\x56\x00\x1b\x01\xa4\x00\xc7\x02\x35\x00\x4d\x00\x7a\x02\x7b\x02\x7c\x02\xa5\x01\x20\x03\xa6\x01\x57\x00\x40\x01\x3c\x00\x3d\x00\x2d\x05\x3e\x00\x3f\x00\x4b\x02\x7c\x00\x5b\x00\x7d\x00\xd1\x05\xa0\x00\xa1\x00\xd9\x02\x2e\x05\x5f\x01\xd2\x05\xe6\x01\x43\x00\x44\x00\xa2\x00\x73\x00\x46\x00\x47\x00\x8e\xfc\x74\x00\x75\x00\x76\x00\xff\xff\xfa\x02\x1f\x03\x64\x00\x65\x00\x88\x00\x4a\x00\x3b\x01\x4c\x00\x8a\x00\x97\x01\x7d\x02\x7e\x02\x0f\x00\x7f\x02\xf7\xfc\x40\x00\x0c\x05\x8c\x00\x4d\x00\x11\x00\xd7\x00\xdb\x00\xa3\x00\xff\xff\x0f\x00\xdc\x00\x61\x02\x0d\x05\x5d\x01\x70\x05\x41\x00\x11\x00\x11\x00\x7e\x00\x7f\x00\x71\x03\x1a\xff\xa4\x00\xbe\x02\xbf\x02\x71\x05\x36\x01\x56\x00\xfb\x00\x91\x01\x38\x01\x91\x00\x74\x00\x23\x01\x76\x00\xc0\x02\x95\x01\x94\x00\x96\x01\x57\x00\x96\x00\x97\x00\x98\x00\x99\x00\x66\x05\xc1\x02\xc2\x02\xc3\x02\x5b\x00\xf8\x00\xe1\x01\x10\x00\x35\x00\xff\xff\xd8\x00\xd0\x03\xaf\x05\x11\x00\x20\x03\xe2\x01\x7f\x00\x40\x01\x3c\x00\x3d\x00\xbd\x02\x3e\x00\x3f\x00\xb0\x05\x72\x03\x7f\x04\x26\x01\x64\x00\x65\x00\x25\x01\x11\x00\x68\x00\x69\x00\x43\x00\x44\x00\x11\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\xb7\x04\xc8\x02\xc5\x02\xc6\x02\xa1\x00\x1f\x01\x11\x00\x09\x03\x4a\x00\x4b\x00\x4c\x00\x0a\x03\xa2\x00\x73\x00\xe2\x02\xff\xff\x82\x02\x74\x00\x75\x00\x76\x00\x40\x00\x4d\x00\x11\x00\x7f\x01\x73\x00\xa9\x03\xaa\x03\x80\x01\x74\x00\x75\x00\x76\x00\x52\x03\x9a\x01\x9b\x01\x44\x00\x41\x00\x2f\x02\x46\x00\x47\x00\xe5\x01\x81\x00\xd7\x00\xdb\x00\xa3\x00\xe6\x01\x0f\x00\xdc\x00\x4b\x02\x7c\x00\x9c\x01\x7d\x00\x4c\x00\x11\x00\x4b\x03\x7e\x00\x7f\x00\xbe\x02\xbf\x02\xa4\x00\x48\x01\x49\x01\xfb\x00\x4d\x00\x61\x02\x91\x00\x7e\x00\x7f\x00\xcb\x04\xc0\x02\x11\x00\x94\x00\xe2\x01\x7f\x00\x96\x00\x97\x00\x98\x00\x99\x00\x72\x02\xc1\x02\xc2\x02\xc3\x02\x55\x02\x7f\x01\x73\x00\x49\x03\xf8\x00\xbd\x03\x74\x00\x75\x00\x76\x00\xd8\x00\xd8\x01\xcc\x04\xd2\x04\xd9\x01\x11\x01\x12\x01\x43\x00\x44\x00\x13\x01\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x27\x03\x28\x03\x29\x03\x2a\x03\x2b\x03\x3f\x03\x4f\x05\x73\x00\x4a\x00\x4b\x00\x4c\x00\x74\x00\x75\x00\x76\x00\xc4\x02\xc5\x02\xc6\x02\xa1\x00\x5b\x02\x7e\x00\x7f\x00\x4d\x00\x55\x02\x23\x03\x06\x02\xa2\x00\x73\x00\xe0\x02\x10\x00\x94\xfe\x74\x00\x75\x00\x76\x00\x94\xfe\x11\x00\x30\x03\xe2\x01\x7f\x00\x2e\x05\xc0\x03\x84\x01\x85\x01\x86\x01\x42\x03\x87\x01\x2e\x01\x43\x03\x22\x01\x7e\x00\x7f\x00\x74\x00\x23\x01\x76\x00\x48\x01\x49\x01\xdb\x00\xa3\x00\xd7\x00\x0f\x00\xdc\x00\x82\x03\x83\x03\x81\x02\x40\x00\x82\x02\x11\x00\x13\x03\x7e\x00\x7f\x00\x0f\x03\x11\x00\xa4\x00\xbe\x02\xce\x04\x98\x02\x24\x01\x99\x02\xfb\x00\x41\x00\x25\x01\x91\x00\x83\x00\x98\x01\xcb\x04\xc0\x02\x11\x00\x94\x00\x0b\x03\x26\x01\x96\x00\x97\x00\x98\x00\x99\x00\x85\x00\xc1\x02\xc2\x02\xc3\x02\x86\x00\x2a\x01\x2b\x01\x2c\x01\xf8\x00\x87\x00\x85\x00\x35\x00\x0d\x03\xd8\x00\x86\x00\xcc\x04\xcd\x04\x2f\x05\xcc\x01\x87\x00\x40\x01\x3c\x00\x3d\x00\xfe\x02\x3e\x00\x3f\x00\x09\x03\xb8\x03\x5c\x01\x82\x02\x0a\x03\x5f\x01\x8d\x00\x8e\x00\x1a\x01\x11\x00\x90\x00\x91\x00\x1b\x01\xa9\x03\xaa\x03\x13\x05\x8d\x00\x82\x02\xa0\x00\xa1\x00\x90\x00\x43\x00\x44\x00\x11\x00\xfa\x02\x46\x00\x47\x00\xa2\x00\x73\x00\x48\x01\x49\x01\x40\x00\x74\x00\x75\x00\x76\x00\x48\x01\x49\x01\x4a\x00\x40\x00\x4c\x00\x0e\x00\x1f\x01\x0f\x00\x10\x00\xfb\x02\x8f\x01\x41\x00\x0f\x00\x10\x00\x11\x00\x4d\x00\x63\x00\xea\x02\x41\x00\x11\x00\x67\x00\xd7\x00\xdb\x00\xa3\x00\x1c\x03\x0f\x00\xdc\x00\x46\x00\x47\x00\x88\x00\x71\x02\x82\x01\x11\x00\x8a\x00\x7e\x00\x7f\x00\xe8\x02\x1a\x01\xa4\x00\xbe\x02\xce\x04\x1b\x01\x8c\x00\xe3\xfc\xfb\x00\x40\x00\x8f\x00\x91\x00\x5a\x03\x70\x02\x36\x05\xc0\x02\x37\x05\x94\x00\x7b\x05\x7c\x05\x96\x00\x97\x00\x98\x00\x99\x00\x41\x00\xc1\x02\xc2\x02\xc3\x02\x95\x02\xf8\x00\x96\x02\x56\x00\x7b\x03\xe6\x02\xd8\x00\x46\x00\x47\x00\x43\x00\x44\x00\xfd\x01\xac\x05\x46\x00\x47\x00\x57\x00\x43\x00\x44\x00\xe4\x02\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x5b\x00\x4a\x00\x9e\x01\x4c\x00\x9f\x01\xe0\x02\xa0\x01\xd9\x02\x4a\x00\x4b\x00\x4c\x00\xe6\x01\xb8\x02\xdf\x02\x4d\x00\x63\x00\xa0\x00\xa1\x00\x7e\x01\x67\x00\x98\x02\x4d\x00\x99\x02\x64\x00\x65\x00\xa2\x00\x73\x00\x68\x00\x69\x00\xdd\x02\x74\x00\x75\x00\x76\x00\xce\x02\x43\x00\x44\x00\x78\x05\xdb\x02\x46\x00\x47\x00\x3c\x03\x3d\x03\x50\x05\xdc\x02\x22\x01\x46\x00\x47\x00\x74\x00\x23\x01\x76\x00\x4a\x00\x6b\x04\x4c\x00\x6c\x04\xd7\x00\xdb\x00\xa3\x00\xca\x02\x0f\x00\xdc\x00\x7b\x05\xa8\x05\x88\x00\x4d\x00\x82\x01\x11\x00\x8a\x00\x7e\x00\x7f\x00\xbe\x02\x3a\x05\xa4\x00\x24\x01\xb9\x02\xfb\x00\x8c\x00\x25\x01\x91\x00\x8f\x02\x8f\x00\xcb\x04\xc0\x02\x11\x00\x94\x00\xb5\x02\x26\x01\x96\x00\x97\x00\x98\x00\x99\x00\xa4\x02\xc1\x02\xc2\x02\xc3\x02\x56\x01\xa1\x02\x91\x01\xcb\x03\xf8\x00\x74\x00\x23\x01\x76\x00\x35\x00\xd8\x00\x95\x01\x7c\x05\x96\x01\x57\x01\x20\x03\x58\x01\x59\x01\x40\x01\x3c\x00\x3d\x00\x9d\x02\x3e\x00\x3f\x00\xe4\x01\xb7\x01\x7c\x00\x79\x00\x7d\x00\x7a\x00\x7b\x00\x7c\x00\xb4\x02\x7d\x00\xef\x02\xaf\x02\x80\x00\x81\x00\x2e\x01\x2f\x01\x30\x01\xa0\x00\xa1\x00\x9c\x02\x26\x01\xe5\xfd\xd3\x01\xe5\xfd\x3e\x04\xe5\xfd\xa2\x00\x73\x00\x28\x04\x8e\x02\x29\x04\x74\x00\x75\x00\x76\x00\xe5\xfd\x60\x03\x3d\x03\xad\x02\x40\x00\x22\x01\xdf\x05\x73\x00\x74\x00\x23\x01\x76\x00\x74\x00\x75\x00\x76\x00\x07\x05\x89\x01\x08\x05\x0f\x00\x10\x00\x41\x00\x9a\x02\xd7\x00\xdb\x00\xa3\x00\x11\x00\x0f\x00\xdc\x00\x90\x02\xd9\x04\x83\x00\xda\x04\x92\x02\x11\x00\x24\x01\x7e\x00\x7f\x00\x91\x02\x25\x01\xa4\x00\xbe\x02\xce\x04\x85\x00\x8f\x02\x11\x00\xfb\x00\x86\x00\x26\x01\x91\x00\x7e\x00\x7f\x00\x87\x00\xc0\x02\xc6\x04\x94\x00\xc7\x04\x8e\x02\x96\x00\x97\x00\x98\x00\x99\x00\xd3\x01\xc1\x02\xc2\x02\xc3\x02\x86\x02\xf8\x00\xbe\x03\x9b\x01\x44\x00\x5c\x01\xd8\x00\x46\x00\x47\x00\x8d\x00\x8e\x00\xa9\x03\xaa\x03\x90\x00\x91\x00\x74\x02\x46\x05\x43\x00\x44\x00\x73\x02\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x42\x04\x3b\x04\x3c\x04\x71\x02\xd1\x01\xef\x02\x70\x02\x56\x01\x4a\x00\x4b\x00\x4c\x00\x19\x03\x1a\x03\x1b\x03\x1c\x03\xa0\x00\xa1\x00\xae\x02\x23\x02\x21\x02\xf0\x02\x4d\x00\x58\x01\x59\x01\xa2\x00\x73\x00\x05\x03\x06\x03\x07\x03\x74\x00\x75\x00\x76\x00\xbb\x04\x79\x00\xbc\x04\x7a\x00\x7b\x00\x7c\x00\xd5\x02\x7d\x00\x0f\x00\x10\x00\x80\x00\x81\x00\xab\x05\x20\x02\x21\x02\x11\x00\x91\x01\x7f\x05\xd7\x00\x74\x00\x23\x01\x76\x00\xdb\x00\xa3\x00\x5d\x02\x0f\x00\xdc\x00\x96\x03\x97\x03\x98\x03\x61\x02\x83\x00\x11\x00\x60\x02\x7e\x00\x7f\x00\xbe\x02\xbf\x02\xa4\x00\x7a\x01\xa6\x04\xfb\x00\xa7\x04\x85\x00\x91\x00\x92\x01\xcd\x01\x86\x00\xc0\x02\x41\x05\x94\x00\x42\x05\x87\x00\x96\x00\x97\x00\x98\x00\x99\x00\x26\x01\xc1\x02\xc2\x02\xc3\x02\x5c\x02\xf8\x00\xd0\x02\x7d\x01\x0f\x00\x10\x00\xd8\x00\x53\x02\xa6\x04\x7e\x01\xa7\x04\x11\x00\xe4\x02\x4e\x02\x8d\x00\x8e\x00\x45\x05\x35\x00\x90\x00\x91\x00\x3a\x04\x3b\x04\x3c\x04\x20\x03\xd1\x01\x57\x03\x40\x01\x3c\x00\x3d\x00\x4d\x02\x3e\x00\x3f\x00\x56\x01\xe4\x01\xb7\x01\x7c\x00\x35\x03\x7d\x00\x36\x03\x42\x02\xa0\x00\xa1\x00\x83\x03\x84\x03\x85\x03\x57\x01\x0f\x01\x58\x01\x59\x01\xa2\x00\x73\x00\x40\x00\x92\x01\x93\x01\x74\x00\x75\x00\x76\x00\xf6\x01\x79\x00\xf7\x01\x7a\x00\x7b\x00\x7c\x00\x86\x02\x7d\x00\xd1\x01\x41\x00\x80\x00\x81\x00\x23\x02\x40\x00\x94\x04\x06\x03\x07\x03\x2f\x02\xd7\x00\x5c\x04\x5d\x04\x5e\x04\xdb\x00\xa3\x00\x21\x04\x0f\x00\xdc\x00\x1b\x04\x41\x00\x57\x04\x58\x04\x59\x04\x11\x00\x18\x04\x7e\x00\x7f\x00\xbe\x02\xbf\x02\xa4\x00\xd7\x00\x2e\x01\xfb\x00\x64\x03\x0f\x04\x91\x00\x94\xfc\x0e\x04\xf5\x02\xc0\x02\x2a\x01\x94\x00\x61\x03\x94\xfc\x96\x00\x97\x00\x98\x00\x99\x00\xc5\xfc\xc1\x02\xc2\x02\xc3\x02\xe2\xfc\xf8\x00\xf6\x02\xf7\x02\xf8\x02\xf9\x02\xd8\x00\xda\x04\x5d\x04\x5e\x04\x43\x00\x44\x00\x94\xfc\xcc\xfc\x46\x00\x47\x00\x94\xfc\xcd\xfc\x94\xfc\xe1\xfc\x94\xfc\x90\x01\x8b\x01\x94\xfc\x94\xfc\xc6\xfc\x4a\x00\xd8\x00\x4c\x00\x43\x00\x44\x00\xd5\x03\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x8d\x01\x8b\x01\x4d\x00\xa0\x00\xa1\x00\xc7\xfc\xed\x04\xd7\x03\x4a\x00\x4b\x00\x4c\x00\x0d\x04\xa2\x00\x73\x00\xd4\x04\x5d\x04\x5e\x04\x74\x00\x75\x00\x76\x00\x5f\x02\x4d\x00\x8a\x01\x8b\x01\xed\x01\x7c\x00\x0c\x04\x7d\x00\x2b\x05\x5d\x04\x5e\x04\x2d\x03\x0b\x04\x92\x02\xe6\x05\x5d\x04\x5e\x04\xee\x05\x5d\x04\x5e\x04\xc5\x05\x0a\x04\xdb\x00\xa3\x00\x09\x04\x0f\x00\xdc\x00\x49\x01\x4a\x01\x33\x01\x34\x01\xf2\xfc\x11\x00\x06\x04\x7e\x00\x7f\x00\xbe\x02\x4e\x04\xa4\x00\xb6\x02\x49\x00\xfb\x00\x92\x01\x66\x04\x91\x00\x83\x00\x5b\x01\x95\xfe\xc0\x02\x05\x04\x94\x00\x95\xfe\x40\x00\x96\x00\x97\x00\x98\x00\x99\x00\x85\x00\xc1\x02\xc2\x02\xc3\x02\x86\x00\xd9\x00\xb9\x03\xba\x03\x91\x00\x87\x00\x41\x00\x04\x04\xda\x00\x7e\x01\x94\x00\x4f\x04\x50\x04\x96\x00\x97\x00\x98\x00\x99\x00\x04\x05\x00\x05\x9a\x00\x9b\x00\xff\x04\x00\x05\x59\x02\x5c\x01\x35\x00\xc9\x04\x98\x03\x8d\x00\x8e\x00\xdb\x03\x20\x03\x90\x00\x91\x00\x40\x01\x3c\x00\x3d\x00\x56\x02\x3e\x00\x3f\x00\xa0\x00\xa1\x00\x52\x05\x47\x00\x1a\x05\x59\x04\xb6\x05\xb7\x05\xcb\x03\xa2\x00\x73\x00\x9c\x05\xba\x03\xca\x03\x74\x00\x75\x00\x76\x00\xc9\x03\xc8\x03\x52\x01\xc7\x03\xa0\x00\xa1\x00\xc6\x03\xc5\x03\xc4\x03\xc3\x03\xc0\x03\x43\x00\x44\x00\xa2\x00\x73\x00\x46\x00\x47\x00\xbd\x03\x74\x00\x75\x00\x76\x00\x40\x00\xdb\x00\xa3\x00\xa2\x03\x0f\x00\xdc\x00\x4a\x00\xbc\x03\x4c\x00\x79\x01\xf6\xfc\x11\x00\xb8\x03\x7e\x00\x7f\x00\x41\x00\x9b\x03\xa4\x00\x96\x03\x4d\x00\x93\x03\x90\x03\xdb\x00\xa3\x00\x8f\x03\x0f\x00\xdc\x00\x8c\x03\x8b\x03\x8a\x03\x80\x03\x89\x03\x11\x00\x5e\x03\x7e\x00\x7f\x00\x35\x00\x8c\x00\xa4\x00\x63\x03\x53\x01\x36\x01\x54\x01\x4d\x05\x5d\x03\x3b\x00\x3c\x00\x3d\x00\x5a\x03\x3e\x00\x3f\x00\x0f\x01\xfe\x02\x57\x03\x4b\x04\x85\x00\x9f\x04\x35\x00\x98\x04\x86\x00\x97\x04\xa3\x03\x92\x04\xa4\x03\x87\x00\x8d\x04\x3b\x00\x3c\x00\x3d\x00\x93\x04\x3e\x00\x3f\x00\x87\x04\x81\x04\xc6\x05\x85\x04\x84\x04\x43\x00\x44\x00\x83\x04\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\xec\xfc\xeb\xfc\x8d\x00\x4e\x05\x40\x00\xed\xfc\x90\x00\x4f\x05\x4a\x00\x4b\x00\x4c\x00\x7f\x04\x7d\x04\x78\x04\x6f\x04\x74\x04\x71\x04\x69\x04\x83\x00\x41\x00\xb7\x04\x4d\x00\x35\x00\xa1\x03\x64\x04\x40\x00\x53\x01\x62\x04\x54\x01\x60\x04\x85\x00\x3b\x00\x3c\x00\x3d\x00\x86\x00\x3e\x00\x3f\x00\x5b\x04\x57\x04\x87\x00\x41\x00\x59\x02\x54\x04\x35\x00\x6a\x00\x48\x04\x4c\x04\xa3\x03\x4b\x04\xa4\x03\x41\x04\x3f\x04\x3b\x00\x3c\x00\x3d\x00\x37\x04\x3e\x00\x3f\x00\x5c\x01\x5e\x02\x39\x04\x2d\x04\x8d\x00\x8e\x00\x2e\x04\x26\x04\x90\x00\x91\x00\x25\x04\xff\x04\xfe\x04\xfd\x04\x8e\x02\xa1\x03\x60\x01\x40\x00\xd3\x01\xf5\x04\x61\x01\xa3\x04\xd1\x03\x43\x00\x44\x00\xed\x04\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\xec\x04\x41\x00\xeb\x04\x60\x04\xea\x04\x62\x04\xd8\x04\x40\x00\x4a\x00\x4b\x00\x4c\x00\x60\x04\xc4\x04\x43\x00\x44\x00\xc8\x04\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x41\x00\xbf\x04\xba\x04\xb6\x04\xb3\x04\x5a\x03\x4b\x04\x4a\x00\x4b\x00\x4c\x00\x49\x05\x55\x05\xb2\x04\x48\x05\x43\x05\x91\x00\xa3\x04\x62\x01\x63\x01\x64\x01\x4d\x00\x94\x00\x44\x05\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x66\x01\x35\x05\x9a\x00\x9b\x00\x60\x04\x1f\x05\x4f\x01\x20\x05\x67\x01\x68\x01\x78\xfe\x5b\x04\x16\x05\x43\x00\x44\x00\x1f\x01\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x92\x05\x8b\x05\x90\x05\x83\x05\x88\x05\x84\x05\x7f\x05\x7e\x05\x4a\x00\x4b\x00\x4c\x00\x73\x05\x81\x05\x43\x00\x44\x00\x63\x05\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4d\x00\x61\x05\xa0\x00\xa1\x00\x60\x05\x5f\x05\x58\x05\xbc\x05\x4a\x00\x4b\x00\x4c\x00\xa2\x00\x73\x00\xb5\x05\xb4\x05\xbb\x05\x74\x00\x75\x00\x76\x00\x60\x01\x69\x01\x4d\x00\xae\x05\x61\x01\xe4\x01\xb7\x01\x7c\x00\x5f\x01\x7d\x00\x96\x03\x79\x01\xe5\x01\x81\x00\xa0\x05\x6a\x01\x6b\x01\xe6\x01\x6c\x01\x57\x03\x59\x02\xd0\x05\xcb\x05\xa3\x00\x57\x03\x0f\x00\x10\x00\xc8\x05\x6d\x01\x6e\x01\xb7\x01\x70\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x71\x01\x81\x00\xa4\x00\xc5\x05\x55\x05\x72\x01\xe2\x05\x73\x01\xe3\x05\xdb\x05\xec\x05\x74\x01\xeb\x05\x62\x04\x75\x01\x60\x04\x91\x00\x76\x01\x62\x01\x63\x01\x64\x01\xe6\x05\x94\x00\x60\x04\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x66\x01\xee\x05\x9a\x00\x9b\x00\x0f\x01\x0d\x01\x18\x02\xca\x01\x67\x01\x68\x01\x35\x00\x36\x00\xf9\x01\x38\x00\x39\x00\xac\x01\x3a\x00\xe3\x01\xa9\x01\x3b\x00\x3c\x00\x3d\x00\x27\x02\x3e\x00\x3f\x00\x26\x02\x83\x00\x5b\x01\xa3\x01\x98\x01\x5d\x01\x46\x01\x3b\x01\x46\x02\x1c\x01\x1d\x01\x18\x01\x4c\x03\x85\x00\x4d\x03\x41\x03\x4b\x03\x86\x00\x49\x03\xa0\x00\xa1\x00\x2b\x03\x87\x00\x18\x02\x17\x03\x14\x03\x13\x03\x0b\x03\xa2\x00\x73\x00\x25\x03\xd1\x02\xff\x02\x74\x00\x75\x00\x76\x00\x60\x01\x69\x01\x40\x00\xdd\x02\x61\x01\x5c\x01\x96\x02\xb9\x02\x93\x02\x8d\x00\x8e\x00\x2a\x02\xa8\x02\x90\x00\x91\x00\x6a\x01\x6b\x01\x41\x00\x6c\x01\x2f\x02\x23\x04\x8c\x02\x22\x04\xa3\x00\x52\x03\x0f\x00\x10\x00\x21\x04\x6d\x01\x6e\x01\x6f\x01\x70\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x71\x01\x81\x00\xa4\x00\x29\x02\x1c\x04\x72\x01\x07\x04\x73\x01\x99\x03\x8a\x02\x94\x03\x74\x01\x91\x03\x90\x03\x75\x01\xdf\x03\x91\x00\x76\x01\xb0\x01\x63\x01\x64\x01\xdb\x03\x94\x00\x42\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\xd2\x03\x8d\x03\x9a\x00\x9b\x00\xd1\x03\x68\x03\x80\x03\x66\x03\xb1\x01\xb2\x01\x71\x03\x65\x03\x35\x00\x63\x03\x43\x00\x44\x00\x5e\x03\x45\x00\x46\x00\x47\x00\xfa\x01\x49\x00\x84\x05\x3d\x00\x58\x03\x3e\x00\x3f\x00\x57\x03\x55\x03\xa1\x04\xa2\x05\x4b\x00\x4c\x00\x95\x04\x90\x04\x85\x04\x78\x04\x7b\x04\x76\x04\x72\x04\x67\x04\x69\x04\x49\x04\x4d\x00\xa0\x00\xa1\x00\x60\x04\x41\x04\x85\x05\x26\x04\x08\x05\x39\x04\xfb\x01\xa2\x00\x73\x00\x05\x05\xf9\x04\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\xf7\x04\x8a\x02\x40\x00\xe2\x04\xc4\x04\xca\x04\xd5\x04\xc2\x04\xb4\x04\xb3\x04\xa4\x04\xa3\x04\x53\x05\x6a\x01\x6b\x01\x51\x05\x6c\x01\x41\x00\x4a\x05\x3f\x05\x35\x05\xa3\x00\x23\x05\x0f\x00\x10\x00\x33\x05\x6d\x01\xb3\x01\x11\x05\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x92\x05\x90\x05\xb5\x01\x10\x05\x73\x01\x12\x05\x8d\x05\x8c\x05\x74\x01\x91\x00\x79\x05\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x88\x05\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x74\x05\x71\x05\x9a\x00\x9b\x00\x81\x05\x73\x05\x66\x05\x61\x05\xb8\x01\x58\x05\x8f\x04\x3d\x03\xb9\x01\xba\x01\x22\x01\xb5\x05\xb1\x05\x74\x00\x23\x01\x76\x00\x43\x00\x44\x00\xb0\x05\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\xaa\x05\xa9\x05\xa6\x05\x9a\x05\x99\x05\xc9\x05\xe3\x05\xe0\x05\x4a\x00\x4b\x00\x4c\x00\xd9\x05\xe8\x05\xe7\x05\x24\x01\xd5\x05\xa0\x00\xa1\x00\x25\x01\x00\x00\x00\x00\x4d\x00\xd3\x05\xe9\x05\x11\x00\xa2\x00\x73\x00\x26\x01\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\xec\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\x00\x00\x6c\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\xad\x01\x73\x00\x9a\x00\x9b\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa1\x02\x20\x05\x10\x03\xa2\x02\x00\x00\x35\x00\x36\x00\x00\x00\x11\x03\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x83\x00\x3e\x00\x3f\x00\x00\x00\x21\x05\x00\x00\xae\x01\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x11\x00\x86\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x5c\x01\x40\x00\x00\x00\x00\x00\x8d\x00\x8e\x00\x00\x00\x00\x00\x90\x00\x91\x00\x00\x00\x6a\x01\x6b\x01\x00\x00\x6c\x01\x00\x00\x41\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x42\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x02\x00\x00\x00\x00\xe3\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\x00\x00\x6c\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x02\x20\x05\x10\x03\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x11\x03\x39\x00\x00\x00\x3a\x00\x56\x01\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x9d\x05\x00\x00\xc1\x03\x86\x01\x57\x01\x87\x01\x58\x01\x59\x01\x22\x01\x00\x00\x00\x00\x74\x00\x23\x01\x76\x00\x00\x00\xa0\x00\xa1\x00\x79\x00\x00\x00\x7a\x00\x7b\x00\x7c\x00\x00\x00\x7d\x00\xa2\x00\x73\x00\x80\x00\x81\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x24\x01\x40\x00\x00\x00\x00\x00\x25\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x6a\x01\x6b\x01\x26\x01\x6c\x01\x00\x00\x41\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x42\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\x03\x00\x00\x00\x00\x21\x01\x00\x00\x00\x00\x22\x01\x00\x00\x00\x00\x74\x00\x23\x01\x76\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x24\x01\x00\x00\xa0\x00\xa1\x00\x25\x01\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x11\x00\xa2\x00\x73\x00\x26\x01\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\x00\x00\x6c\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xe5\x03\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x03\x0f\x03\x10\x03\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x11\x03\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x82\x01\x83\x01\x84\x01\x85\x01\x86\x01\x00\x00\x87\x01\x00\x00\x00\x00\x22\x01\x00\x00\x00\x00\x74\x00\x23\x01\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x24\x01\x40\x00\x00\x00\x00\x00\x25\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x6a\x01\x6b\x01\x26\x01\x6c\x01\x00\x00\x41\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x42\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x01\x6b\x01\x00\x00\x6c\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xb0\x01\x63\x01\x64\x01\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x05\x7c\x03\x10\x03\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x11\x03\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x83\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x03\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x69\x01\x00\x00\x00\x00\xda\x03\x40\x00\x00\x00\x00\x00\x8d\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x60\x01\x00\x00\x6a\x01\x6b\x01\x61\x01\x6c\x01\x00\x00\x41\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6d\x01\xb3\x01\x00\x00\xb4\x01\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xad\x03\x63\x01\xed\x02\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x42\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\xed\x03\x63\x01\xed\x02\x00\x00\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x60\x01\x7e\x00\x7f\x00\x00\x00\x61\x01\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x74\x01\x00\x00\x11\x00\xae\x03\x7e\x00\x7f\x00\x76\x01\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x01\x91\x00\x00\x00\xee\x04\x63\x01\xed\x02\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x63\x01\xed\x02\x00\x00\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x02\xa0\x00\xa1\x00\x00\x00\x14\x02\x15\x02\x16\x02\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x40\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x60\x01\x7e\x00\x7f\x00\x41\x00\x61\x01\xa4\x00\x00\x00\x00\x00\x00\x00\x41\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x74\x01\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x76\x01\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xee\x02\x91\x00\x00\x00\x00\x00\x63\x01\xed\x02\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x63\x01\xed\x02\x00\x00\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x43\x00\x44\x00\x9a\x00\x9b\x00\x46\x00\x47\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4a\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x60\x01\x74\x00\x75\x00\x76\x00\x61\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x60\x01\x7e\x00\x7f\x00\x00\x00\x61\x01\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\xb2\x03\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x76\x01\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x03\x91\x00\x00\x00\x00\x00\x63\x01\xed\x02\x76\x01\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x63\x01\xed\x02\x00\x00\x94\x00\x00\x00\x65\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x1b\x05\x38\x00\x39\x00\x00\x00\x3a\x00\x44\x02\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\xa0\x00\xa1\x00\x00\x00\xf4\x01\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x1c\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x40\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x40\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x41\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\xb0\x03\x00\x00\x83\x00\x00\x00\x00\x00\x11\x00\x76\x01\x7e\x00\x7f\x00\x00\x00\x7a\x01\xa4\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\xaf\x03\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x76\x01\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x7d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x01\x00\x00\x00\x00\x43\x00\x44\x00\x8d\x00\x8e\x00\x46\x00\x47\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x60\x01\x00\x00\x00\x00\x4d\x00\x61\x01\x00\x00\x00\x00\x35\x00\x36\x00\xf3\x01\x38\x00\x39\x00\xf6\x01\x3a\x00\x1d\x05\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xf4\x01\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x62\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x91\x00\x83\x00\x5c\x03\xfb\x02\xed\x02\x00\x00\x94\x00\x00\x00\x40\x00\x96\x00\x97\x00\x98\x00\x99\x00\x85\x00\x00\x00\x9a\x00\x9b\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x41\x00\x00\x00\x00\x00\x35\x00\x36\x00\xf9\x01\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x5c\x01\x00\x00\x00\x00\x00\x00\x8d\x00\x8e\x00\x00\x00\x00\x00\x90\x00\x91\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x42\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x41\x00\x42\x00\x00\x00\xa3\x00\x40\x00\x0f\x00\x10\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x41\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\xf6\x01\x00\x00\xf7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x60\x01\x00\x00\x42\x00\x00\x00\x61\x01\x00\x00\x00\x00\x00\x00\x4b\x02\x7c\x00\x4d\x00\x7d\x00\x00\x00\x00\x00\xe5\x01\x81\x00\x00\x00\x60\x01\x00\x00\xe6\x01\x00\x00\x61\x01\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\xfa\x01\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x00\x00\x46\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x91\x00\x00\x00\x00\x00\xb6\x03\xed\x02\x4a\x00\x94\x00\x4c\x00\xfb\x01\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x4d\x00\x00\x00\xb5\x03\xed\x02\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x77\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x87\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x60\x01\x00\x00\x00\x00\x00\x00\x61\x01\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x5c\x01\x74\x00\x75\x00\x76\x00\x8d\x00\x8e\x00\x00\x00\x60\x01\x90\x00\x91\x00\xa3\x00\x61\x01\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x91\x00\xa4\x00\x00\x00\xac\x03\xed\x02\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x91\x00\x00\x00\x00\x00\x55\x04\xed\x02\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\xce\x02\x9a\x00\x9b\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x3e\x02\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\xcf\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x40\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\xce\x02\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x42\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x8c\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x00\x00\x46\x00\x47\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x51\x04\x00\x00\x54\x04\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x41\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\xe8\x01\x00\x00\x00\x00\x00\x00\xe9\x01\x00\x00\x00\x00\x00\x00\xea\x01\x00\x00\x51\x04\x00\x00\x52\x04\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\xeb\x01\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\xec\x01\x00\x00\x42\x00\x00\x00\x25\x01\x00\x00\x40\x00\x00\x00\xed\x01\x7c\x00\x11\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x41\x00\xce\x02\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x42\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\xc8\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x51\x04\x00\x00\x19\x05\x35\x00\x36\x00\x4d\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\xba\x02\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x00\x03\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\xba\x02\x00\x00\x4d\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x40\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x70\x03\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x42\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x4c\x04\x00\x00\x4d\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\xbd\x04\x00\x00\x00\x00\x35\x00\x36\x00\x4d\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x05\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x42\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\xa8\x05\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\xbb\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x42\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x35\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x1f\x02\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x05\x00\x00\x00\x00\x35\x00\x36\x00\x4d\x00\xbb\x02\x39\x00\x40\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x4d\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xb7\xfd\xb7\xfd\x13\x00\xb7\xfd\x00\x00\x00\x00\x00\x00\xb7\xfd\xb7\xfd\x14\x00\xb7\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xfd\xb7\xfd\x00\x00\x00\x00\xb7\xfd\x15\x00\xb7\xfd\x00\x00\xb7\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\xb7\xfd\xb7\xfd\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xb7\xfd\x00\x00\x23\x00\xb7\xfd\xb7\xfd\x00\x00\xb7\xfd\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xfd\xb7\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x00\x00\x00\x00\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x00\x00\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x00\x00\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x00\x00\xb7\xfd\x9e\x01\xb7\xfd\x9f\x01\xb7\xfd\xa0\x01\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x62\x00\x63\x00\xb7\xfd\xb7\xfd\xb7\xfd\x67\x00\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\xb7\xfd\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x77\xfe\x4f\x00\x13\x00\x77\xfe\x00\x00\x00\x00\x00\x00\x77\xfe\x77\xfe\x14\x00\x77\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\xfe\x77\xfe\x00\x00\x00\x00\x77\xfe\x15\x00\x77\xfe\x00\x00\x77\xfe\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x77\xfe\x77\xfe\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x77\xfe\x00\x00\x23\x00\x77\xfe\x77\xfe\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\xfe\x77\xfe\x56\x00\x77\xfe\x77\xfe\x77\xfe\x00\x00\x00\x00\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x00\x00\x77\xfe\x57\x00\x58\x00\x59\x00\x77\xfe\x5a\x00\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x5b\x00\x00\x00\x00\x00\x18\x02\x77\xfe\x5c\x00\x77\xfe\x00\x00\x77\xfe\x5d\x00\x77\xfe\x5e\x00\x77\xfe\x5f\x00\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x77\xfe\x6f\x00\x77\xfe\x77\xfe\x70\x00\x71\x00\x77\xfe\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x7e\xfe\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x7e\xfe\x7e\xfe\x1a\x02\x1b\x02\x00\x00\x80\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x00\x00\x00\x00\x7e\xfe\x1c\x02\x00\x00\x7e\xfe\x00\x00\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x7e\xfe\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\xfc\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x9c\xfc\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x83\x00\xdd\x01\x9c\xfc\x9c\xfc\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x00\x00\x9c\xfc\x85\x00\x9c\xfc\x9c\xfc\x9c\xfc\x86\x00\xde\x01\xdf\x01\xe0\x01\xe1\x01\x87\x00\x00\x00\x00\x00\x9c\xfc\x9c\xfc\x00\x00\x9c\xfc\x00\x00\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x5c\x01\x9c\xfc\x9c\xfc\x9c\xfc\x8d\x00\x8e\x00\x9c\xfc\x9c\xfc\x90\x00\x91\x00\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\x9c\xfc\xe7\xfd\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xfd\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\xe7\xfd\x15\x00\xe7\xfd\x00\x00\xe7\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\xe7\xfd\xe7\xfd\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\xb1\x00\x00\x00\x00\x00\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\x00\x00\xe7\xfd\xe7\xfd\xb3\x00\xb4\x00\xb5\x00\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\x00\x00\x00\x00\xdb\x01\xe7\xfd\x00\x00\xe7\xfd\x00\x00\xe7\xfd\xb6\x00\xe7\xfd\xb7\x00\xe7\xfd\xb8\x00\xe7\xfd\xb9\x00\xe7\xfd\xe7\xfd\xe7\xfd\xe7\xfd\xba\x00\x2b\x00\x8c\x00\xe7\xfd\xe7\xfd\x2c\x00\x8f\x00\xe7\xfd\xe7\xfd\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xe7\xfd\xd5\x00\xe7\xfd\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xe7\xfd\xe8\xfd\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\xfd\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\xe8\xfd\x15\x00\xe8\xfd\x00\x00\xe8\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\xe8\xfd\xe8\xfd\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\xb1\x00\x00\x00\x00\x00\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\x00\x00\xe8\xfd\xe8\xfd\xb3\x00\xb4\x00\xb5\x00\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\x00\x00\x00\x00\xdb\x01\xe8\xfd\x00\x00\xe8\xfd\x00\x00\xe8\xfd\xb6\x00\xe8\xfd\xb7\x00\xe8\xfd\xb8\x00\xe8\xfd\xb9\x00\xe8\xfd\xe8\xfd\xe8\xfd\xe8\xfd\xba\x00\x2b\x00\x8c\x00\xe8\xfd\xe8\xfd\x2c\x00\x8f\x00\xe8\xfd\xe8\xfd\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xe8\xfd\xd5\x00\xe8\xfd\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xe8\xfd\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x6c\x02\x6d\x02\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x93\x03\x6d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x7d\x04\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x05\x0d\x02\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x13\x04\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x41\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x05\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x12\x04\x35\x00\x36\x00\x10\x04\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x0f\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x35\x00\x36\x00\x6b\x02\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x2e\x04\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x41\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x10\x04\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\xfe\x01\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\xa6\x01\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x02\x00\x00\x35\x00\x36\x00\x7d\x03\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x7d\x04\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x04\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x04\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x04\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x04\x00\x00\x35\x00\x36\x00\x86\x05\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x67\x05\x38\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x3b\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x1e\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x78\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x40\x00\x45\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x00\x00\x35\x00\x36\x00\x40\x00\x40\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x35\x00\x36\x00\x00\x00\x3f\x02\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x42\x00\x35\x00\x36\x00\x00\x00\x3d\x02\x39\x00\x00\x00\x3a\x00\x4d\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x1b\x04\x39\x00\x00\x00\x3a\x00\x4d\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x00\x00\x15\x04\x39\x00\x00\x00\x3a\x00\x00\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x36\x00\x40\x00\xb3\x03\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x42\x00\x35\x00\x36\x00\x40\x00\x93\x04\x39\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x42\x00\x35\x00\x36\x00\x00\x00\x63\x05\x39\x00\x00\x00\x3a\x00\x4d\x00\x41\x00\x3b\x00\x3c\x00\x3d\x00\x40\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x42\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x41\x00\x42\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\xe4\x04\x4d\x00\x00\x00\x00\x00\x00\x00\xe5\x04\xe6\x04\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\xe7\x04\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x29\x05\x00\x00\x2a\x05\x00\x00\x4d\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x03\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x0d\x03\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x03\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\xd6\x04\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x41\x00\x00\x00\x35\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\xbf\x04\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x05\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x75\x05\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x35\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x43\x02\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x00\x00\x41\x00\x00\x00\x4d\x00\x35\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x05\x00\x00\x00\x00\x40\x01\x3c\x00\x3d\x00\x00\x00\x3e\x00\x3f\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x41\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x00\x00\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x00\x00\x43\x00\x44\x00\x00\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x00\x00\x4d\x00\x31\x02\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x4c\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x4d\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x32\x02\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xf7\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\x31\x02\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x71\xfd\x00\x00\x71\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x32\x02\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xff\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x3d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3d\xfe\x00\x00\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x00\x00\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfe\x69\xfe\x69\xfe\x69\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x69\xfe\x00\x00\x00\x00\x69\xfe\x69\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x3c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfe\x00\x00\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x00\x00\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x68\xfe\x68\xfe\x68\xfe\x68\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x13\x00\xa9\x00\xfe\x00\xff\x00\x00\x01\x01\x01\x68\xfe\x14\x00\xaa\x00\x68\xfe\x68\xfe\xde\x00\xdf\x00\xe0\x00\x02\x01\xe1\x00\x00\x00\x03\x01\x00\x00\x15\x00\x00\x00\x04\x01\x00\x00\x00\x00\x05\x01\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x07\x01\xe7\x00\x08\x01\x09\x01\x00\x00\x00\x00\x0a\x01\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\x00\x00\x00\x00\x00\x00\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xf3\x04\xf4\x04\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\x00\x00\x00\x00\xd4\xfc\x00\x00\x00\x00\x00\x00\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\x00\x00\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\x00\x00\xd4\xfc\x00\x00\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\x00\x00\xd4\xfc\x00\x00\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xd4\xfc\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x79\x01\x00\x00\x7a\x01\x00\x00\x00\x00\x00\x00\x7b\x01\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x7c\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x7d\x01\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x7e\x01\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\xd0\x04\xd1\x04\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xd2\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x3c\x05\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x3d\x05\x00\x00\x15\x00\x00\x00\x3e\x05\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\xd0\x04\xd1\x04\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xd2\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x3c\x05\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x3d\x05\x00\x00\x15\x00\x00\x00\x3e\x05\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x79\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\xb7\x01\xb9\x00\x00\x00\x00\x00\x7e\x01\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x98\xfd\xb8\x00\x98\xfd\xb9\x00\x00\x00\x00\x00\x55\x02\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x6f\x02\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x55\x02\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x72\x02\xb9\x00\x00\x00\x00\x00\x55\x02\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfd\x00\x00\xbd\xfd\xbd\xfd\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\xbd\xfd\x00\x00\xbd\xfd\x00\x00\xbd\xfd\x00\x00\xbd\xfd\x00\x00\x00\x00\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\x00\x00\xbd\xfd\x00\x00\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbd\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfd\x00\x00\xbc\xfd\xbc\xfd\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\xbc\xfd\x00\x00\xbc\xfd\x00\x00\xbc\xfd\x00\x00\xbc\xfd\x00\x00\x00\x00\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\x00\x00\xbc\xfd\x00\x00\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xbc\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xd1\x03\xca\xfd\x00\x00\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfd\x00\x00\xca\xfd\xca\xfd\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\xca\xfd\x00\x00\xca\xfd\x00\x00\xca\xfd\x00\x00\xca\xfd\x00\x00\x00\x00\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\x00\x00\xca\xfd\x00\x00\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xca\xfd\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\xbc\x01\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x59\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x01\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\xde\x00\xdf\x00\xe0\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\xe2\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xe3\x00\xe4\x00\xe5\x00\xe6\x00\x00\x00\x00\x00\xe7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xea\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x7f\x01\xba\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\xd3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x01\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xf7\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\xae\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\xae\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\xed\x03\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\xae\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xf7\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\xed\x03\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x78\x01\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x45\x04\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xab\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xac\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\xd8\x02\x84\x01\x85\x01\x86\x01\x00\x00\x87\x01\x00\x00\x00\x00\x22\x01\x00\x00\x00\x00\x74\x00\x23\x01\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\xc5\x01\xc6\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x24\x01\x00\x00\x00\x00\x00\x00\x25\x01\x00\x00\xc7\x01\x00\x00\x4b\x02\x7c\x00\x11\x00\x7d\x00\xb6\x00\x26\x01\xb7\x00\xd9\x02\xb8\x00\x00\x00\xb9\x00\xe6\x01\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xca\xfe\xca\xfe\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfe\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfe\x00\x00\x00\x00\x00\x00\xca\xfe\x00\x00\x00\x00\x00\x00\xca\xfe\x00\x00\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\x00\x00\xca\xfe\x00\x00\x00\x00\x00\x00\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfe\xca\xfe\xca\xfe\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x03\x00\x00\xca\xfe\x00\x00\xca\xfe\x00\x00\xca\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xca\xfe\xca\xfe\xca\xfe\x00\x00\x00\x00\xca\xfe\xca\xfe\x00\x00\x00\x00\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\x00\x00\xca\xfe\x00\x00\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xca\xfe\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x01\x00\x00\x00\x00\x01\x04\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xff\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\x00\x00\x00\x00\x00\x00\xc1\xfe\x00\x00\x00\x00\x00\x00\x6a\x03\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\xc1\xfe\x00\x00\x00\x00\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\x00\x00\xc1\xfe\x00\x00\xc1\xfe\x00\x00\xc1\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\x00\x00\xc1\xfe\xc1\xfe\x00\x00\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\x00\x00\xc1\xfe\x00\x00\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xc1\xfe\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x71\xfd\x00\x00\x71\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xff\x03\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xaf\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\xe3\x03\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\xa9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xad\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xb4\x00\xb5\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\xbb\x00\xbc\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\xa8\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xf2\xfd\x83\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\xf2\x02\xf3\x02\x00\x00\x7f\xfe\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x87\x00\x00\x00\x00\x00\x00\x00\xf4\x02\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\xf2\xfd\x00\x00\xf2\xfd\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x5c\x01\x00\x00\x00\x00\x00\x00\x8d\x00\x8e\x00\x00\x00\x00\x00\x90\x00\x91\x00\xb6\x00\x00\x00\xb7\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\xba\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x00\xbd\x00\xbe\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\x00\x00\xd5\x00\x00\x00\x6f\x00\xd6\x00\xd7\x00\x70\x00\x71\x00\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x1d\xfd\x00\x00\x1d\xfd\x56\x02\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x1d\xfd\x1d\xfd\x1d\xfd\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\xfd\x15\x00\x00\x00\x1d\xfd\x1d\xfd\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\xfe\x01\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x01\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\xf9\x01\x00\x00\x00\x00\x00\x00\x7e\x01\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\xa4\x05\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x01\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\xfe\x01\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x01\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x43\x01\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x01\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x45\x01\x46\x01\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x02\x58\x00\x59\x00\x00\x00\x66\x02\x00\x00\x00\x00\x00\x00\x00\x00\x67\x02\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x68\x02\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x01\x60\x00\x61\x00\x62\x00\x63\x00\x69\x02\x6a\x02\x66\x00\x67\x00\x68\x00\x6b\x02\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x5a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x02\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x05\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x32\x05\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x23\x05\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x05\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x05\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\xa4\x05\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\xa5\x05\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x50\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x6a\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\xa6\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\xa6\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x00\x15\x00\x00\x00\x70\x00\x71\x00\x22\x03\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\xe9\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\xe9\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x00\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x57\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x00\x00\x4f\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x58\x00\x59\x00\x00\x00\x5a\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x5e\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x01\x62\x00\x63\x00\x00\x00\x00\x00\x66\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x06\x02\x00\x00\x00\x00\x00\x00\x6f\x00\x00\x00\x00\x00\x70\x00\x71\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\xf1\x03\x7a\x03\x00\x00\x00\x00\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa0\x00\xa1\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\xf1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa2\x00\x73\x00\xa4\x00\xf2\x03\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\xec\x00\x00\x00\x00\x00\xf3\x03\x00\x00\xa6\x00\x00\x00\xf4\x03\x00\x00\xf5\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\xec\x00\x00\x00\x00\x00\xf7\x03\x00\x00\xa6\x00\x00\x00\xf4\x03\x00\x00\xf5\x03\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\xf1\x03\x00\x00\x00\x00\x00\x00\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa0\x00\xa1\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\xf1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa2\x00\x73\x00\xa4\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\xec\x00\x00\x00\x00\x00\x3f\x04\x00\x00\xa6\x00\x00\x00\xf4\x03\x00\x00\xf5\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\xa5\x00\x00\x00\x00\x00\xec\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\xf5\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\xf9\x03\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\xfa\x03\x00\x00\x00\x00\x00\x00\xc1\x01\xf9\x03\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x03\x00\x00\x00\x00\x00\x00\xfc\x03\x00\x00\xfd\x03\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\xf9\x03\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\x03\x00\x00\x00\x00\x00\x00\xfc\x03\x00\x00\xfd\x03\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\xf9\x03\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x04\x00\x00\x00\x00\x00\x00\xfc\x03\x00\x00\xfd\x03\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xe7\x03\xe8\x03\xe9\x03\xea\x03\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x04\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xf1\x04\xe9\x03\xea\x03\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\xeb\x03\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0b\x01\x0c\x01\x9f\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x9d\x00\x00\x00\x9e\x00\x9f\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\xa5\x00\xab\x02\x00\x00\x00\x00\xaa\x02\x9f\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\xa5\x00\xa9\x02\x00\x00\x00\x00\xaa\x02\x9f\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\xe7\x01\x7e\x00\x7f\x00\x9a\x00\x9b\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x02\x88\x02\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x89\x02\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\xa1\x01\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x91\x00\xce\x01\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9c\x03\x88\x02\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x02\x00\x00\x00\x00\xcf\x01\xd0\x01\xd1\x01\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa6\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xef\x04\x48\x04\x9f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\xf0\x04\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa6\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x91\x00\x92\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x9c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x34\x04\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa5\x00\x00\x00\x00\x00\xec\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa6\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xea\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x91\x00\x6a\x03\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x03\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa5\x00\x00\x00\x00\x00\xfc\x02\x11\x00\x00\x00\x7e\x00\x7f\x00\xa6\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x6a\x03\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\xed\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xd4\x01\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\xa8\x01\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xa2\x01\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x83\x02\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x02\x04\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x01\x04\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xef\x03\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x9d\x03\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x4d\x04\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x43\x04\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x35\x04\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x33\x04\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\xf6\x04\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\xd3\x04\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x49\x05\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x18\x05\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x17\x05\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x16\x05\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x8b\x05\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x9b\x05\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x93\x00\xa5\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xdb\x01\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x93\x00\x77\x02\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x76\x02\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\xa6\x00\xa4\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x93\x00\x75\x02\x94\x00\x00\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\xa6\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x16\x00\x17\x00\x18\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x14\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x02\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x00\x16\x00\x17\x00\x18\x00\x77\x03\x78\x03\x79\x03\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x38\x02\x39\x02\xd9\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x3a\x02\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x06\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x7a\x03\x13\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x14\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x15\x00\x06\x02\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x7a\x03\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x10\x05\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x38\x02\x39\x02\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x3a\x02\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x03\x02\x03\x00\x00\x03\x03\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x38\x02\x39\x02\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x00\x00\xa0\x01\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x03\x02\x03\x00\x00\x03\x03\x96\x00\x97\x00\x98\x00\x99\x00\xa0\x00\xa1\x00\x9a\x00\x9b\x00\x00\x00\x38\x02\x39\x02\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x3a\x02\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa2\x00\x73\x00\xa4\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa1\x01\x00\x00\x0f\x00\x10\x00\x04\x03\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x13\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x03\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x13\x00\x89\x00\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x8b\x00\x00\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x2c\x00\x8f\x00\x90\x00\x91\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x02\x13\x00\xef\x01\x00\x00\xf0\x01\x00\x00\x8a\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\xf1\x01\x00\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x00\x00\x8f\x00\x15\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x13\x00\x00\x00\x00\x00\x00\x00\xad\x04\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\x04\x00\x00\x00\x00\x15\x00\x00\x00\xaf\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xb0\x04\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\xc2\x05\x00\x00\x00\x00\x15\x00\x00\x00\xaf\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xc3\x05\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xb1\x04\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x2b\x00\x63\x00\x00\x00\x00\x00\x2c\x00\x67\x00\x00\x00\xc2\x05\x00\x00\x00\x00\x15\x00\x00\x00\xaf\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xc3\x05\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x13\x00\xb1\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xc4\x05\x00\x00\x00\x00\x2b\x00\x63\x00\x00\x00\x00\x00\x2c\x00\x67\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\xfa\xfd\x00\x00\xb1\x04\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x63\x00\x00\x00\x00\x00\x2c\x00\x67\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x88\x00\x00\x00\x89\x00\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x8d\x01\x00\x00\xfa\xfd\x14\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\x00\x00\x15\x00\xfa\xfd\xfa\xfd\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xaf\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x88\x00\x00\x00\x89\x00\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x2c\x00\x8f\x00\x14\x00\x00\x00\x5e\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\xb1\x04\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x2b\x00\x63\x00\x00\x00\x00\x00\x2c\x00\x67\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\xef\x01\x00\x00\xf0\x01\x14\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x15\x00\x00\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x15\x00\x2c\x00\x8f\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x01\x00\x00\x00\x00\x2b\x00\x8c\x00\xfa\xfd\x00\x00\x00\x00\x8f\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\xfa\xfd\x00\x00\x00\x00\x67\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x01\x00\x00\xfa\xfd\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x8d\x01\x00\x00\xfa\xfd\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x13\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\xfa\xfd\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x81\x02\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x13\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x01\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x13\x00\x89\x01\x7d\x01\x8a\x00\x00\x00\x00\x00\x00\x00\x14\x00\x7e\x01\x00\x00\x00\x00\x2b\x00\x8c\x00\x8d\x00\x8e\x00\x00\x00\x28\x01\x00\x00\x00\x00\x15\x00\x00\x00\x29\x01\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x2a\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x89\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x3b\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x2a\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x89\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x2a\x01\x00\x00\x8a\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x13\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x14\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x11\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x02\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x10\x02\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x10\x02\x13\x00\x00\x00\x11\x02\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x12\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x13\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x14\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x15\x00\x12\x02\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x62\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x02\x39\x02\x00\x00\x00\x00\xf8\xfe\x15\x00\x00\x00\x00\x00\x00\x00\xf8\xfe\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x33\x03\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x00\x00\x00\x00\x00\x00\xca\x02\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x06\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x8b\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x06\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x13\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x14\x00\x8b\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x04\x16\x00\x17\x00\x18\x00\x51\x00\x52\x00\x53\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x91\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x62\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\xa7\x01\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\xc2\x01\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x62\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x91\x00\x7e\x00\x7f\x00\x00\x00\x47\x03\xa4\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\xe8\x02\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\xc0\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\x8b\x04\x00\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc1\x01\x9a\x02\xc3\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x91\x00\x7e\x00\x7f\x00\x00\x00\x32\x05\xa4\x00\x94\x00\x00\x00\x00\x00\x96\x00\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x01\x97\x00\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\xe0\x03\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x91\x00\xe1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x91\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x01\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xc9\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x01\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x91\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x91\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x01\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xaf\x01\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x03\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x91\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x03\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x91\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd9\x01\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x84\x02\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x03\x98\x00\x99\x00\xa2\x00\x73\x00\x9a\x00\x9b\x00\x91\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x03\x98\x00\x99\x00\x00\x00\x00\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\xa0\x00\xa1\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\x73\x00\x00\x00\x00\x00\x00\x00\x74\x00\x75\x00\x76\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\xa3\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x7e\x00\x7f\x00\x00\x00\x00\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = Happy_Data_Array.array (13, 896) [ - (13 , happyReduce_13), - (14 , happyReduce_14), - (15 , happyReduce_15), - (16 , happyReduce_16), - (17 , happyReduce_17), - (18 , happyReduce_18), - (19 , happyReduce_19), - (20 , happyReduce_20), - (21 , happyReduce_21), - (22 , happyReduce_22), - (23 , happyReduce_23), - (24 , happyReduce_24), - (25 , happyReduce_25), - (26 , happyReduce_26), - (27 , happyReduce_27), - (28 , happyReduce_28), - (29 , happyReduce_29), - (30 , happyReduce_30), - (31 , happyReduce_31), - (32 , happyReduce_32), - (33 , happyReduce_33), - (34 , happyReduce_34), - (35 , happyReduce_35), - (36 , happyReduce_36), - (37 , happyReduce_37), - (38 , happyReduce_38), - (39 , happyReduce_39), - (40 , happyReduce_40), - (41 , happyReduce_41), - (42 , happyReduce_42), - (43 , happyReduce_43), - (44 , happyReduce_44), - (45 , happyReduce_45), - (46 , happyReduce_46), - (47 , happyReduce_47), - (48 , happyReduce_48), - (49 , happyReduce_49), - (50 , happyReduce_50), - (51 , happyReduce_51), - (52 , happyReduce_52), - (53 , happyReduce_53), - (54 , happyReduce_54), - (55 , happyReduce_55), - (56 , happyReduce_56), - (57 , happyReduce_57), - (58 , happyReduce_58), - (59 , happyReduce_59), - (60 , happyReduce_60), - (61 , happyReduce_61), - (62 , happyReduce_62), - (63 , happyReduce_63), - (64 , happyReduce_64), - (65 , happyReduce_65), - (66 , happyReduce_66), - (67 , happyReduce_67), - (68 , happyReduce_68), - (69 , happyReduce_69), - (70 , happyReduce_70), - (71 , happyReduce_71), - (72 , happyReduce_72), - (73 , happyReduce_73), - (74 , happyReduce_74), - (75 , happyReduce_75), - (76 , happyReduce_76), - (77 , happyReduce_77), - (78 , happyReduce_78), - (79 , happyReduce_79), - (80 , happyReduce_80), - (81 , happyReduce_81), - (82 , happyReduce_82), - (83 , happyReduce_83), - (84 , happyReduce_84), - (85 , happyReduce_85), - (86 , happyReduce_86), - (87 , happyReduce_87), - (88 , happyReduce_88), - (89 , happyReduce_89), - (90 , happyReduce_90), - (91 , happyReduce_91), - (92 , happyReduce_92), - (93 , happyReduce_93), - (94 , happyReduce_94), - (95 , happyReduce_95), - (96 , happyReduce_96), - (97 , happyReduce_97), - (98 , happyReduce_98), - (99 , happyReduce_99), - (100 , happyReduce_100), - (101 , happyReduce_101), - (102 , happyReduce_102), - (103 , happyReduce_103), - (104 , happyReduce_104), - (105 , happyReduce_105), - (106 , happyReduce_106), - (107 , happyReduce_107), - (108 , happyReduce_108), - (109 , happyReduce_109), - (110 , happyReduce_110), - (111 , happyReduce_111), - (112 , happyReduce_112), - (113 , happyReduce_113), - (114 , happyReduce_114), - (115 , happyReduce_115), - (116 , happyReduce_116), - (117 , happyReduce_117), - (118 , happyReduce_118), - (119 , happyReduce_119), - (120 , happyReduce_120), - (121 , happyReduce_121), - (122 , happyReduce_122), - (123 , happyReduce_123), - (124 , happyReduce_124), - (125 , happyReduce_125), - (126 , happyReduce_126), - (127 , happyReduce_127), - (128 , happyReduce_128), - (129 , happyReduce_129), - (130 , happyReduce_130), - (131 , happyReduce_131), - (132 , happyReduce_132), - (133 , happyReduce_133), - (134 , happyReduce_134), - (135 , happyReduce_135), - (136 , happyReduce_136), - (137 , happyReduce_137), - (138 , happyReduce_138), - (139 , happyReduce_139), - (140 , happyReduce_140), - (141 , happyReduce_141), - (142 , happyReduce_142), - (143 , happyReduce_143), - (144 , happyReduce_144), - (145 , happyReduce_145), - (146 , happyReduce_146), - (147 , happyReduce_147), - (148 , happyReduce_148), - (149 , happyReduce_149), - (150 , happyReduce_150), - (151 , happyReduce_151), - (152 , happyReduce_152), - (153 , happyReduce_153), - (154 , happyReduce_154), - (155 , happyReduce_155), - (156 , happyReduce_156), - (157 , happyReduce_157), - (158 , happyReduce_158), - (159 , happyReduce_159), - (160 , happyReduce_160), - (161 , happyReduce_161), - (162 , happyReduce_162), - (163 , happyReduce_163), - (164 , happyReduce_164), - (165 , happyReduce_165), - (166 , happyReduce_166), - (167 , happyReduce_167), - (168 , happyReduce_168), - (169 , happyReduce_169), - (170 , happyReduce_170), - (171 , happyReduce_171), - (172 , happyReduce_172), - (173 , happyReduce_173), - (174 , happyReduce_174), - (175 , happyReduce_175), - (176 , happyReduce_176), - (177 , happyReduce_177), - (178 , happyReduce_178), - (179 , happyReduce_179), - (180 , happyReduce_180), - (181 , happyReduce_181), - (182 , happyReduce_182), - (183 , happyReduce_183), - (184 , happyReduce_184), - (185 , happyReduce_185), - (186 , happyReduce_186), - (187 , happyReduce_187), - (188 , happyReduce_188), - (189 , happyReduce_189), - (190 , happyReduce_190), - (191 , happyReduce_191), - (192 , happyReduce_192), - (193 , happyReduce_193), - (194 , happyReduce_194), - (195 , happyReduce_195), - (196 , happyReduce_196), - (197 , happyReduce_197), - (198 , happyReduce_198), - (199 , happyReduce_199), - (200 , happyReduce_200), - (201 , happyReduce_201), - (202 , happyReduce_202), - (203 , happyReduce_203), - (204 , happyReduce_204), - (205 , happyReduce_205), - (206 , happyReduce_206), - (207 , happyReduce_207), - (208 , happyReduce_208), - (209 , happyReduce_209), - (210 , happyReduce_210), - (211 , happyReduce_211), - (212 , happyReduce_212), - (213 , happyReduce_213), - (214 , happyReduce_214), - (215 , happyReduce_215), - (216 , happyReduce_216), - (217 , happyReduce_217), - (218 , happyReduce_218), - (219 , happyReduce_219), - (220 , happyReduce_220), - (221 , happyReduce_221), - (222 , happyReduce_222), - (223 , happyReduce_223), - (224 , happyReduce_224), - (225 , happyReduce_225), - (226 , happyReduce_226), - (227 , happyReduce_227), - (228 , happyReduce_228), - (229 , happyReduce_229), - (230 , happyReduce_230), - (231 , happyReduce_231), - (232 , happyReduce_232), - (233 , happyReduce_233), - (234 , happyReduce_234), - (235 , happyReduce_235), - (236 , happyReduce_236), - (237 , happyReduce_237), - (238 , happyReduce_238), - (239 , happyReduce_239), - (240 , happyReduce_240), - (241 , happyReduce_241), - (242 , happyReduce_242), - (243 , happyReduce_243), - (244 , happyReduce_244), - (245 , happyReduce_245), - (246 , happyReduce_246), - (247 , happyReduce_247), - (248 , happyReduce_248), - (249 , happyReduce_249), - (250 , happyReduce_250), - (251 , happyReduce_251), - (252 , happyReduce_252), - (253 , happyReduce_253), - (254 , happyReduce_254), - (255 , happyReduce_255), - (256 , happyReduce_256), - (257 , happyReduce_257), - (258 , happyReduce_258), - (259 , happyReduce_259), - (260 , happyReduce_260), - (261 , happyReduce_261), - (262 , happyReduce_262), - (263 , happyReduce_263), - (264 , happyReduce_264), - (265 , happyReduce_265), - (266 , happyReduce_266), - (267 , happyReduce_267), - (268 , happyReduce_268), - (269 , happyReduce_269), - (270 , happyReduce_270), - (271 , happyReduce_271), - (272 , happyReduce_272), - (273 , happyReduce_273), - (274 , happyReduce_274), - (275 , happyReduce_275), - (276 , happyReduce_276), - (277 , happyReduce_277), - (278 , happyReduce_278), - (279 , happyReduce_279), - (280 , happyReduce_280), - (281 , happyReduce_281), - (282 , happyReduce_282), - (283 , happyReduce_283), - (284 , happyReduce_284), - (285 , happyReduce_285), - (286 , happyReduce_286), - (287 , happyReduce_287), - (288 , happyReduce_288), - (289 , happyReduce_289), - (290 , happyReduce_290), - (291 , happyReduce_291), - (292 , happyReduce_292), - (293 , happyReduce_293), - (294 , happyReduce_294), - (295 , happyReduce_295), - (296 , happyReduce_296), - (297 , happyReduce_297), - (298 , happyReduce_298), - (299 , happyReduce_299), - (300 , happyReduce_300), - (301 , happyReduce_301), - (302 , happyReduce_302), - (303 , happyReduce_303), - (304 , happyReduce_304), - (305 , happyReduce_305), - (306 , happyReduce_306), - (307 , happyReduce_307), - (308 , happyReduce_308), - (309 , happyReduce_309), - (310 , happyReduce_310), - (311 , happyReduce_311), - (312 , happyReduce_312), - (313 , happyReduce_313), - (314 , happyReduce_314), - (315 , happyReduce_315), - (316 , happyReduce_316), - (317 , happyReduce_317), - (318 , happyReduce_318), - (319 , happyReduce_319), - (320 , happyReduce_320), - (321 , happyReduce_321), - (322 , happyReduce_322), - (323 , happyReduce_323), - (324 , happyReduce_324), - (325 , happyReduce_325), - (326 , happyReduce_326), - (327 , happyReduce_327), - (328 , happyReduce_328), - (329 , happyReduce_329), - (330 , happyReduce_330), - (331 , happyReduce_331), - (332 , happyReduce_332), - (333 , happyReduce_333), - (334 , happyReduce_334), - (335 , happyReduce_335), - (336 , happyReduce_336), - (337 , happyReduce_337), - (338 , happyReduce_338), - (339 , happyReduce_339), - (340 , happyReduce_340), - (341 , happyReduce_341), - (342 , happyReduce_342), - (343 , happyReduce_343), - (344 , happyReduce_344), - (345 , happyReduce_345), - (346 , happyReduce_346), - (347 , happyReduce_347), - (348 , happyReduce_348), - (349 , happyReduce_349), - (350 , happyReduce_350), - (351 , happyReduce_351), - (352 , happyReduce_352), - (353 , happyReduce_353), - (354 , happyReduce_354), - (355 , happyReduce_355), - (356 , happyReduce_356), - (357 , happyReduce_357), - (358 , happyReduce_358), - (359 , happyReduce_359), - (360 , happyReduce_360), - (361 , happyReduce_361), - (362 , happyReduce_362), - (363 , happyReduce_363), - (364 , happyReduce_364), - (365 , happyReduce_365), - (366 , happyReduce_366), - (367 , happyReduce_367), - (368 , happyReduce_368), - (369 , happyReduce_369), - (370 , happyReduce_370), - (371 , happyReduce_371), - (372 , happyReduce_372), - (373 , happyReduce_373), - (374 , happyReduce_374), - (375 , happyReduce_375), - (376 , happyReduce_376), - (377 , happyReduce_377), - (378 , happyReduce_378), - (379 , happyReduce_379), - (380 , happyReduce_380), - (381 , happyReduce_381), - (382 , happyReduce_382), - (383 , happyReduce_383), - (384 , happyReduce_384), - (385 , happyReduce_385), - (386 , happyReduce_386), - (387 , happyReduce_387), - (388 , happyReduce_388), - (389 , happyReduce_389), - (390 , happyReduce_390), - (391 , happyReduce_391), - (392 , happyReduce_392), - (393 , happyReduce_393), - (394 , happyReduce_394), - (395 , happyReduce_395), - (396 , happyReduce_396), - (397 , happyReduce_397), - (398 , happyReduce_398), - (399 , happyReduce_399), - (400 , happyReduce_400), - (401 , happyReduce_401), - (402 , happyReduce_402), - (403 , happyReduce_403), - (404 , happyReduce_404), - (405 , happyReduce_405), - (406 , happyReduce_406), - (407 , happyReduce_407), - (408 , happyReduce_408), - (409 , happyReduce_409), - (410 , happyReduce_410), - (411 , happyReduce_411), - (412 , happyReduce_412), - (413 , happyReduce_413), - (414 , happyReduce_414), - (415 , happyReduce_415), - (416 , happyReduce_416), - (417 , happyReduce_417), - (418 , happyReduce_418), - (419 , happyReduce_419), - (420 , happyReduce_420), - (421 , happyReduce_421), - (422 , happyReduce_422), - (423 , happyReduce_423), - (424 , happyReduce_424), - (425 , happyReduce_425), - (426 , happyReduce_426), - (427 , happyReduce_427), - (428 , happyReduce_428), - (429 , happyReduce_429), - (430 , happyReduce_430), - (431 , happyReduce_431), - (432 , happyReduce_432), - (433 , happyReduce_433), - (434 , happyReduce_434), - (435 , happyReduce_435), - (436 , happyReduce_436), - (437 , happyReduce_437), - (438 , happyReduce_438), - (439 , happyReduce_439), - (440 , happyReduce_440), - (441 , happyReduce_441), - (442 , happyReduce_442), - (443 , happyReduce_443), - (444 , happyReduce_444), - (445 , happyReduce_445), - (446 , happyReduce_446), - (447 , happyReduce_447), - (448 , happyReduce_448), - (449 , happyReduce_449), - (450 , happyReduce_450), - (451 , happyReduce_451), - (452 , happyReduce_452), - (453 , happyReduce_453), - (454 , happyReduce_454), - (455 , happyReduce_455), - (456 , happyReduce_456), - (457 , happyReduce_457), - (458 , happyReduce_458), - (459 , happyReduce_459), - (460 , happyReduce_460), - (461 , happyReduce_461), - (462 , happyReduce_462), - (463 , happyReduce_463), - (464 , happyReduce_464), - (465 , happyReduce_465), - (466 , happyReduce_466), - (467 , happyReduce_467), - (468 , happyReduce_468), - (469 , happyReduce_469), - (470 , happyReduce_470), - (471 , happyReduce_471), - (472 , happyReduce_472), - (473 , happyReduce_473), - (474 , happyReduce_474), - (475 , happyReduce_475), - (476 , happyReduce_476), - (477 , happyReduce_477), - (478 , happyReduce_478), - (479 , happyReduce_479), - (480 , happyReduce_480), - (481 , happyReduce_481), - (482 , happyReduce_482), - (483 , happyReduce_483), - (484 , happyReduce_484), - (485 , happyReduce_485), - (486 , happyReduce_486), - (487 , happyReduce_487), - (488 , happyReduce_488), - (489 , happyReduce_489), - (490 , happyReduce_490), - (491 , happyReduce_491), - (492 , happyReduce_492), - (493 , happyReduce_493), - (494 , happyReduce_494), - (495 , happyReduce_495), - (496 , happyReduce_496), - (497 , happyReduce_497), - (498 , happyReduce_498), - (499 , happyReduce_499), - (500 , happyReduce_500), - (501 , happyReduce_501), - (502 , happyReduce_502), - (503 , happyReduce_503), - (504 , happyReduce_504), - (505 , happyReduce_505), - (506 , happyReduce_506), - (507 , happyReduce_507), - (508 , happyReduce_508), - (509 , happyReduce_509), - (510 , happyReduce_510), - (511 , happyReduce_511), - (512 , happyReduce_512), - (513 , happyReduce_513), - (514 , happyReduce_514), - (515 , happyReduce_515), - (516 , happyReduce_516), - (517 , happyReduce_517), - (518 , happyReduce_518), - (519 , happyReduce_519), - (520 , happyReduce_520), - (521 , happyReduce_521), - (522 , happyReduce_522), - (523 , happyReduce_523), - (524 , happyReduce_524), - (525 , happyReduce_525), - (526 , happyReduce_526), - (527 , happyReduce_527), - (528 , happyReduce_528), - (529 , happyReduce_529), - (530 , happyReduce_530), - (531 , happyReduce_531), - (532 , happyReduce_532), - (533 , happyReduce_533), - (534 , happyReduce_534), - (535 , happyReduce_535), - (536 , happyReduce_536), - (537 , happyReduce_537), - (538 , happyReduce_538), - (539 , happyReduce_539), - (540 , happyReduce_540), - (541 , happyReduce_541), - (542 , happyReduce_542), - (543 , happyReduce_543), - (544 , happyReduce_544), - (545 , happyReduce_545), - (546 , happyReduce_546), - (547 , happyReduce_547), - (548 , happyReduce_548), - (549 , happyReduce_549), - (550 , happyReduce_550), - (551 , happyReduce_551), - (552 , happyReduce_552), - (553 , happyReduce_553), - (554 , happyReduce_554), - (555 , happyReduce_555), - (556 , happyReduce_556), - (557 , happyReduce_557), - (558 , happyReduce_558), - (559 , happyReduce_559), - (560 , happyReduce_560), - (561 , happyReduce_561), - (562 , happyReduce_562), - (563 , happyReduce_563), - (564 , happyReduce_564), - (565 , happyReduce_565), - (566 , happyReduce_566), - (567 , happyReduce_567), - (568 , happyReduce_568), - (569 , happyReduce_569), - (570 , happyReduce_570), - (571 , happyReduce_571), - (572 , happyReduce_572), - (573 , happyReduce_573), - (574 , happyReduce_574), - (575 , happyReduce_575), - (576 , happyReduce_576), - (577 , happyReduce_577), - (578 , happyReduce_578), - (579 , happyReduce_579), - (580 , happyReduce_580), - (581 , happyReduce_581), - (582 , happyReduce_582), - (583 , happyReduce_583), - (584 , happyReduce_584), - (585 , happyReduce_585), - (586 , happyReduce_586), - (587 , happyReduce_587), - (588 , happyReduce_588), - (589 , happyReduce_589), - (590 , happyReduce_590), - (591 , happyReduce_591), - (592 , happyReduce_592), - (593 , happyReduce_593), - (594 , happyReduce_594), - (595 , happyReduce_595), - (596 , happyReduce_596), - (597 , happyReduce_597), - (598 , happyReduce_598), - (599 , happyReduce_599), - (600 , happyReduce_600), - (601 , happyReduce_601), - (602 , happyReduce_602), - (603 , happyReduce_603), - (604 , happyReduce_604), - (605 , happyReduce_605), - (606 , happyReduce_606), - (607 , happyReduce_607), - (608 , happyReduce_608), - (609 , happyReduce_609), - (610 , happyReduce_610), - (611 , happyReduce_611), - (612 , happyReduce_612), - (613 , happyReduce_613), - (614 , happyReduce_614), - (615 , happyReduce_615), - (616 , happyReduce_616), - (617 , happyReduce_617), - (618 , happyReduce_618), - (619 , happyReduce_619), - (620 , happyReduce_620), - (621 , happyReduce_621), - (622 , happyReduce_622), - (623 , happyReduce_623), - (624 , happyReduce_624), - (625 , happyReduce_625), - (626 , happyReduce_626), - (627 , happyReduce_627), - (628 , happyReduce_628), - (629 , happyReduce_629), - (630 , happyReduce_630), - (631 , happyReduce_631), - (632 , happyReduce_632), - (633 , happyReduce_633), - (634 , happyReduce_634), - (635 , happyReduce_635), - (636 , happyReduce_636), - (637 , happyReduce_637), - (638 , happyReduce_638), - (639 , happyReduce_639), - (640 , happyReduce_640), - (641 , happyReduce_641), - (642 , happyReduce_642), - (643 , happyReduce_643), - (644 , happyReduce_644), - (645 , happyReduce_645), - (646 , happyReduce_646), - (647 , happyReduce_647), - (648 , happyReduce_648), - (649 , happyReduce_649), - (650 , happyReduce_650), - (651 , happyReduce_651), - (652 , happyReduce_652), - (653 , happyReduce_653), - (654 , happyReduce_654), - (655 , happyReduce_655), - (656 , happyReduce_656), - (657 , happyReduce_657), - (658 , happyReduce_658), - (659 , happyReduce_659), - (660 , happyReduce_660), - (661 , happyReduce_661), - (662 , happyReduce_662), - (663 , happyReduce_663), - (664 , happyReduce_664), - (665 , happyReduce_665), - (666 , happyReduce_666), - (667 , happyReduce_667), - (668 , happyReduce_668), - (669 , happyReduce_669), - (670 , happyReduce_670), - (671 , happyReduce_671), - (672 , happyReduce_672), - (673 , happyReduce_673), - (674 , happyReduce_674), - (675 , happyReduce_675), - (676 , happyReduce_676), - (677 , happyReduce_677), - (678 , happyReduce_678), - (679 , happyReduce_679), - (680 , happyReduce_680), - (681 , happyReduce_681), - (682 , happyReduce_682), - (683 , happyReduce_683), - (684 , happyReduce_684), - (685 , happyReduce_685), - (686 , happyReduce_686), - (687 , happyReduce_687), - (688 , happyReduce_688), - (689 , happyReduce_689), - (690 , happyReduce_690), - (691 , happyReduce_691), - (692 , happyReduce_692), - (693 , happyReduce_693), - (694 , happyReduce_694), - (695 , happyReduce_695), - (696 , happyReduce_696), - (697 , happyReduce_697), - (698 , happyReduce_698), - (699 , happyReduce_699), - (700 , happyReduce_700), - (701 , happyReduce_701), - (702 , happyReduce_702), - (703 , happyReduce_703), - (704 , happyReduce_704), - (705 , happyReduce_705), - (706 , happyReduce_706), - (707 , happyReduce_707), - (708 , happyReduce_708), - (709 , happyReduce_709), - (710 , happyReduce_710), - (711 , happyReduce_711), - (712 , happyReduce_712), - (713 , happyReduce_713), - (714 , happyReduce_714), - (715 , happyReduce_715), - (716 , happyReduce_716), - (717 , happyReduce_717), - (718 , happyReduce_718), - (719 , happyReduce_719), - (720 , happyReduce_720), - (721 , happyReduce_721), - (722 , happyReduce_722), - (723 , happyReduce_723), - (724 , happyReduce_724), - (725 , happyReduce_725), - (726 , happyReduce_726), - (727 , happyReduce_727), - (728 , happyReduce_728), - (729 , happyReduce_729), - (730 , happyReduce_730), - (731 , happyReduce_731), - (732 , happyReduce_732), - (733 , happyReduce_733), - (734 , happyReduce_734), - (735 , happyReduce_735), - (736 , happyReduce_736), - (737 , happyReduce_737), - (738 , happyReduce_738), - (739 , happyReduce_739), - (740 , happyReduce_740), - (741 , happyReduce_741), - (742 , happyReduce_742), - (743 , happyReduce_743), - (744 , happyReduce_744), - (745 , happyReduce_745), - (746 , happyReduce_746), - (747 , happyReduce_747), - (748 , happyReduce_748), - (749 , happyReduce_749), - (750 , happyReduce_750), - (751 , happyReduce_751), - (752 , happyReduce_752), - (753 , happyReduce_753), - (754 , happyReduce_754), - (755 , happyReduce_755), - (756 , happyReduce_756), - (757 , happyReduce_757), - (758 , happyReduce_758), - (759 , happyReduce_759), - (760 , happyReduce_760), - (761 , happyReduce_761), - (762 , happyReduce_762), - (763 , happyReduce_763), - (764 , happyReduce_764), - (765 , happyReduce_765), - (766 , happyReduce_766), - (767 , happyReduce_767), - (768 , happyReduce_768), - (769 , happyReduce_769), - (770 , happyReduce_770), - (771 , happyReduce_771), - (772 , happyReduce_772), - (773 , happyReduce_773), - (774 , happyReduce_774), - (775 , happyReduce_775), - (776 , happyReduce_776), - (777 , happyReduce_777), - (778 , happyReduce_778), - (779 , happyReduce_779), - (780 , happyReduce_780), - (781 , happyReduce_781), - (782 , happyReduce_782), - (783 , happyReduce_783), - (784 , happyReduce_784), - (785 , happyReduce_785), - (786 , happyReduce_786), - (787 , happyReduce_787), - (788 , happyReduce_788), - (789 , happyReduce_789), - (790 , happyReduce_790), - (791 , happyReduce_791), - (792 , happyReduce_792), - (793 , happyReduce_793), - (794 , happyReduce_794), - (795 , happyReduce_795), - (796 , happyReduce_796), - (797 , happyReduce_797), - (798 , happyReduce_798), - (799 , happyReduce_799), - (800 , happyReduce_800), - (801 , happyReduce_801), - (802 , happyReduce_802), - (803 , happyReduce_803), - (804 , happyReduce_804), - (805 , happyReduce_805), - (806 , happyReduce_806), - (807 , happyReduce_807), - (808 , happyReduce_808), - (809 , happyReduce_809), - (810 , happyReduce_810), - (811 , happyReduce_811), - (812 , happyReduce_812), - (813 , happyReduce_813), - (814 , happyReduce_814), - (815 , happyReduce_815), - (816 , happyReduce_816), - (817 , happyReduce_817), - (818 , happyReduce_818), - (819 , happyReduce_819), - (820 , happyReduce_820), - (821 , happyReduce_821), - (822 , happyReduce_822), - (823 , happyReduce_823), - (824 , happyReduce_824), - (825 , happyReduce_825), - (826 , happyReduce_826), - (827 , happyReduce_827), - (828 , happyReduce_828), - (829 , happyReduce_829), - (830 , happyReduce_830), - (831 , happyReduce_831), - (832 , happyReduce_832), - (833 , happyReduce_833), - (834 , happyReduce_834), - (835 , happyReduce_835), - (836 , happyReduce_836), - (837 , happyReduce_837), - (838 , happyReduce_838), - (839 , happyReduce_839), - (840 , happyReduce_840), - (841 , happyReduce_841), - (842 , happyReduce_842), - (843 , happyReduce_843), - (844 , happyReduce_844), - (845 , happyReduce_845), - (846 , happyReduce_846), - (847 , happyReduce_847), - (848 , happyReduce_848), - (849 , happyReduce_849), - (850 , happyReduce_850), - (851 , happyReduce_851), - (852 , happyReduce_852), - (853 , happyReduce_853), - (854 , happyReduce_854), - (855 , happyReduce_855), - (856 , happyReduce_856), - (857 , happyReduce_857), - (858 , happyReduce_858), - (859 , happyReduce_859), - (860 , happyReduce_860), - (861 , happyReduce_861), - (862 , happyReduce_862), - (863 , happyReduce_863), - (864 , happyReduce_864), - (865 , happyReduce_865), - (866 , happyReduce_866), - (867 , happyReduce_867), - (868 , happyReduce_868), - (869 , happyReduce_869), - (870 , happyReduce_870), - (871 , happyReduce_871), - (872 , happyReduce_872), - (873 , happyReduce_873), - (874 , happyReduce_874), - (875 , happyReduce_875), - (876 , happyReduce_876), - (877 , happyReduce_877), - (878 , happyReduce_878), - (879 , happyReduce_879), - (880 , happyReduce_880), - (881 , happyReduce_881), - (882 , happyReduce_882), - (883 , happyReduce_883), - (884 , happyReduce_884), - (885 , happyReduce_885), - (886 , happyReduce_886), - (887 , happyReduce_887), - (888 , happyReduce_888), - (889 , happyReduce_889), - (890 , happyReduce_890), - (891 , happyReduce_891), - (892 , happyReduce_892), - (893 , happyReduce_893), - (894 , happyReduce_894), - (895 , happyReduce_895), - (896 , happyReduce_896) - ] - -happy_n_terms = 160 :: Prelude.Int -happy_n_nonterms = 335 :: Prelude.Int - -happyReduce_13 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_13 = happySpecReduce_1 0# happyReduction_13 -happyReduction_13 happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - happyIn16 - (happy_var_1 - )} - -happyReduce_14 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_14 = happySpecReduce_1 0# happyReduction_14 -happyReduction_14 happy_x_1 - = case happyOut284 happy_x_1 of { (HappyWrap284 happy_var_1) -> - happyIn16 - (happy_var_1 - )} - -happyReduce_15 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_15 = happySpecReduce_1 0# happyReduction_15 -happyReduction_15 happy_x_1 - = case happyOut309 happy_x_1 of { (HappyWrap309 happy_var_1) -> - happyIn16 - (happy_var_1 - )} - -happyReduce_16 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_16 = happySpecReduce_1 0# happyReduction_16 -happyReduction_16 happy_x_1 - = case happyOut293 happy_x_1 of { (HappyWrap293 happy_var_1) -> - happyIn16 - (happy_var_1 - )} - -happyReduce_17 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_17 = happyMonadReduce 1# 0# happyReduction_17 -happyReduction_17 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( amsr (sLL happy_var_1 happy_var_1 $ getRdrName unrestrictedFunTyCon) - (NameAnnRArrow Nothing (epUniTok happy_var_1) Nothing []))}) - ) (\r -> happyReturn (happyIn16 r)) - -happyReduce_18 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_18 = happySpecReduce_3 1# happyReduction_18 -happyReduction_18 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut18 happy_x_2 of { (HappyWrap18 happy_var_2) -> - happyIn17 - (fromOL happy_var_2 - )} - -happyReduce_19 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_19 = happySpecReduce_3 1# happyReduction_19 -happyReduction_19 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut18 happy_x_2 of { (HappyWrap18 happy_var_2) -> - happyIn17 - (fromOL happy_var_2 - )} - -happyReduce_20 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_20 = happySpecReduce_3 2# happyReduction_20 -happyReduction_20 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut18 happy_x_1 of { (HappyWrap18 happy_var_1) -> - case happyOut19 happy_x_3 of { (HappyWrap19 happy_var_3) -> - happyIn18 - (happy_var_1 `appOL` unitOL happy_var_3 - )}} - -happyReduce_21 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_21 = happySpecReduce_2 2# happyReduction_21 -happyReduction_21 happy_x_2 - happy_x_1 - = case happyOut18 happy_x_1 of { (HappyWrap18 happy_var_1) -> - happyIn18 - (happy_var_1 - )} - -happyReduce_22 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_22 = happySpecReduce_1 2# happyReduction_22 -happyReduction_22 happy_x_1 - = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> - happyIn18 - (unitOL happy_var_1 - )} - -happyReduce_23 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_23 = happyReduce 4# 3# happyReduction_23 -happyReduction_23 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut24 happy_x_2 of { (HappyWrap24 happy_var_2) -> - case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> - happyIn19 - (sL1 happy_var_1 $ HsUnit { hsunitName = happy_var_2 - , hsunitBody = fromOL happy_var_4 } - ) `HappyStk` happyRest}}} - -happyReduce_24 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_24 = happySpecReduce_1 4# happyReduction_24 -happyReduction_24 happy_x_1 - = case happyOut24 happy_x_1 of { (HappyWrap24 happy_var_1) -> - happyIn20 - (sL1 happy_var_1 $ HsUnitId happy_var_1 [] - )} - -happyReduce_25 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_25 = happyReduce 4# 4# happyReduction_25 -happyReduction_25 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut24 happy_x_1 of { (HappyWrap24 happy_var_1) -> - case happyOut21 happy_x_3 of { (HappyWrap21 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn20 - (sLL happy_var_1 happy_var_4 $ HsUnitId happy_var_1 (fromOL happy_var_3) - ) `HappyStk` happyRest}}} - -happyReduce_26 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_26 = happySpecReduce_3 5# happyReduction_26 -happyReduction_26 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut21 happy_x_1 of { (HappyWrap21 happy_var_1) -> - case happyOut22 happy_x_3 of { (HappyWrap22 happy_var_3) -> - happyIn21 - (happy_var_1 `appOL` unitOL happy_var_3 - )}} - -happyReduce_27 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_27 = happySpecReduce_2 5# happyReduction_27 -happyReduction_27 happy_x_2 - happy_x_1 - = case happyOut21 happy_x_1 of { (HappyWrap21 happy_var_1) -> - happyIn21 - (happy_var_1 - )} - -happyReduce_28 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_28 = happySpecReduce_1 5# happyReduction_28 -happyReduction_28 happy_x_1 - = case happyOut22 happy_x_1 of { (HappyWrap22 happy_var_1) -> - happyIn21 - (unitOL happy_var_1 - )} - -happyReduce_29 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_29 = happySpecReduce_3 6# happyReduction_29 -happyReduction_29 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut332 happy_x_1 of { (HappyWrap332 happy_var_1) -> - case happyOut23 happy_x_3 of { (HappyWrap23 happy_var_3) -> - happyIn22 - (sLL happy_var_1 happy_var_3 $ (reLoc happy_var_1, happy_var_3) - )}} - -happyReduce_30 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_30 = happyReduce 4# 6# happyReduction_30 -happyReduction_30 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut332 happy_x_1 of { (HappyWrap332 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut332 happy_x_3 of { (HappyWrap332 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn22 - (sLL happy_var_1 happy_var_4 $ (reLoc happy_var_1, sLL happy_var_2 happy_var_4 $ HsModuleVar (reLoc happy_var_3)) - ) `HappyStk` happyRest}}}} - -happyReduce_31 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_31 = happySpecReduce_3 7# happyReduction_31 -happyReduction_31 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn23 - (sLL happy_var_1 happy_var_3 $ HsModuleVar (reLoc happy_var_2) - )}}} - -happyReduce_32 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_32 = happySpecReduce_3 7# happyReduction_32 -happyReduction_32 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut20 happy_x_1 of { (HappyWrap20 happy_var_1) -> - case happyOut332 happy_x_3 of { (HappyWrap332 happy_var_3) -> - happyIn23 - (sLL happy_var_1 happy_var_3 $ HsModuleId happy_var_1 (reLoc happy_var_3) - )}} - -happyReduce_33 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_33 = happySpecReduce_1 8# happyReduction_33 -happyReduction_33 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn24 - (sL1 happy_var_1 $ PackageName (getSTRING happy_var_1) - )} - -happyReduce_34 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_34 = happySpecReduce_1 8# happyReduction_34 -happyReduction_34 happy_x_1 - = case happyOut27 happy_x_1 of { (HappyWrap27 happy_var_1) -> - happyIn24 - (sL1 happy_var_1 $ PackageName (unLoc happy_var_1) - )} - -happyReduce_35 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_35 = happySpecReduce_1 9# happyReduction_35 -happyReduction_35 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn25 - (sL1 happy_var_1 $ getVARID happy_var_1 - )} - -happyReduce_36 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_36 = happySpecReduce_1 9# happyReduction_36 -happyReduction_36 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn25 - (sL1 happy_var_1 $ getCONID happy_var_1 - )} - -happyReduce_37 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_37 = happySpecReduce_1 9# happyReduction_37 -happyReduction_37 happy_x_1 - = case happyOut324 happy_x_1 of { (HappyWrap324 happy_var_1) -> - happyIn25 - (happy_var_1 - )} - -happyReduce_38 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_38 = happySpecReduce_1 10# happyReduction_38 -happyReduction_38 happy_x_1 - = happyIn26 - (() - ) - -happyReduce_39 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_39 = happySpecReduce_1 10# happyReduction_39 -happyReduction_39 happy_x_1 - = happyIn26 - (() - ) - -happyReduce_40 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_40 = happySpecReduce_1 10# happyReduction_40 -happyReduction_40 happy_x_1 - = happyIn26 - (() - ) - -happyReduce_41 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_41 = happySpecReduce_1 11# happyReduction_41 -happyReduction_41 happy_x_1 - = case happyOut25 happy_x_1 of { (HappyWrap25 happy_var_1) -> - happyIn27 - (happy_var_1 - )} - -happyReduce_42 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_42 = happySpecReduce_3 11# happyReduction_42 -happyReduction_42 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut25 happy_x_1 of { (HappyWrap25 happy_var_1) -> - case happyOut27 happy_x_3 of { (HappyWrap27 happy_var_3) -> - happyIn27 - (sLL happy_var_1 happy_var_3 $ concatFS [unLoc happy_var_1, fsLit "-", (unLoc happy_var_3)] - )}} - -happyReduce_43 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_43 = happySpecReduce_0 12# happyReduction_43 -happyReduction_43 = happyIn28 - (Nothing - ) - -happyReduce_44 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_44 = happySpecReduce_3 12# happyReduction_44 -happyReduction_44 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut29 happy_x_2 of { (HappyWrap29 happy_var_2) -> - happyIn28 - (Just (fromOL happy_var_2) - )} - -happyReduce_45 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_45 = happySpecReduce_3 13# happyReduction_45 -happyReduction_45 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut29 happy_x_1 of { (HappyWrap29 happy_var_1) -> - case happyOut30 happy_x_3 of { (HappyWrap30 happy_var_3) -> - happyIn29 - (happy_var_1 `appOL` unitOL happy_var_3 - )}} - -happyReduce_46 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_46 = happySpecReduce_2 13# happyReduction_46 -happyReduction_46 happy_x_2 - happy_x_1 - = case happyOut29 happy_x_1 of { (HappyWrap29 happy_var_1) -> - happyIn29 - (happy_var_1 - )} - -happyReduce_47 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_47 = happySpecReduce_1 13# happyReduction_47 -happyReduction_47 happy_x_1 - = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> - happyIn29 - (unitOL happy_var_1 - )} - -happyReduce_48 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_48 = happySpecReduce_3 14# happyReduction_48 -happyReduction_48 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut332 happy_x_1 of { (HappyWrap332 happy_var_1) -> - case happyOut332 happy_x_3 of { (HappyWrap332 happy_var_3) -> - happyIn30 - (sLL happy_var_1 happy_var_3 $ Renaming (reLoc happy_var_1) (Just (reLoc happy_var_3)) - )}} - -happyReduce_49 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_49 = happySpecReduce_1 14# happyReduction_49 -happyReduction_49 happy_x_1 - = case happyOut332 happy_x_1 of { (HappyWrap332 happy_var_1) -> - happyIn30 - (sL1 happy_var_1 $ Renaming (reLoc happy_var_1) Nothing - )} - -happyReduce_50 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_50 = happySpecReduce_3 15# happyReduction_50 -happyReduction_50 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut32 happy_x_2 of { (HappyWrap32 happy_var_2) -> - happyIn31 - (happy_var_2 - )} - -happyReduce_51 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_51 = happySpecReduce_3 15# happyReduction_51 -happyReduction_51 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut32 happy_x_2 of { (HappyWrap32 happy_var_2) -> - happyIn31 - (happy_var_2 - )} - -happyReduce_52 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_52 = happySpecReduce_3 16# happyReduction_52 -happyReduction_52 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut32 happy_x_1 of { (HappyWrap32 happy_var_1) -> - case happyOut33 happy_x_3 of { (HappyWrap33 happy_var_3) -> - happyIn32 - (happy_var_1 `appOL` unitOL happy_var_3 - )}} - -happyReduce_53 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_53 = happySpecReduce_2 16# happyReduction_53 -happyReduction_53 happy_x_2 - happy_x_1 - = case happyOut32 happy_x_1 of { (HappyWrap32 happy_var_1) -> - happyIn32 - (happy_var_1 - )} - -happyReduce_54 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_54 = happySpecReduce_1 16# happyReduction_54 -happyReduction_54 happy_x_1 - = case happyOut33 happy_x_1 of { (HappyWrap33 happy_var_1) -> - happyIn32 - (unitOL happy_var_1 - )} - -happyReduce_55 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_55 = happyReduce 7# 17# happyReduction_55 -happyReduction_55 (happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut63 happy_x_2 of { (HappyWrap63 happy_var_2) -> - case happyOut332 happy_x_3 of { (HappyWrap332 happy_var_3) -> - case happyOut145 happy_x_4 of { (HappyWrap145 happy_var_4) -> - case happyOut47 happy_x_5 of { (HappyWrap47 happy_var_5) -> - case happyOut38 happy_x_7 of { (HappyWrap38 happy_var_7) -> - happyIn33 - (sL1 happy_var_1 $ DeclD - (case snd happy_var_2 of - NotBoot -> HsSrcFile - IsBoot -> HsBootFile) - (reLoc happy_var_3) - (sL1 happy_var_1 (HsModule (XModulePs noAnn (thdOf3 happy_var_7) happy_var_4 Nothing) (Just happy_var_3) happy_var_5 (fst $ sndOf3 happy_var_7) (snd $ sndOf3 happy_var_7))) - ) `HappyStk` happyRest}}}}}} - -happyReduce_56 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_56 = happyReduce 6# 17# happyReduction_56 -happyReduction_56 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOut145 happy_x_3 of { (HappyWrap145 happy_var_3) -> - case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> - case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> - happyIn33 - (sL1 happy_var_1 $ DeclD - HsigFile - (reLoc happy_var_2) - (sL1 happy_var_1 (HsModule (XModulePs noAnn (thdOf3 happy_var_6) happy_var_3 Nothing) (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) (snd $ sndOf3 happy_var_6))) - ) `HappyStk` happyRest}}}}} - -happyReduce_57 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_57 = happySpecReduce_3 17# happyReduction_57 -happyReduction_57 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut20 happy_x_2 of { (HappyWrap20 happy_var_2) -> - case happyOut28 happy_x_3 of { (HappyWrap28 happy_var_3) -> - happyIn33 - (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_2 - , idModRenaming = happy_var_3 - , idSignatureInclude = False }) - )}}} - -happyReduce_58 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_58 = happySpecReduce_3 17# happyReduction_58 -happyReduction_58 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut20 happy_x_3 of { (HappyWrap20 happy_var_3) -> - happyIn33 - (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_3 - , idModRenaming = Nothing - , idSignatureInclude = True }) - )}} - -happyReduce_59 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_59 = happyMonadReduce 6# 18# happyReduction_59 -happyReduction_59 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOut145 happy_x_3 of { (HappyWrap145 happy_var_3) -> - case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> - ( fileSrcSpan >>= \ loc -> - acs loc (\loc cs-> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule (epTok happy_var_1) NoEpTok (epTok happy_var_5) (fstOf3 happy_var_6) [] Nothing) cs) - (thdOf3 happy_var_6) happy_var_3 Nothing) - (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) - (snd $ sndOf3 happy_var_6))) - ))}}}}}}) - ) (\r -> happyReturn (happyIn34 r)) - -happyReduce_60 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_60 = happyMonadReduce 6# 19# happyReduction_60 -happyReduction_60 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOut145 happy_x_3 of { (HappyWrap145 happy_var_3) -> - case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> - ( fileSrcSpan >>= \ loc -> - acsFinal (\cs eof -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) (fstOf3 happy_var_6) [] eof) cs) - (thdOf3 happy_var_6) happy_var_3 Nothing) - (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) - (snd $ sndOf3 happy_var_6)) - )))}}}}}}) - ) (\r -> happyReturn (happyIn35 r)) - -happyReduce_61 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_61 = happyMonadReduce 1# 19# happyReduction_61 -happyReduction_61 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut39 happy_x_1 of { (HappyWrap39 happy_var_1) -> - ( fileSrcSpan >>= \ loc -> - acsFinal (\cs eof -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 happy_var_1) [] eof) cs) - (thdOf3 happy_var_1) Nothing Nothing) - Nothing Nothing - (fst $ sndOf3 happy_var_1) (snd $ sndOf3 happy_var_1)))))}) - ) (\r -> happyReturn (happyIn35 r)) - -happyReduce_62 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_62 = happyMonadReduce 0# 20# happyReduction_62 -happyReduction_62 (happyRest) tk - = happyThen ((( pushModuleContext)) - ) (\r -> happyReturn (happyIn36 r)) - -happyReduce_63 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_63 = happyMonadReduce 0# 21# happyReduction_63 -happyReduction_63 (happyRest) tk - = happyThen ((( pushModuleContext)) - ) (\r -> happyReturn (happyIn37 r)) - -happyReduce_64 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_64 = happySpecReduce_3 22# happyReduction_64 -happyReduction_64 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn38 - ((fst happy_var_2, snd happy_var_2, epExplicitBraces happy_var_1 happy_var_3) - )}}} - -happyReduce_65 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_65 = happySpecReduce_3 22# happyReduction_65 -happyReduction_65 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> - happyIn38 - ((fst happy_var_2, snd happy_var_2, EpVirtualBraces (getVOCURLY happy_var_1)) - )}} - -happyReduce_66 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_66 = happySpecReduce_3 23# happyReduction_66 -happyReduction_66 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn39 - ((fst happy_var_2, snd happy_var_2, epExplicitBraces happy_var_1 happy_var_3) - )}}} - -happyReduce_67 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_67 = happySpecReduce_3 23# happyReduction_67 -happyReduction_67 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> - happyIn39 - (([], snd happy_var_2, EpVirtualBraces leftmostColumn) - )} - -happyReduce_68 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_68 = happySpecReduce_2 24# happyReduction_68 -happyReduction_68 happy_x_2 - happy_x_1 - = case happyOut59 happy_x_1 of { (HappyWrap59 happy_var_1) -> - case happyOut41 happy_x_2 of { (HappyWrap41 happy_var_2) -> - happyIn40 - ((reverse happy_var_1, happy_var_2) - )}} - -happyReduce_69 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_69 = happySpecReduce_2 25# happyReduction_69 -happyReduction_69 happy_x_2 - happy_x_1 - = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> - case happyOut79 happy_x_2 of { (HappyWrap79 happy_var_2) -> - happyIn41 - ((reverse happy_var_1, cvTopDecls happy_var_2) - )}} - -happyReduce_70 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_70 = happySpecReduce_2 25# happyReduction_70 -happyReduction_70 happy_x_2 - happy_x_1 - = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> - case happyOut78 happy_x_2 of { (HappyWrap78 happy_var_2) -> - happyIn41 - ((reverse happy_var_1, cvTopDecls happy_var_2) - )}} - -happyReduce_71 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_71 = happySpecReduce_1 25# happyReduction_71 -happyReduction_71 happy_x_1 - = case happyOut60 happy_x_1 of { (HappyWrap60 happy_var_1) -> - happyIn41 - ((reverse happy_var_1, []) - )} - -happyReduce_72 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_72 = happyMonadReduce 6# 26# happyReduction_72 -happyReduction_72 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOut145 happy_x_3 of { (HappyWrap145 happy_var_3) -> - case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut43 happy_x_6 of { (HappyWrap43 happy_var_6) -> - ( fileSrcSpan >>= \ loc -> - acs loc (\loc cs -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) [] [] Nothing) cs) - EpNoLayout happy_var_3 Nothing) - (Just happy_var_2) happy_var_4 happy_var_6 [] - ))))}}}}}}) - ) (\r -> happyReturn (happyIn42 r)) - -happyReduce_73 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_73 = happyMonadReduce 6# 26# happyReduction_73 -happyReduction_73 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - case happyOut145 happy_x_3 of { (HappyWrap145 happy_var_3) -> - case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut43 happy_x_6 of { (HappyWrap43 happy_var_6) -> - ( fileSrcSpan >>= \ loc -> - acs loc (\loc cs -> (L loc (HsModule (XModulePs - (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) [] [] Nothing) cs) - EpNoLayout happy_var_3 Nothing) - (Just happy_var_2) happy_var_4 happy_var_6 [] - ))))}}}}}}) - ) (\r -> happyReturn (happyIn42 r)) - -happyReduce_74 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_74 = happyMonadReduce 1# 26# happyReduction_74 -happyReduction_74 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut44 happy_x_1 of { (HappyWrap44 happy_var_1) -> - ( fileSrcSpan >>= \ loc -> - return (L loc (HsModule (XModulePs noAnn EpNoLayout Nothing Nothing) Nothing Nothing happy_var_1 [])))}) - ) (\r -> happyReturn (happyIn42 r)) - -happyReduce_75 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_75 = happySpecReduce_2 27# happyReduction_75 -happyReduction_75 happy_x_2 - happy_x_1 - = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> - happyIn43 - (happy_var_2 - )} - -happyReduce_76 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_76 = happySpecReduce_2 27# happyReduction_76 -happyReduction_76 happy_x_2 - happy_x_1 - = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> - happyIn43 - (happy_var_2 - )} - -happyReduce_77 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_77 = happySpecReduce_2 28# happyReduction_77 -happyReduction_77 happy_x_2 - happy_x_1 - = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> - happyIn44 - (happy_var_2 - )} - -happyReduce_78 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_78 = happySpecReduce_2 28# happyReduction_78 -happyReduction_78 happy_x_2 - happy_x_1 - = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> - happyIn44 - (happy_var_2 - )} - -happyReduce_79 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_79 = happySpecReduce_2 29# happyReduction_79 -happyReduction_79 happy_x_2 - happy_x_1 - = case happyOut46 happy_x_2 of { (HappyWrap46 happy_var_2) -> - happyIn45 - (happy_var_2 - )} - -happyReduce_80 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_80 = happySpecReduce_1 30# happyReduction_80 -happyReduction_80 happy_x_1 - = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> - happyIn46 - (happy_var_1 - )} - -happyReduce_81 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_81 = happySpecReduce_1 30# happyReduction_81 -happyReduction_81 happy_x_1 - = case happyOut60 happy_x_1 of { (HappyWrap60 happy_var_1) -> - happyIn46 - (happy_var_1 - )} - -happyReduce_82 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_82 = happyMonadReduce 3# 31# happyReduction_82 -happyReduction_82 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_2 of { (HappyWrap48 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 (fromOL $ snd happy_var_2)) - (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] (noAnn,fst happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn47 r)) - -happyReduce_83 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_83 = happySpecReduce_0 31# happyReduction_83 -happyReduction_83 = happyIn47 - (Nothing - ) - -happyReduce_84 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_84 = happySpecReduce_1 32# happyReduction_84 -happyReduction_84 happy_x_1 - = case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> - happyIn48 - (([], happy_var_1) - )} - -happyReduce_85 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_85 = happySpecReduce_0 32# happyReduction_85 -happyReduction_85 = happyIn48 - (([], nilOL) - ) - -happyReduce_86 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_86 = happyMonadReduce 2# 32# happyReduction_86 -happyReduction_86 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingCommaA t (epTok happy_var_2) - return ([], snocOL hs t'))}}) - ) (\r -> happyReturn (happyIn48 r)) - -happyReduce_87 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_87 = happySpecReduce_1 32# happyReduction_87 -happyReduction_87 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn48 - (([epTok happy_var_1], nilOL) - )} - -happyReduce_88 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_88 = happyMonadReduce 3# 33# happyReduction_88 -happyReduction_88 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut50 happy_x_3 of { (HappyWrap50 happy_var_3) -> - ( let ls = happy_var_1 - in if isNilOL ls - then return (ls `appOL` happy_var_3) - else case ls of - SnocOL hs t -> do - t' <- addTrailingCommaA t (epTok happy_var_2) - return (snocOL hs t' `appOL` happy_var_3))}}}) - ) (\r -> happyReturn (happyIn49 r)) - -happyReduce_89 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_89 = happySpecReduce_1 33# happyReduction_89 -happyReduction_89 happy_x_1 - = case happyOut50 happy_x_1 of { (HappyWrap50 happy_var_1) -> - happyIn49 - (happy_var_1 - )} - -happyReduce_90 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_90 = happyMonadReduce 1# 34# happyReduction_90 -happyReduction_90 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut51 happy_x_1 of { (HappyWrap51 happy_var_1) -> - ( return (unitOL happy_var_1))}) - ) (\r -> happyReturn (happyIn50 r)) - -happyReduce_91 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_91 = happyMonadReduce 3# 35# happyReduction_91 -happyReduction_91 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut145 happy_x_1 of { (HappyWrap145 happy_var_1) -> - case happyOut56 happy_x_2 of { (HappyWrap56 happy_var_2) -> - case happyOut52 happy_x_3 of { (HappyWrap52 happy_var_3) -> - ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 } - ; impExp <- mkModuleImpExp happy_var_1 (fst $ unLoc happy_var_3) happy_var_2 (snd $ unLoc happy_var_3) - ; return $ reLoc $ sL span $ impExp })}}}) - ) (\r -> happyReturn (happyIn51 r)) - -happyReduce_92 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_92 = happyMonadReduce 3# 35# happyReduction_92 -happyReduction_92 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut145 happy_x_1 of { (HappyWrap145 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut332 happy_x_3 of { (HappyWrap332 happy_var_3) -> - ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 - ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) happy_var_1) happy_var_2 } - ; locImpExp <- return (sL span (IEModuleContents (happy_var_1, (epTok happy_var_2)) happy_var_3)) - ; return $ reLoc $ locImpExp })}}}) - ) (\r -> happyReturn (happyIn51 r)) - -happyReduce_93 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_93 = happySpecReduce_3 35# happyReduction_93 -happyReduction_93 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut145 happy_x_1 of { (HappyWrap145 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut284 happy_x_3 of { (HappyWrap284 happy_var_3) -> - happyIn51 - (let span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 - in reLoc $ sL span $ IEVar happy_var_1 (sLLa happy_var_2 happy_var_3 (IEPattern (epTok happy_var_2) happy_var_3)) Nothing - )}}} - -happyReduce_94 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_94 = happyMonadReduce 3# 35# happyReduction_94 -happyReduction_94 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut145 happy_x_1 of { (HappyWrap145 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut299 happy_x_3 of { (HappyWrap299 happy_var_3) -> - ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 } - ; locImpExp <- return (sL span (IEThingAbs happy_var_1 (sLLa happy_var_2 happy_var_3 (IEDefault (epTok happy_var_2) happy_var_3)) Nothing)) - ; return $ reLoc $ locImpExp })}}}) - ) (\r -> happyReturn (happyIn51 r)) - -happyReduce_95 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_95 = happySpecReduce_0 36# happyReduction_95 -happyReduction_95 = happyIn52 - (sL0 (noAnn,ImpExpAbs) - ) - -happyReduce_96 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_96 = happyMonadReduce 3# 36# happyReduction_96 -happyReduction_96 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut53 happy_x_2 of { (HappyWrap53 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( mkImpExpSubSpec (reverse happy_var_2) - >>= \ie -> return $ sLL happy_var_1 happy_var_3 - ((epTok happy_var_1, epTok happy_var_3), ie))}}}) - ) (\r -> happyReturn (happyIn52 r)) - -happyReduce_97 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_97 = happySpecReduce_0 37# happyReduction_97 -happyReduction_97 = happyIn53 - ([] - ) - -happyReduce_98 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_98 = happySpecReduce_1 37# happyReduction_98 -happyReduction_98 happy_x_1 - = case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> - happyIn53 - (happy_var_1 - )} - -happyReduce_99 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_99 = happyMonadReduce 3# 38# happyReduction_99 -happyReduction_99 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut55 happy_x_3 of { (HappyWrap55 happy_var_3) -> - ( case happy_var_1 of - ((L la (ImpExpQcWildcard tok _)):t) -> - do { return (happy_var_3 : L la (ImpExpQcWildcard tok (epTok happy_var_2)) : t) } - (l:t) -> - do { l' <- addTrailingCommaA l (epTok happy_var_2) - ; return (happy_var_3 : l' : t)})}}}) - ) (\r -> happyReturn (happyIn54 r)) - -happyReduce_100 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_100 = happySpecReduce_1 38# happyReduction_100 -happyReduction_100 happy_x_1 - = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> - happyIn54 - ([happy_var_1] - )} - -happyReduce_101 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_101 = happySpecReduce_1 39# happyReduction_101 -happyReduction_101 happy_x_1 - = case happyOut56 happy_x_1 of { (HappyWrap56 happy_var_1) -> - happyIn55 - (happy_var_1 - )} - -happyReduce_102 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_102 = happySpecReduce_1 39# happyReduction_102 -happyReduction_102 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn55 - (sL1a happy_var_1 (ImpExpQcWildcard (epTok happy_var_1) NoEpTok) - )} - -happyReduce_103 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_103 = happySpecReduce_1 40# happyReduction_103 -happyReduction_103 happy_x_1 - = case happyOut57 happy_x_1 of { (HappyWrap57 happy_var_1) -> - happyIn56 - (sL1a happy_var_1 (ImpExpQcName happy_var_1) - )} - -happyReduce_104 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_104 = happyMonadReduce 2# 40# happyReduction_104 -happyReduction_104 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut296 happy_x_2 of { (HappyWrap296 happy_var_2) -> - ( do { n <- mkTypeImpExp happy_var_2 - ; return $ sLLa happy_var_1 happy_var_2 (ImpExpQcType (epTok happy_var_1) n) })}}) - ) (\r -> happyReturn (happyIn56 r)) - -happyReduce_105 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_105 = happySpecReduce_1 41# happyReduction_105 -happyReduction_105 happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - happyIn57 - (happy_var_1 - )} - -happyReduce_106 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_106 = happySpecReduce_1 41# happyReduction_106 -happyReduction_106 happy_x_1 - = case happyOut297 happy_x_1 of { (HappyWrap297 happy_var_1) -> - happyIn57 - (happy_var_1 - )} - -happyReduce_107 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_107 = happySpecReduce_2 42# happyReduction_107 -happyReduction_107 happy_x_2 - happy_x_1 - = case happyOut58 happy_x_1 of { (HappyWrap58 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn58 - (if isZeroWidthSpan (gl happy_var_2) then (sL1 happy_var_1 $ unLoc happy_var_1) else (sLL happy_var_1 happy_var_2 $ AddSemiAnn (epTok happy_var_2) : (unLoc happy_var_1)) - )}} - -happyReduce_108 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_108 = happySpecReduce_1 42# happyReduction_108 -happyReduction_108 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn58 - (case msemi happy_var_1 of - [] -> noLoc [] - ms -> sL1 happy_var_1 $ ms - )} - -happyReduce_109 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_109 = happySpecReduce_2 43# happyReduction_109 -happyReduction_109 happy_x_2 - happy_x_1 - = case happyOut59 happy_x_1 of { (HappyWrap59 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn59 - (if isZeroWidthSpan (gl happy_var_2) then happy_var_1 else (AddSemiAnn (epTok happy_var_2) : happy_var_1) - )}} - -happyReduce_110 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_110 = happySpecReduce_0 43# happyReduction_110 -happyReduction_110 = happyIn59 - ([] - ) - -happyReduce_111 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_111 = happySpecReduce_2 44# happyReduction_111 -happyReduction_111 happy_x_2 - happy_x_1 - = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> - case happyOut62 happy_x_2 of { (HappyWrap62 happy_var_2) -> - happyIn60 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_112 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_112 = happyMonadReduce 3# 45# happyReduction_112 -happyReduction_112 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> - case happyOut62 happy_x_2 of { (HappyWrap62 happy_var_2) -> - case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> - ( do { i <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) - ; return (i : happy_var_1)})}}}) - ) (\r -> happyReturn (happyIn61 r)) - -happyReduce_113 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_113 = happySpecReduce_0 45# happyReduction_113 -happyReduction_113 = happyIn61 - ([] - ) - -happyReduce_114 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_114 = happyMonadReduce 9# 46# happyReduction_114 -happyReduction_114 (happy_x_9 `HappyStk` - happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut63 happy_x_2 of { (HappyWrap63 happy_var_2) -> - case happyOut64 happy_x_3 of { (HappyWrap64 happy_var_3) -> - case happyOut66 happy_x_4 of { (HappyWrap66 happy_var_4) -> - case happyOut65 happy_x_5 of { (HappyWrap65 happy_var_5) -> - case happyOut332 happy_x_6 of { (HappyWrap332 happy_var_6) -> - case happyOut66 happy_x_7 of { (HappyWrap66 happy_var_7) -> - case happyOut67 happy_x_8 of { (HappyWrap67 happy_var_8) -> - case happyOut68 happy_x_9 of { (HappyWrap68 happy_var_9) -> - ( do { - ; let { ; mPreQual = unLoc happy_var_4 - ; mPostQual = unLoc happy_var_7 } - ; checkImportDecl mPreQual mPostQual - ; let anns - = EpAnnImportDecl - { importDeclAnnImport = epTok happy_var_1 - , importDeclAnnPragma = fst $ fst happy_var_2 - , importDeclAnnSafe = fst happy_var_3 - , importDeclAnnQualified = fst $ importDeclQualifiedStyle mPreQual mPostQual - , importDeclAnnPackage = fst happy_var_5 - , importDeclAnnAs = fst happy_var_8 - } - ; let loc = (comb5 happy_var_1 happy_var_6 happy_var_7 (snd happy_var_8) happy_var_9); - ; fmap reLoc $ acs loc (\loc cs -> L loc $ - ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst happy_var_2) False - , ideclName = happy_var_6, ideclPkgQual = snd happy_var_5 - , ideclSource = snd happy_var_2, ideclSafe = snd happy_var_3 - , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual - , ideclAs = unLoc (snd happy_var_8) - , ideclImportList = unLoc happy_var_9 }) - })}}}}}}}}}) - ) (\r -> happyReturn (happyIn62 r)) - -happyReduce_115 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_115 = happySpecReduce_2 47# happyReduction_115 -happyReduction_115 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn63 - (((Just (glR happy_var_1,epTok happy_var_2),getSOURCE_PRAGs happy_var_1) - , IsBoot) - )}} - -happyReduce_116 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_116 = happySpecReduce_0 47# happyReduction_116 -happyReduction_116 = happyIn63 - (((Nothing,NoSourceText),NotBoot) - ) - -happyReduce_117 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_117 = happySpecReduce_1 48# happyReduction_117 -happyReduction_117 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn64 - ((Just (epTok happy_var_1),True) - )} - -happyReduce_118 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_118 = happySpecReduce_0 48# happyReduction_118 -happyReduction_118 = happyIn64 - ((Nothing, False) - ) - -happyReduce_119 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_119 = happyMonadReduce 1# 49# happyReduction_119 -happyReduction_119 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( do { let { pkgFS = getSTRING happy_var_1 } - ; unless (looksLikePackageName (unpackFS pkgFS)) $ - addError $ mkPlainErrorMsgEnvelope (getLoc happy_var_1) $ - (PsErrInvalidPackageName pkgFS) - ; return (Just (glR happy_var_1), RawPkgQual (StringLiteral (getSTRINGs happy_var_1) pkgFS Nothing)) })}) - ) (\r -> happyReturn (happyIn65 r)) - -happyReduce_120 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_120 = happySpecReduce_0 49# happyReduction_120 -happyReduction_120 = happyIn65 - ((Nothing,NoRawPkgQual) - ) - -happyReduce_121 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_121 = happySpecReduce_1 50# happyReduction_121 -happyReduction_121 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn66 - (sL1 happy_var_1 (Just (epTok happy_var_1)) - )} - -happyReduce_122 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_122 = happySpecReduce_0 50# happyReduction_122 -happyReduction_122 = happyIn66 - (noLoc Nothing - ) - -happyReduce_123 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_123 = happySpecReduce_2 51# happyReduction_123 -happyReduction_123 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - happyIn67 - ((Just (epTok happy_var_1) - ,sLL happy_var_1 happy_var_2 (Just happy_var_2)) - )}} - -happyReduce_124 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_124 = happySpecReduce_0 51# happyReduction_124 -happyReduction_124 = happyIn67 - ((Nothing,noLoc Nothing) - ) - -happyReduce_125 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_125 = happyMonadReduce 1# 52# happyReduction_125 -happyReduction_125 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut69 happy_x_1 of { (HappyWrap69 happy_var_1) -> - ( let (b, ie) = unLoc happy_var_1 in - checkImportSpec ie - >>= \checkedIe -> - return (L (gl happy_var_1) (Just (b, checkedIe))))}) - ) (\r -> happyReturn (happyIn68 r)) - -happyReduce_126 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_126 = happySpecReduce_0 52# happyReduction_126 -happyReduction_126 = happyIn68 - (noLoc Nothing - ) - -happyReduce_127 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_127 = happyMonadReduce 3# 53# happyReduction_127 -happyReduction_127 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut70 happy_x_2 of { (HappyWrap70 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { es <- amsr (sLL happy_var_1 happy_var_3 $ fromOL $ snd happy_var_2) - (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] (noAnn,fst happy_var_2) []) - ; return $ sLL happy_var_1 happy_var_3 (Exactly, es)})}}}) - ) (\r -> happyReturn (happyIn69 r)) - -happyReduce_128 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_128 = happyMonadReduce 4# 53# happyReduction_128 -happyReduction_128 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut70 happy_x_3 of { (HappyWrap70 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( do { es <- amsr (sLL happy_var_1 happy_var_4 $ fromOL $ snd happy_var_3) - (AnnList Nothing (ListParens (epTok happy_var_2) (epTok happy_var_4)) [] (epTok happy_var_1,fst happy_var_3) []) - ; return $ sLL happy_var_1 happy_var_4 (EverythingBut, es)})}}}}) - ) (\r -> happyReturn (happyIn69 r)) - -happyReduce_129 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_129 = happySpecReduce_1 54# happyReduction_129 -happyReduction_129 happy_x_1 - = case happyOut71 happy_x_1 of { (HappyWrap71 happy_var_1) -> - happyIn70 - (([], happy_var_1) - )} - -happyReduce_130 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_130 = happySpecReduce_0 54# happyReduction_130 -happyReduction_130 = happyIn70 - (([], nilOL) - ) - -happyReduce_131 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_131 = happyMonadReduce 2# 54# happyReduction_131 -happyReduction_131 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut71 happy_x_1 of { (HappyWrap71 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingCommaA t (epTok happy_var_2) - return ([], snocOL hs t'))}}) - ) (\r -> happyReturn (happyIn70 r)) - -happyReduce_132 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_132 = happySpecReduce_1 54# happyReduction_132 -happyReduction_132 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn70 - (([epTok happy_var_1], nilOL) - )} - -happyReduce_133 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_133 = happyMonadReduce 3# 55# happyReduction_133 -happyReduction_133 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut71 happy_x_1 of { (HappyWrap71 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut72 happy_x_3 of { (HappyWrap72 happy_var_3) -> - ( let ls = happy_var_1 - in if isNilOL ls - then return (ls `appOL` happy_var_3) - else case ls of - SnocOL hs t -> do - t' <- addTrailingCommaA t (epTok happy_var_2) - return (snocOL hs t' `appOL` happy_var_3))}}}) - ) (\r -> happyReturn (happyIn71 r)) - -happyReduce_134 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_134 = happySpecReduce_1 55# happyReduction_134 -happyReduction_134 happy_x_1 - = case happyOut72 happy_x_1 of { (HappyWrap72 happy_var_1) -> - happyIn71 - (happy_var_1 - )} - -happyReduce_135 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_135 = happyMonadReduce 2# 56# happyReduction_135 -happyReduction_135 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut56 happy_x_1 of { (HappyWrap56 happy_var_1) -> - case happyOut52 happy_x_2 of { (HappyWrap52 happy_var_2) -> - ( fmap (unitOL . reLoc . (sLL happy_var_1 happy_var_2)) $ mkModuleImpExp Nothing (fst $ unLoc happy_var_2) happy_var_1 (snd $ unLoc happy_var_2))}}) - ) (\r -> happyReturn (happyIn72 r)) - -happyReduce_136 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_136 = happyMonadReduce 2# 56# happyReduction_136 -happyReduction_136 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut332 happy_x_2 of { (HappyWrap332 happy_var_2) -> - ( fmap (unitOL . reLoc) $ return (sLL happy_var_1 happy_var_2 (IEModuleContents (Nothing, (epTok happy_var_1)) happy_var_2)))}}) - ) (\r -> happyReturn (happyIn72 r)) - -happyReduce_137 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_137 = happySpecReduce_2 56# happyReduction_137 -happyReduction_137 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut284 happy_x_2 of { (HappyWrap284 happy_var_2) -> - happyIn72 - (unitOL $ reLoc $ sLL happy_var_1 happy_var_2 $ IEVar Nothing (sLLa happy_var_1 happy_var_2 (IEPattern (epTok happy_var_1) happy_var_2)) Nothing - )}} - -happyReduce_138 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_138 = happySpecReduce_0 57# happyReduction_138 -happyReduction_138 = happyIn73 - (Nothing - ) - -happyReduce_139 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_139 = happySpecReduce_1 57# happyReduction_139 -happyReduction_139 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn73 - (Just (sL1 happy_var_1 (getINTEGERs happy_var_1,fromInteger (il_value (getINTEGER happy_var_1)))) - )} - -happyReduce_140 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_140 = happySpecReduce_1 58# happyReduction_140 -happyReduction_140 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn74 - (sL1 happy_var_1 InfixN - )} - -happyReduce_141 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_141 = happySpecReduce_1 58# happyReduction_141 -happyReduction_141 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn74 - (sL1 happy_var_1 InfixL - )} - -happyReduce_142 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_142 = happySpecReduce_1 58# happyReduction_142 -happyReduction_142 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn74 - (sL1 happy_var_1 InfixR - )} - -happyReduce_143 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_143 = happyMonadReduce 3# 59# happyReduction_143 -happyReduction_143 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut75 happy_x_1 of { (HappyWrap75 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut304 happy_x_3 of { (HappyWrap304 happy_var_3) -> - ( case (unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingCommaN t (gl happy_var_2) - return (sLL happy_var_1 happy_var_3 (snocOL hs t' `appOL` unitOL happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn75 r)) - -happyReduce_144 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_144 = happySpecReduce_1 59# happyReduction_144 -happyReduction_144 happy_x_1 - = case happyOut304 happy_x_1 of { (HappyWrap304 happy_var_1) -> - happyIn75 - (sL1 happy_var_1 (unitOL happy_var_1) - )} - -happyReduce_145 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_145 = happySpecReduce_2 60# happyReduction_145 -happyReduction_145 happy_x_2 - happy_x_1 - = case happyOut77 happy_x_1 of { (HappyWrap77 happy_var_1) -> - case happyOut81 happy_x_2 of { (HappyWrap81 happy_var_2) -> - happyIn76 - (happy_var_1 `snocOL` happy_var_2 - )}} - -happyReduce_146 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_146 = happyMonadReduce 3# 61# happyReduction_146 -happyReduction_146 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut77 happy_x_1 of { (HappyWrap77 happy_var_1) -> - case happyOut81 happy_x_2 of { (HappyWrap81 happy_var_2) -> - case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> - ( do { t <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) - ; return (happy_var_1 `snocOL` t) })}}}) - ) (\r -> happyReturn (happyIn77 r)) - -happyReduce_147 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_147 = happySpecReduce_0 61# happyReduction_147 -happyReduction_147 = happyIn77 - (nilOL - ) - -happyReduce_148 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_148 = happySpecReduce_2 62# happyReduction_148 -happyReduction_148 happy_x_2 - happy_x_1 - = case happyOut79 happy_x_1 of { (HappyWrap79 happy_var_1) -> - case happyOut80 happy_x_2 of { (HappyWrap80 happy_var_2) -> - happyIn78 - (happy_var_1 `snocOL` happy_var_2 - )}} - -happyReduce_149 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_149 = happyMonadReduce 3# 63# happyReduction_149 -happyReduction_149 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut79 happy_x_1 of { (HappyWrap79 happy_var_1) -> - case happyOut80 happy_x_2 of { (HappyWrap80 happy_var_2) -> - case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> - ( do { t <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) - ; return (happy_var_1 `snocOL` t) })}}}) - ) (\r -> happyReturn (happyIn79 r)) - -happyReduce_150 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_150 = happySpecReduce_0 63# happyReduction_150 -happyReduction_150 = happyIn79 - (nilOL - ) - -happyReduce_151 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_151 = happyMonadReduce 1# 64# happyReduction_151 -happyReduction_151 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut81 happy_x_1 of { (HappyWrap81 happy_var_1) -> - ( commentsPA happy_var_1)}) - ) (\r -> happyReturn (happyIn80 r)) - -happyReduce_152 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_152 = happySpecReduce_1 65# happyReduction_152 -happyReduction_152 happy_x_1 - = case happyOut82 happy_x_1 of { (HappyWrap82 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (TyClD noExtField (unLoc happy_var_1)) - )} - -happyReduce_153 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_153 = happySpecReduce_1 65# happyReduction_153 -happyReduction_153 happy_x_1 - = case happyOut84 happy_x_1 of { (HappyWrap84 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (TyClD noExtField (unLoc happy_var_1)) - )} - -happyReduce_154 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_154 = happySpecReduce_1 65# happyReduction_154 -happyReduction_154 happy_x_1 - = case happyOut85 happy_x_1 of { (HappyWrap85 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (KindSigD noExtField (unLoc happy_var_1)) - )} - -happyReduce_155 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_155 = happySpecReduce_1 65# happyReduction_155 -happyReduction_155 happy_x_1 - = case happyOut87 happy_x_1 of { (HappyWrap87 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (InstD noExtField (unLoc happy_var_1)) - )} - -happyReduce_156 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_156 = happySpecReduce_1 65# happyReduction_156 -happyReduction_156 happy_x_1 - = case happyOut113 happy_x_1 of { (HappyWrap113 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (DerivD noExtField (unLoc happy_var_1)) - )} - -happyReduce_157 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_157 = happySpecReduce_1 65# happyReduction_157 -happyReduction_157 happy_x_1 - = case happyOut114 happy_x_1 of { (HappyWrap114 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (RoleAnnotD noExtField (unLoc happy_var_1)) - )} - -happyReduce_158 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_158 = happySpecReduce_1 65# happyReduction_158 -happyReduction_158 happy_x_1 - = case happyOut83 happy_x_1 of { (HappyWrap83 happy_var_1) -> - happyIn81 - (L (getLoc happy_var_1) (DefD noExtField (unLoc happy_var_1)) - )} - -happyReduce_159 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_159 = happyMonadReduce 2# 65# happyReduction_159 -happyReduction_159 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut155 happy_x_2 of { (HappyWrap155 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 ((unLoc happy_var_2) (epTok happy_var_1))))}}) - ) (\r -> happyReturn (happyIn81 r)) - -happyReduce_160 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_160 = happyMonadReduce 3# 65# happyReduction_160 -happyReduction_160 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut150 happy_x_2 of { (HappyWrap150 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ WarningD noExtField (Warnings ((glR happy_var_1,epTok happy_var_3), (getDEPRECATED_PRAGs happy_var_1)) (fromOL happy_var_2))))}}}) - ) (\r -> happyReturn (happyIn81 r)) - -happyReduce_161 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_161 = happyMonadReduce 3# 65# happyReduction_161 -happyReduction_161 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut147 happy_x_2 of { (HappyWrap147 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ WarningD noExtField (Warnings ((glR happy_var_1,epTok happy_var_3), (getWARNING_PRAGs happy_var_1)) (fromOL happy_var_2))))}}}) - ) (\r -> happyReturn (happyIn81 r)) - -happyReduce_162 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_162 = happyMonadReduce 3# 65# happyReduction_162 -happyReduction_162 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut137 happy_x_2 of { (HappyWrap137 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ RuleD noExtField (HsRules ((glR happy_var_1,epTok happy_var_3), (getRULES_PRAGs happy_var_1)) (reverse happy_var_2))))}}}) - ) (\r -> happyReturn (happyIn81 r)) - -happyReduce_163 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_163 = happySpecReduce_1 65# happyReduction_163 -happyReduction_163 happy_x_1 - = case happyOut154 happy_x_1 of { (HappyWrap154 happy_var_1) -> - happyIn81 - (happy_var_1 - )} - -happyReduce_164 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_164 = happySpecReduce_1 65# happyReduction_164 -happyReduction_164 happy_x_1 - = case happyOut210 happy_x_1 of { (HappyWrap210 happy_var_1) -> - happyIn81 - (happy_var_1 - )} - -happyReduce_165 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_165 = happyMonadReduce 1# 65# happyReduction_165 -happyReduction_165 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - commentsPA $ mkSpliceDecl happy_var_1)}) - ) (\r -> happyReturn (happyIn81 r)) - -happyReduce_166 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_166 = happyMonadReduce 4# 66# happyReduction_166 -happyReduction_166 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut110 happy_x_2 of { (HappyWrap110 happy_var_2) -> - case happyOut189 happy_x_3 of { (HappyWrap189 happy_var_3) -> - case happyOut128 happy_x_4 of { (HappyWrap128 happy_var_4) -> - ( do { let {(wtok, (oc,semis,cc)) = fstOf3 $ unLoc happy_var_4} - ; mkClassDecl (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) happy_var_2 happy_var_3 (sndOf3 $ unLoc happy_var_4) (thdOf3 $ unLoc happy_var_4) - (AnnClassDecl (epTok happy_var_1) [] [] (fst $ unLoc happy_var_3) wtok oc cc semis) })}}}}) - ) (\r -> happyReturn (happyIn82 r)) - -happyReduce_167 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_167 = happyMonadReduce 5# 67# happyReduction_167 -happyReduction_167 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut92 happy_x_2 of { (HappyWrap92 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut182 happy_x_4 of { (HappyWrap182 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( amsA' (sLL happy_var_1 happy_var_5 (DefaultDecl (epTok happy_var_1,epTok happy_var_3,epTok happy_var_5) happy_var_2 happy_var_4)))}}}}}) - ) (\r -> happyReturn (happyIn83 r)) - -happyReduce_168 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_168 = happyMonadReduce 4# 68# happyReduction_168 -happyReduction_168 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut171 happy_x_2 of { (HappyWrap171 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut167 happy_x_4 of { (HappyWrap167 happy_var_4) -> - ( mkTySynonym (comb2 happy_var_1 happy_var_4) happy_var_2 happy_var_4 (epTok happy_var_1) (epTok happy_var_3))}}}}) - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_169 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_169 = happyMonadReduce 6# 68# happyReduction_169 -happyReduction_169 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - case happyOut108 happy_x_4 of { (HappyWrap108 happy_var_4) -> - case happyOut93 happy_x_5 of { (HappyWrap93 happy_var_5) -> - case happyOut96 happy_x_6 of { (HappyWrap96 happy_var_6) -> - ( do { let { (tdcolon, tequal) = fst $ unLoc happy_var_4 } - ; let { tvbar = fst $ unLoc happy_var_5 } - ; let { (twhere, (toc, tdd, tcc)) = fst $ unLoc happy_var_6 } - ; mkFamDecl (comb5 happy_var_1 happy_var_3 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_6) TopLevel happy_var_3 - (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5) - (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn (epTok happy_var_2) tdcolon tequal tvbar twhere toc tdd tcc) })}}}}}}) - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_170 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_170 = happyMonadReduce 5# 68# happyReduction_170 -happyReduction_170 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut104 happy_x_1 of { (HappyWrap104 happy_var_1) -> - case happyOut112 happy_x_2 of { (HappyWrap112 happy_var_2) -> - case happyOut110 happy_x_3 of { (HappyWrap110 happy_var_3) -> - case happyOut197 happy_x_4 of { (HappyWrap197 happy_var_4) -> - case happyOut206 happy_x_5 of { (HappyWrap206 happy_var_5) -> - ( do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc happy_var_1} - ; let { tequal = fst $ unLoc happy_var_4 } - ; mkTyData (comb4 happy_var_1 happy_var_3 happy_var_4 happy_var_5) (sndOf3 $ unLoc happy_var_1) (thdOf3 $ unLoc happy_var_1) happy_var_2 happy_var_3 - Nothing (reverse (snd $ unLoc happy_var_4)) - (fmap reverse happy_var_5) - (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok NoEpUniTok NoEpTok NoEpTok NoEpTok tequal) - })}}}}}) - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_171 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_171 = happyMonadReduce 6# 68# happyReduction_171 -happyReduction_171 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut104 happy_x_1 of { (HappyWrap104 happy_var_1) -> - case happyOut112 happy_x_2 of { (HappyWrap112 happy_var_2) -> - case happyOut110 happy_x_3 of { (HappyWrap110 happy_var_3) -> - case happyOut106 happy_x_4 of { (HappyWrap106 happy_var_4) -> - case happyOut194 happy_x_5 of { (HappyWrap194 happy_var_5) -> - case happyOut206 happy_x_6 of { (HappyWrap206 happy_var_6) -> - ( do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc happy_var_1} - ; let { tdcolon = fst $ unLoc happy_var_4 } - ; let { (twhere, oc, cc) = fst $ unLoc happy_var_5 } - ; mkTyData (comb5 happy_var_1 happy_var_3 happy_var_4 happy_var_5 happy_var_6) (sndOf3 $ unLoc happy_var_1) (thdOf3 $ unLoc happy_var_1) happy_var_2 happy_var_3 - (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5) - (fmap reverse happy_var_6) - (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok tdcolon twhere oc cc NoEpTok)})}}}}}}) - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_172 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_172 = happyMonadReduce 4# 68# happyReduction_172 -happyReduction_172 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - case happyOut107 happy_x_4 of { (HappyWrap107 happy_var_4) -> - ( do { let { tdcolon = fst $ unLoc happy_var_4 } - ; mkFamDecl (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) DataFamily TopLevel happy_var_3 - (snd $ unLoc happy_var_4) Nothing - (AnnFamilyDecl [] [] noAnn (epTok happy_var_1) (epTok happy_var_2) tdcolon noAnn noAnn noAnn noAnn noAnn noAnn) })}}}}) - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_173 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_173 = happyMonadReduce 4# 69# happyReduction_173 -happyReduction_173 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut86 happy_x_2 of { (HappyWrap86 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut161 happy_x_4 of { (HappyWrap161 happy_var_4) -> - ( mkStandaloneKindSig (comb2 happy_var_1 happy_var_4) (L (gl happy_var_2) $ unLoc happy_var_2) happy_var_4 - (epTok happy_var_1,epUniTok happy_var_3))}}}}) - ) (\r -> happyReturn (happyIn85 r)) - -happyReduce_174 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_174 = happyMonadReduce 3# 70# happyReduction_174 -happyReduction_174 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut86 happy_x_1 of { (HappyWrap86 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut296 happy_x_3 of { (HappyWrap296 happy_var_3) -> - ( case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingCommaN h (gl happy_var_2) - return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) - ) (\r -> happyReturn (happyIn86 r)) - -happyReduce_175 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_175 = happySpecReduce_1 70# happyReduction_175 -happyReduction_175 happy_x_1 - = case happyOut296 happy_x_1 of { (HappyWrap296 happy_var_1) -> - happyIn86 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_176 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_176 = happyMonadReduce 5# 71# happyReduction_176 -happyReduction_176 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut145 happy_x_2 of { (HappyWrap145 happy_var_2) -> - case happyOut88 happy_x_3 of { (HappyWrap88 happy_var_3) -> - case happyOut180 happy_x_4 of { (HappyWrap180 happy_var_4) -> - case happyOut132 happy_x_5 of { (HappyWrap132 happy_var_5) -> - ( do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc happy_var_5) - ; let (twhere, (openc, closec, semis)) = fst $ unLoc happy_var_5 - ; let anns = AnnClsInstDecl (epTok happy_var_1) twhere openc semis closec - ; let cid = ClsInstDecl - { cid_ext = (happy_var_2, anns, NoAnnSortKey) - , cid_poly_ty = happy_var_4, cid_binds = binds - , cid_sigs = mkClassOpSigs sigs - , cid_tyfam_insts = ats - , cid_overlap_mode = happy_var_3 - , cid_datafam_insts = adts } - ; amsA' (L (comb3 happy_var_1 happy_var_4 happy_var_5) - (ClsInstD { cid_d_ext = noExtField, cid_inst = cid })) - })}}}}}) - ) (\r -> happyReturn (happyIn87 r)) - -happyReduce_177 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_177 = happyMonadReduce 3# 71# happyReduction_177 -happyReduction_177 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut99 happy_x_3 of { (HappyWrap99 happy_var_3) -> - ( mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) - (epTok happy_var_1) (epTok happy_var_2))}}}) - ) (\r -> happyReturn (happyIn87 r)) - -happyReduce_178 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_178 = happyMonadReduce 6# 71# happyReduction_178 -happyReduction_178 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut112 happy_x_3 of { (HappyWrap112 happy_var_3) -> - case happyOut111 happy_x_4 of { (HappyWrap111 happy_var_4) -> - case happyOut197 happy_x_5 of { (HappyWrap197 happy_var_5) -> - case happyOut206 happy_x_6 of { (HappyWrap206 happy_var_6) -> - ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } - ; let { tequal = fst $ unLoc happy_var_5 } - ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) - Nothing (reverse (snd $ unLoc happy_var_5)) - (fmap reverse happy_var_6) - (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok happy_var_2) NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)})}}}}}}) - ) (\r -> happyReturn (happyIn87 r)) - -happyReduce_179 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_179 = happyMonadReduce 7# 71# happyReduction_179 -happyReduction_179 (happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut112 happy_x_3 of { (HappyWrap112 happy_var_3) -> - case happyOut111 happy_x_4 of { (HappyWrap111 happy_var_4) -> - case happyOut106 happy_x_5 of { (HappyWrap106 happy_var_5) -> - case happyOut194 happy_x_6 of { (HappyWrap194 happy_var_6) -> - case happyOut206 happy_x_7 of { (HappyWrap206 happy_var_7) -> - ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } - ; let { dcolon = fst $ unLoc happy_var_5 } - ; let { (twhere, oc, cc) = fst $ unLoc happy_var_6 } - ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) - (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6) - (fmap reverse happy_var_7) - (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok happy_var_2) dcolon twhere oc cc NoEpTok)})}}}}}}}) - ) (\r -> happyReturn (happyIn87 r)) - -happyReduce_180 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_180 = happyMonadReduce 2# 72# happyReduction_180 -happyReduction_180 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlappable (getOVERLAPPABLE_PRAGs happy_var_1))) - (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) - ) (\r -> happyReturn (happyIn88 r)) - -happyReduce_181 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_181 = happyMonadReduce 2# 72# happyReduction_181 -happyReduction_181 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlapping (getOVERLAPPING_PRAGs happy_var_1))) - (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) - ) (\r -> happyReturn (happyIn88 r)) - -happyReduce_182 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_182 = happyMonadReduce 2# 72# happyReduction_182 -happyReduction_182 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlaps (getOVERLAPS_PRAGs happy_var_1))) - (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) - ) (\r -> happyReturn (happyIn88 r)) - -happyReduce_183 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_183 = happyMonadReduce 2# 72# happyReduction_183 -happyReduction_183 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Incoherent (getINCOHERENT_PRAGs happy_var_1))) - (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) - ) (\r -> happyReturn (happyIn88 r)) - -happyReduce_184 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_184 = happySpecReduce_0 72# happyReduction_184 -happyReduction_184 = happyIn88 - (Nothing - ) - -happyReduce_185 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_185 = happyMonadReduce 1# 73# happyReduction_185 -happyReduction_185 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( amsA' (sL1 happy_var_1 (StockStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn89 r)) - -happyReduce_186 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_186 = happyMonadReduce 1# 73# happyReduction_186 -happyReduction_186 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( amsA' (sL1 happy_var_1 (AnyclassStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn89 r)) - -happyReduce_187 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_187 = happyMonadReduce 1# 73# happyReduction_187 -happyReduction_187 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( amsA' (sL1 happy_var_1 (NewtypeStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn89 r)) - -happyReduce_188 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_188 = happyMonadReduce 2# 74# happyReduction_188 -happyReduction_188 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut161 happy_x_2 of { (HappyWrap161 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 (ViaStrategy (XViaStrategyPs (epTok happy_var_1) happy_var_2))))}}) - ) (\r -> happyReturn (happyIn90 r)) - -happyReduce_189 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_189 = happyMonadReduce 1# 75# happyReduction_189 -happyReduction_189 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( fmap Just $ amsA' (sL1 happy_var_1 (StockStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn91 r)) - -happyReduce_190 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_190 = happyMonadReduce 1# 75# happyReduction_190 -happyReduction_190 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( fmap Just $ amsA' (sL1 happy_var_1 (AnyclassStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn91 r)) - -happyReduce_191 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_191 = happyMonadReduce 1# 75# happyReduction_191 -happyReduction_191 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( fmap Just $ amsA' (sL1 happy_var_1 (NewtypeStrategy (epTok happy_var_1))))}) - ) (\r -> happyReturn (happyIn91 r)) - -happyReduce_192 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_192 = happySpecReduce_1 75# happyReduction_192 -happyReduction_192 happy_x_1 - = case happyOut90 happy_x_1 of { (HappyWrap90 happy_var_1) -> - happyIn91 - (Just happy_var_1 - )} - -happyReduce_193 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_193 = happySpecReduce_0 75# happyReduction_193 -happyReduction_193 = happyIn91 - (Nothing - ) - -happyReduce_194 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_194 = happySpecReduce_0 76# happyReduction_194 -happyReduction_194 = happyIn92 - (Nothing - ) - -happyReduce_195 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_195 = happyMonadReduce 1# 76# happyReduction_195 -happyReduction_195 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut299 happy_x_1 of { (HappyWrap299 happy_var_1) -> - ( fmap Just $ amsA' (reLoc happy_var_1))}) - ) (\r -> happyReturn (happyIn92 r)) - -happyReduce_196 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_196 = happySpecReduce_0 77# happyReduction_196 -happyReduction_196 = happyIn93 - (noLoc (noAnn, Nothing) - ) - -happyReduce_197 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_197 = happySpecReduce_2 77# happyReduction_197 -happyReduction_197 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut94 happy_x_2 of { (HappyWrap94 happy_var_2) -> - happyIn93 - (sLL happy_var_1 happy_var_2 ((epTok happy_var_1) - , Just (happy_var_2)) - )}} - -happyReduce_198 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_198 = happyMonadReduce 3# 78# happyReduction_198 -happyReduction_198 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut313 happy_x_1 of { (HappyWrap313 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut95 happy_x_3 of { (HappyWrap95 happy_var_3) -> - ( amsA' (sLL happy_var_1 happy_var_3 (InjectivityAnn (epUniTok happy_var_2) happy_var_1 (reverse (unLoc happy_var_3)))))}}}) - ) (\r -> happyReturn (happyIn94 r)) - -happyReduce_199 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_199 = happySpecReduce_2 79# happyReduction_199 -happyReduction_199 happy_x_2 - happy_x_1 - = case happyOut95 happy_x_1 of { (HappyWrap95 happy_var_1) -> - case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> - happyIn95 - (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1) - )}} - -happyReduce_200 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_200 = happySpecReduce_1 79# happyReduction_200 -happyReduction_200 happy_x_1 - = case happyOut313 happy_x_1 of { (HappyWrap313 happy_var_1) -> - happyIn95 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_201 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_201 = happySpecReduce_0 80# happyReduction_201 -happyReduction_201 = happyIn96 - (noLoc (noAnn,OpenTypeFamily) - ) - -happyReduce_202 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_202 = happySpecReduce_2 80# happyReduction_202 -happyReduction_202 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut97 happy_x_2 of { (HappyWrap97 happy_var_2) -> - happyIn96 - (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,(fst $ unLoc happy_var_2)) - ,ClosedTypeFamily (fmap reverse $ snd $ unLoc happy_var_2)) - )}} - -happyReduce_203 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_203 = happySpecReduce_3 81# happyReduction_203 -happyReduction_203 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut98 happy_x_2 of { (HappyWrap98 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn97 - (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,noAnn, epTok happy_var_3) - ,Just (unLoc happy_var_2)) - )}}} - -happyReduce_204 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_204 = happySpecReduce_3 81# happyReduction_204 -happyReduction_204 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut98 happy_x_2 of { (HappyWrap98 happy_var_2) -> - happyIn97 - (let (L loc _) = happy_var_2 in - L loc (noAnn,Just (unLoc happy_var_2)) - )} - -happyReduce_205 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_205 = happySpecReduce_3 81# happyReduction_205 -happyReduction_205 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn97 - (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_2 ,epTok happy_var_3),Nothing) - )}}} - -happyReduce_206 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_206 = happySpecReduce_3 81# happyReduction_206 -happyReduction_206 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn97 - (let (L loc _) = happy_var_2 in - L loc ((noAnn,epTok happy_var_2, noAnn),Nothing) - )} - -happyReduce_207 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_207 = happyMonadReduce 3# 82# happyReduction_207 -happyReduction_207 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut98 happy_x_1 of { (HappyWrap98 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut99 happy_x_3 of { (HappyWrap99 happy_var_3) -> - ( let (L loc eqn) = happy_var_3 in - case unLoc happy_var_1 of - [] -> return (sLL happy_var_1 happy_var_3 (L loc eqn : unLoc happy_var_1)) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) - ) (\r -> happyReturn (happyIn98 r)) - -happyReduce_208 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_208 = happyMonadReduce 2# 82# happyReduction_208 -happyReduction_208 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut98 happy_x_1 of { (HappyWrap98 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( case unLoc happy_var_1 of - [] -> return (sLZ happy_var_1 happy_var_2 (unLoc happy_var_1)) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (h':t)))}}) - ) (\r -> happyReturn (happyIn98 r)) - -happyReduce_209 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_209 = happySpecReduce_1 82# happyReduction_209 -happyReduction_209 happy_x_1 - = case happyOut99 happy_x_1 of { (HappyWrap99 happy_var_1) -> - happyIn98 - (sLL happy_var_1 happy_var_1 [happy_var_1] - )} - -happyReduce_210 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_210 = happySpecReduce_0 82# happyReduction_210 -happyReduction_210 = happyIn98 - (noLoc [] - ) - -happyReduce_211 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_211 = happyMonadReduce 6# 83# happyReduction_211 -happyReduction_211 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut171 happy_x_4 of { (HappyWrap171 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut167 happy_x_6 of { (HappyWrap167 happy_var_6) -> - ( do { hintExplicitForall happy_var_1 - ; tvbs <- fromSpecTyVarBndrs happy_var_2 - ; let loc = comb2 happy_var_1 happy_var_6 - ; !cs <- getCommentsFor loc - ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) cs) tvbs) happy_var_4 happy_var_6 (epTok happy_var_5) })}}}}}}) - ) (\r -> happyReturn (happyIn99 r)) - -happyReduce_212 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_212 = happyMonadReduce 3# 83# happyReduction_212 -happyReduction_212 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut171 happy_x_1 of { (HappyWrap171 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut167 happy_x_3 of { (HappyWrap167 happy_var_3) -> - ( mkTyFamInstEqn (comb2 happy_var_1 happy_var_3) mkHsOuterImplicit happy_var_1 happy_var_3 (epTok happy_var_2))}}}) - ) (\r -> happyReturn (happyIn99 r)) - -happyReduce_213 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_213 = happyMonadReduce 4# 84# happyReduction_213 -happyReduction_213 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut101 happy_x_2 of { (HappyWrap101 happy_var_2) -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - case happyOut107 happy_x_4 of { (HappyWrap107 happy_var_4) -> - ( do { let { tdcolon = fst $ unLoc happy_var_4 } - ; liftM mkTyClD (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) DataFamily NotTopLevel happy_var_3 - (snd $ unLoc happy_var_4) Nothing - (AnnFamilyDecl [] [] noAnn (epTok happy_var_1) happy_var_2 tdcolon noAnn noAnn noAnn noAnn noAnn noAnn)) })}}}}) - ) (\r -> happyReturn (happyIn100 r)) - -happyReduce_214 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_214 = happyMonadReduce 3# 84# happyReduction_214 -happyReduction_214 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut171 happy_x_2 of { (HappyWrap171 happy_var_2) -> - case happyOut109 happy_x_3 of { (HappyWrap109 happy_var_3) -> - ( do { let { (tdcolon, tequal, tvbar) = fst $ unLoc happy_var_3 } - ; liftM mkTyClD - (mkFamDecl (comb3 happy_var_1 happy_var_2 happy_var_3) OpenTypeFamily NotTopLevel happy_var_2 - (fst . snd $ unLoc happy_var_3) - (snd . snd $ unLoc happy_var_3) - (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn noAnn tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) })}}}) - ) (\r -> happyReturn (happyIn100 r)) - -happyReduce_215 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_215 = happyMonadReduce 4# 84# happyReduction_215 -happyReduction_215 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - case happyOut109 happy_x_4 of { (HappyWrap109 happy_var_4) -> - ( do { let { (tdcolon, tequal, tvbar) = fst $ unLoc happy_var_4 } - ; liftM mkTyClD - (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) OpenTypeFamily NotTopLevel happy_var_3 - (fst . snd $ unLoc happy_var_4) - (snd . snd $ unLoc happy_var_4) - (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn (epTok happy_var_2) tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) })}}}}) - ) (\r -> happyReturn (happyIn100 r)) - -happyReduce_216 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_216 = happyMonadReduce 2# 84# happyReduction_216 -happyReduction_216 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut99 happy_x_2 of { (HappyWrap99 happy_var_2) -> - ( liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_2) (unLoc happy_var_2) - (epTok happy_var_1) NoEpTok))}}) - ) (\r -> happyReturn (happyIn100 r)) - -happyReduce_217 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_217 = happyMonadReduce 3# 84# happyReduction_217 -happyReduction_217 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut99 happy_x_3 of { (HappyWrap99 happy_var_3) -> - ( liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) - (epTok happy_var_1) (epTok happy_var_2) ))}}}) - ) (\r -> happyReturn (happyIn100 r)) - -happyReduce_218 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_218 = happySpecReduce_0 85# happyReduction_218 -happyReduction_218 = happyIn101 - (noAnn - ) - -happyReduce_219 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_219 = happySpecReduce_1 85# happyReduction_219 -happyReduction_219 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn101 - ((epTok happy_var_1) - )} - -happyReduce_220 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_220 = happySpecReduce_0 86# happyReduction_220 -happyReduction_220 = happyIn102 - (NoEpTok - ) - -happyReduce_221 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_221 = happySpecReduce_1 86# happyReduction_221 -happyReduction_221 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn102 - (epTok happy_var_1 - )} - -happyReduce_222 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_222 = happyMonadReduce 3# 87# happyReduction_222 -happyReduction_222 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut102 happy_x_2 of { (HappyWrap102 happy_var_2) -> - case happyOut99 happy_x_3 of { (HappyWrap99 happy_var_3) -> - ( mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) - (epTok happy_var_1) happy_var_2)}}}) - ) (\r -> happyReturn (happyIn103 r)) - -happyReduce_223 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_223 = happyMonadReduce 6# 87# happyReduction_223 -happyReduction_223 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> - case happyOut102 happy_x_2 of { (HappyWrap102 happy_var_2) -> - case happyOut112 happy_x_3 of { (HappyWrap112 happy_var_3) -> - case happyOut111 happy_x_4 of { (HappyWrap111 happy_var_4) -> - case happyOut197 happy_x_5 of { (HappyWrap197 happy_var_5) -> - case happyOut206 happy_x_6 of { (HappyWrap206 happy_var_6) -> - ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } - ; let { tequal = fst $ unLoc happy_var_5 } - ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) - Nothing (reverse (snd $ unLoc happy_var_5)) - (fmap reverse happy_var_6) - (AnnDataDefn [] [] NoEpTok tnewtype tdata happy_var_2 NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)})}}}}}}) - ) (\r -> happyReturn (happyIn103 r)) - -happyReduce_224 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_224 = happyMonadReduce 7# 87# happyReduction_224 -happyReduction_224 (happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> - case happyOut102 happy_x_2 of { (HappyWrap102 happy_var_2) -> - case happyOut112 happy_x_3 of { (HappyWrap112 happy_var_3) -> - case happyOut111 happy_x_4 of { (HappyWrap111 happy_var_4) -> - case happyOut106 happy_x_5 of { (HappyWrap106 happy_var_5) -> - case happyOut194 happy_x_6 of { (HappyWrap194 happy_var_6) -> - case happyOut206 happy_x_7 of { (HappyWrap206 happy_var_7) -> - ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } - ; let { dcolon = fst $ unLoc happy_var_5 } - ; let { (twhere, oc, cc) = fst $ unLoc happy_var_6 } - ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3 - (unLoc happy_var_4) (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6) - (fmap reverse happy_var_7) - (AnnDataDefn [] [] NoEpTok tnewtype tdata happy_var_2 dcolon twhere oc cc NoEpTok)})}}}}}}}) - ) (\r -> happyReturn (happyIn103 r)) - -happyReduce_225 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_225 = happySpecReduce_1 88# happyReduction_225 -happyReduction_225 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn104 - (sL1 happy_var_1 ((epTok happy_var_1, NoEpTok, NoEpTok), False,DataType) - )} - -happyReduce_226 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_226 = happySpecReduce_1 88# happyReduction_226 -happyReduction_226 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn104 - (sL1 happy_var_1 ((NoEpTok, epTok happy_var_1, NoEpTok), False,NewType) - )} - -happyReduce_227 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_227 = happySpecReduce_2 88# happyReduction_227 -happyReduction_227 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn104 - (sL1 happy_var_1 ((epTok happy_var_2, NoEpTok, epTok happy_var_1), True ,DataType) - )}} - -happyReduce_228 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_228 = happySpecReduce_1 89# happyReduction_228 -happyReduction_228 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn105 - (sL1 happy_var_1 ((epTok happy_var_1, NoEpTok), DataType) - )} - -happyReduce_229 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_229 = happySpecReduce_1 89# happyReduction_229 -happyReduction_229 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn105 - (sL1 happy_var_1 ((NoEpTok, epTok happy_var_1),NewType) - )} - -happyReduce_230 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_230 = happySpecReduce_0 90# happyReduction_230 -happyReduction_230 = happyIn106 - (noLoc (NoEpUniTok , Nothing) - ) - -happyReduce_231 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_231 = happySpecReduce_2 90# happyReduction_231 -happyReduction_231 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut193 happy_x_2 of { (HappyWrap193 happy_var_2) -> - happyIn106 - (sLL happy_var_1 happy_var_2 (epUniTok happy_var_1, Just happy_var_2) - )}} - -happyReduce_232 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_232 = happySpecReduce_0 91# happyReduction_232 -happyReduction_232 = happyIn107 - (noLoc (noAnn, noLocA (NoSig noExtField) ) - ) - -happyReduce_233 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_233 = happySpecReduce_2 91# happyReduction_233 -happyReduction_233 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut193 happy_x_2 of { (HappyWrap193 happy_var_2) -> - happyIn107 - (sLL happy_var_1 happy_var_2 (epUniTok happy_var_1, sLLa happy_var_1 happy_var_2 (KindSig noExtField happy_var_2)) - )}} - -happyReduce_234 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_234 = happySpecReduce_0 92# happyReduction_234 -happyReduction_234 = happyIn108 - (noLoc (noAnn , noLocA (NoSig noExtField) ) - ) - -happyReduce_235 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_235 = happySpecReduce_2 92# happyReduction_235 -happyReduction_235 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut193 happy_x_2 of { (HappyWrap193 happy_var_2) -> - happyIn108 - (sLL happy_var_1 happy_var_2 ((epUniTok happy_var_1, noAnn), sLLa happy_var_1 happy_var_2 (KindSig noExtField happy_var_2)) - )}} - -happyReduce_236 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_236 = happyMonadReduce 2# 92# happyReduction_236 -happyReduction_236 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> - ( do { tvb <- fromSpecTyVarBndr happy_var_2 - ; return $ sLL happy_var_1 happy_var_2 ((noAnn, epTok happy_var_1), sLLa happy_var_1 happy_var_2 (TyVarSig noExtField tvb))})}}) - ) (\r -> happyReturn (happyIn108 r)) - -happyReduce_237 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_237 = happySpecReduce_0 93# happyReduction_237 -happyReduction_237 = happyIn109 - (noLoc (noAnn, (noLocA (NoSig noExtField), Nothing)) - ) - -happyReduce_238 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_238 = happySpecReduce_2 93# happyReduction_238 -happyReduction_238 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut193 happy_x_2 of { (HappyWrap193 happy_var_2) -> - happyIn109 - (sLL happy_var_1 happy_var_2 ( (epUniTok happy_var_1, noAnn, noAnn) - , (sL1a happy_var_2 (KindSig noExtField happy_var_2), Nothing)) - )}} - -happyReduce_239 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_239 = happyMonadReduce 4# 93# happyReduction_239 -happyReduction_239 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut187 happy_x_2 of { (HappyWrap187 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut94 happy_x_4 of { (HappyWrap94 happy_var_4) -> - ( do { tvb <- fromSpecTyVarBndr happy_var_2 - ; return $ sLL happy_var_1 happy_var_4 ((noAnn, epTok happy_var_1, epTok happy_var_3) - , (sLLa happy_var_1 happy_var_2 (TyVarSig noExtField tvb), Just happy_var_4))})}}}}) - ) (\r -> happyReturn (happyIn109 r)) - -happyReduce_240 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_240 = happyMonadReduce 3# 94# happyReduction_240 -happyReduction_240 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - ( acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc (Just (addTrailingDarrowC happy_var_1 happy_var_2 cs), happy_var_3))))}}}) - ) (\r -> happyReturn (happyIn110 r)) - -happyReduce_241 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_241 = happySpecReduce_1 94# happyReduction_241 -happyReduction_241 happy_x_1 - = case happyOut171 happy_x_1 of { (HappyWrap171 happy_var_1) -> - happyIn110 - (sL1 happy_var_1 (Nothing, happy_var_1) - )} - -happyReduce_242 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_242 = happyMonadReduce 6# 95# happyReduction_242 -happyReduction_242 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut169 happy_x_4 of { (HappyWrap169 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut171 happy_x_6 of { (HappyWrap171 happy_var_6) -> - ( hintExplicitForall happy_var_1 - >> fromSpecTyVarBndrs happy_var_2 - >>= \tvbs -> - (acs (comb2 happy_var_1 happy_var_6) (\loc cs -> (L loc - (Just ( addTrailingDarrowC happy_var_4 happy_var_5 cs) - , mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) emptyComments) tvbs, happy_var_6)))))}}}}}}) - ) (\r -> happyReturn (happyIn111 r)) - -happyReduce_243 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_243 = happyMonadReduce 4# 95# happyReduction_243 -happyReduction_243 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut171 happy_x_4 of { (HappyWrap171 happy_var_4) -> - ( do { hintExplicitForall happy_var_1 - ; tvbs <- fromSpecTyVarBndrs happy_var_2 - ; let loc = comb2 happy_var_1 happy_var_4 - ; !cs <- getCommentsFor loc - ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) cs) tvbs, happy_var_4)) - })}}}}) - ) (\r -> happyReturn (happyIn111 r)) - -happyReduce_244 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_244 = happyMonadReduce 3# 95# happyReduction_244 -happyReduction_244 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut171 happy_x_3 of { (HappyWrap171 happy_var_3) -> - ( acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc (Just (addTrailingDarrowC happy_var_1 happy_var_2 cs), mkHsOuterImplicit, happy_var_3))))}}}) - ) (\r -> happyReturn (happyIn111 r)) - -happyReduce_245 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_245 = happySpecReduce_1 95# happyReduction_245 -happyReduction_245 happy_x_1 - = case happyOut171 happy_x_1 of { (HappyWrap171 happy_var_1) -> - happyIn111 - (sL1 happy_var_1 (Nothing, mkHsOuterImplicit, happy_var_1) - )} - -happyReduce_246 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_246 = happyMonadReduce 4# 96# happyReduction_246 -happyReduction_246 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_4 (CType (getCTYPEs happy_var_1) (Just (Header (getSTRINGs happy_var_2) (getSTRING happy_var_2))) - (getSTRINGs happy_var_3,getSTRING happy_var_3))) - (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn (glR happy_var_2) (glR happy_var_3) noAnn noAnn))}}}}) - ) (\r -> happyReturn (happyIn112 r)) - -happyReduce_247 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_247 = happyMonadReduce 3# 96# happyReduction_247 -happyReduction_247 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 (CType (getCTYPEs happy_var_1) Nothing (getSTRINGs happy_var_2, getSTRING happy_var_2))) - (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn noAnn (glR happy_var_2) noAnn noAnn))}}}) - ) (\r -> happyReturn (happyIn112 r)) - -happyReduce_248 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_248 = happySpecReduce_0 96# happyReduction_248 -happyReduction_248 = happyIn112 - (Nothing - ) - -happyReduce_249 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_249 = happyMonadReduce 6# 97# happyReduction_249 -happyReduction_249 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut91 happy_x_2 of { (HappyWrap91 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut145 happy_x_4 of { (HappyWrap145 happy_var_4) -> - case happyOut88 happy_x_5 of { (HappyWrap88 happy_var_5) -> - case happyOut180 happy_x_6 of { (HappyWrap180 happy_var_6) -> - ( do { let { err = text "in the stand-alone deriving instance" - <> colon <+> quotes (ppr happy_var_6) } - ; amsA' (sLL happy_var_1 happy_var_6 - (DerivDecl (happy_var_4, (epTok happy_var_1, epTok happy_var_3)) (mkHsWildCardBndrs happy_var_6) happy_var_2 happy_var_5)) })}}}}}}) - ) (\r -> happyReturn (happyIn113 r)) - -happyReduce_250 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_250 = happyMonadReduce 4# 98# happyReduction_250 -happyReduction_250 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut296 happy_x_3 of { (HappyWrap296 happy_var_3) -> - case happyOut115 happy_x_4 of { (HappyWrap115 happy_var_4) -> - ( mkRoleAnnotDecl (comb3 happy_var_1 happy_var_4 happy_var_3) happy_var_3 (reverse (unLoc happy_var_4)) - (epTok happy_var_1,epTok happy_var_2))}}}}) - ) (\r -> happyReturn (happyIn114 r)) - -happyReduce_251 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_251 = happySpecReduce_0 99# happyReduction_251 -happyReduction_251 = happyIn115 - (noLoc [] - ) - -happyReduce_252 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_252 = happySpecReduce_1 99# happyReduction_252 -happyReduction_252 happy_x_1 - = case happyOut116 happy_x_1 of { (HappyWrap116 happy_var_1) -> - happyIn115 - (happy_var_1 - )} - -happyReduce_253 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_253 = happySpecReduce_1 100# happyReduction_253 -happyReduction_253 happy_x_1 - = case happyOut117 happy_x_1 of { (HappyWrap117 happy_var_1) -> - happyIn116 - (sLL happy_var_1 happy_var_1 [happy_var_1] - )} - -happyReduce_254 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_254 = happySpecReduce_2 100# happyReduction_254 -happyReduction_254 happy_x_2 - happy_x_1 - = case happyOut116 happy_x_1 of { (HappyWrap116 happy_var_1) -> - case happyOut117 happy_x_2 of { (HappyWrap117 happy_var_2) -> - happyIn116 - (sLL happy_var_1 happy_var_2 $ happy_var_2 : unLoc happy_var_1 - )}} - -happyReduce_255 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_255 = happySpecReduce_1 101# happyReduction_255 -happyReduction_255 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn117 - (sL1 happy_var_1 $ Just $ getVARID happy_var_1 - )} - -happyReduce_256 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_256 = happySpecReduce_1 101# happyReduction_256 -happyReduction_256 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn117 - (sL1 happy_var_1 Nothing - )} - -happyReduce_257 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_257 = happyMonadReduce 4# 102# happyReduction_257 -happyReduction_257 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut119 happy_x_2 of { (HappyWrap119 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut256 happy_x_4 of { (HappyWrap256 happy_var_4) -> - ( let (name, args, (mo, mc) ) = happy_var_2 in - amsA' (sLL happy_var_1 happy_var_4 . ValD noExtField $ mkPatSynBind name args happy_var_4 - ImplicitBidirectional - (AnnPSB (epTok happy_var_1) mo mc Nothing (Just (epTok happy_var_3)))))}}}}) - ) (\r -> happyReturn (happyIn118 r)) - -happyReduce_258 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_258 = happyMonadReduce 4# 102# happyReduction_258 -happyReduction_258 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut119 happy_x_2 of { (HappyWrap119 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut256 happy_x_4 of { (HappyWrap256 happy_var_4) -> - ( let (name, args, (mo,mc)) = happy_var_2 in - amsA' (sLL happy_var_1 happy_var_4 . ValD noExtField $ mkPatSynBind name args happy_var_4 Unidirectional - (AnnPSB (epTok happy_var_1) mo mc (Just (epUniTok happy_var_3)) Nothing)))}}}}) - ) (\r -> happyReturn (happyIn118 r)) - -happyReduce_259 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_259 = happyMonadReduce 5# 102# happyReduction_259 -happyReduction_259 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut119 happy_x_2 of { (HappyWrap119 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut256 happy_x_4 of { (HappyWrap256 happy_var_4) -> - case happyOut122 happy_x_5 of { (HappyWrap122 happy_var_5) -> - ( do { let (name, args, (mo,mc)) = happy_var_2 - ; mg <- mkPatSynMatchGroup name happy_var_5 - ; amsA' (sLL happy_var_1 happy_var_5 . ValD noExtField $ - mkPatSynBind name args happy_var_4 (ExplicitBidirectional mg) - (AnnPSB (epTok happy_var_1) mo mc (Just (epUniTok happy_var_3)) Nothing)) - })}}}}}) - ) (\r -> happyReturn (happyIn118 r)) - -happyReduce_260 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_260 = happySpecReduce_2 103# happyReduction_260 -happyReduction_260 happy_x_2 - happy_x_1 - = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> - case happyOut120 happy_x_2 of { (HappyWrap120 happy_var_2) -> - happyIn119 - ((happy_var_1, PrefixCon noTypeArgs happy_var_2, noAnn) - )}} - -happyReduce_261 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_261 = happySpecReduce_3 103# happyReduction_261 -happyReduction_261 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - case happyOut292 happy_x_2 of { (HappyWrap292 happy_var_2) -> - case happyOut318 happy_x_3 of { (HappyWrap318 happy_var_3) -> - happyIn119 - ((happy_var_2, InfixCon happy_var_1 happy_var_3, noAnn) - )}}} - -happyReduce_262 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_262 = happyReduce 4# 103# happyReduction_262 -happyReduction_262 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut121 happy_x_3 of { (HappyWrap121 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn119 - ((happy_var_1, RecCon happy_var_3, (Just (epTok happy_var_2), Just (epTok happy_var_4))) - ) `HappyStk` happyRest}}}} - -happyReduce_263 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_263 = happySpecReduce_0 104# happyReduction_263 -happyReduction_263 = happyIn120 - ([] - ) - -happyReduce_264 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_264 = happySpecReduce_2 104# happyReduction_264 -happyReduction_264 happy_x_2 - happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - case happyOut120 happy_x_2 of { (HappyWrap120 happy_var_2) -> - happyIn120 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_265 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_265 = happySpecReduce_1 105# happyReduction_265 -happyReduction_265 happy_x_1 - = case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - happyIn121 - ([RecordPatSynField (mkFieldOcc happy_var_1) happy_var_1] - )} - -happyReduce_266 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_266 = happyMonadReduce 3# 105# happyReduction_266 -happyReduction_266 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut121 happy_x_3 of { (HappyWrap121 happy_var_3) -> - ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) - ; return ((RecordPatSynField (mkFieldOcc h) h) : happy_var_3 )})}}}) - ) (\r -> happyReturn (happyIn121 r)) - -happyReduce_267 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_267 = happyMonadReduce 4# 106# happyReduction_267 -happyReduction_267 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut133 happy_x_3 of { (HappyWrap133 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( amsr (sLL happy_var_1 happy_var_4 (thdOf3 $ unLoc happy_var_3)) - (AnnList (Just (fstOf3 $ unLoc happy_var_3)) (ListBraces (epTok happy_var_2) (epTok happy_var_4)) (sndOf3 $ unLoc happy_var_3) (epTok happy_var_1) []))}}}}) - ) (\r -> happyReturn (happyIn122 r)) - -happyReduce_268 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_268 = happyMonadReduce 4# 106# happyReduction_268 -happyReduction_268 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut133 happy_x_3 of { (HappyWrap133 happy_var_3) -> - ( amsr (sLL happy_var_1 happy_var_3 (thdOf3 $ unLoc happy_var_3)) - (AnnList (Just (fstOf3 $ unLoc happy_var_3)) ListNone (sndOf3 $ unLoc happy_var_3) (epTok happy_var_1) []))}}) - ) (\r -> happyReturn (happyIn122 r)) - -happyReduce_269 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_269 = happyMonadReduce 4# 107# happyReduction_269 -happyReduction_269 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut287 happy_x_2 of { (HappyWrap287 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut162 happy_x_4 of { (HappyWrap162 happy_var_4) -> - ( amsA' (sLL happy_var_1 happy_var_4 - $ PatSynSig (AnnSig (epUniTok happy_var_3) (Just (epTok happy_var_1)) Nothing) - (toList $ unLoc happy_var_2) happy_var_4))}}}}) - ) (\r -> happyReturn (happyIn123 r)) - -happyReduce_270 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_270 = happySpecReduce_1 108# happyReduction_270 -happyReduction_270 happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - happyIn124 - (happy_var_1 - )} - -happyReduce_271 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_271 = happySpecReduce_1 108# happyReduction_271 -happyReduction_271 happy_x_1 - = case happyOut284 happy_x_1 of { (HappyWrap284 happy_var_1) -> - happyIn124 - (happy_var_1 - )} - -happyReduce_272 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_272 = happySpecReduce_1 109# happyReduction_272 -happyReduction_272 happy_x_1 - = case happyOut100 happy_x_1 of { (HappyWrap100 happy_var_1) -> - happyIn125 - (happy_var_1 - )} - -happyReduce_273 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_273 = happySpecReduce_1 109# happyReduction_273 -happyReduction_273 happy_x_1 - = case happyOut211 happy_x_1 of { (HappyWrap211 happy_var_1) -> - happyIn125 - (happy_var_1 - )} - -happyReduce_274 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_274 = happyMonadReduce 4# 109# happyReduction_274 -happyReduction_274 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut222 happy_x_2 of { (HappyWrap222 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut162 happy_x_4 of { (HappyWrap162 happy_var_4) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - do { v <- checkValSigLhs happy_var_2 - ; let err = text "in default signature" <> colon <+> - quotes (ppr happy_var_2) - ; amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField $ ClassOpSig (AnnSig (epUniTok happy_var_3) Nothing (Just (epTok happy_var_1))) True [v] happy_var_4) })}}}}) - ) (\r -> happyReturn (happyIn125 r)) - -happyReduce_275 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_275 = happyMonadReduce 3# 110# happyReduction_275 -happyReduction_275 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut126 happy_x_1 of { (HappyWrap126 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut125 happy_x_3 of { (HappyWrap125 happy_var_3) -> - ( if isNilOL (snd $ unLoc happy_var_1) - then return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - , unitOL happy_var_3)) - else case (snd $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1 - , snocOL hs t' `appOL` unitOL happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn126 r)) - -happyReduce_276 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_276 = happyMonadReduce 2# 110# happyReduction_276 -happyReduction_276 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut126 happy_x_1 of { (HappyWrap126 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( if isNilOL (snd $ unLoc happy_var_1) - then return (sLZ happy_var_1 happy_var_2 ( (fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,snd $ unLoc happy_var_1)) - else case (snd $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1 - , snocOL hs t')))}}) - ) (\r -> happyReturn (happyIn126 r)) - -happyReduce_277 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_277 = happySpecReduce_1 110# happyReduction_277 -happyReduction_277 happy_x_1 - = case happyOut125 happy_x_1 of { (HappyWrap125 happy_var_1) -> - happyIn126 - (sL1 happy_var_1 ([], unitOL happy_var_1) - )} - -happyReduce_278 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_278 = happySpecReduce_0 110# happyReduction_278 -happyReduction_278 = happyIn126 - (noLoc ([],nilOL) - ) - -happyReduce_279 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_279 = happySpecReduce_3 111# happyReduction_279 -happyReduction_279 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut126 happy_x_2 of { (HappyWrap126 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn127 - (sLL happy_var_1 happy_var_3 ((epTok happy_var_1, fst $ unLoc happy_var_2, epTok happy_var_3) - ,snd $ unLoc happy_var_2, epExplicitBraces happy_var_1 happy_var_3) - )}}} - -happyReduce_280 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_280 = happySpecReduce_3 111# happyReduction_280 -happyReduction_280 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut126 happy_x_2 of { (HappyWrap126 happy_var_2) -> - happyIn127 - (let { L l (anns, decls) = happy_var_2 } - in L l ((NoEpTok, anns, NoEpTok), decls, EpVirtualBraces (getVOCURLY happy_var_1)) - )}} - -happyReduce_281 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_281 = happySpecReduce_2 112# happyReduction_281 -happyReduction_281 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut127 happy_x_2 of { (HappyWrap127 happy_var_2) -> - happyIn128 - (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,fstOf3 $ unLoc happy_var_2) - ,sndOf3 $ unLoc happy_var_2,thdOf3 $ unLoc happy_var_2) - )}} - -happyReduce_282 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_282 = happySpecReduce_0 112# happyReduction_282 -happyReduction_282 = happyIn128 - (noLoc ((noAnn, noAnn),nilOL,EpNoLayout) - ) - -happyReduce_283 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_283 = happySpecReduce_1 113# happyReduction_283 -happyReduction_283 happy_x_1 - = case happyOut103 happy_x_1 of { (HappyWrap103 happy_var_1) -> - happyIn129 - (sL1 happy_var_1 (unitOL (sL1a happy_var_1 (InstD noExtField (unLoc happy_var_1)))) - )} - -happyReduce_284 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_284 = happySpecReduce_1 113# happyReduction_284 -happyReduction_284 happy_x_1 - = case happyOut211 happy_x_1 of { (HappyWrap211 happy_var_1) -> - happyIn129 - (sL1 happy_var_1 (unitOL happy_var_1) - )} - -happyReduce_285 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_285 = happyMonadReduce 3# 114# happyReduction_285 -happyReduction_285 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut130 happy_x_1 of { (HappyWrap130 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut129 happy_x_3 of { (HappyWrap129 happy_var_3) -> - ( if isNilOL (snd $ unLoc happy_var_1) - then return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - , unLoc happy_var_3)) - else case (snd $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1 - , snocOL hs t' `appOL` unLoc happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn130 r)) - -happyReduce_286 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_286 = happyMonadReduce 2# 114# happyReduction_286 -happyReduction_286 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut130 happy_x_1 of { (HappyWrap130 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( if isNilOL (snd $ unLoc happy_var_1) - then return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,snd $ unLoc happy_var_1)) - else case (snd $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1 - , snocOL hs t')))}}) - ) (\r -> happyReturn (happyIn130 r)) - -happyReduce_287 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_287 = happySpecReduce_1 114# happyReduction_287 -happyReduction_287 happy_x_1 - = case happyOut129 happy_x_1 of { (HappyWrap129 happy_var_1) -> - happyIn130 - (sL1 happy_var_1 ([],unLoc happy_var_1) - )} - -happyReduce_288 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_288 = happySpecReduce_0 114# happyReduction_288 -happyReduction_288 = happyIn130 - (noLoc ([],nilOL) - ) - -happyReduce_289 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_289 = happySpecReduce_3 115# happyReduction_289 -happyReduction_289 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut130 happy_x_2 of { (HappyWrap130 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn131 - (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_3,fst $ unLoc happy_var_2),snd $ unLoc happy_var_2) - )}}} - -happyReduce_290 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_290 = happySpecReduce_3 115# happyReduction_290 -happyReduction_290 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut130 happy_x_2 of { (HappyWrap130 happy_var_2) -> - happyIn131 - (L (gl happy_var_2) ((noAnn,noAnn,fst $ unLoc happy_var_2),snd $ unLoc happy_var_2) - )} - -happyReduce_291 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_291 = happySpecReduce_2 116# happyReduction_291 -happyReduction_291 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut131 happy_x_2 of { (HappyWrap131 happy_var_2) -> - happyIn132 - (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,(fst $ unLoc happy_var_2)) - ,snd $ unLoc happy_var_2) - )}} - -happyReduce_292 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_292 = happySpecReduce_0 116# happyReduction_292 -happyReduction_292 = happyIn132 - (noLoc (noAnn,nilOL) - ) - -happyReduce_293 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_293 = happyMonadReduce 3# 117# happyReduction_293 -happyReduction_293 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut133 happy_x_1 of { (HappyWrap133 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut211 happy_x_3 of { (HappyWrap211 happy_var_3) -> - ( if isNilOL (thdOf3 $ unLoc happy_var_1) - then return (sLL happy_var_2 happy_var_3 (glR happy_var_3, (sndOf3 $ unLoc happy_var_1) ++ (msemiA happy_var_2) - , unitOL happy_var_3)) - else case (thdOf3 $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - let { this = unitOL happy_var_3; - rest = snocOL hs t'; - these = rest `appOL` this } - return (rest `seq` this `seq` these `seq` - (sLL happy_var_1 happy_var_3 (glEE (fstOf3 $ unLoc happy_var_1) happy_var_3, sndOf3 $ unLoc happy_var_1, these))))}}}) - ) (\r -> happyReturn (happyIn133 r)) - -happyReduce_294 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_294 = happyMonadReduce 2# 117# happyReduction_294 -happyReduction_294 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut133 happy_x_1 of { (HappyWrap133 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( if isNilOL (thdOf3 $ unLoc happy_var_1) - then return (sLZ happy_var_1 happy_var_2 (glR happy_var_2, (sndOf3 $ unLoc happy_var_1) ++ (msemiA happy_var_2) - ,thdOf3 $ unLoc happy_var_1)) - else case (thdOf3 $ unLoc happy_var_1) of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (glEEz happy_var_1 happy_var_2, sndOf3 $ unLoc happy_var_1, snocOL hs t')))}}) - ) (\r -> happyReturn (happyIn133 r)) - -happyReduce_295 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_295 = happySpecReduce_1 117# happyReduction_295 -happyReduction_295 happy_x_1 - = case happyOut211 happy_x_1 of { (HappyWrap211 happy_var_1) -> - happyIn133 - (sL1 happy_var_1 (glR happy_var_1, [], unitOL happy_var_1) - )} - -happyReduce_296 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_296 = happySpecReduce_0 117# happyReduction_296 -happyReduction_296 = happyIn133 - (noLoc (noAnn, [],nilOL) - ) - -happyReduce_297 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_297 = happySpecReduce_3 118# happyReduction_297 -happyReduction_297 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut133 happy_x_2 of { (HappyWrap133 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn134 - (sLL happy_var_1 happy_var_3 (AnnList (Just (fstOf3 $ unLoc happy_var_2)) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (sndOf3 $ unLoc happy_var_2) noAnn [] - ,sL1 happy_var_2 $ thdOf3 $ unLoc happy_var_2) - )}}} - -happyReduce_298 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_298 = happySpecReduce_3 118# happyReduction_298 -happyReduction_298 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut133 happy_x_2 of { (HappyWrap133 happy_var_2) -> - happyIn134 - (sL1 happy_var_2 (AnnList (Just (fstOf3 $ unLoc happy_var_2)) ListNone (sndOf3 $ unLoc happy_var_2) noAnn [] - ,sL1 happy_var_2 $ thdOf3 $ unLoc happy_var_2) - )} - -happyReduce_299 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_299 = happyMonadReduce 1# 119# happyReduction_299 -happyReduction_299 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut134 happy_x_1 of { (HappyWrap134 happy_var_1) -> - ( do { let { (AnnList anc p s _ t, decls) = unLoc happy_var_1 } - ; val_binds <- cvBindGroup (unLoc $ decls) - ; !cs <- getCommentsFor (gl happy_var_1) - ; return (sL1 happy_var_1 $ HsValBinds (EpAnn (glR happy_var_1) (AnnList anc p s noAnn t) cs) val_binds)})}) - ) (\r -> happyReturn (happyIn135 r)) - -happyReduce_300 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_300 = happyMonadReduce 3# 119# happyReduction_300 -happyReduction_300 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut273 happy_x_2 of { (HappyWrap273 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( acs (comb3 happy_var_1 happy_var_2 happy_var_3) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (spanAsAnchor (comb3 happy_var_1 happy_var_2 happy_var_3)) (AnnList (Just$ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc happy_var_2)))))}}}) - ) (\r -> happyReturn (happyIn135 r)) - -happyReduce_301 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_301 = happyMonadReduce 3# 119# happyReduction_301 -happyReduction_301 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut273 happy_x_2 of { (HappyWrap273 happy_var_2) -> - ( acs (gl happy_var_2) (\loc cs -> (L loc - $ HsIPBinds (EpAnn (glR happy_var_1) (AnnList (Just $ glR happy_var_2) ListNone [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc happy_var_2)))))}}) - ) (\r -> happyReturn (happyIn135 r)) - -happyReduce_302 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_302 = happyMonadReduce 2# 120# happyReduction_302 -happyReduction_302 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut135 happy_x_2 of { (HappyWrap135 happy_var_2) -> - ( do { r <- acs (comb2 happy_var_1 happy_var_2) (\loc cs -> - (L loc (annBinds (epTok happy_var_1) cs (unLoc happy_var_2)))) - ; return $ Just r})}}) - ) (\r -> happyReturn (happyIn136 r)) - -happyReduce_303 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_303 = happySpecReduce_0 120# happyReduction_303 -happyReduction_303 = happyIn136 - (Nothing - ) - -happyReduce_304 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_304 = happyMonadReduce 3# 121# happyReduction_304 -happyReduction_304 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut137 happy_x_1 of { (HappyWrap137 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut138 happy_x_3 of { (HappyWrap138 happy_var_3) -> - ( case happy_var_1 of - [] -> return (happy_var_3:happy_var_1) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (happy_var_3:h':t))}}}) - ) (\r -> happyReturn (happyIn137 r)) - -happyReduce_305 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_305 = happyMonadReduce 2# 121# happyReduction_305 -happyReduction_305 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut137 happy_x_1 of { (HappyWrap137 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( case happy_var_1 of - [] -> return happy_var_1 - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (h':t))}}) - ) (\r -> happyReturn (happyIn137 r)) - -happyReduce_306 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_306 = happySpecReduce_1 121# happyReduction_306 -happyReduction_306 happy_x_1 - = case happyOut138 happy_x_1 of { (HappyWrap138 happy_var_1) -> - happyIn137 - ([happy_var_1] - )} - -happyReduce_307 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_307 = happySpecReduce_0 121# happyReduction_307 -happyReduction_307 = happyIn137 - ([] - ) - -happyReduce_308 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_308 = happyMonadReduce 6# 122# happyReduction_308 -happyReduction_308 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut139 happy_x_2 of { (HappyWrap139 happy_var_2) -> - case happyOut142 happy_x_3 of { (HappyWrap142 happy_var_3) -> - case happyOut222 happy_x_4 of { (HappyWrap222 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut219 happy_x_6 of { (HappyWrap219 happy_var_6) -> - (runPV (unECP happy_var_4) >>= \ happy_var_4 -> - runPV (unECP happy_var_6) >>= \ happy_var_6 -> - amsA' (sLL happy_var_1 happy_var_6 $ HsRule - { rd_ext =(((fstOf3 happy_var_3) (epTok happy_var_5) (fst happy_var_2)), getSTRINGs happy_var_1) - , rd_name = L (noAnnSrcSpan $ gl happy_var_1) (getSTRING happy_var_1) - , rd_act = (snd happy_var_2) `orElse` AlwaysActive - , rd_tyvs = sndOf3 happy_var_3, rd_tmvs = thdOf3 happy_var_3 - , rd_lhs = happy_var_4, rd_rhs = happy_var_6 }))}}}}}}) - ) (\r -> happyReturn (happyIn138 r)) - -happyReduce_309 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_309 = happySpecReduce_0 123# happyReduction_309 -happyReduction_309 = happyIn139 - ((noAnn, Nothing) - ) - -happyReduce_310 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_310 = happySpecReduce_1 123# happyReduction_310 -happyReduction_310 happy_x_1 - = case happyOut141 happy_x_1 of { (HappyWrap141 happy_var_1) -> - happyIn139 - ((fst happy_var_1,Just (snd happy_var_1)) - )} - -happyReduce_311 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_311 = happySpecReduce_1 124# happyReduction_311 -happyReduction_311 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn140 - ((Just (epTok happy_var_1)) - )} - -happyReduce_312 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_312 = happyMonadReduce 1# 124# happyReduction_312 -happyReduction_312 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( if (getVARSYM happy_var_1 == fsLit "~") - then return (Just (epTok happy_var_1)) - else do { addError $ mkPlainErrorMsgEnvelope (getLoc happy_var_1) $ - PsErrInvalidRuleActivationMarker - ; return Nothing })}) - ) (\r -> happyReturn (happyIn140 r)) - -happyReduce_313 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_313 = happySpecReduce_3 125# happyReduction_313 -happyReduction_313 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn141 - (( ActivationAnn (epTok happy_var_1) (epTok happy_var_3) Nothing (Just (glR happy_var_2)) - , ActiveAfter (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2)))) - )}}} - -happyReduce_314 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_314 = happyReduce 4# 125# happyReduction_314 -happyReduction_314 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut140 happy_x_2 of { (HappyWrap140 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn141 - (( ActivationAnn (epTok happy_var_1) (epTok happy_var_4) happy_var_2 (Just (glR happy_var_3)) - , ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3)))) - ) `HappyStk` happyRest}}}} - -happyReduce_315 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_315 = happySpecReduce_3 125# happyReduction_315 -happyReduction_315 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut140 happy_x_2 of { (HappyWrap140 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn141 - (( ActivationAnn (epTok happy_var_1) (epTok happy_var_3) happy_var_2 Nothing - , NeverActive) - )}}} - -happyReduce_316 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_316 = happyMonadReduce 6# 126# happyReduction_316 -happyReduction_316 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut143 happy_x_2 of { (HappyWrap143 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut143 happy_x_5 of { (HappyWrap143 happy_var_5) -> - case happyOutTok happy_x_6 of { happy_var_6 -> - ( let tyvs = mkRuleTyVarBndrs happy_var_2 - in hintExplicitForall happy_var_1 - >> checkRuleTyVarBndrNames (mkRuleTyVarBndrs happy_var_2) - >> return (\an_eq an_act -> HsRuleAnn - (Just (epUniTok happy_var_1,epTok happy_var_3)) - (Just (epUniTok happy_var_4,epTok happy_var_6)) - an_eq an_act, - Just (mkRuleTyVarBndrs happy_var_2), mkRuleBndrs happy_var_5))}}}}}}) - ) (\r -> happyReturn (happyIn142 r)) - -happyReduce_317 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_317 = happySpecReduce_3 126# happyReduction_317 -happyReduction_317 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut143 happy_x_2 of { (HappyWrap143 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn142 - ((\an_eq an_act -> HsRuleAnn Nothing (Just (epUniTok happy_var_1,epTok happy_var_3)) an_eq an_act, - Nothing, mkRuleBndrs happy_var_2) - )}}} - -happyReduce_318 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_318 = happySpecReduce_0 126# happyReduction_318 -happyReduction_318 = happyIn142 - ((\an_eq an_act -> HsRuleAnn Nothing Nothing an_eq an_act, Nothing, []) - ) - -happyReduce_319 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_319 = happySpecReduce_2 127# happyReduction_319 -happyReduction_319 happy_x_2 - happy_x_1 - = case happyOut144 happy_x_1 of { (HappyWrap144 happy_var_1) -> - case happyOut143 happy_x_2 of { (HappyWrap143 happy_var_2) -> - happyIn143 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_320 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_320 = happySpecReduce_0 127# happyReduction_320 -happyReduction_320 = happyIn143 - ([] - ) - -happyReduce_321 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_321 = happySpecReduce_1 128# happyReduction_321 -happyReduction_321 happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - happyIn144 - (sL1a happy_var_1 (RuleTyTmVar noAnn happy_var_1 Nothing) - )} - -happyReduce_322 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_322 = happyMonadReduce 5# 128# happyReduction_322 -happyReduction_322 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut318 happy_x_2 of { (HappyWrap318 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut168 happy_x_4 of { (HappyWrap168 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( amsA' (sLL happy_var_1 happy_var_5 (RuleTyTmVar (AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3)) happy_var_2 (Just happy_var_4))))}}}}}) - ) (\r -> happyReturn (happyIn144 r)) - -happyReduce_323 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_323 = happyMonadReduce 3# 129# happyReduction_323 -happyReduction_323 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut152 happy_x_2 of { (HappyWrap152 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 $ DeprecatedTxt (getDEPRECATED_PRAGs happy_var_1) (map stringLiteralToHsDocWst $ snd $ unLoc happy_var_2)) - (AnnPragma (glR happy_var_1) (epTok happy_var_3) (fst $ unLoc happy_var_2) noAnn noAnn noAnn noAnn))}}}) - ) (\r -> happyReturn (happyIn145 r)) - -happyReduce_324 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_324 = happyMonadReduce 4# 129# happyReduction_324 -happyReduction_324 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut146 happy_x_2 of { (HappyWrap146 happy_var_2) -> - case happyOut152 happy_x_3 of { (HappyWrap152 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( fmap Just $ amsr (sLL happy_var_1 happy_var_4 $ WarningTxt happy_var_2 (getWARNING_PRAGs happy_var_1) (map stringLiteralToHsDocWst $ snd $ unLoc happy_var_3)) - (AnnPragma (glR happy_var_1) (epTok happy_var_4) (fst $ unLoc happy_var_3) noAnn noAnn noAnn noAnn))}}}}) - ) (\r -> happyReturn (happyIn145 r)) - -happyReduce_325 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_325 = happySpecReduce_0 129# happyReduction_325 -happyReduction_325 = happyIn145 - (Nothing - ) - -happyReduce_326 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_326 = happySpecReduce_2 130# happyReduction_326 -happyReduction_326 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn146 - (Just (reLoc $ sLL happy_var_1 happy_var_2 $ InWarningCategory (epTok happy_var_1) (getSTRINGs happy_var_2) - (reLoc $ sL1 happy_var_2 $ mkWarningCategory (getSTRING happy_var_2))) - )}} - -happyReduce_327 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_327 = happySpecReduce_0 130# happyReduction_327 -happyReduction_327 = happyIn146 - (Nothing - ) - -happyReduce_328 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_328 = happyMonadReduce 3# 131# happyReduction_328 -happyReduction_328 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut147 happy_x_1 of { (HappyWrap147 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut148 happy_x_3 of { (HappyWrap148 happy_var_3) -> - ( if isNilOL happy_var_1 - then return (happy_var_1 `appOL` happy_var_3) - else case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (snocOL hs t' `appOL` happy_var_3))}}}) - ) (\r -> happyReturn (happyIn147 r)) - -happyReduce_329 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_329 = happyMonadReduce 2# 131# happyReduction_329 -happyReduction_329 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut147 happy_x_1 of { (HappyWrap147 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( if isNilOL happy_var_1 - then return happy_var_1 - else case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (snocOL hs t'))}}) - ) (\r -> happyReturn (happyIn147 r)) - -happyReduce_330 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_330 = happySpecReduce_1 131# happyReduction_330 -happyReduction_330 happy_x_1 - = case happyOut148 happy_x_1 of { (HappyWrap148 happy_var_1) -> - happyIn147 - (happy_var_1 - )} - -happyReduce_331 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_331 = happySpecReduce_0 131# happyReduction_331 -happyReduction_331 = happyIn147 - (nilOL - ) - -happyReduce_332 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_332 = happyMonadReduce 4# 132# happyReduction_332 -happyReduction_332 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut146 happy_x_1 of { (HappyWrap146 happy_var_1) -> - case happyOut149 happy_x_2 of { (HappyWrap149 happy_var_2) -> - case happyOut282 happy_x_3 of { (HappyWrap282 happy_var_3) -> - case happyOut152 happy_x_4 of { (HappyWrap152 happy_var_4) -> - ( fmap unitOL $ amsA' (L (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) - (Warning (unLoc happy_var_2, fst $ unLoc happy_var_4) (unLoc happy_var_3) - (WarningTxt happy_var_1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc happy_var_4))))}}}}) - ) (\r -> happyReturn (happyIn148 r)) - -happyReduce_333 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_333 = happySpecReduce_1 133# happyReduction_333 -happyReduction_333 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn149 - (sL1 happy_var_1 $ TypeNamespaceSpecifier (epTok happy_var_1) - )} - -happyReduce_334 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_334 = happySpecReduce_1 133# happyReduction_334 -happyReduction_334 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn149 - (sL1 happy_var_1 $ DataNamespaceSpecifier (epTok happy_var_1) - )} - -happyReduce_335 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_335 = happySpecReduce_0 133# happyReduction_335 -happyReduction_335 = happyIn149 - (sL0 $ NoNamespaceSpecifier - ) - -happyReduce_336 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_336 = happyMonadReduce 3# 134# happyReduction_336 -happyReduction_336 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut150 happy_x_1 of { (HappyWrap150 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut151 happy_x_3 of { (HappyWrap151 happy_var_3) -> - ( if isNilOL happy_var_1 - then return (happy_var_1 `appOL` happy_var_3) - else case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (snocOL hs t' `appOL` happy_var_3))}}}) - ) (\r -> happyReturn (happyIn150 r)) - -happyReduce_337 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_337 = happyMonadReduce 2# 134# happyReduction_337 -happyReduction_337 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut150 happy_x_1 of { (HappyWrap150 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( if isNilOL happy_var_1 - then return happy_var_1 - else case happy_var_1 of - SnocOL hs t -> do - t' <- addTrailingSemiA t (epTok happy_var_2) - return (snocOL hs t'))}}) - ) (\r -> happyReturn (happyIn150 r)) - -happyReduce_338 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_338 = happySpecReduce_1 134# happyReduction_338 -happyReduction_338 happy_x_1 - = case happyOut151 happy_x_1 of { (HappyWrap151 happy_var_1) -> - happyIn150 - (happy_var_1 - )} - -happyReduce_339 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_339 = happySpecReduce_0 134# happyReduction_339 -happyReduction_339 = happyIn150 - (nilOL - ) - -happyReduce_340 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_340 = happyMonadReduce 3# 135# happyReduction_340 -happyReduction_340 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut149 happy_x_1 of { (HappyWrap149 happy_var_1) -> - case happyOut282 happy_x_2 of { (HappyWrap282 happy_var_2) -> - case happyOut152 happy_x_3 of { (HappyWrap152 happy_var_3) -> - ( fmap unitOL $ amsA' (sL (comb3 happy_var_1 happy_var_2 happy_var_3) $ (Warning (unLoc happy_var_1, fst $ unLoc happy_var_3) (unLoc happy_var_2) - (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc happy_var_3))))}}}) - ) (\r -> happyReturn (happyIn151 r)) - -happyReduce_341 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_341 = happySpecReduce_1 136# happyReduction_341 -happyReduction_341 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn152 - (sL1 happy_var_1 (noAnn,[L (gl happy_var_1) (getStringLiteral happy_var_1)]) - )} - -happyReduce_342 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_342 = happySpecReduce_3 136# happyReduction_342 -happyReduction_342 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut153 happy_x_2 of { (HappyWrap153 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn152 - (sLL happy_var_1 happy_var_3 $ ((epTok happy_var_1,epTok happy_var_3),fromOL (unLoc happy_var_2)) - )}}} - -happyReduce_343 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_343 = happyMonadReduce 3# 137# happyReduction_343 -happyReduction_343 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut153 happy_x_1 of { (HappyWrap153 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( if isNilOL (unLoc happy_var_1) - then return (sLL happy_var_1 happy_var_3 (unLoc happy_var_1 `snocOL` - (L (gl happy_var_3) (getStringLiteral happy_var_3)))) - else case (unLoc happy_var_1) of - SnocOL hs t -> do - let { t' = addTrailingCommaS t (glR happy_var_2) } - return (sLL happy_var_1 happy_var_3 (snocOL hs t' `snocOL` - (L (gl happy_var_3) (getStringLiteral happy_var_3)))))}}}) - ) (\r -> happyReturn (happyIn153 r)) - -happyReduce_344 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_344 = happySpecReduce_1 137# happyReduction_344 -happyReduction_344 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn153 - (sLL happy_var_1 happy_var_1 (unitOL (L (gl happy_var_1) (getStringLiteral happy_var_1))) - )} - -happyReduce_345 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_345 = happySpecReduce_0 137# happyReduction_345 -happyReduction_345 = happyIn153 - (noLoc nilOL - ) - -happyReduce_346 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_346 = happyMonadReduce 4# 138# happyReduction_346 -happyReduction_346 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut283 happy_x_2 of { (HappyWrap283 happy_var_2) -> - case happyOut228 happy_x_3 of { (HappyWrap228 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> - amsA' (sLL happy_var_1 happy_var_4 (AnnD noExtField $ HsAnnotation - (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn noAnn noAnn noAnn noAnn, - (getANN_PRAGs happy_var_1)) - (ValueAnnProvenance happy_var_2) happy_var_3)))}}}}) - ) (\r -> happyReturn (happyIn154 r)) - -happyReduce_347 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_347 = happyMonadReduce 5# 138# happyReduction_347 -happyReduction_347 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut303 happy_x_3 of { (HappyWrap303 happy_var_3) -> - case happyOut228 happy_x_4 of { (HappyWrap228 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> - amsA' (sLL happy_var_1 happy_var_5 (AnnD noExtField $ HsAnnotation - (AnnPragma (glR happy_var_1) (epTok happy_var_5) noAnn noAnn noAnn (epTok happy_var_2) noAnn, - (getANN_PRAGs happy_var_1)) - (TypeAnnProvenance happy_var_3) happy_var_4)))}}}}}) - ) (\r -> happyReturn (happyIn154 r)) - -happyReduce_348 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_348 = happyMonadReduce 4# 138# happyReduction_348 -happyReduction_348 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut228 happy_x_3 of { (HappyWrap228 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> - amsA' (sLL happy_var_1 happy_var_4 (AnnD noExtField $ HsAnnotation - (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn noAnn noAnn noAnn (epTok happy_var_2), - (getANN_PRAGs happy_var_1)) - ModuleAnnProvenance happy_var_3)))}}}}) - ) (\r -> happyReturn (happyIn154 r)) - -happyReduce_349 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_349 = happyMonadReduce 4# 139# happyReduction_349 -happyReduction_349 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut156 happy_x_2 of { (HappyWrap156 happy_var_2) -> - case happyOut157 happy_x_3 of { (HappyWrap157 happy_var_3) -> - case happyOut158 happy_x_4 of { (HappyWrap158 happy_var_4) -> - ( mkImport happy_var_2 happy_var_3 (snd $ unLoc happy_var_4) (epTok happy_var_1, fst $ unLoc happy_var_4) >>= \i -> - return (sLL happy_var_1 happy_var_4 i))}}}}) - ) (\r -> happyReturn (happyIn155 r)) - -happyReduce_350 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_350 = happyMonadReduce 3# 139# happyReduction_350 -happyReduction_350 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut156 happy_x_2 of { (HappyWrap156 happy_var_2) -> - case happyOut158 happy_x_3 of { (HappyWrap158 happy_var_3) -> - ( do { d <- mkImport happy_var_2 (noLoc PlaySafe) (snd $ unLoc happy_var_3) (epTok happy_var_1, fst $ unLoc happy_var_3); - return (sLL happy_var_1 happy_var_3 d) })}}}) - ) (\r -> happyReturn (happyIn155 r)) - -happyReduce_351 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_351 = happyMonadReduce 3# 139# happyReduction_351 -happyReduction_351 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut156 happy_x_2 of { (HappyWrap156 happy_var_2) -> - case happyOut158 happy_x_3 of { (HappyWrap158 happy_var_3) -> - ( mkExport happy_var_2 (snd $ unLoc happy_var_3) (epTok happy_var_1, fst $ unLoc happy_var_3) >>= \i -> - return (sLL happy_var_1 happy_var_3 i ))}}}) - ) (\r -> happyReturn (happyIn155 r)) - -happyReduce_352 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_352 = happySpecReduce_1 140# happyReduction_352 -happyReduction_352 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn156 - (sLL happy_var_1 happy_var_1 StdCallConv - )} - -happyReduce_353 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_353 = happySpecReduce_1 140# happyReduction_353 -happyReduction_353 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn156 - (sLL happy_var_1 happy_var_1 CCallConv - )} - -happyReduce_354 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_354 = happySpecReduce_1 140# happyReduction_354 -happyReduction_354 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn156 - (sLL happy_var_1 happy_var_1 CApiConv - )} - -happyReduce_355 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_355 = happySpecReduce_1 140# happyReduction_355 -happyReduction_355 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn156 - (sLL happy_var_1 happy_var_1 PrimCallConv - )} - -happyReduce_356 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_356 = happySpecReduce_1 140# happyReduction_356 -happyReduction_356 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn156 - (sLL happy_var_1 happy_var_1 JavaScriptCallConv - )} - -happyReduce_357 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_357 = happySpecReduce_1 141# happyReduction_357 -happyReduction_357 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn157 - (sLL happy_var_1 happy_var_1 PlayRisky - )} - -happyReduce_358 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_358 = happySpecReduce_1 141# happyReduction_358 -happyReduction_358 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn157 - (sLL happy_var_1 happy_var_1 PlaySafe - )} - -happyReduce_359 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_359 = happySpecReduce_1 141# happyReduction_359 -happyReduction_359 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn157 - (sLL happy_var_1 happy_var_1 PlayInterruptible - )} - -happyReduce_360 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_360 = happyReduce 4# 142# happyReduction_360 -happyReduction_360 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut314 happy_x_2 of { (HappyWrap314 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut162 happy_x_4 of { (HappyWrap162 happy_var_4) -> - happyIn158 - (sLL happy_var_1 happy_var_4 (epUniTok happy_var_3 - ,(L (getLoc happy_var_1) - (getStringLiteral happy_var_1), happy_var_2, happy_var_4)) - ) `HappyStk` happyRest}}}} - -happyReduce_361 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_361 = happySpecReduce_3 142# happyReduction_361 -happyReduction_361 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut162 happy_x_3 of { (HappyWrap162 happy_var_3) -> - happyIn158 - (sLL happy_var_1 happy_var_3 (epUniTok happy_var_2 - ,(noLoc (StringLiteral NoSourceText nilFS Nothing), happy_var_1, happy_var_3)) - )}}} - -happyReduce_362 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_362 = happySpecReduce_0 143# happyReduction_362 -happyReduction_362 = happyIn159 - (Nothing - ) - -happyReduce_363 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_363 = happySpecReduce_2 143# happyReduction_363 -happyReduction_363 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> - happyIn159 - (Just (epUniTok happy_var_1, happy_var_2) - )}} - -happyReduce_364 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_364 = happySpecReduce_0 144# happyReduction_364 -happyReduction_364 = happyIn160 - ((Nothing, Nothing) - ) - -happyReduce_365 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_365 = happySpecReduce_2 144# happyReduction_365 -happyReduction_365 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut294 happy_x_2 of { (HappyWrap294 happy_var_2) -> - happyIn160 - ((Just (epUniTok happy_var_1), Just happy_var_2) - )}} - -happyReduce_366 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_366 = happySpecReduce_1 145# happyReduction_366 -happyReduction_366 happy_x_1 - = case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> - happyIn161 - (happy_var_1 - )} - -happyReduce_367 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_367 = happyMonadReduce 3# 145# happyReduction_367 -happyReduction_367 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut193 happy_x_3 of { (HappyWrap193 happy_var_3) -> - ( amsA' (sLL happy_var_1 happy_var_3 $ mkHsImplicitSigType $ - sLLa happy_var_1 happy_var_3 $ HsKindSig (epUniTok happy_var_2) happy_var_1 happy_var_3))}}}) - ) (\r -> happyReturn (happyIn161 r)) - -happyReduce_368 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_368 = happySpecReduce_1 146# happyReduction_368 -happyReduction_368 happy_x_1 - = case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> - happyIn162 - (hsTypeToHsSigType happy_var_1 - )} - -happyReduce_369 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_369 = happyMonadReduce 3# 147# happyReduction_369 -happyReduction_369 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut314 happy_x_3 of { (HappyWrap314 happy_var_3) -> - ( case unLoc happy_var_1 of - [] -> return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1)) - (h:t) -> do - h' <- addTrailingCommaN h (gl happy_var_2) - return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) - ) (\r -> happyReturn (happyIn163 r)) - -happyReduce_370 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_370 = happySpecReduce_1 147# happyReduction_370 -happyReduction_370 happy_x_1 - = case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - happyIn163 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_371 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_371 = happySpecReduce_1 148# happyReduction_371 -happyReduction_371 happy_x_1 - = case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> - happyIn164 - (unitOL happy_var_1 - )} - -happyReduce_372 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_372 = happyMonadReduce 3# 148# happyReduction_372 -happyReduction_372 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut164 happy_x_3 of { (HappyWrap164 happy_var_3) -> - ( do { st <- addTrailingCommaA happy_var_1 (epTok happy_var_2) - ; return $ unitOL st `appOL` happy_var_3 })}}}) - ) (\r -> happyReturn (happyIn164 r)) - -happyReduce_373 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_373 = happySpecReduce_2 149# happyReduction_373 -happyReduction_373 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn165 - (sLL happy_var_1 happy_var_2 (UnpackednessPragma (glR happy_var_1, epTok happy_var_2) (getUNPACK_PRAGs happy_var_1) SrcUnpack) - )}} - -happyReduce_374 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_374 = happySpecReduce_2 149# happyReduction_374 -happyReduction_374 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn165 - (sLL happy_var_1 happy_var_2 (UnpackednessPragma (glR happy_var_1, epTok happy_var_2) (getNOUNPACK_PRAGs happy_var_1) SrcNoUnpack) - )}} - -happyReduce_375 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_375 = happyMonadReduce 3# 150# happyReduction_375 -happyReduction_375 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { hintExplicitForall happy_var_1 - ; acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ - mkHsForAllInvisTele (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1,epTok happy_var_3) cs) happy_var_2 )) })}}}) - ) (\r -> happyReturn (happyIn166 r)) - -happyReduce_376 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_376 = happyMonadReduce 3# 150# happyReduction_376 -happyReduction_376 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { hintExplicitForall happy_var_1 - ; req_tvbs <- fromSpecTyVarBndrs happy_var_2 - ; acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ - mkHsForAllVisTele (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1,epUniTok happy_var_3) cs) req_tvbs )) })}}}) - ) (\r -> happyReturn (happyIn166 r)) - -happyReduce_377 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_377 = happySpecReduce_1 151# happyReduction_377 -happyReduction_377 happy_x_1 - = case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> - happyIn167 - (happy_var_1 - )} - -happyReduce_378 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_378 = happyMonadReduce 3# 151# happyReduction_378 -happyReduction_378 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut193 happy_x_3 of { (HappyWrap193 happy_var_3) -> - ( amsA' (sLL happy_var_1 happy_var_3 $ HsKindSig (epUniTok happy_var_2) happy_var_1 happy_var_3))}}}) - ) (\r -> happyReturn (happyIn167 r)) - -happyReduce_379 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_379 = happySpecReduce_2 152# happyReduction_379 -happyReduction_379 happy_x_2 - happy_x_1 - = case happyOut166 happy_x_1 of { (HappyWrap166 happy_var_1) -> - case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> - happyIn168 - (sLLa happy_var_1 happy_var_2 $ - HsForAllTy { hst_tele = unLoc happy_var_1 - , hst_xforall = noExtField - , hst_body = happy_var_2 } - )}} - -happyReduce_380 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_380 = happyMonadReduce 3# 152# happyReduction_380 -happyReduction_380 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - ( acsA (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ - HsQualTy { hst_ctxt = addTrailingDarrowC happy_var_1 happy_var_2 cs - , hst_xqual = NoExtField - , hst_body = happy_var_3 })))}}}) - ) (\r -> happyReturn (happyIn168 r)) - -happyReduce_381 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_381 = happyMonadReduce 3# 152# happyReduction_381 -happyReduction_381 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut275 happy_x_1 of { (HappyWrap275 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - ( amsA' (sLL happy_var_1 happy_var_3 (HsIParamTy (epUniTok happy_var_2) (reLoc happy_var_1) happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn168 r)) - -happyReduce_382 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_382 = happySpecReduce_1 152# happyReduction_382 -happyReduction_382 happy_x_1 - = case happyOut171 happy_x_1 of { (HappyWrap171 happy_var_1) -> - happyIn168 - (happy_var_1 - )} - -happyReduce_383 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_383 = happyMonadReduce 1# 153# happyReduction_383 -happyReduction_383 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut174 happy_x_1 of { (HappyWrap174 happy_var_1) -> - ( checkContext happy_var_1)}) - ) (\r -> happyReturn (happyIn169 r)) - -happyReduce_384 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_384 = happySpecReduce_1 154# happyReduction_384 -happyReduction_384 happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - happyIn170 - (unECP happy_var_1 >>= \ happy_var_1 -> - checkContextPV happy_var_1 - )} - -happyReduce_385 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_385 = happySpecReduce_1 155# happyReduction_385 -happyReduction_385 happy_x_1 - = case happyOut174 happy_x_1 of { (HappyWrap174 happy_var_1) -> - happyIn171 - (happy_var_1 - )} - -happyReduce_386 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_386 = happyMonadReduce 3# 155# happyReduction_386 -happyReduction_386 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut174 happy_x_1 of { (HappyWrap174 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - ( amsA' (sLL happy_var_1 happy_var_3 - $ HsFunTy noExtField (HsUnrestrictedArrow (epUniTok happy_var_2)) happy_var_1 happy_var_3))}}}) - ) (\r -> happyReturn (happyIn171 r)) - -happyReduce_387 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_387 = happyMonadReduce 4# 155# happyReduction_387 -happyReduction_387 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut174 happy_x_1 of { (HappyWrap174 happy_var_1) -> - case happyOut172 happy_x_2 of { (HappyWrap172 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut168 happy_x_4 of { (HappyWrap168 happy_var_4) -> - ( hintLinear (getLoc happy_var_2) - >> let arr = (unLoc happy_var_2) (epUniTok happy_var_3) - in amsA' (sLL happy_var_1 happy_var_4 $ HsFunTy noExtField arr happy_var_1 happy_var_4))}}}}) - ) (\r -> happyReturn (happyIn171 r)) - -happyReduce_388 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_388 = happyMonadReduce 3# 155# happyReduction_388 -happyReduction_388 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut174 happy_x_1 of { (HappyWrap174 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - ( hintLinear (getLoc happy_var_2) >> - amsA' (sLL happy_var_1 happy_var_3 $ HsFunTy noExtField (HsLinearArrow (EpLolly (epTok happy_var_2))) happy_var_1 happy_var_3))}}}) - ) (\r -> happyReturn (happyIn171 r)) - -happyReduce_389 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_389 = happySpecReduce_2 156# happyReduction_389 -happyReduction_389 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - happyIn172 - (sLL happy_var_1 happy_var_2 (mkMultTy (epTok happy_var_1) happy_var_2) - )}} - -happyReduce_390 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_390 = happySpecReduce_2 157# happyReduction_390 -happyReduction_390 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - happyIn173 - (unECP happy_var_2 >>= \ happy_var_2 -> - fmap (sLL happy_var_1 happy_var_2) (mkHsMultPV (epTok happy_var_1) happy_var_2) - )}} - -happyReduce_391 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_391 = happyMonadReduce 1# 158# happyReduction_391 -happyReduction_391 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> - ( runPV happy_var_1)}) - ) (\r -> happyReturn (happyIn174 r)) - -happyReduce_392 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_392 = happySpecReduce_1 159# happyReduction_392 -happyReduction_392 happy_x_1 - = case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> - happyIn175 - (happy_var_1 - )} - -happyReduce_393 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_393 = happySpecReduce_3 159# happyReduction_393 -happyReduction_393 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> - case happyOut178 happy_x_2 of { (HappyWrap178 happy_var_2) -> - case happyOut175 happy_x_3 of { (HappyWrap175 happy_var_3) -> - happyIn175 - (happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ happy_var_3 -> - do { let (op, prom) = happy_var_2 - ; when (looksLikeMult happy_var_1 op happy_var_3) $ hintLinear (getLocA op) - ; mkHsOpTyPV prom happy_var_1 op happy_var_3 } - )}}} - -happyReduce_394 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_394 = happySpecReduce_2 159# happyReduction_394 -happyReduction_394 happy_x_2 - happy_x_1 - = case happyOut165 happy_x_1 of { (HappyWrap165 happy_var_1) -> - case happyOut175 happy_x_2 of { (HappyWrap175 happy_var_2) -> - happyIn175 - (happy_var_2 >>= \ happy_var_2 -> - mkUnpackednessPV happy_var_1 happy_var_2 - )}} - -happyReduce_395 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_395 = happySpecReduce_1 160# happyReduction_395 -happyReduction_395 happy_x_1 - = case happyOut179 happy_x_1 of { (HappyWrap179 happy_var_1) -> - happyIn176 - (mkHsAppTyHeadPV happy_var_1 - )} - -happyReduce_396 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_396 = happySpecReduce_1 160# happyReduction_396 -happyReduction_396 happy_x_1 - = case happyOut178 happy_x_1 of { (HappyWrap178 happy_var_1) -> - happyIn176 - (failOpFewArgs (fst happy_var_1) - )} - -happyReduce_397 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_397 = happySpecReduce_2 160# happyReduction_397 -happyReduction_397 happy_x_2 - happy_x_1 - = case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> - case happyOut177 happy_x_2 of { (HappyWrap177 happy_var_2) -> - happyIn176 - (happy_var_1 >>= \ happy_var_1 -> - mkHsAppTyPV happy_var_1 happy_var_2 - )}} - -happyReduce_398 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_398 = happySpecReduce_3 160# happyReduction_398 -happyReduction_398 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut179 happy_x_3 of { (HappyWrap179 happy_var_3) -> - happyIn176 - (happy_var_1 >>= \ happy_var_1 -> - mkHsAppKindTyPV happy_var_1 (epTok happy_var_2) happy_var_3 - )}}} - -happyReduce_399 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_399 = happySpecReduce_1 161# happyReduction_399 -happyReduction_399 happy_x_1 - = case happyOut179 happy_x_1 of { (HappyWrap179 happy_var_1) -> - happyIn177 - (happy_var_1 - )} - -happyReduce_400 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_400 = happyMonadReduce 2# 161# happyReduction_400 -happyReduction_400 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut165 happy_x_1 of { (HappyWrap165 happy_var_1) -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - ( addUnpackednessP happy_var_1 happy_var_2)}}) - ) (\r -> happyReturn (happyIn177 r)) - -happyReduce_401 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_401 = happySpecReduce_1 162# happyReduction_401 -happyReduction_401 happy_x_1 - = case happyOut298 happy_x_1 of { (HappyWrap298 happy_var_1) -> - happyIn178 - ((happy_var_1, NotPromoted) - )} - -happyReduce_402 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_402 = happySpecReduce_1 162# happyReduction_402 -happyReduction_402 happy_x_1 - = case happyOut312 happy_x_1 of { (HappyWrap312 happy_var_1) -> - happyIn178 - ((happy_var_1, NotPromoted) - )} - -happyReduce_403 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_403 = happyMonadReduce 2# 162# happyReduction_403 -happyReduction_403 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut293 happy_x_2 of { (HappyWrap293 happy_var_2) -> - ( do { op <- amsr (sLL happy_var_1 happy_var_2 (unLoc happy_var_2)) - (NameAnnQuote (epTok happy_var_1) (gl happy_var_2) []) - ; return (op, IsPromoted) })}}) - ) (\r -> happyReturn (happyIn178 r)) - -happyReduce_404 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_404 = happyMonadReduce 2# 162# happyReduction_404 -happyReduction_404 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut305 happy_x_2 of { (HappyWrap305 happy_var_2) -> - ( do { op <- amsr (sLL happy_var_1 happy_var_2 (unLoc happy_var_2)) - (NameAnnQuote (epTok happy_var_1) (gl happy_var_2) []) - ; return (op, IsPromoted) })}}) - ) (\r -> happyReturn (happyIn178 r)) - -happyReduce_405 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_405 = happyMonadReduce 1# 163# happyReduction_405 -happyReduction_405 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut295 happy_x_1 of { (HappyWrap295 happy_var_1) -> - ( amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted happy_var_1)))}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_406 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_406 = happyMonadReduce 1# 163# happyReduction_406 -happyReduction_406 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut311 happy_x_1 of { (HappyWrap311 happy_var_1) -> - ( amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted happy_var_1)))}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_407 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_407 = happySpecReduce_1 163# happyReduction_407 -happyReduction_407 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn179 - (sL1a happy_var_1 $ mkAnonWildCardTy (epTok happy_var_1) - )} - -happyReduce_408 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_408 = happyMonadReduce 1# 163# happyReduction_408 -happyReduction_408 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( do { warnStarIsType (getLoc happy_var_1) - ; return $ sL1a happy_var_1 (HsStarTy noExtField (isUnicode happy_var_1)) })}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_409 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_409 = happyMonadReduce 2# 163# happyReduction_409 -happyReduction_409 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 (mkBangTy (glR happy_var_1) SrcLazy happy_var_2)))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_410 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_410 = happyMonadReduce 2# 163# happyReduction_410 -happyReduction_410 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 (mkBangTy (glR happy_var_1) SrcStrict happy_var_2)))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_411 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_411 = happyMonadReduce 3# 163# happyReduction_411 -happyReduction_411 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut203 happy_x_2 of { (HappyWrap203 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { decls <- amsA' (sLL happy_var_1 happy_var_3 $ HsRecTy (AnnList (listAsAnchorM happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []) happy_var_2) - ; checkRecordSyntax decls })}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_412 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_412 = happyMonadReduce 2# 163# happyReduction_412 -happyReduction_412 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsA' . sLL happy_var_1 happy_var_2 =<< (mkTupleSyntaxTy (epTok happy_var_1) [] (epTok happy_var_2)))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_413 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_413 = happyMonadReduce 5# 163# happyReduction_413 -happyReduction_413 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut183 happy_x_4 of { (HappyWrap183 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( do { h <- addTrailingCommaA happy_var_2 (epTok happy_var_3) - ; amsA' . sLL happy_var_1 happy_var_5 =<< (mkTupleSyntaxTy (epTok happy_var_1) (h : happy_var_4) (epTok happy_var_5)) })}}}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_414 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_414 = happyMonadReduce 2# 163# happyReduction_414 -happyReduction_414 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( do { requireLTPuns PEP_TupleSyntaxType happy_var_1 happy_var_2 - ; amsA' (sLL happy_var_1 happy_var_2 $ HsTupleTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_2)) HsUnboxedTuple []) })}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_415 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_415 = happyMonadReduce 3# 163# happyReduction_415 -happyReduction_415 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut183 happy_x_2 of { (HappyWrap183 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { requireLTPuns PEP_TupleSyntaxType happy_var_1 happy_var_3 - ; amsA' (sLL happy_var_1 happy_var_3 $ HsTupleTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_3)) HsUnboxedTuple happy_var_2) })}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_416 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_416 = happyMonadReduce 3# 163# happyReduction_416 -happyReduction_416 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut184 happy_x_2 of { (HappyWrap184 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { requireLTPuns PEP_SumSyntaxType happy_var_1 happy_var_3 - ; amsA' (sLL happy_var_1 happy_var_3 $ HsSumTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_3)) happy_var_2) })}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_417 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_417 = happyMonadReduce 3# 163# happyReduction_417 -happyReduction_417 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' . sLL happy_var_1 happy_var_3 =<< (mkListSyntaxTy1 (epTok happy_var_1) happy_var_2 (epTok happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_418 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_418 = happyMonadReduce 3# 163# happyReduction_418 -happyReduction_418 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ HsParTy (epTok happy_var_1, epTok happy_var_3) happy_var_2))}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_419 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_419 = happyMonadReduce 3# 163# happyReduction_419 -happyReduction_419 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_3 - ; amsA' (sLL happy_var_1 happy_var_3 $ HsExplicitTupleTy (epTok happy_var_1,epTok happy_var_2,epTok happy_var_3) IsPromoted []) })}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_420 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_420 = happyMonadReduce 2# 163# happyReduction_420 -happyReduction_420 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut285 happy_x_2 of { (HappyWrap285 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted happy_var_2))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_421 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_421 = happyMonadReduce 2# 163# happyReduction_421 -happyReduction_421 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut289 happy_x_2 of { (HappyWrap289 happy_var_2) -> - ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 (reLoc happy_var_2) - ; amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted (L (getLoc happy_var_2) $ nameRdrName (dataConName (unLoc happy_var_2)))) })}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_422 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_422 = happyMonadReduce 6# 163# happyReduction_422 -happyReduction_422 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut167 happy_x_3 of { (HappyWrap167 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut183 happy_x_5 of { (HappyWrap183 happy_var_5) -> - case happyOutTok happy_x_6 of { happy_var_6 -> - ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_6 - ; h <- addTrailingCommaA happy_var_3 (epTok happy_var_4) - ; amsA' (sLL happy_var_1 happy_var_6 $ HsExplicitTupleTy (epTok happy_var_1,epTok happy_var_2,epTok happy_var_6) IsPromoted (h : happy_var_5)) })}}}}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_423 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_423 = happyMonadReduce 2# 163# happyReduction_423 -happyReduction_423 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( withCombinedComments happy_var_1 happy_var_2 (mkListSyntaxTy0 (epTok happy_var_1) (epTok happy_var_2)))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_424 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_424 = happyMonadReduce 4# 163# happyReduction_424 -happyReduction_424 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut182 happy_x_3 of { (HappyWrap182 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_4 - ; amsA' (sLL happy_var_1 happy_var_4 $ HsExplicitListTy (epTok happy_var_1, epTok happy_var_2, epTok happy_var_4) IsPromoted happy_var_3) })}}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_425 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_425 = happyMonadReduce 2# 163# happyReduction_425 -happyReduction_425 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut314 happy_x_2 of { (HappyWrap314 happy_var_2) -> - ( amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted happy_var_2))}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_426 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_426 = happySpecReduce_1 163# happyReduction_426 -happyReduction_426 happy_x_1 - = case happyOut218 happy_x_1 of { (HappyWrap218 happy_var_1) -> - happyIn179 - (mapLocA (HsSpliceTy noExtField) happy_var_1 - )} - -happyReduce_427 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_427 = happySpecReduce_1 163# happyReduction_427 -happyReduction_427 happy_x_1 - = case happyOut233 happy_x_1 of { (HappyWrap233 happy_var_1) -> - happyIn179 - (mapLocA (HsSpliceTy noExtField) happy_var_1 - )} - -happyReduce_428 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_428 = happyMonadReduce 5# 163# happyReduction_428 -happyReduction_428 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut183 happy_x_4 of { (HappyWrap183 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( do { h <- addTrailingCommaA happy_var_2 (epTok happy_var_3) - ; amsA' (sLL happy_var_1 happy_var_5 $ HsExplicitListTy (NoEpTok,epTok happy_var_1,epTok happy_var_5) NotPromoted (h:happy_var_4)) })}}}}}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_429 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_429 = happySpecReduce_1 163# happyReduction_429 -happyReduction_429 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn179 - (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsNumTy (getINTEGERs happy_var_1) - (il_value (getINTEGER happy_var_1)) - )} - -happyReduce_430 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_430 = happySpecReduce_1 163# happyReduction_430 -happyReduction_430 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn179 - (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsCharTy (getCHARs happy_var_1) - (getCHAR happy_var_1) - )} - -happyReduce_431 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_431 = happySpecReduce_1 163# happyReduction_431 -happyReduction_431 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn179 - (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsStrTy (getSTRINGs happy_var_1) - (getSTRING happy_var_1) - )} - -happyReduce_432 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_432 = happySpecReduce_1 163# happyReduction_432 -happyReduction_432 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn179 - (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsStrTy (getSTRINGMULTIs happy_var_1) - (getSTRINGMULTI happy_var_1) - )} - -happyReduce_433 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_433 = happyMonadReduce 1# 163# happyReduction_433 -happyReduction_433 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( let qname = mkQual tvName (getQVARID happy_var_1) - in amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted (sL1n happy_var_1 $ qname))))}) - ) (\r -> happyReturn (happyIn179 r)) - -happyReduce_434 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_434 = happySpecReduce_1 164# happyReduction_434 -happyReduction_434 happy_x_1 - = case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> - happyIn180 - (happy_var_1 - )} - -happyReduce_435 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_435 = happySpecReduce_1 165# happyReduction_435 -happyReduction_435 happy_x_1 - = case happyOut161 happy_x_1 of { (HappyWrap161 happy_var_1) -> - happyIn181 - ([happy_var_1] - )} - -happyReduce_436 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_436 = happyMonadReduce 3# 165# happyReduction_436 -happyReduction_436 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut161 happy_x_1 of { (HappyWrap161 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut181 happy_x_3 of { (HappyWrap181 happy_var_3) -> - ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn181 r)) - -happyReduce_437 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_437 = happySpecReduce_1 166# happyReduction_437 -happyReduction_437 happy_x_1 - = case happyOut183 happy_x_1 of { (HappyWrap183 happy_var_1) -> - happyIn182 - (happy_var_1 - )} - -happyReduce_438 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_438 = happySpecReduce_0 166# happyReduction_438 -happyReduction_438 = happyIn182 - ([] - ) - -happyReduce_439 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_439 = happySpecReduce_1 167# happyReduction_439 -happyReduction_439 happy_x_1 - = case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> - happyIn183 - ([happy_var_1] - )} - -happyReduce_440 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_440 = happyMonadReduce 3# 167# happyReduction_440 -happyReduction_440 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut183 happy_x_3 of { (HappyWrap183 happy_var_3) -> - ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn183 r)) - -happyReduce_441 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_441 = happyMonadReduce 3# 168# happyReduction_441 -happyReduction_441 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut167 happy_x_3 of { (HappyWrap167 happy_var_3) -> - ( do { h <- addTrailingVbarA happy_var_1 (epTok happy_var_2) - ; return [h,happy_var_3] })}}}) - ) (\r -> happyReturn (happyIn184 r)) - -happyReduce_442 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_442 = happyMonadReduce 3# 168# happyReduction_442 -happyReduction_442 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut184 happy_x_3 of { (HappyWrap184 happy_var_3) -> - ( do { h <- addTrailingVbarA happy_var_1 (epTok happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn184 r)) - -happyReduce_443 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_443 = happySpecReduce_2 169# happyReduction_443 -happyReduction_443 happy_x_2 - happy_x_1 - = case happyOut186 happy_x_1 of { (HappyWrap186 happy_var_1) -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - happyIn185 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_444 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_444 = happySpecReduce_0 169# happyReduction_444 -happyReduction_444 = happyIn185 - ([] - ) - -happyReduce_445 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_445 = happySpecReduce_1 170# happyReduction_445 -happyReduction_445 happy_x_1 - = case happyOut187 happy_x_1 of { (HappyWrap187 happy_var_1) -> - happyIn186 - (happy_var_1 - )} - -happyReduce_446 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_446 = happyMonadReduce 3# 170# happyReduction_446 -happyReduction_446 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut311 happy_x_2 of { (HappyWrap311 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 - (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_3] noAnn noAnn - , tvb_flag = InferredSpec - , tvb_var = HsBndrVar noExtField happy_var_2 - , tvb_kind = HsBndrNoKind noExtField })))}}}) - ) (\r -> happyReturn (happyIn186 r)) - -happyReduce_447 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_447 = happyMonadReduce 5# 170# happyReduction_447 -happyReduction_447 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut311 happy_x_2 of { (HappyWrap311 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut193 happy_x_4 of { (HappyWrap193 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( amsA' (sLL happy_var_1 happy_var_5 - (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3) - , tvb_flag = InferredSpec - , tvb_var = HsBndrVar noExtField happy_var_2 - , tvb_kind = HsBndrKind noExtField happy_var_4 })))}}}}}) - ) (\r -> happyReturn (happyIn186 r)) - -happyReduce_448 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_448 = happyMonadReduce 1# 171# happyReduction_448 -happyReduction_448 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut188 happy_x_1 of { (HappyWrap188 happy_var_1) -> - ( amsA' (sL1 happy_var_1 - (HsTvb { tvb_ext = noAnn - , tvb_flag = SpecifiedSpec - , tvb_var = unLoc happy_var_1 - , tvb_kind = HsBndrNoKind noExtField })))}) - ) (\r -> happyReturn (happyIn187 r)) - -happyReduce_449 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_449 = happyMonadReduce 5# 171# happyReduction_449 -happyReduction_449 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut188 happy_x_2 of { (HappyWrap188 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut193 happy_x_4 of { (HappyWrap193 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - ( amsA' (sLL happy_var_1 happy_var_5 - (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3) - , tvb_flag = SpecifiedSpec - , tvb_var = unLoc happy_var_2 - , tvb_kind = HsBndrKind noExtField happy_var_4 })))}}}}}) - ) (\r -> happyReturn (happyIn187 r)) - -happyReduce_450 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_450 = happySpecReduce_1 172# happyReduction_450 -happyReduction_450 happy_x_1 - = case happyOut311 happy_x_1 of { (HappyWrap311 happy_var_1) -> - happyIn188 - (sL1 happy_var_1 (HsBndrVar noExtField happy_var_1) - )} - -happyReduce_451 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_451 = happySpecReduce_1 172# happyReduction_451 -happyReduction_451 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn188 - (sL1 happy_var_1 (HsBndrWildCard (epTok happy_var_1)) - )} - -happyReduce_452 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_452 = happySpecReduce_0 173# happyReduction_452 -happyReduction_452 = happyIn189 - (noLoc (NoEpTok,[]) - ) - -happyReduce_453 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_453 = happySpecReduce_2 173# happyReduction_453 -happyReduction_453 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut190 happy_x_2 of { (HappyWrap190 happy_var_2) -> - happyIn189 - ((sLL happy_var_1 happy_var_2 (epTok happy_var_1 ,reverse (unLoc happy_var_2))) - )}} - -happyReduce_454 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_454 = happyMonadReduce 3# 174# happyReduction_454 -happyReduction_454 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut190 happy_x_1 of { (HappyWrap190 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut191 happy_x_3 of { (HappyWrap191 happy_var_3) -> - ( - do { let (h:t) = unLoc happy_var_1 -- Safe from fds1 rules - ; h' <- addTrailingCommaA h (epTok happy_var_2) - ; return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)) })}}}) - ) (\r -> happyReturn (happyIn190 r)) - -happyReduce_455 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_455 = happySpecReduce_1 174# happyReduction_455 -happyReduction_455 happy_x_1 - = case happyOut191 happy_x_1 of { (HappyWrap191 happy_var_1) -> - happyIn190 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_456 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_456 = happyMonadReduce 3# 175# happyReduction_456 -happyReduction_456 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut192 happy_x_1 of { (HappyWrap192 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut192 happy_x_3 of { (HappyWrap192 happy_var_3) -> - ( amsA' (L (comb3 happy_var_1 happy_var_2 happy_var_3) - (FunDep (epUniTok happy_var_2) - (reverse (unLoc happy_var_1)) - (reverse (unLoc happy_var_3)))))}}}) - ) (\r -> happyReturn (happyIn191 r)) - -happyReduce_457 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_457 = happySpecReduce_0 176# happyReduction_457 -happyReduction_457 = happyIn192 - (noLoc [] - ) - -happyReduce_458 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_458 = happySpecReduce_2 176# happyReduction_458 -happyReduction_458 happy_x_2 - happy_x_1 - = case happyOut192 happy_x_1 of { (HappyWrap192 happy_var_1) -> - case happyOut311 happy_x_2 of { (HappyWrap311 happy_var_2) -> - happyIn192 - (sLL happy_var_1 happy_var_2 (happy_var_2 : (unLoc happy_var_1)) - )}} - -happyReduce_459 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_459 = happySpecReduce_1 177# happyReduction_459 -happyReduction_459 happy_x_1 - = case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> - happyIn193 - (happy_var_1 - )} - -happyReduce_460 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_460 = happyMonadReduce 4# 178# happyReduction_460 -happyReduction_460 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut195 happy_x_3 of { (HappyWrap195 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( checkEmptyGADTs $ - L (comb2 happy_var_1 happy_var_4) - ((epTok happy_var_1 - ,epTok happy_var_2 - ,epTok happy_var_4) - , unLoc happy_var_3))}}}}) - ) (\r -> happyReturn (happyIn194 r)) - -happyReduce_461 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_461 = happyMonadReduce 4# 178# happyReduction_461 -happyReduction_461 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut195 happy_x_3 of { (HappyWrap195 happy_var_3) -> - ( checkEmptyGADTs $ - L (comb2 happy_var_1 happy_var_3) - ((epTok happy_var_1, NoEpTok, NoEpTok) - , unLoc happy_var_3))}}) - ) (\r -> happyReturn (happyIn194 r)) - -happyReduce_462 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_462 = happySpecReduce_0 178# happyReduction_462 -happyReduction_462 = happyIn194 - (noLoc (noAnn,[]) - ) - -happyReduce_463 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_463 = happyMonadReduce 3# 179# happyReduction_463 -happyReduction_463 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut196 happy_x_1 of { (HappyWrap196 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut195 happy_x_3 of { (HappyWrap195 happy_var_3) -> - ( do { h <- addTrailingSemiA happy_var_1 (epTok happy_var_2) - ; return (L (comb2 happy_var_1 happy_var_3) (h : unLoc happy_var_3)) })}}}) - ) (\r -> happyReturn (happyIn195 r)) - -happyReduce_464 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_464 = happySpecReduce_1 179# happyReduction_464 -happyReduction_464 happy_x_1 - = case happyOut196 happy_x_1 of { (HappyWrap196 happy_var_1) -> - happyIn195 - (L (glA happy_var_1) [happy_var_1] - )} - -happyReduce_465 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_465 = happySpecReduce_0 179# happyReduction_465 -happyReduction_465 = happyIn195 - (noLoc [] - ) - -happyReduce_466 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_466 = happyMonadReduce 4# 180# happyReduction_466 -happyReduction_466 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut287 happy_x_2 of { (HappyWrap287 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut162 happy_x_4 of { (HappyWrap162 happy_var_4) -> - ( mkGadtDecl (comb2 happy_var_2 happy_var_4) (unLoc happy_var_2) (epUniTok happy_var_3) happy_var_4)}}}) - ) (\r -> happyReturn (happyIn196 r)) - -happyReduce_467 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_467 = happySpecReduce_2 181# happyReduction_467 -happyReduction_467 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut198 happy_x_2 of { (HappyWrap198 happy_var_2) -> - happyIn197 - (sLL happy_var_1 happy_var_2 (epTok happy_var_1,unLoc happy_var_2) - )}} - -happyReduce_468 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_468 = happyMonadReduce 3# 182# happyReduction_468 -happyReduction_468 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut198 happy_x_1 of { (HappyWrap198 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut199 happy_x_3 of { (HappyWrap199 happy_var_3) -> - ( do { let (h:t) = unLoc happy_var_1 - ; h' <- addTrailingVbarA h (epTok happy_var_2) - ; return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)) })}}}) - ) (\r -> happyReturn (happyIn198 r)) - -happyReduce_469 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_469 = happySpecReduce_1 182# happyReduction_469 -happyReduction_469 happy_x_1 - = case happyOut199 happy_x_1 of { (HappyWrap199 happy_var_1) -> - happyIn198 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_470 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_470 = happyMonadReduce 4# 183# happyReduction_470 -happyReduction_470 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut200 happy_x_1 of { (HappyWrap200 happy_var_1) -> - case happyOut169 happy_x_2 of { (HappyWrap169 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut201 happy_x_4 of { (HappyWrap201 happy_var_4) -> - ( amsA' (let (con,details) = unLoc happy_var_4 in - (L (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) (mkConDeclH98 - (epUniTok happy_var_3,(fst $ unLoc happy_var_1)) - con - (snd $ unLoc happy_var_1) - (Just happy_var_2) - details))))}}}}) - ) (\r -> happyReturn (happyIn199 r)) - -happyReduce_471 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_471 = happyMonadReduce 2# 183# happyReduction_471 -happyReduction_471 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut200 happy_x_1 of { (HappyWrap200 happy_var_1) -> - case happyOut201 happy_x_2 of { (HappyWrap201 happy_var_2) -> - ( amsA' (let (con,details) = unLoc happy_var_2 in - (L (comb2 happy_var_1 happy_var_2) (mkConDeclH98 (noAnn, fst $ unLoc happy_var_1) - con - (snd $ unLoc happy_var_1) - Nothing -- No context - details))))}}) - ) (\r -> happyReturn (happyIn199 r)) - -happyReduce_472 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_472 = happySpecReduce_3 184# happyReduction_472 -happyReduction_472 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn200 - (sLL happy_var_1 happy_var_3 ((epUniTok happy_var_1,epTok happy_var_3), Just happy_var_2) - )}}} - -happyReduce_473 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_473 = happySpecReduce_0 184# happyReduction_473 -happyReduction_473 = happyIn200 - (noLoc (noAnn, Nothing) - ) - -happyReduce_474 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_474 = happyMonadReduce 1# 185# happyReduction_474 -happyReduction_474 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> - ( do { b <- runPV happy_var_1 - ; return (sL1 b (dataConBuilderCon b, dataConBuilderDetails b)) })}) - ) (\r -> happyReturn (happyIn201 r)) - -happyReduce_475 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_475 = happyMonadReduce 3# 185# happyReduction_475 -happyReduction_475 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut202 happy_x_2 of { (HappyWrap202 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( let (t, tag, arity) = happy_var_2 in pure (sLL happy_var_1 happy_var_3 $ mkUnboxedSumCon t tag arity))}}}) - ) (\r -> happyReturn (happyIn201 r)) - -happyReduce_476 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_476 = happySpecReduce_2 186# happyReduction_476 -happyReduction_476 happy_x_2 - happy_x_1 - = case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> - case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> - happyIn202 - ((happy_var_1, 1, (snd happy_var_2 + 1)) - )}} - -happyReduce_477 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_477 = happySpecReduce_3 186# happyReduction_477 -happyReduction_477 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> - happyIn202 - ((happy_var_2, snd happy_var_1 + 1, snd happy_var_1 + snd happy_var_3 + 1) - )}}} - -happyReduce_478 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_478 = happySpecReduce_0 187# happyReduction_478 -happyReduction_478 = happyIn203 - ([] - ) - -happyReduce_479 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_479 = happySpecReduce_1 187# happyReduction_479 -happyReduction_479 happy_x_1 - = case happyOut204 happy_x_1 of { (HappyWrap204 happy_var_1) -> - happyIn203 - (happy_var_1 - )} - -happyReduce_480 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_480 = happyMonadReduce 3# 188# happyReduction_480 -happyReduction_480 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut205 happy_x_1 of { (HappyWrap205 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut204 happy_x_3 of { (HappyWrap204 happy_var_3) -> - ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn204 r)) - -happyReduce_481 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_481 = happySpecReduce_1 188# happyReduction_481 -happyReduction_481 happy_x_1 - = case happyOut205 happy_x_1 of { (HappyWrap205 happy_var_1) -> - happyIn204 - ([happy_var_1] - )} - -happyReduce_482 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_482 = happyMonadReduce 3# 189# happyReduction_482 -happyReduction_482 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - ( amsA' (L (comb2 happy_var_1 happy_var_3) - (ConDeclField (epUniTok happy_var_2) - (reverse (map (\ln@(L l n) - -> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc happy_var_1))) happy_var_3 Nothing)))}}}) - ) (\r -> happyReturn (happyIn205 r)) - -happyReduce_483 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_483 = happySpecReduce_0 190# happyReduction_483 -happyReduction_483 = happyIn206 - (noLoc [] - ) - -happyReduce_484 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_484 = happySpecReduce_1 190# happyReduction_484 -happyReduction_484 happy_x_1 - = case happyOut207 happy_x_1 of { (HappyWrap207 happy_var_1) -> - happyIn206 - (happy_var_1 - )} - -happyReduce_485 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_485 = happySpecReduce_2 191# happyReduction_485 -happyReduction_485 happy_x_2 - happy_x_1 - = case happyOut207 happy_x_1 of { (HappyWrap207 happy_var_1) -> - case happyOut208 happy_x_2 of { (HappyWrap208 happy_var_2) -> - happyIn207 - (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1) - )}} - -happyReduce_486 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_486 = happySpecReduce_1 191# happyReduction_486 -happyReduction_486 happy_x_1 - = case happyOut208 happy_x_1 of { (HappyWrap208 happy_var_1) -> - happyIn207 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_487 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_487 = happyMonadReduce 2# 192# happyReduction_487 -happyReduction_487 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut209 happy_x_2 of { (HappyWrap209 happy_var_2) -> - ( let { full_loc = comb2 happy_var_1 happy_var_2 } - in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) Nothing happy_var_2))}}) - ) (\r -> happyReturn (happyIn208 r)) - -happyReduce_488 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_488 = happyMonadReduce 3# 192# happyReduction_488 -happyReduction_488 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut89 happy_x_2 of { (HappyWrap89 happy_var_2) -> - case happyOut209 happy_x_3 of { (HappyWrap209 happy_var_3) -> - ( let { full_loc = comb2 happy_var_1 happy_var_3 } - in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) (Just happy_var_2) happy_var_3))}}}) - ) (\r -> happyReturn (happyIn208 r)) - -happyReduce_489 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_489 = happyMonadReduce 3# 192# happyReduction_489 -happyReduction_489 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut209 happy_x_2 of { (HappyWrap209 happy_var_2) -> - case happyOut90 happy_x_3 of { (HappyWrap90 happy_var_3) -> - ( let { full_loc = comb2 happy_var_1 happy_var_3 } - in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) (Just happy_var_3) happy_var_2))}}}) - ) (\r -> happyReturn (happyIn208 r)) - -happyReduce_490 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_490 = happySpecReduce_1 193# happyReduction_490 -happyReduction_490 happy_x_1 - = case happyOut299 happy_x_1 of { (HappyWrap299 happy_var_1) -> - happyIn209 - (let { tc = sL1a happy_var_1 $ mkHsImplicitSigType $ - sL1a happy_var_1 $ HsTyVar noAnn NotPromoted happy_var_1 } in - sL1a happy_var_1 (DctSingle noExtField tc) - )} - -happyReduce_491 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_491 = happyMonadReduce 2# 193# happyReduction_491 -happyReduction_491 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 (DctMulti noExtField [])) - (AnnContext Nothing [epTok happy_var_1] [epTok happy_var_2]))}}) - ) (\r -> happyReturn (happyIn209 r)) - -happyReduce_492 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_492 = happyMonadReduce 3# 193# happyReduction_492 -happyReduction_492 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut181 happy_x_2 of { (HappyWrap181 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (DctMulti noExtField happy_var_2)) - (AnnContext Nothing [epTok happy_var_1] [epTok happy_var_3]))}}}) - ) (\r -> happyReturn (happyIn209 r)) - -happyReduce_493 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_493 = happySpecReduce_1 194# happyReduction_493 -happyReduction_493 happy_x_1 - = case happyOut215 happy_x_1 of { (HappyWrap215 happy_var_1) -> - happyIn210 - (happy_var_1 - )} - -happyReduce_494 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_494 = happyMonadReduce 3# 194# happyReduction_494 -happyReduction_494 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOut159 happy_x_2 of { (HappyWrap159 happy_var_2) -> - case happyOut212 happy_x_3 of { (HappyWrap212 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - do { let { l = comb2 happy_var_1 happy_var_3 } - ; r <- checkValDef l happy_var_1 (HsNoMultAnn noExtField, happy_var_2) happy_var_3; - -- Depending upon what the pattern looks like we might get either - -- a FunBind or PatBind back from checkValDef. See Note - -- [FunBind vs PatBind] - ; !cs <- getCommentsFor l - ; return $! (sL (commentsA l cs) $ ValD noExtField r) })}}}) - ) (\r -> happyReturn (happyIn210 r)) - -happyReduce_495 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_495 = happyMonadReduce 5# 194# happyReduction_495 -happyReduction_495 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - case happyOut222 happy_x_3 of { (HappyWrap222 happy_var_3) -> - case happyOut159 happy_x_4 of { (HappyWrap159 happy_var_4) -> - case happyOut212 happy_x_5 of { (HappyWrap212 happy_var_5) -> - ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> - do { let { l = comb2 happy_var_1 happy_var_5 } - ; r <- checkValDef l happy_var_3 (mkMultAnn (epTok happy_var_1) happy_var_2, happy_var_4) happy_var_5; - -- parses bindings of the form %p x or - -- %p x :: sig - -- - -- Depending upon what the pattern looks like we might get either - -- a FunBind or PatBind back from checkValDef. See Note - -- [FunBind vs PatBind] - ; !cs <- getCommentsFor l - ; return $! (sL (commentsA l cs) $ ValD noExtField r) })}}}}}) - ) (\r -> happyReturn (happyIn210 r)) - -happyReduce_496 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_496 = happySpecReduce_1 194# happyReduction_496 -happyReduction_496 happy_x_1 - = case happyOut118 happy_x_1 of { (HappyWrap118 happy_var_1) -> - happyIn210 - (happy_var_1 - )} - -happyReduce_497 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_497 = happySpecReduce_1 195# happyReduction_497 -happyReduction_497 happy_x_1 - = case happyOut210 happy_x_1 of { (HappyWrap210 happy_var_1) -> - happyIn211 - (happy_var_1 - )} - -happyReduce_498 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_498 = happySpecReduce_1 195# happyReduction_498 -happyReduction_498 happy_x_1 - = case happyOut232 happy_x_1 of { (HappyWrap232 happy_var_1) -> - happyIn211 - (mkSpliceDecl happy_var_1 - )} - -happyReduce_499 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_499 = happyMonadReduce 3# 196# happyReduction_499 -happyReduction_499 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOut136 happy_x_3 of { (HappyWrap136 happy_var_3) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - do { let L l (bs, csw) = adaptWhereBinds happy_var_3 - ; let loc = (comb3 happy_var_1 happy_var_2 (L l bs)) - ; let locg = (comb2 happy_var_1 happy_var_2) - ; acs loc (\loc cs -> - sL loc (GRHSs csw (unguardedRHS (EpAnn (spanAsAnchor locg) (GrhsAnn Nothing (Left $ epTok happy_var_1)) cs) locg happy_var_2) - bs)) })}}}) - ) (\r -> happyReturn (happyIn212 r)) - -happyReduce_500 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_500 = happyMonadReduce 2# 196# happyReduction_500 -happyReduction_500 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut213 happy_x_1 of { (HappyWrap213 happy_var_1) -> - case happyOut136 happy_x_2 of { (HappyWrap136 happy_var_2) -> - ( do { let {L l (bs, csw) = adaptWhereBinds happy_var_2} - ; acs (comb2 happy_var_1 (L l bs)) (\loc cs -> L loc - (GRHSs (cs Semi.<> csw) (reverse (unLoc happy_var_1)) bs)) })}}) - ) (\r -> happyReturn (happyIn212 r)) - -happyReduce_501 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_501 = happySpecReduce_2 197# happyReduction_501 -happyReduction_501 happy_x_2 - happy_x_1 - = case happyOut213 happy_x_1 of { (HappyWrap213 happy_var_1) -> - case happyOut214 happy_x_2 of { (HappyWrap214 happy_var_2) -> - happyIn213 - (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1) - )}} - -happyReduce_502 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_502 = happySpecReduce_1 197# happyReduction_502 -happyReduction_502 happy_x_1 - = case happyOut214 happy_x_1 of { (HappyWrap214 happy_var_1) -> - happyIn213 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_503 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_503 = happyMonadReduce 4# 198# happyReduction_503 -happyReduction_503 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut249 happy_x_2 of { (HappyWrap249 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> - acsA (comb2 happy_var_1 happy_var_4) (\loc cs -> L loc $ GRHS (EpAnn (glEE happy_var_1 happy_var_4) (GrhsAnn (Just $ epTok happy_var_1) (Left $ epTok happy_var_3)) cs) (unLoc happy_var_2) happy_var_4))}}}}) - ) (\r -> happyReturn (happyIn214 r)) - -happyReduce_504 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_504 = happyMonadReduce 3# 199# happyReduction_504 -happyReduction_504 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut162 happy_x_3 of { (HappyWrap162 happy_var_3) -> - ( do { happy_var_1 <- runPV (unECP happy_var_1) - ; v <- checkValSigLhs happy_var_1 - ; amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField $ - TypeSig (AnnSig (epUniTok happy_var_2) Nothing Nothing) [v] (mkHsWildCardBndrs happy_var_3))})}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_505 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_505 = happyMonadReduce 5# 199# happyReduction_505 -happyReduction_505 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut163 happy_x_3 of { (HappyWrap163 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut162 happy_x_5 of { (HappyWrap162 happy_var_5) -> - ( do { v <- addTrailingCommaN happy_var_1 (gl happy_var_2) - ; let sig = TypeSig (AnnSig (epUniTok happy_var_4) Nothing Nothing) (v : reverse (unLoc happy_var_3)) - (mkHsWildCardBndrs happy_var_5) - ; amsA' (sLL happy_var_1 happy_var_5 $ SigD noExtField sig ) })}}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_506 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_506 = happyMonadReduce 4# 199# happyReduction_506 -happyReduction_506 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut74 happy_x_1 of { (HappyWrap74 happy_var_1) -> - case happyOut73 happy_x_2 of { (HappyWrap73 happy_var_2) -> - case happyOut149 happy_x_3 of { (HappyWrap149 happy_var_3) -> - case happyOut75 happy_x_4 of { (HappyWrap75 happy_var_4) -> - ( do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 happy_var_4 - ; pure (glR l2) }) - happy_var_2 - ; let (fixText, fixPrec) = case happy_var_2 of - -- If an explicit precedence isn't supplied, - -- it defaults to maxPrecedence - Nothing -> (NoSourceText, maxPrecedence) - Just l2 -> (fst $ unLoc l2, snd $ unLoc l2) - ; amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField - (FixSig ((glR happy_var_1, mbPrecAnn), fixText) (FixitySig (unLoc happy_var_3) (fromOL $ unLoc happy_var_4) - (Fixity fixPrec (unLoc happy_var_1))))) - })}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_507 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_507 = happySpecReduce_1 199# happyReduction_507 -happyReduction_507 happy_x_1 - = case happyOut123 happy_x_1 of { (HappyWrap123 happy_var_1) -> - happyIn215 - (L (getLoc happy_var_1) . SigD noExtField . unLoc $ happy_var_1 - )} - -happyReduce_508 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_508 = happyMonadReduce 4# 199# happyReduction_508 -happyReduction_508 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut288 happy_x_2 of { (HappyWrap288 happy_var_2) -> - case happyOut160 happy_x_3 of { (HappyWrap160 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( let (dcolon, tc) = happy_var_3 - in amsA' (sLL happy_var_1 happy_var_4 - (SigD noExtField (CompleteMatchSig ((glR happy_var_1,dcolon,epTok happy_var_4), (getCOMPLETE_PRAGs happy_var_1)) happy_var_2 tc))))}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_509 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_509 = happyMonadReduce 4# 199# happyReduction_509 -happyReduction_509 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut216 happy_x_2 of { (HappyWrap216 happy_var_2) -> - case happyOut124 happy_x_3 of { (HappyWrap124 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField (InlineSig (glR happy_var_1, epTok happy_var_4, fst happy_var_2) happy_var_3 - (mkInlinePragma (getINLINE_PRAGs happy_var_1) (getINLINE happy_var_1) - (snd happy_var_2)))))}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_510 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_510 = happyMonadReduce 3# 199# happyReduction_510 -happyReduction_510 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField (InlineSig (glR happy_var_1, epTok happy_var_3, noAnn) happy_var_2 - (mkOpaquePragma (getOPAQUE_PRAGs happy_var_1)))))}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_511 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_511 = happyMonadReduce 3# 199# happyReduction_511 -happyReduction_511 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 (SigD noExtField (SCCFunSig ((glR happy_var_1, epTok happy_var_3), (getSCC_PRAGs happy_var_1)) happy_var_2 Nothing))))}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_512 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_512 = happyMonadReduce 4# 199# happyReduction_512 -happyReduction_512 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( do { scc <- getSCC happy_var_3 - ; let str_lit = StringLiteral (getSTRINGs happy_var_3) scc Nothing - ; amsA' (sLL happy_var_1 happy_var_4 (SigD noExtField (SCCFunSig ((glR happy_var_1, epTok happy_var_4), (getSCC_PRAGs happy_var_1)) happy_var_2 (Just ( sL1a happy_var_3 str_lit))))) })}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_513 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_513 = happyMonadReduce 6# 199# happyReduction_513 -happyReduction_513 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut216 happy_x_2 of { (HappyWrap216 happy_var_2) -> - case happyOut315 happy_x_3 of { (HappyWrap315 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut164 happy_x_5 of { (HappyWrap164 happy_var_5) -> - case happyOutTok happy_x_6 of { happy_var_6 -> - ( amsA' ( - let inl_prag = mkInlinePragma (getSPEC_PRAGs happy_var_1) - (NoUserInlinePrag, FunLike) (snd happy_var_2) - in sLL happy_var_1 happy_var_6 $ SigD noExtField (SpecSig (AnnSpecSig (glR happy_var_1) (epTok happy_var_6) (epUniTok happy_var_4) (fst happy_var_2)) happy_var_3 (fromOL happy_var_5) inl_prag)))}}}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_514 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_514 = happyMonadReduce 6# 199# happyReduction_514 -happyReduction_514 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut216 happy_x_2 of { (HappyWrap216 happy_var_2) -> - case happyOut315 happy_x_3 of { (HappyWrap315 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut164 happy_x_5 of { (HappyWrap164 happy_var_5) -> - case happyOutTok happy_x_6 of { happy_var_6 -> - ( amsA' (sLL happy_var_1 happy_var_6 $ SigD noExtField (SpecSig (AnnSpecSig (glR happy_var_1) (epTok happy_var_6) (epUniTok happy_var_4) (fst happy_var_2)) happy_var_3 (fromOL happy_var_5) - (mkInlinePragma (getSPEC_INLINE_PRAGs happy_var_1) - (getSPEC_INLINE happy_var_1) (snd happy_var_2)))))}}}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_515 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_515 = happyMonadReduce 4# 199# happyReduction_515 -happyReduction_515 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut180 happy_x_3 of { (HappyWrap180 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField (SpecInstSig ((glR happy_var_1,epTok happy_var_2,epTok happy_var_4), (getSPEC_PRAGs happy_var_1)) happy_var_3)))}}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_516 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_516 = happyMonadReduce 3# 199# happyReduction_516 -happyReduction_516 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut277 happy_x_2 of { (HappyWrap277 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField (MinimalSig ((glR happy_var_1,epTok happy_var_3), (getMINIMAL_PRAGs happy_var_1)) happy_var_2)))}}}) - ) (\r -> happyReturn (happyIn215 r)) - -happyReduce_517 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_517 = happySpecReduce_0 200# happyReduction_517 -happyReduction_517 = happyIn216 - ((noAnn ,Nothing) - ) - -happyReduce_518 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_518 = happySpecReduce_1 200# happyReduction_518 -happyReduction_518 happy_x_1 - = case happyOut217 happy_x_1 of { (HappyWrap217 happy_var_1) -> - happyIn216 - ((fst happy_var_1,Just (snd happy_var_1)) - )} - -happyReduce_519 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_519 = happySpecReduce_3 201# happyReduction_519 -happyReduction_519 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn217 - ((ActivationAnn (epTok happy_var_1) (epTok happy_var_3) Nothing (Just (glR happy_var_2)) - ,ActiveAfter (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2)))) - )}}} - -happyReduce_520 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_520 = happyReduce 4# 201# happyReduction_520 -happyReduction_520 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut140 happy_x_2 of { (HappyWrap140 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn217 - ((ActivationAnn (epTok happy_var_1) (epTok happy_var_4) happy_var_2 (Just (glR happy_var_3)) - ,ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3)))) - ) `HappyStk` happyRest}}}} - -happyReduce_521 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_521 = happySpecReduce_1 202# happyReduction_521 -happyReduction_521 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn218 - (let { loc = getLoc happy_var_1 - ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc happy_var_1 - ; quoterId = mkUnqual varName quoter } - in sL1 happy_var_1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) - )} - -happyReduce_522 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_522 = happySpecReduce_1 202# happyReduction_522 -happyReduction_522 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn218 - (let { loc = getLoc happy_var_1 - ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc happy_var_1 - ; quoterId = mkQual varName (qual, quoter) } - in sL1 happy_var_1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) - )} - -happyReduce_523 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_523 = happySpecReduce_1 203# happyReduction_523 -happyReduction_523 happy_x_1 - = case happyOut338 happy_x_1 of { (HappyWrap338 happy_var_1) -> - happyIn219 - (happy_var_1 - )} - -happyReduce_524 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_524 = happySpecReduce_1 204# happyReduction_524 -happyReduction_524 happy_x_1 - = case happyOut339 happy_x_1 of { (HappyWrap339 happy_var_1) -> - happyIn220 - (happy_var_1 - )} - -happyReduce_525 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_525 = happySpecReduce_1 205# happyReduction_525 -happyReduction_525 happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - happyIn221 - (happy_var_1 - )} - -happyReduce_526 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_526 = happySpecReduce_3 205# happyReduction_526 -happyReduction_526 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut221 happy_x_3 of { (HappyWrap221 happy_var_3) -> - happyIn221 - (ECP $ - withArrowParsingMode' $ \mode -> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - let arr = HsUnrestrictedArrow (epUniTok happy_var_2) - in mkHsArrowPV (comb2 happy_var_1 happy_var_3) mode happy_var_1 arr happy_var_3 - )}}} - -happyReduce_527 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_527 = happyReduce 4# 205# happyReduction_527 -happyReduction_527 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOut173 happy_x_2 of { (HappyWrap173 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> - happyIn221 - (ECP $ - unECP happy_var_1 >>= \ happy_var_1 -> - happy_var_2 >>= \ happy_var_2 -> - unECP happy_var_4 >>= \ happy_var_4 -> - hintLinear (getLoc happy_var_2) >> - let arr = (unLoc happy_var_2) (epUniTok happy_var_3) - in mkHsArrowPV (comb2 happy_var_1 happy_var_4) ArrowIsFunType happy_var_1 arr happy_var_4 - ) `HappyStk` happyRest}}}} - -happyReduce_528 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_528 = happySpecReduce_3 205# happyReduction_528 -happyReduction_528 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut221 happy_x_3 of { (HappyWrap221 happy_var_3) -> - happyIn221 - (ECP $ - hintLinear (getLoc happy_var_2) >> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - let arr = HsLinearArrow (EpLolly (epTok happy_var_2)) - in mkHsArrowPV (comb2 happy_var_1 happy_var_3) ArrowIsFunType happy_var_1 arr happy_var_3 - )}}} - -happyReduce_529 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_529 = happySpecReduce_3 205# happyReduction_529 -happyReduction_529 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut170 happy_x_1 of { (HappyWrap170 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut221 happy_x_3 of { (HappyWrap221 happy_var_3) -> - happyIn221 - (ECP $ - happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - mkQualPV (comb2 happy_var_1 happy_var_3) (addTrailingDarrowC happy_var_1 happy_var_2 emptyComments) happy_var_3 - )}}} - -happyReduce_530 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_530 = happySpecReduce_2 205# happyReduction_530 -happyReduction_530 happy_x_2 - happy_x_1 - = case happyOut166 happy_x_1 of { (HappyWrap166 happy_var_1) -> - case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> - happyIn221 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsForallPV (comb2 happy_var_1 happy_var_2) (unLoc happy_var_1) happy_var_2 - )}} - -happyReduce_531 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_531 = happySpecReduce_1 206# happyReduction_531 -happyReduction_531 happy_x_1 - = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> - happyIn222 - (happy_var_1 - )} - -happyReduce_532 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_532 = happySpecReduce_3 206# happyReduction_532 -happyReduction_532 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOut306 happy_x_2 of { (HappyWrap306 happy_var_2) -> - case happyOut223 happy_x_3 of { (HappyWrap223 happy_var_3) -> - happyIn222 - (ECP $ - superInfixOp $ - happy_var_2 >>= \ happy_var_2 -> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - rejectPragmaPV happy_var_1 >> - (mkHsOpAppPV (comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_2 happy_var_3) - )}}} - -happyReduce_533 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_533 = happySpecReduce_1 207# happyReduction_533 -happyReduction_533 happy_x_1 - = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> - happyIn223 - (happy_var_1 - )} - -happyReduce_534 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_534 = happySpecReduce_1 207# happyReduction_534 -happyReduction_534 happy_x_1 - = case happyOut340 happy_x_1 of { (HappyWrap340 happy_var_1) -> - happyIn223 - (happy_var_1 - )} - -happyReduce_535 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_535 = happySpecReduce_2 208# happyReduction_535 -happyReduction_535 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut227 happy_x_2 of { (HappyWrap227 happy_var_2) -> - happyIn224 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsNegAppPV (comb2 happy_var_1 happy_var_2) happy_var_2 - (epTok happy_var_1) - )}} - -happyReduce_536 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_536 = happySpecReduce_1 208# happyReduction_536 -happyReduction_536 happy_x_1 - = case happyOut227 happy_x_1 of { (HappyWrap227 happy_var_1) -> - happyIn224 - (happy_var_1 - )} - -happyReduce_537 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_537 = happySpecReduce_1 209# happyReduction_537 -happyReduction_537 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn225 - ((msemim happy_var_1,True) - )} - -happyReduce_538 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_538 = happySpecReduce_0 209# happyReduction_538 -happyReduction_538 = happyIn225 - ((Nothing,False) - ) - -happyReduce_539 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_539 = happyMonadReduce 3# 210# happyReduction_539 -happyReduction_539 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { scc <- getSCC happy_var_2 - ; return (sLL happy_var_1 happy_var_3 - (HsPragSCC - (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn (glR happy_var_2) noAnn noAnn noAnn, - (getSCC_PRAGs happy_var_1)) - (StringLiteral (getSTRINGs happy_var_2) scc Nothing)))})}}}) - ) (\r -> happyReturn (happyIn226 r)) - -happyReduce_540 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_540 = happySpecReduce_3 210# happyReduction_540 -happyReduction_540 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn226 - (sLL happy_var_1 happy_var_3 - (HsPragSCC - (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn (glR happy_var_2) noAnn noAnn noAnn, - (getSCC_PRAGs happy_var_1)) - (StringLiteral NoSourceText (getVARID happy_var_2) Nothing)) - )}}} - -happyReduce_541 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_541 = happySpecReduce_2 211# happyReduction_541 -happyReduction_541 happy_x_2 - happy_x_1 - = case happyOut227 happy_x_1 of { (HappyWrap227 happy_var_1) -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - happyIn227 - (ECP $ - superFunArg $ - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_2 >>= \ happy_var_2 -> - spanWithComments (comb2 happy_var_1 happy_var_2) >>= \l -> - mkHsAppPV l happy_var_1 happy_var_2 - )}} - -happyReduce_542 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_542 = happySpecReduce_3 211# happyReduction_542 -happyReduction_542 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut227 happy_x_1 of { (HappyWrap227 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut179 happy_x_3 of { (HappyWrap179 happy_var_3) -> - happyIn227 - (ECP $ - unECP happy_var_1 >>= \ happy_var_1 -> - mkHsAppTypePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 (epTok happy_var_2) happy_var_3 - )}}} - -happyReduce_543 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_543 = happyMonadReduce 2# 211# happyReduction_543 -happyReduction_543 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_2 $ HsStatic (epTok happy_var_1) happy_var_2))}}) - ) (\r -> happyReturn (happyIn227 r)) - -happyReduce_544 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_544 = happySpecReduce_1 211# happyReduction_544 -happyReduction_544 happy_x_1 - = case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> - happyIn227 - (happy_var_1 - )} - -happyReduce_545 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_545 = happySpecReduce_3 212# happyReduction_545 -happyReduction_545 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut228 happy_x_3 of { (HappyWrap228 happy_var_3) -> - happyIn228 - (ECP $ - unECP happy_var_3 >>= \ happy_var_3 -> - mkHsAsPatPV (comb2 happy_var_1 happy_var_3) happy_var_1 (epTok happy_var_2) happy_var_3 - )}}} - -happyReduce_546 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_546 = happySpecReduce_2 212# happyReduction_546 -happyReduction_546 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - happyIn228 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsLazyPatPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) - )}} - -happyReduce_547 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_547 = happySpecReduce_2 212# happyReduction_547 -happyReduction_547 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - happyIn228 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsBangPatPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) - )}} - -happyReduce_548 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_548 = happySpecReduce_2 212# happyReduction_548 -happyReduction_548 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - happyIn228 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsNegAppPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) - )}} - -happyReduce_549 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_549 = happyReduce 4# 212# happyReduction_549 -happyReduction_549 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut135 happy_x_2 of { (HappyWrap135 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - happyIn228 - (ECP $ - unECP happy_var_4 >>= \ happy_var_4 -> - mkHsLetPV (comb2 happy_var_1 happy_var_4) (epTok happy_var_1) (unLoc happy_var_2) (epTok happy_var_3) happy_var_4 - ) `HappyStk` happyRest}}}} - -happyReduce_550 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_550 = happyReduce 4# 212# happyReduction_550 -happyReduction_550 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut261 happy_x_2 of { (HappyWrap261 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - happyIn228 - (ECP $ - unECP happy_var_4 >>= \ happy_var_4 -> - mkHsLamPV (comb2 happy_var_1 happy_var_4) LamSingle - (sLLld happy_var_1 happy_var_4 - [sLLa happy_var_1 happy_var_4 - $ Match { m_ext = noExtField - , m_ctxt = LamAlt LamSingle - , m_pats = L (listLocation happy_var_2) happy_var_2 - , m_grhss = unguardedGRHSs (comb2 happy_var_3 happy_var_4) happy_var_4 (EpAnn (glR happy_var_3) (GrhsAnn Nothing (Right $ epUniTok happy_var_3)) emptyComments) }]) - (EpAnnLam (epTok happy_var_1) Nothing) - ) `HappyStk` happyRest}}}} - -happyReduce_551 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_551 = happySpecReduce_3 212# happyReduction_551 -happyReduction_551 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut337 happy_x_3 of { (HappyWrap337 happy_var_3) -> - happyIn228 - (ECP $ happy_var_3 >>= \ happy_var_3 -> - mkHsLamPV (comb3 happy_var_1 happy_var_2 happy_var_3) LamCase happy_var_3 (EpAnnLam (epTok happy_var_1) (Just (glR happy_var_2))) - )}}} - -happyReduce_552 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_552 = happySpecReduce_3 212# happyReduction_552 -happyReduction_552 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut336 happy_x_3 of { (HappyWrap336 happy_var_3) -> - happyIn228 - (ECP $ happy_var_3 >>= \ happy_var_3 -> - mkHsLamPV (comb3 happy_var_1 happy_var_2 happy_var_3) LamCases happy_var_3 (EpAnnLam (epTok happy_var_1) (Just (glR happy_var_2))) - )}}} - -happyReduce_553 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_553 = happyMonadReduce 8# 212# happyReduction_553 -happyReduction_553 (happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOut225 happy_x_3 of { (HappyWrap225 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut219 happy_x_5 of { (HappyWrap219 happy_var_5) -> - case happyOut225 happy_x_6 of { (HappyWrap225 happy_var_6) -> - case happyOutTok happy_x_7 of { happy_var_7 -> - case happyOut219 happy_x_8 of { (HappyWrap219 happy_var_8) -> - ( runPV (unECP happy_var_2) >>= \ (happy_var_2 :: LHsExpr GhcPs) -> - return $ ECP $ - unECP happy_var_5 >>= \ happy_var_5 -> - unECP happy_var_8 >>= \ happy_var_8 -> - mkHsIfPV (comb2 happy_var_1 happy_var_8) happy_var_2 (snd happy_var_3) happy_var_5 (snd happy_var_6) happy_var_8 - (AnnsIf - { aiIf = epTok happy_var_1 - , aiThen = epTok happy_var_4 - , aiElse = epTok happy_var_7 - , aiThenSemi = fst happy_var_3 - , aiElseSemi = fst happy_var_6}))}}}}}}}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_554 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_554 = happyMonadReduce 2# 212# happyReduction_554 -happyReduction_554 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut254 happy_x_2 of { (HappyWrap254 happy_var_2) -> - ( hintMultiWayIf (getLoc happy_var_1) >>= \_ -> - fmap ecpFromExp $ - do { let (L _ ((o,c),_)) = happy_var_2 - ; amsA' (sLL happy_var_1 happy_var_2 $ HsMultiIf (epTok happy_var_1, o, c) - (reverse $ snd $ unLoc happy_var_2)) })}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_555 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_555 = happyMonadReduce 4# 212# happyReduction_555 -happyReduction_555 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut337 happy_x_4 of { (HappyWrap337 happy_var_4) -> - ( runPV (unECP happy_var_2) >>= \ (happy_var_2 :: LHsExpr GhcPs) -> - return $ ECP $ - happy_var_4 >>= \ happy_var_4 -> - mkHsCasePV (comb3 happy_var_1 happy_var_3 happy_var_4) happy_var_2 happy_var_4 - (EpAnnHsCase (epTok happy_var_1) (epTok happy_var_3)))}}}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_556 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_556 = happyMonadReduce 2# 212# happyReduction_556 -happyReduction_556 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut263 happy_x_2 of { (HappyWrap263 happy_var_2) -> - ( do - hintQualifiedDo happy_var_1 - return $ ECP $ - happy_var_2 >>= \ happy_var_2 -> - mkHsDoPV (comb2 happy_var_1 happy_var_2) - (fmap mkModuleNameFS (getDO happy_var_1)) - happy_var_2 - (glR happy_var_1) - (glR happy_var_2))}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_557 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_557 = happyMonadReduce 2# 212# happyReduction_557 -happyReduction_557 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut263 happy_x_2 of { (HappyWrap263 happy_var_2) -> - ( hintQualifiedDo happy_var_1 >> runPV happy_var_2 >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' (L (comb2 happy_var_1 happy_var_2) - (mkMDo (MDoExpr $ fmap mkModuleNameFS (getMDO happy_var_1)) - happy_var_2 - (glR happy_var_1) - (glR happy_var_2))))}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_558 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_558 = happyMonadReduce 4# 212# happyReduction_558 -happyReduction_558 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - ( (checkPattern <=< runPV) (unECP happy_var_2) >>= \ p -> - runPV (unECP happy_var_4) >>= \ happy_var_4@cmd -> - fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_4 $HsProc (epTok happy_var_1, epUniTok happy_var_3) p (sLLa happy_var_1 happy_var_4 $ HsCmdTop noExtField cmd)))}}}}) - ) (\r -> happyReturn (happyIn228 r)) - -happyReduce_559 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_559 = happySpecReduce_1 212# happyReduction_559 -happyReduction_559 happy_x_1 - = case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> - happyIn228 - (happy_var_1 - )} - -happyReduce_560 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_560 = happyReduce 4# 213# happyReduction_560 -happyReduction_560 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut269 happy_x_3 of { (HappyWrap269 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn229 - (ECP $ - getBit OverloadedRecordUpdateBit >>= \ overloaded -> - unECP happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ happy_var_3 -> - mkHsRecordPV overloaded (comb2 happy_var_1 happy_var_4) (comb2 happy_var_2 happy_var_4) happy_var_1 happy_var_3 - (Just (epTok happy_var_2), Just (epTok happy_var_4)) - ) `HappyStk` happyRest}}}} - -happyReduce_561 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_561 = happyMonadReduce 3# 213# happyReduction_561 -happyReduction_561 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut316 happy_x_3 of { (HappyWrap316 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - fmap ecpFromExp $ amsA' ( - let fl = sLLa happy_var_2 happy_var_3 (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) happy_var_3) in - sLL happy_var_1 happy_var_3 $ mkRdrGetField happy_var_1 fl))}}}) - ) (\r -> happyReturn (happyIn229 r)) - -happyReduce_562 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_562 = happySpecReduce_1 213# happyReduction_562 -happyReduction_562 happy_x_1 - = case happyOut230 happy_x_1 of { (HappyWrap230 happy_var_1) -> - happyIn229 - (happy_var_1 - )} - -happyReduce_563 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_563 = happySpecReduce_1 214# happyReduction_563 -happyReduction_563 happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - happyIn230 - (ECP $ mkHsVarPV $! happy_var_1 - )} - -happyReduce_564 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_564 = happySpecReduce_1 214# happyReduction_564 -happyReduction_564 happy_x_1 - = case happyOut284 happy_x_1 of { (HappyWrap284 happy_var_1) -> - happyIn230 - (ECP $ mkHsVarPV $! happy_var_1 - )} - -happyReduce_565 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_565 = happyMonadReduce 1# 214# happyReduction_565 -happyReduction_565 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut275 happy_x_1 of { (HappyWrap275 happy_var_1) -> - ( fmap ecpFromExp - (ams1 happy_var_1 (HsIPVar NoExtField $! unLoc happy_var_1)))}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_566 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_566 = happyMonadReduce 1# 214# happyReduction_566 -happyReduction_566 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut276 happy_x_1 of { (HappyWrap276 happy_var_1) -> - ( fmap ecpFromExp - (ams1 happy_var_1 (HsOverLabel (fst $! unLoc happy_var_1) (snd $! unLoc happy_var_1))))}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_567 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_567 = happySpecReduce_1 214# happyReduction_567 -happyReduction_567 happy_x_1 - = case happyOut330 happy_x_1 of { (HappyWrap330 happy_var_1) -> - happyIn230 - (ECP $ mkHsLitPV $! happy_var_1 - )} - -happyReduce_568 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_568 = happySpecReduce_1 214# happyReduction_568 -happyReduction_568 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn230 - (ECP $ mkHsOverLitPV (sL1a happy_var_1 $ mkHsIntegral (getINTEGER happy_var_1)) - )} - -happyReduce_569 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_569 = happySpecReduce_1 214# happyReduction_569 -happyReduction_569 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn230 - (ECP $ mkHsOverLitPV (sL1a happy_var_1 $ mkHsFractional (getRATIONAL happy_var_1)) - )} - -happyReduce_570 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_570 = happySpecReduce_3 214# happyReduction_570 -happyReduction_570 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut239 happy_x_2 of { (HappyWrap239 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkHsParPV (comb2 happy_var_1 happy_var_3) (epTok happy_var_1) happy_var_2 (epTok happy_var_3) - )}}} - -happyReduce_571 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_571 = happySpecReduce_3 214# happyReduction_571 -happyReduction_571 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut240 happy_x_2 of { (HappyWrap240 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ - happy_var_2 >>= \ happy_var_2 -> - mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Boxed happy_var_2 - (glR happy_var_1,glR happy_var_3) - )}}} - -happyReduce_572 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_572 = happyMonadReduce 3# 214# happyReduction_572 -happyReduction_572 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut342 happy_x_2 of { (HappyWrap342 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do - { pat <- hintOrPats (sL1a happy_var_2 (OrPat NoExtField (unLoc happy_var_2))) - ; fmap ecpFromPat - (amsA' (sLL happy_var_1 happy_var_3 (ParPat (epTok happy_var_1, epTok happy_var_3) pat))) })}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_573 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_573 = happySpecReduce_3 214# happyReduction_573 -happyReduction_573 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut231 happy_x_2 of { (HappyWrap231 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ - amsA' (sLL happy_var_1 happy_var_3 $ mkRdrProjection (NE.reverse (unLoc happy_var_2)) (AnnProjection (epTok happy_var_1) (epTok happy_var_3)) ) - >>= ecpFromExp' - )}}} - -happyReduce_574 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_574 = happySpecReduce_3 214# happyReduction_574 -happyReduction_574 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut239 happy_x_2 of { (HappyWrap239 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ - unECP happy_var_2 >>= \ happy_var_2 -> - mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Unboxed (Tuple [Right happy_var_2]) - (glR happy_var_1,glR happy_var_3) - )}}} - -happyReduce_575 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_575 = happySpecReduce_3 214# happyReduction_575 -happyReduction_575 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut240 happy_x_2 of { (HappyWrap240 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ - happy_var_2 >>= \ happy_var_2 -> - mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Unboxed happy_var_2 - (glR happy_var_1,glR happy_var_3) - )}}} - -happyReduce_576 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_576 = happySpecReduce_3 214# happyReduction_576 -happyReduction_576 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut243 happy_x_2 of { (HappyWrap243 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn230 - (ECP $ happy_var_2 (comb2 happy_var_1 happy_var_3) (glR happy_var_1,glR happy_var_3) - )}}} - -happyReduce_577 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_577 = happySpecReduce_1 214# happyReduction_577 -happyReduction_577 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn230 - (ECP $ mkHsWildCardPV (getLoc happy_var_1) - )} - -happyReduce_578 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_578 = happySpecReduce_1 214# happyReduction_578 -happyReduction_578 happy_x_1 - = case happyOut233 happy_x_1 of { (HappyWrap233 happy_var_1) -> - happyIn230 - (ECP $ mkHsSplicePV happy_var_1 - )} - -happyReduce_579 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_579 = happySpecReduce_1 214# happyReduction_579 -happyReduction_579 happy_x_1 - = case happyOut234 happy_x_1 of { (HappyWrap234 happy_var_1) -> - happyIn230 - (ecpFromExp $ fmap (uncurry HsTypedSplice) (reLoc happy_var_1) - )} - -happyReduce_580 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_580 = happyMonadReduce 2# 214# happyReduction_580 -happyReduction_580 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> - ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) True happy_var_2)))}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_581 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_581 = happyMonadReduce 2# 214# happyReduction_581 -happyReduction_581 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut284 happy_x_2 of { (HappyWrap284 happy_var_2) -> - ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) True happy_var_2)))}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_582 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_582 = happyMonadReduce 2# 214# happyReduction_582 -happyReduction_582 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut311 happy_x_2 of { (HappyWrap311 happy_var_2) -> - ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) False happy_var_2)))}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_583 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_583 = happyMonadReduce 2# 214# happyReduction_583 -happyReduction_583 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut294 happy_x_2 of { (HappyWrap294 happy_var_2) -> - ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) False happy_var_2)))}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_584 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_584 = happyMonadReduce 1# 214# happyReduction_584 -happyReduction_584 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( reportEmptyDoubleQuotes (getLoc happy_var_1))}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_585 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_585 = happyMonadReduce 3# 214# happyReduction_585 -happyReduction_585 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (ExpBr (if (hasE happy_var_1) then (BracketHasE (epTok happy_var_1), epUniTok happy_var_3) - else (BracketNoE (epUniTok happy_var_1), epUniTok happy_var_3)) happy_var_2)))}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_586 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_586 = happyMonadReduce 3# 214# happyReduction_586 -happyReduction_586 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_3 $ HsTypedBracket (if (hasE happy_var_1) then (BracketHasE (epTok happy_var_1),epTok happy_var_3) else (BracketNoE (epTok happy_var_1),epTok happy_var_3)) happy_var_2))}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_587 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_587 = happyMonadReduce 3# 214# happyReduction_587 -happyReduction_587 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut167 happy_x_2 of { (HappyWrap167 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (TypBr (epTok happy_var_1,epUniTok happy_var_3) happy_var_2)))}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_588 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_588 = happyMonadReduce 3# 214# happyReduction_588 -happyReduction_588 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut222 happy_x_2 of { (HappyWrap222 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( (checkPattern <=< runPV) (unECP happy_var_2) >>= \p -> - fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (PatBr (epTok happy_var_1,epUniTok happy_var_3) p)))}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_589 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_589 = happyMonadReduce 3# 214# happyReduction_589 -happyReduction_589 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut237 happy_x_2 of { (HappyWrap237 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( fmap ecpFromExp $ - amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (DecBrL (epTok happy_var_1,epUniTok happy_var_3, fst happy_var_2) (snd happy_var_2))))}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_590 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_590 = happySpecReduce_1 214# happyReduction_590 -happyReduction_590 happy_x_1 - = case happyOut218 happy_x_1 of { (HappyWrap218 happy_var_1) -> - happyIn230 - (ECP $ mkHsSplicePV happy_var_1 - )} - -happyReduce_591 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_591 = happyMonadReduce 4# 214# happyReduction_591 -happyReduction_591 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut228 happy_x_2 of { (HappyWrap228 happy_var_2) -> - case happyOut235 happy_x_3 of { (HappyWrap235 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_4 $ HsCmdArrForm (AnnList (glRM happy_var_1) (ListBanana (epUniTok happy_var_1) (epUniTok happy_var_4)) [] noAnn []) happy_var_2 Prefix - (reverse happy_var_3)))}}}}) - ) (\r -> happyReturn (happyIn230 r)) - -happyReduce_592 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_592 = happySpecReduce_3 215# happyReduction_592 -happyReduction_592 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut231 happy_x_1 of { (HappyWrap231 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut316 happy_x_3 of { (HappyWrap316 happy_var_3) -> - happyIn231 - (sLL happy_var_1 happy_var_3 ((sLLa happy_var_2 happy_var_3 $ DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) happy_var_3) `NE.cons` unLoc happy_var_1) - )}}} - -happyReduce_593 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_593 = happySpecReduce_2 215# happyReduction_593 -happyReduction_593 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut316 happy_x_2 of { (HappyWrap316 happy_var_2) -> - happyIn231 - (sLL happy_var_1 happy_var_2 ((sLLa happy_var_1 happy_var_2 $ DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_1)) happy_var_2) :| []) - )}} - -happyReduce_594 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_594 = happySpecReduce_1 216# happyReduction_594 -happyReduction_594 happy_x_1 - = case happyOut233 happy_x_1 of { (HappyWrap233 happy_var_1) -> - happyIn232 - (fmap (HsUntypedSplice noExtField) (reLoc happy_var_1) - )} - -happyReduce_595 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_595 = happySpecReduce_1 216# happyReduction_595 -happyReduction_595 happy_x_1 - = case happyOut234 happy_x_1 of { (HappyWrap234 happy_var_1) -> - happyIn232 - (fmap (uncurry HsTypedSplice) (reLoc happy_var_1) - )} - -happyReduce_596 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_596 = happyMonadReduce 2# 217# happyReduction_596 -happyReduction_596 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - return (sLL happy_var_1 happy_var_2 $ HsUntypedSpliceExpr (epTok happy_var_1) happy_var_2))}}) - ) (\r -> happyReturn (happyIn233 r)) - -happyReduce_597 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_597 = happyMonadReduce 2# 218# happyReduction_597 -happyReduction_597 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - return (sLL happy_var_1 happy_var_2 $ (epTok happy_var_1, happy_var_2)))}}) - ) (\r -> happyReturn (happyIn234 r)) - -happyReduce_598 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_598 = happySpecReduce_2 219# happyReduction_598 -happyReduction_598 happy_x_2 - happy_x_1 - = case happyOut235 happy_x_1 of { (HappyWrap235 happy_var_1) -> - case happyOut236 happy_x_2 of { (HappyWrap236 happy_var_2) -> - happyIn235 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_599 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_599 = happySpecReduce_0 219# happyReduction_599 -happyReduction_599 = happyIn235 - ([] - ) - -happyReduce_600 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_600 = happyMonadReduce 1# 220# happyReduction_600 -happyReduction_600 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> - ( runPV (unECP happy_var_1) >>= \ (cmd :: LHsCmd GhcPs) -> - runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a cmd $ HsCmdTop noExtField cmd))}) - ) (\r -> happyReturn (happyIn236 r)) - -happyReduce_601 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_601 = happySpecReduce_3 221# happyReduction_601 -happyReduction_601 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut238 happy_x_2 of { (HappyWrap238 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn237 - (((epTok happy_var_1 ,epTok happy_var_3),happy_var_2) - )}}} - -happyReduce_602 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_602 = happySpecReduce_3 221# happyReduction_602 -happyReduction_602 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut238 happy_x_2 of { (HappyWrap238 happy_var_2) -> - happyIn237 - (((NoEpTok, NoEpTok),happy_var_2) - )} - -happyReduce_603 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_603 = happySpecReduce_1 222# happyReduction_603 -happyReduction_603 happy_x_1 - = case happyOut77 happy_x_1 of { (HappyWrap77 happy_var_1) -> - happyIn238 - (cvTopDecls happy_var_1 - )} - -happyReduce_604 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_604 = happySpecReduce_1 222# happyReduction_604 -happyReduction_604 happy_x_1 - = case happyOut76 happy_x_1 of { (HappyWrap76 happy_var_1) -> - happyIn238 - (cvTopDecls happy_var_1 - )} - -happyReduce_605 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_605 = happySpecReduce_1 223# happyReduction_605 -happyReduction_605 happy_x_1 - = case happyOut220 happy_x_1 of { (HappyWrap220 happy_var_1) -> - happyIn239 - (happy_var_1 - )} - -happyReduce_606 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_606 = happyMonadReduce 2# 223# happyReduction_606 -happyReduction_606 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOut306 happy_x_2 of { (HappyWrap306 happy_var_2) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (rejectPragmaPV happy_var_1) >> - runPV happy_var_2 >>= \ happy_var_2 -> - return $ ecpFromExp $ - sLLa happy_var_1 happy_var_2 $ SectionL noExtField happy_var_1 (n2l happy_var_2))}}) - ) (\r -> happyReturn (happyIn239 r)) - -happyReduce_607 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_607 = happySpecReduce_2 223# happyReduction_607 -happyReduction_607 happy_x_2 - happy_x_1 - = case happyOut307 happy_x_1 of { (HappyWrap307 happy_var_1) -> - case happyOut222 happy_x_2 of { (HappyWrap222 happy_var_2) -> - happyIn239 - (ECP $ - superInfixOp $ - unECP happy_var_2 >>= \ happy_var_2 -> - happy_var_1 >>= \ happy_var_1 -> - mkHsSectionR_PV (comb2 happy_var_1 happy_var_2) (n2l happy_var_1) happy_var_2 - )}} - -happyReduce_608 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_608 = happySpecReduce_2 224# happyReduction_608 -happyReduction_608 happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOut241 happy_x_2 of { (HappyWrap241 happy_var_2) -> - happyIn240 - (unECP happy_var_1 >>= \ happy_var_1 -> - happy_var_2 >>= \ happy_var_2 -> - do { t <- amsA happy_var_1 [AddCommaAnn (EpTok $ srcSpan2e $ fst happy_var_2)] - ; return (Tuple (Right t : snd happy_var_2)) } - )}} - -happyReduce_609 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_609 = happySpecReduce_2 224# happyReduction_609 -happyReduction_609 happy_x_2 - happy_x_1 - = case happyOut333 happy_x_1 of { (HappyWrap333 happy_var_1) -> - case happyOut242 happy_x_2 of { (HappyWrap242 happy_var_2) -> - happyIn240 - (happy_var_2 >>= \ happy_var_2 -> - do { let {cos = map (\ll -> (Left (EpAnn (spanAsAnchor ll) True emptyComments))) (fst happy_var_1) } - ; return (Tuple (cos ++ happy_var_2)) } - )}} - -happyReduce_610 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_610 = happySpecReduce_2 224# happyReduction_610 -happyReduction_610 happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> - happyIn240 - (unECP happy_var_1 >>= \ happy_var_1 -> return $ - (Sum 1 (snd happy_var_2 + 1) happy_var_1 [] (fst happy_var_2)) - )}} - -happyReduce_611 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_611 = happySpecReduce_3 224# happyReduction_611 -happyReduction_611 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> - case happyOut239 happy_x_2 of { (HappyWrap239 happy_var_2) -> - case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> - happyIn240 - (unECP happy_var_2 >>= \ happy_var_2 -> return $ - (Sum (snd happy_var_1 + 1) (snd happy_var_1 + snd happy_var_3 + 1) happy_var_2 (fst happy_var_1) (fst happy_var_3)) - )}}} - -happyReduce_612 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_612 = happySpecReduce_2 225# happyReduction_612 -happyReduction_612 happy_x_2 - happy_x_1 - = case happyOut333 happy_x_1 of { (HappyWrap333 happy_var_1) -> - case happyOut242 happy_x_2 of { (HappyWrap242 happy_var_2) -> - happyIn241 - (happy_var_2 >>= \ happy_var_2 -> - do { let {cos = map (\l -> (Left (EpAnn (spanAsAnchor l) True emptyComments))) (tail $ fst happy_var_1) } - ; return ((head $ fst happy_var_1, cos ++ happy_var_2)) } - )}} - -happyReduce_613 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_613 = happySpecReduce_2 226# happyReduction_613 -happyReduction_613 happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOut241 happy_x_2 of { (HappyWrap241 happy_var_2) -> - happyIn242 - (unECP happy_var_1 >>= \ happy_var_1 -> - happy_var_2 >>= \ happy_var_2 -> - do { t <- amsA happy_var_1 [AddCommaAnn (EpTok $ srcSpan2e $ fst happy_var_2)] - ; return (Right t : snd happy_var_2) } - )}} - -happyReduce_614 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_614 = happySpecReduce_1 226# happyReduction_614 -happyReduction_614 happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - happyIn242 - (unECP happy_var_1 >>= \ happy_var_1 -> - return [Right happy_var_1] - )} - -happyReduce_615 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_615 = happySpecReduce_0 226# happyReduction_615 -happyReduction_615 = happyIn242 - (return [Left noAnn] - ) - -happyReduce_616 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_616 = happySpecReduce_1 227# happyReduction_616 -happyReduction_616 happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - happyIn243 - (\loc (ao,ac) -> unECP happy_var_1 >>= \ happy_var_1 -> - mkHsExplicitListPV loc [happy_var_1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) - )} - -happyReduce_617 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_617 = happySpecReduce_1 227# happyReduction_617 -happyReduction_617 happy_x_1 - = case happyOut244 happy_x_1 of { (HappyWrap244 happy_var_1) -> - happyIn243 - (\loc (ao,ac) -> happy_var_1 >>= \ happy_var_1 -> - mkHsExplicitListPV loc (reverse happy_var_1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) - )} - -happyReduce_618 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_618 = happySpecReduce_2 227# happyReduction_618 -happyReduction_618 happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn243 - (\loc (ao,ac) -> unECP happy_var_1 >>= \ happy_var_1 -> - amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok happy_var_2) (EpTok ac)) Nothing (From happy_var_1)) - >>= ecpFromExp' - )}} - -happyReduce_619 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_619 = happyReduce 4# 227# happyReduction_619 -happyReduction_619 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut220 happy_x_3 of { (HappyWrap220 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - happyIn243 - (\loc (ao,ac) -> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok happy_var_2)) (epTok happy_var_4) (EpTok ac)) Nothing (FromThen happy_var_1 happy_var_3)) - >>= ecpFromExp' - ) `HappyStk` happyRest}}}} - -happyReduce_620 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_620 = happySpecReduce_3 227# happyReduction_620 -happyReduction_620 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut220 happy_x_3 of { (HappyWrap220 happy_var_3) -> - happyIn243 - (\loc (ao,ac) -> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok happy_var_2) (EpTok ac)) Nothing (FromTo happy_var_1 happy_var_3)) - >>= ecpFromExp' - )}}} - -happyReduce_621 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_621 = happyReduce 5# 227# happyReduction_621 -happyReduction_621 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut220 happy_x_3 of { (HappyWrap220 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut220 happy_x_5 of { (HappyWrap220 happy_var_5) -> - happyIn243 - (\loc (ao,ac) -> - unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - unECP happy_var_5 >>= \ happy_var_5 -> - amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok happy_var_2)) (epTok happy_var_4) (EpTok ac)) Nothing (FromThenTo happy_var_1 happy_var_3 happy_var_5)) - >>= ecpFromExp' - ) `HappyStk` happyRest}}}}} - -happyReduce_622 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_622 = happySpecReduce_3 227# happyReduction_622 -happyReduction_622 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut245 happy_x_3 of { (HappyWrap245 happy_var_3) -> - happyIn243 - (\loc (ao,ac) -> - checkMonadComp >>= \ ctxt -> - unECP happy_var_1 >>= \ happy_var_1 -> do { t <- addTrailingVbarA happy_var_1 (epTok happy_var_2) - ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc happy_var_3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn [])) - >>= ecpFromExp' } - )}}} - -happyReduce_623 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_623 = happySpecReduce_3 228# happyReduction_623 -happyReduction_623 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut244 happy_x_1 of { (HappyWrap244 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut239 happy_x_3 of { (HappyWrap239 happy_var_3) -> - happyIn244 - (happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - case happy_var_1 of - (h:t) -> do - h' <- addTrailingCommaA h (epTok happy_var_2) - return (((:) $! happy_var_3) $! (h':t)) - )}}} - -happyReduce_624 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_624 = happySpecReduce_3 228# happyReduction_624 -happyReduction_624 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut239 happy_x_1 of { (HappyWrap239 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut239 happy_x_3 of { (HappyWrap239 happy_var_3) -> - happyIn244 - (unECP happy_var_1 >>= \ happy_var_1 -> - unECP happy_var_3 >>= \ happy_var_3 -> - do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) - ; return [happy_var_3,h] } - )}}} - -happyReduce_625 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_625 = happySpecReduce_1 229# happyReduction_625 -happyReduction_625 happy_x_1 - = case happyOut246 happy_x_1 of { (HappyWrap246 happy_var_1) -> - happyIn245 - (case (unLoc happy_var_1) of - [qs] -> sL1 happy_var_1 qs - -- We just had one thing in our "parallel" list so - -- we simply return that thing directly - - qss -> sL1 happy_var_1 [sL1a happy_var_1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr | - qs <- qss] - noExpr noSyntaxExpr] - -- We actually found some actual parallel lists so - -- we wrap them into as a ParStmt - )} - -happyReduce_626 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_626 = happyMonadReduce 3# 230# happyReduction_626 -happyReduction_626 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut247 happy_x_1 of { (HappyWrap247 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut246 happy_x_3 of { (HappyWrap246 happy_var_3) -> - ( case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingVbarA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (reverse (h':t) : unLoc happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn246 r)) - -happyReduce_627 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_627 = happySpecReduce_1 230# happyReduction_627 -happyReduction_627 happy_x_1 - = case happyOut247 happy_x_1 of { (HappyWrap247 happy_var_1) -> - happyIn246 - (L (getLoc happy_var_1) [reverse (unLoc happy_var_1)] - )} - -happyReduce_628 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_628 = happyMonadReduce 3# 231# happyReduction_628 -happyReduction_628 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut247 happy_x_1 of { (HappyWrap247 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut248 happy_x_3 of { (HappyWrap248 happy_var_3) -> - ( case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingCommaA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 [sLLa happy_var_1 happy_var_3 ((unLoc happy_var_3) (reverse (h':t)))]))}}}) - ) (\r -> happyReturn (happyIn247 r)) - -happyReduce_629 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_629 = happyMonadReduce 3# 231# happyReduction_629 -happyReduction_629 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut247 happy_x_1 of { (HappyWrap247 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut268 happy_x_3 of { (HappyWrap268 happy_var_3) -> - ( runPV happy_var_3 >>= \ happy_var_3 -> - case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingCommaA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (happy_var_3 : (h':t))))}}}) - ) (\r -> happyReturn (happyIn247 r)) - -happyReduce_630 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_630 = happySpecReduce_1 231# happyReduction_630 -happyReduction_630 happy_x_1 - = case happyOut248 happy_x_1 of { (HappyWrap248 happy_var_1) -> - happyIn247 - (sLL happy_var_1 happy_var_1 [L (getLocAnn happy_var_1) ((unLoc happy_var_1) [])] - )} - -happyReduce_631 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_631 = happyMonadReduce 1# 231# happyReduction_631 -happyReduction_631 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut268 happy_x_1 of { (HappyWrap268 happy_var_1) -> - ( runPV happy_var_1 >>= \ happy_var_1 -> - return $ sL1 happy_var_1 [happy_var_1])}) - ) (\r -> happyReturn (happyIn247 r)) - -happyReduce_632 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_632 = happyMonadReduce 2# 232# happyReduction_632 -happyReduction_632 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - return ( - sLL happy_var_1 happy_var_2 (\ss -> (mkTransformStmt (AnnTransStmt (epTok happy_var_1) noAnn noAnn noAnn) ss happy_var_2))))}}) - ) (\r -> happyReturn (happyIn248 r)) - -happyReduce_633 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_633 = happyMonadReduce 4# 232# happyReduction_633 -happyReduction_633 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - runPV (unECP happy_var_4) >>= \ happy_var_4 -> - return (sLL happy_var_1 happy_var_4 (\ss -> (mkTransformByStmt (AnnTransStmt (epTok happy_var_1) noAnn (Just (epTok happy_var_3)) noAnn) ss happy_var_2 happy_var_4))))}}}}) - ) (\r -> happyReturn (happyIn248 r)) - -happyReduce_634 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_634 = happyMonadReduce 4# 232# happyReduction_634 -happyReduction_634 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> - return (sLL happy_var_1 happy_var_4 (\ss -> (mkGroupUsingStmt (AnnTransStmt (epTok happy_var_1) (Just (epTok happy_var_2)) noAnn (Just (epTok happy_var_3))) ss happy_var_4))))}}}}) - ) (\r -> happyReturn (happyIn248 r)) - -happyReduce_635 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_635 = happyMonadReduce 6# 232# happyReduction_635 -happyReduction_635 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - case happyOutTok happy_x_5 of { happy_var_5 -> - case happyOut219 happy_x_6 of { (HappyWrap219 happy_var_6) -> - ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> - runPV (unECP happy_var_6) >>= \ happy_var_6 -> - return (sLL happy_var_1 happy_var_6 (\ss -> (mkGroupByUsingStmt (AnnTransStmt (epTok happy_var_1) (Just (epTok happy_var_2)) (Just (epTok happy_var_3)) (Just (epTok happy_var_5))) ss happy_var_4 happy_var_6))))}}}}}}) - ) (\r -> happyReturn (happyIn248 r)) - -happyReduce_636 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_636 = happySpecReduce_1 233# happyReduction_636 -happyReduction_636 happy_x_1 - = case happyOut250 happy_x_1 of { (HappyWrap250 happy_var_1) -> - happyIn249 - (L (getLoc happy_var_1) (reverse (unLoc happy_var_1)) - )} - -happyReduce_637 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_637 = happyMonadReduce 3# 234# happyReduction_637 -happyReduction_637 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut250 happy_x_1 of { (HappyWrap250 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut268 happy_x_3 of { (HappyWrap268 happy_var_3) -> - ( runPV happy_var_3 >>= \ happy_var_3 -> - case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingCommaA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (happy_var_3 : (h':t))))}}}) - ) (\r -> happyReturn (happyIn250 r)) - -happyReduce_638 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_638 = happyMonadReduce 1# 234# happyReduction_638 -happyReduction_638 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut268 happy_x_1 of { (HappyWrap268 happy_var_1) -> - ( runPV happy_var_1 >>= \ happy_var_1 -> - return $ sL1 happy_var_1 [happy_var_1])}) - ) (\r -> happyReturn (happyIn250 r)) - -happyReduce_639 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_639 = happySpecReduce_2 235# happyReduction_639 -happyReduction_639 happy_x_2 - happy_x_1 - = case happyOut252 happy_x_1 of { (HappyWrap252 happy_var_1) -> - case happyOut136 happy_x_2 of { (HappyWrap136 happy_var_2) -> - happyIn251 - (happy_var_1 >>= \alt -> - do { let {L l (bs, csw) = adaptWhereBinds happy_var_2} - ; acs (comb2 alt (L l bs)) (\loc cs -> L loc (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) } - )}} - -happyReduce_640 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_640 = happySpecReduce_2 236# happyReduction_640 -happyReduction_640 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut219 happy_x_2 of { (HappyWrap219 happy_var_2) -> - happyIn252 - (unECP happy_var_2 >>= \ happy_var_2 -> - acs (comb2 happy_var_1 happy_var_2) (\loc cs -> L loc (unguardedRHS (EpAnn (spanAsAnchor $ comb2 happy_var_1 happy_var_2) (GrhsAnn Nothing (Right $ epUniTok happy_var_1)) cs) (comb2 happy_var_1 happy_var_2) happy_var_2)) - )}} - -happyReduce_641 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_641 = happySpecReduce_1 236# happyReduction_641 -happyReduction_641 happy_x_1 - = case happyOut253 happy_x_1 of { (HappyWrap253 happy_var_1) -> - happyIn252 - (happy_var_1 >>= \gdpats -> - return $ sL1 gdpats (reverse (unLoc gdpats)) - )} - -happyReduce_642 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_642 = happySpecReduce_2 237# happyReduction_642 -happyReduction_642 happy_x_2 - happy_x_1 - = case happyOut253 happy_x_1 of { (HappyWrap253 happy_var_1) -> - case happyOut255 happy_x_2 of { (HappyWrap255 happy_var_2) -> - happyIn253 - (happy_var_1 >>= \gdpats -> - happy_var_2 >>= \gdpat -> - return $ sLL gdpats gdpat (gdpat : unLoc gdpats) - )}} - -happyReduce_643 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_643 = happySpecReduce_1 237# happyReduction_643 -happyReduction_643 happy_x_1 - = case happyOut255 happy_x_1 of { (HappyWrap255 happy_var_1) -> - happyIn253 - (happy_var_1 >>= \gdpat -> return $ sL1 gdpat [gdpat] - )} - -happyReduce_644 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_644 = happyMonadReduce 3# 238# happyReduction_644 -happyReduction_644 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut253 happy_x_2 of { (HappyWrap253 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( runPV happy_var_2 >>= \ happy_var_2 -> - return $ sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_3),unLoc happy_var_2))}}}) - ) (\r -> happyReturn (happyIn254 r)) - -happyReduce_645 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_645 = happyMonadReduce 2# 238# happyReduction_645 -happyReduction_645 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut253 happy_x_1 of { (HappyWrap253 happy_var_1) -> - ( runPV happy_var_1 >>= \ happy_var_1 -> - return $ sL1 happy_var_1 ((NoEpTok, NoEpTok),unLoc happy_var_1))}) - ) (\r -> happyReturn (happyIn254 r)) - -happyReduce_646 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_646 = happyReduce 4# 239# happyReduction_646 -happyReduction_646 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut249 happy_x_2 of { (HappyWrap249 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - case happyOut219 happy_x_4 of { (HappyWrap219 happy_var_4) -> - happyIn255 - (unECP happy_var_4 >>= \ happy_var_4 -> - acsA (comb2 happy_var_1 happy_var_4) (\loc cs -> sL loc $ GRHS (EpAnn (glEE happy_var_1 happy_var_4) (GrhsAnn (Just $ epTok happy_var_1) (Right $ epUniTok happy_var_3)) cs) (unLoc happy_var_2) happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_647 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_647 = happyMonadReduce 1# 240# happyReduction_647 -happyReduction_647 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> - ( (checkPattern <=< runPV) (unECP happy_var_1))}) - ) (\r -> happyReturn (happyIn256 r)) - -happyReduce_648 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_648 = happyMonadReduce 1# 241# happyReduction_648 -happyReduction_648 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut341 happy_x_1 of { (HappyWrap341 happy_var_1) -> - ( case unLoc happy_var_1 of - pat :| [] -> return pat - pats -> hintOrPats (sL1a happy_var_1 (OrPat NoExtField pats)))}) - ) (\r -> happyReturn (happyIn257 r)) - -happyReduce_649 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_649 = happySpecReduce_1 242# happyReduction_649 -happyReduction_649 happy_x_1 - = case happyOut257 happy_x_1 of { (HappyWrap257 happy_var_1) -> - happyIn258 - ([ happy_var_1 ] - )} - -happyReduce_650 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_650 = happyMonadReduce 1# 243# happyReduction_650 -happyReduction_650 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> - ( -- See Note [Parser-Validator Details] in GHC.Parser.PostProcess - checkPattern_details incompleteDoBlock - (unECP happy_var_1))}) - ) (\r -> happyReturn (happyIn259 r)) - -happyReduce_651 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_651 = happySpecReduce_1 244# happyReduction_651 -happyReduction_651 happy_x_1 - = case happyOut262 happy_x_1 of { (HappyWrap262 happy_var_1) -> - happyIn260 - (happy_var_1 - )} - -happyReduce_652 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_652 = happySpecReduce_2 244# happyReduction_652 -happyReduction_652 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - happyIn260 - (sLLa happy_var_1 happy_var_2 (InvisPat (epTok happy_var_1, SpecifiedSpec) (mkHsTyPat happy_var_2)) - )}} - -happyReduce_653 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_653 = happySpecReduce_2 245# happyReduction_653 -happyReduction_653 happy_x_2 - happy_x_1 - = case happyOut260 happy_x_1 of { (HappyWrap260 happy_var_1) -> - case happyOut261 happy_x_2 of { (HappyWrap261 happy_var_2) -> - happyIn261 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_654 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_654 = happySpecReduce_0 245# happyReduction_654 -happyReduction_654 = happyIn261 - ([] - ) - -happyReduce_655 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_655 = happyMonadReduce 1# 246# happyReduction_655 -happyReduction_655 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> - ( (checkPattern <=< runPV) (unECP happy_var_1))}) - ) (\r -> happyReturn (happyIn262 r)) - -happyReduce_656 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_656 = happySpecReduce_3 247# happyReduction_656 -happyReduction_656 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut264 happy_x_2 of { (HappyWrap264 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn263 - (happy_var_2 >>= \ happy_var_2 -> - amsr (sLL happy_var_1 happy_var_3 (reverse $ snd $ unLoc happy_var_2)) (AnnList (stmtsAnchor happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fromOL $ fst $ unLoc happy_var_2) noAnn []) - )}}} - -happyReduce_657 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_657 = happySpecReduce_3 247# happyReduction_657 -happyReduction_657 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut264 happy_x_2 of { (HappyWrap264 happy_var_2) -> - happyIn263 - (happy_var_2 >>= \ happy_var_2 -> amsr - (L (stmtsLoc happy_var_2) (reverse $ snd $ unLoc happy_var_2)) (AnnList (stmtsAnchor happy_var_2) ListNone (fromOL $ fst $ unLoc happy_var_2) noAnn []) - )} - -happyReduce_658 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_658 = happySpecReduce_3 248# happyReduction_658 -happyReduction_658 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut264 happy_x_1 of { (HappyWrap264 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut267 happy_x_3 of { (HappyWrap267 happy_var_3) -> - happyIn264 - (happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ (happy_var_3 :: LStmt GhcPs (LocatedA b)) -> - case (snd $ unLoc happy_var_1) of - [] -> return (sLL happy_var_1 happy_var_3 ( (fst $ unLoc happy_var_1) `snocOL` (epTok happy_var_2) - , happy_var_3 : (snd $ unLoc happy_var_1))) - (h:t) -> do - { h' <- addTrailingSemiA h (epTok happy_var_2) - ; return $ sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 :(h':t)) } - )}}} - -happyReduce_659 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_659 = happySpecReduce_2 248# happyReduction_659 -happyReduction_659 happy_x_2 - happy_x_1 - = case happyOut264 happy_x_1 of { (HappyWrap264 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn264 - (happy_var_1 >>= \ happy_var_1 -> - case (snd $ unLoc happy_var_1) of - [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) `snocOL` (epTok happy_var_2),snd $ unLoc happy_var_1)) - (h:t) -> do - { h' <- addTrailingSemiA h (epTok happy_var_2) - ; return $ sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1,h':t) } - )}} - -happyReduce_660 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_660 = happySpecReduce_1 248# happyReduction_660 -happyReduction_660 happy_x_1 - = case happyOut267 happy_x_1 of { (HappyWrap267 happy_var_1) -> - happyIn264 - (happy_var_1 >>= \ happy_var_1 -> - return $ sL1 happy_var_1 (nilOL,[happy_var_1]) - )} - -happyReduce_661 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_661 = happySpecReduce_0 248# happyReduction_661 -happyReduction_661 = happyIn264 - (return $ noLoc (nilOL,[]) - ) - -happyReduce_662 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_662 = happyMonadReduce 1# 249# happyReduction_662 -happyReduction_662 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut267 happy_x_1 of { (HappyWrap267 happy_var_1) -> - ( fmap Just (runPV happy_var_1))}) - ) (\r -> happyReturn (happyIn265 r)) - -happyReduce_663 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_663 = happySpecReduce_0 249# happyReduction_663 -happyReduction_663 = happyIn265 - (Nothing - ) - -happyReduce_664 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_664 = happyMonadReduce 1# 250# happyReduction_664 -happyReduction_664 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut267 happy_x_1 of { (HappyWrap267 happy_var_1) -> - ( runPV happy_var_1)}) - ) (\r -> happyReturn (happyIn266 r)) - -happyReduce_665 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_665 = happySpecReduce_1 251# happyReduction_665 -happyReduction_665 happy_x_1 - = case happyOut268 happy_x_1 of { (HappyWrap268 happy_var_1) -> - happyIn267 - (happy_var_1 - )} - -happyReduce_666 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_666 = happySpecReduce_2 251# happyReduction_666 -happyReduction_666 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut263 happy_x_2 of { (HappyWrap263 happy_var_2) -> - happyIn267 - (happy_var_2 >>= \ happy_var_2 -> - amsA' (sLL happy_var_1 happy_var_2 $ mkRecStmt (hsDoAnn (epTok happy_var_1) happy_var_2) happy_var_2) - )}} - -happyReduce_667 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_667 = happySpecReduce_3 252# happyReduction_667 -happyReduction_667 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut259 happy_x_1 of { (HappyWrap259 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut219 happy_x_3 of { (HappyWrap219 happy_var_3) -> - happyIn268 - (unECP happy_var_3 >>= \ happy_var_3 -> - amsA' (sLL happy_var_1 happy_var_3 $ mkPsBindStmt (epUniTok happy_var_2) happy_var_1 happy_var_3) - )}}} - -happyReduce_668 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_668 = happySpecReduce_1 252# happyReduction_668 -happyReduction_668 happy_x_1 - = case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> - happyIn268 - (unECP happy_var_1 >>= \ happy_var_1 -> - return $ sL1a happy_var_1 $ mkBodyStmt happy_var_1 - )} - -happyReduce_669 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_669 = happySpecReduce_2 252# happyReduction_669 -happyReduction_669 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut135 happy_x_2 of { (HappyWrap135 happy_var_2) -> - happyIn268 - (amsA' (sLL happy_var_1 happy_var_2 $ mkLetStmt (epTok happy_var_1) (unLoc happy_var_2)) - )}} - -happyReduce_670 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_670 = happySpecReduce_1 253# happyReduction_670 -happyReduction_670 happy_x_1 - = case happyOut270 happy_x_1 of { (HappyWrap270 happy_var_1) -> - happyIn269 - (happy_var_1 - )} - -happyReduce_671 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_671 = happySpecReduce_0 253# happyReduction_671 -happyReduction_671 = happyIn269 - (return ([], Nothing) - ) - -happyReduce_672 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_672 = happySpecReduce_3 254# happyReduction_672 -happyReduction_672 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut271 happy_x_1 of { (HappyWrap271 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut270 happy_x_3 of { (HappyWrap270 happy_var_3) -> - happyIn270 - (happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ happy_var_3 -> do - h <- addTrailingCommaFBind happy_var_1 (epTok happy_var_2) - return (case happy_var_3 of (flds, dd) -> (h : flds, dd)) - )}}} - -happyReduce_673 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_673 = happySpecReduce_1 254# happyReduction_673 -happyReduction_673 happy_x_1 - = case happyOut271 happy_x_1 of { (HappyWrap271 happy_var_1) -> - happyIn270 - (happy_var_1 >>= \ happy_var_1 -> - return ([happy_var_1], Nothing) - )} - -happyReduce_674 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_674 = happySpecReduce_1 254# happyReduction_674 -happyReduction_674 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn270 - (return ([], Just (getLoc happy_var_1)) - )} - -happyReduce_675 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_675 = happySpecReduce_3 255# happyReduction_675 -happyReduction_675 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut239 happy_x_3 of { (HappyWrap239 happy_var_3) -> - happyIn271 - (unECP happy_var_3 >>= \ happy_var_3 -> - fmap Left $ amsA' (sLL happy_var_1 happy_var_3 $ HsFieldBind (Just (epTok happy_var_2)) (sL1a happy_var_1 $ mkFieldOcc happy_var_1) happy_var_3 False) - )}}} - -happyReduce_676 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_676 = happySpecReduce_1 255# happyReduction_676 -happyReduction_676 happy_x_1 - = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> - happyIn271 - (placeHolderPunRhs >>= \rhs -> - fmap Left $ amsA' (sL1 happy_var_1 $ HsFieldBind Nothing (sL1a happy_var_1 $ mkFieldOcc happy_var_1) rhs True) - )} - -happyReduce_677 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_677 = happyReduce 5# 255# happyReduction_677 -happyReduction_677 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut272 happy_x_3 of { (HappyWrap272 happy_var_3) -> - case happyOutTok happy_x_4 of { happy_var_4 -> - case happyOut239 happy_x_5 of { (HappyWrap239 happy_var_5) -> - happyIn271 - (do - let top = sL1a happy_var_1 $ DotFieldOcc noAnn happy_var_1 - ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc happy_var_3) - lf' = comb2 happy_var_2 (L lf ()) - fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) f) : t - final = last fields - l = comb2 happy_var_1 happy_var_3 - isPun = False - happy_var_5 <- unECP happy_var_5 - fmap Right $ mkHsProjUpdatePV (comb2 happy_var_1 happy_var_5) (L l fields) happy_var_5 isPun - (Just (epTok happy_var_4)) - ) `HappyStk` happyRest}}}}} - -happyReduce_678 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_678 = happySpecReduce_3 255# happyReduction_678 -happyReduction_678 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut272 happy_x_3 of { (HappyWrap272 happy_var_3) -> - happyIn271 - (do - let top = sL1a happy_var_1 $ DotFieldOcc noAnn happy_var_1 - ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc happy_var_3) - lf' = comb2 happy_var_2 (L lf ()) - fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) f) : t - final = last fields - l = comb2 happy_var_1 happy_var_3 - isPun = True - var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) - fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun Nothing - )}}} - -happyReduce_679 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_679 = happySpecReduce_3 256# happyReduction_679 -happyReduction_679 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut272 happy_x_1 of { (HappyWrap272 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut316 happy_x_3 of { (HappyWrap316 happy_var_3) -> - happyIn272 - (sLL happy_var_1 happy_var_3 ((sLLa happy_var_2 happy_var_3 (DotFieldOcc (AnnFieldLabel $ Just $ epTok happy_var_2) happy_var_3)) : unLoc happy_var_1) - )}}} - -happyReduce_680 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_680 = happySpecReduce_1 256# happyReduction_680 -happyReduction_680 happy_x_1 - = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> - happyIn272 - (sL1 happy_var_1 [sL1a happy_var_1 (DotFieldOcc (AnnFieldLabel Nothing) happy_var_1)] - )} - -happyReduce_681 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_681 = happyMonadReduce 3# 257# happyReduction_681 -happyReduction_681 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut273 happy_x_1 of { (HappyWrap273 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut274 happy_x_3 of { (HappyWrap274 happy_var_3) -> - ( case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (let { this = happy_var_3; rest = h':t } - in rest `seq` this `seq` sLL happy_var_1 happy_var_3 (this : rest)))}}}) - ) (\r -> happyReturn (happyIn273 r)) - -happyReduce_682 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_682 = happyMonadReduce 2# 257# happyReduction_682 -happyReduction_682 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut273 happy_x_1 of { (HappyWrap273 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( case unLoc happy_var_1 of - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (h':t)))}}) - ) (\r -> happyReturn (happyIn273 r)) - -happyReduce_683 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_683 = happySpecReduce_1 257# happyReduction_683 -happyReduction_683 happy_x_1 - = case happyOut274 happy_x_1 of { (HappyWrap274 happy_var_1) -> - happyIn273 - (let this = happy_var_1 in this `seq` (sL1 happy_var_1 [this]) - )} - -happyReduce_684 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_684 = happyMonadReduce 3# 258# happyReduction_684 -happyReduction_684 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut275 happy_x_1 of { (HappyWrap275 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut219 happy_x_3 of { (HappyWrap219 happy_var_3) -> - ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> - amsA' (sLL happy_var_1 happy_var_3 (IPBind (epTok happy_var_2) (reLoc happy_var_1) happy_var_3)))}}}) - ) (\r -> happyReturn (happyIn274 r)) - -happyReduce_685 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_685 = happySpecReduce_1 259# happyReduction_685 -happyReduction_685 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn275 - (sL1 happy_var_1 (HsIPName (getIPDUPVARID happy_var_1)) - )} - -happyReduce_686 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_686 = happySpecReduce_1 260# happyReduction_686 -happyReduction_686 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn276 - (sL1 happy_var_1 (getLABELVARIDs happy_var_1, getLABELVARID happy_var_1) - )} - -happyReduce_687 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_687 = happySpecReduce_1 261# happyReduction_687 -happyReduction_687 happy_x_1 - = case happyOut278 happy_x_1 of { (HappyWrap278 happy_var_1) -> - happyIn277 - (happy_var_1 - )} - -happyReduce_688 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_688 = happySpecReduce_0 261# happyReduction_688 -happyReduction_688 = happyIn277 - (noLocA mkTrue - ) - -happyReduce_689 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_689 = happySpecReduce_1 262# happyReduction_689 -happyReduction_689 happy_x_1 - = case happyOut279 happy_x_1 of { (HappyWrap279 happy_var_1) -> - happyIn278 - (happy_var_1 - )} - -happyReduce_690 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_690 = happyMonadReduce 3# 262# happyReduction_690 -happyReduction_690 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut279 happy_x_1 of { (HappyWrap279 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut278 happy_x_3 of { (HappyWrap278 happy_var_3) -> - ( do { h <- addTrailingVbarL happy_var_1 (epTok happy_var_2) - ; return (sLLa happy_var_1 happy_var_3 (Or [h,happy_var_3])) })}}}) - ) (\r -> happyReturn (happyIn278 r)) - -happyReduce_691 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_691 = happySpecReduce_1 263# happyReduction_691 -happyReduction_691 happy_x_1 - = case happyOut280 happy_x_1 of { (HappyWrap280 happy_var_1) -> - happyIn279 - (sLLa (head happy_var_1) (last happy_var_1) (And (happy_var_1)) - )} - -happyReduce_692 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_692 = happySpecReduce_1 264# happyReduction_692 -happyReduction_692 happy_x_1 - = case happyOut281 happy_x_1 of { (HappyWrap281 happy_var_1) -> - happyIn280 - ([happy_var_1] - )} - -happyReduce_693 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_693 = happyMonadReduce 3# 264# happyReduction_693 -happyReduction_693 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut281 happy_x_1 of { (HappyWrap281 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut280 happy_x_3 of { (HappyWrap280 happy_var_3) -> - ( do { h <- addTrailingCommaL happy_var_1 (epTok happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn280 r)) - -happyReduce_694 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_694 = happyMonadReduce 3# 265# happyReduction_694 -happyReduction_694 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut278 happy_x_2 of { (HappyWrap278 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (Parens happy_var_2)) - (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []))}}}) - ) (\r -> happyReturn (happyIn281 r)) - -happyReduce_695 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_695 = happySpecReduce_1 265# happyReduction_695 -happyReduction_695 happy_x_1 - = case happyOut283 happy_x_1 of { (HappyWrap283 happy_var_1) -> - happyIn281 - (sL1a happy_var_1 (Var happy_var_1) - )} - -happyReduce_696 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_696 = happySpecReduce_1 266# happyReduction_696 -happyReduction_696 happy_x_1 - = case happyOut283 happy_x_1 of { (HappyWrap283 happy_var_1) -> - happyIn282 - (sL1 happy_var_1 [happy_var_1] - )} - -happyReduce_697 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_697 = happyMonadReduce 3# 266# happyReduction_697 -happyReduction_697 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut283 happy_x_1 of { (HappyWrap283 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut282 happy_x_3 of { (HappyWrap282 happy_var_3) -> - ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) - ; return (sLL happy_var_1 happy_var_3 (h : unLoc happy_var_3)) })}}}) - ) (\r -> happyReturn (happyIn282 r)) - -happyReduce_698 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_698 = happySpecReduce_1 267# happyReduction_698 -happyReduction_698 happy_x_1 - = case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> - happyIn283 - (happy_var_1 - )} - -happyReduce_699 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_699 = happySpecReduce_1 267# happyReduction_699 -happyReduction_699 happy_x_1 - = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> - happyIn283 - (happy_var_1 - )} - -happyReduce_700 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_700 = happySpecReduce_1 268# happyReduction_700 -happyReduction_700 happy_x_1 - = case happyOut285 happy_x_1 of { (HappyWrap285 happy_var_1) -> - happyIn284 - (happy_var_1 - )} - -happyReduce_701 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_701 = happySpecReduce_1 268# happyReduction_701 -happyReduction_701 happy_x_1 - = case happyOut290 happy_x_1 of { (HappyWrap290 happy_var_1) -> - happyIn284 - (happy_var_1 - )} - -happyReduce_702 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_702 = happySpecReduce_1 269# happyReduction_702 -happyReduction_702 happy_x_1 - = case happyOut326 happy_x_1 of { (HappyWrap326 happy_var_1) -> - happyIn285 - (happy_var_1 - )} - -happyReduce_703 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_703 = happyMonadReduce 3# 269# happyReduction_703 -happyReduction_703 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut328 happy_x_2 of { (HappyWrap328 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn285 r)) - -happyReduce_704 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_704 = happySpecReduce_1 270# happyReduction_704 -happyReduction_704 happy_x_1 - = case happyOut327 happy_x_1 of { (HappyWrap327 happy_var_1) -> - happyIn286 - (happy_var_1 - )} - -happyReduce_705 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_705 = happyMonadReduce 3# 270# happyReduction_705 -happyReduction_705 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut329 happy_x_2 of { (HappyWrap329 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn286 r)) - -happyReduce_706 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_706 = happySpecReduce_1 270# happyReduction_706 -happyReduction_706 happy_x_1 - = case happyOut290 happy_x_1 of { (HappyWrap290 happy_var_1) -> - happyIn286 - (happy_var_1 - )} - -happyReduce_707 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_707 = happySpecReduce_1 271# happyReduction_707 -happyReduction_707 happy_x_1 - = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> - happyIn287 - (sL1 happy_var_1 (pure happy_var_1) - )} - -happyReduce_708 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_708 = happyMonadReduce 3# 271# happyReduction_708 -happyReduction_708 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut287 happy_x_3 of { (HappyWrap287 happy_var_3) -> - ( sLL happy_var_1 happy_var_3 . (:| toList (unLoc happy_var_3)) <$> addTrailingCommaN happy_var_1 (gl happy_var_2))}}}) - ) (\r -> happyReturn (happyIn287 r)) - -happyReduce_709 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_709 = happySpecReduce_1 272# happyReduction_709 -happyReduction_709 happy_x_1 - = case happyOut284 happy_x_1 of { (HappyWrap284 happy_var_1) -> - happyIn288 - ([happy_var_1] - )} - -happyReduce_710 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_710 = happyMonadReduce 3# 272# happyReduction_710 -happyReduction_710 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut284 happy_x_1 of { (HappyWrap284 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut288 happy_x_3 of { (HappyWrap288 happy_var_3) -> - ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) - ; return (h : happy_var_3) })}}}) - ) (\r -> happyReturn (happyIn288 r)) - -happyReduce_711 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_711 = happyMonadReduce 3# 273# happyReduction_711 -happyReduction_711 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut333 happy_x_2 of { (HappyWrap333 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 $ tupleDataCon Boxed (snd happy_var_2 + 1)) - (NameAnnCommas (NameParens (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (fst happy_var_2)) []))}}}) - ) (\r -> happyReturn (happyIn289 r)) - -happyReduce_712 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_712 = happyMonadReduce 2# 273# happyReduction_712 -happyReduction_712 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 $ unboxedUnitDataCon) (NameAnnOnly (NameParensHash (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn289 r)) - -happyReduce_713 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_713 = happyMonadReduce 3# 273# happyReduction_713 -happyReduction_713 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut333 happy_x_2 of { (HappyWrap333 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 $ tupleDataCon Unboxed (snd happy_var_2 + 1)) - (NameAnnCommas (NameParensHash (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (fst happy_var_2)) []))}}}) - ) (\r -> happyReturn (happyIn289 r)) - -happyReduce_714 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_714 = happySpecReduce_1 274# happyReduction_714 -happyReduction_714 happy_x_1 - = case happyOut291 happy_x_1 of { (HappyWrap291 happy_var_1) -> - happyIn290 - (L (getLoc happy_var_1) $ nameRdrName (dataConName (unLoc happy_var_1)) - )} - -happyReduce_715 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_715 = happyMonadReduce 3# 274# happyReduction_715 -happyReduction_715 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 $ getRdrName unrestrictedFunTyCon) - (NameAnnRArrow (Just $ epTok happy_var_1) (epUniTok happy_var_2) (Just $ epTok happy_var_3) []))}}}) - ) (\r -> happyReturn (happyIn290 r)) - -happyReduce_716 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_716 = happySpecReduce_1 275# happyReduction_716 -happyReduction_716 happy_x_1 - = case happyOut289 happy_x_1 of { (HappyWrap289 happy_var_1) -> - happyIn291 - (happy_var_1 - )} - -happyReduce_717 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_717 = happyMonadReduce 2# 275# happyReduction_717 -happyReduction_717 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 unitDataCon) (NameAnnOnly (NameParens (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn291 r)) - -happyReduce_718 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_718 = happyMonadReduce 2# 275# happyReduction_718 -happyReduction_718 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 nilDataCon) (NameAnnOnly (NameSquare (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn291 r)) - -happyReduce_719 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_719 = happySpecReduce_1 276# happyReduction_719 -happyReduction_719 happy_x_1 - = case happyOut329 happy_x_1 of { (HappyWrap329 happy_var_1) -> - happyIn292 - (happy_var_1 - )} - -happyReduce_720 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_720 = happyMonadReduce 3# 276# happyReduction_720 -happyReduction_720 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut327 happy_x_2 of { (HappyWrap327 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn292 r)) - -happyReduce_721 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_721 = happySpecReduce_1 277# happyReduction_721 -happyReduction_721 happy_x_1 - = case happyOut328 happy_x_1 of { (HappyWrap328 happy_var_1) -> - happyIn293 - (happy_var_1 - )} - -happyReduce_722 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_722 = happyMonadReduce 3# 277# happyReduction_722 -happyReduction_722 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut326 happy_x_2 of { (HappyWrap326 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn293 r)) - -happyReduce_723 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_723 = happySpecReduce_1 278# happyReduction_723 -happyReduction_723 happy_x_1 - = case happyOut295 happy_x_1 of { (HappyWrap295 happy_var_1) -> - happyIn294 - (happy_var_1 - )} - -happyReduce_724 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_724 = happyMonadReduce 2# 278# happyReduction_724 -happyReduction_724 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 $ getRdrName unitTyCon) - (NameAnnOnly (NameParens (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn294 r)) - -happyReduce_725 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_725 = happyMonadReduce 2# 278# happyReduction_725 -happyReduction_725 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 $ getRdrName unboxedUnitTyCon) - (NameAnnOnly (NameParensHash (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn294 r)) - -happyReduce_726 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_726 = happyMonadReduce 2# 278# happyReduction_726 -happyReduction_726 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - ( amsr (sLL happy_var_1 happy_var_2 $ listTyCon_RDR) - (NameAnnOnly (NameSquare (epTok happy_var_1) (epTok happy_var_2)) []))}}) - ) (\r -> happyReturn (happyIn294 r)) - -happyReduce_727 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_727 = happySpecReduce_1 279# happyReduction_727 -happyReduction_727 happy_x_1 - = case happyOut296 happy_x_1 of { (HappyWrap296 happy_var_1) -> - happyIn295 - (happy_var_1 - )} - -happyReduce_728 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_728 = happyMonadReduce 3# 279# happyReduction_728 -happyReduction_728 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut333 happy_x_2 of { (HappyWrap333 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { n <- mkTupleSyntaxTycon Boxed (snd happy_var_2 + 1) - ; amsr (sLL happy_var_1 happy_var_3 n) (NameAnnCommas (NameParens (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (fst happy_var_2)) []) })}}}) - ) (\r -> happyReturn (happyIn295 r)) - -happyReduce_729 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_729 = happyMonadReduce 3# 279# happyReduction_729 -happyReduction_729 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut333 happy_x_2 of { (HappyWrap333 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { n <- mkTupleSyntaxTycon Unboxed (snd happy_var_2 + 1) - ; amsr (sLL happy_var_1 happy_var_3 n) (NameAnnCommas (NameParensHash (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (fst happy_var_2)) []) })}}}) - ) (\r -> happyReturn (happyIn295 r)) - -happyReduce_730 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_730 = happyMonadReduce 3# 279# happyReduction_730 -happyReduction_730 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( do { requireLTPuns PEP_SumSyntaxType happy_var_1 happy_var_3 - ; amsr (sLL happy_var_1 happy_var_3 $ (getRdrName (sumTyCon (snd happy_var_2 + 1)))) - (NameAnnBars (epTok happy_var_1, epTok happy_var_3) (fst happy_var_2) []) })}}}) - ) (\r -> happyReturn (happyIn295 r)) - -happyReduce_731 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_731 = happyMonadReduce 3# 279# happyReduction_731 -happyReduction_731 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 $ getRdrName unrestrictedFunTyCon) - (NameAnnRArrow (Just $ epTok happy_var_1) (epUniTok happy_var_2) (Just $ epTok happy_var_3) []))}}}) - ) (\r -> happyReturn (happyIn295 r)) - -happyReduce_732 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_732 = happySpecReduce_1 280# happyReduction_732 -happyReduction_732 happy_x_1 - = case happyOut299 happy_x_1 of { (HappyWrap299 happy_var_1) -> - happyIn296 - (happy_var_1 - )} - -happyReduce_733 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_733 = happyMonadReduce 3# 280# happyReduction_733 -happyReduction_733 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut301 happy_x_2 of { (HappyWrap301 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn296 r)) - -happyReduce_734 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_734 = happySpecReduce_1 281# happyReduction_734 -happyReduction_734 happy_x_1 - = case happyOut299 happy_x_1 of { (HappyWrap299 happy_var_1) -> - happyIn297 - (happy_var_1 - )} - -happyReduce_735 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_735 = happyMonadReduce 3# 281# happyReduction_735 -happyReduction_735 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( let { name :: Located RdrName - ; name = sL1 happy_var_2 $! mkQual tcClsName (getQCONSYM happy_var_2) } - in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn297 r)) - -happyReduce_736 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_736 = happyMonadReduce 3# 281# happyReduction_736 -happyReduction_736 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( let { name :: Located RdrName - ; name = sL1 happy_var_2 $! mkUnqual tcClsName (getCONSYM happy_var_2) } - in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn297 r)) - -happyReduce_737 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_737 = happyMonadReduce 3# 281# happyReduction_737 -happyReduction_737 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( let { name :: Located RdrName - ; name = sL1 happy_var_2 $! consDataCon_RDR } - in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn297 r)) - -happyReduce_738 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_738 = happySpecReduce_1 282# happyReduction_738 -happyReduction_738 happy_x_1 - = case happyOut301 happy_x_1 of { (HappyWrap301 happy_var_1) -> - happyIn298 - (happy_var_1 - )} - -happyReduce_739 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_739 = happyMonadReduce 3# 282# happyReduction_739 -happyReduction_739 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut299 happy_x_2 of { (HappyWrap299 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn298 r)) - -happyReduce_740 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_740 = happySpecReduce_1 283# happyReduction_740 -happyReduction_740 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn299 - (sL1n happy_var_1 $! mkQual tcClsName (getQCONID happy_var_1) - )} - -happyReduce_741 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_741 = happySpecReduce_1 283# happyReduction_741 -happyReduction_741 happy_x_1 - = case happyOut300 happy_x_1 of { (HappyWrap300 happy_var_1) -> - happyIn299 - (happy_var_1 - )} - -happyReduce_742 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_742 = happySpecReduce_1 284# happyReduction_742 -happyReduction_742 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn300 - (sL1n happy_var_1 $! mkUnqual tcClsName (getCONID happy_var_1) - )} - -happyReduce_743 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_743 = happySpecReduce_1 285# happyReduction_743 -happyReduction_743 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn301 - (sL1n happy_var_1 $! mkQual tcClsName (getQCONSYM happy_var_1) - )} - -happyReduce_744 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_744 = happySpecReduce_1 285# happyReduction_744 -happyReduction_744 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn301 - (sL1n happy_var_1 $! mkQual tcClsName (getQVARSYM happy_var_1) - )} - -happyReduce_745 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_745 = happySpecReduce_1 285# happyReduction_745 -happyReduction_745 happy_x_1 - = case happyOut302 happy_x_1 of { (HappyWrap302 happy_var_1) -> - happyIn301 - (happy_var_1 - )} - -happyReduce_746 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_746 = happySpecReduce_1 286# happyReduction_746 -happyReduction_746 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn302 - (sL1n happy_var_1 $! mkUnqual tcClsName (getCONSYM happy_var_1) - )} - -happyReduce_747 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_747 = happySpecReduce_1 286# happyReduction_747 -happyReduction_747 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn302 - (sL1n happy_var_1 $! mkUnqual tcClsName (getVARSYM happy_var_1) - )} - -happyReduce_748 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_748 = happySpecReduce_1 286# happyReduction_748 -happyReduction_748 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn302 - (sL1n happy_var_1 $! consDataCon_RDR - )} - -happyReduce_749 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_749 = happySpecReduce_1 286# happyReduction_749 -happyReduction_749 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn302 - (sL1n happy_var_1 $! mkUnqual tcClsName (fsLit "-") - )} - -happyReduce_750 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_750 = happySpecReduce_1 286# happyReduction_750 -happyReduction_750 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn302 - (sL1n happy_var_1 $! mkUnqual tcClsName (fsLit ".") - )} - -happyReduce_751 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_751 = happySpecReduce_1 287# happyReduction_751 -happyReduction_751 happy_x_1 - = case happyOut300 happy_x_1 of { (HappyWrap300 happy_var_1) -> - happyIn303 - (happy_var_1 - )} - -happyReduce_752 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_752 = happyMonadReduce 3# 287# happyReduction_752 -happyReduction_752 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut302 happy_x_2 of { (HappyWrap302 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn303 r)) - -happyReduce_753 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_753 = happySpecReduce_1 288# happyReduction_753 -happyReduction_753 happy_x_1 - = case happyOut305 happy_x_1 of { (HappyWrap305 happy_var_1) -> - happyIn304 - (happy_var_1 - )} - -happyReduce_754 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_754 = happySpecReduce_1 288# happyReduction_754 -happyReduction_754 happy_x_1 - = case happyOut292 happy_x_1 of { (HappyWrap292 happy_var_1) -> - happyIn304 - (happy_var_1 - )} - -happyReduce_755 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_755 = happyMonadReduce 1# 288# happyReduction_755 -happyReduction_755 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - ( amsr (sLL happy_var_1 happy_var_1 $ getRdrName unrestrictedFunTyCon) - (NameAnnRArrow Nothing (epUniTok happy_var_1) Nothing []))}) - ) (\r -> happyReturn (happyIn304 r)) - -happyReduce_756 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_756 = happySpecReduce_1 289# happyReduction_756 -happyReduction_756 happy_x_1 - = case happyOut322 happy_x_1 of { (HappyWrap322 happy_var_1) -> - happyIn305 - (happy_var_1 - )} - -happyReduce_757 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_757 = happyMonadReduce 3# 289# happyReduction_757 -happyReduction_757 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut318 happy_x_2 of { (HappyWrap318 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn305 r)) - -happyReduce_758 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_758 = happySpecReduce_1 290# happyReduction_758 -happyReduction_758 happy_x_1 - = case happyOut309 happy_x_1 of { (HappyWrap309 happy_var_1) -> - happyIn306 - (mkHsVarOpPV happy_var_1 - )} - -happyReduce_759 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_759 = happySpecReduce_1 290# happyReduction_759 -happyReduction_759 happy_x_1 - = case happyOut293 happy_x_1 of { (HappyWrap293 happy_var_1) -> - happyIn306 - (mkHsConOpPV happy_var_1 - )} - -happyReduce_760 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_760 = happySpecReduce_1 290# happyReduction_760 -happyReduction_760 happy_x_1 - = case happyOut308 happy_x_1 of { (HappyWrap308 happy_var_1) -> - happyIn306 - (mkHsInfixHolePV happy_var_1 - )} - -happyReduce_761 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_761 = happySpecReduce_1 291# happyReduction_761 -happyReduction_761 happy_x_1 - = case happyOut310 happy_x_1 of { (HappyWrap310 happy_var_1) -> - happyIn307 - (mkHsVarOpPV happy_var_1 - )} - -happyReduce_762 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_762 = happySpecReduce_1 291# happyReduction_762 -happyReduction_762 happy_x_1 - = case happyOut293 happy_x_1 of { (HappyWrap293 happy_var_1) -> - happyIn307 - (mkHsConOpPV happy_var_1 - )} - -happyReduce_763 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_763 = happySpecReduce_1 291# happyReduction_763 -happyReduction_763 happy_x_1 - = case happyOut308 happy_x_1 of { (HappyWrap308 happy_var_1) -> - happyIn307 - (mkHsInfixHolePV happy_var_1 - )} - -happyReduce_764 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_764 = happySpecReduce_3 292# happyReduction_764 -happyReduction_764 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn308 - (sLLa happy_var_1 happy_var_3 (hsHoleExpr (Just $ EpAnnUnboundVar (epTok happy_var_1, epTok happy_var_3) (epTok happy_var_2))) - )}}} - -happyReduce_765 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_765 = happySpecReduce_1 293# happyReduction_765 -happyReduction_765 happy_x_1 - = case happyOut319 happy_x_1 of { (HappyWrap319 happy_var_1) -> - happyIn309 - (happy_var_1 - )} - -happyReduce_766 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_766 = happyMonadReduce 3# 293# happyReduction_766 -happyReduction_766 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn309 r)) - -happyReduce_767 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_767 = happySpecReduce_1 294# happyReduction_767 -happyReduction_767 happy_x_1 - = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> - happyIn310 - (happy_var_1 - )} - -happyReduce_768 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_768 = happyMonadReduce 3# 294# happyReduction_768 -happyReduction_768 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn310 r)) - -happyReduce_769 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_769 = happySpecReduce_1 295# happyReduction_769 -happyReduction_769 happy_x_1 - = case happyOut313 happy_x_1 of { (HappyWrap313 happy_var_1) -> - happyIn311 - (happy_var_1 - )} - -happyReduce_770 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_770 = happyMonadReduce 3# 296# happyReduction_770 -happyReduction_770 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn312 r)) - -happyReduce_771 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_771 = happySpecReduce_1 297# happyReduction_771 -happyReduction_771 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn313 - (sL1n happy_var_1 $! mkUnqual tvName (getVARID happy_var_1) - )} - -happyReduce_772 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_772 = happySpecReduce_1 297# happyReduction_772 -happyReduction_772 happy_x_1 - = case happyOut324 happy_x_1 of { (HappyWrap324 happy_var_1) -> - happyIn313 - (sL1n happy_var_1 $! mkUnqual tvName (unLoc happy_var_1) - )} - -happyReduce_773 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_773 = happySpecReduce_1 297# happyReduction_773 -happyReduction_773 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn313 - (sL1n happy_var_1 $! mkUnqual tvName (fsLit "unsafe") - )} - -happyReduce_774 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_774 = happySpecReduce_1 297# happyReduction_774 -happyReduction_774 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn313 - (sL1n happy_var_1 $! mkUnqual tvName (fsLit "safe") - )} - -happyReduce_775 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_775 = happySpecReduce_1 297# happyReduction_775 -happyReduction_775 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn313 - (sL1n happy_var_1 $! mkUnqual tvName (fsLit "interruptible") - )} - -happyReduce_776 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_776 = happySpecReduce_1 298# happyReduction_776 -happyReduction_776 happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - happyIn314 - (happy_var_1 - )} - -happyReduce_777 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_777 = happyMonadReduce 3# 298# happyReduction_777 -happyReduction_777 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut322 happy_x_2 of { (HappyWrap322 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn314 r)) - -happyReduce_778 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_778 = happySpecReduce_1 299# happyReduction_778 -happyReduction_778 happy_x_1 - = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> - happyIn315 - (happy_var_1 - )} - -happyReduce_779 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_779 = happyMonadReduce 3# 299# happyReduction_779 -happyReduction_779 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut322 happy_x_2 of { (HappyWrap322 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn315 r)) - -happyReduce_780 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_780 = happyMonadReduce 3# 299# happyReduction_780 -happyReduction_780 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut321 happy_x_2 of { (HappyWrap321 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) - (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) - ) (\r -> happyReturn (happyIn315 r)) - -happyReduce_781 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_781 = happySpecReduce_1 300# happyReduction_781 -happyReduction_781 happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - happyIn316 - (fmap (FieldLabelString . occNameFS . rdrNameOcc) happy_var_1 - )} - -happyReduce_782 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_782 = happySpecReduce_1 301# happyReduction_782 -happyReduction_782 happy_x_1 - = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> - happyIn317 - (happy_var_1 - )} - -happyReduce_783 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_783 = happySpecReduce_1 301# happyReduction_783 -happyReduction_783 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn317 - (sL1n happy_var_1 $! mkQual varName (getQVARID happy_var_1) - )} - -happyReduce_784 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_784 = happySpecReduce_1 302# happyReduction_784 -happyReduction_784 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (getVARID happy_var_1) - )} - -happyReduce_785 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_785 = happySpecReduce_1 302# happyReduction_785 -happyReduction_785 happy_x_1 - = case happyOut324 happy_x_1 of { (HappyWrap324 happy_var_1) -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (unLoc happy_var_1) - )} - -happyReduce_786 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_786 = happySpecReduce_1 302# happyReduction_786 -happyReduction_786 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (fsLit "unsafe") - )} - -happyReduce_787 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_787 = happySpecReduce_1 302# happyReduction_787 -happyReduction_787 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (fsLit "safe") - )} - -happyReduce_788 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_788 = happySpecReduce_1 302# happyReduction_788 -happyReduction_788 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (fsLit "interruptible") - )} - -happyReduce_789 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_789 = happySpecReduce_1 302# happyReduction_789 -happyReduction_789 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (fsLit "family") - )} - -happyReduce_790 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_790 = happySpecReduce_1 302# happyReduction_790 -happyReduction_790 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn318 - (sL1n happy_var_1 $! mkUnqual varName (fsLit "role") - )} - -happyReduce_791 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_791 = happySpecReduce_1 303# happyReduction_791 -happyReduction_791 happy_x_1 - = case happyOut322 happy_x_1 of { (HappyWrap322 happy_var_1) -> - happyIn319 - (happy_var_1 - )} - -happyReduce_792 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_792 = happySpecReduce_1 303# happyReduction_792 -happyReduction_792 happy_x_1 - = case happyOut321 happy_x_1 of { (HappyWrap321 happy_var_1) -> - happyIn319 - (happy_var_1 - )} - -happyReduce_793 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_793 = happySpecReduce_1 304# happyReduction_793 -happyReduction_793 happy_x_1 - = case happyOut323 happy_x_1 of { (HappyWrap323 happy_var_1) -> - happyIn320 - (happy_var_1 - )} - -happyReduce_794 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_794 = happySpecReduce_1 304# happyReduction_794 -happyReduction_794 happy_x_1 - = case happyOut321 happy_x_1 of { (HappyWrap321 happy_var_1) -> - happyIn320 - (happy_var_1 - )} - -happyReduce_795 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_795 = happySpecReduce_1 305# happyReduction_795 -happyReduction_795 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn321 - (sL1n happy_var_1 $ mkQual varName (getQVARSYM happy_var_1) - )} - -happyReduce_796 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_796 = happySpecReduce_1 306# happyReduction_796 -happyReduction_796 happy_x_1 - = case happyOut323 happy_x_1 of { (HappyWrap323 happy_var_1) -> - happyIn322 - (happy_var_1 - )} - -happyReduce_797 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_797 = happySpecReduce_1 306# happyReduction_797 -happyReduction_797 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn322 - (sL1n happy_var_1 $ mkUnqual varName (fsLit "-") - )} - -happyReduce_798 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_798 = happySpecReduce_1 307# happyReduction_798 -happyReduction_798 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn323 - (sL1n happy_var_1 $ mkUnqual varName (getVARSYM happy_var_1) - )} - -happyReduce_799 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_799 = happySpecReduce_1 307# happyReduction_799 -happyReduction_799 happy_x_1 - = case happyOut325 happy_x_1 of { (HappyWrap325 happy_var_1) -> - happyIn323 - (sL1n happy_var_1 $ mkUnqual varName (unLoc happy_var_1) - )} - -happyReduce_800 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_800 = happySpecReduce_1 308# happyReduction_800 -happyReduction_800 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "as") - )} - -happyReduce_801 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_801 = happySpecReduce_1 308# happyReduction_801 -happyReduction_801 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "qualified") - )} - -happyReduce_802 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_802 = happySpecReduce_1 308# happyReduction_802 -happyReduction_802 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "hiding") - )} - -happyReduce_803 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_803 = happySpecReduce_1 308# happyReduction_803 -happyReduction_803 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "export") - )} - -happyReduce_804 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_804 = happySpecReduce_1 308# happyReduction_804 -happyReduction_804 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "label") - )} - -happyReduce_805 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_805 = happySpecReduce_1 308# happyReduction_805 -happyReduction_805 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "dynamic") - )} - -happyReduce_806 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_806 = happySpecReduce_1 308# happyReduction_806 -happyReduction_806 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "stdcall") - )} - -happyReduce_807 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_807 = happySpecReduce_1 308# happyReduction_807 -happyReduction_807 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "ccall") - )} - -happyReduce_808 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_808 = happySpecReduce_1 308# happyReduction_808 -happyReduction_808 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "capi") - )} - -happyReduce_809 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_809 = happySpecReduce_1 308# happyReduction_809 -happyReduction_809 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "prim") - )} - -happyReduce_810 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_810 = happySpecReduce_1 308# happyReduction_810 -happyReduction_810 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "javascript") - )} - -happyReduce_811 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_811 = happySpecReduce_1 308# happyReduction_811 -happyReduction_811 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "group") - )} - -happyReduce_812 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_812 = happySpecReduce_1 308# happyReduction_812 -happyReduction_812 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "stock") - )} - -happyReduce_813 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_813 = happySpecReduce_1 308# happyReduction_813 -happyReduction_813 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "anyclass") - )} - -happyReduce_814 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_814 = happySpecReduce_1 308# happyReduction_814 -happyReduction_814 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "via") - )} - -happyReduce_815 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_815 = happySpecReduce_1 308# happyReduction_815 -happyReduction_815 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "unit") - )} - -happyReduce_816 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_816 = happySpecReduce_1 308# happyReduction_816 -happyReduction_816 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "dependency") - )} - -happyReduce_817 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_817 = happySpecReduce_1 308# happyReduction_817 -happyReduction_817 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn324 - (sL1 happy_var_1 (fsLit "signature") - )} - -happyReduce_818 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_818 = happySpecReduce_1 309# happyReduction_818 -happyReduction_818 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn325 - (sL1 happy_var_1 (fsLit ".") - )} - -happyReduce_819 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_819 = happySpecReduce_1 309# happyReduction_819 -happyReduction_819 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn325 - (sL1 happy_var_1 (starSym (isUnicode happy_var_1)) - )} - -happyReduce_820 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_820 = happySpecReduce_1 310# happyReduction_820 -happyReduction_820 happy_x_1 - = case happyOut327 happy_x_1 of { (HappyWrap327 happy_var_1) -> - happyIn326 - (happy_var_1 - )} - -happyReduce_821 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_821 = happySpecReduce_1 310# happyReduction_821 -happyReduction_821 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn326 - (sL1n happy_var_1 $! mkQual dataName (getQCONID happy_var_1) - )} - -happyReduce_822 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_822 = happySpecReduce_1 311# happyReduction_822 -happyReduction_822 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn327 - (sL1n happy_var_1 $ mkUnqual dataName (getCONID happy_var_1) - )} - -happyReduce_823 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_823 = happySpecReduce_1 312# happyReduction_823 -happyReduction_823 happy_x_1 - = case happyOut329 happy_x_1 of { (HappyWrap329 happy_var_1) -> - happyIn328 - (happy_var_1 - )} - -happyReduce_824 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_824 = happySpecReduce_1 312# happyReduction_824 -happyReduction_824 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn328 - (sL1n happy_var_1 $ mkQual dataName (getQCONSYM happy_var_1) - )} - -happyReduce_825 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_825 = happySpecReduce_1 313# happyReduction_825 -happyReduction_825 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn329 - (sL1n happy_var_1 $ mkUnqual dataName (getCONSYM happy_var_1) - )} - -happyReduce_826 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_826 = happySpecReduce_1 313# happyReduction_826 -happyReduction_826 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn329 - (sL1n happy_var_1 $ consDataCon_RDR - )} - -happyReduce_827 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_827 = happySpecReduce_1 314# happyReduction_827 -happyReduction_827 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsChar (getCHARs happy_var_1) $ getCHAR happy_var_1 - )} - -happyReduce_828 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_828 = happySpecReduce_1 314# happyReduction_828 -happyReduction_828 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsString (getSTRINGs happy_var_1) - $ getSTRING happy_var_1 - )} - -happyReduce_829 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_829 = happySpecReduce_1 314# happyReduction_829 -happyReduction_829 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsMultilineString (getSTRINGMULTIs happy_var_1) - $ getSTRINGMULTI happy_var_1 - )} - -happyReduce_830 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_830 = happySpecReduce_1 314# happyReduction_830 -happyReduction_830 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsIntPrim (getPRIMINTEGERs happy_var_1) - $ getPRIMINTEGER happy_var_1 - )} - -happyReduce_831 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_831 = happySpecReduce_1 314# happyReduction_831 -happyReduction_831 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsWordPrim (getPRIMWORDs happy_var_1) - $ getPRIMWORD happy_var_1 - )} - -happyReduce_832 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_832 = happySpecReduce_1 314# happyReduction_832 -happyReduction_832 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsInt8Prim (getPRIMINTEGER8s happy_var_1) - $ getPRIMINTEGER8 happy_var_1 - )} - -happyReduce_833 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_833 = happySpecReduce_1 314# happyReduction_833 -happyReduction_833 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsInt16Prim (getPRIMINTEGER16s happy_var_1) - $ getPRIMINTEGER16 happy_var_1 - )} - -happyReduce_834 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_834 = happySpecReduce_1 314# happyReduction_834 -happyReduction_834 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsInt32Prim (getPRIMINTEGER32s happy_var_1) - $ getPRIMINTEGER32 happy_var_1 - )} - -happyReduce_835 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_835 = happySpecReduce_1 314# happyReduction_835 -happyReduction_835 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsInt64Prim (getPRIMINTEGER64s happy_var_1) - $ getPRIMINTEGER64 happy_var_1 - )} - -happyReduce_836 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_836 = happySpecReduce_1 314# happyReduction_836 -happyReduction_836 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsWord8Prim (getPRIMWORD8s happy_var_1) - $ getPRIMWORD8 happy_var_1 - )} - -happyReduce_837 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_837 = happySpecReduce_1 314# happyReduction_837 -happyReduction_837 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsWord16Prim (getPRIMWORD16s happy_var_1) - $ getPRIMWORD16 happy_var_1 - )} - -happyReduce_838 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_838 = happySpecReduce_1 314# happyReduction_838 -happyReduction_838 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsWord32Prim (getPRIMWORD32s happy_var_1) - $ getPRIMWORD32 happy_var_1 - )} - -happyReduce_839 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_839 = happySpecReduce_1 314# happyReduction_839 -happyReduction_839 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsWord64Prim (getPRIMWORD64s happy_var_1) - $ getPRIMWORD64 happy_var_1 - )} - -happyReduce_840 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_840 = happySpecReduce_1 314# happyReduction_840 -happyReduction_840 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsCharPrim (getPRIMCHARs happy_var_1) - $ getPRIMCHAR happy_var_1 - )} - -happyReduce_841 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_841 = happySpecReduce_1 314# happyReduction_841 -happyReduction_841 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsStringPrim (getPRIMSTRINGs happy_var_1) - $ getPRIMSTRING happy_var_1 - )} - -happyReduce_842 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_842 = happySpecReduce_1 314# happyReduction_842 -happyReduction_842 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsFloatPrim noExtField $ getPRIMFLOAT happy_var_1 - )} - -happyReduce_843 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_843 = happySpecReduce_1 314# happyReduction_843 -happyReduction_843 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn330 - (sL1 happy_var_1 $ HsDoublePrim noExtField $ getPRIMDOUBLE happy_var_1 - )} - -happyReduce_844 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_844 = happySpecReduce_1 315# happyReduction_844 -happyReduction_844 happy_x_1 - = happyIn331 - (() - ) - -happyReduce_845 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_845 = happyMonadReduce 1# 315# happyReduction_845 -happyReduction_845 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((( popContext)) - ) (\r -> happyReturn (happyIn331 r)) - -happyReduce_846 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_846 = happySpecReduce_1 316# happyReduction_846 -happyReduction_846 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn332 - (sL1a happy_var_1 $ mkModuleNameFS (getCONID happy_var_1) - )} - -happyReduce_847 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_847 = happySpecReduce_1 316# happyReduction_847 -happyReduction_847 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn332 - (sL1a happy_var_1 $ let (mod,c) = getQCONID happy_var_1 in - mkModuleNameFS - (concatFS [mod, fsLit ".", c]) - )} - -happyReduce_848 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_848 = happySpecReduce_2 317# happyReduction_848 -happyReduction_848 happy_x_2 - happy_x_1 - = case happyOut333 happy_x_1 of { (HappyWrap333 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn333 - (((fst happy_var_1)++[gl happy_var_2],snd happy_var_1 + 1) - )}} - -happyReduce_849 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_849 = happySpecReduce_1 317# happyReduction_849 -happyReduction_849 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn333 - (([gl happy_var_1],1) - )} - -happyReduce_850 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_850 = happySpecReduce_1 318# happyReduction_850 -happyReduction_850 happy_x_1 - = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> - happyIn334 - (happy_var_1 - )} - -happyReduce_851 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_851 = happySpecReduce_0 318# happyReduction_851 -happyReduction_851 = happyIn334 - (([], 0) - ) - -happyReduce_852 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_852 = happySpecReduce_2 319# happyReduction_852 -happyReduction_852 happy_x_2 - happy_x_1 - = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn335 - (((fst happy_var_1)++[epTok happy_var_2],snd happy_var_1 + 1) - )}} - -happyReduce_853 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_853 = happySpecReduce_1 319# happyReduction_853 -happyReduction_853 happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - happyIn335 - (([epTok happy_var_1],1) - )} - -happyReduce_854 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_854 = happySpecReduce_3 320# happyReduction_854 -happyReduction_854 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut343 happy_x_2 of { (HappyWrap343 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn336 - (happy_var_2 >>= \ happy_var_2 -> amsr - (sLL happy_var_1 happy_var_3 (reverse (snd $ unLoc happy_var_2))) - (AnnList (Just $ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fst $ unLoc happy_var_2) noAnn []) - )}}} - -happyReduce_855 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_855 = happySpecReduce_3 320# happyReduction_855 -happyReduction_855 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut343 happy_x_2 of { (HappyWrap343 happy_var_2) -> - happyIn336 - (happy_var_2 >>= \ happy_var_2 -> amsr - (L (getLoc happy_var_2) (reverse (snd $ unLoc happy_var_2))) - (AnnList (Just $ glR happy_var_2) ListNone (fst $ unLoc happy_var_2) noAnn []) - )} - -happyReduce_856 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_856 = happySpecReduce_2 320# happyReduction_856 -happyReduction_856 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn336 - (amsr (sLL happy_var_1 happy_var_2 []) (AnnList Nothing (ListBraces (epTok happy_var_1) (epTok happy_var_2)) [] noAnn []) - )}} - -happyReduce_857 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_857 = happySpecReduce_2 320# happyReduction_857 -happyReduction_857 happy_x_2 - happy_x_1 - = happyIn336 - (return $ noLocA [] - ) - -happyReduce_858 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_858 = happySpecReduce_3 321# happyReduction_858 -happyReduction_858 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut344 happy_x_2 of { (HappyWrap344 happy_var_2) -> - case happyOutTok happy_x_3 of { happy_var_3 -> - happyIn337 - (happy_var_2 >>= \ happy_var_2 -> amsr - (sLL happy_var_1 happy_var_3 (reverse (snd $ unLoc happy_var_2))) - (AnnList (Just $ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fst $ unLoc happy_var_2) noAnn []) - )}}} - -happyReduce_859 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_859 = happySpecReduce_3 321# happyReduction_859 -happyReduction_859 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut344 happy_x_2 of { (HappyWrap344 happy_var_2) -> - happyIn337 - (happy_var_2 >>= \ happy_var_2 -> amsr - (L (getLoc happy_var_2) (reverse (snd $ unLoc happy_var_2))) - (AnnList (Just $ glR happy_var_2) ListNone (fst $ unLoc happy_var_2) noAnn []) - )} - -happyReduce_860 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_860 = happySpecReduce_2 321# happyReduction_860 -happyReduction_860 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn337 - (amsr (sLL happy_var_1 happy_var_2 []) (AnnList Nothing (ListBraces (epTok happy_var_1) (epTok happy_var_2)) [] noAnn []) - )}} - -happyReduce_861 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_861 = happySpecReduce_2 321# happyReduction_861 -happyReduction_861 happy_x_2 - happy_x_1 - = happyIn337 - (return $ noLocA [] - ) - -happyReduce_862 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_862 = happySpecReduce_3 322# happyReduction_862 -happyReduction_862 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - happyIn338 - (ECP $ - unECP happy_var_1 >>= \ happy_var_1 -> - rejectPragmaPV happy_var_1 >> - mkHsTySigPV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_3 - (epUniTok happy_var_2) - )}}} - -happyReduce_863 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_863 = happyMonadReduce 3# 322# happyReduction_863 -happyReduction_863 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut338 happy_x_3 of { (HappyWrap338 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 - HsFirstOrderApp True))}}}) - ) (\r -> happyReturn (happyIn338 r)) - -happyReduce_864 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_864 = happyMonadReduce 3# 322# happyReduction_864 -happyReduction_864 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut338 happy_x_3 of { (HappyWrap338 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 - HsFirstOrderApp False))}}}) - ) (\r -> happyReturn (happyIn338 r)) - -happyReduce_865 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_865 = happyMonadReduce 3# 322# happyReduction_865 -happyReduction_865 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut338 happy_x_3 of { (HappyWrap338 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 - HsHigherOrderApp True))}}}) - ) (\r -> happyReturn (happyIn338 r)) - -happyReduce_866 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_866 = happyMonadReduce 3# 322# happyReduction_866 -happyReduction_866 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut338 happy_x_3 of { (HappyWrap338 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 - HsHigherOrderApp False))}}}) - ) (\r -> happyReturn (happyIn338 r)) - -happyReduce_867 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_867 = happySpecReduce_1 322# happyReduction_867 -happyReduction_867 happy_x_1 - = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> - happyIn338 - (happy_var_1 - )} - -happyReduce_868 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_868 = happySpecReduce_1 322# happyReduction_868 -happyReduction_868 happy_x_1 - = case happyOut346 happy_x_1 of { (HappyWrap346 happy_var_1) -> - happyIn338 - (happy_var_1 - )} - -happyReduce_869 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_869 = happySpecReduce_2 322# happyReduction_869 -happyReduction_869 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - happyIn338 - (ECP $ mkHsEmbTyPV (comb2 happy_var_1 happy_var_2) (epTok happy_var_1) happy_var_2 - )}} - -happyReduce_870 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_870 = happySpecReduce_3 323# happyReduction_870 -happyReduction_870 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> - happyIn339 - (ECP $ - unECP happy_var_1 >>= \ happy_var_1 -> - rejectPragmaPV happy_var_1 >> - mkHsTySigPV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_3 - (epUniTok happy_var_2) - )}}} - -happyReduce_871 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_871 = happyMonadReduce 3# 323# happyReduction_871 -happyReduction_871 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut339 happy_x_3 of { (HappyWrap339 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 - HsFirstOrderApp True))}}}) - ) (\r -> happyReturn (happyIn339 r)) - -happyReduce_872 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_872 = happyMonadReduce 3# 323# happyReduction_872 -happyReduction_872 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut339 happy_x_3 of { (HappyWrap339 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 - HsFirstOrderApp False))}}}) - ) (\r -> happyReturn (happyIn339 r)) - -happyReduce_873 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_873 = happyMonadReduce 3# 323# happyReduction_873 -happyReduction_873 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut339 happy_x_3 of { (HappyWrap339 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 - HsHigherOrderApp True))}}}) - ) (\r -> happyReturn (happyIn339 r)) - -happyReduce_874 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_874 = happyMonadReduce 3# 323# happyReduction_874 -happyReduction_874 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut339 happy_x_3 of { (HappyWrap339 happy_var_3) -> - ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> - runPV (unECP happy_var_3) >>= \ happy_var_3 -> - fmap ecpFromCmd $ - amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 - HsHigherOrderApp False))}}}) - ) (\r -> happyReturn (happyIn339 r)) - -happyReduce_875 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_875 = happySpecReduce_1 323# happyReduction_875 -happyReduction_875 happy_x_1 - = case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> - happyIn339 - (happy_var_1 - )} - -happyReduce_876 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_876 = happySpecReduce_1 323# happyReduction_876 -happyReduction_876 happy_x_1 - = case happyOut345 happy_x_1 of { (HappyWrap345 happy_var_1) -> - happyIn339 - (happy_var_1 - )} - -happyReduce_877 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_877 = happySpecReduce_2 323# happyReduction_877 -happyReduction_877 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> - happyIn339 - (ECP $ mkHsEmbTyPV (comb2 happy_var_1 happy_var_2) (epTok happy_var_1) happy_var_2 - )}} - -happyReduce_878 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_878 = happyMonadReduce 2# 324# happyReduction_878 -happyReduction_878 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut226 happy_x_1 of { (HappyWrap226 happy_var_1) -> - case happyOut223 happy_x_2 of { (HappyWrap223 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) - ) (\r -> happyReturn (happyIn340 r)) - -happyReduce_879 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_879 = happyMonadReduce 1# 325# happyReduction_879 -happyReduction_879 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> - ( do - { pat <- (checkPattern <=< runPV) (unECP happy_var_1) - ; return (sL1 pat (NE.singleton pat)) })}) - ) (\r -> happyReturn (happyIn341 r)) - -happyReduce_880 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_880 = happyMonadReduce 3# 325# happyReduction_880 -happyReduction_880 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut341 happy_x_3 of { (HappyWrap341 happy_var_3) -> - ( do - { pat <- (checkPattern <=< runPV) (unECP happy_var_1) - ; pat <- addTrailingSemiA pat (epTok happy_var_2) - ; return (sLL pat happy_var_3 (pat NE.<| unLoc happy_var_3)) })}}}) - ) (\r -> happyReturn (happyIn341 r)) - -happyReduce_881 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_881 = happyMonadReduce 1# 326# happyReduction_881 -happyReduction_881 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut220 happy_x_1 of { (HappyWrap220 happy_var_1) -> - ( do - { pat <- (checkPattern <=< runPV) (unECP happy_var_1) - ; return (sL1 pat (NE.singleton pat)) })}) - ) (\r -> happyReturn (happyIn342 r)) - -happyReduce_882 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_882 = happyMonadReduce 3# 326# happyReduction_882 -happyReduction_882 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut220 happy_x_1 of { (HappyWrap220 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut342 happy_x_3 of { (HappyWrap342 happy_var_3) -> - ( do - { pat <- (checkPattern <=< runPV) (unECP happy_var_1) - ; pat <- addTrailingSemiA pat (epTok happy_var_2) - ; return (sLL pat happy_var_3 (pat NE.<| unLoc happy_var_3)) })}}}) - ) (\r -> happyReturn (happyIn342 r)) - -happyReduce_883 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_883 = happySpecReduce_1 327# happyReduction_883 -happyReduction_883 happy_x_1 - = case happyOut347 happy_x_1 of { (HappyWrap347 happy_var_1) -> - happyIn343 - (happy_var_1 >>= \ happy_var_1 -> return $ - sL1 happy_var_1 (fst $ unLoc happy_var_1,snd $ unLoc happy_var_1) - )} - -happyReduce_884 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_884 = happySpecReduce_2 327# happyReduction_884 -happyReduction_884 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut343 happy_x_2 of { (HappyWrap343 happy_var_2) -> - happyIn343 - (happy_var_2 >>= \ happy_var_2 -> return $ - sLL happy_var_1 happy_var_2 (((mzEpTok happy_var_1) : (fst $ unLoc happy_var_2) ) - ,snd $ unLoc happy_var_2) - )}} - -happyReduce_885 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_885 = happySpecReduce_1 328# happyReduction_885 -happyReduction_885 happy_x_1 - = case happyOut348 happy_x_1 of { (HappyWrap348 happy_var_1) -> - happyIn344 - (happy_var_1 >>= \ happy_var_1 -> return $ - sL1 happy_var_1 (fst $ unLoc happy_var_1,snd $ unLoc happy_var_1) - )} - -happyReduce_886 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_886 = happySpecReduce_2 328# happyReduction_886 -happyReduction_886 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { happy_var_1 -> - case happyOut344 happy_x_2 of { (HappyWrap344 happy_var_2) -> - happyIn344 - (happy_var_2 >>= \ happy_var_2 -> return $ - sLL happy_var_1 happy_var_2 (((mzEpTok happy_var_1) : (fst $ unLoc happy_var_2) ) - ,snd $ unLoc happy_var_2) - )}} - -happyReduce_887 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_887 = happyMonadReduce 2# 329# happyReduction_887 -happyReduction_887 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut226 happy_x_1 of { (HappyWrap226 happy_var_1) -> - case happyOut339 happy_x_2 of { (HappyWrap339 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) - ) (\r -> happyReturn (happyIn345 r)) - -happyReduce_888 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_888 = happyMonadReduce 2# 330# happyReduction_888 -happyReduction_888 (happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen ((case happyOut226 happy_x_1 of { (HappyWrap226 happy_var_1) -> - case happyOut338 happy_x_2 of { (HappyWrap338 happy_var_2) -> - ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> - fmap ecpFromExp $ - amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) - ) (\r -> happyReturn (happyIn346 r)) - -happyReduce_889 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_889 = happySpecReduce_3 331# happyReduction_889 -happyReduction_889 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut347 happy_x_1 of { (HappyWrap347 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut349 happy_x_3 of { (HappyWrap349 happy_var_3) -> - happyIn347 - (happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ happy_var_3 -> - case snd $ unLoc happy_var_1 of - [] -> return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,[happy_var_3])) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 : h' : t)) - )}}} - -happyReduce_890 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_890 = happySpecReduce_2 331# happyReduction_890 -happyReduction_890 happy_x_2 - happy_x_1 - = case happyOut347 happy_x_1 of { (HappyWrap347 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn347 - (happy_var_1 >>= \ happy_var_1 -> - case snd $ unLoc happy_var_1 of - [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,[])) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1, h' : t)) - )}} - -happyReduce_891 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_891 = happySpecReduce_1 331# happyReduction_891 -happyReduction_891 happy_x_1 - = case happyOut349 happy_x_1 of { (HappyWrap349 happy_var_1) -> - happyIn347 - (happy_var_1 >>= \ happy_var_1 -> return $ sL1 happy_var_1 ([],[happy_var_1]) - )} - -happyReduce_892 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_892 = happySpecReduce_3 332# happyReduction_892 -happyReduction_892 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut348 happy_x_1 of { (HappyWrap348 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - case happyOut350 happy_x_3 of { (HappyWrap350 happy_var_3) -> - happyIn348 - (happy_var_1 >>= \ happy_var_1 -> - happy_var_3 >>= \ happy_var_3 -> - case snd $ unLoc happy_var_1 of - [] -> return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,[happy_var_3])) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 : h' : t)) - )}}} - -happyReduce_893 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_893 = happySpecReduce_2 332# happyReduction_893 -happyReduction_893 happy_x_2 - happy_x_1 - = case happyOut348 happy_x_1 of { (HappyWrap348 happy_var_1) -> - case happyOutTok happy_x_2 of { happy_var_2 -> - happyIn348 - (happy_var_1 >>= \ happy_var_1 -> - case snd $ unLoc happy_var_1 of - [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] - ,[])) - (h:t) -> do - h' <- addTrailingSemiA h (epTok happy_var_2) - return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1, h' : t)) - )}} - -happyReduce_894 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_894 = happySpecReduce_1 332# happyReduction_894 -happyReduction_894 happy_x_1 - = case happyOut350 happy_x_1 of { (HappyWrap350 happy_var_1) -> - happyIn348 - (happy_var_1 >>= \ happy_var_1 -> return $ sL1 happy_var_1 ([],[happy_var_1]) - )} - -happyReduce_895 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_895 = happySpecReduce_2 333# happyReduction_895 -happyReduction_895 happy_x_2 - happy_x_1 - = case happyOut261 happy_x_1 of { (HappyWrap261 happy_var_1) -> - case happyOut251 happy_x_2 of { (HappyWrap251 happy_var_2) -> - happyIn349 - (happy_var_2 >>= \ happy_var_2 -> - amsA' (sLLAsl happy_var_1 happy_var_2 - (Match { m_ext = noExtField - , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing - , m_pats = L (listLocation happy_var_1) happy_var_1 - , m_grhss = unLoc happy_var_2 })) - )}} - -happyReduce_896 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) -happyReduce_896 = happySpecReduce_2 334# happyReduction_896 -happyReduction_896 happy_x_2 - happy_x_1 - = case happyOut258 happy_x_1 of { (HappyWrap258 happy_var_1) -> - case happyOut251 happy_x_2 of { (HappyWrap251 happy_var_2) -> - happyIn350 - (happy_var_2 >>= \ happy_var_2 -> - amsA' (sLLAsl happy_var_1 happy_var_2 - (Match { m_ext = noExtField - , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing - , m_pats = L (listLocation happy_var_1) happy_var_1 - , m_grhss = unLoc happy_var_2 })) - )}} - -happyNewToken action sts stk - = (lexer True)(\tk -> - let cont i = happyDoAction i tk action sts stk in - case tk of { - L _ ITeof -> happyDoAction 159# tk action sts stk; - L _ ITunderscore -> cont 1#; - L _ ITas -> cont 2#; - L _ ITcase -> cont 3#; - L _ ITclass -> cont 4#; - L _ ITdata -> cont 5#; - L _ ITdefault -> cont 6#; - L _ ITderiving -> cont 7#; - L _ ITelse -> cont 8#; - L _ IThiding -> cont 9#; - L _ ITif -> cont 10#; - L _ ITimport -> cont 11#; - L _ ITin -> cont 12#; - L _ ITinfix -> cont 13#; - L _ ITinfixl -> cont 14#; - L _ ITinfixr -> cont 15#; - L _ ITinstance -> cont 16#; - L _ ITlet -> cont 17#; - L _ ITmodule -> cont 18#; - L _ ITnewtype -> cont 19#; - L _ ITof -> cont 20#; - L _ ITqualified -> cont 21#; - L _ ITthen -> cont 22#; - L _ ITtype -> cont 23#; - L _ ITwhere -> cont 24#; - L _ (ITforall _) -> cont 25#; - L _ ITforeign -> cont 26#; - L _ ITexport -> cont 27#; - L _ ITlabel -> cont 28#; - L _ ITdynamic -> cont 29#; - L _ ITsafe -> cont 30#; - L _ ITinterruptible -> cont 31#; - L _ ITunsafe -> cont 32#; - L _ ITfamily -> cont 33#; - L _ ITrole -> cont 34#; - L _ ITstdcallconv -> cont 35#; - L _ ITccallconv -> cont 36#; - L _ ITcapiconv -> cont 37#; - L _ ITprimcallconv -> cont 38#; - L _ ITjavascriptcallconv -> cont 39#; - L _ ITproc -> cont 40#; - L _ ITrec -> cont 41#; - L _ ITgroup -> cont 42#; - L _ ITby -> cont 43#; - L _ ITusing -> cont 44#; - L _ ITpattern -> cont 45#; - L _ ITstatic -> cont 46#; - L _ ITstock -> cont 47#; - L _ ITanyclass -> cont 48#; - L _ ITvia -> cont 49#; - L _ ITunit -> cont 50#; - L _ ITsignature -> cont 51#; - L _ ITdependency -> cont 52#; - L _ (ITinline_prag _ _ _) -> cont 53#; - L _ (ITopaque_prag _) -> cont 54#; - L _ (ITspec_prag _) -> cont 55#; - L _ (ITspec_inline_prag _ _) -> cont 56#; - L _ (ITsource_prag _) -> cont 57#; - L _ (ITrules_prag _) -> cont 58#; - L _ (ITscc_prag _) -> cont 59#; - L _ (ITdeprecated_prag _) -> cont 60#; - L _ (ITwarning_prag _) -> cont 61#; - L _ (ITunpack_prag _) -> cont 62#; - L _ (ITnounpack_prag _) -> cont 63#; - L _ (ITann_prag _) -> cont 64#; - L _ (ITminimal_prag _) -> cont 65#; - L _ (ITctype _) -> cont 66#; - L _ (IToverlapping_prag _) -> cont 67#; - L _ (IToverlappable_prag _) -> cont 68#; - L _ (IToverlaps_prag _) -> cont 69#; - L _ (ITincoherent_prag _) -> cont 70#; - L _ (ITcomplete_prag _) -> cont 71#; - L _ ITclose_prag -> cont 72#; - L _ ITdotdot -> cont 73#; - L _ ITcolon -> cont 74#; - L _ (ITdcolon _) -> cont 75#; - L _ ITequal -> cont 76#; - L _ ITlam -> cont 77#; - L _ ITlcase -> cont 78#; - L _ ITlcases -> cont 79#; - L _ ITvbar -> cont 80#; - L _ (ITlarrow _) -> cont 81#; - L _ (ITrarrow _) -> cont 82#; - L _ ITlolly -> cont 83#; - L _ ITat -> cont 84#; - L _ (ITdarrow _) -> cont 85#; - L _ ITminus -> cont 86#; - L _ ITtilde -> cont 87#; - L _ ITbang -> cont 88#; - L _ ITprefixminus -> cont 89#; - L _ (ITstar _) -> cont 90#; - L _ (ITlarrowtail _) -> cont 91#; - L _ (ITrarrowtail _) -> cont 92#; - L _ (ITLarrowtail _) -> cont 93#; - L _ (ITRarrowtail _) -> cont 94#; - L _ ITdot -> cont 95#; - L _ (ITproj True) -> cont 96#; - L _ (ITproj False) -> cont 97#; - L _ ITtypeApp -> cont 98#; - L _ ITpercent -> cont 99#; - L _ ITocurly -> cont 100#; - L _ ITccurly -> cont 101#; - L _ ITvocurly -> cont 102#; - L _ ITvccurly -> cont 103#; - L _ ITobrack -> cont 104#; - L _ ITcbrack -> cont 105#; - L _ IToparen -> cont 106#; - L _ ITcparen -> cont 107#; - L _ IToubxparen -> cont 108#; - L _ ITcubxparen -> cont 109#; - L _ (IToparenbar _) -> cont 110#; - L _ (ITcparenbar _) -> cont 111#; - L _ ITsemi -> cont 112#; - L _ ITcomma -> cont 113#; - L _ ITbackquote -> cont 114#; - L _ ITsimpleQuote -> cont 115#; - L _ (ITvarid _) -> cont 116#; - L _ (ITconid _) -> cont 117#; - L _ (ITvarsym _) -> cont 118#; - L _ (ITconsym _) -> cont 119#; - L _ (ITqvarid _) -> cont 120#; - L _ (ITqconid _) -> cont 121#; - L _ (ITqvarsym _) -> cont 122#; - L _ (ITqconsym _) -> cont 123#; - L _ (ITdo _) -> cont 124#; - L _ (ITmdo _) -> cont 125#; - L _ (ITdupipvarid _) -> cont 126#; - L _ (ITlabelvarid _ _) -> cont 127#; - L _ (ITchar _ _) -> cont 128#; - L _ (ITstring _ _) -> cont 129#; - L _ (ITstringMulti _ _) -> cont 130#; - L _ (ITinteger _) -> cont 131#; - L _ (ITrational _) -> cont 132#; - L _ (ITprimchar _ _) -> cont 133#; - L _ (ITprimstring _ _) -> cont 134#; - L _ (ITprimint _ _) -> cont 135#; - L _ (ITprimword _ _) -> cont 136#; - L _ (ITprimint8 _ _) -> cont 137#; - L _ (ITprimint16 _ _) -> cont 138#; - L _ (ITprimint32 _ _) -> cont 139#; - L _ (ITprimint64 _ _) -> cont 140#; - L _ (ITprimword8 _ _) -> cont 141#; - L _ (ITprimword16 _ _) -> cont 142#; - L _ (ITprimword32 _ _) -> cont 143#; - L _ (ITprimword64 _ _) -> cont 144#; - L _ (ITprimfloat _) -> cont 145#; - L _ (ITprimdouble _) -> cont 146#; - L _ (ITopenExpQuote _ _) -> cont 147#; - L _ ITopenPatQuote -> cont 148#; - L _ ITopenTypQuote -> cont 149#; - L _ ITopenDecQuote -> cont 150#; - L _ (ITcloseQuote _) -> cont 151#; - L _ (ITopenTExpQuote _) -> cont 152#; - L _ ITcloseTExpQuote -> cont 153#; - L _ ITdollar -> cont 154#; - L _ ITdollardollar -> cont 155#; - L _ ITtyQuote -> cont 156#; - L _ (ITquasiQuote _) -> cont 157#; - L _ (ITqQuasiQuote _) -> cont 158#; - _ -> happyError' (tk, []) - }) - -happyError_ explist 159# tk = happyError' (tk, explist) -happyError_ explist _ tk = happyError' (tk, explist) - -happyThen :: () => P a -> (a -> P b) -> P b -happyThen = (>>=) -happyReturn :: () => a -> P a -happyReturn = (return) -happyParse :: () => Happy_GHC_Exts.Int# -> P (HappyAbsSyn ) - -happyNewToken :: () => Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) - -happyDoAction :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) - -happyReduceArr :: () => Happy_Data_Array.Array Prelude.Int (Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )) - -happyThen1 :: () => P a -> (a -> P b) -> P b -happyThen1 = happyThen -happyReturn1 :: () => a -> P a -happyReturn1 = happyReturn -happyError' :: () => (((Located Token)), [Prelude.String]) -> P a -happyError' tk = (\(tokens, explist) -> happyError) tk -parseModuleNoHaddock = happySomeParser where - happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (let {(HappyWrap35 x') = happyOut35 x} in x')) - -parseSignatureNoHaddock = happySomeParser where - happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (let {(HappyWrap34 x') = happyOut34 x} in x')) - -parseImport = happySomeParser where - happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (let {(HappyWrap62 x') = happyOut62 x} in x')) - -parseStatement = happySomeParser where - happySomeParser = happyThen (happyParse 3#) (\x -> happyReturn (let {(HappyWrap266 x') = happyOut266 x} in x')) - -parseDeclaration = happySomeParser where - happySomeParser = happyThen (happyParse 4#) (\x -> happyReturn (let {(HappyWrap81 x') = happyOut81 x} in x')) - -parseExpression = happySomeParser where - happySomeParser = happyThen (happyParse 5#) (\x -> happyReturn (let {(HappyWrap219 x') = happyOut219 x} in x')) - -parsePattern = happySomeParser where - happySomeParser = happyThen (happyParse 6#) (\x -> happyReturn (let {(HappyWrap257 x') = happyOut257 x} in x')) - -parseTypeSignature = happySomeParser where - happySomeParser = happyThen (happyParse 7#) (\x -> happyReturn (let {(HappyWrap215 x') = happyOut215 x} in x')) - -parseStmt = happySomeParser where - happySomeParser = happyThen (happyParse 8#) (\x -> happyReturn (let {(HappyWrap265 x') = happyOut265 x} in x')) - -parseIdentifier = happySomeParser where - happySomeParser = happyThen (happyParse 9#) (\x -> happyReturn (let {(HappyWrap16 x') = happyOut16 x} in x')) - -parseType = happySomeParser where - happySomeParser = happyThen (happyParse 10#) (\x -> happyReturn (let {(HappyWrap167 x') = happyOut167 x} in x')) - -parseBackpack = happySomeParser where - happySomeParser = happyThen (happyParse 11#) (\x -> happyReturn (let {(HappyWrap17 x') = happyOut17 x} in x')) - -parseHeader = happySomeParser where - happySomeParser = happyThen (happyParse 12#) (\x -> happyReturn (let {(HappyWrap42 x') = happyOut42 x} in x')) - -happySeq = happyDoSeq - - -happyError :: P a -happyError = srcParseFail - -getVARID (L _ (ITvarid x)) = x -getCONID (L _ (ITconid x)) = x -getVARSYM (L _ (ITvarsym x)) = x -getCONSYM (L _ (ITconsym x)) = x -getDO (L _ (ITdo x)) = x -getMDO (L _ (ITmdo x)) = x -getQVARID (L _ (ITqvarid x)) = x -getQCONID (L _ (ITqconid x)) = x -getQVARSYM (L _ (ITqvarsym x)) = x -getQCONSYM (L _ (ITqconsym x)) = x -getIPDUPVARID (L _ (ITdupipvarid x)) = x -getLABELVARID (L _ (ITlabelvarid _ x)) = x -getCHAR (L _ (ITchar _ x)) = x -getSTRING (L _ (ITstring _ x)) = x -getSTRINGMULTI (L _ (ITstringMulti _ x)) = x -getINTEGER (L _ (ITinteger x)) = x -getRATIONAL (L _ (ITrational x)) = x -getPRIMCHAR (L _ (ITprimchar _ x)) = x -getPRIMSTRING (L _ (ITprimstring _ x)) = x -getPRIMINTEGER (L _ (ITprimint _ x)) = x -getPRIMWORD (L _ (ITprimword _ x)) = x -getPRIMINTEGER8 (L _ (ITprimint8 _ x)) = x -getPRIMINTEGER16 (L _ (ITprimint16 _ x)) = x -getPRIMINTEGER32 (L _ (ITprimint32 _ x)) = x -getPRIMINTEGER64 (L _ (ITprimint64 _ x)) = x -getPRIMWORD8 (L _ (ITprimword8 _ x)) = x -getPRIMWORD16 (L _ (ITprimword16 _ x)) = x -getPRIMWORD32 (L _ (ITprimword32 _ x)) = x -getPRIMWORD64 (L _ (ITprimword64 _ x)) = x -getPRIMFLOAT (L _ (ITprimfloat x)) = x -getPRIMDOUBLE (L _ (ITprimdouble x)) = x -getINLINE (L _ (ITinline_prag _ inl conl)) = (inl,conl) -getSPEC_INLINE (L _ (ITspec_inline_prag src True)) = (Inline src,FunLike) -getSPEC_INLINE (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike) -getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x -getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l - -getINTEGERs (L _ (ITinteger (IL src _ _))) = src -getCHARs (L _ (ITchar src _)) = src -getSTRINGs (L _ (ITstring src _)) = src -getSTRINGMULTIs (L _ (ITstringMulti src _)) = src -getPRIMCHARs (L _ (ITprimchar src _)) = src -getPRIMSTRINGs (L _ (ITprimstring src _)) = src -getPRIMINTEGERs (L _ (ITprimint src _)) = src -getPRIMWORDs (L _ (ITprimword src _)) = src -getPRIMINTEGER8s (L _ (ITprimint8 src _)) = src -getPRIMINTEGER16s (L _ (ITprimint16 src _)) = src -getPRIMINTEGER32s (L _ (ITprimint32 src _)) = src -getPRIMINTEGER64s (L _ (ITprimint64 src _)) = src -getPRIMWORD8s (L _ (ITprimword8 src _)) = src -getPRIMWORD16s (L _ (ITprimword16 src _)) = src -getPRIMWORD32s (L _ (ITprimword32 src _)) = src -getPRIMWORD64s (L _ (ITprimword64 src _)) = src - -getLABELVARIDs (L _ (ITlabelvarid src _)) = src - --- See Note [Pragma source text] in "GHC.Types.SourceText" for the following -getINLINE_PRAGs (L _ (ITinline_prag _ inl _)) = inlineSpecSource inl -getOPAQUE_PRAGs (L _ (ITopaque_prag src)) = src -getSPEC_PRAGs (L _ (ITspec_prag src)) = src -getSPEC_INLINE_PRAGs (L _ (ITspec_inline_prag src _)) = src -getSOURCE_PRAGs (L _ (ITsource_prag src)) = src -getRULES_PRAGs (L _ (ITrules_prag src)) = src -getWARNING_PRAGs (L _ (ITwarning_prag src)) = src -getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src -getSCC_PRAGs (L _ (ITscc_prag src)) = src -getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src -getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src -getANN_PRAGs (L _ (ITann_prag src)) = src -getMINIMAL_PRAGs (L _ (ITminimal_prag src)) = src -getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src -getOVERLAPPING_PRAGs (L _ (IToverlapping_prag src)) = src -getOVERLAPS_PRAGs (L _ (IToverlaps_prag src)) = src -getINCOHERENT_PRAGs (L _ (ITincoherent_prag src)) = src -getCTYPEs (L _ (ITctype src)) = src - -getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) Nothing - -isUnicode :: Located Token -> Bool -isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITdarrow iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITdcolon iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITlarrow iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax -isUnicode (L _ (IToparenbar iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax -isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax -isUnicode (L _ ITlolly) = True -isUnicode _ = False - -hasE :: Located Token -> Bool -hasE (L _ (ITopenExpQuote HasE _)) = True -hasE (L _ (ITopenTExpQuote HasE)) = True -hasE _ = False - -getSCC :: Located Token -> P FastString -getSCC lt = do let s = getSTRING lt - -- We probably actually want to be more restrictive than this - if ' ' `elem` unpackFS s - then addFatalError $ mkPlainErrorMsgEnvelope (getLoc lt) $ PsErrSpaceInSCC - else return s - -stringLiteralToHsDocWst :: Located StringLiteral -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs) -stringLiteralToHsDocWst sl = reLoc $ lexStringLiteral parseIdentifier sl - --- Utilities for combining source spans -comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan -comb2 !a !b = combineHasLocs a b - -comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan -comb3 !a !b !c = combineSrcSpans (getHasLoc a) (combineHasLocs b c) - -comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan -comb4 !a !b !c !d = - combineSrcSpans (getHasLoc a) $ - combineSrcSpans (getHasLoc b) $ - combineSrcSpans (getHasLoc c) (getHasLoc d) - -comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan -comb5 !a !b !c !d !e = - combineSrcSpans (getHasLoc a) $ - combineSrcSpans (getHasLoc b) $ - combineSrcSpans (getHasLoc c) $ - combineSrcSpans (getHasLoc d) (getHasLoc e) +{-# LANGUAGE MonadComprehensions #-} + +-- | This module provides the generated Happy parser for Haskell. It exports +-- a number of parsers which may be used in any library that uses the GHC API. +-- A common usage pattern is to initialize the parser state with a given string +-- and then parse that string: +-- +-- @ +-- runParser :: ParserOpts -> String -> P a -> ParseResult a +-- runParser opts str parser = unP parser parseState +-- where +-- filename = "\" +-- location = mkRealSrcLoc (mkFastString filename) 1 1 +-- buffer = stringToStringBuffer str +-- parseState = initParserState opts buffer location +-- @ +module GHC.Parser + ( parseModule, parseSignature, parseImport, parseStatement, parseBackpack + , parseDeclaration, parseExpression, parsePattern + , parseTypeSignature + , parseStmt, parseIdentifier + , parseType, parseHeader + , parseModuleNoHaddock + ) +where + +-- base +import Control.Monad ( unless, liftM, when, (<=<) ) +import GHC.Exts +import Data.Maybe ( maybeToList ) +import Data.List.NonEmpty ( NonEmpty(..), head, init, last, tail ) +import qualified Data.List.NonEmpty as NE +import qualified Prelude -- for happy-generated code + +import GHC.Hs + +import GHC.Driver.Backpack.Syntax + +import GHC.Unit.Info +import GHC.Unit.Module +import GHC.Unit.Module.Warnings + +import GHC.Data.OrdList +import GHC.Data.BooleanFormula ( BooleanFormula(..), LBooleanFormula, mkTrue ) +import GHC.Data.FastString +import GHC.Data.Maybe ( orElse ) + +import GHC.Utils.Outputable +import GHC.Utils.Error +import GHC.Utils.Misc ( looksLikePackageName, fstOf3, sndOf3, thdOf3 ) +import GHC.Utils.Panic +import GHC.Prelude hiding ( head, init, last, tail ) +import qualified GHC.Data.Strict as Strict + +import GHC.Types.Name.Reader +import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOccFS) +import GHC.Types.SrcLoc +import GHC.Types.Basic +import GHC.Types.Error ( GhcHint(..) ) +import GHC.Types.Fixity +import GHC.Types.ForeignCall +import GHC.Types.SourceFile +import GHC.Types.SourceText +import GHC.Types.PkgQual + +import GHC.Core.Type ( Specificity(..) ) +import GHC.Core.Class ( FunDep ) +import GHC.Core.DataCon ( DataCon, dataConName ) + +import GHC.Parser.PostProcess +import GHC.Parser.PostProcess.Haddock +import GHC.Parser.Lexer +import GHC.Parser.HaddockLex +import GHC.Parser.Annotation +import GHC.Parser.Errors.Types +import GHC.Parser.Errors.Ppr () + +import GHC.Builtin.Types ( unitTyCon, unitDataCon, sumTyCon, + tupleTyCon, tupleDataCon, nilDataCon, + unboxedUnitTyCon, unboxedUnitDataCon, + listTyCon_RDR, consDataCon_RDR, + unrestrictedFunTyCon ) + +import Language.Haskell.Syntax.Basic (FieldLabelString(..)) + +import qualified Data.Semigroup as Semi +import qualified Data.Array as Happy_Data_Array +import qualified Data.Bits as Bits +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- parser produced by Happy Version 1.20.1.1 + +newtype HappyAbsSyn = HappyAbsSyn HappyAny +#if __GLASGOW_HASKELL__ >= 607 +type HappyAny = Happy_GHC_Exts.Any +#else +type HappyAny = forall a . a +#endif +newtype HappyWrap16 = HappyWrap16 (LocatedN RdrName) +happyIn16 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn16 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap16 x) +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn ) -> HappyWrap16 +happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut16 #-} +newtype HappyWrap17 = HappyWrap17 ([LHsUnit PackageName]) +happyIn17 :: ([LHsUnit PackageName]) -> (HappyAbsSyn ) +happyIn17 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap17 x) +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn ) -> HappyWrap17 +happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut17 #-} +newtype HappyWrap18 = HappyWrap18 (OrdList (LHsUnit PackageName)) +happyIn18 :: (OrdList (LHsUnit PackageName)) -> (HappyAbsSyn ) +happyIn18 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap18 x) +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn ) -> HappyWrap18 +happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut18 #-} +newtype HappyWrap19 = HappyWrap19 (LHsUnit PackageName) +happyIn19 :: (LHsUnit PackageName) -> (HappyAbsSyn ) +happyIn19 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap19 x) +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn ) -> HappyWrap19 +happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut19 #-} +newtype HappyWrap20 = HappyWrap20 (LHsUnitId PackageName) +happyIn20 :: (LHsUnitId PackageName) -> (HappyAbsSyn ) +happyIn20 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap20 x) +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn ) -> HappyWrap20 +happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut20 #-} +newtype HappyWrap21 = HappyWrap21 (OrdList (LHsModuleSubst PackageName)) +happyIn21 :: (OrdList (LHsModuleSubst PackageName)) -> (HappyAbsSyn ) +happyIn21 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap21 x) +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn ) -> HappyWrap21 +happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut21 #-} +newtype HappyWrap22 = HappyWrap22 (LHsModuleSubst PackageName) +happyIn22 :: (LHsModuleSubst PackageName) -> (HappyAbsSyn ) +happyIn22 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap22 x) +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn ) -> HappyWrap22 +happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut22 #-} +newtype HappyWrap23 = HappyWrap23 (LHsModuleId PackageName) +happyIn23 :: (LHsModuleId PackageName) -> (HappyAbsSyn ) +happyIn23 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap23 x) +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn ) -> HappyWrap23 +happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut23 #-} +newtype HappyWrap24 = HappyWrap24 (Located PackageName) +happyIn24 :: (Located PackageName) -> (HappyAbsSyn ) +happyIn24 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap24 x) +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn ) -> HappyWrap24 +happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut24 #-} +newtype HappyWrap25 = HappyWrap25 (Located FastString) +happyIn25 :: (Located FastString) -> (HappyAbsSyn ) +happyIn25 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap25 x) +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn ) -> HappyWrap25 +happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut25 #-} +newtype HappyWrap26 = HappyWrap26 (()) +happyIn26 :: (()) -> (HappyAbsSyn ) +happyIn26 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap26 x) +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn ) -> HappyWrap26 +happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut26 #-} +newtype HappyWrap27 = HappyWrap27 (Located FastString) +happyIn27 :: (Located FastString) -> (HappyAbsSyn ) +happyIn27 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap27 x) +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn ) -> HappyWrap27 +happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut27 #-} +newtype HappyWrap28 = HappyWrap28 (Maybe [LRenaming]) +happyIn28 :: (Maybe [LRenaming]) -> (HappyAbsSyn ) +happyIn28 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap28 x) +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn ) -> HappyWrap28 +happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut28 #-} +newtype HappyWrap29 = HappyWrap29 (OrdList LRenaming) +happyIn29 :: (OrdList LRenaming) -> (HappyAbsSyn ) +happyIn29 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap29 x) +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn ) -> HappyWrap29 +happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut29 #-} +newtype HappyWrap30 = HappyWrap30 (LRenaming) +happyIn30 :: (LRenaming) -> (HappyAbsSyn ) +happyIn30 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap30 x) +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn ) -> HappyWrap30 +happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut30 #-} +newtype HappyWrap31 = HappyWrap31 (OrdList (LHsUnitDecl PackageName)) +happyIn31 :: (OrdList (LHsUnitDecl PackageName)) -> (HappyAbsSyn ) +happyIn31 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap31 x) +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn ) -> HappyWrap31 +happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut31 #-} +newtype HappyWrap32 = HappyWrap32 (OrdList (LHsUnitDecl PackageName)) +happyIn32 :: (OrdList (LHsUnitDecl PackageName)) -> (HappyAbsSyn ) +happyIn32 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap32 x) +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn ) -> HappyWrap32 +happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut32 #-} +newtype HappyWrap33 = HappyWrap33 (LHsUnitDecl PackageName) +happyIn33 :: (LHsUnitDecl PackageName) -> (HappyAbsSyn ) +happyIn33 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap33 x) +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn ) -> HappyWrap33 +happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut33 #-} +newtype HappyWrap34 = HappyWrap34 (Located (HsModule GhcPs)) +happyIn34 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) +happyIn34 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap34 x) +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn ) -> HappyWrap34 +happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut34 #-} +newtype HappyWrap35 = HappyWrap35 (Located (HsModule GhcPs)) +happyIn35 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) +happyIn35 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap35 x) +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn ) -> HappyWrap35 +happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut35 #-} +newtype HappyWrap36 = HappyWrap36 (()) +happyIn36 :: (()) -> (HappyAbsSyn ) +happyIn36 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap36 x) +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn ) -> HappyWrap36 +happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut36 #-} +newtype HappyWrap37 = HappyWrap37 (()) +happyIn37 :: (()) -> (HappyAbsSyn ) +happyIn37 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap37 x) +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn ) -> HappyWrap37 +happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut37 #-} +newtype HappyWrap38 = HappyWrap38 (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]) + ,EpLayout)) +happyIn38 :: (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]) + ,EpLayout)) -> (HappyAbsSyn ) +happyIn38 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap38 x) +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn ) -> HappyWrap38 +happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut38 #-} +newtype HappyWrap39 = HappyWrap39 (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]) + ,EpLayout)) +happyIn39 :: (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]) + ,EpLayout)) -> (HappyAbsSyn ) +happyIn39 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap39 x) +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn ) -> HappyWrap39 +happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut39 #-} +newtype HappyWrap40 = HappyWrap40 (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]))) +happyIn40 :: (([TrailingAnn] + ,([LImportDecl GhcPs], [LHsDecl GhcPs]))) -> (HappyAbsSyn ) +happyIn40 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap40 x) +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn ) -> HappyWrap40 +happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut40 #-} +newtype HappyWrap41 = HappyWrap41 (([LImportDecl GhcPs], [LHsDecl GhcPs])) +happyIn41 :: (([LImportDecl GhcPs], [LHsDecl GhcPs])) -> (HappyAbsSyn ) +happyIn41 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap41 x) +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn ) -> HappyWrap41 +happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut41 #-} +newtype HappyWrap42 = HappyWrap42 (Located (HsModule GhcPs)) +happyIn42 :: (Located (HsModule GhcPs)) -> (HappyAbsSyn ) +happyIn42 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap42 x) +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn ) -> HappyWrap42 +happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut42 #-} +newtype HappyWrap43 = HappyWrap43 ([LImportDecl GhcPs]) +happyIn43 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn43 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap43 x) +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn ) -> HappyWrap43 +happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut43 #-} +newtype HappyWrap44 = HappyWrap44 ([LImportDecl GhcPs]) +happyIn44 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn44 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap44 x) +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn ) -> HappyWrap44 +happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut44 #-} +newtype HappyWrap45 = HappyWrap45 ([LImportDecl GhcPs]) +happyIn45 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn45 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap45 x) +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn ) -> HappyWrap45 +happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut45 #-} +newtype HappyWrap46 = HappyWrap46 ([LImportDecl GhcPs]) +happyIn46 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn46 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap46 x) +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn ) -> HappyWrap46 +happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut46 #-} +newtype HappyWrap47 = HappyWrap47 ((Maybe (LocatedLI [LIE GhcPs]))) +happyIn47 :: ((Maybe (LocatedLI [LIE GhcPs]))) -> (HappyAbsSyn ) +happyIn47 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap47 x) +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn ) -> HappyWrap47 +happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut47 #-} +newtype HappyWrap48 = HappyWrap48 (([EpToken ","], OrdList (LIE GhcPs))) +happyIn48 :: (([EpToken ","], OrdList (LIE GhcPs))) -> (HappyAbsSyn ) +happyIn48 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap48 x) +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn ) -> HappyWrap48 +happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut48 #-} +newtype HappyWrap49 = HappyWrap49 (OrdList (LIE GhcPs)) +happyIn49 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) +happyIn49 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap49 x) +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn ) -> HappyWrap49 +happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut49 #-} +newtype HappyWrap50 = HappyWrap50 (OrdList (LIE GhcPs)) +happyIn50 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) +happyIn50 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap50 x) +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn ) -> HappyWrap50 +happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut50 #-} +newtype HappyWrap51 = HappyWrap51 (LIE GhcPs) +happyIn51 :: (LIE GhcPs) -> (HappyAbsSyn ) +happyIn51 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap51 x) +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn ) -> HappyWrap51 +happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut51 #-} +newtype HappyWrap52 = HappyWrap52 (Located ((EpToken "(", EpToken ")"), ImpExpSubSpec)) +happyIn52 :: (Located ((EpToken "(", EpToken ")"), ImpExpSubSpec)) -> (HappyAbsSyn ) +happyIn52 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap52 x) +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn ) -> HappyWrap52 +happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut52 #-} +newtype HappyWrap53 = HappyWrap53 ([LocatedA ImpExpQcSpec]) +happyIn53 :: ([LocatedA ImpExpQcSpec]) -> (HappyAbsSyn ) +happyIn53 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap53 x) +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn ) -> HappyWrap53 +happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut53 #-} +newtype HappyWrap54 = HappyWrap54 ([LocatedA ImpExpQcSpec]) +happyIn54 :: ([LocatedA ImpExpQcSpec]) -> (HappyAbsSyn ) +happyIn54 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap54 x) +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn ) -> HappyWrap54 +happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut54 #-} +newtype HappyWrap55 = HappyWrap55 (LocatedA ImpExpQcSpec) +happyIn55 :: (LocatedA ImpExpQcSpec) -> (HappyAbsSyn ) +happyIn55 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap55 x) +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn ) -> HappyWrap55 +happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut55 #-} +newtype HappyWrap56 = HappyWrap56 (LocatedA ImpExpQcSpec) +happyIn56 :: (LocatedA ImpExpQcSpec) -> (HappyAbsSyn ) +happyIn56 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap56 x) +{-# INLINE happyIn56 #-} +happyOut56 :: (HappyAbsSyn ) -> HappyWrap56 +happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut56 #-} +newtype HappyWrap57 = HappyWrap57 (LocatedN RdrName) +happyIn57 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn57 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap57 x) +{-# INLINE happyIn57 #-} +happyOut57 :: (HappyAbsSyn ) -> HappyWrap57 +happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut57 #-} +newtype HappyWrap58 = HappyWrap58 (Located [TrailingAnn]) +happyIn58 :: (Located [TrailingAnn]) -> (HappyAbsSyn ) +happyIn58 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap58 x) +{-# INLINE happyIn58 #-} +happyOut58 :: (HappyAbsSyn ) -> HappyWrap58 +happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut58 #-} +newtype HappyWrap59 = HappyWrap59 ([TrailingAnn]) +happyIn59 :: ([TrailingAnn]) -> (HappyAbsSyn ) +happyIn59 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap59 x) +{-# INLINE happyIn59 #-} +happyOut59 :: (HappyAbsSyn ) -> HappyWrap59 +happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut59 #-} +newtype HappyWrap60 = HappyWrap60 ([LImportDecl GhcPs]) +happyIn60 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn60 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap60 x) +{-# INLINE happyIn60 #-} +happyOut60 :: (HappyAbsSyn ) -> HappyWrap60 +happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut60 #-} +newtype HappyWrap61 = HappyWrap61 ([LImportDecl GhcPs]) +happyIn61 :: ([LImportDecl GhcPs]) -> (HappyAbsSyn ) +happyIn61 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap61 x) +{-# INLINE happyIn61 #-} +happyOut61 :: (HappyAbsSyn ) -> HappyWrap61 +happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut61 #-} +newtype HappyWrap62 = HappyWrap62 (LImportDecl GhcPs) +happyIn62 :: (LImportDecl GhcPs) -> (HappyAbsSyn ) +happyIn62 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap62 x) +{-# INLINE happyIn62 #-} +happyOut62 :: (HappyAbsSyn ) -> HappyWrap62 +happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut62 #-} +newtype HappyWrap63 = HappyWrap63 (((Maybe (EpaLocation,EpToken "#-}"),SourceText),IsBootInterface)) +happyIn63 :: (((Maybe (EpaLocation,EpToken "#-}"),SourceText),IsBootInterface)) -> (HappyAbsSyn ) +happyIn63 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap63 x) +{-# INLINE happyIn63 #-} +happyOut63 :: (HappyAbsSyn ) -> HappyWrap63 +happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut63 #-} +newtype HappyWrap64 = HappyWrap64 ((Maybe (EpToken "safe"),Bool)) +happyIn64 :: ((Maybe (EpToken "safe"),Bool)) -> (HappyAbsSyn ) +happyIn64 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap64 x) +{-# INLINE happyIn64 #-} +happyOut64 :: (HappyAbsSyn ) -> HappyWrap64 +happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut64 #-} +newtype HappyWrap65 = HappyWrap65 ((Maybe EpAnnLevel)) +happyIn65 :: ((Maybe EpAnnLevel)) -> (HappyAbsSyn ) +happyIn65 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap65 x) +{-# INLINE happyIn65 #-} +happyOut65 :: (HappyAbsSyn ) -> HappyWrap65 +happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut65 #-} +newtype HappyWrap66 = HappyWrap66 ((Maybe EpaLocation, RawPkgQual)) +happyIn66 :: ((Maybe EpaLocation, RawPkgQual)) -> (HappyAbsSyn ) +happyIn66 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap66 x) +{-# INLINE happyIn66 #-} +happyOut66 :: (HappyAbsSyn ) -> HappyWrap66 +happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut66 #-} +newtype HappyWrap67 = HappyWrap67 (Maybe (EpToken "qualified")) +happyIn67 :: (Maybe (EpToken "qualified")) -> (HappyAbsSyn ) +happyIn67 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap67 x) +{-# INLINE happyIn67 #-} +happyOut67 :: (HappyAbsSyn ) -> HappyWrap67 +happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut67 #-} +newtype HappyWrap68 = HappyWrap68 ((Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName)))) +happyIn68 :: ((Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName)))) -> (HappyAbsSyn ) +happyIn68 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap68 x) +{-# INLINE happyIn68 #-} +happyOut68 :: (HappyAbsSyn ) -> HappyWrap68 +happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut68 #-} +newtype HappyWrap69 = HappyWrap69 (Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs]))) +happyIn69 :: (Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs]))) -> (HappyAbsSyn ) +happyIn69 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap69 x) +{-# INLINE happyIn69 #-} +happyOut69 :: (HappyAbsSyn ) -> HappyWrap69 +happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut69 #-} +newtype HappyWrap70 = HappyWrap70 (Located (ImportListInterpretation, LocatedLI [LIE GhcPs])) +happyIn70 :: (Located (ImportListInterpretation, LocatedLI [LIE GhcPs])) -> (HappyAbsSyn ) +happyIn70 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap70 x) +{-# INLINE happyIn70 #-} +happyOut70 :: (HappyAbsSyn ) -> HappyWrap70 +happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut70 #-} +newtype HappyWrap71 = HappyWrap71 (([EpToken ","], OrdList (LIE GhcPs))) +happyIn71 :: (([EpToken ","], OrdList (LIE GhcPs))) -> (HappyAbsSyn ) +happyIn71 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap71 x) +{-# INLINE happyIn71 #-} +happyOut71 :: (HappyAbsSyn ) -> HappyWrap71 +happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut71 #-} +newtype HappyWrap72 = HappyWrap72 (OrdList (LIE GhcPs)) +happyIn72 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) +happyIn72 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap72 x) +{-# INLINE happyIn72 #-} +happyOut72 :: (HappyAbsSyn ) -> HappyWrap72 +happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut72 #-} +newtype HappyWrap73 = HappyWrap73 (OrdList (LIE GhcPs)) +happyIn73 :: (OrdList (LIE GhcPs)) -> (HappyAbsSyn ) +happyIn73 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap73 x) +{-# INLINE happyIn73 #-} +happyOut73 :: (HappyAbsSyn ) -> HappyWrap73 +happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut73 #-} +newtype HappyWrap74 = HappyWrap74 (Maybe (Located (SourceText,Int))) +happyIn74 :: (Maybe (Located (SourceText,Int))) -> (HappyAbsSyn ) +happyIn74 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap74 x) +{-# INLINE happyIn74 #-} +happyOut74 :: (HappyAbsSyn ) -> HappyWrap74 +happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut74 #-} +newtype HappyWrap75 = HappyWrap75 (Located FixityDirection) +happyIn75 :: (Located FixityDirection) -> (HappyAbsSyn ) +happyIn75 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap75 x) +{-# INLINE happyIn75 #-} +happyOut75 :: (HappyAbsSyn ) -> HappyWrap75 +happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut75 #-} +newtype HappyWrap76 = HappyWrap76 (Located (OrdList (LocatedN RdrName))) +happyIn76 :: (Located (OrdList (LocatedN RdrName))) -> (HappyAbsSyn ) +happyIn76 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap76 x) +{-# INLINE happyIn76 #-} +happyOut76 :: (HappyAbsSyn ) -> HappyWrap76 +happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut76 #-} +newtype HappyWrap77 = HappyWrap77 (OrdList (LHsDecl GhcPs)) +happyIn77 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) +happyIn77 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap77 x) +{-# INLINE happyIn77 #-} +happyOut77 :: (HappyAbsSyn ) -> HappyWrap77 +happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut77 #-} +newtype HappyWrap78 = HappyWrap78 (OrdList (LHsDecl GhcPs)) +happyIn78 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) +happyIn78 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap78 x) +{-# INLINE happyIn78 #-} +happyOut78 :: (HappyAbsSyn ) -> HappyWrap78 +happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut78 #-} +newtype HappyWrap79 = HappyWrap79 (OrdList (LHsDecl GhcPs)) +happyIn79 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) +happyIn79 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap79 x) +{-# INLINE happyIn79 #-} +happyOut79 :: (HappyAbsSyn ) -> HappyWrap79 +happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut79 #-} +newtype HappyWrap80 = HappyWrap80 (OrdList (LHsDecl GhcPs)) +happyIn80 :: (OrdList (LHsDecl GhcPs)) -> (HappyAbsSyn ) +happyIn80 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap80 x) +{-# INLINE happyIn80 #-} +happyOut80 :: (HappyAbsSyn ) -> HappyWrap80 +happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut80 #-} +newtype HappyWrap81 = HappyWrap81 (LHsDecl GhcPs) +happyIn81 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn81 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap81 x) +{-# INLINE happyIn81 #-} +happyOut81 :: (HappyAbsSyn ) -> HappyWrap81 +happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut81 #-} +newtype HappyWrap82 = HappyWrap82 (LHsDecl GhcPs) +happyIn82 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn82 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap82 x) +{-# INLINE happyIn82 #-} +happyOut82 :: (HappyAbsSyn ) -> HappyWrap82 +happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut82 #-} +newtype HappyWrap83 = HappyWrap83 (LTyClDecl GhcPs) +happyIn83 :: (LTyClDecl GhcPs) -> (HappyAbsSyn ) +happyIn83 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap83 x) +{-# INLINE happyIn83 #-} +happyOut83 :: (HappyAbsSyn ) -> HappyWrap83 +happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut83 #-} +newtype HappyWrap84 = HappyWrap84 (LDefaultDecl GhcPs) +happyIn84 :: (LDefaultDecl GhcPs) -> (HappyAbsSyn ) +happyIn84 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap84 x) +{-# INLINE happyIn84 #-} +happyOut84 :: (HappyAbsSyn ) -> HappyWrap84 +happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut84 #-} +newtype HappyWrap85 = HappyWrap85 (LTyClDecl GhcPs) +happyIn85 :: (LTyClDecl GhcPs) -> (HappyAbsSyn ) +happyIn85 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap85 x) +{-# INLINE happyIn85 #-} +happyOut85 :: (HappyAbsSyn ) -> HappyWrap85 +happyOut85 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut85 #-} +newtype HappyWrap86 = HappyWrap86 (LStandaloneKindSig GhcPs) +happyIn86 :: (LStandaloneKindSig GhcPs) -> (HappyAbsSyn ) +happyIn86 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap86 x) +{-# INLINE happyIn86 #-} +happyOut86 :: (HappyAbsSyn ) -> HappyWrap86 +happyOut86 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut86 #-} +newtype HappyWrap87 = HappyWrap87 (Located [LocatedN RdrName]) +happyIn87 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn87 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap87 x) +{-# INLINE happyIn87 #-} +happyOut87 :: (HappyAbsSyn ) -> HappyWrap87 +happyOut87 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut87 #-} +newtype HappyWrap88 = HappyWrap88 (LInstDecl GhcPs) +happyIn88 :: (LInstDecl GhcPs) -> (HappyAbsSyn ) +happyIn88 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap88 x) +{-# INLINE happyIn88 #-} +happyOut88 :: (HappyAbsSyn ) -> HappyWrap88 +happyOut88 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut88 #-} +newtype HappyWrap89 = HappyWrap89 (Maybe (LocatedP OverlapMode)) +happyIn89 :: (Maybe (LocatedP OverlapMode)) -> (HappyAbsSyn ) +happyIn89 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap89 x) +{-# INLINE happyIn89 #-} +happyOut89 :: (HappyAbsSyn ) -> HappyWrap89 +happyOut89 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut89 #-} +newtype HappyWrap90 = HappyWrap90 (LDerivStrategy GhcPs) +happyIn90 :: (LDerivStrategy GhcPs) -> (HappyAbsSyn ) +happyIn90 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap90 x) +{-# INLINE happyIn90 #-} +happyOut90 :: (HappyAbsSyn ) -> HappyWrap90 +happyOut90 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut90 #-} +newtype HappyWrap91 = HappyWrap91 (LDerivStrategy GhcPs) +happyIn91 :: (LDerivStrategy GhcPs) -> (HappyAbsSyn ) +happyIn91 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap91 x) +{-# INLINE happyIn91 #-} +happyOut91 :: (HappyAbsSyn ) -> HappyWrap91 +happyOut91 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut91 #-} +newtype HappyWrap92 = HappyWrap92 (Maybe (LDerivStrategy GhcPs)) +happyIn92 :: (Maybe (LDerivStrategy GhcPs)) -> (HappyAbsSyn ) +happyIn92 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap92 x) +{-# INLINE happyIn92 #-} +happyOut92 :: (HappyAbsSyn ) -> HappyWrap92 +happyOut92 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut92 #-} +newtype HappyWrap93 = HappyWrap93 (Maybe (LIdP GhcPs)) +happyIn93 :: (Maybe (LIdP GhcPs)) -> (HappyAbsSyn ) +happyIn93 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap93 x) +{-# INLINE happyIn93 #-} +happyOut93 :: (HappyAbsSyn ) -> HappyWrap93 +happyOut93 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut93 #-} +newtype HappyWrap94 = HappyWrap94 (Located (EpToken "|", Maybe (LInjectivityAnn GhcPs))) +happyIn94 :: (Located (EpToken "|", Maybe (LInjectivityAnn GhcPs))) -> (HappyAbsSyn ) +happyIn94 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap94 x) +{-# INLINE happyIn94 #-} +happyOut94 :: (HappyAbsSyn ) -> HappyWrap94 +happyOut94 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut94 #-} +newtype HappyWrap95 = HappyWrap95 (LInjectivityAnn GhcPs) +happyIn95 :: (LInjectivityAnn GhcPs) -> (HappyAbsSyn ) +happyIn95 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap95 x) +{-# INLINE happyIn95 #-} +happyOut95 :: (HappyAbsSyn ) -> HappyWrap95 +happyOut95 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut95 #-} +newtype HappyWrap96 = HappyWrap96 (Located [LocatedN RdrName]) +happyIn96 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn96 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap96 x) +{-# INLINE happyIn96 #-} +happyOut96 :: (HappyAbsSyn ) -> HappyWrap96 +happyOut96 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut96 #-} +newtype HappyWrap97 = HappyWrap97 (Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs)) +happyIn97 :: (Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs)) -> (HappyAbsSyn ) +happyIn97 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap97 x) +{-# INLINE happyIn97 #-} +happyOut97 :: (HappyAbsSyn ) -> HappyWrap97 +happyOut97 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut97 #-} +newtype HappyWrap98 = HappyWrap98 (Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs])) +happyIn98 :: (Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs])) -> (HappyAbsSyn ) +happyIn98 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap98 x) +{-# INLINE happyIn98 #-} +happyOut98 :: (HappyAbsSyn ) -> HappyWrap98 +happyOut98 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut98 #-} +newtype HappyWrap99 = HappyWrap99 (Located [LTyFamInstEqn GhcPs]) +happyIn99 :: (Located [LTyFamInstEqn GhcPs]) -> (HappyAbsSyn ) +happyIn99 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap99 x) +{-# INLINE happyIn99 #-} +happyOut99 :: (HappyAbsSyn ) -> HappyWrap99 +happyOut99 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut99 #-} +newtype HappyWrap100 = HappyWrap100 (LTyFamInstEqn GhcPs) +happyIn100 :: (LTyFamInstEqn GhcPs) -> (HappyAbsSyn ) +happyIn100 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap100 x) +{-# INLINE happyIn100 #-} +happyOut100 :: (HappyAbsSyn ) -> HappyWrap100 +happyOut100 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut100 #-} +newtype HappyWrap101 = HappyWrap101 (LHsDecl GhcPs) +happyIn101 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn101 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap101 x) +{-# INLINE happyIn101 #-} +happyOut101 :: (HappyAbsSyn ) -> HappyWrap101 +happyOut101 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut101 #-} +newtype HappyWrap102 = HappyWrap102 (EpToken "family") +happyIn102 :: (EpToken "family") -> (HappyAbsSyn ) +happyIn102 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap102 x) +{-# INLINE happyIn102 #-} +happyOut102 :: (HappyAbsSyn ) -> HappyWrap102 +happyOut102 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut102 #-} +newtype HappyWrap103 = HappyWrap103 (EpToken "instance") +happyIn103 :: (EpToken "instance") -> (HappyAbsSyn ) +happyIn103 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap103 x) +{-# INLINE happyIn103 #-} +happyOut103 :: (HappyAbsSyn ) -> HappyWrap103 +happyOut103 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut103 #-} +newtype HappyWrap104 = HappyWrap104 (LInstDecl GhcPs) +happyIn104 :: (LInstDecl GhcPs) -> (HappyAbsSyn ) +happyIn104 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap104 x) +{-# INLINE happyIn104 #-} +happyOut104 :: (HappyAbsSyn ) -> HappyWrap104 +happyOut104 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut104 #-} +newtype HappyWrap105 = HappyWrap105 (Located ((EpToken "data", EpToken "newtype", EpToken "type") + , Bool, NewOrData)) +happyIn105 :: (Located ((EpToken "data", EpToken "newtype", EpToken "type") + , Bool, NewOrData)) -> (HappyAbsSyn ) +happyIn105 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap105 x) +{-# INLINE happyIn105 #-} +happyOut105 :: (HappyAbsSyn ) -> HappyWrap105 +happyOut105 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut105 #-} +newtype HappyWrap106 = HappyWrap106 (Located ((EpToken "data", EpToken "newtype"), NewOrData)) +happyIn106 :: (Located ((EpToken "data", EpToken "newtype"), NewOrData)) -> (HappyAbsSyn ) +happyIn106 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap106 x) +{-# INLINE happyIn106 #-} +happyOut106 :: (HappyAbsSyn ) -> HappyWrap106 +happyOut106 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut106 #-} +newtype HappyWrap107 = HappyWrap107 (Located (TokDcolon, Maybe (LHsKind GhcPs))) +happyIn107 :: (Located (TokDcolon, Maybe (LHsKind GhcPs))) -> (HappyAbsSyn ) +happyIn107 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap107 x) +{-# INLINE happyIn107 #-} +happyOut107 :: (HappyAbsSyn ) -> HappyWrap107 +happyOut107 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut107 #-} +newtype HappyWrap108 = HappyWrap108 (Located (TokDcolon, LFamilyResultSig GhcPs)) +happyIn108 :: (Located (TokDcolon, LFamilyResultSig GhcPs)) -> (HappyAbsSyn ) +happyIn108 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap108 x) +{-# INLINE happyIn108 #-} +happyOut108 :: (HappyAbsSyn ) -> HappyWrap108 +happyOut108 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut108 #-} +newtype HappyWrap109 = HappyWrap109 (Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs)) +happyIn109 :: (Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs)) -> (HappyAbsSyn ) +happyIn109 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap109 x) +{-# INLINE happyIn109 #-} +happyOut109 :: (HappyAbsSyn ) -> HappyWrap109 +happyOut109 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut109 #-} +newtype HappyWrap110 = HappyWrap110 (Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs + , Maybe (LInjectivityAnn GhcPs)))) +happyIn110 :: (Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs + , Maybe (LInjectivityAnn GhcPs)))) -> (HappyAbsSyn ) +happyIn110 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap110 x) +{-# INLINE happyIn110 #-} +happyOut110 :: (HappyAbsSyn ) -> HappyWrap110 +happyOut110 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut110 #-} +newtype HappyWrap111 = HappyWrap111 (Located (Maybe (LHsContext GhcPs), LHsType GhcPs)) +happyIn111 :: (Located (Maybe (LHsContext GhcPs), LHsType GhcPs)) -> (HappyAbsSyn ) +happyIn111 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap111 x) +{-# INLINE happyIn111 #-} +happyOut111 :: (HappyAbsSyn ) -> HappyWrap111 +happyOut111 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut111 #-} +newtype HappyWrap112 = HappyWrap112 (Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs)) +happyIn112 :: (Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs)) -> (HappyAbsSyn ) +happyIn112 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap112 x) +{-# INLINE happyIn112 #-} +happyOut112 :: (HappyAbsSyn ) -> HappyWrap112 +happyOut112 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut112 #-} +newtype HappyWrap113 = HappyWrap113 (Maybe (LocatedP CType)) +happyIn113 :: (Maybe (LocatedP CType)) -> (HappyAbsSyn ) +happyIn113 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap113 x) +{-# INLINE happyIn113 #-} +happyOut113 :: (HappyAbsSyn ) -> HappyWrap113 +happyOut113 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut113 #-} +newtype HappyWrap114 = HappyWrap114 (LDerivDecl GhcPs) +happyIn114 :: (LDerivDecl GhcPs) -> (HappyAbsSyn ) +happyIn114 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap114 x) +{-# INLINE happyIn114 #-} +happyOut114 :: (HappyAbsSyn ) -> HappyWrap114 +happyOut114 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut114 #-} +newtype HappyWrap115 = HappyWrap115 (LRoleAnnotDecl GhcPs) +happyIn115 :: (LRoleAnnotDecl GhcPs) -> (HappyAbsSyn ) +happyIn115 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap115 x) +{-# INLINE happyIn115 #-} +happyOut115 :: (HappyAbsSyn ) -> HappyWrap115 +happyOut115 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut115 #-} +newtype HappyWrap116 = HappyWrap116 (Located [Located (Maybe FastString)]) +happyIn116 :: (Located [Located (Maybe FastString)]) -> (HappyAbsSyn ) +happyIn116 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap116 x) +{-# INLINE happyIn116 #-} +happyOut116 :: (HappyAbsSyn ) -> HappyWrap116 +happyOut116 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut116 #-} +newtype HappyWrap117 = HappyWrap117 (Located [Located (Maybe FastString)]) +happyIn117 :: (Located [Located (Maybe FastString)]) -> (HappyAbsSyn ) +happyIn117 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap117 x) +{-# INLINE happyIn117 #-} +happyOut117 :: (HappyAbsSyn ) -> HappyWrap117 +happyOut117 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut117 #-} +newtype HappyWrap118 = HappyWrap118 (Located (Maybe FastString)) +happyIn118 :: (Located (Maybe FastString)) -> (HappyAbsSyn ) +happyIn118 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap118 x) +{-# INLINE happyIn118 #-} +happyOut118 :: (HappyAbsSyn ) -> HappyWrap118 +happyOut118 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut118 #-} +newtype HappyWrap119 = HappyWrap119 (LHsDecl GhcPs) +happyIn119 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn119 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap119 x) +{-# INLINE happyIn119 #-} +happyOut119 :: (HappyAbsSyn ) -> HappyWrap119 +happyOut119 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut119 #-} +newtype HappyWrap120 = HappyWrap120 ((LocatedN RdrName, HsPatSynDetails GhcPs, (Maybe (EpToken "{"), Maybe (EpToken "}")))) +happyIn120 :: ((LocatedN RdrName, HsPatSynDetails GhcPs, (Maybe (EpToken "{"), Maybe (EpToken "}")))) -> (HappyAbsSyn ) +happyIn120 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap120 x) +{-# INLINE happyIn120 #-} +happyOut120 :: (HappyAbsSyn ) -> HappyWrap120 +happyOut120 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut120 #-} +newtype HappyWrap121 = HappyWrap121 ([LocatedN RdrName]) +happyIn121 :: ([LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn121 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap121 x) +{-# INLINE happyIn121 #-} +happyOut121 :: (HappyAbsSyn ) -> HappyWrap121 +happyOut121 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut121 #-} +newtype HappyWrap122 = HappyWrap122 ([RecordPatSynField GhcPs]) +happyIn122 :: ([RecordPatSynField GhcPs]) -> (HappyAbsSyn ) +happyIn122 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap122 x) +{-# INLINE happyIn122 #-} +happyOut122 :: (HappyAbsSyn ) -> HappyWrap122 +happyOut122 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut122 #-} +newtype HappyWrap123 = HappyWrap123 (LocatedLW (OrdList (LHsDecl GhcPs))) +happyIn123 :: (LocatedLW (OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn123 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap123 x) +{-# INLINE happyIn123 #-} +happyOut123 :: (HappyAbsSyn ) -> HappyWrap123 +happyOut123 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut123 #-} +newtype HappyWrap124 = HappyWrap124 (LSig GhcPs) +happyIn124 :: (LSig GhcPs) -> (HappyAbsSyn ) +happyIn124 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap124 x) +{-# INLINE happyIn124 #-} +happyOut124 :: (HappyAbsSyn ) -> HappyWrap124 +happyOut124 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut124 #-} +newtype HappyWrap125 = HappyWrap125 (LocatedN RdrName) +happyIn125 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn125 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap125 x) +{-# INLINE happyIn125 #-} +happyOut125 :: (HappyAbsSyn ) -> HappyWrap125 +happyOut125 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut125 #-} +newtype HappyWrap126 = HappyWrap126 (LHsDecl GhcPs) +happyIn126 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn126 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap126 x) +{-# INLINE happyIn126 #-} +happyOut126 :: (HappyAbsSyn ) -> HappyWrap126 +happyOut126 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut126 #-} +newtype HappyWrap127 = HappyWrap127 (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) +happyIn127 :: (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn127 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap127 x) +{-# INLINE happyIn127 #-} +happyOut127 :: (HappyAbsSyn ) -> HappyWrap127 +happyOut127 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut127 #-} +newtype HappyWrap128 = HappyWrap128 (Located ((EpToken "{", [EpToken ";"], EpToken "}") + , OrdList (LHsDecl GhcPs) + , EpLayout)) +happyIn128 :: (Located ((EpToken "{", [EpToken ";"], EpToken "}") + , OrdList (LHsDecl GhcPs) + , EpLayout)) -> (HappyAbsSyn ) +happyIn128 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap128 x) +{-# INLINE happyIn128 #-} +happyOut128 :: (HappyAbsSyn ) -> HappyWrap128 +happyOut128 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut128 #-} +newtype HappyWrap129 = HappyWrap129 (Located ((EpToken "where", (EpToken "{", [EpToken ";"], EpToken "}")) + ,(OrdList (LHsDecl GhcPs)) -- Reversed + ,EpLayout)) +happyIn129 :: (Located ((EpToken "where", (EpToken "{", [EpToken ";"], EpToken "}")) + ,(OrdList (LHsDecl GhcPs)) -- Reversed + ,EpLayout)) -> (HappyAbsSyn ) +happyIn129 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap129 x) +{-# INLINE happyIn129 #-} +happyOut129 :: (HappyAbsSyn ) -> HappyWrap129 +happyOut129 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut129 #-} +newtype HappyWrap130 = HappyWrap130 (Located (OrdList (LHsDecl GhcPs))) +happyIn130 :: (Located (OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn130 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap130 x) +{-# INLINE happyIn130 #-} +happyOut130 :: (HappyAbsSyn ) -> HappyWrap130 +happyOut130 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut130 #-} +newtype HappyWrap131 = HappyWrap131 (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) +happyIn131 :: (Located ([EpToken ";"],OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn131 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap131 x) +{-# INLINE happyIn131 #-} +happyOut131 :: (HappyAbsSyn ) -> HappyWrap131 +happyOut131 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut131 #-} +newtype HappyWrap132 = HappyWrap132 (Located ((EpToken "{", EpToken "}", [EpToken ";"]) + , OrdList (LHsDecl GhcPs))) +happyIn132 :: (Located ((EpToken "{", EpToken "}", [EpToken ";"]) + , OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn132 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap132 x) +{-# INLINE happyIn132 #-} +happyOut132 :: (HappyAbsSyn ) -> HappyWrap132 +happyOut132 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut132 #-} +newtype HappyWrap133 = HappyWrap133 (Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"])) + , OrdList (LHsDecl GhcPs))) +happyIn133 :: (Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken ";"])) + , OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn133 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap133 x) +{-# INLINE happyIn133 #-} +happyOut133 :: (HappyAbsSyn ) -> HappyWrap133 +happyOut133 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut133 #-} +newtype HappyWrap134 = HappyWrap134 (Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs))) +happyIn134 :: (Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs))) -> (HappyAbsSyn ) +happyIn134 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap134 x) +{-# INLINE happyIn134 #-} +happyOut134 :: (HappyAbsSyn ) -> HappyWrap134 +happyOut134 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut134 #-} +newtype HappyWrap135 = HappyWrap135 (Located (AnnList (),Located (OrdList (LHsDecl GhcPs)))) +happyIn135 :: (Located (AnnList (),Located (OrdList (LHsDecl GhcPs)))) -> (HappyAbsSyn ) +happyIn135 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap135 x) +{-# INLINE happyIn135 #-} +happyOut135 :: (HappyAbsSyn ) -> HappyWrap135 +happyOut135 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut135 #-} +newtype HappyWrap136 = HappyWrap136 (Located (HsLocalBinds GhcPs)) +happyIn136 :: (Located (HsLocalBinds GhcPs)) -> (HappyAbsSyn ) +happyIn136 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap136 x) +{-# INLINE happyIn136 #-} +happyOut136 :: (HappyAbsSyn ) -> HappyWrap136 +happyOut136 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut136 #-} +newtype HappyWrap137 = HappyWrap137 (Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments ))) +happyIn137 :: (Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments ))) -> (HappyAbsSyn ) +happyIn137 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap137 x) +{-# INLINE happyIn137 #-} +happyOut137 :: (HappyAbsSyn ) -> HappyWrap137 +happyOut137 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut137 #-} +newtype HappyWrap138 = HappyWrap138 ([LRuleDecl GhcPs]) +happyIn138 :: ([LRuleDecl GhcPs]) -> (HappyAbsSyn ) +happyIn138 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap138 x) +{-# INLINE happyIn138 #-} +happyOut138 :: (HappyAbsSyn ) -> HappyWrap138 +happyOut138 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut138 #-} +newtype HappyWrap139 = HappyWrap139 (LRuleDecl GhcPs) +happyIn139 :: (LRuleDecl GhcPs) -> (HappyAbsSyn ) +happyIn139 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap139 x) +{-# INLINE happyIn139 #-} +happyOut139 :: (HappyAbsSyn ) -> HappyWrap139 +happyOut139 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut139 #-} +newtype HappyWrap140 = HappyWrap140 ((ActivationAnn, Maybe Activation)) +happyIn140 :: ((ActivationAnn, Maybe Activation)) -> (HappyAbsSyn ) +happyIn140 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap140 x) +{-# INLINE happyIn140 #-} +happyOut140 :: (HappyAbsSyn ) -> HappyWrap140 +happyOut140 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut140 #-} +newtype HappyWrap141 = HappyWrap141 ((Maybe (EpToken "~"))) +happyIn141 :: ((Maybe (EpToken "~"))) -> (HappyAbsSyn ) +happyIn141 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap141 x) +{-# INLINE happyIn141 #-} +happyOut141 :: (HappyAbsSyn ) -> HappyWrap141 +happyOut141 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut141 #-} +newtype HappyWrap142 = HappyWrap142 (( ActivationAnn + , Activation)) +happyIn142 :: (( ActivationAnn + , Activation)) -> (HappyAbsSyn ) +happyIn142 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap142 x) +{-# INLINE happyIn142 #-} +happyOut142 :: (HappyAbsSyn ) -> HappyWrap142 +happyOut142 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut142 #-} +newtype HappyWrap143 = HappyWrap143 (Maybe (RuleBndrs GhcPs)) +happyIn143 :: (Maybe (RuleBndrs GhcPs)) -> (HappyAbsSyn ) +happyIn143 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap143 x) +{-# INLINE happyIn143 #-} +happyOut143 :: (HappyAbsSyn ) -> HappyWrap143 +happyOut143 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut143 #-} +newtype HappyWrap144 = HappyWrap144 ([LRuleTyTmVar]) +happyIn144 :: ([LRuleTyTmVar]) -> (HappyAbsSyn ) +happyIn144 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap144 x) +{-# INLINE happyIn144 #-} +happyOut144 :: (HappyAbsSyn ) -> HappyWrap144 +happyOut144 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut144 #-} +newtype HappyWrap145 = HappyWrap145 (LRuleTyTmVar) +happyIn145 :: (LRuleTyTmVar) -> (HappyAbsSyn ) +happyIn145 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap145 x) +{-# INLINE happyIn145 #-} +happyOut145 :: (HappyAbsSyn ) -> HappyWrap145 +happyOut145 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut145 #-} +newtype HappyWrap146 = HappyWrap146 (Maybe (LWarningTxt GhcPs)) +happyIn146 :: (Maybe (LWarningTxt GhcPs)) -> (HappyAbsSyn ) +happyIn146 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap146 x) +{-# INLINE happyIn146 #-} +happyOut146 :: (HappyAbsSyn ) -> HappyWrap146 +happyOut146 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut146 #-} +newtype HappyWrap147 = HappyWrap147 (Maybe (LocatedE InWarningCategory)) +happyIn147 :: (Maybe (LocatedE InWarningCategory)) -> (HappyAbsSyn ) +happyIn147 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap147 x) +{-# INLINE happyIn147 #-} +happyOut147 :: (HappyAbsSyn ) -> HappyWrap147 +happyOut147 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut147 #-} +newtype HappyWrap148 = HappyWrap148 (OrdList (LWarnDecl GhcPs)) +happyIn148 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) +happyIn148 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap148 x) +{-# INLINE happyIn148 #-} +happyOut148 :: (HappyAbsSyn ) -> HappyWrap148 +happyOut148 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut148 #-} +newtype HappyWrap149 = HappyWrap149 (OrdList (LWarnDecl GhcPs)) +happyIn149 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) +happyIn149 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap149 x) +{-# INLINE happyIn149 #-} +happyOut149 :: (HappyAbsSyn ) -> HappyWrap149 +happyOut149 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut149 #-} +newtype HappyWrap150 = HappyWrap150 (Located NamespaceSpecifier) +happyIn150 :: (Located NamespaceSpecifier) -> (HappyAbsSyn ) +happyIn150 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap150 x) +{-# INLINE happyIn150 #-} +happyOut150 :: (HappyAbsSyn ) -> HappyWrap150 +happyOut150 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut150 #-} +newtype HappyWrap151 = HappyWrap151 (OrdList (LWarnDecl GhcPs)) +happyIn151 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) +happyIn151 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap151 x) +{-# INLINE happyIn151 #-} +happyOut151 :: (HappyAbsSyn ) -> HappyWrap151 +happyOut151 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut151 #-} +newtype HappyWrap152 = HappyWrap152 (OrdList (LWarnDecl GhcPs)) +happyIn152 :: (OrdList (LWarnDecl GhcPs)) -> (HappyAbsSyn ) +happyIn152 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap152 x) +{-# INLINE happyIn152 #-} +happyOut152 :: (HappyAbsSyn ) -> HappyWrap152 +happyOut152 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut152 #-} +newtype HappyWrap153 = HappyWrap153 (Located ((EpToken "[", EpToken "]"),[Located StringLiteral])) +happyIn153 :: (Located ((EpToken "[", EpToken "]"),[Located StringLiteral])) -> (HappyAbsSyn ) +happyIn153 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap153 x) +{-# INLINE happyIn153 #-} +happyOut153 :: (HappyAbsSyn ) -> HappyWrap153 +happyOut153 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut153 #-} +newtype HappyWrap154 = HappyWrap154 (Located (OrdList (Located StringLiteral))) +happyIn154 :: (Located (OrdList (Located StringLiteral))) -> (HappyAbsSyn ) +happyIn154 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap154 x) +{-# INLINE happyIn154 #-} +happyOut154 :: (HappyAbsSyn ) -> HappyWrap154 +happyOut154 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut154 #-} +newtype HappyWrap155 = HappyWrap155 (LHsDecl GhcPs) +happyIn155 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn155 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap155 x) +{-# INLINE happyIn155 #-} +happyOut155 :: (HappyAbsSyn ) -> HappyWrap155 +happyOut155 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut155 #-} +newtype HappyWrap156 = HappyWrap156 (Located (EpToken "foreign" -> HsDecl GhcPs)) +happyIn156 :: (Located (EpToken "foreign" -> HsDecl GhcPs)) -> (HappyAbsSyn ) +happyIn156 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap156 x) +{-# INLINE happyIn156 #-} +happyOut156 :: (HappyAbsSyn ) -> HappyWrap156 +happyOut156 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut156 #-} +newtype HappyWrap157 = HappyWrap157 (Located CCallConv) +happyIn157 :: (Located CCallConv) -> (HappyAbsSyn ) +happyIn157 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap157 x) +{-# INLINE happyIn157 #-} +happyOut157 :: (HappyAbsSyn ) -> HappyWrap157 +happyOut157 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut157 #-} +newtype HappyWrap158 = HappyWrap158 (Located Safety) +happyIn158 :: (Located Safety) -> (HappyAbsSyn ) +happyIn158 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap158 x) +{-# INLINE happyIn158 #-} +happyOut158 :: (HappyAbsSyn ) -> HappyWrap158 +happyOut158 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut158 #-} +newtype HappyWrap159 = HappyWrap159 (Located (TokDcolon + ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs))) +happyIn159 :: (Located (TokDcolon + ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs))) -> (HappyAbsSyn ) +happyIn159 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap159 x) +{-# INLINE happyIn159 #-} +happyOut159 :: (HappyAbsSyn ) -> HappyWrap159 +happyOut159 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut159 #-} +newtype HappyWrap160 = HappyWrap160 (Maybe (EpUniToken "::" "\8759", LHsType GhcPs)) +happyIn160 :: (Maybe (EpUniToken "::" "\8759", LHsType GhcPs)) -> (HappyAbsSyn ) +happyIn160 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap160 x) +{-# INLINE happyIn160 #-} +happyOut160 :: (HappyAbsSyn ) -> HappyWrap160 +happyOut160 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut160 #-} +newtype HappyWrap161 = HappyWrap161 ((Maybe (EpUniToken "::" "\8759"), Maybe (LocatedN RdrName))) +happyIn161 :: ((Maybe (EpUniToken "::" "\8759"), Maybe (LocatedN RdrName))) -> (HappyAbsSyn ) +happyIn161 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap161 x) +{-# INLINE happyIn161 #-} +happyOut161 :: (HappyAbsSyn ) -> HappyWrap161 +happyOut161 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut161 #-} +newtype HappyWrap162 = HappyWrap162 (LHsSigType GhcPs) +happyIn162 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) +happyIn162 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap162 x) +{-# INLINE happyIn162 #-} +happyOut162 :: (HappyAbsSyn ) -> HappyWrap162 +happyOut162 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut162 #-} +newtype HappyWrap163 = HappyWrap163 (LHsSigType GhcPs) +happyIn163 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) +happyIn163 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap163 x) +{-# INLINE happyIn163 #-} +happyOut163 :: (HappyAbsSyn ) -> HappyWrap163 +happyOut163 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut163 #-} +newtype HappyWrap164 = HappyWrap164 (Located [LocatedN RdrName]) +happyIn164 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn164 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap164 x) +{-# INLINE happyIn164 #-} +happyOut164 :: (HappyAbsSyn ) -> HappyWrap164 +happyOut164 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut164 #-} +newtype HappyWrap165 = HappyWrap165 (Located (OrdList (LHsSigType GhcPs))) +happyIn165 :: (Located (OrdList (LHsSigType GhcPs))) -> (HappyAbsSyn ) +happyIn165 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap165 x) +{-# INLINE happyIn165 #-} +happyOut165 :: (HappyAbsSyn ) -> HappyWrap165 +happyOut165 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut165 #-} +newtype HappyWrap166 = HappyWrap166 (Located UnpackednessPragma) +happyIn166 :: (Located UnpackednessPragma) -> (HappyAbsSyn ) +happyIn166 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap166 x) +{-# INLINE happyIn166 #-} +happyOut166 :: (HappyAbsSyn ) -> HappyWrap166 +happyOut166 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut166 #-} +newtype HappyWrap167 = HappyWrap167 (Located (HsForAllTelescope GhcPs)) +happyIn167 :: (Located (HsForAllTelescope GhcPs)) -> (HappyAbsSyn ) +happyIn167 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap167 x) +{-# INLINE happyIn167 #-} +happyOut167 :: (HappyAbsSyn ) -> HappyWrap167 +happyOut167 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut167 #-} +newtype HappyWrap168 = HappyWrap168 (LHsType GhcPs) +happyIn168 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn168 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap168 x) +{-# INLINE happyIn168 #-} +happyOut168 :: (HappyAbsSyn ) -> HappyWrap168 +happyOut168 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut168 #-} +newtype HappyWrap169 = HappyWrap169 (LHsType GhcPs) +happyIn169 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn169 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap169 x) +{-# INLINE happyIn169 #-} +happyOut169 :: (HappyAbsSyn ) -> HappyWrap169 +happyOut169 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut169 #-} +newtype HappyWrap170 = HappyWrap170 (LHsContext GhcPs) +happyIn170 :: (LHsContext GhcPs) -> (HappyAbsSyn ) +happyIn170 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap170 x) +{-# INLINE happyIn170 #-} +happyOut170 :: (HappyAbsSyn ) -> HappyWrap170 +happyOut170 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut170 #-} +newtype HappyWrap171 = HappyWrap171 (forall b. DisambECP b => PV (LocatedC [LocatedA b])) +happyIn171 :: (forall b. DisambECP b => PV (LocatedC [LocatedA b])) -> (HappyAbsSyn ) +happyIn171 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap171 x) +{-# INLINE happyIn171 #-} +happyOut171 :: (HappyAbsSyn ) -> HappyWrap171 +happyOut171 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut171 #-} +newtype HappyWrap172 = HappyWrap172 (LHsType GhcPs) +happyIn172 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn172 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap172 x) +{-# INLINE happyIn172 #-} +happyOut172 :: (HappyAbsSyn ) -> HappyWrap172 +happyOut172 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut172 #-} +newtype HappyWrap173 = HappyWrap173 (Located (EpUniToken "->" "\8594" -> HsMultAnn GhcPs)) +happyIn173 :: (Located (EpUniToken "->" "\8594" -> HsMultAnn GhcPs)) -> (HappyAbsSyn ) +happyIn173 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap173 x) +{-# INLINE happyIn173 #-} +happyOut173 :: (HappyAbsSyn ) -> HappyWrap173 +happyOut173 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut173 #-} +newtype HappyWrap174 = HappyWrap174 (forall b. DisambECP b => PV (Located (EpUniToken "->" "\8594" -> HsMultAnnOf (LocatedA b) GhcPs))) +happyIn174 :: (forall b. DisambECP b => PV (Located (EpUniToken "->" "\8594" -> HsMultAnnOf (LocatedA b) GhcPs))) -> (HappyAbsSyn ) +happyIn174 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap174 x) +{-# INLINE happyIn174 #-} +happyOut174 :: (HappyAbsSyn ) -> HappyWrap174 +happyOut174 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut174 #-} +newtype HappyWrap175 = HappyWrap175 (LHsType GhcPs) +happyIn175 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn175 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap175 x) +{-# INLINE happyIn175 #-} +happyOut175 :: (HappyAbsSyn ) -> HappyWrap175 +happyOut175 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut175 #-} +newtype HappyWrap176 = HappyWrap176 (forall b. DisambTD b => PV (LocatedA b)) +happyIn176 :: (forall b. DisambTD b => PV (LocatedA b)) -> (HappyAbsSyn ) +happyIn176 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap176 x) +{-# INLINE happyIn176 #-} +happyOut176 :: (HappyAbsSyn ) -> HappyWrap176 +happyOut176 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut176 #-} +newtype HappyWrap177 = HappyWrap177 (forall b. DisambTD b => PV (LocatedA b)) +happyIn177 :: (forall b. DisambTD b => PV (LocatedA b)) -> (HappyAbsSyn ) +happyIn177 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap177 x) +{-# INLINE happyIn177 #-} +happyOut177 :: (HappyAbsSyn ) -> HappyWrap177 +happyOut177 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut177 #-} +newtype HappyWrap178 = HappyWrap178 (LHsType GhcPs) +happyIn178 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn178 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap178 x) +{-# INLINE happyIn178 #-} +happyOut178 :: (HappyAbsSyn ) -> HappyWrap178 +happyOut178 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut178 #-} +newtype HappyWrap179 = HappyWrap179 ((LocatedN RdrName, PromotionFlag)) +happyIn179 :: ((LocatedN RdrName, PromotionFlag)) -> (HappyAbsSyn ) +happyIn179 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap179 x) +{-# INLINE happyIn179 #-} +happyOut179 :: (HappyAbsSyn ) -> HappyWrap179 +happyOut179 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut179 #-} +newtype HappyWrap180 = HappyWrap180 (LHsType GhcPs) +happyIn180 :: (LHsType GhcPs) -> (HappyAbsSyn ) +happyIn180 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap180 x) +{-# INLINE happyIn180 #-} +happyOut180 :: (HappyAbsSyn ) -> HappyWrap180 +happyOut180 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut180 #-} +newtype HappyWrap181 = HappyWrap181 (LHsSigType GhcPs) +happyIn181 :: (LHsSigType GhcPs) -> (HappyAbsSyn ) +happyIn181 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap181 x) +{-# INLINE happyIn181 #-} +happyOut181 :: (HappyAbsSyn ) -> HappyWrap181 +happyOut181 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut181 #-} +newtype HappyWrap182 = HappyWrap182 ([LHsSigType GhcPs]) +happyIn182 :: ([LHsSigType GhcPs]) -> (HappyAbsSyn ) +happyIn182 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap182 x) +{-# INLINE happyIn182 #-} +happyOut182 :: (HappyAbsSyn ) -> HappyWrap182 +happyOut182 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut182 #-} +newtype HappyWrap183 = HappyWrap183 ([LHsType GhcPs]) +happyIn183 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) +happyIn183 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap183 x) +{-# INLINE happyIn183 #-} +happyOut183 :: (HappyAbsSyn ) -> HappyWrap183 +happyOut183 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut183 #-} +newtype HappyWrap184 = HappyWrap184 ([LHsType GhcPs]) +happyIn184 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) +happyIn184 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap184 x) +{-# INLINE happyIn184 #-} +happyOut184 :: (HappyAbsSyn ) -> HappyWrap184 +happyOut184 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut184 #-} +newtype HappyWrap185 = HappyWrap185 ([LHsType GhcPs]) +happyIn185 :: ([LHsType GhcPs]) -> (HappyAbsSyn ) +happyIn185 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap185 x) +{-# INLINE happyIn185 #-} +happyOut185 :: (HappyAbsSyn ) -> HappyWrap185 +happyOut185 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut185 #-} +newtype HappyWrap186 = HappyWrap186 ([LHsTyVarBndr Specificity GhcPs]) +happyIn186 :: ([LHsTyVarBndr Specificity GhcPs]) -> (HappyAbsSyn ) +happyIn186 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap186 x) +{-# INLINE happyIn186 #-} +happyOut186 :: (HappyAbsSyn ) -> HappyWrap186 +happyOut186 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut186 #-} +newtype HappyWrap187 = HappyWrap187 (LHsTyVarBndr Specificity GhcPs) +happyIn187 :: (LHsTyVarBndr Specificity GhcPs) -> (HappyAbsSyn ) +happyIn187 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap187 x) +{-# INLINE happyIn187 #-} +happyOut187 :: (HappyAbsSyn ) -> HappyWrap187 +happyOut187 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut187 #-} +newtype HappyWrap188 = HappyWrap188 (LHsTyVarBndr Specificity GhcPs) +happyIn188 :: (LHsTyVarBndr Specificity GhcPs) -> (HappyAbsSyn ) +happyIn188 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap188 x) +{-# INLINE happyIn188 #-} +happyOut188 :: (HappyAbsSyn ) -> HappyWrap188 +happyOut188 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut188 #-} +newtype HappyWrap189 = HappyWrap189 (Located (HsBndrVar GhcPs)) +happyIn189 :: (Located (HsBndrVar GhcPs)) -> (HappyAbsSyn ) +happyIn189 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap189 x) +{-# INLINE happyIn189 #-} +happyOut189 :: (HappyAbsSyn ) -> HappyWrap189 +happyOut189 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut189 #-} +newtype HappyWrap190 = HappyWrap190 (Located (EpToken "|",[LHsFunDep GhcPs])) +happyIn190 :: (Located (EpToken "|",[LHsFunDep GhcPs])) -> (HappyAbsSyn ) +happyIn190 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap190 x) +{-# INLINE happyIn190 #-} +happyOut190 :: (HappyAbsSyn ) -> HappyWrap190 +happyOut190 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut190 #-} +newtype HappyWrap191 = HappyWrap191 (Located [LHsFunDep GhcPs]) +happyIn191 :: (Located [LHsFunDep GhcPs]) -> (HappyAbsSyn ) +happyIn191 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap191 x) +{-# INLINE happyIn191 #-} +happyOut191 :: (HappyAbsSyn ) -> HappyWrap191 +happyOut191 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut191 #-} +newtype HappyWrap192 = HappyWrap192 (LHsFunDep GhcPs) +happyIn192 :: (LHsFunDep GhcPs) -> (HappyAbsSyn ) +happyIn192 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap192 x) +{-# INLINE happyIn192 #-} +happyOut192 :: (HappyAbsSyn ) -> HappyWrap192 +happyOut192 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut192 #-} +newtype HappyWrap193 = HappyWrap193 (Located [LocatedN RdrName]) +happyIn193 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn193 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap193 x) +{-# INLINE happyIn193 #-} +happyOut193 :: (HappyAbsSyn ) -> HappyWrap193 +happyOut193 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut193 #-} +newtype HappyWrap194 = HappyWrap194 (LHsKind GhcPs) +happyIn194 :: (LHsKind GhcPs) -> (HappyAbsSyn ) +happyIn194 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap194 x) +{-# INLINE happyIn194 #-} +happyOut194 :: (HappyAbsSyn ) -> HappyWrap194 +happyOut194 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut194 #-} +newtype HappyWrap195 = HappyWrap195 (Located ((EpToken "where", EpToken "{", EpToken "}") + ,[LConDecl GhcPs])) +happyIn195 :: (Located ((EpToken "where", EpToken "{", EpToken "}") + ,[LConDecl GhcPs])) -> (HappyAbsSyn ) +happyIn195 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap195 x) +{-# INLINE happyIn195 #-} +happyOut195 :: (HappyAbsSyn ) -> HappyWrap195 +happyOut195 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut195 #-} +newtype HappyWrap196 = HappyWrap196 (Located [LConDecl GhcPs]) +happyIn196 :: (Located [LConDecl GhcPs]) -> (HappyAbsSyn ) +happyIn196 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap196 x) +{-# INLINE happyIn196 #-} +happyOut196 :: (HappyAbsSyn ) -> HappyWrap196 +happyOut196 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut196 #-} +newtype HappyWrap197 = HappyWrap197 (LConDecl GhcPs) +happyIn197 :: (LConDecl GhcPs) -> (HappyAbsSyn ) +happyIn197 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap197 x) +{-# INLINE happyIn197 #-} +happyOut197 :: (HappyAbsSyn ) -> HappyWrap197 +happyOut197 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut197 #-} +newtype HappyWrap198 = HappyWrap198 (Located (EpToken "=",[LConDecl GhcPs])) +happyIn198 :: (Located (EpToken "=",[LConDecl GhcPs])) -> (HappyAbsSyn ) +happyIn198 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap198 x) +{-# INLINE happyIn198 #-} +happyOut198 :: (HappyAbsSyn ) -> HappyWrap198 +happyOut198 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut198 #-} +newtype HappyWrap199 = HappyWrap199 (Located [LConDecl GhcPs]) +happyIn199 :: (Located [LConDecl GhcPs]) -> (HappyAbsSyn ) +happyIn199 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap199 x) +{-# INLINE happyIn199 #-} +happyOut199 :: (HappyAbsSyn ) -> HappyWrap199 +happyOut199 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut199 #-} +newtype HappyWrap200 = HappyWrap200 (LConDecl GhcPs) +happyIn200 :: (LConDecl GhcPs) -> (HappyAbsSyn ) +happyIn200 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap200 x) +{-# INLINE happyIn200 #-} +happyOut200 :: (HappyAbsSyn ) -> HappyWrap200 +happyOut200 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut200 #-} +newtype HappyWrap201 = HappyWrap201 (Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs])) +happyIn201 :: (Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs])) -> (HappyAbsSyn ) +happyIn201 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap201 x) +{-# INLINE happyIn201 #-} +happyOut201 :: (HappyAbsSyn ) -> HappyWrap201 +happyOut201 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut201 #-} +newtype HappyWrap202 = HappyWrap202 (Located (LocatedN RdrName, HsConDeclH98Details GhcPs)) +happyIn202 :: (Located (LocatedN RdrName, HsConDeclH98Details GhcPs)) -> (HappyAbsSyn ) +happyIn202 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap202 x) +{-# INLINE happyIn202 #-} +happyOut202 :: (HappyAbsSyn ) -> HappyWrap202 +happyOut202 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut202 #-} +newtype HappyWrap203 = HappyWrap203 ((LHsType GhcPs, Int, Int)) +happyIn203 :: ((LHsType GhcPs, Int, Int)) -> (HappyAbsSyn ) +happyIn203 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap203 x) +{-# INLINE happyIn203 #-} +happyOut203 :: (HappyAbsSyn ) -> HappyWrap203 +happyOut203 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut203 #-} +newtype HappyWrap204 = HappyWrap204 ([LHsConDeclRecField GhcPs]) +happyIn204 :: ([LHsConDeclRecField GhcPs]) -> (HappyAbsSyn ) +happyIn204 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap204 x) +{-# INLINE happyIn204 #-} +happyOut204 :: (HappyAbsSyn ) -> HappyWrap204 +happyOut204 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut204 #-} +newtype HappyWrap205 = HappyWrap205 ([LHsConDeclRecField GhcPs]) +happyIn205 :: ([LHsConDeclRecField GhcPs]) -> (HappyAbsSyn ) +happyIn205 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap205 x) +{-# INLINE happyIn205 #-} +happyOut205 :: (HappyAbsSyn ) -> HappyWrap205 +happyOut205 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut205 #-} +newtype HappyWrap206 = HappyWrap206 (LHsConDeclRecField GhcPs) +happyIn206 :: (LHsConDeclRecField GhcPs) -> (HappyAbsSyn ) +happyIn206 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap206 x) +{-# INLINE happyIn206 #-} +happyOut206 :: (HappyAbsSyn ) -> HappyWrap206 +happyOut206 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut206 #-} +newtype HappyWrap207 = HappyWrap207 (Located (HsDeriving GhcPs)) +happyIn207 :: (Located (HsDeriving GhcPs)) -> (HappyAbsSyn ) +happyIn207 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap207 x) +{-# INLINE happyIn207 #-} +happyOut207 :: (HappyAbsSyn ) -> HappyWrap207 +happyOut207 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut207 #-} +newtype HappyWrap208 = HappyWrap208 (Located (HsDeriving GhcPs)) +happyIn208 :: (Located (HsDeriving GhcPs)) -> (HappyAbsSyn ) +happyIn208 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap208 x) +{-# INLINE happyIn208 #-} +happyOut208 :: (HappyAbsSyn ) -> HappyWrap208 +happyOut208 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut208 #-} +newtype HappyWrap209 = HappyWrap209 (LHsDerivingClause GhcPs) +happyIn209 :: (LHsDerivingClause GhcPs) -> (HappyAbsSyn ) +happyIn209 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap209 x) +{-# INLINE happyIn209 #-} +happyOut209 :: (HappyAbsSyn ) -> HappyWrap209 +happyOut209 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut209 #-} +newtype HappyWrap210 = HappyWrap210 (LDerivClauseTys GhcPs) +happyIn210 :: (LDerivClauseTys GhcPs) -> (HappyAbsSyn ) +happyIn210 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap210 x) +{-# INLINE happyIn210 #-} +happyOut210 :: (HappyAbsSyn ) -> HappyWrap210 +happyOut210 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut210 #-} +newtype HappyWrap211 = HappyWrap211 (LHsDecl GhcPs) +happyIn211 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn211 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap211 x) +{-# INLINE happyIn211 #-} +happyOut211 :: (HappyAbsSyn ) -> HappyWrap211 +happyOut211 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut211 #-} +newtype HappyWrap212 = HappyWrap212 (LHsDecl GhcPs) +happyIn212 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn212 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap212 x) +{-# INLINE happyIn212 #-} +happyOut212 :: (HappyAbsSyn ) -> HappyWrap212 +happyOut212 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut212 #-} +newtype HappyWrap213 = HappyWrap213 (Located (GRHSs GhcPs (LHsExpr GhcPs))) +happyIn213 :: (Located (GRHSs GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) +happyIn213 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap213 x) +{-# INLINE happyIn213 #-} +happyOut213 :: (HappyAbsSyn ) -> HappyWrap213 +happyOut213 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut213 #-} +newtype HappyWrap214 = HappyWrap214 (Located (NonEmpty (LGRHS GhcPs (LHsExpr GhcPs)))) +happyIn214 :: (Located (NonEmpty (LGRHS GhcPs (LHsExpr GhcPs)))) -> (HappyAbsSyn ) +happyIn214 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap214 x) +{-# INLINE happyIn214 #-} +happyOut214 :: (HappyAbsSyn ) -> HappyWrap214 +happyOut214 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut214 #-} +newtype HappyWrap215 = HappyWrap215 (LGRHS GhcPs (LHsExpr GhcPs)) +happyIn215 :: (LGRHS GhcPs (LHsExpr GhcPs)) -> (HappyAbsSyn ) +happyIn215 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap215 x) +{-# INLINE happyIn215 #-} +happyOut215 :: (HappyAbsSyn ) -> HappyWrap215 +happyOut215 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut215 #-} +newtype HappyWrap216 = HappyWrap216 (LHsDecl GhcPs) +happyIn216 :: (LHsDecl GhcPs) -> (HappyAbsSyn ) +happyIn216 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap216 x) +{-# INLINE happyIn216 #-} +happyOut216 :: (HappyAbsSyn ) -> HappyWrap216 +happyOut216 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut216 #-} +newtype HappyWrap217 = HappyWrap217 (Maybe (Located (TokDcolon, OrdList (LHsSigType GhcPs)))) +happyIn217 :: (Maybe (Located (TokDcolon, OrdList (LHsSigType GhcPs)))) -> (HappyAbsSyn ) +happyIn217 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap217 x) +{-# INLINE happyIn217 #-} +happyOut217 :: (HappyAbsSyn ) -> HappyWrap217 +happyOut217 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut217 #-} +newtype HappyWrap218 = HappyWrap218 ((ActivationAnn,Maybe Activation)) +happyIn218 :: ((ActivationAnn,Maybe Activation)) -> (HappyAbsSyn ) +happyIn218 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap218 x) +{-# INLINE happyIn218 #-} +happyOut218 :: (HappyAbsSyn ) -> HappyWrap218 +happyOut218 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut218 #-} +newtype HappyWrap219 = HappyWrap219 ((ActivationAnn, Activation)) +happyIn219 :: ((ActivationAnn, Activation)) -> (HappyAbsSyn ) +happyIn219 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap219 x) +{-# INLINE happyIn219 #-} +happyOut219 :: (HappyAbsSyn ) -> HappyWrap219 +happyOut219 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut219 #-} +newtype HappyWrap220 = HappyWrap220 (Located (HsUntypedSplice GhcPs)) +happyIn220 :: (Located (HsUntypedSplice GhcPs)) -> (HappyAbsSyn ) +happyIn220 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap220 x) +{-# INLINE happyIn220 #-} +happyOut220 :: (HappyAbsSyn ) -> HappyWrap220 +happyOut220 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut220 #-} +newtype HappyWrap221 = HappyWrap221 (ECP) +happyIn221 :: (ECP) -> (HappyAbsSyn ) +happyIn221 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap221 x) +{-# INLINE happyIn221 #-} +happyOut221 :: (HappyAbsSyn ) -> HappyWrap221 +happyOut221 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut221 #-} +newtype HappyWrap222 = HappyWrap222 (ECP) +happyIn222 :: (ECP) -> (HappyAbsSyn ) +happyIn222 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap222 x) +{-# INLINE happyIn222 #-} +happyOut222 :: (HappyAbsSyn ) -> HappyWrap222 +happyOut222 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut222 #-} +newtype HappyWrap223 = HappyWrap223 (ECP) +happyIn223 :: (ECP) -> (HappyAbsSyn ) +happyIn223 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap223 x) +{-# INLINE happyIn223 #-} +happyOut223 :: (HappyAbsSyn ) -> HappyWrap223 +happyOut223 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut223 #-} +newtype HappyWrap224 = HappyWrap224 (ECP) +happyIn224 :: (ECP) -> (HappyAbsSyn ) +happyIn224 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap224 x) +{-# INLINE happyIn224 #-} +happyOut224 :: (HappyAbsSyn ) -> HappyWrap224 +happyOut224 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut224 #-} +newtype HappyWrap225 = HappyWrap225 (ECP) +happyIn225 :: (ECP) -> (HappyAbsSyn ) +happyIn225 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap225 x) +{-# INLINE happyIn225 #-} +happyOut225 :: (HappyAbsSyn ) -> HappyWrap225 +happyOut225 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut225 #-} +newtype HappyWrap226 = HappyWrap226 (ECP) +happyIn226 :: (ECP) -> (HappyAbsSyn ) +happyIn226 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap226 x) +{-# INLINE happyIn226 #-} +happyOut226 :: (HappyAbsSyn ) -> HappyWrap226 +happyOut226 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut226 #-} +newtype HappyWrap227 = HappyWrap227 ((Maybe (EpToken ";"),Bool)) +happyIn227 :: ((Maybe (EpToken ";"),Bool)) -> (HappyAbsSyn ) +happyIn227 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap227 x) +{-# INLINE happyIn227 #-} +happyOut227 :: (HappyAbsSyn ) -> HappyWrap227 +happyOut227 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut227 #-} +newtype HappyWrap228 = HappyWrap228 (Located (HsPragE GhcPs)) +happyIn228 :: (Located (HsPragE GhcPs)) -> (HappyAbsSyn ) +happyIn228 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap228 x) +{-# INLINE happyIn228 #-} +happyOut228 :: (HappyAbsSyn ) -> HappyWrap228 +happyOut228 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut228 #-} +newtype HappyWrap229 = HappyWrap229 (ECP) +happyIn229 :: (ECP) -> (HappyAbsSyn ) +happyIn229 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap229 x) +{-# INLINE happyIn229 #-} +happyOut229 :: (HappyAbsSyn ) -> HappyWrap229 +happyOut229 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut229 #-} +newtype HappyWrap230 = HappyWrap230 (ECP) +happyIn230 :: (ECP) -> (HappyAbsSyn ) +happyIn230 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap230 x) +{-# INLINE happyIn230 #-} +happyOut230 :: (HappyAbsSyn ) -> HappyWrap230 +happyOut230 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut230 #-} +newtype HappyWrap231 = HappyWrap231 (ECP) +happyIn231 :: (ECP) -> (HappyAbsSyn ) +happyIn231 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap231 x) +{-# INLINE happyIn231 #-} +happyOut231 :: (HappyAbsSyn ) -> HappyWrap231 +happyOut231 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut231 #-} +newtype HappyWrap232 = HappyWrap232 (ECP) +happyIn232 :: (ECP) -> (HappyAbsSyn ) +happyIn232 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap232 x) +{-# INLINE happyIn232 #-} +happyOut232 :: (HappyAbsSyn ) -> HappyWrap232 +happyOut232 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut232 #-} +newtype HappyWrap233 = HappyWrap233 (Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)))) +happyIn233 :: (Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs)))) -> (HappyAbsSyn ) +happyIn233 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap233 x) +{-# INLINE happyIn233 #-} +happyOut233 :: (HappyAbsSyn ) -> HappyWrap233 +happyOut233 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut233 #-} +newtype HappyWrap234 = HappyWrap234 (LHsExpr GhcPs) +happyIn234 :: (LHsExpr GhcPs) -> (HappyAbsSyn ) +happyIn234 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap234 x) +{-# INLINE happyIn234 #-} +happyOut234 :: (HappyAbsSyn ) -> HappyWrap234 +happyOut234 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut234 #-} +newtype HappyWrap235 = HappyWrap235 (Located (HsUntypedSplice GhcPs)) +happyIn235 :: (Located (HsUntypedSplice GhcPs)) -> (HappyAbsSyn ) +happyIn235 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap235 x) +{-# INLINE happyIn235 #-} +happyOut235 :: (HappyAbsSyn ) -> HappyWrap235 +happyOut235 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut235 #-} +newtype HappyWrap236 = HappyWrap236 (Located (HsTypedSplice GhcPs)) +happyIn236 :: (Located (HsTypedSplice GhcPs)) -> (HappyAbsSyn ) +happyIn236 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap236 x) +{-# INLINE happyIn236 #-} +happyOut236 :: (HappyAbsSyn ) -> HappyWrap236 +happyOut236 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut236 #-} +newtype HappyWrap237 = HappyWrap237 ([LHsCmdTop GhcPs]) +happyIn237 :: ([LHsCmdTop GhcPs]) -> (HappyAbsSyn ) +happyIn237 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap237 x) +{-# INLINE happyIn237 #-} +happyOut237 :: (HappyAbsSyn ) -> HappyWrap237 +happyOut237 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut237 #-} +newtype HappyWrap238 = HappyWrap238 (LHsCmdTop GhcPs) +happyIn238 :: (LHsCmdTop GhcPs) -> (HappyAbsSyn ) +happyIn238 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap238 x) +{-# INLINE happyIn238 #-} +happyOut238 :: (HappyAbsSyn ) -> HappyWrap238 +happyOut238 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut238 #-} +newtype HappyWrap239 = HappyWrap239 (((EpToken "{", EpToken "}"),[LHsDecl GhcPs])) +happyIn239 :: (((EpToken "{", EpToken "}"),[LHsDecl GhcPs])) -> (HappyAbsSyn ) +happyIn239 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap239 x) +{-# INLINE happyIn239 #-} +happyOut239 :: (HappyAbsSyn ) -> HappyWrap239 +happyOut239 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut239 #-} +newtype HappyWrap240 = HappyWrap240 ([LHsDecl GhcPs]) +happyIn240 :: ([LHsDecl GhcPs]) -> (HappyAbsSyn ) +happyIn240 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap240 x) +{-# INLINE happyIn240 #-} +happyOut240 :: (HappyAbsSyn ) -> HappyWrap240 +happyOut240 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut240 #-} +newtype HappyWrap241 = HappyWrap241 (ECP) +happyIn241 :: (ECP) -> (HappyAbsSyn ) +happyIn241 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap241 x) +{-# INLINE happyIn241 #-} +happyOut241 :: (HappyAbsSyn ) -> HappyWrap241 +happyOut241 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut241 #-} +newtype HappyWrap242 = HappyWrap242 (forall b. DisambECP b => PV (SumOrTuple b)) +happyIn242 :: (forall b. DisambECP b => PV (SumOrTuple b)) -> (HappyAbsSyn ) +happyIn242 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap242 x) +{-# INLINE happyIn242 #-} +happyOut242 :: (HappyAbsSyn ) -> HappyWrap242 +happyOut242 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut242 #-} +newtype HappyWrap243 = HappyWrap243 (forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)])) +happyIn243 :: (forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)])) -> (HappyAbsSyn ) +happyIn243 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap243 x) +{-# INLINE happyIn243 #-} +happyOut243 :: (HappyAbsSyn ) -> HappyWrap243 +happyOut243 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut243 #-} +newtype HappyWrap244 = HappyWrap244 (forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)]) +happyIn244 :: (forall b. DisambECP b => PV [Either (EpAnn Bool) (LocatedA b)]) -> (HappyAbsSyn ) +happyIn244 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap244 x) +{-# INLINE happyIn244 #-} +happyOut244 :: (HappyAbsSyn ) -> HappyWrap244 +happyOut244 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut244 #-} +newtype HappyWrap245 = HappyWrap245 (forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b)) +happyIn245 :: (forall b. DisambECP b => SrcSpan -> (EpaLocation, EpaLocation) -> PV (LocatedA b)) -> (HappyAbsSyn ) +happyIn245 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap245 x) +{-# INLINE happyIn245 #-} +happyOut245 :: (HappyAbsSyn ) -> HappyWrap245 +happyOut245 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut245 #-} +newtype HappyWrap246 = HappyWrap246 (forall b. DisambECP b => PV [LocatedA b]) +happyIn246 :: (forall b. DisambECP b => PV [LocatedA b]) -> (HappyAbsSyn ) +happyIn246 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap246 x) +{-# INLINE happyIn246 #-} +happyOut246 :: (HappyAbsSyn ) -> HappyWrap246 +happyOut246 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut246 #-} +newtype HappyWrap247 = HappyWrap247 (Located [LStmt GhcPs (LHsExpr GhcPs)]) +happyIn247 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) +happyIn247 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap247 x) +{-# INLINE happyIn247 #-} +happyOut247 :: (HappyAbsSyn ) -> HappyWrap247 +happyOut247 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut247 #-} +newtype HappyWrap248 = HappyWrap248 (Located (NonEmpty [LStmt GhcPs (LHsExpr GhcPs)])) +happyIn248 :: (Located (NonEmpty [LStmt GhcPs (LHsExpr GhcPs)])) -> (HappyAbsSyn ) +happyIn248 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap248 x) +{-# INLINE happyIn248 #-} +happyOut248 :: (HappyAbsSyn ) -> HappyWrap248 +happyOut248 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut248 #-} +newtype HappyWrap249 = HappyWrap249 (Located (NonEmpty (LStmt GhcPs (LHsExpr GhcPs)))) +happyIn249 :: (Located (NonEmpty (LStmt GhcPs (LHsExpr GhcPs)))) -> (HappyAbsSyn ) +happyIn249 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap249 x) +{-# INLINE happyIn249 #-} +happyOut249 :: (HappyAbsSyn ) -> HappyWrap249 +happyOut249 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut249 #-} +newtype HappyWrap250 = HappyWrap250 (Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs))) +happyIn250 :: (Located ([LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) +happyIn250 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap250 x) +{-# INLINE happyIn250 #-} +happyOut250 :: (HappyAbsSyn ) -> HappyWrap250 +happyOut250 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut250 #-} +newtype HappyWrap251 = HappyWrap251 (Located [LStmt GhcPs (LHsExpr GhcPs)]) +happyIn251 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) +happyIn251 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap251 x) +{-# INLINE happyIn251 #-} +happyOut251 :: (HappyAbsSyn ) -> HappyWrap251 +happyOut251 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut251 #-} +newtype HappyWrap252 = HappyWrap252 (Located [LStmt GhcPs (LHsExpr GhcPs)]) +happyIn252 :: (Located [LStmt GhcPs (LHsExpr GhcPs)]) -> (HappyAbsSyn ) +happyIn252 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap252 x) +{-# INLINE happyIn252 #-} +happyOut252 :: (HappyAbsSyn ) -> HappyWrap252 +happyOut252 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut252 #-} +newtype HappyWrap253 = HappyWrap253 (forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b)))) +happyIn253 :: (forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b)))) -> (HappyAbsSyn ) +happyIn253 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap253 x) +{-# INLINE happyIn253 #-} +happyOut253 :: (HappyAbsSyn ) -> HappyWrap253 +happyOut253 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut253 #-} +newtype HappyWrap254 = HappyWrap254 (forall b. DisambECP b => PV (Located (NonEmpty (LGRHS GhcPs (LocatedA b))))) +happyIn254 :: (forall b. DisambECP b => PV (Located (NonEmpty (LGRHS GhcPs (LocatedA b))))) -> (HappyAbsSyn ) +happyIn254 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap254 x) +{-# INLINE happyIn254 #-} +happyOut254 :: (HappyAbsSyn ) -> HappyWrap254 +happyOut254 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut254 #-} +newtype HappyWrap255 = HappyWrap255 (forall b. DisambECP b => PV (Located (NonEmpty (LGRHS GhcPs (LocatedA b))))) +happyIn255 :: (forall b. DisambECP b => PV (Located (NonEmpty (LGRHS GhcPs (LocatedA b))))) -> (HappyAbsSyn ) +happyIn255 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap255 x) +{-# INLINE happyIn255 #-} +happyOut255 :: (HappyAbsSyn ) -> HappyWrap255 +happyOut255 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut255 #-} +newtype HappyWrap256 = HappyWrap256 (Located ((EpToken "{", EpToken "}"), NonEmpty (LGRHS GhcPs (LHsExpr GhcPs)))) +happyIn256 :: (Located ((EpToken "{", EpToken "}"), NonEmpty (LGRHS GhcPs (LHsExpr GhcPs)))) -> (HappyAbsSyn ) +happyIn256 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap256 x) +{-# INLINE happyIn256 #-} +happyOut256 :: (HappyAbsSyn ) -> HappyWrap256 +happyOut256 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut256 #-} +newtype HappyWrap257 = HappyWrap257 (forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b))) +happyIn257 :: (forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b))) -> (HappyAbsSyn ) +happyIn257 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap257 x) +{-# INLINE happyIn257 #-} +happyOut257 :: (HappyAbsSyn ) -> HappyWrap257 +happyOut257 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut257 #-} +newtype HappyWrap258 = HappyWrap258 (LPat GhcPs) +happyIn258 :: (LPat GhcPs) -> (HappyAbsSyn ) +happyIn258 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap258 x) +{-# INLINE happyIn258 #-} +happyOut258 :: (HappyAbsSyn ) -> HappyWrap258 +happyOut258 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut258 #-} +newtype HappyWrap259 = HappyWrap259 (LPat GhcPs) +happyIn259 :: (LPat GhcPs) -> (HappyAbsSyn ) +happyIn259 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap259 x) +{-# INLINE happyIn259 #-} +happyOut259 :: (HappyAbsSyn ) -> HappyWrap259 +happyOut259 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut259 #-} +newtype HappyWrap260 = HappyWrap260 ([LPat GhcPs]) +happyIn260 :: ([LPat GhcPs]) -> (HappyAbsSyn ) +happyIn260 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap260 x) +{-# INLINE happyIn260 #-} +happyOut260 :: (HappyAbsSyn ) -> HappyWrap260 +happyOut260 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut260 #-} +newtype HappyWrap261 = HappyWrap261 (LPat GhcPs) +happyIn261 :: (LPat GhcPs) -> (HappyAbsSyn ) +happyIn261 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap261 x) +{-# INLINE happyIn261 #-} +happyOut261 :: (HappyAbsSyn ) -> HappyWrap261 +happyOut261 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut261 #-} +newtype HappyWrap262 = HappyWrap262 (LPat GhcPs) +happyIn262 :: (LPat GhcPs) -> (HappyAbsSyn ) +happyIn262 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap262 x) +{-# INLINE happyIn262 #-} +happyOut262 :: (HappyAbsSyn ) -> HappyWrap262 +happyOut262 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut262 #-} +newtype HappyWrap263 = HappyWrap263 ([LPat GhcPs]) +happyIn263 :: ([LPat GhcPs]) -> (HappyAbsSyn ) +happyIn263 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap263 x) +{-# INLINE happyIn263 #-} +happyOut263 :: (HappyAbsSyn ) -> HappyWrap263 +happyOut263 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut263 #-} +newtype HappyWrap264 = HappyWrap264 (LPat GhcPs) +happyIn264 :: (LPat GhcPs) -> (HappyAbsSyn ) +happyIn264 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap264 x) +{-# INLINE happyIn264 #-} +happyOut264 :: (HappyAbsSyn ) -> HappyWrap264 +happyOut264 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut264 #-} +newtype HappyWrap265 = HappyWrap265 (forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))])) +happyIn265 :: (forall b. DisambECP b => PV (LocatedLW [LocatedA (Stmt GhcPs (LocatedA b))])) -> (HappyAbsSyn ) +happyIn265 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap265 x) +{-# INLINE happyIn265 #-} +happyOut265 :: (HappyAbsSyn ) -> HappyWrap265 +happyOut265 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut265 #-} +newtype HappyWrap266 = HappyWrap266 (forall b. DisambECP b => PV (Located (OrdList (EpToken ";"),[LStmt GhcPs (LocatedA b)]))) +happyIn266 :: (forall b. DisambECP b => PV (Located (OrdList (EpToken ";"),[LStmt GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) +happyIn266 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap266 x) +{-# INLINE happyIn266 #-} +happyOut266 :: (HappyAbsSyn ) -> HappyWrap266 +happyOut266 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut266 #-} +newtype HappyWrap267 = HappyWrap267 (Maybe (LStmt GhcPs (LHsExpr GhcPs))) +happyIn267 :: (Maybe (LStmt GhcPs (LHsExpr GhcPs))) -> (HappyAbsSyn ) +happyIn267 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap267 x) +{-# INLINE happyIn267 #-} +happyOut267 :: (HappyAbsSyn ) -> HappyWrap267 +happyOut267 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut267 #-} +newtype HappyWrap268 = HappyWrap268 (LStmt GhcPs (LHsExpr GhcPs)) +happyIn268 :: (LStmt GhcPs (LHsExpr GhcPs)) -> (HappyAbsSyn ) +happyIn268 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap268 x) +{-# INLINE happyIn268 #-} +happyOut268 :: (HappyAbsSyn ) -> HappyWrap268 +happyOut268 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut268 #-} +newtype HappyWrap269 = HappyWrap269 (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) +happyIn269 :: (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -> (HappyAbsSyn ) +happyIn269 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap269 x) +{-# INLINE happyIn269 #-} +happyOut269 :: (HappyAbsSyn ) -> HappyWrap269 +happyOut269 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut269 #-} +newtype HappyWrap270 = HappyWrap270 (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) +happyIn270 :: (forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b))) -> (HappyAbsSyn ) +happyIn270 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap270 x) +{-# INLINE happyIn270 #-} +happyOut270 :: (HappyAbsSyn ) -> HappyWrap270 +happyOut270 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut270 #-} +newtype HappyWrap271 = HappyWrap271 (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) +happyIn271 :: (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -> (HappyAbsSyn ) +happyIn271 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap271 x) +{-# INLINE happyIn271 #-} +happyOut271 :: (HappyAbsSyn ) -> HappyWrap271 +happyOut271 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut271 #-} +newtype HappyWrap272 = HappyWrap272 (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) +happyIn272 :: (forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan)) -> (HappyAbsSyn ) +happyIn272 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap272 x) +{-# INLINE happyIn272 #-} +happyOut272 :: (HappyAbsSyn ) -> HappyWrap272 +happyOut272 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut272 #-} +newtype HappyWrap273 = HappyWrap273 (forall b. DisambECP b => PV (Fbind b)) +happyIn273 :: (forall b. DisambECP b => PV (Fbind b)) -> (HappyAbsSyn ) +happyIn273 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap273 x) +{-# INLINE happyIn273 #-} +happyOut273 :: (HappyAbsSyn ) -> HappyWrap273 +happyOut273 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut273 #-} +newtype HappyWrap274 = HappyWrap274 (Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]) +happyIn274 :: (Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]) -> (HappyAbsSyn ) +happyIn274 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap274 x) +{-# INLINE happyIn274 #-} +happyOut274 :: (HappyAbsSyn ) -> HappyWrap274 +happyOut274 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut274 #-} +newtype HappyWrap275 = HappyWrap275 (Located [LIPBind GhcPs]) +happyIn275 :: (Located [LIPBind GhcPs]) -> (HappyAbsSyn ) +happyIn275 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap275 x) +{-# INLINE happyIn275 #-} +happyOut275 :: (HappyAbsSyn ) -> HappyWrap275 +happyOut275 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut275 #-} +newtype HappyWrap276 = HappyWrap276 (LIPBind GhcPs) +happyIn276 :: (LIPBind GhcPs) -> (HappyAbsSyn ) +happyIn276 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap276 x) +{-# INLINE happyIn276 #-} +happyOut276 :: (HappyAbsSyn ) -> HappyWrap276 +happyOut276 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut276 #-} +newtype HappyWrap277 = HappyWrap277 (Located HsIPName) +happyIn277 :: (Located HsIPName) -> (HappyAbsSyn ) +happyIn277 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap277 x) +{-# INLINE happyIn277 #-} +happyOut277 :: (HappyAbsSyn ) -> HappyWrap277 +happyOut277 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut277 #-} +newtype HappyWrap278 = HappyWrap278 (Located (SourceText, FastString)) +happyIn278 :: (Located (SourceText, FastString)) -> (HappyAbsSyn ) +happyIn278 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap278 x) +{-# INLINE happyIn278 #-} +happyOut278 :: (HappyAbsSyn ) -> HappyWrap278 +happyOut278 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut278 #-} +newtype HappyWrap279 = HappyWrap279 (LBooleanFormula GhcPs) +happyIn279 :: (LBooleanFormula GhcPs) -> (HappyAbsSyn ) +happyIn279 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap279 x) +{-# INLINE happyIn279 #-} +happyOut279 :: (HappyAbsSyn ) -> HappyWrap279 +happyOut279 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut279 #-} +newtype HappyWrap280 = HappyWrap280 (LBooleanFormula GhcPs) +happyIn280 :: (LBooleanFormula GhcPs) -> (HappyAbsSyn ) +happyIn280 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap280 x) +{-# INLINE happyIn280 #-} +happyOut280 :: (HappyAbsSyn ) -> HappyWrap280 +happyOut280 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut280 #-} +newtype HappyWrap281 = HappyWrap281 (LBooleanFormula GhcPs) +happyIn281 :: (LBooleanFormula GhcPs) -> (HappyAbsSyn ) +happyIn281 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap281 x) +{-# INLINE happyIn281 #-} +happyOut281 :: (HappyAbsSyn ) -> HappyWrap281 +happyOut281 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut281 #-} +newtype HappyWrap282 = HappyWrap282 (NonEmpty (LBooleanFormula GhcPs)) +happyIn282 :: (NonEmpty (LBooleanFormula GhcPs)) -> (HappyAbsSyn ) +happyIn282 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap282 x) +{-# INLINE happyIn282 #-} +happyOut282 :: (HappyAbsSyn ) -> HappyWrap282 +happyOut282 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut282 #-} +newtype HappyWrap283 = HappyWrap283 (LBooleanFormula GhcPs) +happyIn283 :: (LBooleanFormula GhcPs) -> (HappyAbsSyn ) +happyIn283 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap283 x) +{-# INLINE happyIn283 #-} +happyOut283 :: (HappyAbsSyn ) -> HappyWrap283 +happyOut283 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut283 #-} +newtype HappyWrap284 = HappyWrap284 (Located [LocatedN RdrName]) +happyIn284 :: (Located [LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn284 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap284 x) +{-# INLINE happyIn284 #-} +happyOut284 :: (HappyAbsSyn ) -> HappyWrap284 +happyOut284 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut284 #-} +newtype HappyWrap285 = HappyWrap285 (LocatedN RdrName) +happyIn285 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn285 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap285 x) +{-# INLINE happyIn285 #-} +happyOut285 :: (HappyAbsSyn ) -> HappyWrap285 +happyOut285 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut285 #-} +newtype HappyWrap286 = HappyWrap286 (LocatedN RdrName) +happyIn286 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn286 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap286 x) +{-# INLINE happyIn286 #-} +happyOut286 :: (HappyAbsSyn ) -> HappyWrap286 +happyOut286 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut286 #-} +newtype HappyWrap287 = HappyWrap287 (LocatedN RdrName) +happyIn287 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn287 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap287 x) +{-# INLINE happyIn287 #-} +happyOut287 :: (HappyAbsSyn ) -> HappyWrap287 +happyOut287 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut287 #-} +newtype HappyWrap288 = HappyWrap288 (LocatedN RdrName) +happyIn288 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn288 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap288 x) +{-# INLINE happyIn288 #-} +happyOut288 :: (HappyAbsSyn ) -> HappyWrap288 +happyOut288 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut288 #-} +newtype HappyWrap289 = HappyWrap289 (Located (NonEmpty (LocatedN RdrName))) +happyIn289 :: (Located (NonEmpty (LocatedN RdrName))) -> (HappyAbsSyn ) +happyIn289 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap289 x) +{-# INLINE happyIn289 #-} +happyOut289 :: (HappyAbsSyn ) -> HappyWrap289 +happyOut289 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut289 #-} +newtype HappyWrap290 = HappyWrap290 ([LocatedN RdrName]) +happyIn290 :: ([LocatedN RdrName]) -> (HappyAbsSyn ) +happyIn290 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap290 x) +{-# INLINE happyIn290 #-} +happyOut290 :: (HappyAbsSyn ) -> HappyWrap290 +happyOut290 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut290 #-} +newtype HappyWrap291 = HappyWrap291 (LocatedN DataCon) +happyIn291 :: (LocatedN DataCon) -> (HappyAbsSyn ) +happyIn291 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap291 x) +{-# INLINE happyIn291 #-} +happyOut291 :: (HappyAbsSyn ) -> HappyWrap291 +happyOut291 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut291 #-} +newtype HappyWrap292 = HappyWrap292 (LocatedN RdrName) +happyIn292 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn292 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap292 x) +{-# INLINE happyIn292 #-} +happyOut292 :: (HappyAbsSyn ) -> HappyWrap292 +happyOut292 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut292 #-} +newtype HappyWrap293 = HappyWrap293 (LocatedN DataCon) +happyIn293 :: (LocatedN DataCon) -> (HappyAbsSyn ) +happyIn293 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap293 x) +{-# INLINE happyIn293 #-} +happyOut293 :: (HappyAbsSyn ) -> HappyWrap293 +happyOut293 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut293 #-} +newtype HappyWrap294 = HappyWrap294 (LocatedN RdrName) +happyIn294 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn294 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap294 x) +{-# INLINE happyIn294 #-} +happyOut294 :: (HappyAbsSyn ) -> HappyWrap294 +happyOut294 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut294 #-} +newtype HappyWrap295 = HappyWrap295 (LocatedN RdrName) +happyIn295 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn295 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap295 x) +{-# INLINE happyIn295 #-} +happyOut295 :: (HappyAbsSyn ) -> HappyWrap295 +happyOut295 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut295 #-} +newtype HappyWrap296 = HappyWrap296 (LocatedN RdrName) +happyIn296 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn296 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap296 x) +{-# INLINE happyIn296 #-} +happyOut296 :: (HappyAbsSyn ) -> HappyWrap296 +happyOut296 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut296 #-} +newtype HappyWrap297 = HappyWrap297 (LocatedN RdrName) +happyIn297 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn297 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap297 x) +{-# INLINE happyIn297 #-} +happyOut297 :: (HappyAbsSyn ) -> HappyWrap297 +happyOut297 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut297 #-} +newtype HappyWrap298 = HappyWrap298 (LocatedN RdrName) +happyIn298 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn298 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap298 x) +{-# INLINE happyIn298 #-} +happyOut298 :: (HappyAbsSyn ) -> HappyWrap298 +happyOut298 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut298 #-} +newtype HappyWrap299 = HappyWrap299 (LocatedN RdrName) +happyIn299 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn299 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap299 x) +{-# INLINE happyIn299 #-} +happyOut299 :: (HappyAbsSyn ) -> HappyWrap299 +happyOut299 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut299 #-} +newtype HappyWrap300 = HappyWrap300 (LocatedN RdrName) +happyIn300 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn300 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap300 x) +{-# INLINE happyIn300 #-} +happyOut300 :: (HappyAbsSyn ) -> HappyWrap300 +happyOut300 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut300 #-} +newtype HappyWrap301 = HappyWrap301 (LocatedN RdrName) +happyIn301 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn301 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap301 x) +{-# INLINE happyIn301 #-} +happyOut301 :: (HappyAbsSyn ) -> HappyWrap301 +happyOut301 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut301 #-} +newtype HappyWrap302 = HappyWrap302 (LocatedN RdrName) +happyIn302 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn302 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap302 x) +{-# INLINE happyIn302 #-} +happyOut302 :: (HappyAbsSyn ) -> HappyWrap302 +happyOut302 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut302 #-} +newtype HappyWrap303 = HappyWrap303 (LocatedN RdrName) +happyIn303 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn303 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap303 x) +{-# INLINE happyIn303 #-} +happyOut303 :: (HappyAbsSyn ) -> HappyWrap303 +happyOut303 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut303 #-} +newtype HappyWrap304 = HappyWrap304 (LocatedN RdrName) +happyIn304 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn304 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap304 x) +{-# INLINE happyIn304 #-} +happyOut304 :: (HappyAbsSyn ) -> HappyWrap304 +happyOut304 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut304 #-} +newtype HappyWrap305 = HappyWrap305 (LocatedN RdrName) +happyIn305 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn305 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap305 x) +{-# INLINE happyIn305 #-} +happyOut305 :: (HappyAbsSyn ) -> HappyWrap305 +happyOut305 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut305 #-} +newtype HappyWrap306 = HappyWrap306 (LocatedN RdrName) +happyIn306 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn306 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap306 x) +{-# INLINE happyIn306 #-} +happyOut306 :: (HappyAbsSyn ) -> HappyWrap306 +happyOut306 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut306 #-} +newtype HappyWrap307 = HappyWrap307 (LocatedN RdrName) +happyIn307 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn307 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap307 x) +{-# INLINE happyIn307 #-} +happyOut307 :: (HappyAbsSyn ) -> HappyWrap307 +happyOut307 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut307 #-} +newtype HappyWrap308 = HappyWrap308 (forall b. DisambInfixOp b => PV (LocatedN b)) +happyIn308 :: (forall b. DisambInfixOp b => PV (LocatedN b)) -> (HappyAbsSyn ) +happyIn308 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap308 x) +{-# INLINE happyIn308 #-} +happyOut308 :: (HappyAbsSyn ) -> HappyWrap308 +happyOut308 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut308 #-} +newtype HappyWrap309 = HappyWrap309 (forall b. DisambInfixOp b => PV (LocatedN b)) +happyIn309 :: (forall b. DisambInfixOp b => PV (LocatedN b)) -> (HappyAbsSyn ) +happyIn309 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap309 x) +{-# INLINE happyIn309 #-} +happyOut309 :: (HappyAbsSyn ) -> HappyWrap309 +happyOut309 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut309 #-} +newtype HappyWrap310 = HappyWrap310 (LocatedN RdrName) +happyIn310 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn310 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap310 x) +{-# INLINE happyIn310 #-} +happyOut310 :: (HappyAbsSyn ) -> HappyWrap310 +happyOut310 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut310 #-} +newtype HappyWrap311 = HappyWrap311 (LocatedN RdrName) +happyIn311 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn311 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap311 x) +{-# INLINE happyIn311 #-} +happyOut311 :: (HappyAbsSyn ) -> HappyWrap311 +happyOut311 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut311 #-} +newtype HappyWrap312 = HappyWrap312 (LocatedN RdrName) +happyIn312 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn312 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap312 x) +{-# INLINE happyIn312 #-} +happyOut312 :: (HappyAbsSyn ) -> HappyWrap312 +happyOut312 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut312 #-} +newtype HappyWrap313 = HappyWrap313 (LocatedN RdrName) +happyIn313 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn313 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap313 x) +{-# INLINE happyIn313 #-} +happyOut313 :: (HappyAbsSyn ) -> HappyWrap313 +happyOut313 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut313 #-} +newtype HappyWrap314 = HappyWrap314 (LocatedN RdrName) +happyIn314 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn314 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap314 x) +{-# INLINE happyIn314 #-} +happyOut314 :: (HappyAbsSyn ) -> HappyWrap314 +happyOut314 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut314 #-} +newtype HappyWrap315 = HappyWrap315 (LocatedN RdrName) +happyIn315 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn315 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap315 x) +{-# INLINE happyIn315 #-} +happyOut315 :: (HappyAbsSyn ) -> HappyWrap315 +happyOut315 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut315 #-} +newtype HappyWrap316 = HappyWrap316 (LocatedN RdrName) +happyIn316 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn316 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap316 x) +{-# INLINE happyIn316 #-} +happyOut316 :: (HappyAbsSyn ) -> HappyWrap316 +happyOut316 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut316 #-} +newtype HappyWrap317 = HappyWrap317 (LocatedN RdrName) +happyIn317 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn317 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap317 x) +{-# INLINE happyIn317 #-} +happyOut317 :: (HappyAbsSyn ) -> HappyWrap317 +happyOut317 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut317 #-} +newtype HappyWrap318 = HappyWrap318 (LocatedN FieldLabelString) +happyIn318 :: (LocatedN FieldLabelString) -> (HappyAbsSyn ) +happyIn318 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap318 x) +{-# INLINE happyIn318 #-} +happyOut318 :: (HappyAbsSyn ) -> HappyWrap318 +happyOut318 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut318 #-} +newtype HappyWrap319 = HappyWrap319 (LocatedN RdrName) +happyIn319 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn319 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap319 x) +{-# INLINE happyIn319 #-} +happyOut319 :: (HappyAbsSyn ) -> HappyWrap319 +happyOut319 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut319 #-} +newtype HappyWrap320 = HappyWrap320 (LocatedN RdrName) +happyIn320 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn320 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap320 x) +{-# INLINE happyIn320 #-} +happyOut320 :: (HappyAbsSyn ) -> HappyWrap320 +happyOut320 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut320 #-} +newtype HappyWrap321 = HappyWrap321 (LocatedN RdrName) +happyIn321 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn321 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap321 x) +{-# INLINE happyIn321 #-} +happyOut321 :: (HappyAbsSyn ) -> HappyWrap321 +happyOut321 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut321 #-} +newtype HappyWrap322 = HappyWrap322 (LocatedN RdrName) +happyIn322 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn322 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap322 x) +{-# INLINE happyIn322 #-} +happyOut322 :: (HappyAbsSyn ) -> HappyWrap322 +happyOut322 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut322 #-} +newtype HappyWrap323 = HappyWrap323 (LocatedN RdrName) +happyIn323 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn323 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap323 x) +{-# INLINE happyIn323 #-} +happyOut323 :: (HappyAbsSyn ) -> HappyWrap323 +happyOut323 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut323 #-} +newtype HappyWrap324 = HappyWrap324 (LocatedN RdrName) +happyIn324 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn324 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap324 x) +{-# INLINE happyIn324 #-} +happyOut324 :: (HappyAbsSyn ) -> HappyWrap324 +happyOut324 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut324 #-} +newtype HappyWrap325 = HappyWrap325 (LocatedN RdrName) +happyIn325 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn325 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap325 x) +{-# INLINE happyIn325 #-} +happyOut325 :: (HappyAbsSyn ) -> HappyWrap325 +happyOut325 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut325 #-} +newtype HappyWrap326 = HappyWrap326 (Located FastString) +happyIn326 :: (Located FastString) -> (HappyAbsSyn ) +happyIn326 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap326 x) +{-# INLINE happyIn326 #-} +happyOut326 :: (HappyAbsSyn ) -> HappyWrap326 +happyOut326 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut326 #-} +newtype HappyWrap327 = HappyWrap327 (Located FastString) +happyIn327 :: (Located FastString) -> (HappyAbsSyn ) +happyIn327 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap327 x) +{-# INLINE happyIn327 #-} +happyOut327 :: (HappyAbsSyn ) -> HappyWrap327 +happyOut327 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut327 #-} +newtype HappyWrap328 = HappyWrap328 (LocatedN RdrName) +happyIn328 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn328 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap328 x) +{-# INLINE happyIn328 #-} +happyOut328 :: (HappyAbsSyn ) -> HappyWrap328 +happyOut328 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut328 #-} +newtype HappyWrap329 = HappyWrap329 (LocatedN RdrName) +happyIn329 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn329 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap329 x) +{-# INLINE happyIn329 #-} +happyOut329 :: (HappyAbsSyn ) -> HappyWrap329 +happyOut329 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut329 #-} +newtype HappyWrap330 = HappyWrap330 (LocatedN RdrName) +happyIn330 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn330 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap330 x) +{-# INLINE happyIn330 #-} +happyOut330 :: (HappyAbsSyn ) -> HappyWrap330 +happyOut330 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut330 #-} +newtype HappyWrap331 = HappyWrap331 (LocatedN RdrName) +happyIn331 :: (LocatedN RdrName) -> (HappyAbsSyn ) +happyIn331 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap331 x) +{-# INLINE happyIn331 #-} +happyOut331 :: (HappyAbsSyn ) -> HappyWrap331 +happyOut331 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut331 #-} +newtype HappyWrap332 = HappyWrap332 (Located (HsLit GhcPs)) +happyIn332 :: (Located (HsLit GhcPs)) -> (HappyAbsSyn ) +happyIn332 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap332 x) +{-# INLINE happyIn332 #-} +happyOut332 :: (HappyAbsSyn ) -> HappyWrap332 +happyOut332 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut332 #-} +newtype HappyWrap333 = HappyWrap333 (()) +happyIn333 :: (()) -> (HappyAbsSyn ) +happyIn333 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap333 x) +{-# INLINE happyIn333 #-} +happyOut333 :: (HappyAbsSyn ) -> HappyWrap333 +happyOut333 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut333 #-} +newtype HappyWrap334 = HappyWrap334 (LocatedA ModuleName) +happyIn334 :: (LocatedA ModuleName) -> (HappyAbsSyn ) +happyIn334 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap334 x) +{-# INLINE happyIn334 #-} +happyOut334 :: (HappyAbsSyn ) -> HappyWrap334 +happyOut334 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut334 #-} +newtype HappyWrap335 = HappyWrap335 ((NonEmpty SrcSpan,Int)) +happyIn335 :: ((NonEmpty SrcSpan,Int)) -> (HappyAbsSyn ) +happyIn335 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap335 x) +{-# INLINE happyIn335 #-} +happyOut335 :: (HappyAbsSyn ) -> HappyWrap335 +happyOut335 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut335 #-} +newtype HappyWrap336 = HappyWrap336 (([EpToken "|"],Int)) +happyIn336 :: (([EpToken "|"],Int)) -> (HappyAbsSyn ) +happyIn336 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap336 x) +{-# INLINE happyIn336 #-} +happyOut336 :: (HappyAbsSyn ) -> HappyWrap336 +happyOut336 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut336 #-} +newtype HappyWrap337 = HappyWrap337 (([EpToken "|"],Int)) +happyIn337 :: (([EpToken "|"],Int)) -> (HappyAbsSyn ) +happyIn337 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap337 x) +{-# INLINE happyIn337 #-} +happyOut337 :: (HappyAbsSyn ) -> HappyWrap337 +happyOut337 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut337 #-} +newtype HappyWrap338 = HappyWrap338 (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) +happyIn338 :: (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -> (HappyAbsSyn ) +happyIn338 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap338 x) +{-# INLINE happyIn338 #-} +happyOut338 :: (HappyAbsSyn ) -> HappyWrap338 +happyOut338 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut338 #-} +newtype HappyWrap339 = HappyWrap339 (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) +happyIn339 :: (forall b. DisambECP b => PV (LocatedLW [LMatch GhcPs (LocatedA b)])) -> (HappyAbsSyn ) +happyIn339 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap339 x) +{-# INLINE happyIn339 #-} +happyOut339 :: (HappyAbsSyn ) -> HappyWrap339 +happyOut339 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut339 #-} +newtype HappyWrap340 = HappyWrap340 (ECP) +happyIn340 :: (ECP) -> (HappyAbsSyn ) +happyIn340 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap340 x) +{-# INLINE happyIn340 #-} +happyOut340 :: (HappyAbsSyn ) -> HappyWrap340 +happyOut340 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut340 #-} +newtype HappyWrap341 = HappyWrap341 (ECP) +happyIn341 :: (ECP) -> (HappyAbsSyn ) +happyIn341 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap341 x) +{-# INLINE happyIn341 #-} +happyOut341 :: (HappyAbsSyn ) -> HappyWrap341 +happyOut341 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut341 #-} +newtype HappyWrap342 = HappyWrap342 (ECP) +happyIn342 :: (ECP) -> (HappyAbsSyn ) +happyIn342 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap342 x) +{-# INLINE happyIn342 #-} +happyOut342 :: (HappyAbsSyn ) -> HappyWrap342 +happyOut342 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut342 #-} +newtype HappyWrap343 = HappyWrap343 (Located (NonEmpty (LPat GhcPs))) +happyIn343 :: (Located (NonEmpty (LPat GhcPs))) -> (HappyAbsSyn ) +happyIn343 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap343 x) +{-# INLINE happyIn343 #-} +happyOut343 :: (HappyAbsSyn ) -> HappyWrap343 +happyOut343 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut343 #-} +newtype HappyWrap344 = HappyWrap344 (Located (NonEmpty (LPat GhcPs))) +happyIn344 :: (Located (NonEmpty (LPat GhcPs))) -> (HappyAbsSyn ) +happyIn344 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap344 x) +{-# INLINE happyIn344 #-} +happyOut344 :: (HappyAbsSyn ) -> HappyWrap344 +happyOut344 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut344 #-} +newtype HappyWrap345 = HappyWrap345 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) +happyIn345 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) +happyIn345 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap345 x) +{-# INLINE happyIn345 #-} +happyOut345 :: (HappyAbsSyn ) -> HappyWrap345 +happyOut345 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut345 #-} +newtype HappyWrap346 = HappyWrap346 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) +happyIn346 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) +happyIn346 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap346 x) +{-# INLINE happyIn346 #-} +happyOut346 :: (HappyAbsSyn ) -> HappyWrap346 +happyOut346 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut346 #-} +newtype HappyWrap347 = HappyWrap347 (ECP) +happyIn347 :: (ECP) -> (HappyAbsSyn ) +happyIn347 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap347 x) +{-# INLINE happyIn347 #-} +happyOut347 :: (HappyAbsSyn ) -> HappyWrap347 +happyOut347 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut347 #-} +newtype HappyWrap348 = HappyWrap348 (ECP) +happyIn348 :: (ECP) -> (HappyAbsSyn ) +happyIn348 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap348 x) +{-# INLINE happyIn348 #-} +happyOut348 :: (HappyAbsSyn ) -> HappyWrap348 +happyOut348 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut348 #-} +newtype HappyWrap349 = HappyWrap349 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) +happyIn349 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) +happyIn349 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap349 x) +{-# INLINE happyIn349 #-} +happyOut349 :: (HappyAbsSyn ) -> HappyWrap349 +happyOut349 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut349 #-} +newtype HappyWrap350 = HappyWrap350 (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) +happyIn350 :: (forall b. DisambECP b => PV (Located ([EpToken ";"],[LMatch GhcPs (LocatedA b)]))) -> (HappyAbsSyn ) +happyIn350 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap350 x) +{-# INLINE happyIn350 #-} +happyOut350 :: (HappyAbsSyn ) -> HappyWrap350 +happyOut350 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut350 #-} +newtype HappyWrap351 = HappyWrap351 (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) +happyIn351 :: (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -> (HappyAbsSyn ) +happyIn351 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap351 x) +{-# INLINE happyIn351 #-} +happyOut351 :: (HappyAbsSyn ) -> HappyWrap351 +happyOut351 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut351 #-} +newtype HappyWrap352 = HappyWrap352 (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) +happyIn352 :: (forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b))) -> (HappyAbsSyn ) +happyIn352 x = Happy_GHC_Exts.unsafeCoerce# (HappyWrap352 x) +{-# INLINE happyIn352 #-} +happyOut352 :: (HappyAbsSyn ) -> HappyWrap352 +happyOut352 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut352 #-} +happyInTok :: ((Located Token)) -> (HappyAbsSyn ) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn ) -> ((Located Token)) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyExpList :: HappyAddr +happyExpList = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x1f\xff\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x37\x5f\xe5\xff\x2f\xff\xbf\x67\x10\x04\x78\x00\xa1\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\xb9\x08\xfe\x7f\xf9\xff\x09\x82\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe3\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x10\x10\x11\x02\x54\xd0\x3f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x01\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x08\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x14\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x00\x40\x10\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x16\x40\x54\xe0\x0c\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf0\xf3\x09\xff\x00\x00\x00\x00\x2c\x80\xa8\xc0\x19\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0b\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc4\x85\x10\x1d\xfe\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x82\x0b\x21\x6a\xfc\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x00\x00\x00\xc0\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x20\x00\x22\x04\xa8\xa0\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\xaa\x70\x86\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x20\x22\x04\x40\x10\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xff\x27\xfc\x03\x00\x00\x00\x00\x00\x00\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x10\x3f\x00\x00\x31\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xc2\x3f\x00\x00\x40\x00\x07\x08\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\xff\x81\x00\x00\x12\x3c\x00\x51\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x60\x01\x44\x05\xce\xc0\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x0f\x00\x00\x10\xc0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xc2\x3f\x00\x00\x40\x00\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf0\xff\x0b\xff\x00\x00\x00\x07\x1c\x20\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xff\x01\x00\x00\x02\x38\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfc\x03\x00\x00\x04\x70\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xf8\x07\x00\x00\x08\xe0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x04\xff\xbf\xf0\x0f\x00\x00\x10\xc0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x1f\x08\x00\x24\xc0\x87\x00\x57\xfc\xff\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x3f\x10\x00\x48\x8a\x0f\x03\xba\xfc\xff\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x7f\x20\x00\x90\x04\x1f\x02\xd4\xf9\xff\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf0\xff\x0b\xff\x00\x00\x00\x01\x1c\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\xfe\x01\x00\x00\x00\x00\x00\x50\x01\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xff\x01\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x55\x38\xc3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7c\xc2\x3f\x00\x00\x00\x00\x00\x00\x2a\x60\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x88\x10\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x01\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x01\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x08\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x00\x54\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xea\xff\x17\xff\x81\x00\x40\x52\x7c\x18\xd0\xe5\xff\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x20\x42\x00\x00\x62\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x22\x10\x82\xff\x4f\xf8\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x15\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x90\xe2\xff\x13\xfe\x01\x00\x00\x00\x00\x00\x50\x01\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x03\x00\x00\x00\xb0\x00\xa2\x02\x67\xe0\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\xc5\x7f\x00\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\xa8\x80\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xfe\x01\x00\x00\x02\x38\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\x85\x7f\x00\x00\x80\x00\x0e\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x40\x44\x08\x80\x20\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x2a\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x40\x00\x48\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x40\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x80\x00\x00\x00\x41\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x07\x30\x00\x01\x70\x21\x44\x05\xff\xc3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x04\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\x87\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x20\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x00\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf4\xff\x8b\xff\x00\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x26\x42\x04\x00\x62\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x20\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfe\x03\x00\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xd5\xff\x2f\xfe\x03\x01\x80\x04\xf8\x10\xa0\xcb\xff\xff\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\xaa\xff\x5f\xfc\x07\x02\x00\x49\xf0\x21\x40\x15\xff\xff\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x16\x40\x54\xe0\x0c\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfe\x03\x00\x00\x04\x70\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x00\x60\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x40\x00\x00\x80\x20\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x20\x20\x22\x04\xe8\x90\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x20\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\xa8\x80\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x5c\x04\xff\xbf\xfc\xff\x04\x41\x10\xe0\x01\x84\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\xb9\x08\xfe\x7f\xf9\xff\x09\x82\x20\xc0\x03\x08\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x08\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x88\x00\x01\x10\x84\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x11\x02\x00\x10\x33\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x3f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x7f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\xa8\xfe\x7f\xf1\x1f\x08\x00\x24\xc0\x87\x00\x75\xfe\xff\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\x85\x7f\x00\x00\x80\x00\x0e\x10\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xfe\x01\x00\x00\x02\x38\x40\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x3f\x00\x00\x00\x00\x0b\x20\x2a\x70\x06\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x1f\x00\x00\x20\x80\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x10\x00\x00\x00\x20\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x03\x00\x00\x00\xb0\x00\xa2\x02\x67\xe0\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x74\xf8\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\x00\x80\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x40\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x84\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x00\x00\x04\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xf3\x09\xff\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\xfe\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x60\x01\x44\x05\xce\xc0\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x16\x40\x54\xe0\x0c\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x60\x01\x44\x05\xce\xc0\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xc1\x27\xfc\x03\x00\x00\x00\x00\x00\x00\x00\x06\x40\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x01\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x00\x00\x00\x16\x40\x54\xe0\x0c\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\x20\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x1f\x00\x00\x20\x80\x03\x24\x55\x39\xf3\xff\xff\x7f\x7d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x11\xfc\xff\xc2\x3f\x00\x00\x40\x00\x07\x08\xab\x72\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa9\xca\x99\xff\xff\xff\xeb\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\xff\x81\x00\x00\x02\x3c\x00\x58\x95\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x54\xff\xbf\xf8\x0f\x04\x00\x12\xe0\x43\x80\x2a\xfe\xff\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xe2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf5\xff\x8b\xff\x40\x00\x20\x01\x3e\x04\xa8\xe2\xff\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x3f\x10\x00\x48\x80\x0f\x01\xaa\xfc\xff\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xfe\x01\x00\x00\x02\x38\x00\x50\x8d\x33\xff\xff\xff\xd7\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x9b\xaf\xf2\xff\x97\xff\xdf\x33\x08\x02\x3c\x80\x50\x85\x33\xff\xff\xff\xd7\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x80\x88\x10\x00\x80\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x44\x08\x00\x40\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x02\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xff\x01\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xff\x27\xfc\x03\x00\x00\x00\x00\x00\x80\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\x22\xf8\xff\xc5\x7f\x00\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x80\x0a\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x15\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x01\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x88\x10\x00\x80\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x30\x11\x22\x00\x10\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc1\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\xa2\xff\x5f\xfc\x07\x00\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x44\xff\xbf\xf8\x0f\x00\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x1f\x00\x00\x20\x80\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xfa\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf5\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xea\xff\x17\xff\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xd5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\xaa\xff\x5f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x44\xff\xbf\xf8\x0f\x00\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x04\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\x87\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x01\x02\x00\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x00\x00\x04\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x00\x10\x40\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x04\x10\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x04\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x40\x05\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x1f\x00\x00\x20\x80\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x80\x00\x01\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x44\x08\x00\x40\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfe\xe6\xab\xfc\xff\xe5\xff\xf7\x0c\x82\x00\x0f\x20\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x15\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x82\xff\x5f\xfc\x07\x00\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x04\x10\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\xff\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x01\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\x00\x00\x00\x00\x00\x10\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x01\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf0\xf3\x09\xff\x00\x00\x00\x00\x00\x80\x20\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xd1\xff\x2f\xfe\x03\x00\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x00\x22\x04\x00\x20\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\xfc\x7f\xc2\x3f\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x11\x02\x00\x10\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x73\x11\xfc\xff\xf2\xff\x13\x04\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\xff\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x38\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x28\xfe\x7f\xf1\x1f\x08\x00\x20\xc0\x03\x00\x55\x39\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x83\x81\x08\xfe\x7f\xe1\x1f\x00\x00\x20\x80\x03\x04\x55\x39\xf3\xff\xff\x7f\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x20\x8a\xff\x5f\xfc\x07\x02\x00\x08\xf0\x00\x40\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf5\xff\x8b\xff\x40\x00\x20\x01\x3e\x04\xa8\xe2\xff\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xff\x13\xfe\x01\x00\x20\x00\x00\x00\x40\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x7a\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x07\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x02\xe0\x42\x88\x0a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xfe\x01\x00\x00\x02\x38\x40\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\xff\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x71\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xe2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf5\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x22\x42\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x07\x30\x00\x01\x70\x21\x44\x05\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x3f\x00\x00\x00\x00\x00\x20\x08\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x01\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xf8\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc1\x40\x14\xff\xbf\xf8\x0f\x04\x00\x10\xe0\x01\x80\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x73\x51\xfc\xff\xf2\xff\x13\x04\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\xe6\xa2\xf8\xff\xe5\xff\x27\x08\x82\x00\x0f\x20\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xf3\x09\xff\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe1\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\xf0\xff\x09\xff\x00\x00\x00\x00\x00\x00\x20\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x20\x42\x00\x00\x62\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x00\x29\xfe\x3f\xe9\x1f\x00\x00\x00\x00\x00\x00\x04\x30\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\x00\x08\xfe\x3f\xe1\x1f\x00\x00\x00\x00\x00\x00\x15\x30\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x01\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x88\x10\x00\x00\x98\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\xff\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x17\xc1\xff\x2f\xff\x3f\x41\x10\x04\x78\x00\xa1\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x60\x2e\x82\xff\x5f\xfe\x7f\x82\x20\x08\xf0\x00\x42\x15\xce\xfc\xff\xff\x5f\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x73\x55\xfc\xff\xf2\xff\x13\x04\x41\x80\x07\x10\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\xe6\xaa\xf8\xff\xe5\xff\x27\x08\x82\x00\x0f\x20\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x20\x00\x82\x9f\x4f\xf8\x07\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe0\xff\x17\xff\x01\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x08\xd1\xdf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe1\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf0\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x83\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x10\x5c\x08\x51\xe3\xff\xf4\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\xff\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x02\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfc\xff\xe2\x3f\x10\x00\x40\x80\x07\x00\xaa\x70\xe6\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0e\x06\xa2\xf8\xff\xc5\x7f\x20\x00\x80\x00\x0f\x00\x54\xe1\xcc\xff\xff\xff\xf5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0c\x44\xf1\xff\x8b\xff\x40\x00\x00\x01\x1e\x00\xa8\xc2\x99\xff\xff\xff\xeb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x03\x51\xfd\xff\xe2\x3f\x10\x00\x48\x80\x0f\x01\xaa\xf8\xff\xff\xff\xff\xfa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x20\xf8\xff\x84\x7f\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x40\x70\xf0\x09\xff\x00\x00\x00\x00\x00\x00\x00\x80\x01\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x07\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x00\x18\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x30\x10\xc5\xff\x2f\xfe\x03\x01\x00\x04\x78\x00\xa0\x0a\x67\xfe\xff\xff\xaf\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x40\x00\x44\x3f\x9f\xf0\x0f\x60\x00\x82\xe0\x42\x88\x1a\xfe\xa7\x07\x00\x00\x32\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x08\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2a\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xcd\x5c\x14\xff\xbf\xfc\xff\x04\x41\x10\xe0\x01\x84\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf0\xf3\x09\xff\x00\x06\x20\x00\x2e\x84\xa8\xe0\x7f\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x00\x44\x08\x00\x40\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xc1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe1\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x18\x00\x17\x42\x54\xf0\x3f\x3c\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x04\x40\xf4\xf3\x09\xff\x00\x06\x30\x00\x2e\x84\xa8\xe0\x7f\x78\x00\x00\x20\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x08\x80\xe0\xe7\x13\xfe\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x22\x00\x8a\xff\x4f\xf8\x07\x00\x80\x00\x00\x00\x00\x01\xcc\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x40\x00\x04\x3f\x9f\xf0\x0f\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\xc5\x5c\x15\xff\xbf\xfc\xff\x04\x41\x10\xe0\x01\x84\x2a\x9c\xf9\xff\xff\xbf\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x0f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x10\x00\xd1\xcf\x27\xfc\x03\x18\x80\x00\xb8\x10\xa2\x82\xff\xe9\x01\x00\x80\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe0\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x20\xfa\xf9\x84\x7f\x00\x03\x10\x00\x17\x42\x54\xf0\x3f\x3d\x00\x00\x90\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x81\x00\x88\x7e\x3e\xe1\x1f\xc0\x00\x04\xc0\x85\x10\x15\xfc\x4f\x0f\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x38\x18\x88\xe2\xff\x17\xff\x81\x00\x00\x02\x3c\x00\x50\x85\x33\xff\xff\xff\xd7\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x9f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\x20\x00\xa2\x9f\x4f\xf8\x07\x30\x00\x01\x71\x21\x44\x87\xff\xd3\x03\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfc\x7c\xc2\x3f\x00\x00\x00\x00\x00\x00\x08\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x08\x80\xe8\xe7\x13\xfe\x01\x0c\x40\x00\x5c\x08\x51\xc1\xff\xf0\x00\x00\x40\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x03\x01\x10\xfd\x7c\xc2\x3f\x80\x01\x08\x80\x0b\x21\x2a\xf8\x1f\x1e\x00\x00\xc8\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x22\x00\x8a\xff\x4f\xf8\x07\x00\x80\x00\x00\x00\x00\x01\xcc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x10\x00\xc1\xcf\x27\xfc\x03\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x01\x10\x1c\x7c\xc2\x3f\x00\x00\x00\x00\x00\x00\x00\xe0\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x29\xfe\x3f\xe9\x1f\x00\x00\x00\x00\x00\x00\x04\x32\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x05\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x29\xfe\x3f\xe9\x1f\x00\x00\x00\x00\x00\x00\x04\x32\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x11\x20\xc5\xff\x27\xfd\x03\x00\x00\x00\x00\x00\x80\x00\x66\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +{-# NOINLINE happyExpListPerState #-} +happyExpListPerState st = + token_strs_expected + where token_strs = ["error","%dummy","%start_parseModuleNoHaddock","%start_parseSignatureNoHaddock","%start_parseImport","%start_parseStatement","%start_parseDeclaration","%start_parseExpression","%start_parsePattern","%start_parseTypeSignature","%start_parseStmt","%start_parseIdentifier","%start_parseType","%start_parseBackpack","%start_parseHeader","identifier","backpack","units","unit","unitid","msubsts","msubst","moduleid","pkgname","litpkgname_segment","HYPHEN","litpkgname","mayberns","rns","rn","unitbody","unitdecls","unitdecl","signature","module","missing_module_keyword","implicit_top","body","body2","top","top1","header","header_body","header_body2","header_top","header_top_importdecls","maybeexports","exportlist","exportlist1","export_cs","export","export_subspec","qcnames","qcnames1","qcname_ext_w_wildcard","qcname_ext","qcname","semis1","semis","importdecls","importdecls_semi","importdecl","maybe_src","maybe_safe","maybe_splice","maybe_pkg","optqualified","maybeas","maybeimpspec","impspec","importlist","importlist1","import","prec","infix","ops","topdecls","topdecls_semi","topdecls_cs","topdecls_cs_semi","topdecl_cs","topdecl","cl_decl","default_decl","ty_decl","standalone_kind_sig","sks_vars","inst_decl","overlap_pragma","deriv_strategy_no_via","deriv_strategy_via","deriv_standalone_strategy","opt_class","opt_injective_info","injectivity_cond","inj_varids","where_type_family","ty_fam_inst_eqn_list","ty_fam_inst_eqns","ty_fam_inst_eqn","at_decl_cls","opt_family","opt_instance","at_decl_inst","type_data_or_newtype","data_or_newtype","opt_kind_sig","opt_datafam_kind_sig","opt_tyfam_kind_sig","opt_at_kind_inj_sig","tycl_hdr","datafam_inst_hdr","capi_ctype","stand_alone_deriving","role_annot","maybe_roles","roles","role","pattern_synonym_decl","pattern_synonym_lhs","vars0","cvars1","where_decls","pattern_synonym_sig","qvarcon","decl_cls","decls_cls","decllist_cls","where_cls","decl_inst","decls_inst","decllist_inst","where_inst","decls","decllist","binds","wherebinds","rules","rule","rule_activation","rule_activation_marker","rule_explicit_activation","rule_foralls","rule_vars","rule_var","maybe_warning_pragma","warning_category","warnings","warning","namespace_spec","deprecations","deprecation","strings","stringlist","annotation","fdecl","callconv","safety","fspec","opt_sig","opt_tyconsig","sigktype","sigtype","sig_vars","sigtypes1","unpackedness","forall_telescope","ktype","ctype","context","expcontext","type","mult","expmult","btype","infixtype","ftype","tyarg","tyop","atype","inst_type","deriv_types","comma_types0","comma_types1","bar_types2","tv_bndrs","tv_bndr","tv_bndr_no_braces","tyvar_wc","fds","fds1","fd","varids0","kind","gadt_constrlist","gadt_constrs","gadt_constr","constrs","constrs1","constr","forall","constr_stuff","usum_constr","fielddecls","fielddecls1","fielddecl","maybe_derivings","derivings","deriving","deriv_clause_types","decl_no_th","decl","rhs","gdrhs","gdrh","sigdecl","sigtypes_maybe","activation","explicit_activation","quasiquote","exp","exp2","infixexp2","infixexp","exp10p","exp10","optSemi","prag_e","fexp","aexp","aexp1","aexp2","projection","splice_exp","splice_untyped","splice_typed","cmdargs","acmd","cvtopbody","cvtopdecls0","texp","tup_exprs","commas_tup_tail","tup_tail","list","lexps","flattenedpquals","pquals","squals","transformqual","guardquals","guardquals1","alt_rhs","ralt","gdpats","ifgdpats","gdpat","pat_syn_pat","pat","pats1","bindpat","argpat","argpats","apat","stmtlist","stmts","maybe_stmt","e_stmt","stmt","qual","fbinds","fbinds1","fbind","fieldToUpdate","dbinds","dbind","ipvar","overloaded_label","name_boolformula_opt","name_boolformula","name_boolformula_and","name_boolformula_and_list","name_boolformula_atom","namelist","name_var","qcon","gen_qcon","con","con_list","qcon_list","sysdcon_nolist","syscon","sysdcon","conop","qconop","gtycon","ntgtycon","oqtycon","oqtycon_no_varcon","qtyconop","qtycon","tycon","qtyconsym","tyconsym","otycon","op","varop","qop","qopm","hole_op","qvarop","qvaropm","tyvar","tyvarop","tyvarid","var","qvar","field","qvarid","varid","qvarsym","qvarsym_no_minus","qvarsym1","varsym","varsym_no_minus","special_id","special_sym","qconid","conid","qconsym","consym","literal","close","modid","commas","bars0","bars","altslist__argpats__","altslist__pats1__","exp_gen__infixexp__","exp_gen__infixexp2__","exp_prag__exp10p__","orpats__exp__","orpats__exp2__","alts__argpats__","alts__pats1__","exp_prag__exp_gen__infixexp2____","exp_prag__exp_gen__infixexp____","alts1__argpats__","alts1__pats1__","alt__argpats__","alt__pats1__","'_'","'as'","'case'","'class'","'data'","'default'","'deriving'","'else'","'hiding'","'if'","'import'","'in'","'infix'","'infixl'","'infixr'","'instance'","'let'","'module'","'newtype'","'of'","'qualified'","'then'","'type'","'where'","'forall'","'foreign'","'export'","'label'","'dynamic'","'safe'","'interruptible'","'unsafe'","'family'","'role'","'stdcall'","'ccall'","'capi'","'prim'","'javascript'","'proc'","'rec'","'group'","'by'","'using'","'pattern'","'static'","'stock'","'anyclass'","'via'","'splice'","'quote'","'unit'","'signature'","'dependency'","'{-# INLINE'","'{-# OPAQUE'","'{-# SPECIALISE'","'{-# SPECIALISE_INLINE'","'{-# SOURCE'","'{-# RULES'","'{-# SCC'","'{-# DEPRECATED'","'{-# WARNING'","'{-# UNPACK'","'{-# NOUNPACK'","'{-# ANN'","'{-# MINIMAL'","'{-# CTYPE'","'{-# OVERLAPPING'","'{-# OVERLAPPABLE'","'{-# OVERLAPS'","'{-# INCOHERENT'","'{-# COMPLETE'","'#-}'","'..'","':'","'::'","'='","'\\\\'","'lcase'","'lcases'","'|'","'<-'","'->'","'->.'","TIGHT_INFIX_AT","'=>'","'-'","PREFIX_TILDE","PREFIX_BANG","PREFIX_MINUS","'*'","'-<'","'>-'","'-<<'","'>>-'","'.'","PREFIX_PROJ","TIGHT_INFIX_PROJ","PREFIX_AT","PREFIX_PERCENT","'{'","'}'","vocurly","vccurly","'['","']'","'('","')'","'(#'","'#)'","'(|'","'|)'","';'","','","'`'","SIMPLEQUOTE","VARID","CONID","VARSYM","CONSYM","QVARID","QCONID","QVARSYM","QCONSYM","DO","MDO","IPDUPVARID","LABELVARID","CHAR","STRING","STRING_MULTI","INTEGER","RATIONAL","PRIMCHAR","PRIMSTRING","PRIMINTEGER","PRIMWORD","PRIMINTEGER8","PRIMINTEGER16","PRIMINTEGER32","PRIMINTEGER64","PRIMWORD8","PRIMWORD16","PRIMWORD32","PRIMWORD64","PRIMFLOAT","PRIMDOUBLE","'[|'","'[p|'","'[t|'","'[d|'","'|]'","'[||'","'||]'","PREFIX_DOLLAR","PREFIX_DOLLAR_DOLLAR","TH_TY_QUOTE","TH_QUASIQUOTE","TH_QQUASIQUOTE","%eof"] + bit_start = st Prelude.* 513 + bit_end = (st Prelude.+ 1) Prelude.* 513 + read_bit = readArrayBit happyExpList + bits = Prelude.map read_bit [bit_start..bit_end Prelude.- 1] + bits_indexed = Prelude.zip bits [0..512] + token_strs_expected = Prelude.concatMap f bits_indexed + f (Prelude.False, _) = [] + f (Prelude.True, nr) = [token_strs Prelude.!! nr] + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x25\x00\x1b\x00\xa6\x00\xf1\x35\xd1\x28\x31\x3c\x31\x3c\x71\x33\xf1\x35\x75\x6d\x7f\x55\xb6\x00\x47\x01\x70\x72\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x00\x00\x00\x00\x00\x00\x12\x01\x00\x00\xa3\x01\xa3\x01\x00\x00\xa7\x00\x0b\x02\x0b\x02\x55\x5b\x7f\x55\xda\x00\xf9\x01\x06\x02\x00\x00\x4e\x1a\x00\x00\x0a\x19\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x19\x00\x00\xc6\x17\x00\x00\x00\x00\x00\x00\x68\x18\x45\x75\x00\x00\x00\x00\x00\x00\x62\x01\x57\x02\x00\x00\x00\x00\xf3\x5d\xf3\x5d\x00\x00\x00\x00\x7e\x76\xe7\x53\xb9\x50\x41\x51\x06\x72\xde\x6d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x4f\x00\x00\x00\x00\x15\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x02\x63\x08\x46\x03\x9c\x71\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x02\xf0\x1a\x00\x00\x31\x3c\x92\x1b\x00\x00\xbd\x02\x00\x00\x00\x00\x00\x00\x7f\x02\x72\x02\x00\x00\x00\x00\x82\x16\x00\x00\x00\x00\xe8\x02\x00\x00\x00\x00\x00\x00\x00\x00\x31\x3c\xb1\x34\xa5\x04\xf3\x5d\xf1\x4e\xf7\x04\xf1\x4e\xf6\x00\x11\x43\x11\x4d\xf1\x4e\xf1\x4e\xf1\x4e\x91\x31\x11\x2a\x31\x2d\xf1\x4e\x0c\x70\xf7\x04\xf7\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x31\x3c\x31\x4b\x7f\x55\x08\x05\x31\x3c\x91\x4f\x24\x17\xc3\x02\x00\x00\x05\x03\x56\x09\x0d\x03\x16\x03\x00\x00\x00\x00\x00\x00\x20\x05\xe0\x03\x70\x70\x70\x72\xd1\x3c\xb1\x43\x70\x72\x74\x73\xdd\x02\x11\x2a\xa2\x01\x12\x03\x00\x00\x12\x03\x12\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x03\xbe\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\x0d\x55\x5b\xea\x01\x79\x03\x65\x02\xae\x00\xca\x03\x4f\x52\x2a\x02\xd1\x73\x5d\x03\x2d\x00\x4e\x00\x17\x73\xf3\x5d\x73\x03\x00\x00\x73\x03\xb2\x03\x7a\x03\x30\x04\x7a\x03\x00\x00\x00\x00\x30\x04\x00\x00\xd9\x03\xbb\x03\xae\x00\x00\x00\x00\x00\x33\x00\xae\x00\xc7\x02\xe6\x03\x31\x4b\x38\x71\xf1\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\x4e\xca\x01\xc2\x04\x6a\x01\x1e\x00\x00\x00\xf0\x03\x2e\x74\x9f\x00\x00\x00\x00\x00\x00\x00\x0c\x01\x00\x00\x51\x44\xa3\x03\x44\x76\x00\x04\x14\x01\x85\x02\x00\x00\x49\x06\x49\x06\xac\x00\x1b\x04\xe7\x02\x29\x01\x00\x00\xaf\x58\x55\x5b\xda\x02\xf1\x04\x04\x00\x75\x04\x00\x00\x9c\x04\x00\x00\x00\x00\x00\x00\x7f\x55\x45\x04\x00\x00\x55\x5b\x6b\x04\x80\x04\x00\x00\x64\x04\x00\x00\xf1\x44\x00\x00\x00\x00\x7f\x55\x45\x6e\x9f\x04\x55\x5b\x73\x04\x71\x3d\x91\x45\xb3\x04\x81\x04\xcb\x1c\x7d\x4f\x91\x36\x94\x02\x59\x01\xb0\x04\x00\x00\x31\x4b\x00\x00\x00\x00\x00\x00\xfc\x04\x0e\x05\x18\x05\x1e\x05\x71\x2e\x31\x32\x00\x00\x35\x05\x00\x00\xf3\x5d\x00\x00\x43\x05\x11\x4d\xd7\x77\x00\x00\x00\x00\x45\x6e\xad\x04\xc5\x04\xe7\x03\xce\x04\x00\x00\x6c\x05\x00\x00\x46\x05\x00\x00\xae\x72\xfc\xff\x31\x46\x00\x00\x3e\x01\x31\x46\x7f\x55\x86\x05\xd4\x70\x6b\x05\x00\x00\xdd\x05\xd1\x32\xd1\x32\x7e\x76\x7f\x55\x6a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x05\xb6\x06\xd1\x01\x00\x00\x00\x00\x5e\x05\x73\x05\x00\x00\x00\x00\x78\x05\x3b\x06\x7b\x05\x00\x00\x31\x37\x31\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x02\x95\x05\x00\x00\x00\x00\x11\x2f\x00\x00\xb0\x05\x77\x00\xc0\x05\xbb\x05\x00\x00\x00\x00\x00\x00\x00\x00\x34\x1c\x00\x00\xb1\x4d\xe6\x05\x00\x00\x5c\x05\x5f\x05\xf3\x5d\x02\x06\x1e\x06\x00\x00\x00\x00\x22\x06\x00\x00\x37\x06\x18\x06\x43\x00\x00\x00\x00\x00\x11\x3e\x54\x06\x87\x06\xf1\x4e\xb1\x3e\xd7\x77\x3b\x72\x00\x00\xf3\x5d\x00\x00\x7f\x55\xb1\x3e\xb1\x3e\xb1\x3e\xb1\x3e\x35\x06\x4f\x06\x5e\x04\x29\x06\x5c\x06\x11\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x55\xd7\x52\xd1\x71\x59\x06\x7c\x06\x78\x01\x61\x06\x75\x06\xb9\x04\xfa\x01\x00\x00\x68\x02\x31\x50\xef\x02\x72\x06\x00\x00\xdf\x02\x00\x00\x64\x01\xb1\x06\x00\x00\xa8\x06\x00\x00\xa4\x02\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x01\x45\x75\x00\x00\x00\x00\x00\x00\x00\x00\x46\x78\x6f\x28\x7f\x55\xf3\x5d\x00\x00\x55\x5b\x00\x00\xf3\x5d\xc9\x06\x7f\x55\x7f\x55\xf3\x5d\x7f\x55\x7f\x55\x00\x00\x00\x00\x53\x02\x00\x00\x3c\x61\x30\x00\x00\x00\xaf\x06\x33\x03\x33\x03\x00\x00\xc4\x06\xc4\x06\x00\x00\x00\x00\x1f\x07\x00\x00\x00\x00\x00\x00\x00\x00\x05\x07\x28\x07\x33\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x55\x00\x00\x00\x00\x00\x00\x00\x00\xf5\x06\x1b\x01\x00\x00\x00\x00\x00\x00\xdb\x06\x7e\x76\x00\x00\x7f\x55\xf3\x5d\x7e\x76\x00\x00\x7f\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x55\x7f\x55\x00\x00\x00\x00\xdf\x06\xdc\x06\xee\x06\xf2\x06\x04\x07\x11\x07\x00\x00\x15\x07\x16\x07\x17\x07\xf3\x06\x1a\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x07\x00\x00\x1c\x07\x44\x07\x30\x07\x31\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x05\xdb\x01\x46\x07\x25\x07\x00\x00\x00\x00\x00\x00\x8c\x07\x00\x00\xb1\x3e\xb1\x3e\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x46\x77\x1d\x00\x00\x51\x35\xd6\x1c\xb1\x3e\x00\x00\x11\x34\x00\x00\xd1\x37\x71\x38\x11\x34\x00\x00\x2d\x07\x00\x00\x00\x00\x00\x00\xd1\x2d\x53\x07\x00\x00\x51\x4e\x4f\x00\x00\x00\xb0\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x28\x33\x00\x3c\x07\x00\x00\x00\x00\x00\x00\x3d\x07\x00\x00\x00\x00\x7f\x05\x00\x00\x00\x00\x55\x01\x5b\x00\x00\x00\x00\x00\xfa\x0e\x00\x00\xb1\x2f\x51\x30\x67\x00\x00\x00\xf1\x30\xd1\x02\x55\x03\xe0\x03\x61\x07\x00\x00\x00\x00\x00\x00\x00\x00\x62\x07\x31\x4b\xb3\x76\x2b\x07\x00\x00\x00\x00\x42\x07\x31\x4b\x00\x00\x69\x07\x48\x07\x49\x07\x8b\x74\x8b\x74\x00\x00\x6a\x07\xab\x04\x92\x05\x4b\x07\x4f\x07\x00\x00\x00\x00\x00\x00\x00\x00\x67\x07\x54\x07\xfd\x04\x00\x00\x00\x00\xd7\x77\x00\x00\x7d\x4f\x00\x00\x6e\x07\x71\x47\x11\x48\x11\x48\xf1\x4e\x7f\x55\x11\x39\x11\x39\x11\x39\x11\x39\x11\x39\x11\x48\x00\x00\x00\x00\xfe\xff\x44\x04\x37\x59\xff\x04\x00\x00\x00\x00\xb1\x48\x00\x00\x00\x00\xc7\x00\x00\x00\xb1\x3e\x51\x3f\x55\x5b\xae\x07\x00\x00\x7b\x07\x7f\x55\x00\x00\x00\x00\x7f\x07\x67\x04\x04\x00\x88\x07\x55\x07\x00\x00\x7f\x55\x8d\x07\x8f\x07\x91\x07\x92\x07\x2b\x00\x90\x02\xf3\x04\x00\x00\x93\x07\x45\x75\x7f\x55\x7f\x55\xda\x02\x5e\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x60\xd7\x77\x00\x00\x66\x07\x7f\x55\x00\x00\xd7\x77\xf1\x76\xf1\x3f\xf1\x3f\x51\x49\x00\x00\x7a\x01\x00\x00\x5c\x07\x00\x00\xa9\x01\x04\x00\x6f\x07\x00\x00\x00\x00\x51\x00\xe8\x74\x00\x00\xf1\x4e\x9d\x01\x9d\x07\x9e\x07\xc8\x0f\x00\x00\xcd\x07\x00\x00\x00\x00\x80\x07\x00\x00\x80\x07\x00\x00\x00\x00\xe2\x07\x00\x00\x7d\x07\x00\x00\xd1\x28\xd8\x07\x14\x02\xd9\x07\xde\x07\x00\x00\x45\x05\x7f\x55\x00\x00\x00\x00\x89\x07\xab\x07\x04\x00\x00\x00\xe8\x74\x00\x00\x00\x00\x00\x00\xec\x01\x95\x07\x31\x4b\x00\x00\xe5\x07\x00\x00\x9a\x07\x87\x07\x00\x00\x00\x00\x8e\x07\x00\x00\xd1\x60\x00\x00\xb6\x07\xb7\x07\xb8\x07\xb9\x07\xf1\x76\xf1\x76\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x07\x7f\x55\xbe\x07\x7f\x55\x45\x75\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\x07\x41\x03\x00\x00\x00\x00\xc1\x07\xf1\x04\x7f\x55\xa4\x07\x00\x00\x7f\x55\x9f\x07\x00\x00\x0c\x78\x00\x00\x80\x05\x00\x00\xc7\x07\xfe\x07\x00\x00\x00\x00\x8c\x05\x00\x00\x09\x05\xc0\x07\x00\x00\x45\x75\x00\x08\x12\x08\x7f\x55\x02\x08\x00\x00\xd4\x07\x00\x00\x93\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf1\x49\x00\x00\x00\x00\xd5\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x0f\x00\x00\xb4\x07\xcf\x07\x26\x77\x00\x00\xd7\x77\xe2\x0f\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x07\x00\x00\xd1\x32\xf1\x3f\x00\x00\x00\x00\x7f\x55\xc3\x07\x00\x00\x00\x00\x00\x00\x00\x00\x83\x75\x00\x00\x00\x00\xc2\x07\x00\x00\xb1\x39\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x07\x00\x00\x00\x00\x00\x00\xbb\x01\x00\x00\x00\x00\x91\x40\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x00\x00\x33\x00\xc5\x07\x00\x00\x51\x3a\xd1\x07\x00\x00\x2c\x00\x00\x00\x33\x00\xce\x07\x00\x00\xd1\x4b\xd2\x07\x00\x00\x00\x00\x00\x00\x31\x41\xd1\x41\x71\x42\x00\x00\x00\x00\xd7\x77\x11\x34\x3b\x72\x00\x00\x00\x00\x7f\x55\x00\x00\x00\x00\xed\x07\x00\x00\xd6\x07\xdd\x07\x00\x00\xf4\x07\x00\x00\x00\x00\x00\x00\x7f\x55\x00\x00\x7f\x55\x00\x00\x38\x6d\x00\x00\x00\x00\x00\x00\xa2\x05\x00\x00\x34\x08\x35\x08\x1a\x06\x1a\x06\x00\x00\x3f\x00\x3f\x00\x00\x00\xe7\x07\xee\x07\x7f\x55\x00\x00\x00\x00\xea\x07\x00\x00\x00\x00\x56\x01\x00\x00\x00\x00\x00\x00\xe8\x07\x00\x00\x00\x00\x91\x4a\x00\x00\x00\x00\x44\x08\x0b\x08\x71\x42\x00\x00\x00\x00\x71\x42\x00\x00\x00\x00\x3c\x08\x71\x29\xf1\x3a\xf1\x3a\x91\x3b\x00\x00\xf6\x07\x00\x00\x7f\x05\x00\x00\x00\x00\x00\x00\x00\x00\x11\x08\x22\x08\x7f\x55\x23\x08\x00\x00\x56\x08\x00\x00\x29\x08\x00\x00\x00\x00\x27\x08\x00\x00\xdb\x5b\xbb\x75\x00\x00\x00\x00\x75\x08\x00\x00\x5f\x01\x75\x08\x1d\x06\x1c\x08\x61\x5c\x67\x08\x79\x08\x00\x00\x00\x00\x71\x42\x00\x00\xb1\x2a\xb1\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x55\x00\x00\x00\x00\x03\x08\x00\x00\x2a\x06\x00\x00\x00\x00\x00\x00\x6d\x08\x46\x78\x00\x00\x61\x5c\x3b\x08\x3e\x08\x7f\x55\x00\x00\x00\x00\x64\x77\x00\x00\x00\x00\x5e\x06\xc9\x03\x00\x00\x00\x00\x1e\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x08\x00\x00\x64\x06\x20\x08\x1f\x08\x00\x00\x00\x00\xf9\x6e\x00\x00\x64\x06\x25\x08\x00\x00\x26\x08\x00\x00\x26\x08\x00\x00\x00\x00\x00\x00\x2d\x08\x00\x00\x00\x00\x00\x00\x00\x00\xd4\x70\x25\x05\x26\x05\xda\x02\x92\x05\x7c\x04\x87\x00\x00\x00\x00\x00\x26\x05\x00\x00\x00\x00\x71\x42\xd1\x32\xd1\x32\x00\x00\x00\x00\x7f\x55\x7f\x55\x43\x08\x00\x00\x41\x08\x00\x00\x76\x06\x00\x00\x51\x2b\x51\x2b\x00\x00\x00\x00\x00\x00\x46\x78\x00\x00\x00\x00\x8e\x00\x00\x00\x7a\x08\x71\x4c\x6f\x54\x5f\x03\x00\x00\x00\x00\x93\x08\x00\x00\x61\x5c\x80\x03\x80\x03\x00\x00\xea\x02\x6b\x08\x00\x00\x00\x00\x00\x00\x00\x00\xf7\x54\x00\x00\x3d\x08\x46\x08\x00\x00\x49\x08\x00\x00\x41\x51\x89\x08\x00\x00\x99\x77\x7f\x55\x38\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x42\x71\x42\x71\x42\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x08\x11\x34\xd7\x77\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x01\x00\x00\x73\x08\x26\x05\x71\x61\x66\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x00\x45\x08\x48\x08\xa6\x61\xa4\x05\x26\x05\x00\x00\x00\x00\x00\x00\x71\x42\x00\x00\x00\x00\x84\x08\x7f\x55\x4b\x08\x55\x08\x00\x00\xbc\x01\x4a\x08\x5f\x53\xe7\x5c\x00\x00\x47\x08\x4f\x08\x00\x00\x00\x00\x00\x00\x33\x00\x50\x08\xe0\x03\x5a\x08\x66\x08\x00\x00\x00\x00\x00\x00\xf1\x2b\x00\x00\xe7\x05\xbf\x59\x6d\x5d\x36\x10\x6d\x5d\x00\x00\x00\x00\x00\x00\xb3\x08\x00\x00\x52\x01\x00\x00\x00\x00\x00\x00\xb3\x08\x76\x03\x00\x00\x07\x56\x8f\x56\x46\x78\x17\x57\x00\x00\x00\x00\x5c\x01\x77\x03\x00\x00\xf3\x05\x00\x00\x58\x08\x64\x08\x65\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x6f\x33\x00\x60\x08\x00\x00\x00\x00\x68\x08\x61\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x08\x00\x00\x00\x00\x00\x00\x46\x78\x00\x00\x66\x01\x00\x00\x33\x00\xa1\x03\x70\x08\x00\x00\x91\x2c\xbf\x59\x00\x00\x00\x00\x99\x08\x91\x08\x17\x57\xf2\x05\x00\x00\x00\x00\x17\x57\x9f\x57\x00\x00\x6d\x5d\x00\x00\x94\x08\x80\x03\x00\x00\x00\x00\x27\x58\x00\x00\x00\x00\x90\x08\x00\x00\x9a\x08\x27\x58\x00\x00\x00\x00\x00\x00\x71\x42\x00\x00\x11\x06\x7f\x08\x00\x00\x26\x05\x00\x00\x26\x05\x00\x00\x01\x03\x00\x00\xeb\x08\xd8\x03\x00\x00\xf1\xff\xd6\x08\x83\x08\x00\x00\x00\x00\x00\x00\x00\x00\x27\x58\x00\x00\x9e\x08\x18\x1e\x9e\x1e\xc9\x51\x00\x00\x00\x00\x0f\x76\x00\x00\x00\x00\x47\x5a\x00\x00\x00\x00\x00\x00\x00\x00\xcf\x5a\x00\x00\x00\x00\x00\x00\xef\x08\xce\x6f\x00\x00\x00\x00\x28\x00\x26\x05\x00\x00\xfa\x05\x46\x78\x00\x00\xda\x08\x85\x06\x06\x61\x26\x05\x00\x00\x26\x05\x26\x05\x00\x00\x26\x05\x00\x00\x00\x00\x00\x00\x80\x08\xaa\x08\x00\x00\x26\x05\x00\x00\x85\x06\x00\x00\xdf\x08\xf2\x08\x00\x00\x00\x00\x00\x00\x8e\x08\x2e\x6f\x96\x08\x8f\x08\x9b\x08\x00\x00\x26\x05\x92\x05\x00\x00\x2e\x6f\x00\x00\x02\x09\x00\x00\x95\x08\x26\x05\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x08\x00\x00\x00\x00\x99\x6f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\xc8\x04\x00\x09\xe5\x08\xb5\x61\x9e\x01\xa0\x65\x85\x64\x0e\x07\xff\x61\x01\x00\xa2\x20\x6e\x02\x87\x04\x9f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8e\x03\x00\x00\x00\x00\x31\x00\x00\x00\x00\x00\xe6\x07\xe9\x07\xc5\x02\x00\x00\x57\x06\x60\x06\xb0\x0f\x72\x24\x00\x00\x00\x00\x00\x00\x00\x00\x86\x08\x00\x00\x8a\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\x01\xab\x02\x00\x00\x00\x00\xf9\xff\xe9\x20\x1e\x10\xd2\x0f\xf3\x01\xeb\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x62\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x03\xe1\x07\x2b\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x0f\x00\x00\x3b\x6b\xbe\x79\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x66\x8d\x63\x28\x06\x5b\x05\xcf\x79\x2c\x08\x04\x7a\x00\x00\x7b\x77\x1c\x21\x44\x7a\x79\x7a\x8a\x7a\xb2\x09\x2f\x08\x31\x09\xbf\x7a\x65\x0b\x39\x08\x3a\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x66\xc1\x77\xfc\x20\x4e\x08\x97\x66\x00\x7c\x76\x08\xf4\x08\x00\x00\x00\x00\xad\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3e\x06\x8a\x02\xef\x05\xd3\x03\x36\x06\x4b\x06\x8b\x04\x12\x0a\x81\x03\xb0\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x97\xff\x13\x05\x00\x00\xb9\xff\x8a\x06\xb4\x08\x00\x00\x1e\x01\xab\x08\x9f\xff\xad\x06\x47\x05\x94\x05\x1f\x09\x50\x06\x00\x00\x00\x00\x00\x00\x09\x09\x00\x00\xfb\x07\x00\x00\x38\x01\x00\x00\xfc\x07\x5a\x02\x00\x00\x02\x03\xb9\x08\x00\x00\x00\x00\xff\x07\xbd\x08\x0f\x09\x00\x00\xed\x77\x27\x02\xff\x7a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x7b\x97\x00\xc6\x03\xbb\x08\x00\x00\x00\x00\x00\x00\xab\x0d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfe\x03\x00\x00\xb5\xff\x00\x00\x2f\xff\x76\x04\x00\x00\xb8\x08\xbc\x08\x00\x00\x00\x00\xaf\x08\x00\x00\x00\x00\x6e\x03\x30\x0c\xea\x03\xff\x08\xc4\x08\xcb\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x99\x11\x00\x00\x00\x00\xa2\x0c\xa1\x08\x00\x00\x00\x00\x72\x05\x00\x00\xb3\x6d\x00\x00\x00\x00\x48\x13\x2b\x04\xf0\x08\x58\x07\x00\x00\x0a\x65\x92\x10\x00\x00\x00\x00\x00\x00\x70\x02\xd9\x0d\x00\x00\xc4\xff\x00\x00\x00\x00\x33\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x0a\x08\x0b\x00\x00\x00\x00\x00\x00\x70\x06\x00\x00\x00\x00\x1c\x21\x0e\x03\x00\x00\x00\x00\xe6\x04\x00\x00\xbf\x08\xc8\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x3c\x00\x00\xd3\x08\x00\x00\xd9\x08\xd4\x08\x4d\x12\x00\x00\xd9\x00\x00\x00\x00\x00\x00\x00\x23\x03\x9a\x03\x17\x00\x5b\x13\xd2\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x00\x32\x05\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\x15\x00\x00\x00\xad\x0f\x00\x00\x00\x00\x4a\x62\x95\x62\x00\x00\x00\x00\x00\x00\x7d\x08\x00\x00\xc4\xff\x00\x00\x00\x00\x00\x00\x24\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x7b\x00\x00\x5f\x78\x00\x00\x00\x00\x18\x08\x1b\x08\x76\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x08\x70\xff\x00\x00\x00\x00\x08\x63\xf9\x05\x00\x00\x7a\x7b\xa8\x66\x37\x03\x03\x01\x00\x00\x80\x09\x00\x00\x92\x24\x4c\x6b\xbf\x6b\xd0\x6b\x43\x6c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x1e\xf0\x0f\xb1\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x01\x61\xff\xd9\x24\xed\x09\x00\x00\x8f\x20\x00\x00\x5f\x0a\x00\x00\x30\x25\x77\x25\x68\x0a\x8a\x25\x43\x21\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x30\x08\x00\x00\xed\x02\xea\x08\xed\x08\x00\x00\x52\x09\x53\x09\x00\x00\x00\x00\x45\x09\x00\x00\x00\x00\x00\x00\x00\x00\x72\x09\x00\x00\x6c\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x00\x00\xe4\x25\xda\x0a\x40\x02\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa1\x1f\xe1\x1f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x08\x87\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x67\x2c\x67\x00\x00\x00\x00\x00\x00\x00\x00\x74\x22\xf1\x5e\x00\x00\xd9\x5d\xad\x5d\x9f\x67\x00\x00\x7a\x0b\x00\x00\x53\x0d\x21\x61\xec\x0b\x00\x00\x37\xff\x00\x00\x00\x00\x00\x00\x96\x0a\x00\x00\x00\x00\x57\x79\x40\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x02\x4d\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe9\xff\x00\x00\x00\x00\x00\x00\x59\x08\x00\x00\x00\x00\x97\xff\x00\x00\x00\x00\x00\x00\x5c\x08\x00\x00\x00\x00\x00\x00\x00\x00\xab\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x78\xaa\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x78\x00\x00\x00\x00\x00\x00\x00\x00\x4e\x07\x94\x06\x00\x00\x00\x00\xe9\x04\x99\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\x05\x00\x00\xad\x0f\x00\x00\x00\x00\x6c\x03\x00\x00\xe5\x02\x00\x00\x00\x00\xb3\x6d\xa8\x10\xbe\x10\xba\x7b\x2b\x26\x4b\x0e\x5c\x0e\xce\x0e\xe2\x0e\x42\x0d\x39\x11\x00\x00\x00\x00\x00\x00\xd2\xff\xaf\x07\x00\x00\x00\x00\x00\x00\xc4\x6d\x00\x00\x00\x00\xf2\xff\x00\x00\xb0\x67\x7b\x63\xdf\x26\x0a\x09\x71\x05\x25\x09\x98\x1e\x00\x00\x00\x00\x00\x00\x0b\x09\x0c\x09\x00\x00\x16\x09\x00\x00\x94\x12\x00\x00\x00\x00\x00\x00\x00\x00\x16\x06\x2d\x06\x47\x09\x00\x00\x00\x00\xfd\x01\x9d\x21\x3a\x12\x2a\x04\xeb\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\x2e\xff\x00\x00\x6c\x08\xa2\x13\x00\x00\xc0\xff\xcc\xff\x1c\x65\x8f\x65\x27\x09\x00\x00\x2d\x09\x00\x00\x30\x09\x00\x00\x6b\x06\x24\x09\x00\x00\x00\x00\x00\x00\x78\x06\x43\x10\x00\x00\xef\x7b\x98\x08\x00\x00\x00\x00\x6b\x01\x00\x00\x7f\x09\x00\x00\x00\x00\x91\x09\x00\x00\x92\x09\x00\x00\x00\x00\x26\x00\x00\x00\x89\x09\x00\x00\x50\x01\x00\x00\x85\x01\x00\x00\x86\x09\x00\x00\xb8\x05\x3e\x26\x00\x00\x00\x00\x00\x00\x00\x00\x32\x09\x00\x00\x90\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x79\x00\x00\x4f\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf7\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x02\xff\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x21\x6e\x09\xf7\x21\xc0\x01\x00\x00\x5a\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x09\x00\x00\x00\x00\x00\x00\x00\x00\x79\x09\x3e\x22\x00\x00\x00\x00\x95\x22\x00\x00\x00\x00\x6a\x02\x00\x00\x59\x09\x00\x00\x00\x00\x4d\x09\x00\x00\x00\x00\xbe\x06\x00\x00\xd9\xff\x00\x00\x00\x00\x03\x03\x18\x09\xf1\x05\xdc\x22\x09\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4b\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x05\x00\x00\x00\x00\x00\x00\xae\xff\x00\x00\x5c\x02\xf5\x07\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x06\x00\x00\xf9\x06\x23\x68\x00\x00\x00\x00\xb5\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x03\x00\x00\x00\x00\xa3\x09\x00\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x68\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x04\x00\x00\x97\x08\x00\x00\x00\x00\x5e\x5e\x00\x00\x00\x00\x67\x05\x00\x00\x9c\x08\x00\x00\x00\x00\x12\x23\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x68\x97\x64\xb8\x68\x00\x00\x00\x00\x32\x01\x5e\x0c\xaf\x00\x00\x00\x00\x00\x01\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x33\x23\x00\x00\x7a\x23\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\xc1\x09\x00\x00\x00\x00\x00\x00\xb6\x09\xbc\x09\x00\x00\x45\x07\x51\x07\x00\x00\x00\x00\x00\x00\x85\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x09\x00\x00\x00\x00\x3c\x5f\x00\x00\x00\x00\x62\x09\xfc\x08\x2b\x69\x00\x00\x00\x00\x8a\x5e\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x61\x12\x64\xc5\x0d\x00\x00\x00\x00\x00\x00\x5d\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x0b\x38\x03\x00\x00\x00\x00\x1b\x09\x00\x00\xd1\xff\x19\x06\x00\x00\x00\x00\xf2\x26\x2b\x09\x44\x06\x00\x00\x00\x00\x3c\x69\x00\x00\x16\x04\x90\x04\x00\x00\x3d\x09\xb3\x06\x00\x00\x00\x00\x00\x00\xee\x12\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x09\x00\x00\x00\x00\x00\x00\x9f\x09\xbb\xff\x00\x00\x39\x27\x00\x00\x00\x00\xfc\x13\x00\x00\x00\x00\xdd\xff\x00\x00\x00\x00\x00\x00\xad\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x09\x00\x00\xdd\x09\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x00\x00\xde\x09\xcc\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x02\xb4\x02\xd3\x09\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x01\x4a\x06\xc0\x08\x5a\x04\x0f\x03\x29\x05\x3d\x00\x00\x00\x00\x00\xc6\x08\x00\x00\x00\x00\xaf\x69\x0b\x06\x82\x06\x00\x00\x00\x00\x0f\x14\x56\x14\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x09\x00\x00\xce\xff\xa3\x02\x00\x00\x00\x00\x00\x00\x6a\x02\x00\x00\x00\x00\xc5\x08\x00\x00\xa4\x09\x43\x79\x14\x04\x00\x00\x00\x00\x00\x00\x47\x06\x00\x00\xbe\x0b\xa4\x01\x0a\x02\x00\x00\x52\xff\xb1\x09\x00\x00\x00\x00\x00\x00\x00\x00\x87\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x0f\xbf\x06\x00\x00\xd8\xff\x98\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc0\x69\x33\x6a\x44\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x0c\xf1\x03\x00\x00\x00\x00\x00\x00\x00\x00\xcd\x08\x00\x00\xdc\x09\xd1\x08\x0e\x00\x00\x00\x00\x00\x07\x03\x22\x03\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x09\x04\x0a\x00\x00\x14\x00\x8f\x09\xd7\x08\x00\x00\x00\x00\x00\x00\xb7\x6a\x00\x00\x00\x00\x00\x00\x01\x13\x00\x00\x00\x00\x00\x00\xd5\x08\x00\x00\x9a\x23\x9d\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x08\x00\x00\xc1\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x05\x00\x00\xb9\x09\x70\x04\x4c\x27\xad\x0f\x93\x27\x00\x00\x00\x00\x00\x00\xbd\x09\x00\x00\xde\x08\x00\x00\x00\x00\x00\x00\xc5\x09\x00\x00\x00\x00\x31\x01\xa1\x02\xbd\xff\xda\x23\x00\x00\x00\x00\xe2\x08\x00\x00\x00\x00\xf1\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\xe8\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\x09\x00\x00\x00\x00\x00\x00\x09\x03\x00\x00\xf1\x08\x00\x00\xf3\x08\x00\x00\x00\x00\x00\x00\x15\x05\x6f\x05\x00\x00\x00\x00\xd0\x09\xd9\x09\x69\x14\xda\x09\x00\x00\x00\x00\x32\x24\xe2\x1e\x00\x00\xa6\x27\x00\x00\x00\x00\x31\x02\x00\x00\x00\x00\xf3\x11\x00\x00\x00\x00\x2b\x06\x00\x00\x00\x00\x48\x20\x00\x00\x00\x00\x00\x00\xc8\x6a\x00\x00\xb7\x09\x1b\x0a\x00\x00\xff\xff\x00\x00\xf5\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1c\x0a\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x14\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x08\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\xca\x07\x00\x00\x00\x00\x00\x00\x00\x00\x56\x06\x00\x00\x00\x00\x00\x00\x08\x0a\x2e\x00\x00\x00\x00\x00\x47\x07\x03\x09\x00\x00\xe7\xff\xbc\xff\x00\x00\x00\x00\x27\x0a\x08\x00\x04\x09\x00\x00\x02\x00\x05\x09\x00\x00\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x09\x00\x00\x28\x0a\x00\x00\x94\x09\x65\x06\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x26\x0a\x00\x00\x00\x00\x00\x00\x12\x09\x6f\x04\x00\x00\x44\x00\x00\x00\x7e\x06\x00\x00\x00\x00\x13\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# +happyAdjustOffset off = off + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\xc1\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x60\xfd\x00\x00\x00\x00\xc0\xff\xc1\xff\x00\x00\xf2\xff\xed\xfc\xe9\xfc\xe6\xfc\xd7\xfc\xd5\xfc\xd6\xfc\xd4\xfc\xd3\xfc\xd2\xfc\xe4\xfc\xe3\xfc\xe5\xfc\xe2\xfc\xe1\xfc\xd1\xfc\xd0\xfc\xcf\xfc\xce\xfc\xcd\xfc\xcc\xfc\xcb\xfc\xca\xfc\xc9\xfc\xc4\xfc\xc5\xfc\xc8\xfc\xc6\xfc\xc7\xfc\x00\x00\xe7\xfc\xe8\xfc\x90\xff\x00\x00\xb5\xff\x00\x00\x00\x00\x90\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x81\xfe\x00\x00\x7c\xfe\x79\xfe\x73\xfe\x72\xfe\x6e\xfe\x6f\xfe\x50\xfe\x4f\xfe\x00\x00\x65\xfe\x20\xfd\x69\xfe\x1b\xfd\x12\xfd\x15\xfd\x0e\xfd\x64\xfe\x68\xfe\xf6\xfc\xf3\xfc\x63\xfe\x3e\xfe\xf1\xfc\xf0\xfc\xf2\xfc\x00\x00\x00\x00\x0b\xfd\x0a\xfd\x00\x00\x00\x00\x62\xfe\x09\xfd\x1c\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xfc\x11\xfd\x0c\xfd\x0d\xfd\x49\xfe\x13\xfd\x0f\xfd\x10\xfd\x4a\xfd\x4c\xfe\x4b\xfe\x4a\xfe\x4d\xfe\x00\x00\xee\xfd\xed\xfd\x00\x00\xf1\xff\x3b\xfd\x2b\xfd\x3a\xfd\x2d\xfd\xef\xff\xf0\xff\xfa\xfc\xdf\xfc\xe0\xfc\xdb\xfc\xd8\xfc\x39\xfd\xc1\xfc\x26\xfd\xbe\xfc\xbb\xfc\xee\xff\xda\xfc\xc2\xfc\xc3\xfc\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xfc\xd9\xfc\xbc\xfc\xc0\xfc\xdc\xfc\xbd\xfc\xa9\xfd\x5b\xfd\x92\xfc\xe4\xfd\x00\x00\xdf\xfd\xd7\xfd\xc8\xfd\xc5\xfd\xb5\xfd\xb4\xfd\x00\x00\x00\x00\x61\xfd\x5e\xfd\xc2\xfd\xc1\xfd\xc3\xfd\xc4\xfd\xc0\xfd\xec\xfd\x91\xfc\xb6\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\xfd\xba\xfc\xb9\xfc\xb8\xfc\xbf\xfd\xbe\xfd\xad\xfc\xac\xfc\xb7\xfc\xb6\xfc\xb5\xfc\xb4\xfc\xb3\xfc\xb2\xfc\xb1\xfc\xb0\xfc\xaf\xfc\xae\xfc\xab\xfc\xaa\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xfd\x71\xff\xfe\xfd\x00\x00\x00\x00\x00\x00\xe9\xfc\x6f\xff\x6e\xff\x6d\xff\x00\x00\x00\x00\xf2\xfd\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x47\xfd\x00\x00\x00\x00\x86\xfc\x00\x00\x6f\xfd\x00\x00\x00\x00\x63\xff\x5d\xff\x62\xff\x61\xff\x60\xff\x03\xff\x00\x00\x5f\xff\x5e\xff\x09\xfe\x58\xff\x57\xff\x0c\xfe\x56\xff\x00\x00\x1a\xff\x39\xff\x3a\xff\xb6\xfe\x19\xff\x00\x00\x00\x00\x00\x00\xc8\xfe\xac\xfe\xb4\xfe\x00\x00\x00\x00\x00\x00\x5f\xfd\x00\x00\x8a\xff\x00\x00\x00\x00\x00\x00\x90\xff\xc2\xff\x00\x00\x90\xff\x00\x00\x8d\xff\xb6\xfe\xa7\xfc\xa6\xfc\x00\x00\xb6\xfe\x85\xff\x00\x00\x00\x00\x00\x00\x00\x00\x3c\xfd\x35\xfd\x3d\xfd\xef\xfc\x37\xfd\x00\x00\x00\x00\x00\x00\xac\xfe\x00\x00\xb1\xfe\x00\x00\x00\x00\x00\x00\xa9\xfe\xad\xfe\xae\xfe\x00\x00\xc9\xfe\xc6\xfe\x00\x00\x34\xfd\x00\x00\x00\x00\x00\x00\x5c\xff\x00\x00\x00\x00\x00\x00\x00\x00\x79\xfe\x20\xfd\x18\xff\x00\x00\x00\x00\x00\x00\x43\xff\x00\x00\xb4\xfe\x3b\xff\x00\x00\x3c\xff\x3e\xff\x3d\xff\x00\x00\x00\x00\x38\xff\x00\x00\x36\xfe\x00\x00\x0a\xff\x00\x00\x00\xfd\x00\x00\xff\xfc\x01\xfd\x00\x00\x00\x00\x03\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9a\xfd\x8a\xfc\xea\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xfc\x00\x00\xfc\xfc\xfe\xfc\xf8\xfc\xdd\xfc\x00\x00\xde\xfc\x26\xfd\x00\x00\x00\x00\xeb\xfd\x00\x00\x89\xfc\x00\x00\xa0\xfc\x00\x00\xda\xfc\x00\x00\x2a\xfd\xa4\xfc\x00\x00\x32\xfd\x8e\xfe\x00\x00\x00\x00\x48\xfd\x46\xfd\x44\xfd\x43\xfd\x40\xfd\x00\x00\x00\x00\xbd\xfe\xf1\xfd\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\x34\xfd\xd0\xfe\x00\x00\xd3\xfe\xd3\xfe\x00\x00\x00\x00\xac\xfe\x70\xff\xb0\xfd\x24\xfd\xb1\xfd\x00\x00\x00\x00\x00\x00\xa2\xfd\xc4\xfd\x00\x00\x00\x00\x68\xff\x68\xff\x00\x00\x00\x00\x00\x00\xca\xfd\x62\xfd\x62\xfd\xcb\xfd\xb2\xfd\xb3\xfd\xa0\xfd\x9a\xfd\x00\x00\x00\x00\xdd\xfc\xde\xfc\x00\x00\x2f\xfd\x00\x00\x8f\xfd\x00\x00\x8e\xfd\x29\xfd\xd3\xfd\xd4\xfd\xd5\xfd\xe0\xfd\x68\xfd\x69\xfd\x00\x00\x6c\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd8\xfd\x5d\xfd\x00\x00\x90\xfc\x5a\xfd\xdd\xfd\x00\x00\xcd\xfd\x74\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\xfd\xda\xfd\x00\x00\x7d\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa3\xfd\x56\xfe\x55\xfe\x67\xfe\x66\xfe\x51\xfe\x03\xfd\x44\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x43\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x5c\xfe\x00\x00\x15\xfd\x00\x00\x00\x00\x5e\xfe\x00\x00\x53\xfe\x00\x00\x00\x00\x1b\xfe\x19\xfe\x88\xfe\x00\x00\x60\xfe\x61\xfe\x84\xfe\x85\xfe\x00\x00\x3e\xfe\x3d\xfe\x3a\xfe\x38\xfe\x37\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x6d\xfe\x00\x00\x6b\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\xfe\x70\xfe\x00\x00\xe9\xff\x00\x00\x00\x00\xb2\xff\x8d\xff\xb6\xfe\xb6\xfe\xb1\xff\xac\xff\xac\xff\xb0\xff\xae\xff\xaf\xff\x91\xff\xed\xff\xa8\xfc\xa9\xfc\xea\xff\x00\x00\xd6\xff\xdd\xff\xda\xff\xdc\xff\xdb\xff\xde\xff\xec\xff\x2f\xfe\x80\xfe\x7e\xfe\x75\xfe\x76\xfe\x78\xfe\x00\x00\x6c\xfe\x71\xfe\x6a\xfe\x7d\xfe\x00\x00\x00\x00\x3f\xfe\x82\xfe\x83\xfe\x00\x00\x00\x00\x5f\xfe\x00\x00\x00\x00\x00\x00\x59\xfe\x00\x00\x1c\xfd\x1f\xfd\xa5\xfc\x1a\xfd\x58\xfe\x00\x00\xa1\xfc\x1d\xfd\x1e\xfd\x5a\xfe\x5b\xfe\x00\x00\x00\x00\xf5\xfc\x14\xfd\x00\x00\x00\x00\x0b\xfd\x0a\xfd\x62\xfe\x09\xfd\x57\xfe\x0c\xfd\x0d\xfd\x10\xfd\x43\xfe\x00\x00\x45\xfe\x30\xfd\x38\xfd\xeb\xfc\x2e\xfd\x25\xfd\xf9\xfc\x93\xfc\x94\xfc\x95\xfc\x96\xfc\x97\xfc\xd9\xfd\x00\x00\x59\xfd\x56\xfd\x53\xfd\x00\x00\xe9\xfc\x55\xfd\xc6\xfd\xea\xfc\x5c\xfd\xd6\xfd\x00\x00\x00\x00\x00\x00\x7b\xfd\x79\xfd\x75\xfd\x72\xfd\x00\x00\xde\xfd\x00\x00\x00\x00\xdc\xfd\xdb\xfd\x6b\xfd\xcf\xfd\x69\xfd\x00\x00\xd0\xfd\x00\x00\x00\x00\x00\x00\x6a\xfd\x00\x00\xb7\xfd\x8d\xfd\x00\x00\x00\x00\xec\xfc\x91\xfd\x96\xfd\xb8\xfd\x97\xfd\x90\xfd\x95\xfd\xb9\xfd\x00\x00\x00\x00\x63\xfd\x00\x00\xae\xfd\xab\xfd\xac\xfd\x9b\xfd\x9c\xfd\x00\x00\x00\x00\xaa\xfd\xad\xfd\x22\xfd\x00\x00\x23\xfd\x21\xfd\x00\x00\x01\xfe\x8a\xfe\x00\x00\x00\x00\x08\xfe\xd4\xfe\x90\xfe\x07\xfe\xa5\xfd\xa4\xfd\x00\x00\x4c\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xec\xfe\xed\xfe\xfb\xfd\x48\xfe\x00\x00\x00\x00\xbb\xfe\x00\x00\xc4\xfe\xc3\xfe\x00\x00\x00\x00\xfa\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\xfd\x2c\xfd\x88\xfc\xbb\xfd\xa2\xfc\xec\xfc\x98\xfd\xbc\xfd\xbd\xfd\x00\x00\xba\xfd\xea\xfd\x7e\xfc\x00\x00\x99\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\xfd\x85\xfc\x00\x00\x15\xff\x00\x00\x8a\xfe\xe3\xfd\xe2\xfd\x00\x00\xe1\xfd\x0b\xfe\xcc\xfe\x03\xfe\x00\x00\x00\x00\x00\x00\xe1\xfe\x31\xfe\x13\xff\x44\xfe\x3f\xff\x8c\xfe\x8a\xfe\xb6\xfe\x00\x00\x00\x00\xa2\xfe\xa6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\x00\x00\x11\xff\x4a\xff\x00\x00\x3e\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x9b\xfe\x9a\xfe\x99\xfe\x98\xfe\x97\xfe\x00\x00\x00\x00\x28\xfd\x00\x00\x00\x00\xf7\xfe\xf4\xfe\x00\x00\x00\x00\x00\x00\xbd\xfe\xc5\xfe\x00\x00\x59\xff\xca\xfe\x5b\xff\xac\xfe\x00\x00\x3f\xfd\xb5\xfe\x5a\xff\xb4\xfe\x00\x00\x08\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x90\xfe\x8b\xff\x88\xff\x87\xff\x86\xff\xac\xff\xbc\xff\xac\xff\xbb\xff\xb8\xff\x65\xff\xbd\xff\x8f\xff\xb9\xff\xba\xff\x00\x00\xb6\xfe\x00\x00\x81\xff\x89\xff\x00\x00\x00\x00\xa1\xfe\x9f\xfe\x00\x00\x00\x00\x00\x00\xb3\xfe\x00\x00\xa7\xfe\xab\xfe\xcb\xfe\x00\x00\x00\x00\x00\x00\x70\xfd\xf9\xfe\xfa\xfe\x00\x00\xf2\xfe\xf3\xfe\xee\xfe\x00\x00\xf6\xfe\x00\x00\x9d\xfe\x00\x00\x95\xfe\x94\xfe\x96\xfe\x00\x00\x00\x00\x9c\xfe\x4d\xff\x4e\xff\x53\xff\x00\x00\x00\x00\x37\xff\x00\x00\x00\x00\x01\xff\xff\xfe\xfe\xfe\xfb\xfe\xfc\xfe\x44\xff\x45\xff\x47\xff\x46\xff\xd7\xfe\x00\x00\xa3\xfe\xb8\xfe\x00\x00\x43\xff\x00\x00\x00\x00\x4f\xff\x00\x00\x35\xfe\x33\xfe\x00\x00\x55\xff\x00\x00\x0b\xff\x00\x00\xcc\xfe\x05\xfe\x04\xfe\x00\x00\x87\xfc\x15\xff\x00\x00\x06\xff\x3e\xfe\x2c\xfe\x16\xfe\x00\x00\x21\xfe\x04\xff\x00\x00\xe6\xfd\x84\xfc\x83\xfc\x8b\xfc\x8c\xfc\x8d\xfc\x8e\xfc\x8f\xfc\x74\xfe\xe7\xfd\xe9\xfd\x00\x00\xa7\xfd\x94\xfd\xa3\xfc\xfb\xfc\xf7\xfc\x31\xfd\x8d\xfe\xfd\xfd\x45\xfd\x42\xfd\x36\xfd\x41\xfd\xf9\xfd\xf3\xfd\xf0\xfd\x00\x00\x00\x00\xbb\xfe\xba\xfe\x00\x00\xf3\xfd\xf6\xfd\xfc\xfd\x33\xfd\xcf\xfe\x4d\xfd\xd2\xfe\xd5\xfe\x00\x00\xce\xfe\xd1\xfe\x00\x00\xff\xfd\x05\xfd\x6b\xff\x06\xfd\x04\xfd\x00\x00\x9e\xfd\x9d\xfd\x6a\xff\x67\xfd\x64\xfd\x66\xfd\x9f\xfd\xa1\xfd\xa8\xfd\x93\xfd\x92\xfd\x9a\xfd\x87\xfd\x89\xfd\x86\xfd\x84\xfd\x81\xfd\x80\xfd\x00\x00\x8b\xfd\x88\xfd\xd1\xfd\x6e\xfd\x00\x00\x98\xfc\x00\x00\x80\xfc\x77\xfc\x00\x00\x00\x00\x99\xfc\x00\x00\x9c\xfc\x00\x00\x82\xfc\x7a\xfc\x69\xfd\x00\x00\x9d\xfc\xc9\xfd\xd2\xfd\x00\x00\x00\x00\x00\x00\x73\xfd\xcc\xfd\x00\x00\x00\x00\x00\x00\xc7\xfd\x52\xfe\x00\x00\x02\xfd\x42\xfe\x41\xfe\x40\xfe\x00\x00\x00\x00\x89\xfe\x00\x00\x18\xfe\x1a\xfe\xee\xfc\x00\x00\x3c\xfe\x00\x00\x77\xfe\x00\x00\xd9\xff\xd8\xff\xd7\xff\x00\x00\xeb\xff\x00\x00\x00\x00\x00\x00\x00\x00\xe8\xff\x00\x00\x00\x00\xd5\xff\x00\x00\x00\x00\x00\x00\x4e\xfe\x5d\xfe\x00\x00\x57\xfd\x54\xfd\x51\xfd\x4f\xfd\x71\xfd\x7a\xfd\xdd\xfd\x9f\xfc\x81\xfc\x7b\xfc\x9e\xfc\x76\xfc\xcc\xfe\x76\xfd\x00\x00\x9b\xfc\x7f\xfc\x78\xfc\x9a\xfc\x75\xfc\x7f\xfd\xcc\xfc\x00\x00\x00\x00\x8c\xfd\x65\xfd\x69\xff\x92\xff\x00\x00\x00\xfe\x4b\xfd\xd6\xfe\x4e\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xbc\xfe\xbe\xfe\xef\xfd\x00\x00\xe8\xfd\x05\xff\x27\xfe\x25\xfe\x00\x00\x3e\xfe\x14\xff\x51\xff\x15\xfe\x13\xfe\x00\x00\x16\xfe\x00\x00\x00\x00\x00\x00\x2c\xfe\x16\xfe\xcd\xfe\x06\xfe\x00\x00\xe2\xfe\xe5\xfe\xe5\xfe\x30\xfe\x31\xfe\x31\xfe\x12\xff\x54\xff\x8b\xfe\x00\x00\xb7\xfe\xa5\xfe\x00\x00\x4b\xff\x00\x00\xfd\xfe\x0f\xff\x10\xff\x32\xff\x00\x00\x27\xff\x00\x00\x00\x00\x00\x00\x00\x00\x9e\xfe\x27\xfd\x00\x00\xf5\xfe\xf8\xfe\x00\x00\x00\x00\xc2\xfe\xc0\xfe\x00\x00\x3e\xfd\xaf\xfe\xa0\xfe\x07\xfd\x8f\xfe\x0a\xfe\x83\xff\x82\xff\x00\x00\x00\x00\xab\xff\xa6\xff\xa5\xff\x00\x00\xa8\xff\x00\x00\x67\xff\x64\xff\x8e\xff\x93\xff\x66\xff\xc3\xff\x90\xff\x90\xff\xa0\xff\x98\xff\x94\xff\x19\xfd\x95\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\xfe\xad\xff\xc4\xff\x00\x00\x84\xff\xc1\xfe\x00\x00\xd3\xfe\xd3\xfe\xf1\xfe\x91\xfe\x00\x00\x00\x00\x00\x00\x36\xff\x00\x00\x52\xff\x00\x00\xd8\xfe\xdb\xfe\xdb\xfe\xa4\xfe\x02\xff\x34\xfe\x32\xfe\xeb\xfe\xe6\xfe\x00\x00\xea\xfe\x21\xff\x00\x00\x00\x00\x00\x00\x02\xfe\x49\xff\x16\xfe\x07\xff\x00\x00\x29\xfe\x29\xfe\x50\xff\x00\x00\x12\xfe\x0f\xfe\x40\xff\x42\xff\x41\xff\x00\x00\x14\xfe\x00\x00\x00\x00\x7b\xfe\x20\xfe\x23\xfe\x00\x00\x21\xfe\xf7\xfd\xbb\xfe\x00\x00\x87\xfe\xf4\xfd\xf8\xfd\x6c\xff\x8a\xfd\x83\xfd\x82\xfd\x85\xfd\x00\x00\x00\x00\x00\x00\x79\xfc\x77\xfd\x78\xfd\x7c\xfc\x00\x00\x00\x00\x00\x00\x54\xfe\x17\xfe\x3b\xfe\x39\xfe\x00\x00\xc9\xff\x8a\xff\x00\x00\x00\x00\x00\x00\xb6\xff\x90\xff\x90\xff\xb7\xff\xb3\xff\xb4\xff\xcd\xff\xca\xff\xd4\xff\xe7\xff\xc6\xfc\xb6\xfe\x00\x00\xcc\xff\x50\xfd\x52\xfd\x00\x00\x7e\xfd\x7d\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x26\xfe\x43\xfe\x00\x00\x00\x00\x00\x00\x22\xfe\x47\xfe\x00\x00\x0e\xfe\x10\xfe\x11\xfe\x00\x00\x2a\xfe\x00\x00\x00\x00\x00\x00\x08\xff\x48\xff\xe4\xfe\xe7\xfe\x23\xff\x0e\xff\x00\x00\x00\x00\x00\x00\x00\x00\x20\xff\xe3\xfe\xe0\xfe\x1f\xff\xdc\xfe\x00\x00\xdf\xfe\x17\xff\x16\xff\x1f\xff\x00\x00\x31\xff\x29\xff\x29\xff\x00\x00\x00\x00\x92\xfe\x93\xfe\x00\x00\x00\x00\xc7\xfe\x85\xff\xa7\xff\x00\x00\x00\x00\x00\x00\xa2\xff\x97\xff\xa3\xff\xa1\xff\x96\xff\xa4\xff\x9e\xff\x00\x00\x00\x00\xbf\xff\xbe\xff\x00\x00\x9d\xff\x9b\xff\x9a\xff\x99\xff\x18\xfd\x17\xfd\x16\xfd\x81\xff\xf0\xfe\xef\xfe\x28\xff\x35\xff\x33\xff\x00\x00\x2a\xff\x00\x00\x00\x00\x00\x00\xda\xfe\xdd\xfe\x00\x00\x1e\xff\xd9\xfe\x03\xff\x13\xff\x00\x00\x0e\xff\x22\xff\x25\xff\x00\x00\x00\x00\xe8\xfe\x00\x00\x2e\xfe\x00\x00\x29\xfe\x2d\xfe\x0d\xfe\x00\x00\x20\xfe\x24\xfe\xa2\xfc\x1f\xfe\x1e\xfe\xa0\xfc\xbf\xfe\xb9\xfe\x86\xfe\x00\x00\xce\xfd\xb6\xfe\xac\xff\xc5\xff\x00\x00\xc6\xff\x00\x00\xcb\xff\x00\x00\xd0\xff\xce\xff\x00\x00\xe3\xff\x00\x00\x00\x00\xac\xff\x7c\xfd\x1d\xfe\x46\xfe\x2b\xfe\x00\x00\x09\xff\x00\x00\x64\xfe\x63\xfe\x00\x00\x0d\xff\x24\xff\x00\x00\xe9\xfe\x26\xff\x00\x00\x1d\xff\xde\xfe\x2e\xff\x30\xff\x2b\xff\x2d\xff\x2f\xff\x34\xff\x7f\xff\x00\x00\x9f\xff\x9c\xff\x7d\xff\x00\x00\x2c\xff\x15\xff\x00\x00\x28\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xe6\xff\xe4\xff\x00\x00\xd3\xff\xd1\xff\xd2\xff\xcf\xff\xe5\xff\x00\x00\x00\x00\xe2\xff\x00\x00\xc7\xff\x00\x00\x0c\xff\x2c\xfe\x16\xfe\x80\xff\x8c\xff\x7e\xff\x00\x00\x79\xff\xa0\xff\x00\x00\x7a\xff\x75\xff\x00\x00\x00\x00\x77\xff\x79\xff\x1c\xff\x16\xfe\xc8\xff\x00\x00\x00\x00\xe1\xff\xdf\xff\xe0\xff\x1b\xff\x00\x00\x72\xff\x73\xff\x78\xff\x7c\xff\x74\xff\x76\xff\x7b\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x00\x00\x0d\x00\x0e\x00\x05\x00\x06\x00\x4d\x00\x68\x00\x06\x00\x3b\x00\x4f\x00\x4f\x00\x04\x00\x50\x00\xad\x00\x07\x00\x08\x00\x09\x00\x04\x00\x0b\x00\xc2\x00\x0e\x00\x08\x00\x09\x00\x04\x00\x0b\x00\xe3\x00\x4a\x00\x08\x00\x09\x00\x69\x00\x0b\x00\x08\x00\x09\x00\x09\x00\x0b\x00\x0b\x00\x3c\x00\x58\x00\x90\x00\x5a\x00\x69\x00\x80\x00\x81\x00\x01\x00\x5b\x00\x80\x00\x81\x00\x00\x00\x09\x00\x05\x00\x00\x00\x5b\x00\x67\x00\x6a\x00\x12\x00\x3d\x00\x3e\x00\x6c\x00\xaa\x00\xab\x00\xac\x00\xad\x00\x4e\x00\x72\x00\x73\x00\x5b\x00\x00\x00\x17\x00\x16\x01\x4a\x00\x6a\x00\x4a\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x1d\x00\x00\x00\x35\x00\x12\x00\x3d\x00\x3e\x00\x2e\x00\x27\x00\x28\x00\x29\x00\x80\x00\x81\x00\x0c\x00\x00\x00\x2b\x00\x0c\x00\x30\x01\x22\x00\x23\x00\xf1\x00\x28\x00\x29\x00\x36\x01\x3f\x00\x40\x00\x00\x00\x4a\x00\x78\x00\x3b\x01\x79\x00\x28\x00\x29\x00\x6a\x00\x1d\x01\x1e\x01\x37\x00\x38\x00\x39\x00\x35\x00\x36\x00\x3f\x01\x4a\x00\x28\x00\x29\x00\x8f\x00\x37\x00\x38\x00\x39\x00\x52\x00\x83\x00\x54\x00\x83\x00\x28\x00\x29\x00\x8e\x00\x8f\x00\x8f\x00\x83\x00\xb6\x00\x39\x00\x29\x01\x66\x00\x2b\x01\x94\x00\x00\x00\xb6\x00\x72\x00\xc3\x00\xc4\x00\xc2\x00\x6c\x00\x52\x00\xc8\x00\x36\x01\x4a\x00\x69\x00\xcc\x00\x4a\x00\x69\x00\xb6\x00\xd0\x00\x72\x00\xd2\x00\x76\x00\x72\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xe3\x00\xda\x00\xdb\x00\xdc\x00\x94\x00\x69\x00\x3d\x01\x17\x01\x10\x01\x11\x01\x0b\x00\x13\x01\x14\x01\x15\x01\xbc\x00\xbd\x00\xbe\x00\x69\x00\xc7\x00\x29\x01\x24\x01\x2b\x01\x26\x01\x27\x01\x82\x00\x72\x00\x72\x00\x4b\x00\x72\x00\x69\x00\x3e\x00\x3f\x00\x36\x01\x31\x01\x52\x00\x33\x01\x34\x01\x35\x01\x72\x00\x37\x01\x30\x01\x69\x00\x3a\x01\x3b\x01\x05\x01\x06\x01\x36\x01\x1d\x01\x1e\x01\x39\x01\x72\x00\x30\x01\xe0\x00\x0e\x01\x0f\x01\x30\x01\x18\x00\x36\x01\x13\x01\x14\x01\x15\x01\x36\x01\x30\x01\x2b\x01\x2b\x01\x2b\x01\x4a\x00\x73\x00\x36\x01\x3e\x00\x3f\x00\x1d\x01\x1e\x01\x30\x01\x36\x01\x36\x01\x36\x01\x6d\x00\xe0\x00\x36\x01\x69\x00\x2c\x01\x4d\x00\x2c\x01\x2d\x01\x30\x01\x2f\x01\x30\x01\x16\x01\x72\x00\x94\x00\x36\x01\x3f\x01\x36\x01\x41\x01\x38\x01\x39\x01\x30\x01\x2c\x01\x3c\x01\x22\x01\x23\x01\x30\x01\x36\x01\x0e\x01\x0f\x01\x72\x00\x00\x00\x36\x01\x13\x01\x14\x01\x15\x01\x2c\x01\x17\x01\x52\x00\x00\x00\x30\x01\x66\x00\x34\x01\x35\x01\x73\x00\x37\x01\x36\x01\x2c\x01\x2c\x01\x3b\x01\x2c\x01\x30\x01\x30\x01\x27\x01\x30\x01\xbd\x00\xbe\x00\x36\x01\x36\x01\x2d\x01\x36\x01\x2f\x01\x30\x01\x31\x01\x3e\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3e\x01\x36\x01\x1b\x01\x3e\x01\x1d\x01\x1e\x01\x2c\x01\x36\x01\x3e\x01\x6d\x00\x30\x01\xa1\x00\x1b\x01\x36\x01\x1d\x01\x1e\x01\x36\x01\x36\x01\x36\x01\x18\x00\x2d\x01\x00\x00\x2f\x01\x30\x01\x1b\x01\x4a\x00\x1d\x01\x1e\x01\x12\x00\x36\x01\x2d\x01\x00\x00\x2f\x01\x30\x01\x1b\x01\x4c\x00\x1d\x01\x1e\x01\x2b\x00\x36\x01\x47\x00\x00\x00\x2d\x01\x4d\x00\x2f\x01\x30\x01\x1b\x01\x76\x00\x1d\x01\x1e\x01\x05\x00\x36\x01\x2d\x01\x13\x00\x2f\x01\x30\x01\x1b\x01\x4d\x00\x1d\x01\x1e\x01\x83\x00\x36\x01\xa1\x00\x35\x00\x2d\x01\x72\x00\x2f\x01\x30\x01\x17\x00\x67\x00\x69\x00\x53\x00\x54\x00\x36\x01\x2d\x01\x74\x00\x2f\x01\x30\x01\x3b\x00\x72\x00\x79\x00\x2f\x00\x30\x00\x36\x01\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x59\x00\x48\x00\x2c\x01\xac\x00\xad\x00\x73\x00\x30\x01\xaa\x00\xab\x00\xac\x00\xad\x00\x4d\x00\x36\x01\x4e\x00\x20\x00\x21\x00\x22\x00\x23\x00\x59\x00\x5a\x00\x52\x00\x4a\x00\x66\x00\x05\x00\x00\x01\x01\x01\x4d\x00\x62\x00\x63\x00\x96\x00\x1e\x01\x78\x00\x67\x00\x21\x01\x63\x00\x9c\x00\x69\x00\x6c\x00\x9f\x00\xa0\x00\xa1\x00\x17\x00\xa3\x00\xa4\x00\x85\x00\x72\x00\x69\x00\x6d\x00\x96\x00\x73\x00\x65\x00\x52\x00\x6c\x00\x73\x00\x9c\x00\x72\x00\x69\x00\x9f\x00\xa0\x00\xa1\x00\x59\x00\xa3\x00\xa4\x00\x77\x00\x73\x00\x72\x00\x3b\x00\x7b\x00\x8b\x00\x2d\x01\x2e\x01\x2f\x01\x30\x01\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x36\x01\x48\x00\x0e\x01\x0f\x01\x4c\x00\xcc\x00\x73\x00\x13\x01\x14\x01\x15\x01\x54\x00\x1f\x01\x20\x01\x78\x00\x4a\x00\x52\x00\x58\x00\x54\x00\x59\x00\x5a\x00\xdb\x00\x10\x00\x90\x00\x61\x00\xcc\x00\x61\x00\x85\x00\x62\x00\x63\x00\xff\x00\x00\x01\x01\x01\x67\x00\x2d\x01\x82\x00\x2f\x01\x30\x01\x6c\x00\x21\x00\xdb\x00\x52\x00\x52\x00\x36\x01\x3f\x01\x38\x01\x39\x01\xc3\x00\x72\x00\x78\x00\x79\x00\x29\x01\xc8\x00\x2b\x01\x77\x00\x72\x00\xcc\x00\x29\x01\x7b\x00\x2b\x01\xd0\x00\x6d\x00\xd2\x00\x52\x00\x36\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x8b\x00\x36\x01\xdb\x00\xdc\x00\x52\x00\x73\x00\x73\x00\x2d\x01\x2e\x01\x2f\x01\x30\x01\x02\x01\x0b\x00\x6c\x00\x19\x01\x1a\x01\x36\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x34\x00\x6f\x00\x77\x00\x67\x00\xa1\x00\x73\x00\x1b\x00\x4d\x00\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\x52\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x3e\x00\x3f\x00\x36\x01\x05\x01\x06\x01\x6b\x00\xb4\x00\xb5\x00\x29\x01\x2a\x01\x2b\x01\x57\x00\x0e\x01\x0f\x01\x2e\x01\xc3\x00\x30\x01\x13\x01\x14\x01\x15\x01\xc8\x00\x36\x01\x36\x01\x6f\x00\xcc\x00\xab\x00\xac\x00\xad\x00\xd0\x00\x01\x00\xd2\x00\x85\x00\x18\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd3\x00\x13\x00\xdb\x00\xdc\x00\x4d\x00\x2c\x01\x2d\x01\x6d\x00\x2f\x01\x30\x01\x6d\x00\x17\x01\x15\x00\x73\x00\x2b\x00\x36\x01\x73\x00\x38\x01\x39\x01\x6b\x00\x58\x00\x3c\x01\xa4\x00\x5b\x00\x24\x01\x3b\x00\x26\x01\x27\x01\x52\x00\x2f\x00\x30\x00\x31\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x31\x01\x48\x00\x33\x01\x34\x01\x35\x01\x4a\x00\x37\x01\x05\x01\x06\x01\x3a\x01\x3b\x01\xaa\x00\xab\x00\xac\x00\xad\x00\x78\x00\x0e\x01\x0f\x01\x59\x00\x5a\x00\x6f\x00\x13\x01\x14\x01\x15\x01\x73\x00\xcc\x00\xa1\x00\x62\x00\x63\x00\x29\x01\x67\x00\x2b\x01\x67\x00\x18\x00\xb4\x00\xb5\x00\x53\x00\x6c\x00\x0e\x01\x0f\x01\xdb\x00\x72\x00\x36\x01\x13\x01\x14\x01\x15\x01\x2c\x01\x2d\x01\x18\x00\x2f\x01\x30\x01\x58\x00\x2b\x00\x4c\x00\x53\x00\x5c\x00\x36\x01\x6d\x00\x38\x01\x39\x01\x61\x00\x54\x00\x3c\x01\x73\x00\x4c\x00\xd3\x00\x3b\x00\x2b\x00\x8b\x00\x2d\x01\x1d\x00\x2f\x01\x30\x01\xb4\x00\xb5\x00\x00\x00\x58\x00\x29\x01\x36\x01\x2b\x01\x38\x01\x39\x01\x07\x00\x78\x00\x2b\x00\x61\x00\x6d\x00\x7c\x00\x53\x00\x54\x00\x36\x01\x63\x00\x73\x00\x32\x00\x33\x00\x58\x00\x58\x00\x5a\x00\x79\x00\x18\x00\x5c\x00\x6d\x00\x19\x01\x1a\x01\xd3\x00\x61\x00\x1d\x01\x1e\x01\x78\x00\x79\x00\x67\x00\x1e\x00\x7c\x00\x7d\x00\x9e\x00\x6c\x00\x1d\x01\x1e\x01\x29\x01\xa1\x00\x2b\x01\x72\x00\x73\x00\x67\x00\xc3\x00\x2c\x00\x2d\x00\x19\x00\x78\x00\xc8\x00\x2b\x01\x36\x01\x63\x00\xcc\x00\x72\x00\x66\x00\x1d\x00\xd0\x00\x29\x01\xd2\x00\x2b\x01\x36\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x2c\x00\x2d\x00\xdb\x00\xdc\x00\x2b\x00\x36\x01\x4d\x00\x4e\x00\x0f\x01\x96\x00\x67\x00\x52\x00\x13\x01\x54\x00\x55\x00\x9c\x00\x56\x00\x1d\x00\x9f\x00\xa0\x00\xa1\x00\x72\x00\xa3\x00\xa4\x00\x6c\x00\x6a\x00\x85\x00\x6c\x00\x6b\x00\x6e\x00\x65\x00\x2b\x00\x67\x00\xa4\x00\x69\x00\x77\x00\x73\x00\x2c\x01\x77\x00\x7b\x00\x6c\x00\x30\x01\x7b\x00\x72\x00\x05\x01\x06\x01\x6d\x00\x36\x01\x3b\x00\x38\x01\x39\x01\x77\x00\x73\x00\x0e\x01\x0f\x01\x7b\x00\xc3\x00\xc4\x00\x13\x01\x14\x01\x15\x01\xc8\x00\x2c\x01\xcc\x00\x6d\x00\xcc\x00\x30\x01\x3e\x00\x3f\x00\xd0\x00\x73\x00\xd2\x00\x36\x01\xcc\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xdb\x00\xda\x00\xdb\x00\xdc\x00\x73\x00\x2c\x01\x2d\x01\x9e\x00\x2f\x01\x30\x01\xdb\x00\x17\x01\xa1\x00\x73\x00\x67\x00\x36\x01\x30\x01\x38\x01\x39\x01\x6c\x00\x44\x00\x3c\x01\x36\x01\x29\x01\x24\x01\x2b\x01\x26\x01\x27\x01\x2c\x01\x76\x00\x10\x01\x11\x01\x30\x01\x13\x01\x14\x01\x15\x01\x36\x01\x31\x01\x36\x01\x33\x01\x34\x01\x35\x01\xa1\x00\x37\x01\x05\x01\x06\x01\x3a\x01\x3b\x01\x6b\x00\xaa\x00\xab\x00\xac\x00\xad\x00\x0e\x01\x0f\x01\xa1\x00\x73\x00\x6f\x00\x13\x01\x14\x01\x15\x01\x73\x00\x19\x01\x1a\x01\x67\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x54\x00\x39\x01\x19\x01\x1a\x01\x67\x00\x72\x00\x1d\x01\x1e\x01\x29\x01\x2a\x01\x2b\x01\x67\x00\x10\x00\x2c\x01\x2d\x01\x72\x00\x2f\x01\x30\x01\x29\x01\x3b\x00\x2b\x01\x36\x01\x72\x00\x36\x01\x10\x00\x38\x01\x39\x01\x67\x00\x67\x00\x3c\x01\x83\x00\x36\x01\xaa\x00\xab\x00\xac\x00\xad\x00\xc3\x00\xc4\x00\x72\x00\x72\x00\x6a\x00\xc8\x00\x6c\x00\x3b\x00\x6e\x00\xcc\x00\x77\x00\x4e\x00\x72\x00\xd0\x00\x7b\x00\xd2\x00\x53\x00\x77\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x17\x01\xda\x00\xdb\x00\xdc\x00\x6d\x00\x67\x00\x3a\x01\x3b\x01\x96\x00\x72\x00\x6c\x00\x3f\x01\x67\x00\x24\x01\x9c\x00\x26\x01\x27\x01\x9f\x00\xa0\x00\xa1\x00\x76\x00\xa3\x00\xa4\x00\x72\x00\xa1\x00\x4c\x00\x31\x01\x4e\x00\x33\x01\x34\x01\x35\x01\xa1\x00\x37\x01\x0e\x01\x0f\x01\x3a\x01\x3b\x01\x58\x00\x13\x01\x14\x01\x15\x01\x5c\x00\x03\x01\x04\x01\x05\x01\x06\x01\x61\x00\x2c\x01\x29\x01\x72\x00\x2b\x01\x30\x01\x4a\x00\x0e\x01\x0f\x01\x4c\x00\x2b\x01\x36\x01\x13\x01\x14\x01\x15\x01\x36\x01\xcc\x00\x54\x00\x2e\x01\x74\x00\x30\x01\x36\x01\x67\x00\x78\x00\x79\x00\x6b\x00\x36\x01\x7c\x00\x7d\x00\x38\x01\x39\x01\xdb\x00\x6a\x00\x73\x00\x6c\x00\x4d\x00\x6e\x00\x2c\x01\x2d\x01\x3b\x00\x2f\x01\x30\x01\x6d\x00\x34\x01\x35\x01\x77\x00\x37\x01\x36\x01\x73\x00\x38\x01\x39\x01\xc3\x00\xc4\x00\x3c\x01\x79\x00\x29\x01\xc8\x00\x2b\x01\x7d\x00\x2e\x01\xcc\x00\x30\x01\x54\x00\x4e\x00\xd0\x00\x55\x00\xd2\x00\x36\x01\x36\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x83\x00\xda\x00\xdb\x00\xdc\x00\x33\x01\x34\x01\x35\x01\x7c\x00\x37\x01\x7e\x00\x67\x00\x3a\x01\x3b\x01\x30\x01\x0c\x00\x6c\x00\x3f\x01\x6e\x00\x6f\x00\x36\x01\x19\x01\x1a\x01\x39\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x0e\x01\x0f\x01\x4d\x00\x4e\x00\x12\x01\x13\x01\x14\x01\x15\x01\x29\x01\x2a\x01\x2b\x01\x2e\x01\x14\x00\x30\x01\x03\x01\x04\x01\x05\x01\x06\x01\x1a\x00\x36\x01\x1c\x00\x36\x01\x3e\x00\x3f\x00\x77\x00\x0e\x01\x0f\x01\x96\x00\x7b\x00\x10\x00\x13\x01\x14\x01\x15\x01\x9c\x00\x6c\x00\x4e\x00\x9f\x00\xa0\x00\xa1\x00\x52\x00\xa3\x00\xa4\x00\x38\x01\x39\x01\x10\x01\x11\x01\x52\x00\x13\x01\x14\x01\x15\x01\x33\x01\x34\x01\x35\x01\x54\x00\x37\x01\x2c\x01\x2d\x01\x4c\x00\x2f\x01\x30\x01\x3b\x00\x2d\x01\x6f\x00\x2f\x01\x30\x01\x36\x01\x73\x00\x38\x01\x39\x01\x58\x00\x36\x01\x3c\x01\x57\x00\x5c\x00\xc3\x00\xc4\x00\x13\x00\x14\x00\x61\x00\xc8\x00\x17\x00\xcc\x00\x30\x01\xcc\x00\x44\x00\x39\x01\x55\x00\xd0\x00\x36\x01\xd2\x00\x38\x01\x39\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xdb\x00\xda\x00\xdb\x00\xdc\x00\x72\x00\x78\x00\x79\x00\x83\x00\x67\x00\x7c\x00\x7d\x00\x34\x01\x35\x01\x6c\x00\x37\x01\x6e\x00\x6f\x00\x2d\x01\x3b\x01\x2f\x01\x30\x01\x1a\x01\x3f\x01\x96\x00\x1d\x01\x1e\x01\x36\x01\x57\x00\x66\x00\x9c\x00\x68\x00\x4c\x00\x9f\x00\xa0\x00\xa1\x00\x4d\x00\xa3\x00\xa4\x00\x6a\x00\x54\x00\x6c\x00\x4a\x00\x6e\x00\x58\x00\x05\x01\x06\x01\x6d\x00\x5c\x00\x2e\x01\x73\x00\x30\x01\x77\x00\x61\x00\x0e\x01\x0f\x01\x7b\x00\x36\x01\x6f\x00\x13\x01\x14\x01\x15\x01\x73\x00\x19\x01\x1a\x01\x6d\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x73\x00\x45\x00\x46\x00\x47\x00\x48\x00\x78\x00\x79\x00\xcc\x00\x29\x01\x2a\x01\x2b\x01\x4d\x00\x4e\x00\x2c\x01\x2d\x01\x1a\x01\x2f\x01\x30\x01\x1d\x01\x1e\x01\x4c\x00\x36\x01\xdb\x00\x36\x01\x4e\x00\x38\x01\x39\x01\x3b\x00\x52\x00\x3c\x01\xc3\x00\xc4\x00\x58\x00\x4d\x00\x4e\x00\xc8\x00\x5c\x00\x2f\x01\x30\x01\xcc\x00\x66\x00\x61\x00\x68\x00\xd0\x00\x36\x01\xd2\x00\x38\x01\x39\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x6d\x00\xda\x00\xdb\x00\xdc\x00\x58\x00\x66\x00\x5a\x00\x68\x00\x74\x00\x5f\x00\x16\x01\x1a\x01\x78\x00\x79\x00\x1d\x01\x1e\x01\x7c\x00\x7d\x00\x6d\x00\x67\x00\x0e\x01\x0f\x01\x22\x01\x23\x01\x6c\x00\x13\x01\x14\x01\x15\x01\x6d\x00\x66\x00\x72\x00\x68\x00\x19\x01\x1a\x01\x6d\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x34\x01\x35\x01\x4e\x00\x37\x01\x05\x01\x06\x01\x52\x00\x3b\x01\x29\x01\x2a\x01\x2b\x01\x77\x00\x77\x00\x0e\x01\x0f\x01\x7b\x00\x7b\x00\x6d\x00\x13\x01\x14\x01\x15\x01\x36\x01\x38\x01\x39\x01\x96\x00\xed\x00\xee\x00\xef\x00\x9a\x00\xf1\x00\x9c\x00\x6d\x00\x3b\x01\x9f\x00\xa0\x00\xa1\x00\x3f\x01\xa3\x00\xa4\x00\x2d\x01\x73\x00\x2f\x01\x30\x01\x2c\x01\x2d\x01\x52\x00\x2f\x01\x30\x01\x36\x01\x66\x00\x54\x00\x68\x00\x66\x00\x36\x01\x68\x00\x38\x01\x39\x01\x3b\x00\x4c\x00\x3c\x01\x86\x00\x87\x00\x88\x00\x4a\x00\x10\x01\x11\x01\x54\x00\x13\x01\x14\x01\x15\x01\x58\x00\xc3\x00\xc4\x00\x66\x00\x5c\x00\x68\x00\xc8\x00\x73\x00\xcc\x00\x61\x00\xcc\x00\x3e\x00\x3f\x00\x55\x00\xd0\x00\x66\x00\xd2\x00\x68\x00\x0c\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xdb\x00\xda\x00\xdb\x00\xdc\x00\x66\x00\x74\x00\x68\x00\x6b\x00\x67\x00\x78\x00\x79\x00\x9b\x00\x39\x01\x6c\x00\x6a\x00\x6e\x00\x6c\x00\xa4\x00\x6e\x00\x18\x01\x19\x01\x1a\x01\x6f\x00\x96\x00\x1d\x01\x1e\x01\x66\x00\x77\x00\x68\x00\x9c\x00\x99\x00\x7b\x00\x9f\x00\xa0\x00\xa1\x00\x99\x00\xa3\x00\xa4\x00\x99\x00\x2f\x01\x30\x01\x83\x00\x84\x00\x85\x00\x05\x01\x06\x01\x36\x01\x6d\x00\x38\x01\x39\x01\xaf\x00\xb0\x00\xb1\x00\x0e\x01\x0f\x01\x32\x00\x33\x00\xcc\x00\x13\x01\x14\x01\x15\x01\x6b\x00\x19\x01\x1a\x01\x73\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x4d\x00\x4e\x00\xdb\x00\xc5\x00\xc6\x00\xc7\x00\x54\x00\xcc\x00\x29\x01\x2a\x01\x2b\x01\x4d\x00\x4e\x00\x2c\x01\x2d\x01\x0c\x00\x2f\x01\x30\x01\x3b\x00\x4d\x00\x4e\x00\x36\x01\xdb\x00\x36\x01\x4a\x00\x38\x01\x39\x01\x3e\x00\x3f\x00\x3c\x01\xc3\x00\xc4\x00\xed\x00\xee\x00\xef\x00\xc8\x00\xf1\x00\x02\x00\x03\x00\xcc\x00\x33\x01\x34\x01\x35\x01\xd0\x00\x37\x01\xd2\x00\x02\x00\x03\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4a\x00\xda\x00\xdb\x00\xdc\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x3f\x01\x67\x00\x41\x01\x19\x01\x1a\x01\x54\x00\x6c\x00\x1d\x01\x1e\x01\x64\x00\x65\x00\x66\x00\xc5\x00\xc6\x00\xc7\x00\x66\x00\x76\x00\x68\x00\x66\x00\x29\x01\x68\x00\x2b\x01\x4c\x00\x19\x01\x1a\x01\x72\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x66\x00\x36\x01\x68\x00\x58\x00\x05\x01\x06\x01\x6d\x00\x5c\x00\x29\x01\x2a\x01\x2b\x01\x14\x00\x61\x00\x0e\x01\x0f\x01\x77\x00\x78\x00\xc9\x00\x13\x01\x14\x01\x15\x01\x36\x01\x52\x00\x0e\x01\x0f\x01\x74\x00\x54\x00\x12\x01\x13\x01\x14\x01\x15\x01\x74\x00\xbf\x00\xc0\x00\xc1\x00\x78\x00\x79\x00\x77\x00\x78\x00\x7c\x00\x7d\x00\xca\x00\xcb\x00\x2c\x01\x2d\x01\x3b\x00\x2f\x01\x30\x01\xb7\x00\xb8\x00\xb9\x00\x74\x00\x66\x00\x36\x01\x68\x00\x38\x01\x39\x01\x6d\x00\x66\x00\x3c\x01\x68\x00\x74\x00\xc3\x00\xc4\x00\x6f\x00\x38\x01\x39\x01\xc8\x00\x99\x00\x4b\x00\x4c\x00\xcc\x00\xbf\x00\xc0\x00\xc1\x00\xd0\x00\x66\x00\xd2\x00\x68\x00\x6d\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x6f\x00\xda\x00\xdb\x00\xdc\x00\xef\x00\x67\x00\xf1\x00\x66\x00\x96\x00\x68\x00\x6c\x00\x17\x01\x74\x00\x86\x00\x9c\x00\x88\x00\xa4\x00\x9f\x00\xa0\x00\xa1\x00\x76\x00\xa3\x00\xa4\x00\x83\x00\x24\x01\x85\x00\x26\x01\x27\x01\xca\x00\xcb\x00\x4c\x00\xbf\x00\xc0\x00\xc1\x00\xbf\x00\xc0\x00\xc1\x00\x31\x01\x54\x00\x33\x01\x34\x01\x35\x01\x58\x00\x37\x01\x05\x01\x06\x01\x3a\x01\x3b\x01\xa4\x00\xca\x00\xcb\x00\x61\x00\x67\x00\x0e\x01\x0f\x01\x73\x00\xcc\x00\x54\x00\x13\x01\x14\x01\x15\x01\x72\x00\xcc\x00\x6d\x00\xbf\x00\xc0\x00\xc1\x00\x7a\x00\x7b\x00\x73\x00\x0b\x00\xdb\x00\x40\x01\x41\x01\x78\x00\x79\x00\x6c\x00\xdb\x00\x7c\x00\x7d\x00\x3b\x00\x77\x00\x78\x00\x2c\x01\x2d\x01\x34\x00\x2f\x01\x30\x01\xcc\x00\xbf\x00\xc0\x00\xc1\x00\x18\x00\x36\x01\x4d\x00\x38\x01\x39\x01\xc3\x00\xc4\x00\x3c\x01\x6d\x00\x3b\x00\xc8\x00\xdb\x00\x1f\x01\x20\x01\xcc\x00\x73\x00\x04\x01\x05\x01\xd0\x00\x74\x00\xd2\x00\x10\x00\x11\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x6d\x00\xda\x00\xdb\x00\xdc\x00\x6d\x00\x67\x00\x10\x00\x11\x00\xb0\x00\xb1\x00\x6c\x00\x73\x00\x1d\x01\x1e\x01\x19\x01\x1a\x01\x40\x01\x41\x01\x1d\x01\x1e\x01\x19\x01\x1a\x01\x6d\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xb8\x00\xb9\x00\x29\x01\x6c\x00\x2b\x01\x35\x00\x36\x00\x6d\x00\x29\x01\x2a\x01\x2b\x01\x6d\x00\x6d\x00\x6d\x00\x6b\x00\x36\x01\x05\x01\x06\x01\x19\x01\x1a\x01\x67\x00\x36\x01\x1d\x01\x1e\x01\x73\x00\x0e\x01\x0f\x01\x4e\x00\x63\x00\x63\x00\x13\x01\x14\x01\x15\x01\x73\x00\x29\x01\x54\x00\x2b\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\x73\x00\x0d\x01\x16\x00\x67\x00\x10\x01\x52\x00\x36\x01\x13\x01\x14\x01\x15\x01\x6d\x00\x4a\x00\x4a\x00\x6b\x00\x2c\x01\x2d\x01\x85\x00\x2f\x01\x30\x01\x4a\x00\x4a\x00\x6d\x00\x6d\x00\x5f\x00\x36\x01\x52\x00\x38\x01\x39\x01\xc3\x00\xc4\x00\x3c\x01\x74\x00\x2c\x01\xc8\x00\x54\x00\x74\x00\x30\x01\xcc\x00\x18\x00\x73\x00\x4d\x00\xd0\x00\x36\x01\xd2\x00\x4d\x00\x39\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4a\x00\xda\x00\xdb\x00\xdc\x00\xc8\x00\x4a\x00\x83\x00\x4a\x00\xcc\x00\x4a\x00\x4a\x00\x77\x00\xd0\x00\x83\x00\xd2\x00\x4e\x00\x73\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4a\x00\x4a\x00\xdb\x00\xdc\x00\x1e\x00\x6c\x00\x0b\x00\x96\x00\x72\x00\x18\x00\x18\x00\x9a\x00\x15\x00\x9c\x00\x4a\x00\x6d\x00\x9f\x00\xa0\x00\xa1\x00\x73\x00\xa3\x00\xa4\x00\x18\x00\x05\x01\x06\x01\x6b\x00\x67\x00\x74\x00\x4d\x00\x4d\x00\x4d\x00\x4d\x00\x0e\x01\x0f\x01\x61\x00\x18\x00\x4a\x00\x13\x01\x14\x01\x15\x01\x60\x00\x52\x00\x6d\x00\x73\x00\x05\x01\x06\x01\x4e\x00\x18\x00\x57\x00\x18\x00\x07\x00\xa4\x00\x19\x00\x0e\x01\x0f\x01\x4a\x00\x6b\x00\x96\x00\x13\x01\x14\x01\x15\x01\xcc\x00\x2c\x01\x2d\x01\x52\x00\x2f\x01\x30\x01\x60\x00\x4b\x00\xa2\x00\xa3\x00\xa4\x00\x36\x01\x61\x00\x38\x01\x39\x01\xdb\x00\x72\x00\x3c\x01\x73\x00\x72\x00\x67\x00\x67\x00\x2c\x01\x2d\x01\x80\x00\x2f\x01\x30\x01\x52\x00\x72\x00\x4d\x00\xcc\x00\x6d\x00\x36\x01\x96\x00\x38\x01\x39\x01\x6b\x00\x9a\x00\x3c\x01\x9c\x00\x18\x00\x18\x00\x9f\x00\xa0\x00\xa1\x00\xdb\x00\xa3\x00\xa4\x00\x6d\x00\x67\x00\xcc\x00\x6d\x00\x0a\x01\x0b\x01\x72\x00\x0d\x01\x18\x00\x52\x00\x10\x01\x4e\x00\x96\x00\x13\x01\x14\x01\x15\x01\x9a\x00\xdb\x00\x9c\x00\x2b\x00\x72\x00\x9f\x00\xa0\x00\xa1\x00\x4a\x00\xa3\x00\xa4\x00\x19\x00\x4d\x00\x19\x01\x1a\x01\x4a\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x52\x00\x2c\x01\xcc\x00\x07\x00\x61\x00\x30\x01\x18\x00\x07\x00\x29\x01\x2a\x01\x2b\x01\x36\x01\x18\x00\x83\x00\x39\x01\x4d\x00\x6b\x00\xdb\x00\x4d\x00\x83\x00\x6d\x00\x36\x01\x19\x01\x1a\x01\x4e\x00\x73\x00\x1d\x01\x1e\x01\x54\x00\xcc\x00\x72\x00\x72\x00\x6c\x00\x07\x00\x21\x00\x31\x00\x57\x00\x61\x00\x29\x01\x57\x00\x2b\x01\x19\x00\x19\x01\x1a\x01\xdb\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x73\x00\x36\x01\x08\x00\x3b\x00\x4c\x00\x2c\x00\x6c\x00\x6a\x00\x29\x01\x2a\x01\x2b\x01\x61\x00\x54\x00\x6d\x00\x6f\x00\x73\x00\x58\x00\x6d\x00\x57\x00\xc9\x00\x5c\x00\x36\x01\x67\x00\x72\x00\x10\x00\x61\x00\x6d\x00\x97\x00\x67\x00\x19\x01\x1a\x01\x9b\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x6d\x00\x6d\x00\x6d\x00\x15\x00\x73\x00\x6d\x00\x73\x00\x67\x00\x29\x01\x2a\x01\x2b\x01\x78\x00\x79\x00\x44\x00\x4d\x00\x7c\x00\x7d\x00\x4d\x00\x52\x00\x19\x01\x1a\x01\x36\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x6c\x00\x52\x00\x02\x00\x18\x00\x6c\x00\x52\x00\x02\x00\x18\x00\x29\x01\x2a\x01\x2b\x01\x4c\x00\x18\x00\x78\x00\x07\x00\x6c\x00\xcc\x00\x6d\x00\xce\x00\xcf\x00\xd0\x00\x36\x01\xd2\x00\x6c\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\x07\x00\xdb\x00\xdc\x00\x17\x01\x78\x00\x73\x00\x6d\x00\xe1\x00\xe2\x00\x12\x00\x2e\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x24\x01\x9c\x00\x26\x01\x27\x01\x9f\x00\xa0\x00\xa1\x00\x3f\x01\xa3\x00\xa4\x00\x9d\x00\x3e\x01\xf9\x00\x31\x01\x3e\x01\x33\x01\x34\x01\x35\x01\xad\x00\x37\x01\xdf\x00\x3a\x00\x3a\x01\x3b\x01\x61\x00\xf9\x00\xf9\x00\x05\x01\x06\x01\x82\x00\x8c\x00\x2f\x00\x3e\x01\x3e\x01\x82\x00\x3d\x01\x0e\x01\x0f\x01\x82\x00\x31\x00\x86\x00\x13\x01\x14\x01\x15\x01\x8d\x00\x17\x01\x97\x00\x49\x00\x8d\x00\xcc\x00\x9b\x00\x9d\x00\x89\x00\x83\x00\xae\x00\x91\x00\x61\x00\x7f\x00\x7f\x00\x25\x01\x26\x01\x7d\x00\x28\x01\x86\x00\xdb\x00\xdd\x00\x43\x01\x2d\x01\x42\x01\x2f\x01\x30\x01\xd3\x00\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\x82\x00\x3d\x01\x3f\x01\x82\x00\x41\x01\x1f\x00\x1f\x00\x2e\x00\x45\x01\x03\x00\x0a\x00\x48\x01\xf1\x00\x43\x01\x4b\x01\x71\x00\xcc\x00\x3d\x01\xce\x00\xcf\x00\xd0\x00\x5c\x00\xd2\x00\x05\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xd9\x00\x3d\x01\xdb\x00\xdc\x00\x82\x00\x18\x01\x19\x01\x1a\x01\xe1\x00\xe2\x00\x1d\x01\x1e\x01\x89\x00\x3d\x01\x19\x01\x1a\x01\x3d\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x29\x01\x8a\x00\x2b\x01\x4c\x00\x4d\x00\x5d\x00\x39\x01\x7f\x00\x29\x01\x2a\x01\x2b\x01\x7d\x00\x7b\x00\x36\x01\x89\x00\x58\x00\x30\x00\x1f\x00\x1f\x00\x5c\x00\x2a\x00\x36\x01\x05\x01\x06\x01\x61\x00\x20\x01\x33\x00\x6b\x00\x89\x00\x4e\x00\x3f\x01\x0e\x01\x0f\x01\x66\x00\x75\x00\x49\x00\x13\x01\x14\x01\x15\x01\x79\x00\x17\x01\x97\x00\x70\x00\x74\x00\xb3\x00\x9b\x00\x2a\x00\x78\x00\x79\x00\x0f\x00\x1b\x00\x7c\x00\x7d\x00\x3d\x01\x25\x01\x26\x01\x1b\x00\x28\x01\x3d\x01\xd3\x00\x79\x00\xc1\x00\x2d\x01\xb3\x00\x2f\x01\x30\x01\x74\x00\x32\x01\x33\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xf1\x00\xb1\x00\x3f\x01\x51\x00\x41\x01\x32\x00\x16\x00\x16\x00\x45\x01\x2a\x00\x24\x00\x48\x01\x52\x00\x56\x00\x4b\x01\x4b\x00\xcc\x00\x3e\x01\xce\x00\xcf\x00\xd0\x00\x3d\x01\xd2\x00\x3e\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x3d\x01\x2f\x00\xdb\x00\xdc\x00\x11\x00\x3e\x01\x0c\x00\x82\x00\xe1\x00\xe2\x00\x57\x00\x3e\x01\x41\x01\x5e\x00\x3d\x01\x92\x00\x93\x00\x3d\x01\x57\x00\x96\x00\x97\x00\x3d\x01\x99\x00\x9a\x00\x31\x00\x9c\x00\xa4\x00\x3d\x01\x9f\x00\xa0\x00\xa1\x00\x33\x00\xa3\x00\xa4\x00\x0d\x01\xa6\x00\x3d\x01\x10\x01\x3d\x01\x61\x00\x13\x01\x14\x01\x15\x01\x5c\x00\x05\x01\x06\x01\x5e\x00\x82\x00\x1f\x00\x1f\x00\x34\x00\x16\x00\x16\x00\x0e\x01\x0f\x01\x3e\x01\x3e\x01\x3e\x01\x13\x01\x14\x01\x15\x01\xb3\x00\x17\x01\x97\x00\x24\x00\x2c\x01\xcc\x00\x9b\x00\x3e\x01\x30\x01\x3e\x01\x3e\x01\xff\xff\xcc\x00\xff\xff\x36\x01\x25\x01\x26\x01\x39\x01\x28\x01\xff\xff\xdb\x00\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xdb\x00\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xff\xff\x3f\x01\xff\xff\x41\x01\xff\xff\xff\xff\xff\xff\x45\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\x05\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xa4\x00\xff\xff\xe1\x00\xff\xff\xff\xff\xff\xff\xe5\x00\xe6\x00\x19\x01\x1a\x01\xff\xff\xff\xff\x1d\x01\x1e\x01\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\x29\x01\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\x36\x01\x05\x01\x06\x01\xcc\x00\xff\xff\x97\x00\xff\xff\x36\x01\xff\xff\x9b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xdb\x00\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xa4\x00\xff\xff\xe1\x00\x19\x01\x1a\x01\xe4\x00\xff\xff\x1d\x01\x1e\x01\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\xff\xff\x2b\x01\x07\x01\x08\x01\x09\x01\x0a\x01\x0b\x01\xff\xff\x0d\x01\xff\xff\xff\xff\x10\x01\x36\x01\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xcc\x00\xff\xff\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xdb\x00\x17\x01\xff\xff\xff\xff\x2c\x01\xff\xff\xff\xff\xff\xff\x30\x01\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\x25\x01\x26\x01\x39\x01\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xe1\x00\x19\x01\x1a\x01\xe4\x00\xff\xff\x1d\x01\x1e\x01\xa4\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\xff\xff\x1d\x01\x1e\x01\xff\xff\x29\x01\xff\xff\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\xff\xff\x2b\x01\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\x96\x00\xdb\x00\xdc\x00\xff\xff\x9a\x00\xff\xff\xff\xff\xe1\x00\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\xff\xff\x1d\x01\x1e\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\xff\xff\x2b\x01\xba\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\x96\x00\xdb\x00\xdc\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\xe1\x00\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\x29\x01\x2a\x01\x2b\x01\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\x96\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\x9c\x00\xe1\x00\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\x96\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\x9c\x00\xe1\x00\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xcc\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xe1\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x17\x01\xff\xff\xff\xff\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x01\x26\x01\xff\xff\x28\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x32\x01\x33\x01\xff\xff\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\x0e\x01\x0f\x01\x61\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\x74\x00\x13\x01\x14\x01\x15\x01\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x2d\x01\x97\x00\x2f\x01\x30\x01\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\x45\x01\xff\xff\x36\x01\x48\x01\x38\x01\x39\x01\x4b\x01\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xce\x00\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x10\x01\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\x2c\x01\x13\x01\x14\x01\x15\x01\x30\x01\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x36\x01\x97\x00\xff\xff\x39\x01\xff\xff\x9b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x2d\x01\x97\x00\x2f\x01\x30\x01\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x45\x01\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\x4b\x01\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\x0e\x01\x0f\x01\x61\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\x74\x00\x13\x01\x14\x01\x15\x01\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x2d\x01\x97\x00\x2f\x01\x30\x01\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\x45\x01\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x4b\x01\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\x45\x01\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4b\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x05\x01\x06\x01\xff\xff\xa8\x00\xa9\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xbb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xcc\x00\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xdb\x00\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x45\x01\x4c\x00\x4d\x00\xff\xff\xff\xff\x36\x01\x4b\x01\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\x45\x01\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\x4b\x01\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\x74\x00\xff\xff\x5c\x00\xff\xff\x78\x00\x79\x00\xff\xff\x61\x00\x7c\x00\x7d\x00\x96\x00\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x74\x00\x29\x01\x2a\x01\x2b\x01\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x3f\x01\x9c\x00\x41\x01\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xa9\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xdb\x00\x9c\x00\xff\xff\x58\x00\x9f\x00\xa0\x00\xa1\x00\x5c\x00\xa3\x00\xa4\x00\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\xff\xff\xdb\x00\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xcc\x00\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xdb\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x24\x01\xff\xff\x26\x01\x27\x01\xff\xff\xff\xff\x05\x01\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x31\x01\xff\xff\x33\x01\x34\x01\x35\x01\xff\xff\x37\x01\xff\xff\x36\x01\x3a\x01\x3b\x01\xff\xff\xcc\x00\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x3f\x01\xff\xff\x41\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x34\x01\x35\x01\x36\x01\x37\x01\xff\xff\x97\x00\x3a\x01\x3b\x01\xff\xff\x9b\x00\xff\xff\x3f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\x97\x00\xff\xff\xff\xff\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0c\x01\x0d\x01\xff\xff\xff\xff\x10\x01\x36\x01\x97\x00\x13\x01\x14\x01\x15\x01\x9b\x00\xff\xff\xff\xff\xff\xff\x3f\x01\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\x2c\x01\xff\xff\xff\xff\xff\xff\x30\x01\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\x36\x01\xd2\x00\xff\xff\x39\x01\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\x97\x00\x13\x01\x14\x01\x15\x01\x9b\x00\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x97\x00\xff\xff\x3c\x01\xff\xff\x9b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xcc\x00\xff\xff\xff\xff\xcf\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xdb\x00\x3c\x01\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x92\x00\x93\x00\x3c\x01\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xa6\x00\xff\xff\xff\xff\x0c\x01\x0d\x01\x05\x01\xff\xff\x10\x01\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\x2c\x01\xff\xff\xff\xff\xcc\x00\x30\x01\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\x36\x01\xff\xff\xff\xff\x39\x01\xff\xff\xff\xff\x92\x00\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xa5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\xff\xff\xff\xff\xff\xff\x17\x01\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\x23\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\x2c\x01\xff\xff\xcc\x00\xff\xff\x30\x01\x29\x01\x2a\x01\x2b\x01\x34\x01\x35\x01\x36\x01\x37\x01\x38\x01\x39\x01\x3a\x01\x3b\x01\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xa5\x00\x93\x00\xff\xff\x95\x00\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xa5\x00\x93\x00\xff\xff\x95\x00\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\x96\x00\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x93\x00\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xba\x00\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\x36\x01\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\x07\x00\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\xff\xff\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\xff\xff\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\xff\xff\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\x53\x00\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\xff\xff\x67\x00\xff\xff\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\xa1\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\x4b\x00\xff\xff\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x5d\x00\x5e\x00\x5f\x00\x60\x00\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x67\x00\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\x6f\x00\xff\xff\xff\xff\x72\x00\x73\x00\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x00\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\x69\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\x00\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\x40\x00\x41\x00\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xa7\x00\xa8\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\x67\x00\xff\xff\x69\x00\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xcc\x00\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xdb\x00\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\x9c\x00\xa3\x00\xa4\x00\x9f\x00\xa0\x00\xa7\x00\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xac\x00\xad\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\x05\x01\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\x05\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xa9\x00\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xdb\x00\x9c\x00\xff\xff\x36\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x05\x01\xff\xff\xff\xff\xa8\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xdb\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\x05\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xa9\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xb2\x00\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xf6\x00\xf7\x00\xf8\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\x05\x01\x06\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x19\x01\x1a\x01\x3c\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x01\x29\x01\x2a\x01\x2b\x01\x4d\x01\xff\xff\x4f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xf6\x00\xf7\x00\xf8\x00\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\x05\x01\x06\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\x05\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x19\x01\x1a\x01\x3c\x01\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x01\x29\x01\x2a\x01\x2b\x01\x4d\x01\xff\xff\x4f\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x98\x00\x99\x00\x9a\x00\xdb\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\x19\x01\x1a\x01\xdb\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\x36\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xb2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xdb\x00\x9c\x00\xff\xff\x36\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xdb\x00\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\x05\x01\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\xff\xff\x96\x00\x97\x00\x36\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\x97\x00\xff\xff\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\x97\x00\x05\x01\x99\x00\x9a\x00\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\x05\x01\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\x96\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xa1\x00\xff\xff\xa3\x00\xa4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xdb\x00\x36\x01\x01\x00\x02\x00\xcc\x00\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xdb\x00\x36\x01\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x19\x01\x1a\x01\xff\xff\x1c\x01\x1d\x01\x1e\x01\x1f\x01\x20\x01\xff\xff\xff\xff\x36\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x01\x2a\x01\x2b\x01\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\x09\x00\x0a\x00\x36\x01\xff\xff\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\xff\xff\x13\x00\x76\x00\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\x42\x00\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\x2b\x00\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\x63\x00\x64\x00\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\x62\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\x06\x00\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\x13\x00\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\x70\x00\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\x63\x00\x64\x00\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\x63\x00\x64\x00\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\x4e\x00\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\x63\x00\x64\x00\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\x0d\x00\x0e\x00\x0f\x00\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x43\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x08\x01\x09\x01\x0a\x01\x0b\x01\xff\xff\x0d\x01\xff\xff\xff\xff\x10\x01\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\x2c\x01\xff\xff\xff\xff\xff\xff\x30\x01\xff\xff\xff\xff\xff\xff\x34\x01\x35\x01\x36\x01\x37\x01\xff\xff\x39\x01\x6a\x00\x3b\x01\x6c\x00\xff\xff\x6e\x00\x3f\x01\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\x72\x00\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\x71\x00\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x11\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\x5b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x4b\x00\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\xff\xff\xff\xff\xff\xff\x65\x00\xff\xff\x67\x00\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\x6f\x00\xff\xff\xff\xff\x72\x00\x73\x00\x74\x00\xff\xff\xff\xff\xff\xff\x78\x00\x79\x00\xff\xff\xff\xff\x7c\x00\x7d\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x70\x00\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x8c\x00\x8d\x00\x8e\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x96\x00\x97\x00\x98\x00\xff\xff\x9a\x00\xff\xff\x9c\x00\x9d\x00\x9e\x00\x9f\x00\xa0\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x4d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\x55\x00\xff\xff\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\x6f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\x6b\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x10\x00\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\x80\x00\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\x15\x00\xff\xff\x9f\x00\xa0\x00\x19\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x40\x00\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x75\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x82\x00\x83\x00\x84\x00\x85\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x9c\x00\xff\xff\xff\xff\x9f\x00\xa0\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xf4\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xf4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\x3d\x01\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xff\xff\x50\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xff\xff\x50\x01\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xf4\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xf4\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\x4a\x01\xff\xff\x4c\x01\xff\xff\x4e\x01\xff\xff\x50\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\x44\x01\xff\xff\xff\xff\x47\x01\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\xff\xff\x50\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xf8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\x3d\x01\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xf8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x49\x01\xff\xff\xff\xff\xff\xff\x4d\x01\xff\xff\x4f\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\x15\x00\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x4f\x01\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\x84\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x83\x00\x84\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x83\x00\x84\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x76\x00\x77\x00\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x83\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x83\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\x83\x00\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xe7\x00\xe8\x00\xe9\x00\xea\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xfe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x83\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xe8\x00\xe9\x00\xea\x00\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\xff\xff\xfe\x00\xff\xff\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\xff\xff\xfc\x00\xfd\x00\xfe\x00\xff\xff\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\xfb\x00\xff\xff\xfd\x00\xfe\x00\xff\xff\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\x44\x01\xfa\x00\xff\xff\xff\xff\xfd\x00\xfe\x00\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\x44\x01\xfa\x00\xff\xff\xff\xff\xfd\x00\xfe\x00\xff\xff\xff\xff\x4c\x01\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xd8\x00\x38\x01\x39\x01\xdb\x00\xdc\x00\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xeb\x00\xec\x00\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xfe\x00\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xeb\x00\xec\x00\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xfe\x00\xff\xff\xff\xff\xef\x00\xf0\x00\xf1\x00\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x44\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x4c\x01\xff\xff\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xea\x00\xfd\x00\xfe\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xfe\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x44\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x4c\x01\xff\xff\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf3\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xf5\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xfe\x00\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x44\x01\xff\xff\xff\xff\x47\x01\x36\x01\xff\xff\x38\x01\x39\x01\x4c\x01\xff\xff\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf2\x00\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\x44\x01\xff\xff\xff\xff\x47\x01\x36\x01\xff\xff\x38\x01\x39\x01\x4c\x01\xff\xff\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xf2\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xcd\x00\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x4c\x01\x3c\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\x44\x01\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x4c\x01\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\x1b\x00\x1c\x00\x1d\x00\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\x09\x00\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x44\x01\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x01\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\x02\x00\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\x74\x00\xff\xff\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x7b\x00\x7c\x00\x7d\x00\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x74\x00\xff\xff\x76\x00\x77\x00\x78\x00\x79\x00\xff\xff\x7b\x00\x15\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd1\x00\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xd1\x00\xd2\x00\xff\xff\xd4\x00\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\x46\x01\x36\x01\x02\x00\x38\x01\x39\x01\x05\x00\x06\x00\x3c\x01\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x46\x01\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6c\x00\x02\x00\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\x73\x00\x09\x00\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\x05\x00\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\x09\x00\xff\xff\xff\xff\xff\xff\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x09\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\x15\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x09\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\x15\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x09\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\x15\x00\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\x09\x00\x6e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\x15\x00\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\x7a\x00\x7b\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\x7b\x00\xff\xff\xff\xff\xff\xff\x15\x00\x4b\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\x7a\x00\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x76\x00\xff\xff\xff\xff\xff\xff\x7a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x61\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6a\x00\x02\x00\x6c\x00\x6d\x00\x6e\x00\xff\xff\xff\xff\xff\xff\x09\x00\x73\x00\xff\xff\xff\xff\x76\x00\x77\x00\x78\x00\x79\x00\xff\xff\x12\x00\xff\xff\xff\xff\x15\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\x6a\x00\xff\xff\x6c\x00\xff\xff\x6e\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x66\x00\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\x76\x00\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\x77\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\x6c\x00\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\x76\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4e\x00\x15\x00\xff\xff\xff\xff\xff\xff\x53\x00\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\x66\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\xff\xff\x73\x00\xff\xff\xff\xff\x76\x00\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x6c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\x6c\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x02\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\x02\x00\xff\xff\xff\xff\xff\xff\xff\xff\x76\x00\xff\xff\x09\x00\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x54\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\xf6\x00\xf7\x00\xf8\x00\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\x76\x00\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xf6\x00\xf7\x00\xf8\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\xd0\x00\xff\xff\xd2\x00\xff\xff\xff\xff\xd5\x00\xd6\x00\xd7\x00\xd8\x00\x05\x01\x06\x01\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xde\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x0e\x01\x0f\x01\x3c\x01\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xcc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xcc\x00\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xcc\x00\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xcc\x00\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xd6\x00\xd7\x00\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xcc\x00\xff\xff\xff\xff\xff\xff\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xd6\x00\xd7\x00\xd8\x00\x0e\x01\x0f\x01\xdb\x00\xdc\x00\xcc\x00\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xd8\x00\xff\xff\xff\xff\xdb\x00\xdc\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\x05\x01\x06\x01\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\x05\x01\x06\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0e\x01\x0f\x01\xff\xff\xff\xff\xff\xff\x13\x01\x14\x01\x15\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\x2d\x01\xff\xff\x2f\x01\x30\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x36\x01\xff\xff\x38\x01\x39\x01\xff\xff\xff\xff\x3c\x01\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x73\x00\xa4\x05\xa5\x05\xa7\x05\xa8\x05\x51\x01\x38\x01\xd9\x05\xd9\x00\xcb\x04\xe0\x05\xdb\x05\x76\x05\x48\x02\xdc\x05\x1d\x05\x36\x02\x1c\x05\x37\x02\x35\x05\xd7\x05\x1d\x05\x36\x02\x9f\x05\x37\x02\xed\x03\xe6\x04\x1d\x05\x36\x02\x34\x03\x37\x02\x35\x02\x36\x02\x36\x02\x37\x02\x33\x04\xdd\x03\x47\x05\x57\x01\x48\x05\x73\x03\xcd\x03\xce\x03\x8c\x03\xab\x03\x5f\x04\xce\x03\x33\x02\xe7\x05\x34\x01\x33\x02\x72\x04\xfa\x00\x71\x03\x17\x01\xb2\x02\xb3\x02\xda\x00\x0c\x02\x0d\x02\x0e\x02\x0f\x02\xd1\x05\x49\x05\x4f\x05\xe1\x05\x33\x02\x35\x01\x30\x03\xdb\x02\xc6\x04\xb0\x03\x6a\x05\x6b\x05\x6c\x05\x6d\x05\xb3\x04\x2a\x02\x33\x02\x13\x01\x11\x05\xb2\x02\xb3\x02\x57\x03\xc7\x05\x6d\x05\xb3\x04\x2a\x05\xce\x03\x30\x01\x33\x02\x27\x02\x30\x01\x76\x03\x5b\x05\xa6\x04\x8d\x02\xe8\x05\xb3\x04\x11\x00\x58\x03\x59\x03\x33\x02\x44\x03\xd2\x05\x31\x03\xa3\x03\xe8\x05\xb3\x04\x1a\x03\xe8\x04\x49\x00\xe9\x05\xea\x05\xeb\x05\x12\x05\x13\x05\xa8\x02\xa8\xfe\xe8\x05\xb3\x04\x7f\x03\xf9\x05\xea\x05\xeb\x05\xd5\x01\xdc\x02\x49\x04\xb1\x03\xb2\x04\xb3\x04\x77\x03\x78\x03\x90\x04\x1b\x03\xac\x03\xff\x05\x10\x02\x18\x01\x4e\x00\x02\x02\x33\x02\x73\x04\x45\x03\xc1\x02\x4b\x05\xe7\x04\xe8\x05\xd5\x01\xfd\x00\x4f\x00\xb0\xfe\x34\x02\x93\x00\xb2\xfe\x34\x02\xe2\x05\xc3\x02\xa8\xfe\x96\x00\x8d\x03\x35\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\xa7\x02\xc4\x02\xc5\x02\xc6\x02\xbf\x02\x34\x02\x8e\x02\x58\x01\x39\x01\x3a\x01\x11\x01\x76\x00\x25\x01\x78\x00\x03\x02\x04\x02\x05\x02\x34\x02\xa4\x03\x10\x02\x59\x01\x4e\x00\x5a\x01\x5b\x01\xa7\x04\xb0\xfe\xe8\x03\xa1\x02\xb2\xfe\x34\x02\x4a\x01\x4b\x01\x4f\x00\x7b\x00\xa2\x02\x7c\x00\x7d\x00\x7e\x00\xd9\x03\x7f\x00\x3b\x01\x34\x02\x82\x00\x83\x00\xa2\x00\xa3\x00\x11\x00\x52\x01\x49\x00\x28\x01\xd7\x03\xcf\x03\xb5\x02\xa4\x00\x75\x00\xcf\x03\xa6\x03\x11\x00\x76\x00\x77\x00\x78\x00\x11\x00\x35\x03\xcc\x04\xcc\x04\x77\x05\x3f\x03\xa3\x02\x11\x00\x4a\x01\x4b\x01\xe8\x04\x49\x00\x35\x03\x4f\x00\x4f\x00\x4f\x00\xa9\xff\xb4\x02\x11\x00\x34\x02\x72\x03\x28\x03\xdd\x00\xa5\x00\x27\x01\x0f\x00\xde\x00\xde\x03\x3f\x05\x02\x02\x11\x00\xa8\x02\x11\x00\xa9\x02\x80\x00\x81\x00\xcf\x03\x72\x03\xa6\x00\xdf\x03\xe0\x03\x27\x01\x11\x00\x74\x00\x75\x00\x40\x03\xff\xff\x11\x00\x76\x00\x77\x00\x78\x00\x79\x03\x79\x00\x0e\x03\x33\x02\x27\x01\x37\x00\xef\x01\x7e\x00\x29\x03\x7f\x00\x11\x00\x79\x03\x79\x03\x31\x03\x06\x02\x27\x01\x27\x01\x7a\x00\x27\x01\x20\x04\x05\x02\x11\x00\x11\x00\x0e\x00\x11\x00\x0f\x00\x10\x00\x7b\x00\xa6\x05\x7c\x00\x7d\x00\x7e\x00\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa9\x05\x38\x02\xb4\x04\xa9\x05\xb5\x04\x49\x00\x06\x02\x38\x02\xa6\x05\xcd\x02\x27\x01\xff\xff\xb4\x04\x38\x02\xb5\x04\x49\x00\x11\x00\x38\x02\x38\x02\x1d\x01\xb6\x04\x33\x02\x0f\x00\x10\x00\xb4\x04\x3d\x03\xb5\x04\x49\x00\x32\x00\x11\x00\xb6\x04\x33\x02\x0f\x00\x10\x00\xb4\x04\x85\x00\xb5\x04\x49\x00\x19\x01\x11\x00\x40\x01\x33\x02\xb6\x04\x23\x04\x0f\x00\x10\x00\xb4\x04\xca\x01\xb5\x04\x49\x00\x34\x01\x11\x00\xb6\x04\xea\x04\x0f\x00\x10\x00\xb4\x04\x4c\xff\xb5\x04\x49\x00\xcb\x01\x11\x00\xff\xff\x33\x00\xb6\x04\x3e\x03\x0f\x00\x10\x00\x35\x01\x24\x04\x34\x02\x7b\x05\x79\x05\x11\x00\xb6\x04\x33\x03\x0f\x00\x10\x00\xd9\x00\x1c\x05\x90\x00\xeb\x04\xec\x04\x11\x00\xaa\x04\xab\x04\xf1\x00\xf2\x00\xf3\x00\xf4\x00\xd7\x02\xf5\x00\x06\x02\xb2\x05\x0f\x02\x4c\xff\x27\x01\x4a\x02\x0d\x02\x0e\x02\x0f\x02\xdd\x03\x11\x00\x09\x05\xa3\x04\xa4\x04\xa5\x04\xa6\x04\xf6\x00\xf7\x00\x7b\x01\x0c\x02\x34\x00\x34\x01\x3a\x04\x7f\x02\x51\x02\xf8\x00\xf9\x00\x37\x00\x46\x03\xd8\x02\xfa\x00\x47\x03\x0a\x05\x41\x01\x34\x02\xda\x00\x42\x01\x3e\x00\x3f\x00\x35\x01\x40\x00\x41\x00\xd9\x02\x7f\x05\x34\x02\xef\x02\x37\x00\x53\x02\x52\x02\x61\x02\xed\x04\x80\x01\x24\x03\xd9\x03\x34\x02\x42\x01\x3e\x00\x3f\x00\xd7\x02\x40\x00\x41\x00\x65\x00\x53\x02\xc1\x05\xd9\x00\x69\x00\xfb\x00\x80\x02\x81\x02\x0f\x00\x82\x02\xf0\x00\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x11\x00\xf5\x00\xce\x02\x75\x00\x58\x00\x42\x00\x62\x02\x76\x00\x77\x00\x78\x00\x4c\x02\xb9\x02\x4b\x00\xd8\x02\xaa\xfe\x86\xfc\x59\x00\x86\xfc\xf6\x00\xf7\x00\x43\x00\x17\xff\x5f\x03\x4d\x02\x42\x00\x5d\x00\x6d\x03\xf8\x00\xf9\x00\x7d\x02\x7e\x02\x7f\x02\xfa\x00\xcf\x02\xa7\x04\x0f\x00\x10\x00\xda\x00\x54\x01\x43\x00\x51\x04\x98\x05\x11\x00\xfd\x01\x80\x00\x81\x00\xfc\x00\x62\x01\x66\x00\x67\x00\x10\x02\xfd\x00\x4e\x00\x1c\x01\xaa\xfe\x93\x00\x10\x02\x1d\x01\x4e\x00\xfe\x00\x63\x05\x96\x00\x7b\x01\x4f\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xfb\x00\x4f\x00\x9c\x00\x9d\x00\xd5\x01\x52\x04\x62\x02\x80\x02\x81\x02\x0f\x00\x82\x02\x3c\x04\x3f\x01\x49\x03\x45\x00\x43\x01\x11\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x25\x02\xb9\x02\x65\x00\x10\x04\x86\xfc\x80\x01\x40\x01\x20\x02\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x5c\x02\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4a\x01\x4b\x01\x4f\x00\xa2\x00\xa3\x00\x99\x04\x39\x05\x37\x05\x4c\x00\x4d\x00\x4e\x00\x1f\x02\xa4\x00\x75\x00\x3d\x04\xfc\x00\x85\x02\x76\x00\x77\x00\x78\x00\xfd\x00\x4f\x00\x11\x00\x5d\x02\x93\x00\x87\x04\x0e\x02\x0f\x02\xfe\x00\x34\x00\x96\x00\x9a\x04\x18\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x38\x05\x4e\x01\x9c\x00\x9d\x00\x15\x02\xdd\x00\xa5\x00\x72\x02\x0f\x00\xde\x00\xaa\xff\x58\x01\x35\x00\x58\x02\x19\x01\x11\x00\xa9\x04\x80\x00\x81\x00\xbe\x01\x28\x04\xa6\x00\x09\x02\x29\x04\x59\x01\xd9\x00\x5a\x01\x5b\x01\x7b\x01\x4f\x01\x50\x01\x51\x01\xe5\x03\xf1\x00\xf2\x00\xf3\x00\xf4\x00\x7b\x00\xf5\x00\x7c\x00\x7d\x00\x7e\x00\x0b\x02\x7f\x00\xa2\x00\xa3\x00\x82\x00\x83\x00\x83\x03\x0d\x02\x0e\x02\x0f\x02\x2a\x04\xa4\x00\x75\x00\xf6\x00\xf7\x00\xab\x02\x76\x00\x77\x00\x78\x00\x80\x01\x42\x00\xff\xff\xf8\x00\xf9\x00\x49\x02\x3d\x02\x4e\x00\xfa\x00\x67\x05\x36\x05\x37\x05\x6d\xfd\xda\x00\xce\x02\x75\x00\x43\x00\x35\x02\x4f\x00\x76\x00\x77\x00\x78\x00\xdd\x00\xa5\x00\x66\x05\x0f\x00\xde\x00\x87\x00\x19\x01\x85\x00\xd9\x01\x88\x00\x11\x00\x5a\x02\x80\x00\x81\x00\x89\x00\x7c\x01\xa6\x00\x5b\x02\x58\x00\x38\x05\xd9\x00\x19\x01\xfb\x00\xcf\x02\x26\x02\x0f\x00\x10\x00\xaf\x05\x37\x05\x79\xfe\x59\x00\x10\x02\x11\x00\x4e\x00\x80\x00\x81\x00\x79\xfe\x8f\x00\x27\x02\x5d\x00\x7f\x01\x92\x00\x78\x05\x79\x05\x4f\x00\xf0\x02\x80\x01\x4f\x03\x50\x03\x47\x05\x87\x00\x48\x05\x90\x00\x79\xfe\x88\x00\xf1\x02\x45\x00\x46\x00\x38\x05\x89\x00\x48\x00\x49\x00\x66\x00\x67\x00\xfa\x00\x2d\x02\x6a\x00\x6b\x00\xf3\x02\xda\x00\xf3\x01\x49\x00\x4c\x00\xff\xff\x4e\x00\x49\x05\x4a\x05\xe7\x03\xfc\x00\x2e\x02\x2f\x02\x53\x03\x8f\x00\xfd\x00\xf4\x01\x4f\x00\xda\x01\x93\x00\xe8\x03\xdb\x01\x19\x05\xfe\x00\x10\x02\x96\x00\x4e\x00\x4f\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x54\x03\x55\x03\x9c\x00\x9d\x00\x27\x02\x4f\x00\x79\xfe\x79\xfe\xea\x01\x37\x00\xd8\x03\x79\xfe\xeb\x01\x1c\x02\x1d\x02\x24\x03\xd8\x01\x18\x05\x42\x01\x3e\x00\x3f\x00\xd9\x03\x40\x00\x41\x00\x22\x03\x8a\x00\x9c\x01\x84\x01\x54\x02\x8c\x00\x1e\x02\x27\x02\x79\xfe\x08\x02\x79\xfe\x65\x00\x55\x02\xee\x01\x8e\x00\x69\x00\xed\x04\x27\x01\x91\x00\x79\xfe\xa2\x00\xa3\x00\x57\x02\x11\x00\xd9\x00\x80\x00\x81\x00\x65\x00\x58\x02\xa4\x00\x75\x00\x69\x00\xc1\x02\x4b\x05\x76\x00\x77\x00\x78\x00\xfd\x00\x1d\x04\x42\x00\xd6\x05\x93\x00\x27\x01\x4a\x01\x4b\x01\xc3\x02\xd7\x05\x96\x00\x11\x00\x42\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x43\x00\xc4\x02\xc5\x02\xc6\x02\x99\x01\xdd\x00\xa5\x00\xf3\x02\x0f\x00\xde\x00\x43\x00\x58\x01\x79\xfe\xef\xfc\xfa\x00\x11\x00\x5e\x04\x80\x00\x81\x00\xda\x00\x61\x01\xa6\x00\x11\x00\x7a\x04\xf4\x02\x4e\x00\x5a\x01\x5b\x01\x8e\x04\xca\x02\x93\x01\x3a\x01\x27\x01\x76\x00\x25\x01\x78\x00\x4f\x00\x7b\x00\x11\x00\x7c\x00\x7d\x00\x7e\x00\xff\xff\x7f\x00\xa2\x00\xa3\x00\x82\x00\x83\x00\x83\x04\x70\x04\x0d\x02\x0e\x02\x0f\x02\xa4\x00\x75\x00\xff\xff\x84\x04\xb9\x01\x76\x00\x77\x00\x78\x00\x80\x01\x45\x00\x46\x00\xd6\x03\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x23\x03\x28\x01\x45\x00\x46\x00\x3e\x05\xd7\x03\x48\x00\x49\x00\x4c\x00\x4d\x00\x4e\x00\x1b\x05\x5f\x01\xdd\x00\xa5\x00\x3f\x05\x0f\x00\xde\x00\x4c\x00\xd9\x00\x4e\x00\x4f\x00\x1c\x05\x11\x00\x16\xff\x80\x00\x81\x00\x7e\x05\x74\x05\xa6\x00\x38\x01\x4f\x00\xee\x04\x0d\x02\x0e\x02\x0f\x02\xc1\x02\xc2\x02\x7f\x05\xd9\x03\xdd\xfd\xfd\x00\xdd\xfd\x21\x01\xdd\xfd\x93\x00\x65\x00\x38\x03\x91\x02\xc3\x02\x69\x00\x96\x00\x39\x03\xdd\xfd\x98\x00\x99\x00\x9a\x00\x9b\x00\x58\x01\xc4\x02\xc5\x02\xc6\x02\x84\xfc\xfa\x00\xe7\x01\x83\x00\x37\x00\xfe\x02\xda\x00\xe8\x01\xc0\x05\x59\x01\x24\x03\x5a\x01\x5b\x01\x42\x01\x3e\x00\x3f\x00\xc0\x02\x40\x00\x41\x00\xc1\x05\xff\xff\x85\x00\x7b\x00\xc4\x04\x7c\x00\x7d\x00\x7e\x00\xff\xff\x7f\x00\x5f\x05\x75\x00\x82\x00\x83\x00\x87\x00\x76\x00\x77\x00\x78\x00\x88\x00\xcb\x02\xc8\x02\xc9\x02\xa3\x00\x89\x00\x8d\x04\x10\x02\x31\x02\x4e\x00\x27\x01\x4d\x03\xa4\x00\x75\x00\x85\x00\xc3\x05\x11\x00\x76\x00\x77\x00\x78\x00\x4f\x00\x42\x00\x7c\x01\xe6\x02\x5e\x01\x85\x02\x4f\x00\x57\x03\x8f\x00\x90\x00\xd3\x05\x11\x00\x92\x00\x93\x00\x80\x00\x81\x00\x43\x00\x8a\x00\xd4\x05\x3d\x01\x34\x03\x8c\x00\xdd\x00\xa5\x00\xd9\x00\x0f\x00\xde\x00\x7f\x01\x4d\x02\x7e\x00\x8e\x00\x7f\x00\x11\x00\x80\x01\x80\x00\x81\x00\xc1\x02\xc2\x02\xa6\x00\x90\x00\x10\x02\xfd\x00\x4e\x00\x93\x00\x84\x02\x93\x00\x85\x02\x3f\x05\x27\x03\xc3\x02\xd6\x04\x96\x00\x11\x00\x4f\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x43\x03\xc4\x02\xc5\x02\xc6\x02\xe6\x01\xb9\x01\x7e\x00\x39\x03\x7f\x00\x3a\x03\xfa\x00\xe7\x01\x83\x00\x64\x02\x30\x01\xda\x00\xe8\x01\xd7\x04\xdd\x04\x11\x00\x45\x00\x46\x00\x75\x03\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x81\x01\x75\x00\xae\x03\xaf\x03\x82\x01\x76\x00\x77\x00\x78\x00\x4c\x00\x4d\x00\x4e\x00\xbd\x03\x2e\x00\x85\x02\xc7\x02\xc8\x02\xc9\x02\xa3\x00\x2f\x00\x11\x00\x30\x00\x4f\x00\x4a\x01\x4b\x01\x1c\x01\xa4\x00\x75\x00\x37\x00\x1d\x01\x17\x03\x76\x00\x77\x00\x78\x00\x40\x05\x13\x03\x0d\x03\x42\x01\x3e\x00\x3f\x00\x0e\x03\x40\x00\x41\x00\x80\x00\x81\x00\x93\x01\xd4\x03\x11\x03\x76\x00\x25\x01\x78\x00\xe6\x01\xb9\x01\x7e\x00\x86\x05\x7f\x00\xdd\x00\xa5\x00\x5d\x05\x0f\x00\xde\x00\xd9\x00\x0e\x00\x75\x02\x0f\x00\x10\x00\x11\x00\x58\x02\x80\x00\x81\x00\x87\x00\x11\x00\xa6\x00\x0f\x03\x88\x00\xc1\x02\xd9\x04\x13\x01\x14\x01\x89\x00\xfd\x00\x15\x01\x42\x00\x64\x02\x93\x00\x61\x01\x28\x01\xd6\x04\xc3\x02\x11\x00\x96\x00\xe4\x01\x81\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x43\x00\xc4\x02\xc5\x02\xc6\x02\xfe\x02\x8f\x00\x5e\x05\x02\x03\xfa\x00\x92\x00\x5f\x05\x4d\x02\x7e\x00\xda\x00\x7f\x00\xd7\x04\xd8\x04\x91\x01\xdd\x02\x0f\x00\x10\x00\x20\x03\xe8\x01\x37\x00\x48\x00\x49\x00\x11\x00\xff\x02\x97\x01\x24\x03\x98\x01\x85\x00\x42\x01\x3e\x00\x3f\x00\xe3\x02\x40\x00\x41\x00\xa0\x01\x7c\x01\xa1\x01\xe1\x02\xa2\x01\x87\x00\xa2\x00\xa3\x00\xee\x02\x88\x00\x22\x05\xe4\x02\x85\x02\x65\x00\x89\x00\xa4\x00\x75\x00\x69\x00\x11\x00\x5e\x02\x76\x00\x77\x00\x78\x00\x58\x02\x45\x00\x46\x00\x7f\x01\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x80\x01\x1d\x03\x1e\x03\x1f\x03\x20\x03\x8f\x00\x90\x00\x42\x00\x4c\x00\x4d\x00\x4e\x00\x87\x03\x88\x03\xdd\x00\xa5\x00\x80\x03\x0f\x00\xde\x00\x48\x00\x49\x00\x85\x00\x4f\x00\x43\x00\x11\x00\x8f\xfe\x80\x00\x81\x00\xd9\x00\x8f\xfe\xa6\x00\xc1\x02\xd9\x04\x87\x00\xae\x03\xaf\x03\xfd\x00\x88\x00\xe3\x01\x10\x00\x93\x00\xad\x01\x89\x00\xae\x01\xc3\x02\x11\x00\x96\x00\xe4\x01\x81\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x74\x02\xc4\x02\xc5\x02\xc6\x02\x47\x05\xa7\x01\x48\x05\xa8\x01\x5e\x01\x54\x01\xde\x03\x60\x05\x8f\x00\x90\x00\x48\x00\x49\x00\x92\x00\x93\x00\xec\x02\xfa\x00\xfa\x05\x75\x00\xfb\x04\xe0\x03\xda\x00\x76\x00\x77\x00\x78\x00\xdb\xfc\x97\x01\xbd\x05\x98\x01\x45\x00\x46\x00\x73\x02\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xef\x01\x7e\x00\x0d\x03\x7f\x00\xa2\x00\xa3\x00\x0e\x03\x31\x03\x4c\x00\x4d\x00\x4e\x00\x65\x00\x1c\x01\xa4\x00\x75\x00\x69\x00\x1d\x01\xea\x02\x76\x00\x77\x00\x78\x00\x4f\x00\x80\x00\x81\x00\x37\x00\x4d\x04\x46\x04\x47\x04\x55\x01\xd3\x01\x56\x01\xe8\x02\xdd\x02\x3d\x00\x3e\x00\x3f\x00\xe8\x01\x40\x00\x41\x00\x8b\x01\xdf\x02\x0f\x00\x10\x00\xdd\x00\xa5\x00\xe0\x02\x0f\x00\xde\x00\x11\x00\x9b\x02\xbc\x05\x9c\x02\x98\x02\x11\x00\x99\x02\x80\x00\x81\x00\xd9\x00\x85\x00\xa6\x00\x30\x01\x31\x01\x32\x01\xd1\x02\x93\x01\x8d\x05\xe2\x03\x76\x00\x25\x01\x78\x00\x87\x00\xc1\x02\x4b\x05\x9b\x02\x88\x00\x9c\x02\xfd\x00\xcd\x02\x42\x00\x89\x00\x93\x00\x4a\x01\x4b\x01\xd6\x04\xc3\x02\x79\x04\x96\x00\x7a\x04\x92\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\x43\x00\xc4\x02\xc5\x02\xc6\x02\x97\x01\xe3\x03\x98\x01\xbc\x02\xfa\x00\x8f\x00\x90\x00\xb8\x02\x28\x01\xda\x00\x8a\x00\x8a\x05\x84\x01\xce\x01\x8c\x00\xc3\x03\x9d\x01\x46\x00\xa7\x02\x37\x00\x48\x00\x49\x00\x32\x04\x8e\x00\x33\x04\x24\x03\xb7\x02\x91\x00\x42\x01\x3e\x00\x3f\x00\xb2\x02\x40\x00\x41\x00\xb0\x02\xe4\x02\x10\x00\x2c\x01\x2d\x01\x2e\x01\xa2\x00\xa3\x00\x11\x00\xa4\x02\xe4\x01\x81\x00\x9b\x03\x9c\x03\x9d\x03\xa4\x00\x75\x00\x4f\x03\x50\x03\x42\x00\x76\x00\x77\x00\x78\x00\xa0\x02\x45\x00\x46\x00\x9f\x02\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x89\x05\x8a\x05\x43\x00\x09\x03\x0a\x03\x0b\x03\x9d\x02\x42\x00\x4c\x00\x4d\x00\x4e\x00\x89\x05\xb9\x05\xdd\x00\xa5\x00\x92\x02\x0f\x00\xde\x00\xd9\x00\xae\x03\xaf\x03\x4f\x00\x43\x00\x11\x00\x95\x02\x80\x00\x81\x00\x4a\x01\x4b\x01\xa6\x00\xc1\x02\xd9\x04\x45\x04\x46\x04\x47\x04\xfd\x00\xd3\x01\x25\x02\x23\x02\x93\x00\xe6\x01\xb9\x01\x7e\x00\xc3\x02\x7f\x00\x96\x00\x22\x02\x23\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\x94\x02\xc4\x02\xc5\x02\xc6\x02\x2b\x03\x2c\x03\x2d\x03\x2e\x03\x2f\x03\xf8\x01\xfa\x00\xf9\x01\x45\x00\x46\x00\x93\x02\xda\x00\x48\x00\x49\x00\x88\x03\x89\x03\x8a\x03\x9f\x04\x0a\x03\x0b\x03\x16\x05\x58\x05\x17\x05\xe4\x04\x4c\x00\xe5\x04\x4e\x00\x85\x00\x45\x00\x46\x00\x91\x02\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xd1\x04\x4f\x00\xd2\x04\x87\x00\xa2\x00\xa3\x00\x74\x02\x88\x00\x4c\x00\x4d\x00\x4e\x00\x89\x02\x89\x00\xa4\x00\x75\x00\x94\x01\xcf\x01\x62\x04\x76\x00\x77\x00\x78\x00\x4f\x00\xd5\x01\x81\x01\x75\x00\x77\x02\xca\x05\xc2\x03\x76\x00\x77\x00\x78\x00\x5e\x01\x6a\x04\x6b\x04\x6c\x04\x8f\x00\x90\x00\x94\x01\x95\x01\x92\x00\x93\x00\x92\x01\x8d\x01\xdd\x00\xa5\x00\xd9\x00\x0f\x00\xde\x00\x65\x04\x66\x04\x67\x04\x76\x02\xc5\x04\x11\x00\xc6\x04\x80\x00\x81\x00\x73\x02\xb1\x04\xa6\x00\xb2\x04\x64\x02\xc1\x02\xc2\x02\x60\x02\x80\x00\x81\x00\xfd\x00\xb1\x02\x4b\x01\x4c\x01\x93\x00\xe5\x04\x6b\x04\x6c\x04\xc3\x02\x52\x05\x96\x00\x53\x05\x56\x02\x98\x00\x99\x00\x9a\x00\x9b\x00\x5f\x02\xc4\x02\xc5\x02\xc6\x02\x89\x02\xfa\x00\xd3\x01\xb1\x04\x37\x00\xb2\x04\xda\x00\x58\x01\x63\x02\x30\x01\x24\x03\x69\x03\x21\x01\x42\x01\x3e\x00\x3f\x00\x57\x05\x40\x00\x41\x00\x2c\x01\x59\x01\x66\x03\x5a\x01\x5b\x01\x8f\x01\x8d\x01\x58\x00\xdf\x04\x6b\x04\x6c\x04\x3c\x05\x6b\x04\x6c\x04\x7b\x00\xff\x01\x7c\x00\x7d\x00\x7e\x00\x59\x00\x7f\x00\xa2\x00\xa3\x00\x82\x00\x83\x00\xe8\x02\x8c\x01\x8d\x01\x5d\x00\x50\x02\xa4\x00\x75\x00\x4f\x02\x42\x00\x44\x02\x76\x00\x77\x00\x78\x00\x31\x02\x42\x00\xbb\x02\xf0\x05\x6b\x04\x6c\x04\x35\x01\x36\x01\x80\x01\x11\x01\x43\x00\xbe\x03\xbf\x03\x66\x00\x67\x00\x5c\x03\x43\x00\x6a\x00\x6b\x00\xd9\x00\x94\x01\x74\x04\xdd\x00\xa5\x00\x25\x02\x0f\x00\xde\x00\x42\x00\xf8\x05\x6b\x04\x6c\x04\x2b\x04\x11\x00\x25\x04\x80\x00\x81\x00\xc1\x02\xc2\x02\xa6\x00\x22\x04\xd9\x00\xfd\x00\x43\x00\xb9\x02\x4b\x00\x93\x00\x17\x04\x5a\x04\x5b\x04\xc3\x02\x18\x04\x96\x00\x13\x05\x0f\x05\x98\x00\x99\x00\x9a\x00\x9b\x00\xbb\xfc\xc4\x02\xc5\x02\xc6\x02\xda\xfc\xfa\x00\x0e\x05\x0f\x05\xd4\x04\x9d\x03\xda\x00\x62\x02\x62\x05\x49\x00\x45\x00\x46\x00\xad\x05\xbf\x03\x48\x00\x49\x00\x45\x00\x46\x00\xc2\xfc\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x2b\x05\x67\x04\x4c\x00\xda\x00\x4e\x00\xe4\x05\xe5\x05\xc3\xfc\x4c\x00\x4d\x00\x4e\x00\xd9\xfc\xbc\xfc\xbd\xfc\x16\x04\x4f\x00\xa2\x00\xa3\x00\x45\x00\x46\x00\x15\x04\x4f\x00\x48\x00\x49\x00\x14\x04\xa4\x00\x75\x00\x13\x04\x12\x04\xea\xfc\x76\x00\x77\x00\x78\x00\x0e\x04\x4c\x00\x0f\x04\x4e\x00\xc5\x03\x86\x01\x87\x01\x88\x01\x80\x01\x89\x01\x0d\x04\xe4\x03\x24\x01\x5c\x02\x4f\x00\x76\x00\x25\x01\x78\x00\x59\x02\xd4\x03\xd3\x03\xcc\x03\xdd\x00\xa5\x00\xcd\x03\x0f\x00\xde\x00\xca\x03\xc5\x03\xc9\x03\xc8\x03\x02\x03\x11\x00\x7b\x01\x80\x00\x81\x00\xc1\x02\x59\x04\xa6\x00\xc2\x03\x26\x01\xfd\x00\xbd\x03\xc1\x03\x27\x01\x93\x00\xa0\x03\xee\xfc\x9b\x03\xc3\x02\x11\x00\x96\x00\x98\x03\x28\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x95\x03\xc4\x02\xc5\x02\xc6\x02\xdb\x00\x91\x03\x94\x03\x90\x03\x93\x00\x8f\x03\x8e\x03\x8e\x00\xdc\x00\x38\x01\x96\x00\x85\x03\x68\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x63\x03\x62\x03\x9c\x00\x9d\x00\x5f\x03\x5c\x03\x11\x01\x37\x00\x56\x04\xaa\x04\xa3\x04\x55\x01\xa2\x04\x56\x01\x9d\x04\x9e\x04\x3d\x00\x3e\x00\x3f\x00\x93\x04\x40\x00\x41\x00\x96\x04\xa2\x00\xa3\x00\x98\x04\x94\x04\x92\x04\x90\x04\xe4\xfc\xe3\xfc\xe5\xfc\xa4\x00\x75\x00\x8d\x04\x86\x04\x82\x04\x76\x00\x77\x00\x78\x00\xa7\x03\x8b\x04\x7f\x04\x7d\x04\xa2\x00\xa3\x00\x77\x04\xa6\x03\x72\x04\x70\x04\x6e\x04\x95\x02\x69\x04\xa4\x00\x75\x00\x65\x04\x62\x04\x15\x02\x76\x00\x77\x00\x78\x00\x42\x00\xdd\x00\xa5\x00\x5c\x02\x0f\x00\xde\x00\xcb\x05\x53\x04\x16\x02\x17\x02\x18\x02\x11\x00\x61\x04\x80\x00\x81\x00\x43\x00\x56\x04\xa6\x00\x57\x04\x4c\x04\x4a\x04\x42\x04\xdd\x00\xa5\x00\x6c\x00\x0f\x00\xde\x00\x61\x02\x44\x04\x37\x04\x42\x00\x39\x04\x11\x00\x37\x00\x80\x00\x81\x00\x38\x04\xa8\x03\xa6\x00\xa9\x03\x30\x04\x2f\x04\x3d\x00\x3e\x00\x3f\x00\x43\x00\x40\x00\x41\x00\x0e\x05\x0d\x05\x42\x00\x0b\x05\xc6\x03\x88\x01\x91\x02\x89\x01\xa6\x03\xd5\x01\x24\x01\xda\x03\x37\x00\x76\x00\x25\x01\x78\x00\xa8\x03\x43\x00\xa9\x03\x03\x05\xae\x04\x3d\x00\x3e\x00\x3f\x00\xfb\x04\x40\x00\x41\x00\xf7\x04\xf8\x04\x45\x00\x46\x00\xf6\x04\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xf5\x04\x26\x01\x42\x00\x6e\x04\xe3\x04\x27\x01\x70\x04\x6e\x04\x4c\x00\x4d\x00\x4e\x00\x11\x00\xcf\x04\xd3\x04\x28\x01\xca\x04\xc3\x04\x43\x00\xc9\x04\xc2\x04\xbf\x04\x4f\x00\x45\x00\x46\x00\x55\x05\xbe\x04\x48\x00\x49\x00\x54\x05\x42\x00\x56\x04\xae\x04\x66\x05\x6e\x04\x46\x05\x51\x01\x30\x05\x31\x05\x4c\x00\x73\xfe\x4e\x00\x69\x04\x45\x00\x46\x00\x43\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x29\x05\x4f\x00\x25\x05\x21\x01\x85\x00\x9c\x05\xa3\x05\xa1\x05\x4c\x00\x4d\x00\x4e\x00\x99\x05\x7c\x01\x9a\x05\x96\x05\x92\x05\x87\x00\x91\x05\x8c\x05\x5c\x04\x88\x00\x4f\x00\x8d\x05\x8f\x05\x81\x05\x89\x00\x72\x05\x62\x01\x69\x05\x45\x00\x46\x00\x63\x01\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x7f\x01\x71\x05\x70\x05\xa2\x04\xc6\x05\xc7\x05\x80\x01\xbf\x05\x4c\x00\x4d\x00\x4e\x00\x8f\x00\x90\x00\x61\x01\x9b\x03\x92\x00\x93\x00\xb1\x05\x7b\x01\x45\x00\x46\x00\x4f\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x5c\x03\x5c\x02\xd5\x05\xd0\x05\x5c\x03\xcd\x05\xca\x05\xe0\x05\x4c\x00\x4d\x00\x4e\x00\xf5\x05\x70\x04\xf6\x05\x6e\x04\xf0\x05\x93\x00\xfe\x05\x64\x01\x65\x01\x66\x01\x4f\x00\x96\x00\x66\x05\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x68\x01\x6e\x04\x9c\x00\x9d\x00\x58\x01\xf8\x05\xfd\x05\x01\x06\x69\x01\x6a\x01\x11\x01\x0f\x01\x37\x00\x38\x00\xfb\x01\x3a\x00\x3b\x00\x59\x01\x3c\x00\x5a\x01\x5b\x01\x3d\x00\x3e\x00\x3f\x00\xe5\x01\x40\x00\x41\x00\x1a\x02\x29\x02\xcc\x01\x7b\x00\x28\x02\x7c\x00\x7d\x00\x7e\x00\x48\x02\x7f\x00\xa5\x01\x9a\x01\x82\x00\x83\x00\x5f\x01\xae\x01\xab\x01\xa2\x00\xa3\x00\x48\x01\x3d\x01\x1f\x01\x1e\x01\x1a\x01\x52\x03\x51\x03\xa4\x00\x75\x00\x50\x03\x4d\x03\x45\x03\x76\x00\x77\x00\x78\x00\x2f\x03\x6b\x01\x62\x01\x1b\x03\x29\x03\x42\x00\x63\x01\x1a\x02\x18\x03\x17\x03\x0f\x03\xe1\x02\x03\x03\xd9\x02\xd3\x02\x6c\x01\x6d\x01\xd5\x02\x6e\x01\xbc\x02\x43\x00\xab\x02\x99\x02\xa5\x00\x96\x02\x0f\x00\x10\x00\x8f\x02\x6f\x01\x70\x01\xb9\x01\x72\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x73\x01\x83\x00\xa6\x00\x2c\x02\x31\x02\x74\x01\x2b\x02\x75\x01\x2d\x04\x2c\x04\x57\x03\x76\x01\x2b\x04\x26\x04\x77\x01\x8d\x02\x10\x04\x78\x01\x9e\x03\x93\x00\xe8\x03\x64\x01\x65\x01\x66\x01\x99\x03\x96\x00\x44\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x68\x01\xe4\x03\x9c\x00\x9d\x00\x96\x03\x9c\x01\x9d\x01\x46\x00\x69\x01\x6a\x01\x48\x00\x49\x00\x95\x03\xdb\x03\x45\x00\x46\x00\xda\x03\x47\x00\x48\x00\x49\x00\xfc\x01\x4b\x00\x9e\x01\x92\x03\x4e\x00\x85\x00\x9a\x01\x85\x03\x75\x03\x6d\x03\xb3\x05\x4d\x00\x4e\x00\x6b\x03\x6a\x03\x4f\x00\x68\x03\x87\x00\x5d\x03\x5c\x03\x5a\x03\x88\x00\xac\x04\x4f\x00\xa2\x00\xa3\x00\x89\x00\x63\x03\xa0\x04\x94\x04\x9b\x04\x89\x04\xfd\x01\xa4\x00\x75\x00\x86\x04\x84\x04\x80\x04\x76\x00\x77\x00\x78\x00\x75\x04\x6b\x01\x62\x01\x77\x04\x5e\x01\x6e\x04\x63\x01\x54\x04\x8f\x00\x90\x00\x30\x04\x17\x05\x92\x00\x93\x00\x4c\x04\x6c\x01\x6d\x01\x14\x05\x6e\x01\x44\x04\x07\x05\x05\x05\xed\x04\xa5\x00\xe0\x04\x0f\x00\x10\x00\xcf\x04\x6f\x01\x70\x01\x71\x01\x72\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x73\x01\x83\x00\xa6\x00\x8d\x02\xd5\x04\x74\x01\xcd\x04\x75\x01\xc0\x04\xbf\x04\xaf\x04\x76\x01\xae\x04\x64\x05\x77\x01\x50\x05\x44\x05\x78\x01\x34\x05\x93\x00\x61\x05\xb2\x01\x65\x01\x66\x01\x46\x05\x96\x00\x5a\x05\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x21\x05\x20\x05\x9c\x00\x9d\x00\xa3\x05\x1f\x05\xa1\x05\x9e\x05\xb3\x01\xb4\x01\x82\x05\x9d\x05\x96\x05\x87\x05\x8f\x05\x31\x05\x14\x03\x81\x05\x7f\x05\x37\x00\x38\x00\x74\x05\x15\x03\x3b\x00\x72\x05\x3c\x00\x7c\x02\x69\x05\x3d\x00\x3e\x00\x3f\x00\xc4\x05\x40\x00\x41\x00\x23\x01\x32\x05\xc2\x05\x24\x01\xc1\x05\xbb\x05\x76\x00\x25\x01\x78\x00\xba\x05\xa2\x00\xa3\x00\xb7\x05\xab\x05\xaa\x05\xce\x05\xc8\x05\xde\x05\xf2\x05\xa4\x00\x75\x00\xe3\x05\xda\x05\xd8\x05\x76\x00\x77\x00\x78\x00\xf1\x05\x6b\x01\x62\x01\xfe\x05\x26\x01\x42\x00\x63\x01\xf3\x05\x27\x01\xfb\x05\xf6\x05\x00\x00\x42\x00\x00\x00\x11\x00\x6c\x01\x6d\x01\x28\x01\x6e\x01\x00\x00\x43\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x43\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x00\x00\xb7\x01\x00\x00\x75\x01\x00\x00\x00\x00\x00\x00\x76\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x78\x01\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x00\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x44\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x46\x02\x00\x00\xba\x01\x00\x00\x00\x00\x00\x00\xbb\x01\xbc\x01\x45\x00\x46\x00\x00\x00\x00\x00\x48\x00\x49\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x4f\x00\xa2\x00\xa3\x00\x42\x00\x00\x00\x62\x01\x00\x00\x4f\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x43\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x44\x02\x00\x00\xa4\x02\x45\x00\x46\x00\xa5\x02\x00\x00\x48\x00\x49\x00\x40\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x84\x01\x85\x01\x86\x01\x87\x01\x88\x01\x00\x00\x89\x01\x00\x00\x00\x00\x24\x01\x4f\x00\x00\x00\x76\x00\x25\x01\x78\x00\x00\x00\xa2\x00\xa3\x00\x42\x00\x00\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x43\x00\x6b\x01\x00\x00\x00\x00\x26\x01\x00\x00\x00\x00\x00\x00\x27\x01\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x6c\x01\x6d\x01\x28\x01\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x02\x45\x00\x46\x00\xec\x03\x00\x00\x48\x00\x49\x00\x1e\x04\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x00\x00\x48\x00\x49\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x37\x00\x9c\x00\x9d\x00\x00\x00\xef\x04\x00\x00\x00\x00\xea\x02\x00\x00\xf0\x04\xf1\x04\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x00\x00\x48\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\xf2\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x37\x00\x9c\x00\x9d\x00\x00\x00\x3a\x05\x00\x00\x3b\x05\xf7\x03\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\x01\x75\x00\x4c\x00\x4d\x00\x4e\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\xb0\x01\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xee\x03\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x37\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x22\x03\xef\x03\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x37\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x11\x03\x3b\x04\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x42\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x01\x65\x01\x66\x01\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x4f\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x6b\x01\x00\x00\x00\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x01\x6d\x01\x00\x00\x6e\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x6f\x01\xb5\x01\x00\x00\xb6\x01\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xb2\x03\x65\x01\xf1\x02\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\xf6\x03\x65\x01\xf1\x02\x00\x00\x96\x00\x00\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x5d\x01\x90\xfe\x00\x00\x00\x00\x00\x00\x90\xfe\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x89\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x00\x00\x00\x00\x5e\x01\x76\x00\x77\x00\x78\x00\x8f\x00\x90\x00\x00\x00\x00\x00\x92\x00\x93\x00\xa5\x00\x62\x01\x0f\x00\x10\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x76\x01\x00\x00\x11\x00\xb3\x03\x80\x00\x81\x00\x78\x01\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\xfc\x04\x65\x01\xf1\x02\x00\x00\x96\x00\x76\x01\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x65\x01\xf1\x02\x00\x00\x96\x00\x00\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x40\x03\x41\x03\x00\x00\x00\x00\x24\x01\x00\x00\x00\x00\x76\x00\x25\x01\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x26\x01\x76\x00\x77\x00\x78\x00\x27\x01\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x11\x00\x62\x01\x00\x00\x28\x01\x00\x00\x63\x01\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x62\x01\x0f\x00\x10\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x76\x01\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x78\x01\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x65\x01\xf1\x02\x00\x00\x96\x00\xf2\x02\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\x00\x00\x65\x01\xf1\x02\x00\x00\x96\x00\x00\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x5d\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x89\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\xa4\x00\x75\x00\x00\x00\x00\x00\x5e\x01\x76\x00\x77\x00\x78\x00\x8f\x00\x90\x00\x00\x00\x00\x00\x92\x00\x93\x00\xa5\x00\x62\x01\x0f\x00\x10\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\xb7\x03\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x78\x01\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x65\x01\xf1\x02\x00\x00\x96\x00\xb6\x03\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x78\x01\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x65\x01\xf1\x02\x00\x00\x96\x00\x00\x00\x67\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x2c\x05\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\xa2\x00\xa3\x00\x00\x00\xf6\x01\xf7\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x2d\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x42\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x43\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xb5\x03\x85\x00\x61\x03\x00\x00\x00\x00\x11\x00\x78\x01\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\xb4\x03\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x78\x01\x85\x00\x5e\x04\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x5e\x01\x00\x00\x88\x00\x00\x00\x8f\x00\x90\x00\x00\x00\x89\x00\x92\x00\x93\x00\x37\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x21\x02\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x5e\x01\x4c\x00\x4d\x00\x4e\x00\x8f\x00\x90\x00\x00\x00\x00\x00\x92\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\xf5\x01\x3a\x00\x3b\x00\xf8\x01\x3c\x00\x2e\x05\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\xf6\x01\xf7\x01\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x85\x05\x00\x00\x00\x00\x37\x00\x38\x00\x65\x02\x3a\x00\x3b\x00\x43\x00\x3c\x00\x00\x00\x87\x00\x3d\x00\x3e\x00\x3f\x00\x88\x00\x40\x00\x41\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x01\x00\x00\x00\x00\x43\x00\x8f\x00\x90\x00\x00\x00\x00\x00\x92\x00\x93\x00\x37\x00\x38\x00\xfb\x01\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x42\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x58\x01\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x43\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x59\x01\x00\x00\x5a\x01\x5b\x01\x00\x00\x00\x00\x44\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x7b\x00\x00\x00\x7c\x00\x7d\x00\x7e\x00\x00\x00\x7f\x00\x00\x00\x4f\x00\x82\x00\x83\x00\x00\x00\x42\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\xf8\x01\x00\x00\xf9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x4d\x02\x7e\x00\x4f\x00\x7f\x00\x00\x00\x62\x01\xe7\x01\x83\x00\x00\x00\x63\x01\x00\x00\xe8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\xfc\x01\x4b\x00\x62\x01\x00\x00\x00\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x03\x41\x03\x00\x00\x00\x00\x24\x01\x4f\x00\x62\x01\x76\x00\x25\x01\x78\x00\x63\x01\x00\x00\x00\x00\x00\x00\xfd\x01\x93\x00\x00\x00\x00\x00\xff\x02\xf1\x02\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x26\x01\x00\x00\x00\x00\x00\x00\x27\x01\x93\x00\x00\x00\x00\x00\xbb\x03\xf1\x02\x11\x00\x96\x00\x00\x00\x28\x01\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\xba\x03\xf1\x02\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x62\x01\x76\x00\x77\x00\x78\x00\x63\x01\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x62\x01\x00\x00\xa6\x00\x00\x00\x63\x01\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\xb1\x03\xf1\x02\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x93\x00\x00\x00\x00\x00\x63\x04\xf1\x02\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x13\x03\x14\x03\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x15\x03\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x43\x00\xa6\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x31\x05\x14\x03\xa6\x00\x00\x00\x37\x00\x38\x00\x00\x00\x15\x03\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xae\x05\x00\x00\x00\x00\x9a\x04\x41\x03\x44\x00\x00\x00\x24\x01\x00\x00\x00\x00\x76\x00\x25\x01\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x26\x01\x00\x00\x00\x00\x42\x00\x27\x01\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x11\x00\x00\x00\x00\x00\x28\x01\x00\x00\x00\x00\x81\x03\x14\x03\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x15\x03\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xd1\x02\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\xd2\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\xea\x01\x00\x00\x00\x00\x00\x00\xeb\x01\x00\x00\x00\x00\x00\x00\xec\x01\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\xed\x01\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\xee\x01\x00\x00\x42\x00\x00\x00\x27\x01\x4c\x00\x4d\x00\x4e\x00\xef\x01\x7e\x00\x11\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xd1\x02\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x91\x03\xf8\x04\x00\x00\xf9\x04\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd1\x02\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\xd3\x04\xf8\x04\x00\x00\x9a\x05\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x02\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x04\x03\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xbd\x02\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x03\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x57\x04\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x04\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x56\x05\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x55\x05\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xb9\x05\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x92\x05\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xcd\x05\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xbe\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x93\x05\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x4f\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xaf\xfd\xaf\xfd\x13\x00\xaf\xfd\x00\x00\x00\x00\x00\x00\xaf\xfd\xaf\xfd\x14\x00\xaf\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xfd\xaf\xfd\x00\x00\x00\x00\xaf\xfd\x15\x00\xaf\xfd\x00\x00\xaf\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\xaf\xfd\xaf\xfd\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\xfd\x00\x00\x23\x00\xaf\xfd\xaf\xfd\x00\x00\xaf\xfd\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xfd\xaf\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x00\x00\x00\x00\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x00\x00\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x00\x00\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x00\x00\xaf\xfd\xa0\x01\xaf\xfd\xa1\x01\xaf\xfd\xa2\x01\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x64\x00\x65\x00\xaf\xfd\xaf\xfd\xaf\xfd\x69\x00\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\xaf\xfd\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x72\xfe\x51\x00\x13\x00\x72\xfe\x00\x00\x00\x00\x00\x00\x72\xfe\x72\xfe\x14\x00\x72\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\xfe\x72\xfe\x00\x00\x00\x00\x72\xfe\x15\x00\x72\xfe\x00\x00\x72\xfe\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x72\xfe\x72\xfe\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x72\xfe\x00\x00\x23\x00\x72\xfe\x72\xfe\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x72\xfe\x72\xfe\x58\x00\x72\xfe\x72\xfe\x72\xfe\x00\x00\x00\x00\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x00\x00\x72\xfe\x59\x00\x5a\x00\x5b\x00\x72\xfe\x5c\x00\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x5d\x00\x00\x00\x00\x00\x1a\x02\x72\xfe\x5e\x00\x72\xfe\x00\x00\x72\xfe\x5f\x00\x72\xfe\x60\x00\x72\xfe\x61\x00\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x6d\x00\x6e\x00\x6f\x00\x70\x00\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x72\xfe\x71\x00\x72\xfe\x72\xfe\x72\x00\x73\x00\x72\xfe\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x00\x00\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x00\x00\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\xfe\x79\xfe\x00\x00\x00\x00\x79\xfe\x79\xfe\x79\xfe\x00\x00\x79\xfe\x00\x00\x00\x00\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x79\xfe\x79\xfe\x1c\x02\x1d\x02\x00\x00\x7b\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x00\x00\x00\x00\x79\xfe\x1e\x02\x00\x00\x79\xfe\x00\x00\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x79\xfe\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x92\xfc\x92\xfc\x92\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\xfc\x00\x00\x00\x00\x92\xfc\x92\xfc\x92\xfc\x00\x00\x92\xfc\x00\x00\x00\x00\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x00\x00\x92\xfc\x92\xfc\x92\xfc\x00\x00\x00\x00\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\xfc\x92\xfc\x85\x00\xdf\x01\x92\xfc\x92\xfc\x00\x00\x00\x00\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x00\x00\x92\xfc\x87\x00\x92\xfc\x92\xfc\x92\xfc\x88\x00\xe0\x01\xe1\x01\xe2\x01\xe3\x01\x89\x00\x00\x00\x00\x00\x92\xfc\x92\xfc\x00\x00\x92\xfc\x00\x00\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x5e\x01\x92\xfc\x92\xfc\x92\xfc\x8f\x00\x90\x00\x92\xfc\x92\xfc\x92\x00\x93\x00\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\x92\xfc\xdf\xfd\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\xfd\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\xdf\xfd\x15\x00\xdf\xfd\x00\x00\xdf\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\xdf\xfd\xdf\xfd\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\xb3\x00\x00\x00\x00\x00\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\x00\x00\xdf\xfd\xdf\xfd\xb5\x00\xb6\x00\xb7\x00\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\x00\x00\x00\x00\xdd\x01\xdf\xfd\x00\x00\xdf\xfd\x00\x00\xdf\xfd\xb8\x00\xdf\xfd\xb9\x00\xdf\xfd\xba\x00\xdf\xfd\xbb\x00\xdf\xfd\xdf\xfd\xdf\xfd\xdf\xfd\xbc\x00\x2d\x00\x8e\x00\xdf\xfd\xdf\xfd\x2e\x00\x91\x00\xdf\xfd\xdf\xfd\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xdf\xfd\xd7\x00\xdf\xfd\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xdf\xfd\xe0\xfd\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xfd\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\xe0\xfd\x15\x00\xe0\xfd\x00\x00\xe0\xfd\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\xe0\xfd\xe0\xfd\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\xb3\x00\x00\x00\x00\x00\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\x00\x00\xe0\xfd\xe0\xfd\xb5\x00\xb6\x00\xb7\x00\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\x00\x00\x00\x00\xdd\x01\xe0\xfd\x00\x00\xe0\xfd\x00\x00\xe0\xfd\xb8\x00\xe0\xfd\xb9\x00\xe0\xfd\xba\x00\xe0\xfd\xbb\x00\xe0\xfd\xe0\xfd\xe0\xfd\xe0\xfd\xbc\x00\x2d\x00\x8e\x00\xe0\xfd\xe0\xfd\x2e\x00\x91\x00\xe0\xfd\xe0\xfd\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\xe0\xfd\xd7\x00\xe0\xfd\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xe0\xfd\x33\x02\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x8a\xfc\x00\x00\xf9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x8a\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\xfa\x02\xfb\x02\xfc\x02\xfd\x02\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x8a\xfc\x00\x00\x00\x00\x00\x00\x8a\xfc\x00\x00\x8a\xfc\x00\x00\x8a\xfc\x00\x00\x00\x00\x8a\xfc\x8a\xfc\x34\x02\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\x33\x02\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x69\xfd\x00\x00\x69\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x34\x02\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x08\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x38\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x38\xfe\x00\x00\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x00\x00\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x64\xfe\x64\xfe\x64\xfe\x64\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x64\xfe\x00\x00\x00\x00\x64\xfe\x64\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x63\xfe\x63\xfe\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x6f\x02\x70\x02\x63\xfe\x37\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x37\xfe\x00\x00\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x00\x00\x63\xfe\x63\xfe\x63\xfe\x42\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x43\x00\x00\x00\x00\x00\x00\x00\x63\xfe\x63\xfe\x63\xfe\x63\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x63\xfe\x40\x00\x41\x00\x63\xfe\x63\xfe\x98\x03\x70\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x37\x00\x38\x00\x8b\x04\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x05\x0f\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x44\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x1c\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x44\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x1b\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x05\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4f\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x37\x00\x38\x00\x19\x04\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x04\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x43\x00\x3c\x00\x00\x00\x4f\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x18\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x6e\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x44\x00\x00\x00\x00\x00\x39\x04\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x43\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x37\x00\x38\x00\x19\x04\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x44\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x45\x02\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x02\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\xa8\x01\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\xc1\x01\x99\x00\x9a\x00\x9b\x00\x3e\x02\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x4f\x00\x37\x00\x38\x00\x82\x03\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x8b\x04\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x7d\x04\x00\x00\x00\x00\xc2\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\xc3\x01\x02\x04\xc5\x01\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\xa2\x00\xa3\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x45\x00\x46\x00\xa6\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x04\x4c\x00\x4d\x00\x4e\x00\x05\x04\x00\x00\x06\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x35\x04\x00\x00\x00\x00\xc2\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\xc3\x01\x02\x04\xc5\x01\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\xa2\x00\xa3\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x04\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x94\x05\x3a\x00\x3b\x00\x00\x00\x3c\x00\x00\x00\x44\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x45\x00\x46\x00\xa6\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x04\x4c\x00\x4d\x00\x4e\x00\x05\x04\x00\x00\x06\x04\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x75\x05\x3a\x00\x3b\x00\x43\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x45\x00\x46\x00\x43\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x3d\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x4f\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb6\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x20\x02\x3b\x00\x43\x00\x3c\x00\x00\x00\x4f\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x7b\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x43\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x37\x00\x38\x00\x00\x00\x47\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x44\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x42\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x00\x00\x37\x00\x38\x00\x4f\x00\x41\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x00\x00\x3f\x02\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x25\x04\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\x1f\x04\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\xb8\x03\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\x9e\x04\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x38\x00\x00\x00\x0b\x05\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x38\x00\x44\x00\x29\x05\x3b\x00\x00\x00\x3c\x00\x00\x00\x00\x00\x3d\x00\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\x03\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x44\x00\x00\x00\x00\x00\x00\x00\xe1\x04\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\x04\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x05\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x83\x05\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x05\x00\x00\x00\x00\x42\x01\x3e\x00\x3f\x00\x00\x00\x40\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x43\x00\x4f\x00\x12\x02\x13\x00\x42\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x00\x4f\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x45\x00\x46\x00\x00\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\xaa\x00\x13\x00\xab\x00\x00\x01\x01\x01\x02\x01\x03\x01\x00\x00\x14\x00\xac\x00\x4f\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x04\x01\xe3\x00\x00\x00\x05\x01\x64\x00\x15\x00\x00\x00\x06\x01\x00\x00\x00\x00\x07\x01\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x09\x01\xe9\x00\x0a\x01\x0b\x01\x00\x00\x00\x00\x0c\x01\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\x00\x00\x00\x00\x00\x00\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x01\x05\x02\x05\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x00\x00\x00\x00\xcc\xfc\x00\x00\x00\x00\x00\x00\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x00\x00\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x00\x00\xcc\xfc\x00\x00\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\x00\x00\xcc\xfc\x00\x00\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xcc\xfc\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x7b\x01\x00\x00\x7c\x01\x00\x00\x00\x00\x00\x00\x7d\x01\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x7e\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x7f\x01\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x80\x01\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\xdb\x04\xdc\x04\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xdd\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x4d\x05\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x4e\x05\x00\x00\x15\x00\x00\x00\x4f\x05\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\xdb\x04\xdc\x04\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xdd\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x4d\x05\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x4e\x05\x00\x00\x15\x00\x00\x00\x4f\x05\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x7b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\xb9\x01\xbb\x00\x00\x00\x00\x00\x80\x01\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x90\xfd\xba\x00\x90\xfd\xbb\x00\x00\x00\x00\x00\x58\x02\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x72\x02\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x58\x02\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x75\x02\xbb\x00\x00\x00\x00\x00\x58\x02\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb5\xfd\x00\x00\xb5\xfd\xb5\xfd\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\xb5\xfd\x00\x00\xb5\xfd\x00\x00\xb5\xfd\x00\x00\xb5\xfd\x00\x00\x00\x00\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\x00\x00\xb5\xfd\x00\x00\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb5\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb4\xfd\x00\x00\xb4\xfd\xb4\xfd\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\xb4\xfd\x00\x00\xb4\xfd\x00\x00\xb4\xfd\x00\x00\xb4\xfd\x00\x00\x00\x00\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\x00\x00\xb4\xfd\x00\x00\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xb4\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xda\x03\xc2\xfd\x00\x00\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\xc2\xfd\x00\x00\xc2\xfd\x00\x00\xc2\xfd\x00\x00\xc2\xfd\x00\x00\x00\x00\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\x00\x00\xc2\xfd\x00\x00\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xc2\xfd\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\xbe\x01\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x5c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x08\x01\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x01\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\xe0\x00\xe1\x00\xe2\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\xe4\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xe5\x00\xe6\x00\xe7\x00\xe8\x00\x00\x00\x00\x00\xe9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xea\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xec\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x81\x01\xbc\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\xd5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd6\x01\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x04\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\xb0\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\xb0\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\xf6\x03\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\xb0\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\xf6\x03\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x7a\x01\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x91\x01\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\xdc\x02\x86\x01\x87\x01\x88\x01\x00\x00\x89\x01\x00\x00\x00\x00\x24\x01\x00\x00\x00\x00\x76\x00\x25\x01\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x26\x01\x00\x00\x00\x00\x00\x00\x27\x01\x00\x00\x00\x00\x00\x00\x4d\x02\x7e\x00\x11\x00\x7f\x00\x00\x00\x28\x01\x8f\x01\xdd\x02\xf2\xfd\x00\x00\xf2\xfd\xe8\x01\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\xf2\xfd\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xad\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xae\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\xc7\x01\xc8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x01\x00\x00\xf2\xfd\x00\x00\xf2\xfd\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\xf2\xfd\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xfe\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\xc6\xfe\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x03\x00\x00\xc6\xfe\x00\x00\xc6\xfe\x00\x00\xc6\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\x00\x00\xc6\xfe\xc6\xfe\x00\x00\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\x00\x00\xc6\xfe\x00\x00\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xc6\xfe\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xd5\x02\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\xbd\xfe\xbd\xfe\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x0a\x04\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x08\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xd5\x02\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\x00\x00\xbd\xfe\xbd\xfe\x00\x00\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\x00\x00\xbd\xfe\x00\x00\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xbd\xfe\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x69\xfd\x00\x00\x69\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x08\x04\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc9\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\xec\x03\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\xab\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\xac\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xaf\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\xb6\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\xbd\x00\xbe\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\xaa\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xea\xfd\x85\x00\xea\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xea\xfd\x00\x00\xf6\x02\xf7\x02\x00\x00\x7a\xfe\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\xea\xfd\xea\xfd\xea\xfd\xea\xfd\x89\x00\x00\x00\x00\x00\x00\x00\xf8\x02\x00\x00\xea\xfd\x00\x00\x00\x00\x00\x00\xea\xfd\x00\x00\xea\xfd\x00\x00\xea\xfd\x00\x00\x00\x00\xea\xfd\xea\xfd\x5e\x01\x00\x00\x00\x00\x00\x00\x8f\x00\x90\x00\x00\x00\x00\x00\x92\x00\x93\x00\xb8\x00\x00\x00\xb9\x00\x00\x00\xba\x00\x00\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x00\xbf\x00\xc0\x00\xc1\x00\xc2\x00\xc3\x00\xc4\x00\xc5\x00\xc6\x00\xc7\x00\xc8\x00\xc9\x00\xca\x00\xcb\x00\xcc\x00\xcd\x00\xce\x00\xcf\x00\xd0\x00\xd1\x00\xd2\x00\xd3\x00\xd4\x00\xd5\x00\xd6\x00\x00\x00\xd7\x00\x00\x00\x71\x00\xd8\x00\xd9\x00\x72\x00\x73\x00\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x15\xfd\x00\x00\x15\xfd\x59\x02\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\xfd\x15\xfd\x15\xfd\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\xfd\x15\x00\x00\x00\x15\xfd\x15\xfd\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\x01\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x02\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\xfb\x01\x00\x00\x00\x00\x00\x00\x80\x01\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\xb5\x05\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\x01\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x02\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x45\x01\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x46\x01\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x47\x01\x48\x01\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\x02\x5a\x00\x5b\x00\x00\x00\x69\x02\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x6b\x02\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x62\x00\x63\x00\x64\x00\x65\x00\x6c\x02\x6d\x02\x68\x00\x69\x00\x6a\x00\x6e\x02\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x5d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x02\x02\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x05\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x43\x05\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x34\x05\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x05\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7b\x05\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\xb5\x05\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\xb6\x05\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x52\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x6c\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\xab\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\xab\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x00\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x15\x00\x00\x00\x72\x00\x73\x00\x26\x03\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\xf4\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\xf4\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x56\x00\x57\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x58\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x59\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x00\x00\x51\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5a\x00\x5b\x00\x00\x00\x5c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x60\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x01\x64\x00\x65\x00\x00\x00\x00\x00\x68\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x71\x00\x00\x00\x00\x00\x72\x00\x73\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\xfa\x03\x00\x00\x00\x00\x00\x00\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\xfa\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\xfb\x03\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\xfc\x03\x00\x00\xa8\x00\x00\x00\xfd\x03\x00\x00\xfe\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\x00\x04\x00\x00\xa8\x00\x00\x00\xfd\x03\x00\x00\xfe\x03\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\xfa\x03\x00\x00\x00\x00\x00\x00\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf9\x03\xfa\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\x4a\x04\x00\x00\xa8\x00\x00\x00\xfd\x03\x00\x00\xfe\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\xc2\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\xa7\x00\x00\x00\x00\x00\xee\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x00\x00\x03\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x01\x02\x04\xc5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x03\x04\x00\x00\x00\x00\x00\x00\xc3\x01\x02\x04\xc5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x05\x04\x00\x00\x06\x04\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x15\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x06\x05\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x7b\x03\x7c\x03\x7d\x03\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x03\x7f\x03\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x08\x02\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7e\x03\x7f\x03\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x08\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x7e\x03\x7f\x03\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x3a\x02\x3b\x02\xde\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x3c\x02\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x1f\x05\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x3a\x02\x3b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x3c\x02\x00\x00\x16\x00\x17\x00\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x3b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x3c\x02\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x03\xf1\x03\xf2\x03\xf3\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x02\x3b\x02\x00\x00\xf4\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x3c\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xff\x04\xf2\x03\xf3\x03\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x00\x00\xf4\x03\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x0d\x01\x0e\x01\xa1\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x00\x9f\x00\x00\x00\xa0\x00\xa1\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\xa7\x00\xae\x02\x00\x00\x00\x00\xad\x02\xa1\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\xa7\x00\xac\x02\x00\x00\x00\x00\xad\x02\xa1\x00\x00\x00\x00\x00\xa8\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\xe9\x01\x80\x00\x81\x00\x9c\x00\x9d\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x02\x8b\x02\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x8c\x02\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa3\x01\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x93\x00\xd0\x01\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa1\x03\x8b\x02\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8c\x02\x00\x00\x00\x00\xd1\x01\xd2\x01\xd3\x01\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa8\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x04\x53\x04\xa1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\xfe\x04\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa8\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x93\x00\x94\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x3f\x04\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa7\x00\x00\x00\x00\x00\xee\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa8\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x93\x00\xec\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x93\x00\x6e\x03\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x03\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x00\x03\x11\x00\x00\x00\x80\x00\x81\x00\xa8\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x6e\x03\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\xef\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\xd6\x01\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\xaa\x01\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\xa4\x01\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x86\x02\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x0b\x04\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x0a\x04\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\xf8\x03\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\xa2\x03\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x58\x04\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x4e\x04\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x40\x04\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x3e\x04\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x04\x05\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\xde\x04\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x59\x05\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x27\x05\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x26\x05\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x25\x05\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x9c\x05\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\xac\x05\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xa7\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x95\x00\xa7\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\xdd\x01\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x95\x00\x7a\x02\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\x00\x00\x00\x00\x95\x00\x00\x00\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x79\x02\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\xa8\x00\xa6\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x95\x00\x78\x02\x96\x00\x00\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa8\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x16\x00\x17\x00\x18\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x14\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x02\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa8\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x3a\x02\x3b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x86\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x13\x00\x8b\x00\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x8d\x00\x00\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x2e\x00\x91\x00\x92\x00\x93\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x02\x13\x00\xf1\x01\x00\x00\xf2\x01\x00\x00\x8c\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\xf3\x01\x00\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x00\x00\x91\x00\x15\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x05\x03\x06\x03\x00\x00\x07\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x03\x06\x03\x00\x00\x07\x03\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x03\x11\x00\x13\x00\x80\x00\x81\x00\xb8\x04\xb9\x04\xa6\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x03\xba\x04\x00\x00\x00\x00\x15\x00\x00\x00\xbb\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xbc\x04\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\xb8\x04\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xed\x05\x00\x00\x00\x00\x15\x00\x00\x00\xbb\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xee\x05\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xbd\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbd\x04\x13\x00\x00\x00\x00\x00\xb8\x04\x00\x00\x00\x00\xef\x05\x14\x00\x00\x00\x2d\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x69\x00\x00\x00\xed\x05\x00\x00\x00\x00\x15\x00\x00\x00\xbb\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\xee\x05\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\xb8\x04\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\xbb\x04\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\xbd\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x69\x00\x14\x00\x00\x00\x00\x00\x00\x00\x6f\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xbd\x04\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x2d\x00\x65\x00\x00\x00\x00\x00\x2e\x00\x69\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x8b\x00\xf2\xfd\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\xf2\xfd\x2e\x00\x91\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x8f\x01\x00\x00\xf2\xfd\x14\x00\xf2\xfd\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf2\xfd\xf2\xfd\x00\x00\x15\x00\xf2\xfd\xf2\xfd\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x8b\x00\x14\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x15\x00\x2e\x00\x91\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\xf1\x01\x00\x00\xf2\x01\x14\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x15\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x2e\x00\x91\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x91\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x64\x00\x65\x00\x00\x00\x00\x00\x00\x00\x69\x00\x00\x00\x00\x00\x00\x00\x15\x00\x84\x02\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x85\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x01\x00\x00\x00\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x88\x00\x00\x00\x00\x00\x00\x00\x00\x00\x89\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x13\x00\x8b\x01\x7f\x01\x8c\x00\x00\x00\x00\x00\x00\x00\x14\x00\x80\x01\x00\x00\x00\x00\x2d\x00\x8e\x00\x8f\x00\x90\x00\x00\x00\x2a\x01\x00\x00\x00\x00\x15\x00\x00\x00\x2b\x01\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x2c\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x8b\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x3d\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x2c\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x8b\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x8a\x00\x00\x00\x2c\x01\x00\x00\x8c\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x13\x02\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x14\x02\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x64\x00\x12\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x02\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x02\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x14\x02\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x64\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x14\x02\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf4\xfe\x15\x00\x00\x00\x00\x00\x00\x00\xf4\xfe\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x37\x03\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x00\x00\xcd\x02\x00\x00\x00\x00\x2d\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xd1\x03\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xd1\x03\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x08\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\xd1\x03\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x13\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x13\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x14\x00\x00\x00\xc2\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7c\x04\x16\x00\x17\x00\x18\x00\x53\x00\x54\x00\x55\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x23\x00\xc3\x01\xc4\x01\xc5\x01\x00\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xa9\x01\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x64\x00\x4b\x03\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xec\x02\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc2\x01\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc3\x01\x9d\x02\xc5\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xd1\x03\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\xca\x03\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\x96\x04\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\x43\x05\x00\x00\x96\x00\x00\x00\x00\x00\x98\x00\x99\x00\x9a\x00\x9b\x00\xa2\x00\xa3\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xe9\x03\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\xea\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa4\x00\x75\x00\xa6\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\xdb\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x93\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcd\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x01\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xc0\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\x01\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x93\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x01\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x4a\x03\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x49\x03\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x93\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdb\x01\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x93\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x02\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xb9\x03\x9a\x00\x9b\x00\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x93\x00\x00\x00\x00\x00\x00\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x03\x9a\x00\x9b\x00\xa4\x00\x75\x00\x9c\x00\x9d\x00\x93\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x01\x00\x00\x00\x00\x9c\x00\x9d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\xa2\x00\xa3\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\xa2\x00\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x00\x75\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x00\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\xa3\x01\x00\x00\x0f\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x80\x00\x81\x00\x00\x00\x00\x00\xa6\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (13, 906) [ + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39), + (40 , happyReduce_40), + (41 , happyReduce_41), + (42 , happyReduce_42), + (43 , happyReduce_43), + (44 , happyReduce_44), + (45 , happyReduce_45), + (46 , happyReduce_46), + (47 , happyReduce_47), + (48 , happyReduce_48), + (49 , happyReduce_49), + (50 , happyReduce_50), + (51 , happyReduce_51), + (52 , happyReduce_52), + (53 , happyReduce_53), + (54 , happyReduce_54), + (55 , happyReduce_55), + (56 , happyReduce_56), + (57 , happyReduce_57), + (58 , happyReduce_58), + (59 , happyReduce_59), + (60 , happyReduce_60), + (61 , happyReduce_61), + (62 , happyReduce_62), + (63 , happyReduce_63), + (64 , happyReduce_64), + (65 , happyReduce_65), + (66 , happyReduce_66), + (67 , happyReduce_67), + (68 , happyReduce_68), + (69 , happyReduce_69), + (70 , happyReduce_70), + (71 , happyReduce_71), + (72 , happyReduce_72), + (73 , happyReduce_73), + (74 , happyReduce_74), + (75 , happyReduce_75), + (76 , happyReduce_76), + (77 , happyReduce_77), + (78 , happyReduce_78), + (79 , happyReduce_79), + (80 , happyReduce_80), + (81 , happyReduce_81), + (82 , happyReduce_82), + (83 , happyReduce_83), + (84 , happyReduce_84), + (85 , happyReduce_85), + (86 , happyReduce_86), + (87 , happyReduce_87), + (88 , happyReduce_88), + (89 , happyReduce_89), + (90 , happyReduce_90), + (91 , happyReduce_91), + (92 , happyReduce_92), + (93 , happyReduce_93), + (94 , happyReduce_94), + (95 , happyReduce_95), + (96 , happyReduce_96), + (97 , happyReduce_97), + (98 , happyReduce_98), + (99 , happyReduce_99), + (100 , happyReduce_100), + (101 , happyReduce_101), + (102 , happyReduce_102), + (103 , happyReduce_103), + (104 , happyReduce_104), + (105 , happyReduce_105), + (106 , happyReduce_106), + (107 , happyReduce_107), + (108 , happyReduce_108), + (109 , happyReduce_109), + (110 , happyReduce_110), + (111 , happyReduce_111), + (112 , happyReduce_112), + (113 , happyReduce_113), + (114 , happyReduce_114), + (115 , happyReduce_115), + (116 , happyReduce_116), + (117 , happyReduce_117), + (118 , happyReduce_118), + (119 , happyReduce_119), + (120 , happyReduce_120), + (121 , happyReduce_121), + (122 , happyReduce_122), + (123 , happyReduce_123), + (124 , happyReduce_124), + (125 , happyReduce_125), + (126 , happyReduce_126), + (127 , happyReduce_127), + (128 , happyReduce_128), + (129 , happyReduce_129), + (130 , happyReduce_130), + (131 , happyReduce_131), + (132 , happyReduce_132), + (133 , happyReduce_133), + (134 , happyReduce_134), + (135 , happyReduce_135), + (136 , happyReduce_136), + (137 , happyReduce_137), + (138 , happyReduce_138), + (139 , happyReduce_139), + (140 , happyReduce_140), + (141 , happyReduce_141), + (142 , happyReduce_142), + (143 , happyReduce_143), + (144 , happyReduce_144), + (145 , happyReduce_145), + (146 , happyReduce_146), + (147 , happyReduce_147), + (148 , happyReduce_148), + (149 , happyReduce_149), + (150 , happyReduce_150), + (151 , happyReduce_151), + (152 , happyReduce_152), + (153 , happyReduce_153), + (154 , happyReduce_154), + (155 , happyReduce_155), + (156 , happyReduce_156), + (157 , happyReduce_157), + (158 , happyReduce_158), + (159 , happyReduce_159), + (160 , happyReduce_160), + (161 , happyReduce_161), + (162 , happyReduce_162), + (163 , happyReduce_163), + (164 , happyReduce_164), + (165 , happyReduce_165), + (166 , happyReduce_166), + (167 , happyReduce_167), + (168 , happyReduce_168), + (169 , happyReduce_169), + (170 , happyReduce_170), + (171 , happyReduce_171), + (172 , happyReduce_172), + (173 , happyReduce_173), + (174 , happyReduce_174), + (175 , happyReduce_175), + (176 , happyReduce_176), + (177 , happyReduce_177), + (178 , happyReduce_178), + (179 , happyReduce_179), + (180 , happyReduce_180), + (181 , happyReduce_181), + (182 , happyReduce_182), + (183 , happyReduce_183), + (184 , happyReduce_184), + (185 , happyReduce_185), + (186 , happyReduce_186), + (187 , happyReduce_187), + (188 , happyReduce_188), + (189 , happyReduce_189), + (190 , happyReduce_190), + (191 , happyReduce_191), + (192 , happyReduce_192), + (193 , happyReduce_193), + (194 , happyReduce_194), + (195 , happyReduce_195), + (196 , happyReduce_196), + (197 , happyReduce_197), + (198 , happyReduce_198), + (199 , happyReduce_199), + (200 , happyReduce_200), + (201 , happyReduce_201), + (202 , happyReduce_202), + (203 , happyReduce_203), + (204 , happyReduce_204), + (205 , happyReduce_205), + (206 , happyReduce_206), + (207 , happyReduce_207), + (208 , happyReduce_208), + (209 , happyReduce_209), + (210 , happyReduce_210), + (211 , happyReduce_211), + (212 , happyReduce_212), + (213 , happyReduce_213), + (214 , happyReduce_214), + (215 , happyReduce_215), + (216 , happyReduce_216), + (217 , happyReduce_217), + (218 , happyReduce_218), + (219 , happyReduce_219), + (220 , happyReduce_220), + (221 , happyReduce_221), + (222 , happyReduce_222), + (223 , happyReduce_223), + (224 , happyReduce_224), + (225 , happyReduce_225), + (226 , happyReduce_226), + (227 , happyReduce_227), + (228 , happyReduce_228), + (229 , happyReduce_229), + (230 , happyReduce_230), + (231 , happyReduce_231), + (232 , happyReduce_232), + (233 , happyReduce_233), + (234 , happyReduce_234), + (235 , happyReduce_235), + (236 , happyReduce_236), + (237 , happyReduce_237), + (238 , happyReduce_238), + (239 , happyReduce_239), + (240 , happyReduce_240), + (241 , happyReduce_241), + (242 , happyReduce_242), + (243 , happyReduce_243), + (244 , happyReduce_244), + (245 , happyReduce_245), + (246 , happyReduce_246), + (247 , happyReduce_247), + (248 , happyReduce_248), + (249 , happyReduce_249), + (250 , happyReduce_250), + (251 , happyReduce_251), + (252 , happyReduce_252), + (253 , happyReduce_253), + (254 , happyReduce_254), + (255 , happyReduce_255), + (256 , happyReduce_256), + (257 , happyReduce_257), + (258 , happyReduce_258), + (259 , happyReduce_259), + (260 , happyReduce_260), + (261 , happyReduce_261), + (262 , happyReduce_262), + (263 , happyReduce_263), + (264 , happyReduce_264), + (265 , happyReduce_265), + (266 , happyReduce_266), + (267 , happyReduce_267), + (268 , happyReduce_268), + (269 , happyReduce_269), + (270 , happyReduce_270), + (271 , happyReduce_271), + (272 , happyReduce_272), + (273 , happyReduce_273), + (274 , happyReduce_274), + (275 , happyReduce_275), + (276 , happyReduce_276), + (277 , happyReduce_277), + (278 , happyReduce_278), + (279 , happyReduce_279), + (280 , happyReduce_280), + (281 , happyReduce_281), + (282 , happyReduce_282), + (283 , happyReduce_283), + (284 , happyReduce_284), + (285 , happyReduce_285), + (286 , happyReduce_286), + (287 , happyReduce_287), + (288 , happyReduce_288), + (289 , happyReduce_289), + (290 , happyReduce_290), + (291 , happyReduce_291), + (292 , happyReduce_292), + (293 , happyReduce_293), + (294 , happyReduce_294), + (295 , happyReduce_295), + (296 , happyReduce_296), + (297 , happyReduce_297), + (298 , happyReduce_298), + (299 , happyReduce_299), + (300 , happyReduce_300), + (301 , happyReduce_301), + (302 , happyReduce_302), + (303 , happyReduce_303), + (304 , happyReduce_304), + (305 , happyReduce_305), + (306 , happyReduce_306), + (307 , happyReduce_307), + (308 , happyReduce_308), + (309 , happyReduce_309), + (310 , happyReduce_310), + (311 , happyReduce_311), + (312 , happyReduce_312), + (313 , happyReduce_313), + (314 , happyReduce_314), + (315 , happyReduce_315), + (316 , happyReduce_316), + (317 , happyReduce_317), + (318 , happyReduce_318), + (319 , happyReduce_319), + (320 , happyReduce_320), + (321 , happyReduce_321), + (322 , happyReduce_322), + (323 , happyReduce_323), + (324 , happyReduce_324), + (325 , happyReduce_325), + (326 , happyReduce_326), + (327 , happyReduce_327), + (328 , happyReduce_328), + (329 , happyReduce_329), + (330 , happyReduce_330), + (331 , happyReduce_331), + (332 , happyReduce_332), + (333 , happyReduce_333), + (334 , happyReduce_334), + (335 , happyReduce_335), + (336 , happyReduce_336), + (337 , happyReduce_337), + (338 , happyReduce_338), + (339 , happyReduce_339), + (340 , happyReduce_340), + (341 , happyReduce_341), + (342 , happyReduce_342), + (343 , happyReduce_343), + (344 , happyReduce_344), + (345 , happyReduce_345), + (346 , happyReduce_346), + (347 , happyReduce_347), + (348 , happyReduce_348), + (349 , happyReduce_349), + (350 , happyReduce_350), + (351 , happyReduce_351), + (352 , happyReduce_352), + (353 , happyReduce_353), + (354 , happyReduce_354), + (355 , happyReduce_355), + (356 , happyReduce_356), + (357 , happyReduce_357), + (358 , happyReduce_358), + (359 , happyReduce_359), + (360 , happyReduce_360), + (361 , happyReduce_361), + (362 , happyReduce_362), + (363 , happyReduce_363), + (364 , happyReduce_364), + (365 , happyReduce_365), + (366 , happyReduce_366), + (367 , happyReduce_367), + (368 , happyReduce_368), + (369 , happyReduce_369), + (370 , happyReduce_370), + (371 , happyReduce_371), + (372 , happyReduce_372), + (373 , happyReduce_373), + (374 , happyReduce_374), + (375 , happyReduce_375), + (376 , happyReduce_376), + (377 , happyReduce_377), + (378 , happyReduce_378), + (379 , happyReduce_379), + (380 , happyReduce_380), + (381 , happyReduce_381), + (382 , happyReduce_382), + (383 , happyReduce_383), + (384 , happyReduce_384), + (385 , happyReduce_385), + (386 , happyReduce_386), + (387 , happyReduce_387), + (388 , happyReduce_388), + (389 , happyReduce_389), + (390 , happyReduce_390), + (391 , happyReduce_391), + (392 , happyReduce_392), + (393 , happyReduce_393), + (394 , happyReduce_394), + (395 , happyReduce_395), + (396 , happyReduce_396), + (397 , happyReduce_397), + (398 , happyReduce_398), + (399 , happyReduce_399), + (400 , happyReduce_400), + (401 , happyReduce_401), + (402 , happyReduce_402), + (403 , happyReduce_403), + (404 , happyReduce_404), + (405 , happyReduce_405), + (406 , happyReduce_406), + (407 , happyReduce_407), + (408 , happyReduce_408), + (409 , happyReduce_409), + (410 , happyReduce_410), + (411 , happyReduce_411), + (412 , happyReduce_412), + (413 , happyReduce_413), + (414 , happyReduce_414), + (415 , happyReduce_415), + (416 , happyReduce_416), + (417 , happyReduce_417), + (418 , happyReduce_418), + (419 , happyReduce_419), + (420 , happyReduce_420), + (421 , happyReduce_421), + (422 , happyReduce_422), + (423 , happyReduce_423), + (424 , happyReduce_424), + (425 , happyReduce_425), + (426 , happyReduce_426), + (427 , happyReduce_427), + (428 , happyReduce_428), + (429 , happyReduce_429), + (430 , happyReduce_430), + (431 , happyReduce_431), + (432 , happyReduce_432), + (433 , happyReduce_433), + (434 , happyReduce_434), + (435 , happyReduce_435), + (436 , happyReduce_436), + (437 , happyReduce_437), + (438 , happyReduce_438), + (439 , happyReduce_439), + (440 , happyReduce_440), + (441 , happyReduce_441), + (442 , happyReduce_442), + (443 , happyReduce_443), + (444 , happyReduce_444), + (445 , happyReduce_445), + (446 , happyReduce_446), + (447 , happyReduce_447), + (448 , happyReduce_448), + (449 , happyReduce_449), + (450 , happyReduce_450), + (451 , happyReduce_451), + (452 , happyReduce_452), + (453 , happyReduce_453), + (454 , happyReduce_454), + (455 , happyReduce_455), + (456 , happyReduce_456), + (457 , happyReduce_457), + (458 , happyReduce_458), + (459 , happyReduce_459), + (460 , happyReduce_460), + (461 , happyReduce_461), + (462 , happyReduce_462), + (463 , happyReduce_463), + (464 , happyReduce_464), + (465 , happyReduce_465), + (466 , happyReduce_466), + (467 , happyReduce_467), + (468 , happyReduce_468), + (469 , happyReduce_469), + (470 , happyReduce_470), + (471 , happyReduce_471), + (472 , happyReduce_472), + (473 , happyReduce_473), + (474 , happyReduce_474), + (475 , happyReduce_475), + (476 , happyReduce_476), + (477 , happyReduce_477), + (478 , happyReduce_478), + (479 , happyReduce_479), + (480 , happyReduce_480), + (481 , happyReduce_481), + (482 , happyReduce_482), + (483 , happyReduce_483), + (484 , happyReduce_484), + (485 , happyReduce_485), + (486 , happyReduce_486), + (487 , happyReduce_487), + (488 , happyReduce_488), + (489 , happyReduce_489), + (490 , happyReduce_490), + (491 , happyReduce_491), + (492 , happyReduce_492), + (493 , happyReduce_493), + (494 , happyReduce_494), + (495 , happyReduce_495), + (496 , happyReduce_496), + (497 , happyReduce_497), + (498 , happyReduce_498), + (499 , happyReduce_499), + (500 , happyReduce_500), + (501 , happyReduce_501), + (502 , happyReduce_502), + (503 , happyReduce_503), + (504 , happyReduce_504), + (505 , happyReduce_505), + (506 , happyReduce_506), + (507 , happyReduce_507), + (508 , happyReduce_508), + (509 , happyReduce_509), + (510 , happyReduce_510), + (511 , happyReduce_511), + (512 , happyReduce_512), + (513 , happyReduce_513), + (514 , happyReduce_514), + (515 , happyReduce_515), + (516 , happyReduce_516), + (517 , happyReduce_517), + (518 , happyReduce_518), + (519 , happyReduce_519), + (520 , happyReduce_520), + (521 , happyReduce_521), + (522 , happyReduce_522), + (523 , happyReduce_523), + (524 , happyReduce_524), + (525 , happyReduce_525), + (526 , happyReduce_526), + (527 , happyReduce_527), + (528 , happyReduce_528), + (529 , happyReduce_529), + (530 , happyReduce_530), + (531 , happyReduce_531), + (532 , happyReduce_532), + (533 , happyReduce_533), + (534 , happyReduce_534), + (535 , happyReduce_535), + (536 , happyReduce_536), + (537 , happyReduce_537), + (538 , happyReduce_538), + (539 , happyReduce_539), + (540 , happyReduce_540), + (541 , happyReduce_541), + (542 , happyReduce_542), + (543 , happyReduce_543), + (544 , happyReduce_544), + (545 , happyReduce_545), + (546 , happyReduce_546), + (547 , happyReduce_547), + (548 , happyReduce_548), + (549 , happyReduce_549), + (550 , happyReduce_550), + (551 , happyReduce_551), + (552 , happyReduce_552), + (553 , happyReduce_553), + (554 , happyReduce_554), + (555 , happyReduce_555), + (556 , happyReduce_556), + (557 , happyReduce_557), + (558 , happyReduce_558), + (559 , happyReduce_559), + (560 , happyReduce_560), + (561 , happyReduce_561), + (562 , happyReduce_562), + (563 , happyReduce_563), + (564 , happyReduce_564), + (565 , happyReduce_565), + (566 , happyReduce_566), + (567 , happyReduce_567), + (568 , happyReduce_568), + (569 , happyReduce_569), + (570 , happyReduce_570), + (571 , happyReduce_571), + (572 , happyReduce_572), + (573 , happyReduce_573), + (574 , happyReduce_574), + (575 , happyReduce_575), + (576 , happyReduce_576), + (577 , happyReduce_577), + (578 , happyReduce_578), + (579 , happyReduce_579), + (580 , happyReduce_580), + (581 , happyReduce_581), + (582 , happyReduce_582), + (583 , happyReduce_583), + (584 , happyReduce_584), + (585 , happyReduce_585), + (586 , happyReduce_586), + (587 , happyReduce_587), + (588 , happyReduce_588), + (589 , happyReduce_589), + (590 , happyReduce_590), + (591 , happyReduce_591), + (592 , happyReduce_592), + (593 , happyReduce_593), + (594 , happyReduce_594), + (595 , happyReduce_595), + (596 , happyReduce_596), + (597 , happyReduce_597), + (598 , happyReduce_598), + (599 , happyReduce_599), + (600 , happyReduce_600), + (601 , happyReduce_601), + (602 , happyReduce_602), + (603 , happyReduce_603), + (604 , happyReduce_604), + (605 , happyReduce_605), + (606 , happyReduce_606), + (607 , happyReduce_607), + (608 , happyReduce_608), + (609 , happyReduce_609), + (610 , happyReduce_610), + (611 , happyReduce_611), + (612 , happyReduce_612), + (613 , happyReduce_613), + (614 , happyReduce_614), + (615 , happyReduce_615), + (616 , happyReduce_616), + (617 , happyReduce_617), + (618 , happyReduce_618), + (619 , happyReduce_619), + (620 , happyReduce_620), + (621 , happyReduce_621), + (622 , happyReduce_622), + (623 , happyReduce_623), + (624 , happyReduce_624), + (625 , happyReduce_625), + (626 , happyReduce_626), + (627 , happyReduce_627), + (628 , happyReduce_628), + (629 , happyReduce_629), + (630 , happyReduce_630), + (631 , happyReduce_631), + (632 , happyReduce_632), + (633 , happyReduce_633), + (634 , happyReduce_634), + (635 , happyReduce_635), + (636 , happyReduce_636), + (637 , happyReduce_637), + (638 , happyReduce_638), + (639 , happyReduce_639), + (640 , happyReduce_640), + (641 , happyReduce_641), + (642 , happyReduce_642), + (643 , happyReduce_643), + (644 , happyReduce_644), + (645 , happyReduce_645), + (646 , happyReduce_646), + (647 , happyReduce_647), + (648 , happyReduce_648), + (649 , happyReduce_649), + (650 , happyReduce_650), + (651 , happyReduce_651), + (652 , happyReduce_652), + (653 , happyReduce_653), + (654 , happyReduce_654), + (655 , happyReduce_655), + (656 , happyReduce_656), + (657 , happyReduce_657), + (658 , happyReduce_658), + (659 , happyReduce_659), + (660 , happyReduce_660), + (661 , happyReduce_661), + (662 , happyReduce_662), + (663 , happyReduce_663), + (664 , happyReduce_664), + (665 , happyReduce_665), + (666 , happyReduce_666), + (667 , happyReduce_667), + (668 , happyReduce_668), + (669 , happyReduce_669), + (670 , happyReduce_670), + (671 , happyReduce_671), + (672 , happyReduce_672), + (673 , happyReduce_673), + (674 , happyReduce_674), + (675 , happyReduce_675), + (676 , happyReduce_676), + (677 , happyReduce_677), + (678 , happyReduce_678), + (679 , happyReduce_679), + (680 , happyReduce_680), + (681 , happyReduce_681), + (682 , happyReduce_682), + (683 , happyReduce_683), + (684 , happyReduce_684), + (685 , happyReduce_685), + (686 , happyReduce_686), + (687 , happyReduce_687), + (688 , happyReduce_688), + (689 , happyReduce_689), + (690 , happyReduce_690), + (691 , happyReduce_691), + (692 , happyReduce_692), + (693 , happyReduce_693), + (694 , happyReduce_694), + (695 , happyReduce_695), + (696 , happyReduce_696), + (697 , happyReduce_697), + (698 , happyReduce_698), + (699 , happyReduce_699), + (700 , happyReduce_700), + (701 , happyReduce_701), + (702 , happyReduce_702), + (703 , happyReduce_703), + (704 , happyReduce_704), + (705 , happyReduce_705), + (706 , happyReduce_706), + (707 , happyReduce_707), + (708 , happyReduce_708), + (709 , happyReduce_709), + (710 , happyReduce_710), + (711 , happyReduce_711), + (712 , happyReduce_712), + (713 , happyReduce_713), + (714 , happyReduce_714), + (715 , happyReduce_715), + (716 , happyReduce_716), + (717 , happyReduce_717), + (718 , happyReduce_718), + (719 , happyReduce_719), + (720 , happyReduce_720), + (721 , happyReduce_721), + (722 , happyReduce_722), + (723 , happyReduce_723), + (724 , happyReduce_724), + (725 , happyReduce_725), + (726 , happyReduce_726), + (727 , happyReduce_727), + (728 , happyReduce_728), + (729 , happyReduce_729), + (730 , happyReduce_730), + (731 , happyReduce_731), + (732 , happyReduce_732), + (733 , happyReduce_733), + (734 , happyReduce_734), + (735 , happyReduce_735), + (736 , happyReduce_736), + (737 , happyReduce_737), + (738 , happyReduce_738), + (739 , happyReduce_739), + (740 , happyReduce_740), + (741 , happyReduce_741), + (742 , happyReduce_742), + (743 , happyReduce_743), + (744 , happyReduce_744), + (745 , happyReduce_745), + (746 , happyReduce_746), + (747 , happyReduce_747), + (748 , happyReduce_748), + (749 , happyReduce_749), + (750 , happyReduce_750), + (751 , happyReduce_751), + (752 , happyReduce_752), + (753 , happyReduce_753), + (754 , happyReduce_754), + (755 , happyReduce_755), + (756 , happyReduce_756), + (757 , happyReduce_757), + (758 , happyReduce_758), + (759 , happyReduce_759), + (760 , happyReduce_760), + (761 , happyReduce_761), + (762 , happyReduce_762), + (763 , happyReduce_763), + (764 , happyReduce_764), + (765 , happyReduce_765), + (766 , happyReduce_766), + (767 , happyReduce_767), + (768 , happyReduce_768), + (769 , happyReduce_769), + (770 , happyReduce_770), + (771 , happyReduce_771), + (772 , happyReduce_772), + (773 , happyReduce_773), + (774 , happyReduce_774), + (775 , happyReduce_775), + (776 , happyReduce_776), + (777 , happyReduce_777), + (778 , happyReduce_778), + (779 , happyReduce_779), + (780 , happyReduce_780), + (781 , happyReduce_781), + (782 , happyReduce_782), + (783 , happyReduce_783), + (784 , happyReduce_784), + (785 , happyReduce_785), + (786 , happyReduce_786), + (787 , happyReduce_787), + (788 , happyReduce_788), + (789 , happyReduce_789), + (790 , happyReduce_790), + (791 , happyReduce_791), + (792 , happyReduce_792), + (793 , happyReduce_793), + (794 , happyReduce_794), + (795 , happyReduce_795), + (796 , happyReduce_796), + (797 , happyReduce_797), + (798 , happyReduce_798), + (799 , happyReduce_799), + (800 , happyReduce_800), + (801 , happyReduce_801), + (802 , happyReduce_802), + (803 , happyReduce_803), + (804 , happyReduce_804), + (805 , happyReduce_805), + (806 , happyReduce_806), + (807 , happyReduce_807), + (808 , happyReduce_808), + (809 , happyReduce_809), + (810 , happyReduce_810), + (811 , happyReduce_811), + (812 , happyReduce_812), + (813 , happyReduce_813), + (814 , happyReduce_814), + (815 , happyReduce_815), + (816 , happyReduce_816), + (817 , happyReduce_817), + (818 , happyReduce_818), + (819 , happyReduce_819), + (820 , happyReduce_820), + (821 , happyReduce_821), + (822 , happyReduce_822), + (823 , happyReduce_823), + (824 , happyReduce_824), + (825 , happyReduce_825), + (826 , happyReduce_826), + (827 , happyReduce_827), + (828 , happyReduce_828), + (829 , happyReduce_829), + (830 , happyReduce_830), + (831 , happyReduce_831), + (832 , happyReduce_832), + (833 , happyReduce_833), + (834 , happyReduce_834), + (835 , happyReduce_835), + (836 , happyReduce_836), + (837 , happyReduce_837), + (838 , happyReduce_838), + (839 , happyReduce_839), + (840 , happyReduce_840), + (841 , happyReduce_841), + (842 , happyReduce_842), + (843 , happyReduce_843), + (844 , happyReduce_844), + (845 , happyReduce_845), + (846 , happyReduce_846), + (847 , happyReduce_847), + (848 , happyReduce_848), + (849 , happyReduce_849), + (850 , happyReduce_850), + (851 , happyReduce_851), + (852 , happyReduce_852), + (853 , happyReduce_853), + (854 , happyReduce_854), + (855 , happyReduce_855), + (856 , happyReduce_856), + (857 , happyReduce_857), + (858 , happyReduce_858), + (859 , happyReduce_859), + (860 , happyReduce_860), + (861 , happyReduce_861), + (862 , happyReduce_862), + (863 , happyReduce_863), + (864 , happyReduce_864), + (865 , happyReduce_865), + (866 , happyReduce_866), + (867 , happyReduce_867), + (868 , happyReduce_868), + (869 , happyReduce_869), + (870 , happyReduce_870), + (871 , happyReduce_871), + (872 , happyReduce_872), + (873 , happyReduce_873), + (874 , happyReduce_874), + (875 , happyReduce_875), + (876 , happyReduce_876), + (877 , happyReduce_877), + (878 , happyReduce_878), + (879 , happyReduce_879), + (880 , happyReduce_880), + (881 , happyReduce_881), + (882 , happyReduce_882), + (883 , happyReduce_883), + (884 , happyReduce_884), + (885 , happyReduce_885), + (886 , happyReduce_886), + (887 , happyReduce_887), + (888 , happyReduce_888), + (889 , happyReduce_889), + (890 , happyReduce_890), + (891 , happyReduce_891), + (892 , happyReduce_892), + (893 , happyReduce_893), + (894 , happyReduce_894), + (895 , happyReduce_895), + (896 , happyReduce_896), + (897 , happyReduce_897), + (898 , happyReduce_898), + (899 , happyReduce_899), + (900 , happyReduce_900), + (901 , happyReduce_901), + (902 , happyReduce_902), + (903 , happyReduce_903), + (904 , happyReduce_904), + (905 , happyReduce_905), + (906 , happyReduce_906) + ] + +happy_n_terms = 162 :: Prelude.Int +happy_n_nonterms = 337 :: Prelude.Int + +happyReduce_13 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_13 = happySpecReduce_1 0# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + happyIn16 + (happy_var_1 + )} + +happyReduce_14 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_14 = happySpecReduce_1 0# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> + happyIn16 + (happy_var_1 + )} + +happyReduce_15 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_15 = happySpecReduce_1 0# happyReduction_15 +happyReduction_15 happy_x_1 + = case happyOut311 happy_x_1 of { (HappyWrap311 happy_var_1) -> + happyIn16 + (happy_var_1 + )} + +happyReduce_16 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_16 = happySpecReduce_1 0# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOut295 happy_x_1 of { (HappyWrap295 happy_var_1) -> + happyIn16 + (happy_var_1 + )} + +happyReduce_17 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_17 = happyMonadReduce 1# 0# happyReduction_17 +happyReduction_17 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( amsr (sLL happy_var_1 happy_var_1 $ getRdrName unrestrictedFunTyCon) + (NameAnnRArrow Nothing (epUniTok happy_var_1) Nothing []))}) + ) (\r -> happyReturn (happyIn16 r)) + +happyReduce_18 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_18 = happySpecReduce_3 1# happyReduction_18 +happyReduction_18 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut18 happy_x_2 of { (HappyWrap18 happy_var_2) -> + happyIn17 + (fromOL happy_var_2 + )} + +happyReduce_19 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_19 = happySpecReduce_3 1# happyReduction_19 +happyReduction_19 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut18 happy_x_2 of { (HappyWrap18 happy_var_2) -> + happyIn17 + (fromOL happy_var_2 + )} + +happyReduce_20 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_20 = happySpecReduce_3 2# happyReduction_20 +happyReduction_20 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut18 happy_x_1 of { (HappyWrap18 happy_var_1) -> + case happyOut19 happy_x_3 of { (HappyWrap19 happy_var_3) -> + happyIn18 + (happy_var_1 `appOL` unitOL happy_var_3 + )}} + +happyReduce_21 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_21 = happySpecReduce_2 2# happyReduction_21 +happyReduction_21 happy_x_2 + happy_x_1 + = case happyOut18 happy_x_1 of { (HappyWrap18 happy_var_1) -> + happyIn18 + (happy_var_1 + )} + +happyReduce_22 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_22 = happySpecReduce_1 2# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut19 happy_x_1 of { (HappyWrap19 happy_var_1) -> + happyIn18 + (unitOL happy_var_1 + )} + +happyReduce_23 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_23 = happyReduce 4# 3# happyReduction_23 +happyReduction_23 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut24 happy_x_2 of { (HappyWrap24 happy_var_2) -> + case happyOut31 happy_x_4 of { (HappyWrap31 happy_var_4) -> + happyIn19 + (sL1 happy_var_1 $ HsUnit { hsunitName = happy_var_2 + , hsunitBody = fromOL happy_var_4 } + ) `HappyStk` happyRest}}} + +happyReduce_24 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_24 = happySpecReduce_1 4# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOut24 happy_x_1 of { (HappyWrap24 happy_var_1) -> + happyIn20 + (sL1 happy_var_1 $ HsUnitId happy_var_1 [] + )} + +happyReduce_25 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_25 = happyReduce 4# 4# happyReduction_25 +happyReduction_25 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut24 happy_x_1 of { (HappyWrap24 happy_var_1) -> + case happyOut21 happy_x_3 of { (HappyWrap21 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn20 + (sLL happy_var_1 happy_var_4 $ HsUnitId happy_var_1 (fromOL happy_var_3) + ) `HappyStk` happyRest}}} + +happyReduce_26 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_26 = happySpecReduce_3 5# happyReduction_26 +happyReduction_26 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { (HappyWrap21 happy_var_1) -> + case happyOut22 happy_x_3 of { (HappyWrap22 happy_var_3) -> + happyIn21 + (happy_var_1 `appOL` unitOL happy_var_3 + )}} + +happyReduce_27 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_27 = happySpecReduce_2 5# happyReduction_27 +happyReduction_27 happy_x_2 + happy_x_1 + = case happyOut21 happy_x_1 of { (HappyWrap21 happy_var_1) -> + happyIn21 + (happy_var_1 + )} + +happyReduce_28 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_28 = happySpecReduce_1 5# happyReduction_28 +happyReduction_28 happy_x_1 + = case happyOut22 happy_x_1 of { (HappyWrap22 happy_var_1) -> + happyIn21 + (unitOL happy_var_1 + )} + +happyReduce_29 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_29 = happySpecReduce_3 6# happyReduction_29 +happyReduction_29 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut334 happy_x_1 of { (HappyWrap334 happy_var_1) -> + case happyOut23 happy_x_3 of { (HappyWrap23 happy_var_3) -> + happyIn22 + (sLL happy_var_1 happy_var_3 $ (reLoc happy_var_1, happy_var_3) + )}} + +happyReduce_30 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_30 = happyReduce 4# 6# happyReduction_30 +happyReduction_30 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut334 happy_x_1 of { (HappyWrap334 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn22 + (sLL happy_var_1 happy_var_4 $ (reLoc happy_var_1, sLL happy_var_2 happy_var_4 $ HsModuleVar (reLoc happy_var_3)) + ) `HappyStk` happyRest}}}} + +happyReduce_31 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_31 = happySpecReduce_3 7# happyReduction_31 +happyReduction_31 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn23 + (sLL happy_var_1 happy_var_3 $ HsModuleVar (reLoc happy_var_2) + )}}} + +happyReduce_32 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_32 = happySpecReduce_3 7# happyReduction_32 +happyReduction_32 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut20 happy_x_1 of { (HappyWrap20 happy_var_1) -> + case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> + happyIn23 + (sLL happy_var_1 happy_var_3 $ HsModuleId happy_var_1 (reLoc happy_var_3) + )}} + +happyReduce_33 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_33 = happySpecReduce_1 8# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn24 + (sL1 happy_var_1 $ PackageName (getSTRING happy_var_1) + )} + +happyReduce_34 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_34 = happySpecReduce_1 8# happyReduction_34 +happyReduction_34 happy_x_1 + = case happyOut27 happy_x_1 of { (HappyWrap27 happy_var_1) -> + happyIn24 + (sL1 happy_var_1 $ PackageName (unLoc happy_var_1) + )} + +happyReduce_35 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_35 = happySpecReduce_1 9# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + (sL1 happy_var_1 $ getVARID happy_var_1 + )} + +happyReduce_36 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_36 = happySpecReduce_1 9# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn25 + (sL1 happy_var_1 $ getCONID happy_var_1 + )} + +happyReduce_37 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_37 = happySpecReduce_1 9# happyReduction_37 +happyReduction_37 happy_x_1 + = case happyOut326 happy_x_1 of { (HappyWrap326 happy_var_1) -> + happyIn25 + (happy_var_1 + )} + +happyReduce_38 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_38 = happySpecReduce_1 10# happyReduction_38 +happyReduction_38 happy_x_1 + = happyIn26 + (() + ) + +happyReduce_39 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_39 = happySpecReduce_1 10# happyReduction_39 +happyReduction_39 happy_x_1 + = happyIn26 + (() + ) + +happyReduce_40 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_40 = happySpecReduce_1 10# happyReduction_40 +happyReduction_40 happy_x_1 + = happyIn26 + (() + ) + +happyReduce_41 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_41 = happySpecReduce_1 11# happyReduction_41 +happyReduction_41 happy_x_1 + = case happyOut25 happy_x_1 of { (HappyWrap25 happy_var_1) -> + happyIn27 + (happy_var_1 + )} + +happyReduce_42 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_42 = happySpecReduce_3 11# happyReduction_42 +happyReduction_42 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut25 happy_x_1 of { (HappyWrap25 happy_var_1) -> + case happyOut27 happy_x_3 of { (HappyWrap27 happy_var_3) -> + happyIn27 + (sLL happy_var_1 happy_var_3 $ concatFS [unLoc happy_var_1, fsLit "-", (unLoc happy_var_3)] + )}} + +happyReduce_43 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_43 = happySpecReduce_0 12# happyReduction_43 +happyReduction_43 = happyIn28 + (Nothing + ) + +happyReduce_44 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_44 = happySpecReduce_3 12# happyReduction_44 +happyReduction_44 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_2 of { (HappyWrap29 happy_var_2) -> + happyIn28 + (Just (fromOL happy_var_2) + )} + +happyReduce_45 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_45 = happySpecReduce_3 13# happyReduction_45 +happyReduction_45 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { (HappyWrap29 happy_var_1) -> + case happyOut30 happy_x_3 of { (HappyWrap30 happy_var_3) -> + happyIn29 + (happy_var_1 `appOL` unitOL happy_var_3 + )}} + +happyReduce_46 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_46 = happySpecReduce_2 13# happyReduction_46 +happyReduction_46 happy_x_2 + happy_x_1 + = case happyOut29 happy_x_1 of { (HappyWrap29 happy_var_1) -> + happyIn29 + (happy_var_1 + )} + +happyReduce_47 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_47 = happySpecReduce_1 13# happyReduction_47 +happyReduction_47 happy_x_1 + = case happyOut30 happy_x_1 of { (HappyWrap30 happy_var_1) -> + happyIn29 + (unitOL happy_var_1 + )} + +happyReduce_48 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_48 = happySpecReduce_3 14# happyReduction_48 +happyReduction_48 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut334 happy_x_1 of { (HappyWrap334 happy_var_1) -> + case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> + happyIn30 + (sLL happy_var_1 happy_var_3 $ Renaming (reLoc happy_var_1) (Just (reLoc happy_var_3)) + )}} + +happyReduce_49 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_49 = happySpecReduce_1 14# happyReduction_49 +happyReduction_49 happy_x_1 + = case happyOut334 happy_x_1 of { (HappyWrap334 happy_var_1) -> + happyIn30 + (sL1 happy_var_1 $ Renaming (reLoc happy_var_1) Nothing + )} + +happyReduce_50 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_50 = happySpecReduce_3 15# happyReduction_50 +happyReduction_50 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut32 happy_x_2 of { (HappyWrap32 happy_var_2) -> + happyIn31 + (happy_var_2 + )} + +happyReduce_51 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_51 = happySpecReduce_3 15# happyReduction_51 +happyReduction_51 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut32 happy_x_2 of { (HappyWrap32 happy_var_2) -> + happyIn31 + (happy_var_2 + )} + +happyReduce_52 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_52 = happySpecReduce_3 16# happyReduction_52 +happyReduction_52 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut32 happy_x_1 of { (HappyWrap32 happy_var_1) -> + case happyOut33 happy_x_3 of { (HappyWrap33 happy_var_3) -> + happyIn32 + (happy_var_1 `appOL` unitOL happy_var_3 + )}} + +happyReduce_53 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_53 = happySpecReduce_2 16# happyReduction_53 +happyReduction_53 happy_x_2 + happy_x_1 + = case happyOut32 happy_x_1 of { (HappyWrap32 happy_var_1) -> + happyIn32 + (happy_var_1 + )} + +happyReduce_54 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_54 = happySpecReduce_1 16# happyReduction_54 +happyReduction_54 happy_x_1 + = case happyOut33 happy_x_1 of { (HappyWrap33 happy_var_1) -> + happyIn32 + (unitOL happy_var_1 + )} + +happyReduce_55 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_55 = happyReduce 7# 17# happyReduction_55 +happyReduction_55 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut63 happy_x_2 of { (HappyWrap63 happy_var_2) -> + case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> + case happyOut146 happy_x_4 of { (HappyWrap146 happy_var_4) -> + case happyOut47 happy_x_5 of { (HappyWrap47 happy_var_5) -> + case happyOut38 happy_x_7 of { (HappyWrap38 happy_var_7) -> + happyIn33 + (sL1 happy_var_1 $ DeclD + (case snd happy_var_2 of + NotBoot -> HsSrcFile + IsBoot -> HsBootFile) + (reLoc happy_var_3) + (sL1 happy_var_1 (HsModule (XModulePs noAnn (thdOf3 happy_var_7) happy_var_4 Nothing) (Just happy_var_3) happy_var_5 (fst $ sndOf3 happy_var_7) (snd $ sndOf3 happy_var_7))) + ) `HappyStk` happyRest}}}}}} + +happyReduce_56 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_56 = happyReduce 6# 17# happyReduction_56 +happyReduction_56 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOut146 happy_x_3 of { (HappyWrap146 happy_var_3) -> + case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> + case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> + happyIn33 + (sL1 happy_var_1 $ DeclD + HsigFile + (reLoc happy_var_2) + (sL1 happy_var_1 (HsModule (XModulePs noAnn (thdOf3 happy_var_6) happy_var_3 Nothing) (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) (snd $ sndOf3 happy_var_6))) + ) `HappyStk` happyRest}}}}} + +happyReduce_57 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_57 = happySpecReduce_3 17# happyReduction_57 +happyReduction_57 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_2 of { (HappyWrap20 happy_var_2) -> + case happyOut28 happy_x_3 of { (HappyWrap28 happy_var_3) -> + happyIn33 + (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_2 + , idModRenaming = happy_var_3 + , idSignatureInclude = False }) + )}}} + +happyReduce_58 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_58 = happySpecReduce_3 17# happyReduction_58 +happyReduction_58 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut20 happy_x_3 of { (HappyWrap20 happy_var_3) -> + happyIn33 + (sL1 happy_var_1 $ IncludeD (IncludeDecl { idUnitId = happy_var_3 + , idModRenaming = Nothing + , idSignatureInclude = True }) + )}} + +happyReduce_59 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_59 = happyMonadReduce 6# 18# happyReduction_59 +happyReduction_59 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOut146 happy_x_3 of { (HappyWrap146 happy_var_3) -> + case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> + ( fileSrcSpan >>= \ loc -> + acs loc (\loc cs-> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule (epTok happy_var_1) NoEpTok (epTok happy_var_5) (fstOf3 happy_var_6) [] Nothing) cs) + (thdOf3 happy_var_6) happy_var_3 Nothing) + (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) + (snd $ sndOf3 happy_var_6))) + ))}}}}}}) + ) (\r -> happyReturn (happyIn34 r)) + +happyReduce_60 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_60 = happyMonadReduce 6# 19# happyReduction_60 +happyReduction_60 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOut146 happy_x_3 of { (HappyWrap146 happy_var_3) -> + case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut38 happy_x_6 of { (HappyWrap38 happy_var_6) -> + ( fileSrcSpan >>= \ loc -> + acsFinal (\cs eof -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) (fstOf3 happy_var_6) [] eof) cs) + (thdOf3 happy_var_6) happy_var_3 Nothing) + (Just happy_var_2) happy_var_4 (fst $ sndOf3 happy_var_6) + (snd $ sndOf3 happy_var_6)) + )))}}}}}}) + ) (\r -> happyReturn (happyIn35 r)) + +happyReduce_61 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_61 = happyMonadReduce 1# 19# happyReduction_61 +happyReduction_61 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut39 happy_x_1 of { (HappyWrap39 happy_var_1) -> + ( fileSrcSpan >>= \ loc -> + acsFinal (\cs eof -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 happy_var_1) [] eof) cs) + (thdOf3 happy_var_1) Nothing Nothing) + Nothing Nothing + (fst $ sndOf3 happy_var_1) (snd $ sndOf3 happy_var_1)))))}) + ) (\r -> happyReturn (happyIn35 r)) + +happyReduce_62 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_62 = happyMonadReduce 0# 20# happyReduction_62 +happyReduction_62 (happyRest) tk + = happyThen ((( pushModuleContext)) + ) (\r -> happyReturn (happyIn36 r)) + +happyReduce_63 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_63 = happyMonadReduce 0# 21# happyReduction_63 +happyReduction_63 (happyRest) tk + = happyThen ((( pushModuleContext)) + ) (\r -> happyReturn (happyIn37 r)) + +happyReduce_64 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_64 = happySpecReduce_3 22# happyReduction_64 +happyReduction_64 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn38 + ((fst happy_var_2, snd happy_var_2, epExplicitBraces happy_var_1 happy_var_3) + )}}} + +happyReduce_65 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_65 = happySpecReduce_3 22# happyReduction_65 +happyReduction_65 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> + happyIn38 + ((fst happy_var_2, snd happy_var_2, EpVirtualBraces (getVOCURLY happy_var_1)) + )}} + +happyReduce_66 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_66 = happySpecReduce_3 23# happyReduction_66 +happyReduction_66 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn39 + ((fst happy_var_2, snd happy_var_2, epExplicitBraces happy_var_1 happy_var_3) + )}}} + +happyReduce_67 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_67 = happySpecReduce_3 23# happyReduction_67 +happyReduction_67 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut40 happy_x_2 of { (HappyWrap40 happy_var_2) -> + happyIn39 + (([], snd happy_var_2, EpVirtualBraces leftmostColumn) + )} + +happyReduce_68 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_68 = happySpecReduce_2 24# happyReduction_68 +happyReduction_68 happy_x_2 + happy_x_1 + = case happyOut59 happy_x_1 of { (HappyWrap59 happy_var_1) -> + case happyOut41 happy_x_2 of { (HappyWrap41 happy_var_2) -> + happyIn40 + ((reverse happy_var_1, happy_var_2) + )}} + +happyReduce_69 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_69 = happySpecReduce_2 25# happyReduction_69 +happyReduction_69 happy_x_2 + happy_x_1 + = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> + case happyOut80 happy_x_2 of { (HappyWrap80 happy_var_2) -> + happyIn41 + ((reverse happy_var_1, cvTopDecls happy_var_2) + )}} + +happyReduce_70 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_70 = happySpecReduce_2 25# happyReduction_70 +happyReduction_70 happy_x_2 + happy_x_1 + = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> + case happyOut79 happy_x_2 of { (HappyWrap79 happy_var_2) -> + happyIn41 + ((reverse happy_var_1, cvTopDecls happy_var_2) + )}} + +happyReduce_71 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_71 = happySpecReduce_1 25# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut60 happy_x_1 of { (HappyWrap60 happy_var_1) -> + happyIn41 + ((reverse happy_var_1, []) + )} + +happyReduce_72 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_72 = happyMonadReduce 6# 26# happyReduction_72 +happyReduction_72 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOut146 happy_x_3 of { (HappyWrap146 happy_var_3) -> + case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut43 happy_x_6 of { (HappyWrap43 happy_var_6) -> + ( fileSrcSpan >>= \ loc -> + acs loc (\loc cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) [] [] Nothing) cs) + EpNoLayout happy_var_3 Nothing) + (Just happy_var_2) happy_var_4 happy_var_6 [] + ))))}}}}}}) + ) (\r -> happyReturn (happyIn42 r)) + +happyReduce_73 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_73 = happyMonadReduce 6# 26# happyReduction_73 +happyReduction_73 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + case happyOut146 happy_x_3 of { (HappyWrap146 happy_var_3) -> + case happyOut47 happy_x_4 of { (HappyWrap47 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut43 happy_x_6 of { (HappyWrap43 happy_var_6) -> + ( fileSrcSpan >>= \ loc -> + acs loc (\loc cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok happy_var_1) (epTok happy_var_5) [] [] Nothing) cs) + EpNoLayout happy_var_3 Nothing) + (Just happy_var_2) happy_var_4 happy_var_6 [] + ))))}}}}}}) + ) (\r -> happyReturn (happyIn42 r)) + +happyReduce_74 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_74 = happyMonadReduce 1# 26# happyReduction_74 +happyReduction_74 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut44 happy_x_1 of { (HappyWrap44 happy_var_1) -> + ( fileSrcSpan >>= \ loc -> + return (L loc (HsModule (XModulePs noAnn EpNoLayout Nothing Nothing) Nothing Nothing happy_var_1 [])))}) + ) (\r -> happyReturn (happyIn42 r)) + +happyReduce_75 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_75 = happySpecReduce_2 27# happyReduction_75 +happyReduction_75 happy_x_2 + happy_x_1 + = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> + happyIn43 + (happy_var_2 + )} + +happyReduce_76 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_76 = happySpecReduce_2 27# happyReduction_76 +happyReduction_76 happy_x_2 + happy_x_1 + = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> + happyIn43 + (happy_var_2 + )} + +happyReduce_77 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_77 = happySpecReduce_2 28# happyReduction_77 +happyReduction_77 happy_x_2 + happy_x_1 + = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> + happyIn44 + (happy_var_2 + )} + +happyReduce_78 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_78 = happySpecReduce_2 28# happyReduction_78 +happyReduction_78 happy_x_2 + happy_x_1 + = case happyOut45 happy_x_2 of { (HappyWrap45 happy_var_2) -> + happyIn44 + (happy_var_2 + )} + +happyReduce_79 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_79 = happySpecReduce_2 29# happyReduction_79 +happyReduction_79 happy_x_2 + happy_x_1 + = case happyOut46 happy_x_2 of { (HappyWrap46 happy_var_2) -> + happyIn45 + (happy_var_2 + )} + +happyReduce_80 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_80 = happySpecReduce_1 30# happyReduction_80 +happyReduction_80 happy_x_1 + = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> + happyIn46 + (happy_var_1 + )} + +happyReduce_81 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_81 = happySpecReduce_1 30# happyReduction_81 +happyReduction_81 happy_x_1 + = case happyOut60 happy_x_1 of { (HappyWrap60 happy_var_1) -> + happyIn46 + (happy_var_1 + )} + +happyReduce_82 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_82 = happyMonadReduce 3# 31# happyReduction_82 +happyReduction_82 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut48 happy_x_2 of { (HappyWrap48 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 (fromOL $ snd happy_var_2)) + (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] (noAnn,fst happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn47 r)) + +happyReduce_83 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_83 = happySpecReduce_0 31# happyReduction_83 +happyReduction_83 = happyIn47 + (Nothing + ) + +happyReduce_84 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_84 = happySpecReduce_1 32# happyReduction_84 +happyReduction_84 happy_x_1 + = case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> + happyIn48 + (([], happy_var_1) + )} + +happyReduce_85 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_85 = happySpecReduce_0 32# happyReduction_85 +happyReduction_85 = happyIn48 + (([], nilOL) + ) + +happyReduce_86 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_86 = happyMonadReduce 2# 32# happyReduction_86 +happyReduction_86 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingCommaA t (epTok happy_var_2) + return ([], snocOL hs t'))}}) + ) (\r -> happyReturn (happyIn48 r)) + +happyReduce_87 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_87 = happySpecReduce_1 32# happyReduction_87 +happyReduction_87 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn48 + (([epTok happy_var_1], nilOL) + )} + +happyReduce_88 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_88 = happyMonadReduce 3# 33# happyReduction_88 +happyReduction_88 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut49 happy_x_1 of { (HappyWrap49 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut50 happy_x_3 of { (HappyWrap50 happy_var_3) -> + ( let ls = happy_var_1 + in if isNilOL ls + then return (ls `appOL` happy_var_3) + else case ls of + SnocOL hs t -> do + t' <- addTrailingCommaA t (epTok happy_var_2) + return (snocOL hs t' `appOL` happy_var_3))}}}) + ) (\r -> happyReturn (happyIn49 r)) + +happyReduce_89 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_89 = happySpecReduce_1 33# happyReduction_89 +happyReduction_89 happy_x_1 + = case happyOut50 happy_x_1 of { (HappyWrap50 happy_var_1) -> + happyIn49 + (happy_var_1 + )} + +happyReduce_90 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_90 = happyMonadReduce 1# 34# happyReduction_90 +happyReduction_90 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut51 happy_x_1 of { (HappyWrap51 happy_var_1) -> + ( return (unitOL happy_var_1))}) + ) (\r -> happyReturn (happyIn50 r)) + +happyReduce_91 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_91 = happyMonadReduce 3# 35# happyReduction_91 +happyReduction_91 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut146 happy_x_1 of { (HappyWrap146 happy_var_1) -> + case happyOut56 happy_x_2 of { (HappyWrap56 happy_var_2) -> + case happyOut52 happy_x_3 of { (HappyWrap52 happy_var_3) -> + ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 } + ; impExp <- mkModuleImpExp happy_var_1 (fst $ unLoc happy_var_3) happy_var_2 (snd $ unLoc happy_var_3) + ; return $ reLoc $ sL span $ impExp })}}}) + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_92 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_92 = happyMonadReduce 3# 35# happyReduction_92 +happyReduction_92 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut146 happy_x_1 of { (HappyWrap146 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut334 happy_x_3 of { (HappyWrap334 happy_var_3) -> + ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 + ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) happy_var_1) happy_var_2 } + ; locImpExp <- return (sL span (IEModuleContents (happy_var_1, (epTok happy_var_2)) happy_var_3)) + ; return $ reLoc $ locImpExp })}}}) + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_93 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_93 = happyMonadReduce 3# 35# happyReduction_93 +happyReduction_93 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut146 happy_x_1 of { (HappyWrap146 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut286 happy_x_3 of { (HappyWrap286 happy_var_3) -> + ( do { warnPatternNamespaceSpecifier (getLoc happy_var_2) + ; let span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 + ; return $ reLoc $ sL span $ IEVar happy_var_1 (sLLa happy_var_2 happy_var_3 (IEPattern (epTok happy_var_2) happy_var_3)) Nothing })}}}) + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_94 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_94 = happyMonadReduce 3# 35# happyReduction_94 +happyReduction_94 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut146 happy_x_1 of { (HappyWrap146 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut301 happy_x_3 of { (HappyWrap301 happy_var_3) -> + ( do { let { span = (maybe comb2 comb3 happy_var_1) happy_var_2 happy_var_3 } + ; locImpExp <- return (sL span (IEThingAbs happy_var_1 (sLLa happy_var_2 happy_var_3 (IEDefault (epTok happy_var_2) happy_var_3)) Nothing)) + ; return $ reLoc $ locImpExp })}}}) + ) (\r -> happyReturn (happyIn51 r)) + +happyReduce_95 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_95 = happySpecReduce_0 36# happyReduction_95 +happyReduction_95 = happyIn52 + (sL0 (noAnn,ImpExpAbs) + ) + +happyReduce_96 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_96 = happyMonadReduce 3# 36# happyReduction_96 +happyReduction_96 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut53 happy_x_2 of { (HappyWrap53 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( mkImpExpSubSpec (reverse happy_var_2) + >>= \ie -> return $ sLL happy_var_1 happy_var_3 + ((epTok happy_var_1, epTok happy_var_3), ie))}}}) + ) (\r -> happyReturn (happyIn52 r)) + +happyReduce_97 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_97 = happySpecReduce_0 37# happyReduction_97 +happyReduction_97 = happyIn53 + ([] + ) + +happyReduce_98 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_98 = happySpecReduce_1 37# happyReduction_98 +happyReduction_98 happy_x_1 + = case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> + happyIn53 + (happy_var_1 + )} + +happyReduce_99 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_99 = happyMonadReduce 3# 38# happyReduction_99 +happyReduction_99 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut54 happy_x_1 of { (HappyWrap54 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut55 happy_x_3 of { (HappyWrap55 happy_var_3) -> + ( case happy_var_1 of + ((L la (ImpExpQcWildcard tok _)):t) -> + do { return (happy_var_3 : L la (ImpExpQcWildcard tok (epTok happy_var_2)) : t) } + (l:t) -> + do { l' <- addTrailingCommaA l (epTok happy_var_2) + ; return (happy_var_3 : l' : t)})}}}) + ) (\r -> happyReturn (happyIn54 r)) + +happyReduce_100 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_100 = happySpecReduce_1 38# happyReduction_100 +happyReduction_100 happy_x_1 + = case happyOut55 happy_x_1 of { (HappyWrap55 happy_var_1) -> + happyIn54 + ([happy_var_1] + )} + +happyReduce_101 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_101 = happySpecReduce_1 39# happyReduction_101 +happyReduction_101 happy_x_1 + = case happyOut56 happy_x_1 of { (HappyWrap56 happy_var_1) -> + happyIn55 + (happy_var_1 + )} + +happyReduce_102 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_102 = happySpecReduce_1 39# happyReduction_102 +happyReduction_102 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn55 + (sL1a happy_var_1 (ImpExpQcWildcard (epTok happy_var_1) NoEpTok) + )} + +happyReduce_103 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_103 = happySpecReduce_1 40# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut57 happy_x_1 of { (HappyWrap57 happy_var_1) -> + happyIn56 + (sL1a happy_var_1 (mkPlainImpExp happy_var_1) + )} + +happyReduce_104 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_104 = happyMonadReduce 2# 40# happyReduction_104 +happyReduction_104 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut298 happy_x_2 of { (HappyWrap298 happy_var_2) -> + ( do { imp_exp <- mkTypeImpExp (epTok happy_var_1) happy_var_2 + ; return $ sLLa happy_var_1 happy_var_2 imp_exp })}}) + ) (\r -> happyReturn (happyIn56 r)) + +happyReduce_105 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_105 = happyMonadReduce 2# 40# happyReduction_105 +happyReduction_105 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut125 happy_x_2 of { (HappyWrap125 happy_var_2) -> + ( do { imp_exp <- mkDataImpExp (epTok happy_var_1) happy_var_2 + ; return $ sLLa happy_var_1 happy_var_2 imp_exp })}}) + ) (\r -> happyReturn (happyIn56 r)) + +happyReduce_106 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_106 = happySpecReduce_1 41# happyReduction_106 +happyReduction_106 happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + happyIn57 + (happy_var_1 + )} + +happyReduce_107 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_107 = happySpecReduce_1 41# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut299 happy_x_1 of { (HappyWrap299 happy_var_1) -> + happyIn57 + (happy_var_1 + )} + +happyReduce_108 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_108 = happySpecReduce_2 42# happyReduction_108 +happyReduction_108 happy_x_2 + happy_x_1 + = case happyOut58 happy_x_1 of { (HappyWrap58 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn58 + (if isZeroWidthSpan (gl happy_var_2) then (sL1 happy_var_1 $ unLoc happy_var_1) else (sLL happy_var_1 happy_var_2 $ AddSemiAnn (epTok happy_var_2) : (unLoc happy_var_1)) + )}} + +happyReduce_109 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_109 = happySpecReduce_1 42# happyReduction_109 +happyReduction_109 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn58 + (case msemi happy_var_1 of + [] -> noLoc [] + ms -> sL1 happy_var_1 $ ms + )} + +happyReduce_110 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_110 = happySpecReduce_2 43# happyReduction_110 +happyReduction_110 happy_x_2 + happy_x_1 + = case happyOut59 happy_x_1 of { (HappyWrap59 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn59 + (if isZeroWidthSpan (gl happy_var_2) then happy_var_1 else (AddSemiAnn (epTok happy_var_2) : happy_var_1) + )}} + +happyReduce_111 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_111 = happySpecReduce_0 43# happyReduction_111 +happyReduction_111 = happyIn59 + ([] + ) + +happyReduce_112 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_112 = happySpecReduce_2 44# happyReduction_112 +happyReduction_112 happy_x_2 + happy_x_1 + = case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> + case happyOut62 happy_x_2 of { (HappyWrap62 happy_var_2) -> + happyIn60 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_113 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_113 = happyMonadReduce 3# 45# happyReduction_113 +happyReduction_113 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut61 happy_x_1 of { (HappyWrap61 happy_var_1) -> + case happyOut62 happy_x_2 of { (HappyWrap62 happy_var_2) -> + case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> + ( do { i <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) + ; return (i : happy_var_1)})}}}) + ) (\r -> happyReturn (happyIn61 r)) + +happyReduce_114 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_114 = happySpecReduce_0 45# happyReduction_114 +happyReduction_114 = happyIn61 + ([] + ) + +happyReduce_115 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_115 = happyMonadReduce 11# 46# happyReduction_115 +happyReduction_115 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut63 happy_x_2 of { (HappyWrap63 happy_var_2) -> + case happyOut65 happy_x_3 of { (HappyWrap65 happy_var_3) -> + case happyOut64 happy_x_4 of { (HappyWrap64 happy_var_4) -> + case happyOut67 happy_x_5 of { (HappyWrap67 happy_var_5) -> + case happyOut66 happy_x_6 of { (HappyWrap66 happy_var_6) -> + case happyOut334 happy_x_7 of { (HappyWrap334 happy_var_7) -> + case happyOut65 happy_x_8 of { (HappyWrap65 happy_var_8) -> + case happyOut67 happy_x_9 of { (HappyWrap67 happy_var_9) -> + case happyOut68 happy_x_10 of { (HappyWrap68 happy_var_10) -> + case happyOut69 happy_x_11 of { (HappyWrap69 happy_var_11) -> + ( do { + ; let { ; mPreQual = happy_var_5 + ; mPostQual = happy_var_9 + ; mPreLevel = happy_var_3 + ; mPostLevel = happy_var_8 } + ; (qualSpec, levelSpec) <- checkImportDecl mPreQual mPostQual mPreLevel mPostLevel + ; let anns + = EpAnnImportDecl + { importDeclAnnImport = epTok happy_var_1 + , importDeclAnnPragma = fst $ fst happy_var_2 + , importDeclAnnLevel = fst $ levelSpec + , importDeclAnnSafe = fst happy_var_4 + , importDeclAnnQualified = fst $ qualSpec + , importDeclAnnPackage = fst happy_var_6 + , importDeclAnnAs = fst happy_var_10 + } + ; let loc = (comb6 happy_var_1 happy_var_7 happy_var_8 happy_var_9 (snd happy_var_10) happy_var_11); + ; fmap reLoc $ acs loc (\loc cs -> L loc $ + ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst happy_var_2) False + , ideclName = happy_var_7, ideclPkgQual = snd happy_var_6 + , ideclSource = snd happy_var_2 + , ideclLevelSpec = snd $ levelSpec + , ideclSafe = snd happy_var_4 + , ideclQualified = snd $ qualSpec + , ideclAs = unLoc (snd happy_var_10) + , ideclImportList = unLoc happy_var_11 }) + })}}}}}}}}}}}) + ) (\r -> happyReturn (happyIn62 r)) + +happyReduce_116 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_116 = happySpecReduce_2 47# happyReduction_116 +happyReduction_116 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn63 + (((Just (glR happy_var_1,epTok happy_var_2),getSOURCE_PRAGs happy_var_1) + , IsBoot) + )}} + +happyReduce_117 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_117 = happySpecReduce_0 47# happyReduction_117 +happyReduction_117 = happyIn63 + (((Nothing,NoSourceText),NotBoot) + ) + +happyReduce_118 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_118 = happySpecReduce_1 48# happyReduction_118 +happyReduction_118 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn64 + ((Just (epTok happy_var_1),True) + )} + +happyReduce_119 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_119 = happySpecReduce_0 48# happyReduction_119 +happyReduction_119 = happyIn64 + ((Nothing, False) + ) + +happyReduce_120 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_120 = happySpecReduce_1 49# happyReduction_120 +happyReduction_120 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn65 + ((Just (EpAnnLevelSplice (epTok happy_var_1))) + )} + +happyReduce_121 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_121 = happySpecReduce_1 49# happyReduction_121 +happyReduction_121 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn65 + ((Just (EpAnnLevelQuote (epTok happy_var_1))) + )} + +happyReduce_122 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_122 = happySpecReduce_0 49# happyReduction_122 +happyReduction_122 = happyIn65 + ((Nothing) + ) + +happyReduce_123 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_123 = happyMonadReduce 1# 50# happyReduction_123 +happyReduction_123 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( do { let { pkgFS = getSTRING happy_var_1 } + ; unless (looksLikePackageName (unpackFS pkgFS)) $ + addError $ mkPlainErrorMsgEnvelope (getLoc happy_var_1) $ + (PsErrInvalidPackageName pkgFS) + ; return (Just (glR happy_var_1), RawPkgQual (StringLiteral (getSTRINGs happy_var_1) pkgFS Nothing)) })}) + ) (\r -> happyReturn (happyIn66 r)) + +happyReduce_124 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_124 = happySpecReduce_0 50# happyReduction_124 +happyReduction_124 = happyIn66 + ((Nothing,NoRawPkgQual) + ) + +happyReduce_125 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_125 = happySpecReduce_1 51# happyReduction_125 +happyReduction_125 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn67 + (Just (epTok happy_var_1) + )} + +happyReduce_126 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_126 = happySpecReduce_0 51# happyReduction_126 +happyReduction_126 = happyIn67 + (Nothing + ) + +happyReduce_127 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_127 = happySpecReduce_2 52# happyReduction_127 +happyReduction_127 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + happyIn68 + ((Just (epTok happy_var_1) + ,sLL happy_var_1 happy_var_2 (Just happy_var_2)) + )}} + +happyReduce_128 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_128 = happySpecReduce_0 52# happyReduction_128 +happyReduction_128 = happyIn68 + ((Nothing,noLoc Nothing) + ) + +happyReduce_129 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_129 = happyMonadReduce 1# 53# happyReduction_129 +happyReduction_129 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut70 happy_x_1 of { (HappyWrap70 happy_var_1) -> + ( let (b, ie) = unLoc happy_var_1 in + checkImportSpec ie + >>= \checkedIe -> + return (L (gl happy_var_1) (Just (b, checkedIe))))}) + ) (\r -> happyReturn (happyIn69 r)) + +happyReduce_130 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_130 = happySpecReduce_0 53# happyReduction_130 +happyReduction_130 = happyIn69 + (noLoc Nothing + ) + +happyReduce_131 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_131 = happyMonadReduce 3# 54# happyReduction_131 +happyReduction_131 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut71 happy_x_2 of { (HappyWrap71 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { es <- amsr (sLL happy_var_1 happy_var_3 $ fromOL $ snd happy_var_2) + (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] (noAnn,fst happy_var_2) []) + ; return $ sLL happy_var_1 happy_var_3 (Exactly, es)})}}}) + ) (\r -> happyReturn (happyIn70 r)) + +happyReduce_132 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_132 = happyMonadReduce 4# 54# happyReduction_132 +happyReduction_132 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut71 happy_x_3 of { (HappyWrap71 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( do { es <- amsr (sLL happy_var_1 happy_var_4 $ fromOL $ snd happy_var_3) + (AnnList Nothing (ListParens (epTok happy_var_2) (epTok happy_var_4)) [] (epTok happy_var_1,fst happy_var_3) []) + ; return $ sLL happy_var_1 happy_var_4 (EverythingBut, es)})}}}}) + ) (\r -> happyReturn (happyIn70 r)) + +happyReduce_133 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_133 = happySpecReduce_1 55# happyReduction_133 +happyReduction_133 happy_x_1 + = case happyOut72 happy_x_1 of { (HappyWrap72 happy_var_1) -> + happyIn71 + (([], happy_var_1) + )} + +happyReduce_134 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_134 = happySpecReduce_0 55# happyReduction_134 +happyReduction_134 = happyIn71 + (([], nilOL) + ) + +happyReduce_135 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_135 = happyMonadReduce 2# 55# happyReduction_135 +happyReduction_135 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut72 happy_x_1 of { (HappyWrap72 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingCommaA t (epTok happy_var_2) + return ([], snocOL hs t'))}}) + ) (\r -> happyReturn (happyIn71 r)) + +happyReduce_136 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_136 = happySpecReduce_1 55# happyReduction_136 +happyReduction_136 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn71 + (([epTok happy_var_1], nilOL) + )} + +happyReduce_137 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_137 = happyMonadReduce 3# 56# happyReduction_137 +happyReduction_137 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut72 happy_x_1 of { (HappyWrap72 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut73 happy_x_3 of { (HappyWrap73 happy_var_3) -> + ( let ls = happy_var_1 + in if isNilOL ls + then return (ls `appOL` happy_var_3) + else case ls of + SnocOL hs t -> do + t' <- addTrailingCommaA t (epTok happy_var_2) + return (snocOL hs t' `appOL` happy_var_3))}}}) + ) (\r -> happyReturn (happyIn72 r)) + +happyReduce_138 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_138 = happySpecReduce_1 56# happyReduction_138 +happyReduction_138 happy_x_1 + = case happyOut73 happy_x_1 of { (HappyWrap73 happy_var_1) -> + happyIn72 + (happy_var_1 + )} + +happyReduce_139 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_139 = happyMonadReduce 2# 57# happyReduction_139 +happyReduction_139 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut56 happy_x_1 of { (HappyWrap56 happy_var_1) -> + case happyOut52 happy_x_2 of { (HappyWrap52 happy_var_2) -> + ( fmap (unitOL . reLoc . (sLL happy_var_1 happy_var_2)) $ mkModuleImpExp Nothing (fst $ unLoc happy_var_2) happy_var_1 (snd $ unLoc happy_var_2))}}) + ) (\r -> happyReturn (happyIn73 r)) + +happyReduce_140 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_140 = happyMonadReduce 2# 57# happyReduction_140 +happyReduction_140 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut334 happy_x_2 of { (HappyWrap334 happy_var_2) -> + ( fmap (unitOL . reLoc) $ return (sLL happy_var_1 happy_var_2 (IEModuleContents (Nothing, (epTok happy_var_1)) happy_var_2)))}}) + ) (\r -> happyReturn (happyIn73 r)) + +happyReduce_141 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_141 = happyMonadReduce 2# 57# happyReduction_141 +happyReduction_141 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut286 happy_x_2 of { (HappyWrap286 happy_var_2) -> + ( do { warnPatternNamespaceSpecifier (getLoc happy_var_1) + ; return $ unitOL $ reLoc $ sLL happy_var_1 happy_var_2 $ IEVar Nothing (sLLa happy_var_1 happy_var_2 (IEPattern (epTok happy_var_1) happy_var_2)) Nothing })}}) + ) (\r -> happyReturn (happyIn73 r)) + +happyReduce_142 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_142 = happySpecReduce_0 58# happyReduction_142 +happyReduction_142 = happyIn74 + (Nothing + ) + +happyReduce_143 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_143 = happySpecReduce_1 58# happyReduction_143 +happyReduction_143 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn74 + (Just (sL1 happy_var_1 (getINTEGERs happy_var_1,fromInteger (il_value (getINTEGER happy_var_1)))) + )} + +happyReduce_144 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_144 = happySpecReduce_1 59# happyReduction_144 +happyReduction_144 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn75 + (sL1 happy_var_1 InfixN + )} + +happyReduce_145 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_145 = happySpecReduce_1 59# happyReduction_145 +happyReduction_145 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn75 + (sL1 happy_var_1 InfixL + )} + +happyReduce_146 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_146 = happySpecReduce_1 59# happyReduction_146 +happyReduction_146 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn75 + (sL1 happy_var_1 InfixR + )} + +happyReduce_147 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_147 = happyMonadReduce 3# 60# happyReduction_147 +happyReduction_147 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut76 happy_x_1 of { (HappyWrap76 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut306 happy_x_3 of { (HappyWrap306 happy_var_3) -> + ( case (unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingCommaN t (gl happy_var_2) + return (sLL happy_var_1 happy_var_3 (snocOL hs t' `appOL` unitOL happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn76 r)) + +happyReduce_148 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_148 = happySpecReduce_1 60# happyReduction_148 +happyReduction_148 happy_x_1 + = case happyOut306 happy_x_1 of { (HappyWrap306 happy_var_1) -> + happyIn76 + (sL1 happy_var_1 (unitOL happy_var_1) + )} + +happyReduce_149 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_149 = happySpecReduce_2 61# happyReduction_149 +happyReduction_149 happy_x_2 + happy_x_1 + = case happyOut78 happy_x_1 of { (HappyWrap78 happy_var_1) -> + case happyOut82 happy_x_2 of { (HappyWrap82 happy_var_2) -> + happyIn77 + (happy_var_1 `snocOL` happy_var_2 + )}} + +happyReduce_150 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_150 = happyMonadReduce 3# 62# happyReduction_150 +happyReduction_150 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut78 happy_x_1 of { (HappyWrap78 happy_var_1) -> + case happyOut82 happy_x_2 of { (HappyWrap82 happy_var_2) -> + case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> + ( do { t <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) + ; return (happy_var_1 `snocOL` t) })}}}) + ) (\r -> happyReturn (happyIn78 r)) + +happyReduce_151 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_151 = happySpecReduce_0 62# happyReduction_151 +happyReduction_151 = happyIn78 + (nilOL + ) + +happyReduce_152 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_152 = happySpecReduce_2 63# happyReduction_152 +happyReduction_152 happy_x_2 + happy_x_1 + = case happyOut80 happy_x_1 of { (HappyWrap80 happy_var_1) -> + case happyOut81 happy_x_2 of { (HappyWrap81 happy_var_2) -> + happyIn79 + (happy_var_1 `snocOL` happy_var_2 + )}} + +happyReduce_153 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_153 = happyMonadReduce 3# 64# happyReduction_153 +happyReduction_153 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut80 happy_x_1 of { (HappyWrap80 happy_var_1) -> + case happyOut81 happy_x_2 of { (HappyWrap81 happy_var_2) -> + case happyOut58 happy_x_3 of { (HappyWrap58 happy_var_3) -> + ( do { t <- amsAl happy_var_2 (comb2 happy_var_2 happy_var_3) (reverse $ unLoc happy_var_3) + ; return (happy_var_1 `snocOL` t) })}}}) + ) (\r -> happyReturn (happyIn80 r)) + +happyReduce_154 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_154 = happySpecReduce_0 64# happyReduction_154 +happyReduction_154 = happyIn80 + (nilOL + ) + +happyReduce_155 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_155 = happyMonadReduce 1# 65# happyReduction_155 +happyReduction_155 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut82 happy_x_1 of { (HappyWrap82 happy_var_1) -> + ( commentsPA happy_var_1)}) + ) (\r -> happyReturn (happyIn81 r)) + +happyReduce_156 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_156 = happySpecReduce_1 66# happyReduction_156 +happyReduction_156 happy_x_1 + = case happyOut83 happy_x_1 of { (HappyWrap83 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (TyClD noExtField (unLoc happy_var_1)) + )} + +happyReduce_157 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_157 = happySpecReduce_1 66# happyReduction_157 +happyReduction_157 happy_x_1 + = case happyOut85 happy_x_1 of { (HappyWrap85 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (TyClD noExtField (unLoc happy_var_1)) + )} + +happyReduce_158 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_158 = happySpecReduce_1 66# happyReduction_158 +happyReduction_158 happy_x_1 + = case happyOut86 happy_x_1 of { (HappyWrap86 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (KindSigD noExtField (unLoc happy_var_1)) + )} + +happyReduce_159 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_159 = happySpecReduce_1 66# happyReduction_159 +happyReduction_159 happy_x_1 + = case happyOut88 happy_x_1 of { (HappyWrap88 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (InstD noExtField (unLoc happy_var_1)) + )} + +happyReduce_160 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_160 = happySpecReduce_1 66# happyReduction_160 +happyReduction_160 happy_x_1 + = case happyOut114 happy_x_1 of { (HappyWrap114 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (DerivD noExtField (unLoc happy_var_1)) + )} + +happyReduce_161 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_161 = happySpecReduce_1 66# happyReduction_161 +happyReduction_161 happy_x_1 + = case happyOut115 happy_x_1 of { (HappyWrap115 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (RoleAnnotD noExtField (unLoc happy_var_1)) + )} + +happyReduce_162 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_162 = happySpecReduce_1 66# happyReduction_162 +happyReduction_162 happy_x_1 + = case happyOut84 happy_x_1 of { (HappyWrap84 happy_var_1) -> + happyIn82 + (L (getLoc happy_var_1) (DefD noExtField (unLoc happy_var_1)) + )} + +happyReduce_163 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_163 = happyMonadReduce 2# 66# happyReduction_163 +happyReduction_163 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut156 happy_x_2 of { (HappyWrap156 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 ((unLoc happy_var_2) (epTok happy_var_1))))}}) + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_164 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_164 = happyMonadReduce 3# 66# happyReduction_164 +happyReduction_164 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut151 happy_x_2 of { (HappyWrap151 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ WarningD noExtField (Warnings ((glR happy_var_1,epTok happy_var_3), (getDEPRECATED_PRAGs happy_var_1)) (fromOL happy_var_2))))}}}) + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_165 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_165 = happyMonadReduce 3# 66# happyReduction_165 +happyReduction_165 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut148 happy_x_2 of { (HappyWrap148 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ WarningD noExtField (Warnings ((glR happy_var_1,epTok happy_var_3), (getWARNING_PRAGs happy_var_1)) (fromOL happy_var_2))))}}}) + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_166 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_166 = happyMonadReduce 3# 66# happyReduction_166 +happyReduction_166 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut138 happy_x_2 of { (HappyWrap138 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ RuleD noExtField (HsRules ((glR happy_var_1,epTok happy_var_3), (getRULES_PRAGs happy_var_1)) (reverse happy_var_2))))}}}) + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_167 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_167 = happySpecReduce_1 66# happyReduction_167 +happyReduction_167 happy_x_1 + = case happyOut155 happy_x_1 of { (HappyWrap155 happy_var_1) -> + happyIn82 + (happy_var_1 + )} + +happyReduce_168 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_168 = happySpecReduce_1 66# happyReduction_168 +happyReduction_168 happy_x_1 + = case happyOut211 happy_x_1 of { (HappyWrap211 happy_var_1) -> + happyIn82 + (happy_var_1 + )} + +happyReduce_169 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_169 = happyMonadReduce 1# 66# happyReduction_169 +happyReduction_169 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + commentsPA $ mkSpliceDecl happy_var_1)}) + ) (\r -> happyReturn (happyIn82 r)) + +happyReduce_170 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_170 = happyMonadReduce 4# 67# happyReduction_170 +happyReduction_170 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut111 happy_x_2 of { (HappyWrap111 happy_var_2) -> + case happyOut190 happy_x_3 of { (HappyWrap190 happy_var_3) -> + case happyOut129 happy_x_4 of { (HappyWrap129 happy_var_4) -> + ( do { let {(wtok, (oc,semis,cc)) = fstOf3 $ unLoc happy_var_4} + ; mkClassDecl (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) happy_var_2 happy_var_3 (sndOf3 $ unLoc happy_var_4) (thdOf3 $ unLoc happy_var_4) + (AnnClassDecl (epTok happy_var_1) [] [] (fst $ unLoc happy_var_3) wtok oc cc semis) })}}}}) + ) (\r -> happyReturn (happyIn83 r)) + +happyReduce_171 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_171 = happyMonadReduce 5# 68# happyReduction_171 +happyReduction_171 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut93 happy_x_2 of { (HappyWrap93 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut183 happy_x_4 of { (HappyWrap183 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( amsA' (sLL happy_var_1 happy_var_5 (DefaultDecl (epTok happy_var_1,epTok happy_var_3,epTok happy_var_5) happy_var_2 happy_var_4)))}}}}}) + ) (\r -> happyReturn (happyIn84 r)) + +happyReduce_172 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_172 = happyMonadReduce 4# 69# happyReduction_172 +happyReduction_172 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut172 happy_x_2 of { (HappyWrap172 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut168 happy_x_4 of { (HappyWrap168 happy_var_4) -> + ( mkTySynonym (comb2 happy_var_1 happy_var_4) happy_var_2 happy_var_4 (epTok happy_var_1) (epTok happy_var_3))}}}}) + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_173 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_173 = happyMonadReduce 6# 69# happyReduction_173 +happyReduction_173 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + case happyOut109 happy_x_4 of { (HappyWrap109 happy_var_4) -> + case happyOut94 happy_x_5 of { (HappyWrap94 happy_var_5) -> + case happyOut97 happy_x_6 of { (HappyWrap97 happy_var_6) -> + ( do { let { (tdcolon, tequal) = fst $ unLoc happy_var_4 } + ; let { tvbar = fst $ unLoc happy_var_5 } + ; let { (twhere, (toc, tdd, tcc)) = fst $ unLoc happy_var_6 } + ; mkFamDecl (comb5 happy_var_1 happy_var_3 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_6) TopLevel happy_var_3 + (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5) + (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn (epTok happy_var_2) tdcolon tequal tvbar twhere toc tdd tcc) })}}}}}}) + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_174 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_174 = happyMonadReduce 5# 69# happyReduction_174 +happyReduction_174 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> + case happyOut113 happy_x_2 of { (HappyWrap113 happy_var_2) -> + case happyOut111 happy_x_3 of { (HappyWrap111 happy_var_3) -> + case happyOut198 happy_x_4 of { (HappyWrap198 happy_var_4) -> + case happyOut207 happy_x_5 of { (HappyWrap207 happy_var_5) -> + ( do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc happy_var_1} + ; let { tequal = fst $ unLoc happy_var_4 } + ; mkTyData (comb4 happy_var_1 happy_var_3 happy_var_4 happy_var_5) (sndOf3 $ unLoc happy_var_1) (thdOf3 $ unLoc happy_var_1) happy_var_2 happy_var_3 + Nothing (reverse (snd $ unLoc happy_var_4)) + (fmap reverse happy_var_5) + (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok NoEpUniTok NoEpTok NoEpTok NoEpTok tequal) + })}}}}}) + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_175 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_175 = happyMonadReduce 6# 69# happyReduction_175 +happyReduction_175 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut105 happy_x_1 of { (HappyWrap105 happy_var_1) -> + case happyOut113 happy_x_2 of { (HappyWrap113 happy_var_2) -> + case happyOut111 happy_x_3 of { (HappyWrap111 happy_var_3) -> + case happyOut107 happy_x_4 of { (HappyWrap107 happy_var_4) -> + case happyOut195 happy_x_5 of { (HappyWrap195 happy_var_5) -> + case happyOut207 happy_x_6 of { (HappyWrap207 happy_var_6) -> + ( do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc happy_var_1} + ; let { tdcolon = fst $ unLoc happy_var_4 } + ; let { (twhere, oc, cc) = fst $ unLoc happy_var_5 } + ; mkTyData (comb5 happy_var_1 happy_var_3 happy_var_4 happy_var_5 happy_var_6) (sndOf3 $ unLoc happy_var_1) (thdOf3 $ unLoc happy_var_1) happy_var_2 happy_var_3 + (snd $ unLoc happy_var_4) (snd $ unLoc happy_var_5) + (fmap reverse happy_var_6) + (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok tdcolon twhere oc cc NoEpTok)})}}}}}}) + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_176 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_176 = happyMonadReduce 4# 69# happyReduction_176 +happyReduction_176 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + case happyOut108 happy_x_4 of { (HappyWrap108 happy_var_4) -> + ( do { let { tdcolon = fst $ unLoc happy_var_4 } + ; mkFamDecl (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) DataFamily TopLevel happy_var_3 + (snd $ unLoc happy_var_4) Nothing + (AnnFamilyDecl [] [] noAnn (epTok happy_var_1) (epTok happy_var_2) tdcolon noAnn noAnn noAnn noAnn noAnn noAnn) })}}}}) + ) (\r -> happyReturn (happyIn85 r)) + +happyReduce_177 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_177 = happyMonadReduce 4# 70# happyReduction_177 +happyReduction_177 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut87 happy_x_2 of { (HappyWrap87 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut162 happy_x_4 of { (HappyWrap162 happy_var_4) -> + ( mkStandaloneKindSig (comb2 happy_var_1 happy_var_4) (L (gl happy_var_2) $ unLoc happy_var_2) happy_var_4 + (epTok happy_var_1,epUniTok happy_var_3))}}}}) + ) (\r -> happyReturn (happyIn86 r)) + +happyReduce_178 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_178 = happyMonadReduce 3# 71# happyReduction_178 +happyReduction_178 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut87 happy_x_1 of { (HappyWrap87 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut298 happy_x_3 of { (HappyWrap298 happy_var_3) -> + ( case unLoc happy_var_1 of + (h:t) -> do + h' <- addTrailingCommaN h (gl happy_var_2) + return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) + ) (\r -> happyReturn (happyIn87 r)) + +happyReduce_179 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_179 = happySpecReduce_1 71# happyReduction_179 +happyReduction_179 happy_x_1 + = case happyOut298 happy_x_1 of { (HappyWrap298 happy_var_1) -> + happyIn87 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_180 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_180 = happyMonadReduce 5# 72# happyReduction_180 +happyReduction_180 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut146 happy_x_2 of { (HappyWrap146 happy_var_2) -> + case happyOut89 happy_x_3 of { (HappyWrap89 happy_var_3) -> + case happyOut181 happy_x_4 of { (HappyWrap181 happy_var_4) -> + case happyOut133 happy_x_5 of { (HappyWrap133 happy_var_5) -> + ( do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc happy_var_5) + ; let (twhere, (openc, closec, semis)) = fst $ unLoc happy_var_5 + ; let anns = AnnClsInstDecl (epTok happy_var_1) twhere openc semis closec + ; let cid = ClsInstDecl + { cid_ext = (happy_var_2, anns, NoAnnSortKey) + , cid_poly_ty = happy_var_4, cid_binds = binds + , cid_sigs = mkClassOpSigs sigs + , cid_tyfam_insts = ats + , cid_overlap_mode = happy_var_3 + , cid_datafam_insts = adts } + ; amsA' (L (comb3 happy_var_1 happy_var_4 happy_var_5) + (ClsInstD { cid_d_ext = noExtField, cid_inst = cid })) + })}}}}}) + ) (\r -> happyReturn (happyIn88 r)) + +happyReduce_181 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_181 = happyMonadReduce 3# 72# happyReduction_181 +happyReduction_181 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut100 happy_x_3 of { (HappyWrap100 happy_var_3) -> + ( mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) + (epTok happy_var_1) (epTok happy_var_2))}}}) + ) (\r -> happyReturn (happyIn88 r)) + +happyReduce_182 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_182 = happyMonadReduce 6# 72# happyReduction_182 +happyReduction_182 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut106 happy_x_1 of { (HappyWrap106 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut113 happy_x_3 of { (HappyWrap113 happy_var_3) -> + case happyOut112 happy_x_4 of { (HappyWrap112 happy_var_4) -> + case happyOut198 happy_x_5 of { (HappyWrap198 happy_var_5) -> + case happyOut207 happy_x_6 of { (HappyWrap207 happy_var_6) -> + ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } + ; let { tequal = fst $ unLoc happy_var_5 } + ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) + Nothing (reverse (snd $ unLoc happy_var_5)) + (fmap reverse happy_var_6) + (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok happy_var_2) NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)})}}}}}}) + ) (\r -> happyReturn (happyIn88 r)) + +happyReduce_183 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_183 = happyMonadReduce 7# 72# happyReduction_183 +happyReduction_183 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut106 happy_x_1 of { (HappyWrap106 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut113 happy_x_3 of { (HappyWrap113 happy_var_3) -> + case happyOut112 happy_x_4 of { (HappyWrap112 happy_var_4) -> + case happyOut107 happy_x_5 of { (HappyWrap107 happy_var_5) -> + case happyOut195 happy_x_6 of { (HappyWrap195 happy_var_6) -> + case happyOut207 happy_x_7 of { (HappyWrap207 happy_var_7) -> + ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } + ; let { dcolon = fst $ unLoc happy_var_5 } + ; let { (twhere, oc, cc) = fst $ unLoc happy_var_6 } + ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) + (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6) + (fmap reverse happy_var_7) + (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok happy_var_2) dcolon twhere oc cc NoEpTok)})}}}}}}}) + ) (\r -> happyReturn (happyIn88 r)) + +happyReduce_184 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_184 = happyMonadReduce 2# 73# happyReduction_184 +happyReduction_184 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlappable (getOVERLAPPABLE_PRAGs happy_var_1))) + (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) + ) (\r -> happyReturn (happyIn89 r)) + +happyReduce_185 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_185 = happyMonadReduce 2# 73# happyReduction_185 +happyReduction_185 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlapping (getOVERLAPPING_PRAGs happy_var_1))) + (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) + ) (\r -> happyReturn (happyIn89 r)) + +happyReduce_186 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_186 = happyMonadReduce 2# 73# happyReduction_186 +happyReduction_186 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Overlaps (getOVERLAPS_PRAGs happy_var_1))) + (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) + ) (\r -> happyReturn (happyIn89 r)) + +happyReduce_187 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_187 = happyMonadReduce 2# 73# happyReduction_187 +happyReduction_187 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_2 (Incoherent (getINCOHERENT_PRAGs happy_var_1))) + (AnnPragma (glR happy_var_1) (epTok happy_var_2) noAnn noAnn noAnn noAnn noAnn))}}) + ) (\r -> happyReturn (happyIn89 r)) + +happyReduce_188 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_188 = happySpecReduce_0 73# happyReduction_188 +happyReduction_188 = happyIn89 + (Nothing + ) + +happyReduce_189 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_189 = happyMonadReduce 1# 74# happyReduction_189 +happyReduction_189 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( amsA' (sL1 happy_var_1 (StockStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn90 r)) + +happyReduce_190 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_190 = happyMonadReduce 1# 74# happyReduction_190 +happyReduction_190 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( amsA' (sL1 happy_var_1 (AnyclassStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn90 r)) + +happyReduce_191 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_191 = happyMonadReduce 1# 74# happyReduction_191 +happyReduction_191 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( amsA' (sL1 happy_var_1 (NewtypeStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn90 r)) + +happyReduce_192 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_192 = happyMonadReduce 2# 75# happyReduction_192 +happyReduction_192 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut162 happy_x_2 of { (HappyWrap162 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 (ViaStrategy (XViaStrategyPs (epTok happy_var_1) happy_var_2))))}}) + ) (\r -> happyReturn (happyIn91 r)) + +happyReduce_193 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_193 = happyMonadReduce 1# 76# happyReduction_193 +happyReduction_193 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( fmap Just $ amsA' (sL1 happy_var_1 (StockStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_194 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_194 = happyMonadReduce 1# 76# happyReduction_194 +happyReduction_194 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( fmap Just $ amsA' (sL1 happy_var_1 (AnyclassStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_195 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_195 = happyMonadReduce 1# 76# happyReduction_195 +happyReduction_195 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( fmap Just $ amsA' (sL1 happy_var_1 (NewtypeStrategy (epTok happy_var_1))))}) + ) (\r -> happyReturn (happyIn92 r)) + +happyReduce_196 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_196 = happySpecReduce_1 76# happyReduction_196 +happyReduction_196 happy_x_1 + = case happyOut91 happy_x_1 of { (HappyWrap91 happy_var_1) -> + happyIn92 + (Just happy_var_1 + )} + +happyReduce_197 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_197 = happySpecReduce_0 76# happyReduction_197 +happyReduction_197 = happyIn92 + (Nothing + ) + +happyReduce_198 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_198 = happySpecReduce_0 77# happyReduction_198 +happyReduction_198 = happyIn93 + (Nothing + ) + +happyReduce_199 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_199 = happyMonadReduce 1# 77# happyReduction_199 +happyReduction_199 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut301 happy_x_1 of { (HappyWrap301 happy_var_1) -> + ( fmap Just $ amsA' (reLoc happy_var_1))}) + ) (\r -> happyReturn (happyIn93 r)) + +happyReduce_200 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_200 = happySpecReduce_0 78# happyReduction_200 +happyReduction_200 = happyIn94 + (noLoc (noAnn, Nothing) + ) + +happyReduce_201 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_201 = happySpecReduce_2 78# happyReduction_201 +happyReduction_201 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut95 happy_x_2 of { (HappyWrap95 happy_var_2) -> + happyIn94 + (sLL happy_var_1 happy_var_2 ((epTok happy_var_1) + , Just (happy_var_2)) + )}} + +happyReduce_202 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_202 = happyMonadReduce 3# 79# happyReduction_202 +happyReduction_202 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut96 happy_x_3 of { (HappyWrap96 happy_var_3) -> + ( amsA' (sLL happy_var_1 happy_var_3 (InjectivityAnn (epUniTok happy_var_2) happy_var_1 (reverse (unLoc happy_var_3)))))}}}) + ) (\r -> happyReturn (happyIn95 r)) + +happyReduce_203 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_203 = happySpecReduce_2 80# happyReduction_203 +happyReduction_203 happy_x_2 + happy_x_1 + = case happyOut96 happy_x_1 of { (HappyWrap96 happy_var_1) -> + case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> + happyIn96 + (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1) + )}} + +happyReduce_204 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_204 = happySpecReduce_1 80# happyReduction_204 +happyReduction_204 happy_x_1 + = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> + happyIn96 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_205 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_205 = happySpecReduce_0 81# happyReduction_205 +happyReduction_205 = happyIn97 + (noLoc (noAnn,OpenTypeFamily) + ) + +happyReduce_206 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_206 = happySpecReduce_2 81# happyReduction_206 +happyReduction_206 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut98 happy_x_2 of { (HappyWrap98 happy_var_2) -> + happyIn97 + (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,(fst $ unLoc happy_var_2)) + ,ClosedTypeFamily (fmap reverse $ snd $ unLoc happy_var_2)) + )}} + +happyReduce_207 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_207 = happySpecReduce_3 82# happyReduction_207 +happyReduction_207 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut99 happy_x_2 of { (HappyWrap99 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn98 + (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,noAnn, epTok happy_var_3) + ,Just (unLoc happy_var_2)) + )}}} + +happyReduce_208 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_208 = happySpecReduce_3 82# happyReduction_208 +happyReduction_208 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut99 happy_x_2 of { (HappyWrap99 happy_var_2) -> + happyIn98 + (let (L loc _) = happy_var_2 in + L loc (noAnn,Just (unLoc happy_var_2)) + )} + +happyReduce_209 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_209 = happySpecReduce_3 82# happyReduction_209 +happyReduction_209 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn98 + (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_2 ,epTok happy_var_3),Nothing) + )}}} + +happyReduce_210 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_210 = happySpecReduce_3 82# happyReduction_210 +happyReduction_210 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn98 + (let (L loc _) = happy_var_2 in + L loc ((noAnn,epTok happy_var_2, noAnn),Nothing) + )} + +happyReduce_211 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_211 = happyMonadReduce 3# 83# happyReduction_211 +happyReduction_211 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut99 happy_x_1 of { (HappyWrap99 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut100 happy_x_3 of { (HappyWrap100 happy_var_3) -> + ( let (L loc eqn) = happy_var_3 in + case unLoc happy_var_1 of + [] -> return (sLL happy_var_1 happy_var_3 (L loc eqn : unLoc happy_var_1)) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) + ) (\r -> happyReturn (happyIn99 r)) + +happyReduce_212 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_212 = happyMonadReduce 2# 83# happyReduction_212 +happyReduction_212 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut99 happy_x_1 of { (HappyWrap99 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( case unLoc happy_var_1 of + [] -> return (sLZ happy_var_1 happy_var_2 (unLoc happy_var_1)) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (h':t)))}}) + ) (\r -> happyReturn (happyIn99 r)) + +happyReduce_213 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_213 = happySpecReduce_1 83# happyReduction_213 +happyReduction_213 happy_x_1 + = case happyOut100 happy_x_1 of { (HappyWrap100 happy_var_1) -> + happyIn99 + (sLL happy_var_1 happy_var_1 [happy_var_1] + )} + +happyReduce_214 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_214 = happySpecReduce_0 83# happyReduction_214 +happyReduction_214 = happyIn99 + (noLoc [] + ) + +happyReduce_215 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_215 = happyMonadReduce 6# 84# happyReduction_215 +happyReduction_215 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut172 happy_x_4 of { (HappyWrap172 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut168 happy_x_6 of { (HappyWrap168 happy_var_6) -> + ( do { hintExplicitForall happy_var_1 + ; tvbs <- fromSpecTyVarBndrs happy_var_2 + ; let loc = comb2 happy_var_1 happy_var_6 + ; !cs <- getCommentsFor loc + ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) cs) tvbs) happy_var_4 happy_var_6 (epTok happy_var_5) })}}}}}}) + ) (\r -> happyReturn (happyIn100 r)) + +happyReduce_216 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_216 = happyMonadReduce 3# 84# happyReduction_216 +happyReduction_216 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut172 happy_x_1 of { (HappyWrap172 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> + ( mkTyFamInstEqn (comb2 happy_var_1 happy_var_3) mkHsOuterImplicit happy_var_1 happy_var_3 (epTok happy_var_2))}}}) + ) (\r -> happyReturn (happyIn100 r)) + +happyReduce_217 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_217 = happyMonadReduce 4# 85# happyReduction_217 +happyReduction_217 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut102 happy_x_2 of { (HappyWrap102 happy_var_2) -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + case happyOut108 happy_x_4 of { (HappyWrap108 happy_var_4) -> + ( do { let { tdcolon = fst $ unLoc happy_var_4 } + ; liftM mkTyClD (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) DataFamily NotTopLevel happy_var_3 + (snd $ unLoc happy_var_4) Nothing + (AnnFamilyDecl [] [] noAnn (epTok happy_var_1) happy_var_2 tdcolon noAnn noAnn noAnn noAnn noAnn noAnn)) })}}}}) + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_218 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_218 = happyMonadReduce 3# 85# happyReduction_218 +happyReduction_218 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut172 happy_x_2 of { (HappyWrap172 happy_var_2) -> + case happyOut110 happy_x_3 of { (HappyWrap110 happy_var_3) -> + ( do { let { (tdcolon, tequal, tvbar) = fst $ unLoc happy_var_3 } + ; liftM mkTyClD + (mkFamDecl (comb3 happy_var_1 happy_var_2 happy_var_3) OpenTypeFamily NotTopLevel happy_var_2 + (fst . snd $ unLoc happy_var_3) + (snd . snd $ unLoc happy_var_3) + (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn noAnn tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) })}}}) + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_219 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_219 = happyMonadReduce 4# 85# happyReduction_219 +happyReduction_219 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + case happyOut110 happy_x_4 of { (HappyWrap110 happy_var_4) -> + ( do { let { (tdcolon, tequal, tvbar) = fst $ unLoc happy_var_4 } + ; liftM mkTyClD + (mkFamDecl (comb3 happy_var_1 happy_var_3 happy_var_4) OpenTypeFamily NotTopLevel happy_var_3 + (fst . snd $ unLoc happy_var_4) + (snd . snd $ unLoc happy_var_4) + (AnnFamilyDecl [] [] (epTok happy_var_1) noAnn (epTok happy_var_2) tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) })}}}}) + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_220 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_220 = happyMonadReduce 2# 85# happyReduction_220 +happyReduction_220 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut100 happy_x_2 of { (HappyWrap100 happy_var_2) -> + ( liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_2) (unLoc happy_var_2) + (epTok happy_var_1) NoEpTok))}}) + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_221 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_221 = happyMonadReduce 3# 85# happyReduction_221 +happyReduction_221 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut100 happy_x_3 of { (HappyWrap100 happy_var_3) -> + ( liftM mkInstD (mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) + (epTok happy_var_1) (epTok happy_var_2) ))}}}) + ) (\r -> happyReturn (happyIn101 r)) + +happyReduce_222 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_222 = happySpecReduce_0 86# happyReduction_222 +happyReduction_222 = happyIn102 + (noAnn + ) + +happyReduce_223 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_223 = happySpecReduce_1 86# happyReduction_223 +happyReduction_223 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn102 + ((epTok happy_var_1) + )} + +happyReduce_224 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_224 = happySpecReduce_0 87# happyReduction_224 +happyReduction_224 = happyIn103 + (NoEpTok + ) + +happyReduce_225 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_225 = happySpecReduce_1 87# happyReduction_225 +happyReduction_225 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn103 + (epTok happy_var_1 + )} + +happyReduce_226 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_226 = happyMonadReduce 3# 88# happyReduction_226 +happyReduction_226 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut103 happy_x_2 of { (HappyWrap103 happy_var_2) -> + case happyOut100 happy_x_3 of { (HappyWrap100 happy_var_3) -> + ( mkTyFamInst (comb2 happy_var_1 happy_var_3) (unLoc happy_var_3) + (epTok happy_var_1) happy_var_2)}}}) + ) (\r -> happyReturn (happyIn104 r)) + +happyReduce_227 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_227 = happyMonadReduce 6# 88# happyReduction_227 +happyReduction_227 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut106 happy_x_1 of { (HappyWrap106 happy_var_1) -> + case happyOut103 happy_x_2 of { (HappyWrap103 happy_var_2) -> + case happyOut113 happy_x_3 of { (HappyWrap113 happy_var_3) -> + case happyOut112 happy_x_4 of { (HappyWrap112 happy_var_4) -> + case happyOut198 happy_x_5 of { (HappyWrap198 happy_var_5) -> + case happyOut207 happy_x_6 of { (HappyWrap207 happy_var_6) -> + ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } + ; let { tequal = fst $ unLoc happy_var_5 } + ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_5 happy_var_6) (snd $ unLoc happy_var_1) happy_var_3 (unLoc happy_var_4) + Nothing (reverse (snd $ unLoc happy_var_5)) + (fmap reverse happy_var_6) + (AnnDataDefn [] [] NoEpTok tnewtype tdata happy_var_2 NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)})}}}}}}) + ) (\r -> happyReturn (happyIn104 r)) + +happyReduce_228 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_228 = happyMonadReduce 7# 88# happyReduction_228 +happyReduction_228 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut106 happy_x_1 of { (HappyWrap106 happy_var_1) -> + case happyOut103 happy_x_2 of { (HappyWrap103 happy_var_2) -> + case happyOut113 happy_x_3 of { (HappyWrap113 happy_var_3) -> + case happyOut112 happy_x_4 of { (HappyWrap112 happy_var_4) -> + case happyOut107 happy_x_5 of { (HappyWrap107 happy_var_5) -> + case happyOut195 happy_x_6 of { (HappyWrap195 happy_var_6) -> + case happyOut207 happy_x_7 of { (HappyWrap207 happy_var_7) -> + ( do { let { (tdata, tnewtype) = fst $ unLoc happy_var_1 } + ; let { dcolon = fst $ unLoc happy_var_5 } + ; let { (twhere, oc, cc) = fst $ unLoc happy_var_6 } + ; mkDataFamInst (comb4 happy_var_1 happy_var_4 happy_var_6 happy_var_7) (snd $ unLoc happy_var_1) happy_var_3 + (unLoc happy_var_4) (snd $ unLoc happy_var_5) (snd $ unLoc happy_var_6) + (fmap reverse happy_var_7) + (AnnDataDefn [] [] NoEpTok tnewtype tdata happy_var_2 dcolon twhere oc cc NoEpTok)})}}}}}}}) + ) (\r -> happyReturn (happyIn104 r)) + +happyReduce_229 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_229 = happySpecReduce_1 89# happyReduction_229 +happyReduction_229 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn105 + (sL1 happy_var_1 ((epTok happy_var_1, NoEpTok, NoEpTok), False,DataType) + )} + +happyReduce_230 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_230 = happySpecReduce_1 89# happyReduction_230 +happyReduction_230 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn105 + (sL1 happy_var_1 ((NoEpTok, epTok happy_var_1, NoEpTok), False,NewType) + )} + +happyReduce_231 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_231 = happySpecReduce_2 89# happyReduction_231 +happyReduction_231 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn105 + (sL1 happy_var_1 ((epTok happy_var_2, NoEpTok, epTok happy_var_1), True ,DataType) + )}} + +happyReduce_232 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_232 = happySpecReduce_1 90# happyReduction_232 +happyReduction_232 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn106 + (sL1 happy_var_1 ((epTok happy_var_1, NoEpTok), DataType) + )} + +happyReduce_233 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_233 = happySpecReduce_1 90# happyReduction_233 +happyReduction_233 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn106 + (sL1 happy_var_1 ((NoEpTok, epTok happy_var_1),NewType) + )} + +happyReduce_234 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_234 = happySpecReduce_0 91# happyReduction_234 +happyReduction_234 = happyIn107 + (noLoc (NoEpUniTok , Nothing) + ) + +happyReduce_235 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_235 = happySpecReduce_2 91# happyReduction_235 +happyReduction_235 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut194 happy_x_2 of { (HappyWrap194 happy_var_2) -> + happyIn107 + (sLL happy_var_1 happy_var_2 (epUniTok happy_var_1, Just happy_var_2) + )}} + +happyReduce_236 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_236 = happySpecReduce_0 92# happyReduction_236 +happyReduction_236 = happyIn108 + (noLoc (noAnn, noLocA (NoSig noExtField) ) + ) + +happyReduce_237 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_237 = happySpecReduce_2 92# happyReduction_237 +happyReduction_237 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut194 happy_x_2 of { (HappyWrap194 happy_var_2) -> + happyIn108 + (sLL happy_var_1 happy_var_2 (epUniTok happy_var_1, sLLa happy_var_1 happy_var_2 (KindSig noExtField happy_var_2)) + )}} + +happyReduce_238 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_238 = happySpecReduce_0 93# happyReduction_238 +happyReduction_238 = happyIn109 + (noLoc (noAnn , noLocA (NoSig noExtField) ) + ) + +happyReduce_239 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_239 = happySpecReduce_2 93# happyReduction_239 +happyReduction_239 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut194 happy_x_2 of { (HappyWrap194 happy_var_2) -> + happyIn109 + (sLL happy_var_1 happy_var_2 ((epUniTok happy_var_1, noAnn), sLLa happy_var_1 happy_var_2 (KindSig noExtField happy_var_2)) + )}} + +happyReduce_240 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_240 = happyMonadReduce 2# 93# happyReduction_240 +happyReduction_240 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut187 happy_x_2 of { (HappyWrap187 happy_var_2) -> + ( do { tvb <- fromSpecTyVarBndr happy_var_2 + ; return $ sLL happy_var_1 happy_var_2 ((noAnn, epTok happy_var_1), sLLa happy_var_1 happy_var_2 (TyVarSig noExtField tvb))})}}) + ) (\r -> happyReturn (happyIn109 r)) + +happyReduce_241 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_241 = happySpecReduce_0 94# happyReduction_241 +happyReduction_241 = happyIn110 + (noLoc (noAnn, (noLocA (NoSig noExtField), Nothing)) + ) + +happyReduce_242 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_242 = happySpecReduce_2 94# happyReduction_242 +happyReduction_242 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut194 happy_x_2 of { (HappyWrap194 happy_var_2) -> + happyIn110 + (sLL happy_var_1 happy_var_2 ( (epUniTok happy_var_1, noAnn, noAnn) + , (sL1a happy_var_2 (KindSig noExtField happy_var_2), Nothing)) + )}} + +happyReduce_243 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_243 = happyMonadReduce 4# 94# happyReduction_243 +happyReduction_243 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut188 happy_x_2 of { (HappyWrap188 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut95 happy_x_4 of { (HappyWrap95 happy_var_4) -> + ( do { tvb <- fromSpecTyVarBndr happy_var_2 + ; return $ sLL happy_var_1 happy_var_4 ((noAnn, epTok happy_var_1, epTok happy_var_3) + , (sLLa happy_var_1 happy_var_2 (TyVarSig noExtField tvb), Just happy_var_4))})}}}}) + ) (\r -> happyReturn (happyIn110 r)) + +happyReduce_244 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_244 = happyMonadReduce 3# 95# happyReduction_244 +happyReduction_244 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut170 happy_x_1 of { (HappyWrap170 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + ( acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc (Just (addTrailingDarrowC happy_var_1 happy_var_2 cs), happy_var_3))))}}}) + ) (\r -> happyReturn (happyIn111 r)) + +happyReduce_245 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_245 = happySpecReduce_1 95# happyReduction_245 +happyReduction_245 happy_x_1 + = case happyOut172 happy_x_1 of { (HappyWrap172 happy_var_1) -> + happyIn111 + (sL1 happy_var_1 (Nothing, happy_var_1) + )} + +happyReduce_246 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_246 = happyMonadReduce 6# 96# happyReduction_246 +happyReduction_246 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut170 happy_x_4 of { (HappyWrap170 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut172 happy_x_6 of { (HappyWrap172 happy_var_6) -> + ( hintExplicitForall happy_var_1 + >> fromSpecTyVarBndrs happy_var_2 + >>= \tvbs -> + (acs (comb2 happy_var_1 happy_var_6) (\loc cs -> (L loc + (Just ( addTrailingDarrowC happy_var_4 happy_var_5 cs) + , mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) emptyComments) tvbs, happy_var_6)))))}}}}}}) + ) (\r -> happyReturn (happyIn112 r)) + +happyReduce_247 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_247 = happyMonadReduce 4# 96# happyReduction_247 +happyReduction_247 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut172 happy_x_4 of { (HappyWrap172 happy_var_4) -> + ( do { hintExplicitForall happy_var_1 + ; tvbs <- fromSpecTyVarBndrs happy_var_2 + ; let loc = comb2 happy_var_1 happy_var_4 + ; !cs <- getCommentsFor loc + ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1, epTok happy_var_3) cs) tvbs, happy_var_4)) + })}}}}) + ) (\r -> happyReturn (happyIn112 r)) + +happyReduce_248 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_248 = happyMonadReduce 3# 96# happyReduction_248 +happyReduction_248 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut170 happy_x_1 of { (HappyWrap170 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut172 happy_x_3 of { (HappyWrap172 happy_var_3) -> + ( acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc (Just (addTrailingDarrowC happy_var_1 happy_var_2 cs), mkHsOuterImplicit, happy_var_3))))}}}) + ) (\r -> happyReturn (happyIn112 r)) + +happyReduce_249 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_249 = happySpecReduce_1 96# happyReduction_249 +happyReduction_249 happy_x_1 + = case happyOut172 happy_x_1 of { (HappyWrap172 happy_var_1) -> + happyIn112 + (sL1 happy_var_1 (Nothing, mkHsOuterImplicit, happy_var_1) + )} + +happyReduce_250 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_250 = happyMonadReduce 4# 97# happyReduction_250 +happyReduction_250 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_4 (CType (getCTYPEs happy_var_1) (Just (Header (getSTRINGs happy_var_2) (getSTRING happy_var_2))) + (getSTRINGs happy_var_3,getSTRING happy_var_3))) + (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn (glR happy_var_2) (glR happy_var_3) noAnn noAnn))}}}}) + ) (\r -> happyReturn (happyIn113 r)) + +happyReduce_251 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_251 = happyMonadReduce 3# 97# happyReduction_251 +happyReduction_251 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 (CType (getCTYPEs happy_var_1) Nothing (getSTRINGs happy_var_2, getSTRING happy_var_2))) + (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn noAnn (glR happy_var_2) noAnn noAnn))}}}) + ) (\r -> happyReturn (happyIn113 r)) + +happyReduce_252 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_252 = happySpecReduce_0 97# happyReduction_252 +happyReduction_252 = happyIn113 + (Nothing + ) + +happyReduce_253 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_253 = happyMonadReduce 6# 98# happyReduction_253 +happyReduction_253 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut92 happy_x_2 of { (HappyWrap92 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut146 happy_x_4 of { (HappyWrap146 happy_var_4) -> + case happyOut89 happy_x_5 of { (HappyWrap89 happy_var_5) -> + case happyOut181 happy_x_6 of { (HappyWrap181 happy_var_6) -> + ( do { let { err = text "in the stand-alone deriving instance" + <> colon <+> quotes (ppr happy_var_6) } + ; amsA' (sLL happy_var_1 happy_var_6 + (DerivDecl (happy_var_4, (epTok happy_var_1, epTok happy_var_3)) (mkHsWildCardBndrs happy_var_6) happy_var_2 happy_var_5)) })}}}}}}) + ) (\r -> happyReturn (happyIn114 r)) + +happyReduce_254 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_254 = happyMonadReduce 4# 99# happyReduction_254 +happyReduction_254 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut298 happy_x_3 of { (HappyWrap298 happy_var_3) -> + case happyOut116 happy_x_4 of { (HappyWrap116 happy_var_4) -> + ( mkRoleAnnotDecl (comb3 happy_var_1 happy_var_4 happy_var_3) happy_var_3 (reverse (unLoc happy_var_4)) + (epTok happy_var_1,epTok happy_var_2))}}}}) + ) (\r -> happyReturn (happyIn115 r)) + +happyReduce_255 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_255 = happySpecReduce_0 100# happyReduction_255 +happyReduction_255 = happyIn116 + (noLoc [] + ) + +happyReduce_256 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_256 = happySpecReduce_1 100# happyReduction_256 +happyReduction_256 happy_x_1 + = case happyOut117 happy_x_1 of { (HappyWrap117 happy_var_1) -> + happyIn116 + (happy_var_1 + )} + +happyReduce_257 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_257 = happySpecReduce_1 101# happyReduction_257 +happyReduction_257 happy_x_1 + = case happyOut118 happy_x_1 of { (HappyWrap118 happy_var_1) -> + happyIn117 + (sLL happy_var_1 happy_var_1 [happy_var_1] + )} + +happyReduce_258 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_258 = happySpecReduce_2 101# happyReduction_258 +happyReduction_258 happy_x_2 + happy_x_1 + = case happyOut117 happy_x_1 of { (HappyWrap117 happy_var_1) -> + case happyOut118 happy_x_2 of { (HappyWrap118 happy_var_2) -> + happyIn117 + (sLL happy_var_1 happy_var_2 $ happy_var_2 : unLoc happy_var_1 + )}} + +happyReduce_259 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_259 = happySpecReduce_1 102# happyReduction_259 +happyReduction_259 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn118 + (sL1 happy_var_1 $ Just $ getVARID happy_var_1 + )} + +happyReduce_260 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_260 = happySpecReduce_1 102# happyReduction_260 +happyReduction_260 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn118 + (sL1 happy_var_1 Nothing + )} + +happyReduce_261 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_261 = happyMonadReduce 4# 103# happyReduction_261 +happyReduction_261 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { (HappyWrap120 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut258 happy_x_4 of { (HappyWrap258 happy_var_4) -> + ( let (name, args, (mo, mc) ) = happy_var_2 in + amsA' (sLL happy_var_1 happy_var_4 . ValD noExtField $ mkPatSynBind name args happy_var_4 + ImplicitBidirectional + (AnnPSB (epTok happy_var_1) mo mc Nothing (Just (epTok happy_var_3)))))}}}}) + ) (\r -> happyReturn (happyIn119 r)) + +happyReduce_262 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_262 = happyMonadReduce 4# 103# happyReduction_262 +happyReduction_262 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { (HappyWrap120 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut258 happy_x_4 of { (HappyWrap258 happy_var_4) -> + ( let (name, args, (mo,mc)) = happy_var_2 in + amsA' (sLL happy_var_1 happy_var_4 . ValD noExtField $ mkPatSynBind name args happy_var_4 Unidirectional + (AnnPSB (epTok happy_var_1) mo mc (Just (epUniTok happy_var_3)) Nothing)))}}}}) + ) (\r -> happyReturn (happyIn119 r)) + +happyReduce_263 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_263 = happyMonadReduce 5# 103# happyReduction_263 +happyReduction_263 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut120 happy_x_2 of { (HappyWrap120 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut258 happy_x_4 of { (HappyWrap258 happy_var_4) -> + case happyOut123 happy_x_5 of { (HappyWrap123 happy_var_5) -> + ( do { let (name, args, (mo,mc)) = happy_var_2 + ; mg <- mkPatSynMatchGroup name happy_var_5 + ; amsA' (sLL happy_var_1 happy_var_5 . ValD noExtField $ + mkPatSynBind name args happy_var_4 (ExplicitBidirectional mg) + (AnnPSB (epTok happy_var_1) mo mc (Just (epUniTok happy_var_3)) Nothing)) + })}}}}}) + ) (\r -> happyReturn (happyIn119 r)) + +happyReduce_264 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_264 = happySpecReduce_2 104# happyReduction_264 +happyReduction_264 happy_x_2 + happy_x_1 + = case happyOut288 happy_x_1 of { (HappyWrap288 happy_var_1) -> + case happyOut121 happy_x_2 of { (HappyWrap121 happy_var_2) -> + happyIn120 + ((happy_var_1, PrefixCon happy_var_2, noAnn) + )}} + +happyReduce_265 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_265 = happySpecReduce_3 104# happyReduction_265 +happyReduction_265 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + case happyOut294 happy_x_2 of { (HappyWrap294 happy_var_2) -> + case happyOut320 happy_x_3 of { (HappyWrap320 happy_var_3) -> + happyIn120 + ((happy_var_2, InfixCon happy_var_1 happy_var_3, noAnn) + )}}} + +happyReduce_266 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_266 = happyReduce 4# 104# happyReduction_266 +happyReduction_266 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut288 happy_x_1 of { (HappyWrap288 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut122 happy_x_3 of { (HappyWrap122 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn120 + ((happy_var_1, RecCon happy_var_3, (Just (epTok happy_var_2), Just (epTok happy_var_4))) + ) `HappyStk` happyRest}}}} + +happyReduce_267 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_267 = happySpecReduce_0 105# happyReduction_267 +happyReduction_267 = happyIn121 + ([] + ) + +happyReduce_268 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_268 = happySpecReduce_2 105# happyReduction_268 +happyReduction_268 happy_x_2 + happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + case happyOut121 happy_x_2 of { (HappyWrap121 happy_var_2) -> + happyIn121 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_269 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_269 = happySpecReduce_1 106# happyReduction_269 +happyReduction_269 happy_x_1 + = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + happyIn122 + ([RecordPatSynField (mkFieldOcc happy_var_1) happy_var_1] + )} + +happyReduce_270 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_270 = happyMonadReduce 3# 106# happyReduction_270 +happyReduction_270 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut122 happy_x_3 of { (HappyWrap122 happy_var_3) -> + ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) + ; return ((RecordPatSynField (mkFieldOcc h) h) : happy_var_3 )})}}}) + ) (\r -> happyReturn (happyIn122 r)) + +happyReduce_271 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_271 = happyMonadReduce 4# 107# happyReduction_271 +happyReduction_271 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut134 happy_x_3 of { (HappyWrap134 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( amsr (sLL happy_var_1 happy_var_4 (thdOf3 $ unLoc happy_var_3)) + (AnnList (Just (fstOf3 $ unLoc happy_var_3)) (ListBraces (epTok happy_var_2) (epTok happy_var_4)) (sndOf3 $ unLoc happy_var_3) (epTok happy_var_1) []))}}}}) + ) (\r -> happyReturn (happyIn123 r)) + +happyReduce_272 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_272 = happyMonadReduce 4# 107# happyReduction_272 +happyReduction_272 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut134 happy_x_3 of { (HappyWrap134 happy_var_3) -> + ( amsr (sLL happy_var_1 happy_var_3 (thdOf3 $ unLoc happy_var_3)) + (AnnList (Just (fstOf3 $ unLoc happy_var_3)) ListNone (sndOf3 $ unLoc happy_var_3) (epTok happy_var_1) []))}}) + ) (\r -> happyReturn (happyIn123 r)) + +happyReduce_273 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_273 = happyMonadReduce 4# 108# happyReduction_273 +happyReduction_273 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut289 happy_x_2 of { (HappyWrap289 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut163 happy_x_4 of { (HappyWrap163 happy_var_4) -> + ( amsA' (sLL happy_var_1 happy_var_4 + $ PatSynSig (AnnSig (epUniTok happy_var_3) (Just (epTok happy_var_1)) Nothing) + (toList $ unLoc happy_var_2) happy_var_4))}}}}) + ) (\r -> happyReturn (happyIn124 r)) + +happyReduce_274 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_274 = happySpecReduce_1 109# happyReduction_274 +happyReduction_274 happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + happyIn125 + (happy_var_1 + )} + +happyReduce_275 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_275 = happySpecReduce_1 109# happyReduction_275 +happyReduction_275 happy_x_1 + = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> + happyIn125 + (happy_var_1 + )} + +happyReduce_276 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_276 = happySpecReduce_1 110# happyReduction_276 +happyReduction_276 happy_x_1 + = case happyOut101 happy_x_1 of { (HappyWrap101 happy_var_1) -> + happyIn126 + (happy_var_1 + )} + +happyReduce_277 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_277 = happySpecReduce_1 110# happyReduction_277 +happyReduction_277 happy_x_1 + = case happyOut212 happy_x_1 of { (HappyWrap212 happy_var_1) -> + happyIn126 + (happy_var_1 + )} + +happyReduce_278 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_278 = happyMonadReduce 4# 110# happyReduction_278 +happyReduction_278 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut224 happy_x_2 of { (HappyWrap224 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut163 happy_x_4 of { (HappyWrap163 happy_var_4) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + do { v <- checkValSigLhs happy_var_2 + ; let err = text "in default signature" <> colon <+> + quotes (ppr happy_var_2) + ; amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField $ ClassOpSig (AnnSig (epUniTok happy_var_3) Nothing (Just (epTok happy_var_1))) True [v] happy_var_4) })}}}}) + ) (\r -> happyReturn (happyIn126 r)) + +happyReduce_279 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_279 = happyMonadReduce 3# 111# happyReduction_279 +happyReduction_279 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut127 happy_x_1 of { (HappyWrap127 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut126 happy_x_3 of { (HappyWrap126 happy_var_3) -> + ( if isNilOL (snd $ unLoc happy_var_1) + then return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + , unitOL happy_var_3)) + else case (snd $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1 + , snocOL hs t' `appOL` unitOL happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn127 r)) + +happyReduce_280 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_280 = happyMonadReduce 2# 111# happyReduction_280 +happyReduction_280 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut127 happy_x_1 of { (HappyWrap127 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( if isNilOL (snd $ unLoc happy_var_1) + then return (sLZ happy_var_1 happy_var_2 ( (fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,snd $ unLoc happy_var_1)) + else case (snd $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1 + , snocOL hs t')))}}) + ) (\r -> happyReturn (happyIn127 r)) + +happyReduce_281 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_281 = happySpecReduce_1 111# happyReduction_281 +happyReduction_281 happy_x_1 + = case happyOut126 happy_x_1 of { (HappyWrap126 happy_var_1) -> + happyIn127 + (sL1 happy_var_1 ([], unitOL happy_var_1) + )} + +happyReduce_282 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_282 = happySpecReduce_0 111# happyReduction_282 +happyReduction_282 = happyIn127 + (noLoc ([],nilOL) + ) + +happyReduce_283 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_283 = happySpecReduce_3 112# happyReduction_283 +happyReduction_283 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut127 happy_x_2 of { (HappyWrap127 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn128 + (sLL happy_var_1 happy_var_3 ((epTok happy_var_1, fst $ unLoc happy_var_2, epTok happy_var_3) + ,snd $ unLoc happy_var_2, epExplicitBraces happy_var_1 happy_var_3) + )}}} + +happyReduce_284 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_284 = happySpecReduce_3 112# happyReduction_284 +happyReduction_284 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut127 happy_x_2 of { (HappyWrap127 happy_var_2) -> + happyIn128 + (let { L l (anns, decls) = happy_var_2 } + in L l ((NoEpTok, anns, NoEpTok), decls, EpVirtualBraces (getVOCURLY happy_var_1)) + )}} + +happyReduce_285 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_285 = happySpecReduce_2 113# happyReduction_285 +happyReduction_285 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut128 happy_x_2 of { (HappyWrap128 happy_var_2) -> + happyIn129 + (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,fstOf3 $ unLoc happy_var_2) + ,sndOf3 $ unLoc happy_var_2,thdOf3 $ unLoc happy_var_2) + )}} + +happyReduce_286 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_286 = happySpecReduce_0 113# happyReduction_286 +happyReduction_286 = happyIn129 + (noLoc ((noAnn, noAnn),nilOL,EpNoLayout) + ) + +happyReduce_287 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_287 = happySpecReduce_1 114# happyReduction_287 +happyReduction_287 happy_x_1 + = case happyOut104 happy_x_1 of { (HappyWrap104 happy_var_1) -> + happyIn130 + (sL1 happy_var_1 (unitOL (sL1a happy_var_1 (InstD noExtField (unLoc happy_var_1)))) + )} + +happyReduce_288 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_288 = happySpecReduce_1 114# happyReduction_288 +happyReduction_288 happy_x_1 + = case happyOut212 happy_x_1 of { (HappyWrap212 happy_var_1) -> + happyIn130 + (sL1 happy_var_1 (unitOL happy_var_1) + )} + +happyReduce_289 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_289 = happyMonadReduce 3# 115# happyReduction_289 +happyReduction_289 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut131 happy_x_1 of { (HappyWrap131 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut130 happy_x_3 of { (HappyWrap130 happy_var_3) -> + ( if isNilOL (snd $ unLoc happy_var_1) + then return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + , unLoc happy_var_3)) + else case (snd $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1 + , snocOL hs t' `appOL` unLoc happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn131 r)) + +happyReduce_290 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_290 = happyMonadReduce 2# 115# happyReduction_290 +happyReduction_290 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut131 happy_x_1 of { (HappyWrap131 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( if isNilOL (snd $ unLoc happy_var_1) + then return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,snd $ unLoc happy_var_1)) + else case (snd $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1 + , snocOL hs t')))}}) + ) (\r -> happyReturn (happyIn131 r)) + +happyReduce_291 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_291 = happySpecReduce_1 115# happyReduction_291 +happyReduction_291 happy_x_1 + = case happyOut130 happy_x_1 of { (HappyWrap130 happy_var_1) -> + happyIn131 + (sL1 happy_var_1 ([],unLoc happy_var_1) + )} + +happyReduce_292 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_292 = happySpecReduce_0 115# happyReduction_292 +happyReduction_292 = happyIn131 + (noLoc ([],nilOL) + ) + +happyReduce_293 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_293 = happySpecReduce_3 116# happyReduction_293 +happyReduction_293 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut131 happy_x_2 of { (HappyWrap131 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn132 + (sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_3,fst $ unLoc happy_var_2),snd $ unLoc happy_var_2) + )}}} + +happyReduce_294 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_294 = happySpecReduce_3 116# happyReduction_294 +happyReduction_294 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut131 happy_x_2 of { (HappyWrap131 happy_var_2) -> + happyIn132 + (L (gl happy_var_2) ((noAnn,noAnn,fst $ unLoc happy_var_2),snd $ unLoc happy_var_2) + )} + +happyReduce_295 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_295 = happySpecReduce_2 117# happyReduction_295 +happyReduction_295 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut132 happy_x_2 of { (HappyWrap132 happy_var_2) -> + happyIn133 + (sLL happy_var_1 happy_var_2 ((epTok happy_var_1,(fst $ unLoc happy_var_2)) + ,snd $ unLoc happy_var_2) + )}} + +happyReduce_296 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_296 = happySpecReduce_0 117# happyReduction_296 +happyReduction_296 = happyIn133 + (noLoc (noAnn,nilOL) + ) + +happyReduce_297 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_297 = happyMonadReduce 3# 118# happyReduction_297 +happyReduction_297 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut134 happy_x_1 of { (HappyWrap134 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut212 happy_x_3 of { (HappyWrap212 happy_var_3) -> + ( if isNilOL (thdOf3 $ unLoc happy_var_1) + then return (sLL happy_var_2 happy_var_3 (glR happy_var_3, (sndOf3 $ unLoc happy_var_1) ++ (msemiA happy_var_2) + , unitOL happy_var_3)) + else case (thdOf3 $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + let { this = unitOL happy_var_3; + rest = snocOL hs t'; + these = rest `appOL` this } + return (rest `seq` this `seq` these `seq` + (sLL happy_var_1 happy_var_3 (glEE (fstOf3 $ unLoc happy_var_1) happy_var_3, sndOf3 $ unLoc happy_var_1, these))))}}}) + ) (\r -> happyReturn (happyIn134 r)) + +happyReduce_298 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_298 = happyMonadReduce 2# 118# happyReduction_298 +happyReduction_298 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut134 happy_x_1 of { (HappyWrap134 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( if isNilOL (thdOf3 $ unLoc happy_var_1) + then return (sLZ happy_var_1 happy_var_2 (glR happy_var_2, (sndOf3 $ unLoc happy_var_1) ++ (msemiA happy_var_2) + ,thdOf3 $ unLoc happy_var_1)) + else case (thdOf3 $ unLoc happy_var_1) of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (glEEz happy_var_1 happy_var_2, sndOf3 $ unLoc happy_var_1, snocOL hs t')))}}) + ) (\r -> happyReturn (happyIn134 r)) + +happyReduce_299 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_299 = happySpecReduce_1 118# happyReduction_299 +happyReduction_299 happy_x_1 + = case happyOut212 happy_x_1 of { (HappyWrap212 happy_var_1) -> + happyIn134 + (sL1 happy_var_1 (glR happy_var_1, [], unitOL happy_var_1) + )} + +happyReduce_300 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_300 = happySpecReduce_0 118# happyReduction_300 +happyReduction_300 = happyIn134 + (noLoc (noAnn, [],nilOL) + ) + +happyReduce_301 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_301 = happySpecReduce_3 119# happyReduction_301 +happyReduction_301 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut134 happy_x_2 of { (HappyWrap134 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn135 + (sLL happy_var_1 happy_var_3 (AnnList (Just (fstOf3 $ unLoc happy_var_2)) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (sndOf3 $ unLoc happy_var_2) noAnn [] + ,sL1 happy_var_2 $ thdOf3 $ unLoc happy_var_2) + )}}} + +happyReduce_302 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_302 = happySpecReduce_3 119# happyReduction_302 +happyReduction_302 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut134 happy_x_2 of { (HappyWrap134 happy_var_2) -> + happyIn135 + (sL1 happy_var_2 (AnnList (Just (fstOf3 $ unLoc happy_var_2)) ListNone (sndOf3 $ unLoc happy_var_2) noAnn [] + ,sL1 happy_var_2 $ thdOf3 $ unLoc happy_var_2) + )} + +happyReduce_303 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_303 = happyMonadReduce 1# 120# happyReduction_303 +happyReduction_303 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut135 happy_x_1 of { (HappyWrap135 happy_var_1) -> + ( do { let { (AnnList anc p s _ t, decls) = unLoc happy_var_1 } + ; val_binds <- cvBindGroup (unLoc $ decls) + ; !cs <- getCommentsFor (gl happy_var_1) + ; return (sL1 happy_var_1 $ HsValBinds (EpAnn (glR happy_var_1) (AnnList anc p s noAnn t) cs) val_binds)})}) + ) (\r -> happyReturn (happyIn136 r)) + +happyReduce_304 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_304 = happyMonadReduce 3# 120# happyReduction_304 +happyReduction_304 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut275 happy_x_2 of { (HappyWrap275 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( acs (comb3 happy_var_1 happy_var_2 happy_var_3) (\loc cs -> (L loc + $ HsIPBinds (EpAnn (spanAsAnchor (comb3 happy_var_1 happy_var_2 happy_var_3)) (AnnList (Just$ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc happy_var_2)))))}}}) + ) (\r -> happyReturn (happyIn136 r)) + +happyReduce_305 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_305 = happyMonadReduce 3# 120# happyReduction_305 +happyReduction_305 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut275 happy_x_2 of { (HappyWrap275 happy_var_2) -> + ( acs (gl happy_var_2) (\loc cs -> (L loc + $ HsIPBinds (EpAnn (glR happy_var_1) (AnnList (Just $ glR happy_var_2) ListNone [] noAnn []) cs) (IPBinds noExtField (reverse $ unLoc happy_var_2)))))}}) + ) (\r -> happyReturn (happyIn136 r)) + +happyReduce_306 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_306 = happyMonadReduce 2# 121# happyReduction_306 +happyReduction_306 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut136 happy_x_2 of { (HappyWrap136 happy_var_2) -> + ( do { r <- acs (comb2 happy_var_1 happy_var_2) (\loc cs -> + (L loc (annBinds (epTok happy_var_1) cs (unLoc happy_var_2)))) + ; return $ Just r})}}) + ) (\r -> happyReturn (happyIn137 r)) + +happyReduce_307 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_307 = happySpecReduce_0 121# happyReduction_307 +happyReduction_307 = happyIn137 + (Nothing + ) + +happyReduce_308 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_308 = happyMonadReduce 3# 122# happyReduction_308 +happyReduction_308 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut138 happy_x_1 of { (HappyWrap138 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut139 happy_x_3 of { (HappyWrap139 happy_var_3) -> + ( case happy_var_1 of + [] -> return (happy_var_3:happy_var_1) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (happy_var_3:h':t))}}}) + ) (\r -> happyReturn (happyIn138 r)) + +happyReduce_309 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_309 = happyMonadReduce 2# 122# happyReduction_309 +happyReduction_309 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut138 happy_x_1 of { (HappyWrap138 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( case happy_var_1 of + [] -> return happy_var_1 + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (h':t))}}) + ) (\r -> happyReturn (happyIn138 r)) + +happyReduce_310 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_310 = happySpecReduce_1 122# happyReduction_310 +happyReduction_310 happy_x_1 + = case happyOut139 happy_x_1 of { (HappyWrap139 happy_var_1) -> + happyIn138 + ([happy_var_1] + )} + +happyReduce_311 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_311 = happySpecReduce_0 122# happyReduction_311 +happyReduction_311 = happyIn138 + ([] + ) + +happyReduce_312 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_312 = happyMonadReduce 6# 123# happyReduction_312 +happyReduction_312 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut140 happy_x_2 of { (HappyWrap140 happy_var_2) -> + case happyOut143 happy_x_3 of { (HappyWrap143 happy_var_3) -> + case happyOut224 happy_x_4 of { (HappyWrap224 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut221 happy_x_6 of { (HappyWrap221 happy_var_6) -> + (runPV (unECP happy_var_4) >>= \ happy_var_4 -> + runPV (unECP happy_var_6) >>= \ happy_var_6 -> + amsA' (sLL happy_var_1 happy_var_6 $ HsRule + { rd_ext =((fst happy_var_2, epTok happy_var_5), getSTRINGs happy_var_1) + , rd_name = L (noAnnSrcSpan $ gl happy_var_1) (getSTRING happy_var_1) + , rd_act = snd happy_var_2 `orElse` AlwaysActive + , rd_bndrs = ruleBndrsOrDef happy_var_3 + , rd_lhs = happy_var_4, rd_rhs = happy_var_6 }))}}}}}}) + ) (\r -> happyReturn (happyIn139 r)) + +happyReduce_313 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_313 = happySpecReduce_0 124# happyReduction_313 +happyReduction_313 = happyIn140 + ((noAnn, Nothing) + ) + +happyReduce_314 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_314 = happySpecReduce_1 124# happyReduction_314 +happyReduction_314 happy_x_1 + = case happyOut142 happy_x_1 of { (HappyWrap142 happy_var_1) -> + happyIn140 + ((fst happy_var_1,Just (snd happy_var_1)) + )} + +happyReduce_315 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_315 = happySpecReduce_1 125# happyReduction_315 +happyReduction_315 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn141 + ((Just (epTok happy_var_1)) + )} + +happyReduce_316 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_316 = happyMonadReduce 1# 125# happyReduction_316 +happyReduction_316 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( if (getVARSYM happy_var_1 == fsLit "~") + then return (Just (epTok happy_var_1)) + else do { addError $ mkPlainErrorMsgEnvelope (getLoc happy_var_1) $ + PsErrInvalidRuleActivationMarker + ; return Nothing })}) + ) (\r -> happyReturn (happyIn141 r)) + +happyReduce_317 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_317 = happySpecReduce_3 126# happyReduction_317 +happyReduction_317 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn142 + (( ActivationAnn (epTok happy_var_1) (epTok happy_var_3) Nothing (Just (glR happy_var_2)) + , ActiveAfter (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2)))) + )}}} + +happyReduce_318 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_318 = happyReduce 4# 126# happyReduction_318 +happyReduction_318 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut141 happy_x_2 of { (HappyWrap141 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn142 + (( ActivationAnn (epTok happy_var_1) (epTok happy_var_4) happy_var_2 (Just (glR happy_var_3)) + , ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3)))) + ) `HappyStk` happyRest}}}} + +happyReduce_319 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_319 = happySpecReduce_3 126# happyReduction_319 +happyReduction_319 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut141 happy_x_2 of { (HappyWrap141 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn142 + (( ActivationAnn (epTok happy_var_1) (epTok happy_var_3) happy_var_2 Nothing + , NeverActive) + )}}} + +happyReduce_320 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_320 = happyMonadReduce 6# 127# happyReduction_320 +happyReduction_320 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut144 happy_x_2 of { (HappyWrap144 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut144 happy_x_5 of { (HappyWrap144 happy_var_5) -> + case happyOutTok happy_x_6 of { happy_var_6 -> + ( hintExplicitForall happy_var_1 + >> checkRuleTyVarBndrNames happy_var_2 + >> let ann = HsRuleBndrsAnn + (Just (epUniTok happy_var_1,epTok happy_var_3)) + (Just (epUniTok happy_var_4,epTok happy_var_6)) + in return (Just (mkRuleBndrs ann (Just happy_var_2) happy_var_5)))}}}}}}) + ) (\r -> happyReturn (happyIn143 r)) + +happyReduce_321 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_321 = happySpecReduce_3 127# happyReduction_321 +happyReduction_321 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut144 happy_x_2 of { (HappyWrap144 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn143 + (Just (mkRuleBndrs (HsRuleBndrsAnn Nothing (Just (epUniTok happy_var_1,epTok happy_var_3))) + Nothing happy_var_2) + )}}} + +happyReduce_322 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_322 = happySpecReduce_0 127# happyReduction_322 +happyReduction_322 = happyIn143 + (Nothing + ) + +happyReduce_323 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_323 = happySpecReduce_2 128# happyReduction_323 +happyReduction_323 happy_x_2 + happy_x_1 + = case happyOut145 happy_x_1 of { (HappyWrap145 happy_var_1) -> + case happyOut144 happy_x_2 of { (HappyWrap144 happy_var_2) -> + happyIn144 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_324 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_324 = happySpecReduce_0 128# happyReduction_324 +happyReduction_324 = happyIn144 + ([] + ) + +happyReduce_325 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_325 = happySpecReduce_1 129# happyReduction_325 +happyReduction_325 happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + happyIn145 + (sL1a happy_var_1 (RuleTyTmVar noAnn happy_var_1 Nothing) + )} + +happyReduce_326 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_326 = happyMonadReduce 5# 129# happyReduction_326 +happyReduction_326 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut320 happy_x_2 of { (HappyWrap320 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut169 happy_x_4 of { (HappyWrap169 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( amsA' (sLL happy_var_1 happy_var_5 (RuleTyTmVar (AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3)) happy_var_2 (Just happy_var_4))))}}}}}) + ) (\r -> happyReturn (happyIn145 r)) + +happyReduce_327 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_327 = happyMonadReduce 3# 130# happyReduction_327 +happyReduction_327 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut153 happy_x_2 of { (HappyWrap153 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_3 $ DeprecatedTxt (getDEPRECATED_PRAGs happy_var_1) (map stringLiteralToHsDocWst $ snd $ unLoc happy_var_2)) + (AnnPragma (glR happy_var_1) (epTok happy_var_3) (fst $ unLoc happy_var_2) noAnn noAnn noAnn noAnn))}}}) + ) (\r -> happyReturn (happyIn146 r)) + +happyReduce_328 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_328 = happyMonadReduce 4# 130# happyReduction_328 +happyReduction_328 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut147 happy_x_2 of { (HappyWrap147 happy_var_2) -> + case happyOut153 happy_x_3 of { (HappyWrap153 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( fmap Just $ amsr (sLL happy_var_1 happy_var_4 $ WarningTxt happy_var_2 (getWARNING_PRAGs happy_var_1) (map stringLiteralToHsDocWst $ snd $ unLoc happy_var_3)) + (AnnPragma (glR happy_var_1) (epTok happy_var_4) (fst $ unLoc happy_var_3) noAnn noAnn noAnn noAnn))}}}}) + ) (\r -> happyReturn (happyIn146 r)) + +happyReduce_329 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_329 = happySpecReduce_0 130# happyReduction_329 +happyReduction_329 = happyIn146 + (Nothing + ) + +happyReduce_330 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_330 = happySpecReduce_2 131# happyReduction_330 +happyReduction_330 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn147 + (Just (reLoc $ sLL happy_var_1 happy_var_2 $ InWarningCategory (epTok happy_var_1) (getSTRINGs happy_var_2) + (reLoc $ sL1 happy_var_2 $ mkWarningCategory (getSTRING happy_var_2))) + )}} + +happyReduce_331 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_331 = happySpecReduce_0 131# happyReduction_331 +happyReduction_331 = happyIn147 + (Nothing + ) + +happyReduce_332 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_332 = happyMonadReduce 3# 132# happyReduction_332 +happyReduction_332 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut148 happy_x_1 of { (HappyWrap148 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut149 happy_x_3 of { (HappyWrap149 happy_var_3) -> + ( if isNilOL happy_var_1 + then return (happy_var_1 `appOL` happy_var_3) + else case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (snocOL hs t' `appOL` happy_var_3))}}}) + ) (\r -> happyReturn (happyIn148 r)) + +happyReduce_333 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_333 = happyMonadReduce 2# 132# happyReduction_333 +happyReduction_333 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut148 happy_x_1 of { (HappyWrap148 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( if isNilOL happy_var_1 + then return happy_var_1 + else case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (snocOL hs t'))}}) + ) (\r -> happyReturn (happyIn148 r)) + +happyReduce_334 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_334 = happySpecReduce_1 132# happyReduction_334 +happyReduction_334 happy_x_1 + = case happyOut149 happy_x_1 of { (HappyWrap149 happy_var_1) -> + happyIn148 + (happy_var_1 + )} + +happyReduce_335 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_335 = happySpecReduce_0 132# happyReduction_335 +happyReduction_335 = happyIn148 + (nilOL + ) + +happyReduce_336 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_336 = happyMonadReduce 4# 133# happyReduction_336 +happyReduction_336 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut147 happy_x_1 of { (HappyWrap147 happy_var_1) -> + case happyOut150 happy_x_2 of { (HappyWrap150 happy_var_2) -> + case happyOut284 happy_x_3 of { (HappyWrap284 happy_var_3) -> + case happyOut153 happy_x_4 of { (HappyWrap153 happy_var_4) -> + ( fmap unitOL $ amsA' (L (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) + (Warning (unLoc happy_var_2, fst $ unLoc happy_var_4) (unLoc happy_var_3) + (WarningTxt happy_var_1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc happy_var_4))))}}}}) + ) (\r -> happyReturn (happyIn149 r)) + +happyReduce_337 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_337 = happySpecReduce_1 134# happyReduction_337 +happyReduction_337 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn150 + (sL1 happy_var_1 $ TypeNamespaceSpecifier (epTok happy_var_1) + )} + +happyReduce_338 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_338 = happySpecReduce_1 134# happyReduction_338 +happyReduction_338 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn150 + (sL1 happy_var_1 $ DataNamespaceSpecifier (epTok happy_var_1) + )} + +happyReduce_339 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_339 = happySpecReduce_0 134# happyReduction_339 +happyReduction_339 = happyIn150 + (sL0 $ NoNamespaceSpecifier + ) + +happyReduce_340 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_340 = happyMonadReduce 3# 135# happyReduction_340 +happyReduction_340 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut151 happy_x_1 of { (HappyWrap151 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut152 happy_x_3 of { (HappyWrap152 happy_var_3) -> + ( if isNilOL happy_var_1 + then return (happy_var_1 `appOL` happy_var_3) + else case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (snocOL hs t' `appOL` happy_var_3))}}}) + ) (\r -> happyReturn (happyIn151 r)) + +happyReduce_341 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_341 = happyMonadReduce 2# 135# happyReduction_341 +happyReduction_341 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut151 happy_x_1 of { (HappyWrap151 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( if isNilOL happy_var_1 + then return happy_var_1 + else case happy_var_1 of + SnocOL hs t -> do + t' <- addTrailingSemiA t (epTok happy_var_2) + return (snocOL hs t'))}}) + ) (\r -> happyReturn (happyIn151 r)) + +happyReduce_342 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_342 = happySpecReduce_1 135# happyReduction_342 +happyReduction_342 happy_x_1 + = case happyOut152 happy_x_1 of { (HappyWrap152 happy_var_1) -> + happyIn151 + (happy_var_1 + )} + +happyReduce_343 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_343 = happySpecReduce_0 135# happyReduction_343 +happyReduction_343 = happyIn151 + (nilOL + ) + +happyReduce_344 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_344 = happyMonadReduce 3# 136# happyReduction_344 +happyReduction_344 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut150 happy_x_1 of { (HappyWrap150 happy_var_1) -> + case happyOut284 happy_x_2 of { (HappyWrap284 happy_var_2) -> + case happyOut153 happy_x_3 of { (HappyWrap153 happy_var_3) -> + ( fmap unitOL $ amsA' (sL (comb3 happy_var_1 happy_var_2 happy_var_3) $ (Warning (unLoc happy_var_1, fst $ unLoc happy_var_3) (unLoc happy_var_2) + (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc happy_var_3))))}}}) + ) (\r -> happyReturn (happyIn152 r)) + +happyReduce_345 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_345 = happySpecReduce_1 137# happyReduction_345 +happyReduction_345 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn153 + (sL1 happy_var_1 (noAnn,[L (gl happy_var_1) (getStringLiteral happy_var_1)]) + )} + +happyReduce_346 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_346 = happySpecReduce_3 137# happyReduction_346 +happyReduction_346 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut154 happy_x_2 of { (HappyWrap154 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn153 + (sLL happy_var_1 happy_var_3 $ ((epTok happy_var_1,epTok happy_var_3),fromOL (unLoc happy_var_2)) + )}}} + +happyReduce_347 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_347 = happyMonadReduce 3# 138# happyReduction_347 +happyReduction_347 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut154 happy_x_1 of { (HappyWrap154 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( if isNilOL (unLoc happy_var_1) + then return (sLL happy_var_1 happy_var_3 (unLoc happy_var_1 `snocOL` + (L (gl happy_var_3) (getStringLiteral happy_var_3)))) + else case (unLoc happy_var_1) of + SnocOL hs t -> do + let { t' = addTrailingCommaS t (glR happy_var_2) } + return (sLL happy_var_1 happy_var_3 (snocOL hs t' `snocOL` + (L (gl happy_var_3) (getStringLiteral happy_var_3)))))}}}) + ) (\r -> happyReturn (happyIn154 r)) + +happyReduce_348 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_348 = happySpecReduce_1 138# happyReduction_348 +happyReduction_348 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn154 + (sLL happy_var_1 happy_var_1 (unitOL (L (gl happy_var_1) (getStringLiteral happy_var_1))) + )} + +happyReduce_349 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_349 = happySpecReduce_0 138# happyReduction_349 +happyReduction_349 = happyIn154 + (noLoc nilOL + ) + +happyReduce_350 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_350 = happyMonadReduce 4# 139# happyReduction_350 +happyReduction_350 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut285 happy_x_2 of { (HappyWrap285 happy_var_2) -> + case happyOut230 happy_x_3 of { (HappyWrap230 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> + amsA' (sLL happy_var_1 happy_var_4 (AnnD noExtField $ HsAnnotation + (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn noAnn noAnn noAnn noAnn, + (getANN_PRAGs happy_var_1)) + (ValueAnnProvenance happy_var_2) happy_var_3)))}}}}) + ) (\r -> happyReturn (happyIn155 r)) + +happyReduce_351 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_351 = happyMonadReduce 5# 139# happyReduction_351 +happyReduction_351 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut305 happy_x_3 of { (HappyWrap305 happy_var_3) -> + case happyOut230 happy_x_4 of { (HappyWrap230 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> + amsA' (sLL happy_var_1 happy_var_5 (AnnD noExtField $ HsAnnotation + (AnnPragma (glR happy_var_1) (epTok happy_var_5) noAnn noAnn noAnn (epTok happy_var_2) noAnn, + (getANN_PRAGs happy_var_1)) + (TypeAnnProvenance happy_var_3) happy_var_4)))}}}}}) + ) (\r -> happyReturn (happyIn155 r)) + +happyReduce_352 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_352 = happyMonadReduce 4# 139# happyReduction_352 +happyReduction_352 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut230 happy_x_3 of { (HappyWrap230 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> + amsA' (sLL happy_var_1 happy_var_4 (AnnD noExtField $ HsAnnotation + (AnnPragma (glR happy_var_1) (epTok happy_var_4) noAnn noAnn noAnn noAnn (epTok happy_var_2), + (getANN_PRAGs happy_var_1)) + ModuleAnnProvenance happy_var_3)))}}}}) + ) (\r -> happyReturn (happyIn155 r)) + +happyReduce_353 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_353 = happyMonadReduce 4# 140# happyReduction_353 +happyReduction_353 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut157 happy_x_2 of { (HappyWrap157 happy_var_2) -> + case happyOut158 happy_x_3 of { (HappyWrap158 happy_var_3) -> + case happyOut159 happy_x_4 of { (HappyWrap159 happy_var_4) -> + ( mkImport happy_var_2 happy_var_3 (snd $ unLoc happy_var_4) (epTok happy_var_1, fst $ unLoc happy_var_4) >>= \i -> + return (sLL happy_var_1 happy_var_4 i))}}}}) + ) (\r -> happyReturn (happyIn156 r)) + +happyReduce_354 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_354 = happyMonadReduce 3# 140# happyReduction_354 +happyReduction_354 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut157 happy_x_2 of { (HappyWrap157 happy_var_2) -> + case happyOut159 happy_x_3 of { (HappyWrap159 happy_var_3) -> + ( do { d <- mkImport happy_var_2 (noLoc PlaySafe) (snd $ unLoc happy_var_3) (epTok happy_var_1, fst $ unLoc happy_var_3); + return (sLL happy_var_1 happy_var_3 d) })}}}) + ) (\r -> happyReturn (happyIn156 r)) + +happyReduce_355 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_355 = happyMonadReduce 3# 140# happyReduction_355 +happyReduction_355 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut157 happy_x_2 of { (HappyWrap157 happy_var_2) -> + case happyOut159 happy_x_3 of { (HappyWrap159 happy_var_3) -> + ( mkExport happy_var_2 (snd $ unLoc happy_var_3) (epTok happy_var_1, fst $ unLoc happy_var_3) >>= \i -> + return (sLL happy_var_1 happy_var_3 i ))}}}) + ) (\r -> happyReturn (happyIn156 r)) + +happyReduce_356 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_356 = happySpecReduce_1 141# happyReduction_356 +happyReduction_356 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn157 + (sLL happy_var_1 happy_var_1 StdCallConv + )} + +happyReduce_357 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_357 = happySpecReduce_1 141# happyReduction_357 +happyReduction_357 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn157 + (sLL happy_var_1 happy_var_1 CCallConv + )} + +happyReduce_358 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_358 = happySpecReduce_1 141# happyReduction_358 +happyReduction_358 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn157 + (sLL happy_var_1 happy_var_1 CApiConv + )} + +happyReduce_359 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_359 = happySpecReduce_1 141# happyReduction_359 +happyReduction_359 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn157 + (sLL happy_var_1 happy_var_1 PrimCallConv + )} + +happyReduce_360 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_360 = happySpecReduce_1 141# happyReduction_360 +happyReduction_360 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn157 + (sLL happy_var_1 happy_var_1 JavaScriptCallConv + )} + +happyReduce_361 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_361 = happySpecReduce_1 142# happyReduction_361 +happyReduction_361 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn158 + (sLL happy_var_1 happy_var_1 PlayRisky + )} + +happyReduce_362 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_362 = happySpecReduce_1 142# happyReduction_362 +happyReduction_362 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn158 + (sLL happy_var_1 happy_var_1 PlaySafe + )} + +happyReduce_363 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_363 = happySpecReduce_1 142# happyReduction_363 +happyReduction_363 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn158 + (sLL happy_var_1 happy_var_1 PlayInterruptible + )} + +happyReduce_364 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_364 = happyReduce 4# 143# happyReduction_364 +happyReduction_364 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut316 happy_x_2 of { (HappyWrap316 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut163 happy_x_4 of { (HappyWrap163 happy_var_4) -> + happyIn159 + (sLL happy_var_1 happy_var_4 (epUniTok happy_var_3 + ,(L (getLoc happy_var_1) + (getStringLiteral happy_var_1), happy_var_2, happy_var_4)) + ) `HappyStk` happyRest}}}} + +happyReduce_365 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_365 = happyReduce 4# 143# happyReduction_365 +happyReduction_365 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut316 happy_x_2 of { (HappyWrap316 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut163 happy_x_4 of { (HappyWrap163 happy_var_4) -> + happyIn159 + (sLL happy_var_1 happy_var_4 (epUniTok happy_var_3 + ,(L (getLoc happy_var_1) + (getStringMultiLiteral happy_var_1), happy_var_2, happy_var_4)) + ) `HappyStk` happyRest}}}} + +happyReduce_366 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_366 = happySpecReduce_3 143# happyReduction_366 +happyReduction_366 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut163 happy_x_3 of { (HappyWrap163 happy_var_3) -> + happyIn159 + (sLL happy_var_1 happy_var_3 (epUniTok happy_var_2 + ,(noLoc (StringLiteral NoSourceText nilFS Nothing), happy_var_1, happy_var_3)) + )}}} + +happyReduce_367 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_367 = happySpecReduce_0 144# happyReduction_367 +happyReduction_367 = happyIn160 + (Nothing + ) + +happyReduce_368 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_368 = happySpecReduce_2 144# happyReduction_368 +happyReduction_368 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut169 happy_x_2 of { (HappyWrap169 happy_var_2) -> + happyIn160 + (Just (epUniTok happy_var_1, happy_var_2) + )}} + +happyReduce_369 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_369 = happySpecReduce_0 145# happyReduction_369 +happyReduction_369 = happyIn161 + ((Nothing, Nothing) + ) + +happyReduce_370 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_370 = happySpecReduce_2 145# happyReduction_370 +happyReduction_370 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut296 happy_x_2 of { (HappyWrap296 happy_var_2) -> + happyIn161 + ((Just (epUniTok happy_var_1), Just happy_var_2) + )}} + +happyReduce_371 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_371 = happySpecReduce_1 146# happyReduction_371 +happyReduction_371 happy_x_1 + = case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> + happyIn162 + (happy_var_1 + )} + +happyReduce_372 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_372 = happyMonadReduce 3# 146# happyReduction_372 +happyReduction_372 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut194 happy_x_3 of { (HappyWrap194 happy_var_3) -> + ( amsA' (sLL happy_var_1 happy_var_3 $ mkHsImplicitSigType $ + sLLa happy_var_1 happy_var_3 $ HsKindSig (epUniTok happy_var_2) happy_var_1 happy_var_3))}}}) + ) (\r -> happyReturn (happyIn162 r)) + +happyReduce_373 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_373 = happySpecReduce_1 147# happyReduction_373 +happyReduction_373 happy_x_1 + = case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> + happyIn163 + (hsTypeToHsSigType happy_var_1 + )} + +happyReduce_374 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_374 = happyMonadReduce 3# 148# happyReduction_374 +happyReduction_374 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut164 happy_x_1 of { (HappyWrap164 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut316 happy_x_3 of { (HappyWrap316 happy_var_3) -> + ( case unLoc happy_var_1 of + [] -> return (sLL happy_var_1 happy_var_3 (happy_var_3 : unLoc happy_var_1)) + (h:t) -> do + h' <- addTrailingCommaN h (gl happy_var_2) + return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)))}}}) + ) (\r -> happyReturn (happyIn164 r)) + +happyReduce_375 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_375 = happySpecReduce_1 148# happyReduction_375 +happyReduction_375 happy_x_1 + = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + happyIn164 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_376 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_376 = happySpecReduce_1 149# happyReduction_376 +happyReduction_376 happy_x_1 + = case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> + happyIn165 + (sL1 happy_var_1 (unitOL happy_var_1) + )} + +happyReduce_377 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_377 = happyMonadReduce 3# 149# happyReduction_377 +happyReduction_377 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut165 happy_x_3 of { (HappyWrap165 happy_var_3) -> + ( do { st <- addTrailingCommaA happy_var_1 (epTok happy_var_2) + ; return $ sLL happy_var_1 happy_var_3 (unitOL st `appOL` unLoc happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn165 r)) + +happyReduce_378 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_378 = happySpecReduce_2 150# happyReduction_378 +happyReduction_378 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn166 + (sLL happy_var_1 happy_var_2 (UnpackednessPragma (glR happy_var_1, epTok happy_var_2) (getUNPACK_PRAGs happy_var_1) SrcUnpack) + )}} + +happyReduce_379 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_379 = happySpecReduce_2 150# happyReduction_379 +happyReduction_379 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn166 + (sLL happy_var_1 happy_var_2 (UnpackednessPragma (glR happy_var_1, epTok happy_var_2) (getNOUNPACK_PRAGs happy_var_1) SrcNoUnpack) + )}} + +happyReduce_380 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_380 = happyMonadReduce 3# 151# happyReduction_380 +happyReduction_380 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { hintExplicitForall happy_var_1 + ; acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ + mkHsForAllInvisTele (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1,epTok happy_var_3) cs) happy_var_2 )) })}}}) + ) (\r -> happyReturn (happyIn167 r)) + +happyReduce_381 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_381 = happyMonadReduce 3# 151# happyReduction_381 +happyReduction_381 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { hintExplicitForall happy_var_1 + ; req_tvbs <- fromSpecTyVarBndrs happy_var_2 + ; acs (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ + mkHsForAllVisTele (EpAnn (glEE happy_var_1 happy_var_3) (epUniTok happy_var_1,epUniTok happy_var_3) cs) req_tvbs )) })}}}) + ) (\r -> happyReturn (happyIn167 r)) + +happyReduce_382 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_382 = happySpecReduce_1 152# happyReduction_382 +happyReduction_382 happy_x_1 + = case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> + happyIn168 + (happy_var_1 + )} + +happyReduce_383 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_383 = happyMonadReduce 3# 152# happyReduction_383 +happyReduction_383 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut194 happy_x_3 of { (HappyWrap194 happy_var_3) -> + ( amsA' (sLL happy_var_1 happy_var_3 $ HsKindSig (epUniTok happy_var_2) happy_var_1 happy_var_3))}}}) + ) (\r -> happyReturn (happyIn168 r)) + +happyReduce_384 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_384 = happySpecReduce_2 153# happyReduction_384 +happyReduction_384 happy_x_2 + happy_x_1 + = case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> + case happyOut169 happy_x_2 of { (HappyWrap169 happy_var_2) -> + happyIn169 + (sLLa happy_var_1 happy_var_2 $ + HsForAllTy { hst_tele = unLoc happy_var_1 + , hst_xforall = noExtField + , hst_body = happy_var_2 } + )}} + +happyReduce_385 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_385 = happyMonadReduce 3# 153# happyReduction_385 +happyReduction_385 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut170 happy_x_1 of { (HappyWrap170 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + ( acsA (comb2 happy_var_1 happy_var_3) (\loc cs -> (L loc $ + HsQualTy { hst_ctxt = addTrailingDarrowC happy_var_1 happy_var_2 cs + , hst_xqual = NoExtField + , hst_body = happy_var_3 })))}}}) + ) (\r -> happyReturn (happyIn169 r)) + +happyReduce_386 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_386 = happyMonadReduce 3# 153# happyReduction_386 +happyReduction_386 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut277 happy_x_1 of { (HappyWrap277 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + ( amsA' (sLL happy_var_1 happy_var_3 (HsIParamTy (epUniTok happy_var_2) (reLoc happy_var_1) happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn169 r)) + +happyReduce_387 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_387 = happySpecReduce_1 153# happyReduction_387 +happyReduction_387 happy_x_1 + = case happyOut172 happy_x_1 of { (HappyWrap172 happy_var_1) -> + happyIn169 + (happy_var_1 + )} + +happyReduce_388 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_388 = happyMonadReduce 1# 154# happyReduction_388 +happyReduction_388 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> + ( checkContext happy_var_1)}) + ) (\r -> happyReturn (happyIn170 r)) + +happyReduce_389 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_389 = happySpecReduce_1 155# happyReduction_389 +happyReduction_389 happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + happyIn171 + (unECP happy_var_1 >>= \ happy_var_1 -> + checkContextPV happy_var_1 + )} + +happyReduce_390 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_390 = happySpecReduce_1 156# happyReduction_390 +happyReduction_390 happy_x_1 + = case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> + happyIn172 + (happy_var_1 + )} + +happyReduce_391 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_391 = happyMonadReduce 3# 156# happyReduction_391 +happyReduction_391 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + ( amsA' (sLL happy_var_1 happy_var_3 + $ HsFunTy noExtField (HsUnannotated (EpArrow (epUniTok happy_var_2))) happy_var_1 happy_var_3))}}}) + ) (\r -> happyReturn (happyIn172 r)) + +happyReduce_392 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_392 = happyMonadReduce 4# 156# happyReduction_392 +happyReduction_392 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> + case happyOut173 happy_x_2 of { (HappyWrap173 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut169 happy_x_4 of { (HappyWrap169 happy_var_4) -> + ( hintLinear (getLoc happy_var_2) + >> let arr = (unLoc happy_var_2) (epUniTok happy_var_3) + in amsA' (sLL happy_var_1 happy_var_4 $ HsFunTy noExtField arr happy_var_1 happy_var_4))}}}}) + ) (\r -> happyReturn (happyIn172 r)) + +happyReduce_393 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_393 = happyMonadReduce 3# 156# happyReduction_393 +happyReduction_393 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut175 happy_x_1 of { (HappyWrap175 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + ( hintLinear (getLoc happy_var_2) >> + amsA' (sLL happy_var_1 happy_var_3 $ HsFunTy noExtField (HsLinearAnn (EpLolly (epTok happy_var_2))) happy_var_1 happy_var_3))}}}) + ) (\r -> happyReturn (happyIn172 r)) + +happyReduce_394 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_394 = happySpecReduce_2 157# happyReduction_394 +happyReduction_394 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + happyIn173 + (sLL happy_var_1 happy_var_2 (mkMultAnn (epTok happy_var_1) happy_var_2 . EpArrow) + )}} + +happyReduce_395 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_395 = happySpecReduce_2 158# happyReduction_395 +happyReduction_395 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + happyIn174 + (unECP happy_var_2 >>= \ happy_var_2 -> + fmap (sLL happy_var_1 happy_var_2) (mkHsMultPV (epTok happy_var_1) happy_var_2) + )}} + +happyReduce_396 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_396 = happyMonadReduce 1# 159# happyReduction_396 +happyReduction_396 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> + ( runPV happy_var_1)}) + ) (\r -> happyReturn (happyIn175 r)) + +happyReduce_397 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_397 = happySpecReduce_1 160# happyReduction_397 +happyReduction_397 happy_x_1 + = case happyOut177 happy_x_1 of { (HappyWrap177 happy_var_1) -> + happyIn176 + (happy_var_1 + )} + +happyReduce_398 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_398 = happySpecReduce_3 160# happyReduction_398 +happyReduction_398 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut177 happy_x_1 of { (HappyWrap177 happy_var_1) -> + case happyOut179 happy_x_2 of { (HappyWrap179 happy_var_2) -> + case happyOut176 happy_x_3 of { (HappyWrap176 happy_var_3) -> + happyIn176 + (happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ happy_var_3 -> + do { let (op, prom) = happy_var_2 + ; when (looksLikeMult happy_var_1 op happy_var_3) $ hintLinear (getLocA op) + ; mkHsOpTyPV prom happy_var_1 op happy_var_3 } + )}}} + +happyReduce_399 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_399 = happySpecReduce_2 160# happyReduction_399 +happyReduction_399 happy_x_2 + happy_x_1 + = case happyOut166 happy_x_1 of { (HappyWrap166 happy_var_1) -> + case happyOut176 happy_x_2 of { (HappyWrap176 happy_var_2) -> + happyIn176 + (happy_var_2 >>= \ happy_var_2 -> + mkUnpackednessPV happy_var_1 happy_var_2 + )}} + +happyReduce_400 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_400 = happySpecReduce_1 161# happyReduction_400 +happyReduction_400 happy_x_1 + = case happyOut180 happy_x_1 of { (HappyWrap180 happy_var_1) -> + happyIn177 + (mkHsAppTyHeadPV happy_var_1 + )} + +happyReduce_401 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_401 = happySpecReduce_1 161# happyReduction_401 +happyReduction_401 happy_x_1 + = case happyOut179 happy_x_1 of { (HappyWrap179 happy_var_1) -> + happyIn177 + (failOpFewArgs (fst happy_var_1) + )} + +happyReduce_402 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_402 = happySpecReduce_2 161# happyReduction_402 +happyReduction_402 happy_x_2 + happy_x_1 + = case happyOut177 happy_x_1 of { (HappyWrap177 happy_var_1) -> + case happyOut178 happy_x_2 of { (HappyWrap178 happy_var_2) -> + happyIn177 + (happy_var_1 >>= \ happy_var_1 -> + mkHsAppTyPV happy_var_1 happy_var_2 + )}} + +happyReduce_403 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_403 = happySpecReduce_3 161# happyReduction_403 +happyReduction_403 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut177 happy_x_1 of { (HappyWrap177 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut180 happy_x_3 of { (HappyWrap180 happy_var_3) -> + happyIn177 + (happy_var_1 >>= \ happy_var_1 -> + mkHsAppKindTyPV happy_var_1 (epTok happy_var_2) happy_var_3 + )}}} + +happyReduce_404 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_404 = happySpecReduce_1 162# happyReduction_404 +happyReduction_404 happy_x_1 + = case happyOut180 happy_x_1 of { (HappyWrap180 happy_var_1) -> + happyIn178 + (happy_var_1 + )} + +happyReduce_405 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_405 = happyMonadReduce 2# 162# happyReduction_405 +happyReduction_405 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut166 happy_x_1 of { (HappyWrap166 happy_var_1) -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + ( addUnpackednessP happy_var_1 happy_var_2)}}) + ) (\r -> happyReturn (happyIn178 r)) + +happyReduce_406 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_406 = happySpecReduce_1 163# happyReduction_406 +happyReduction_406 happy_x_1 + = case happyOut300 happy_x_1 of { (HappyWrap300 happy_var_1) -> + happyIn179 + ((happy_var_1, NotPromoted) + )} + +happyReduce_407 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_407 = happySpecReduce_1 163# happyReduction_407 +happyReduction_407 happy_x_1 + = case happyOut314 happy_x_1 of { (HappyWrap314 happy_var_1) -> + happyIn179 + ((happy_var_1, NotPromoted) + )} + +happyReduce_408 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_408 = happyMonadReduce 2# 163# happyReduction_408 +happyReduction_408 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut295 happy_x_2 of { (HappyWrap295 happy_var_2) -> + ( do { op <- amsr (sLL happy_var_1 happy_var_2 (unLoc happy_var_2)) + (NameAnnQuote (epTok happy_var_1) (gl happy_var_2) []) + ; return (op, IsPromoted) })}}) + ) (\r -> happyReturn (happyIn179 r)) + +happyReduce_409 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_409 = happyMonadReduce 2# 163# happyReduction_409 +happyReduction_409 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut307 happy_x_2 of { (HappyWrap307 happy_var_2) -> + ( do { op <- amsr (sLL happy_var_1 happy_var_2 (unLoc happy_var_2)) + (NameAnnQuote (epTok happy_var_1) (gl happy_var_2) []) + ; return (op, IsPromoted) })}}) + ) (\r -> happyReturn (happyIn179 r)) + +happyReduce_410 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_410 = happyMonadReduce 1# 164# happyReduction_410 +happyReduction_410 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut297 happy_x_1 of { (HappyWrap297 happy_var_1) -> + ( amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted happy_var_1)))}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_411 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_411 = happyMonadReduce 1# 164# happyReduction_411 +happyReduction_411 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut313 happy_x_1 of { (HappyWrap313 happy_var_1) -> + ( amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted happy_var_1)))}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_412 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_412 = happySpecReduce_1 164# happyReduction_412 +happyReduction_412 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn180 + (sL1a happy_var_1 $ mkAnonWildCardTy (epTok happy_var_1) + )} + +happyReduce_413 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_413 = happyMonadReduce 1# 164# happyReduction_413 +happyReduction_413 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( do { warnStarIsType (getLoc happy_var_1) + ; return $ sL1a happy_var_1 (HsStarTy noExtField (isUnicode happy_var_1)) })}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_414 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_414 = happyMonadReduce 2# 164# happyReduction_414 +happyReduction_414 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 (mkBangTy (glR happy_var_1) SrcLazy happy_var_2)))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_415 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_415 = happyMonadReduce 2# 164# happyReduction_415 +happyReduction_415 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 (mkBangTy (glR happy_var_1) SrcStrict happy_var_2)))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_416 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_416 = happyMonadReduce 3# 164# happyReduction_416 +happyReduction_416 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut204 happy_x_2 of { (HappyWrap204 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { decls <- amsA' (sLL happy_var_1 happy_var_3 $ XHsType $ HsRecTy (AnnList (listAsAnchorM happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []) happy_var_2) + ; checkRecordSyntax decls })}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_417 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_417 = happyMonadReduce 2# 164# happyReduction_417 +happyReduction_417 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsA' . sLL happy_var_1 happy_var_2 =<< (mkTupleSyntaxTy (epTok happy_var_1) [] (epTok happy_var_2)))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_418 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_418 = happyMonadReduce 5# 164# happyReduction_418 +happyReduction_418 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut184 happy_x_4 of { (HappyWrap184 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( do { h <- addTrailingCommaA happy_var_2 (epTok happy_var_3) + ; amsA' . sLL happy_var_1 happy_var_5 =<< (mkTupleSyntaxTy (epTok happy_var_1) (h : happy_var_4) (epTok happy_var_5)) })}}}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_419 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_419 = happyMonadReduce 2# 164# happyReduction_419 +happyReduction_419 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( do { requireLTPuns PEP_TupleSyntaxType happy_var_1 happy_var_2 + ; amsA' (sLL happy_var_1 happy_var_2 $ HsTupleTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_2)) HsUnboxedTuple []) })}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_420 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_420 = happyMonadReduce 3# 164# happyReduction_420 +happyReduction_420 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut184 happy_x_2 of { (HappyWrap184 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { requireLTPuns PEP_TupleSyntaxType happy_var_1 happy_var_3 + ; amsA' (sLL happy_var_1 happy_var_3 $ HsTupleTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_3)) HsUnboxedTuple happy_var_2) })}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_421 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_421 = happyMonadReduce 3# 164# happyReduction_421 +happyReduction_421 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut185 happy_x_2 of { (HappyWrap185 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { requireLTPuns PEP_SumSyntaxType happy_var_1 happy_var_3 + ; amsA' (sLL happy_var_1 happy_var_3 $ HsSumTy (AnnParensHash (epTok happy_var_1) (epTok happy_var_3)) happy_var_2) })}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_422 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_422 = happyMonadReduce 3# 164# happyReduction_422 +happyReduction_422 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' . sLL happy_var_1 happy_var_3 =<< (mkListSyntaxTy1 (epTok happy_var_1) happy_var_2 (epTok happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_423 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_423 = happyMonadReduce 3# 164# happyReduction_423 +happyReduction_423 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ HsParTy (epTok happy_var_1, epTok happy_var_3) happy_var_2))}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_424 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_424 = happyMonadReduce 3# 164# happyReduction_424 +happyReduction_424 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_3 + ; amsA' (sLL happy_var_1 happy_var_3 $ HsExplicitTupleTy (epTok happy_var_1,epTok happy_var_2,epTok happy_var_3) IsPromoted []) })}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_425 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_425 = happyMonadReduce 2# 164# happyReduction_425 +happyReduction_425 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut287 happy_x_2 of { (HappyWrap287 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted happy_var_2))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_426 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_426 = happyMonadReduce 2# 164# happyReduction_426 +happyReduction_426 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut291 happy_x_2 of { (HappyWrap291 happy_var_2) -> + ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 (reLoc happy_var_2) + ; amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted (L (getLoc happy_var_2) $ nameRdrName (dataConName (unLoc happy_var_2)))) })}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_427 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_427 = happyMonadReduce 6# 164# happyReduction_427 +happyReduction_427 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut184 happy_x_5 of { (HappyWrap184 happy_var_5) -> + case happyOutTok happy_x_6 of { happy_var_6 -> + ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_6 + ; h <- addTrailingCommaA happy_var_3 (epTok happy_var_4) + ; amsA' (sLL happy_var_1 happy_var_6 $ HsExplicitTupleTy (epTok happy_var_1,epTok happy_var_2,epTok happy_var_6) IsPromoted (h : happy_var_5)) })}}}}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_428 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_428 = happyMonadReduce 2# 164# happyReduction_428 +happyReduction_428 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( withCombinedComments happy_var_1 happy_var_2 (mkListSyntaxTy0 (epTok happy_var_1) (epTok happy_var_2)))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_429 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_429 = happyMonadReduce 4# 164# happyReduction_429 +happyReduction_429 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut183 happy_x_3 of { (HappyWrap183 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( do { requireLTPuns PEP_QuoteDisambiguation happy_var_1 happy_var_4 + ; amsA' (sLL happy_var_1 happy_var_4 $ HsExplicitListTy (epTok happy_var_1, epTok happy_var_2, epTok happy_var_4) IsPromoted happy_var_3) })}}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_430 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_430 = happyMonadReduce 2# 164# happyReduction_430 +happyReduction_430 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut316 happy_x_2 of { (HappyWrap316 happy_var_2) -> + ( amsA' (sLL happy_var_1 happy_var_2 $ HsTyVar (epTok happy_var_1) IsPromoted happy_var_2))}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_431 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_431 = happySpecReduce_1 164# happyReduction_431 +happyReduction_431 happy_x_1 + = case happyOut220 happy_x_1 of { (HappyWrap220 happy_var_1) -> + happyIn180 + (mapLocA (HsSpliceTy noExtField) happy_var_1 + )} + +happyReduce_432 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_432 = happySpecReduce_1 164# happyReduction_432 +happyReduction_432 happy_x_1 + = case happyOut235 happy_x_1 of { (HappyWrap235 happy_var_1) -> + happyIn180 + (mapLocA (HsSpliceTy noExtField) happy_var_1 + )} + +happyReduce_433 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_433 = happyMonadReduce 5# 164# happyReduction_433 +happyReduction_433 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut184 happy_x_4 of { (HappyWrap184 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( do { h <- addTrailingCommaA happy_var_2 (epTok happy_var_3) + ; amsA' (sLL happy_var_1 happy_var_5 $ HsExplicitListTy (NoEpTok,epTok happy_var_1,epTok happy_var_5) NotPromoted (h:happy_var_4)) })}}}}}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_434 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_434 = happySpecReduce_1 164# happyReduction_434 +happyReduction_434 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn180 + (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsNumTy (getINTEGERs happy_var_1) + (il_value (getINTEGER happy_var_1)) + )} + +happyReduce_435 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_435 = happySpecReduce_1 164# happyReduction_435 +happyReduction_435 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn180 + (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsCharTy (getCHARs happy_var_1) + (getCHAR happy_var_1) + )} + +happyReduce_436 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_436 = happySpecReduce_1 164# happyReduction_436 +happyReduction_436 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn180 + (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsStrTy (getSTRINGs happy_var_1) + (getSTRING happy_var_1) + )} + +happyReduce_437 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_437 = happySpecReduce_1 164# happyReduction_437 +happyReduction_437 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn180 + (sLLa happy_var_1 happy_var_1 $ HsTyLit noExtField $ HsStrTy (getSTRINGMULTIs happy_var_1) + (getSTRINGMULTI happy_var_1) + )} + +happyReduce_438 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_438 = happyMonadReduce 1# 164# happyReduction_438 +happyReduction_438 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( let qname = mkQual tvName (getQVARID happy_var_1) + in amsA' (sL1 happy_var_1 (HsTyVar noAnn NotPromoted (sL1n happy_var_1 $ qname))))}) + ) (\r -> happyReturn (happyIn180 r)) + +happyReduce_439 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_439 = happySpecReduce_1 165# happyReduction_439 +happyReduction_439 happy_x_1 + = case happyOut163 happy_x_1 of { (HappyWrap163 happy_var_1) -> + happyIn181 + (happy_var_1 + )} + +happyReduce_440 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_440 = happySpecReduce_1 166# happyReduction_440 +happyReduction_440 happy_x_1 + = case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> + happyIn182 + ([happy_var_1] + )} + +happyReduce_441 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_441 = happyMonadReduce 3# 166# happyReduction_441 +happyReduction_441 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut162 happy_x_1 of { (HappyWrap162 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut182 happy_x_3 of { (HappyWrap182 happy_var_3) -> + ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) + ; return (h : happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn182 r)) + +happyReduce_442 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_442 = happySpecReduce_1 167# happyReduction_442 +happyReduction_442 happy_x_1 + = case happyOut184 happy_x_1 of { (HappyWrap184 happy_var_1) -> + happyIn183 + (happy_var_1 + )} + +happyReduce_443 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_443 = happySpecReduce_0 167# happyReduction_443 +happyReduction_443 = happyIn183 + ([] + ) + +happyReduce_444 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_444 = happySpecReduce_1 168# happyReduction_444 +happyReduction_444 happy_x_1 + = case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> + happyIn184 + ([happy_var_1] + )} + +happyReduce_445 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_445 = happyMonadReduce 3# 168# happyReduction_445 +happyReduction_445 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut184 happy_x_3 of { (HappyWrap184 happy_var_3) -> + ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) + ; return (h : happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn184 r)) + +happyReduce_446 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_446 = happyMonadReduce 3# 169# happyReduction_446 +happyReduction_446 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut168 happy_x_3 of { (HappyWrap168 happy_var_3) -> + ( do { h <- addTrailingVbarA happy_var_1 (epTok happy_var_2) + ; return [h,happy_var_3] })}}}) + ) (\r -> happyReturn (happyIn185 r)) + +happyReduce_447 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_447 = happyMonadReduce 3# 169# happyReduction_447 +happyReduction_447 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut185 happy_x_3 of { (HappyWrap185 happy_var_3) -> + ( do { h <- addTrailingVbarA happy_var_1 (epTok happy_var_2) + ; return (h : happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn185 r)) + +happyReduce_448 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_448 = happySpecReduce_2 170# happyReduction_448 +happyReduction_448 happy_x_2 + happy_x_1 + = case happyOut187 happy_x_1 of { (HappyWrap187 happy_var_1) -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + happyIn186 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_449 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_449 = happySpecReduce_0 170# happyReduction_449 +happyReduction_449 = happyIn186 + ([] + ) + +happyReduce_450 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_450 = happySpecReduce_1 171# happyReduction_450 +happyReduction_450 happy_x_1 + = case happyOut188 happy_x_1 of { (HappyWrap188 happy_var_1) -> + happyIn187 + (happy_var_1 + )} + +happyReduce_451 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_451 = happyMonadReduce 3# 171# happyReduction_451 +happyReduction_451 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 + (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_3] noAnn noAnn + , tvb_flag = InferredSpec + , tvb_var = HsBndrVar noExtField happy_var_2 + , tvb_kind = HsBndrNoKind noExtField })))}}}) + ) (\r -> happyReturn (happyIn187 r)) + +happyReduce_452 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_452 = happyMonadReduce 5# 171# happyReduction_452 +happyReduction_452 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut194 happy_x_4 of { (HappyWrap194 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( amsA' (sLL happy_var_1 happy_var_5 + (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3) + , tvb_flag = InferredSpec + , tvb_var = HsBndrVar noExtField happy_var_2 + , tvb_kind = HsBndrKind noExtField happy_var_4 })))}}}}}) + ) (\r -> happyReturn (happyIn187 r)) + +happyReduce_453 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_453 = happyMonadReduce 1# 172# happyReduction_453 +happyReduction_453 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut189 happy_x_1 of { (HappyWrap189 happy_var_1) -> + ( amsA' (sL1 happy_var_1 + (HsTvb { tvb_ext = noAnn + , tvb_flag = SpecifiedSpec + , tvb_var = unLoc happy_var_1 + , tvb_kind = HsBndrNoKind noExtField })))}) + ) (\r -> happyReturn (happyIn188 r)) + +happyReduce_454 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_454 = happyMonadReduce 5# 172# happyReduction_454 +happyReduction_454 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut189 happy_x_2 of { (HappyWrap189 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut194 happy_x_4 of { (HappyWrap194 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + ( amsA' (sLL happy_var_1 happy_var_5 + (HsTvb { tvb_ext = AnnTyVarBndr [glR happy_var_1] [glR happy_var_5] noAnn (epUniTok happy_var_3) + , tvb_flag = SpecifiedSpec + , tvb_var = unLoc happy_var_2 + , tvb_kind = HsBndrKind noExtField happy_var_4 })))}}}}}) + ) (\r -> happyReturn (happyIn188 r)) + +happyReduce_455 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_455 = happySpecReduce_1 173# happyReduction_455 +happyReduction_455 happy_x_1 + = case happyOut313 happy_x_1 of { (HappyWrap313 happy_var_1) -> + happyIn189 + (sL1 happy_var_1 (HsBndrVar noExtField happy_var_1) + )} + +happyReduce_456 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_456 = happySpecReduce_1 173# happyReduction_456 +happyReduction_456 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn189 + (sL1 happy_var_1 (HsBndrWildCard (epTok happy_var_1)) + )} + +happyReduce_457 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_457 = happySpecReduce_0 174# happyReduction_457 +happyReduction_457 = happyIn190 + (noLoc (NoEpTok,[]) + ) + +happyReduce_458 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_458 = happySpecReduce_2 174# happyReduction_458 +happyReduction_458 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut191 happy_x_2 of { (HappyWrap191 happy_var_2) -> + happyIn190 + ((sLL happy_var_1 happy_var_2 (epTok happy_var_1 ,reverse (unLoc happy_var_2))) + )}} + +happyReduce_459 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_459 = happyMonadReduce 3# 175# happyReduction_459 +happyReduction_459 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut191 happy_x_1 of { (HappyWrap191 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut192 happy_x_3 of { (HappyWrap192 happy_var_3) -> + ( + do { let (h:t) = unLoc happy_var_1 -- Safe from fds1 rules + ; h' <- addTrailingCommaA h (epTok happy_var_2) + ; return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)) })}}}) + ) (\r -> happyReturn (happyIn191 r)) + +happyReduce_460 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_460 = happySpecReduce_1 175# happyReduction_460 +happyReduction_460 happy_x_1 + = case happyOut192 happy_x_1 of { (HappyWrap192 happy_var_1) -> + happyIn191 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_461 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_461 = happyMonadReduce 3# 176# happyReduction_461 +happyReduction_461 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut193 happy_x_1 of { (HappyWrap193 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut193 happy_x_3 of { (HappyWrap193 happy_var_3) -> + ( amsA' (L (comb3 happy_var_1 happy_var_2 happy_var_3) + (FunDep (epUniTok happy_var_2) + (reverse (unLoc happy_var_1)) + (reverse (unLoc happy_var_3)))))}}}) + ) (\r -> happyReturn (happyIn192 r)) + +happyReduce_462 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_462 = happySpecReduce_0 177# happyReduction_462 +happyReduction_462 = happyIn193 + (noLoc [] + ) + +happyReduce_463 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_463 = happySpecReduce_2 177# happyReduction_463 +happyReduction_463 happy_x_2 + happy_x_1 + = case happyOut193 happy_x_1 of { (HappyWrap193 happy_var_1) -> + case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> + happyIn193 + (sLL happy_var_1 happy_var_2 (happy_var_2 : (unLoc happy_var_1)) + )}} + +happyReduce_464 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_464 = happySpecReduce_1 178# happyReduction_464 +happyReduction_464 happy_x_1 + = case happyOut169 happy_x_1 of { (HappyWrap169 happy_var_1) -> + happyIn194 + (happy_var_1 + )} + +happyReduce_465 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_465 = happyMonadReduce 4# 179# happyReduction_465 +happyReduction_465 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut196 happy_x_3 of { (HappyWrap196 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( checkEmptyGADTs $ + L (comb2 happy_var_1 happy_var_4) + ((epTok happy_var_1 + ,epTok happy_var_2 + ,epTok happy_var_4) + , unLoc happy_var_3))}}}}) + ) (\r -> happyReturn (happyIn195 r)) + +happyReduce_466 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_466 = happyMonadReduce 4# 179# happyReduction_466 +happyReduction_466 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut196 happy_x_3 of { (HappyWrap196 happy_var_3) -> + ( checkEmptyGADTs $ + L (comb2 happy_var_1 happy_var_3) + ((epTok happy_var_1, NoEpTok, NoEpTok) + , unLoc happy_var_3))}}) + ) (\r -> happyReturn (happyIn195 r)) + +happyReduce_467 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_467 = happySpecReduce_0 179# happyReduction_467 +happyReduction_467 = happyIn195 + (noLoc (noAnn,[]) + ) + +happyReduce_468 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_468 = happyMonadReduce 3# 180# happyReduction_468 +happyReduction_468 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut197 happy_x_1 of { (HappyWrap197 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut196 happy_x_3 of { (HappyWrap196 happy_var_3) -> + ( do { h <- addTrailingSemiA happy_var_1 (epTok happy_var_2) + ; return (L (comb2 happy_var_1 happy_var_3) (h : unLoc happy_var_3)) })}}}) + ) (\r -> happyReturn (happyIn196 r)) + +happyReduce_469 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_469 = happySpecReduce_1 180# happyReduction_469 +happyReduction_469 happy_x_1 + = case happyOut197 happy_x_1 of { (HappyWrap197 happy_var_1) -> + happyIn196 + (L (glA happy_var_1) [happy_var_1] + )} + +happyReduce_470 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_470 = happySpecReduce_0 180# happyReduction_470 +happyReduction_470 = happyIn196 + (noLoc [] + ) + +happyReduce_471 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_471 = happyMonadReduce 4# 181# happyReduction_471 +happyReduction_471 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut289 happy_x_2 of { (HappyWrap289 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut163 happy_x_4 of { (HappyWrap163 happy_var_4) -> + ( mkGadtDecl (comb2 happy_var_2 happy_var_4) (unLoc happy_var_2) (epUniTok happy_var_3) happy_var_4)}}}) + ) (\r -> happyReturn (happyIn197 r)) + +happyReduce_472 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_472 = happySpecReduce_2 182# happyReduction_472 +happyReduction_472 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut199 happy_x_2 of { (HappyWrap199 happy_var_2) -> + happyIn198 + (sLL happy_var_1 happy_var_2 (epTok happy_var_1,unLoc happy_var_2) + )}} + +happyReduce_473 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_473 = happyMonadReduce 3# 183# happyReduction_473 +happyReduction_473 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut199 happy_x_1 of { (HappyWrap199 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut200 happy_x_3 of { (HappyWrap200 happy_var_3) -> + ( do { let (h:t) = unLoc happy_var_1 + ; h' <- addTrailingVbarA h (epTok happy_var_2) + ; return (sLL happy_var_1 happy_var_3 (happy_var_3 : h' : t)) })}}}) + ) (\r -> happyReturn (happyIn199 r)) + +happyReduce_474 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_474 = happySpecReduce_1 183# happyReduction_474 +happyReduction_474 happy_x_1 + = case happyOut200 happy_x_1 of { (HappyWrap200 happy_var_1) -> + happyIn199 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_475 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_475 = happyMonadReduce 4# 184# happyReduction_475 +happyReduction_475 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut201 happy_x_1 of { (HappyWrap201 happy_var_1) -> + case happyOut170 happy_x_2 of { (HappyWrap170 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut202 happy_x_4 of { (HappyWrap202 happy_var_4) -> + ( amsA' (let (con,details) = unLoc happy_var_4 in + (L (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_4) (mkConDeclH98 + (epUniTok happy_var_3,(fst $ unLoc happy_var_1)) + con + (snd $ unLoc happy_var_1) + (Just happy_var_2) + details))))}}}}) + ) (\r -> happyReturn (happyIn200 r)) + +happyReduce_476 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_476 = happyMonadReduce 2# 184# happyReduction_476 +happyReduction_476 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut201 happy_x_1 of { (HappyWrap201 happy_var_1) -> + case happyOut202 happy_x_2 of { (HappyWrap202 happy_var_2) -> + ( amsA' (let (con,details) = unLoc happy_var_2 in + (L (comb2 happy_var_1 happy_var_2) (mkConDeclH98 (noAnn, fst $ unLoc happy_var_1) + con + (snd $ unLoc happy_var_1) + Nothing -- No context + details))))}}) + ) (\r -> happyReturn (happyIn200 r)) + +happyReduce_477 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_477 = happySpecReduce_3 185# happyReduction_477 +happyReduction_477 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut186 happy_x_2 of { (HappyWrap186 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn201 + (sLL happy_var_1 happy_var_3 ((epUniTok happy_var_1,epTok happy_var_3), Just happy_var_2) + )}}} + +happyReduce_478 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_478 = happySpecReduce_0 185# happyReduction_478 +happyReduction_478 = happyIn201 + (noLoc (noAnn, Nothing) + ) + +happyReduce_479 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_479 = happyMonadReduce 1# 186# happyReduction_479 +happyReduction_479 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut176 happy_x_1 of { (HappyWrap176 happy_var_1) -> + ( do { b <- runPV happy_var_1 + ; return (sL1 b (dataConBuilderCon b, dataConBuilderDetails b)) })}) + ) (\r -> happyReturn (happyIn202 r)) + +happyReduce_480 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_480 = happyMonadReduce 3# 186# happyReduction_480 +happyReduction_480 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut203 happy_x_2 of { (HappyWrap203 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( let (t, tag, arity) = happy_var_2 in pure (sLL happy_var_1 happy_var_3 $ mkUnboxedSumCon t tag arity))}}}) + ) (\r -> happyReturn (happyIn202 r)) + +happyReduce_481 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_481 = happySpecReduce_2 187# happyReduction_481 +happyReduction_481 happy_x_2 + happy_x_1 + = case happyOut168 happy_x_1 of { (HappyWrap168 happy_var_1) -> + case happyOut337 happy_x_2 of { (HappyWrap337 happy_var_2) -> + happyIn203 + ((happy_var_1, 1, (snd happy_var_2 + 1)) + )}} + +happyReduce_482 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_482 = happySpecReduce_3 187# happyReduction_482 +happyReduction_482 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut337 happy_x_1 of { (HappyWrap337 happy_var_1) -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOut336 happy_x_3 of { (HappyWrap336 happy_var_3) -> + happyIn203 + ((happy_var_2, snd happy_var_1 + 1, snd happy_var_1 + snd happy_var_3 + 1) + )}}} + +happyReduce_483 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_483 = happySpecReduce_0 188# happyReduction_483 +happyReduction_483 = happyIn204 + ([] + ) + +happyReduce_484 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_484 = happySpecReduce_1 188# happyReduction_484 +happyReduction_484 happy_x_1 + = case happyOut205 happy_x_1 of { (HappyWrap205 happy_var_1) -> + happyIn204 + (happy_var_1 + )} + +happyReduce_485 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_485 = happyMonadReduce 3# 189# happyReduction_485 +happyReduction_485 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut206 happy_x_1 of { (HappyWrap206 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut205 happy_x_3 of { (HappyWrap205 happy_var_3) -> + ( do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) + ; return (h : happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn205 r)) + +happyReduce_486 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_486 = happySpecReduce_1 189# happyReduction_486 +happyReduction_486 happy_x_1 + = case happyOut206 happy_x_1 of { (HappyWrap206 happy_var_1) -> + happyIn205 + ([happy_var_1] + )} + +happyReduce_487 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_487 = happyMonadReduce 3# 190# happyReduction_487 +happyReduction_487 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut164 happy_x_1 of { (HappyWrap164 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + ( amsA' (L (comb2 happy_var_1 happy_var_3) + (HsConDeclRecField noExtField + (reverse (map (\ln@(L l n) + -> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc happy_var_1))) + (mkConDeclField (HsUnannotated (EpColon (epUniTok happy_var_2))) happy_var_3))))}}}) + ) (\r -> happyReturn (happyIn206 r)) + +happyReduce_488 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_488 = happyMonadReduce 5# 190# happyReduction_488 +happyReduction_488 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut164 happy_x_1 of { (HappyWrap164 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut180 happy_x_3 of { (HappyWrap180 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut169 happy_x_5 of { (HappyWrap169 happy_var_5) -> + ( amsA' (L (comb4 happy_var_1 happy_var_2 happy_var_3 happy_var_5) + (HsConDeclRecField noExtField + (reverse (map (\ln@(L l n) + -> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc happy_var_1))) + (mkMultField (epTok happy_var_2) happy_var_3 (epUniTok happy_var_4) happy_var_5))))}}}}}) + ) (\r -> happyReturn (happyIn206 r)) + +happyReduce_489 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_489 = happySpecReduce_0 191# happyReduction_489 +happyReduction_489 = happyIn207 + (noLoc [] + ) + +happyReduce_490 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_490 = happySpecReduce_1 191# happyReduction_490 +happyReduction_490 happy_x_1 + = case happyOut208 happy_x_1 of { (HappyWrap208 happy_var_1) -> + happyIn207 + (happy_var_1 + )} + +happyReduce_491 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_491 = happySpecReduce_2 192# happyReduction_491 +happyReduction_491 happy_x_2 + happy_x_1 + = case happyOut208 happy_x_1 of { (HappyWrap208 happy_var_1) -> + case happyOut209 happy_x_2 of { (HappyWrap209 happy_var_2) -> + happyIn208 + (sLL happy_var_1 happy_var_2 (happy_var_2 : unLoc happy_var_1) + )}} + +happyReduce_492 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_492 = happySpecReduce_1 192# happyReduction_492 +happyReduction_492 happy_x_1 + = case happyOut209 happy_x_1 of { (HappyWrap209 happy_var_1) -> + happyIn208 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_493 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_493 = happyMonadReduce 2# 193# happyReduction_493 +happyReduction_493 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut210 happy_x_2 of { (HappyWrap210 happy_var_2) -> + ( let { full_loc = comb2 happy_var_1 happy_var_2 } + in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) Nothing happy_var_2))}}) + ) (\r -> happyReturn (happyIn209 r)) + +happyReduce_494 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_494 = happyMonadReduce 3# 193# happyReduction_494 +happyReduction_494 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut90 happy_x_2 of { (HappyWrap90 happy_var_2) -> + case happyOut210 happy_x_3 of { (HappyWrap210 happy_var_3) -> + ( let { full_loc = comb2 happy_var_1 happy_var_3 } + in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) (Just happy_var_2) happy_var_3))}}}) + ) (\r -> happyReturn (happyIn209 r)) + +happyReduce_495 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_495 = happyMonadReduce 3# 193# happyReduction_495 +happyReduction_495 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut210 happy_x_2 of { (HappyWrap210 happy_var_2) -> + case happyOut91 happy_x_3 of { (HappyWrap91 happy_var_3) -> + ( let { full_loc = comb2 happy_var_1 happy_var_3 } + in amsA' (L full_loc $ HsDerivingClause (epTok happy_var_1) (Just happy_var_3) happy_var_2))}}}) + ) (\r -> happyReturn (happyIn209 r)) + +happyReduce_496 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_496 = happySpecReduce_1 194# happyReduction_496 +happyReduction_496 happy_x_1 + = case happyOut301 happy_x_1 of { (HappyWrap301 happy_var_1) -> + happyIn210 + (let { tc = sL1a happy_var_1 $ mkHsImplicitSigType $ + sL1a happy_var_1 $ HsTyVar noAnn NotPromoted happy_var_1 } in + sL1a happy_var_1 (DctSingle noExtField tc) + )} + +happyReduce_497 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_497 = happyMonadReduce 2# 194# happyReduction_497 +happyReduction_497 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 (DctMulti noExtField [])) + (AnnContext Nothing [epTok happy_var_1] [epTok happy_var_2]))}}) + ) (\r -> happyReturn (happyIn210 r)) + +happyReduce_498 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_498 = happyMonadReduce 3# 194# happyReduction_498 +happyReduction_498 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut182 happy_x_2 of { (HappyWrap182 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (DctMulti noExtField happy_var_2)) + (AnnContext Nothing [epTok happy_var_1] [epTok happy_var_3]))}}}) + ) (\r -> happyReturn (happyIn210 r)) + +happyReduce_499 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_499 = happySpecReduce_1 195# happyReduction_499 +happyReduction_499 happy_x_1 + = case happyOut216 happy_x_1 of { (HappyWrap216 happy_var_1) -> + happyIn211 + (happy_var_1 + )} + +happyReduce_500 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_500 = happyMonadReduce 3# 195# happyReduction_500 +happyReduction_500 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOut160 happy_x_2 of { (HappyWrap160 happy_var_2) -> + case happyOut213 happy_x_3 of { (HappyWrap213 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + do { let { l = comb2 happy_var_1 happy_var_3 } + ; r <- checkValDef l happy_var_1 (HsUnannotated EpPatBind, happy_var_2) happy_var_3; + -- Depending upon what the pattern looks like we might get either + -- a FunBind or PatBind back from checkValDef. See Note + -- [FunBind vs PatBind] + ; !cs <- getCommentsFor l + ; return $! (sL (commentsA l cs) $ ValD noExtField r) })}}}) + ) (\r -> happyReturn (happyIn211 r)) + +happyReduce_501 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_501 = happyMonadReduce 5# 195# happyReduction_501 +happyReduction_501 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + case happyOut224 happy_x_3 of { (HappyWrap224 happy_var_3) -> + case happyOut160 happy_x_4 of { (HappyWrap160 happy_var_4) -> + case happyOut213 happy_x_5 of { (HappyWrap213 happy_var_5) -> + ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> + do { let { l = comb2 happy_var_1 happy_var_5 } + ; r <- checkValDef l happy_var_3 (mkMultAnn (epTok happy_var_1) happy_var_2 EpPatBind, happy_var_4) happy_var_5; + -- parses bindings of the form %p x or + -- %p x :: sig + -- + -- Depending upon what the pattern looks like we might get either + -- a FunBind or PatBind back from checkValDef. See Note + -- [FunBind vs PatBind] + ; !cs <- getCommentsFor l + ; return $! (sL (commentsA l cs) $ ValD noExtField r) })}}}}}) + ) (\r -> happyReturn (happyIn211 r)) + +happyReduce_502 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_502 = happySpecReduce_1 195# happyReduction_502 +happyReduction_502 happy_x_1 + = case happyOut119 happy_x_1 of { (HappyWrap119 happy_var_1) -> + happyIn211 + (happy_var_1 + )} + +happyReduce_503 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_503 = happySpecReduce_1 196# happyReduction_503 +happyReduction_503 happy_x_1 + = case happyOut211 happy_x_1 of { (HappyWrap211 happy_var_1) -> + happyIn212 + (happy_var_1 + )} + +happyReduce_504 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_504 = happySpecReduce_1 196# happyReduction_504 +happyReduction_504 happy_x_1 + = case happyOut234 happy_x_1 of { (HappyWrap234 happy_var_1) -> + happyIn212 + (mkSpliceDecl happy_var_1 + )} + +happyReduce_505 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_505 = happyMonadReduce 3# 197# happyReduction_505 +happyReduction_505 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOut137 happy_x_3 of { (HappyWrap137 happy_var_3) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + do { let L l (bs, csw) = adaptWhereBinds happy_var_3 + ; let loc = (comb3 happy_var_1 happy_var_2 (L l bs)) + ; let locg = (comb2 happy_var_1 happy_var_2) + ; acs loc (\loc cs -> + sL loc (GRHSs csw (unguardedRHS (EpAnn (spanAsAnchor locg) (GrhsAnn Nothing (Left $ epTok happy_var_1)) cs) locg happy_var_2) + bs)) })}}}) + ) (\r -> happyReturn (happyIn213 r)) + +happyReduce_506 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_506 = happyMonadReduce 2# 197# happyReduction_506 +happyReduction_506 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut214 happy_x_1 of { (HappyWrap214 happy_var_1) -> + case happyOut137 happy_x_2 of { (HappyWrap137 happy_var_2) -> + ( do { let {L l (bs, csw) = adaptWhereBinds happy_var_2} + ; acs (comb2 happy_var_1 (L l bs)) (\loc cs -> L loc + (GRHSs (cs Semi.<> csw) (NE.reverse (unLoc happy_var_1)) bs)) })}}) + ) (\r -> happyReturn (happyIn213 r)) + +happyReduce_507 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_507 = happySpecReduce_2 198# happyReduction_507 +happyReduction_507 happy_x_2 + happy_x_1 + = case happyOut214 happy_x_1 of { (HappyWrap214 happy_var_1) -> + case happyOut215 happy_x_2 of { (HappyWrap215 happy_var_2) -> + happyIn214 + (sLL happy_var_1 happy_var_2 (happy_var_2 NE.<| unLoc happy_var_1) + )}} + +happyReduce_508 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_508 = happySpecReduce_1 198# happyReduction_508 +happyReduction_508 happy_x_1 + = case happyOut215 happy_x_1 of { (HappyWrap215 happy_var_1) -> + happyIn214 + (sL1 happy_var_1 (NE.singleton happy_var_1) + )} + +happyReduce_509 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_509 = happyMonadReduce 4# 199# happyReduction_509 +happyReduction_509 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut251 happy_x_2 of { (HappyWrap251 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> + acsA (comb2 happy_var_1 happy_var_4) (\loc cs -> L loc $ GRHS (EpAnn (glEE happy_var_1 happy_var_4) (GrhsAnn (Just $ epTok happy_var_1) (Left $ epTok happy_var_3)) cs) (unLoc happy_var_2) happy_var_4))}}}}) + ) (\r -> happyReturn (happyIn215 r)) + +happyReduce_510 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_510 = happyMonadReduce 3# 200# happyReduction_510 +happyReduction_510 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut163 happy_x_3 of { (HappyWrap163 happy_var_3) -> + ( do { happy_var_1 <- runPV (unECP happy_var_1) + ; v <- checkValSigLhs happy_var_1 + ; amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField $ + TypeSig (AnnSig (epUniTok happy_var_2) Nothing Nothing) [v] (mkHsWildCardBndrs happy_var_3))})}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_511 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_511 = happyMonadReduce 5# 200# happyReduction_511 +happyReduction_511 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut164 happy_x_3 of { (HappyWrap164 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut163 happy_x_5 of { (HappyWrap163 happy_var_5) -> + ( do { v <- addTrailingCommaN happy_var_1 (gl happy_var_2) + ; let sig = TypeSig (AnnSig (epUniTok happy_var_4) Nothing Nothing) (v : reverse (unLoc happy_var_3)) + (mkHsWildCardBndrs happy_var_5) + ; amsA' (sLL happy_var_1 happy_var_5 $ SigD noExtField sig ) })}}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_512 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_512 = happyMonadReduce 4# 200# happyReduction_512 +happyReduction_512 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut75 happy_x_1 of { (HappyWrap75 happy_var_1) -> + case happyOut74 happy_x_2 of { (HappyWrap74 happy_var_2) -> + case happyOut150 happy_x_3 of { (HappyWrap150 happy_var_3) -> + case happyOut76 happy_x_4 of { (HappyWrap76 happy_var_4) -> + ( do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 happy_var_4 + ; pure (glR l2) }) + happy_var_2 + ; let (fixText, fixPrec) = case happy_var_2 of + -- If an explicit precedence isn't supplied, + -- it defaults to maxPrecedence + Nothing -> (NoSourceText, maxPrecedence) + Just l2 -> (fst $ unLoc l2, snd $ unLoc l2) + ; amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField + (FixSig ((glR happy_var_1, mbPrecAnn), fixText) (FixitySig (unLoc happy_var_3) (fromOL $ unLoc happy_var_4) + (Fixity fixPrec (unLoc happy_var_1))))) + })}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_513 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_513 = happySpecReduce_1 200# happyReduction_513 +happyReduction_513 happy_x_1 + = case happyOut124 happy_x_1 of { (HappyWrap124 happy_var_1) -> + happyIn216 + (L (getLoc happy_var_1) . SigD noExtField . unLoc $ happy_var_1 + )} + +happyReduce_514 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_514 = happyMonadReduce 4# 200# happyReduction_514 +happyReduction_514 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut290 happy_x_2 of { (HappyWrap290 happy_var_2) -> + case happyOut161 happy_x_3 of { (HappyWrap161 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( let (dcolon, tc) = happy_var_3 + in amsA' (sLL happy_var_1 happy_var_4 + (SigD noExtField (CompleteMatchSig ((glR happy_var_1,dcolon,epTok happy_var_4), (getCOMPLETE_PRAGs happy_var_1)) happy_var_2 tc))))}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_515 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_515 = happyMonadReduce 4# 200# happyReduction_515 +happyReduction_515 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut218 happy_x_2 of { (HappyWrap218 happy_var_2) -> + case happyOut125 happy_x_3 of { (HappyWrap125 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField (InlineSig (glR happy_var_1, epTok happy_var_4, fst happy_var_2) happy_var_3 + (mkInlinePragma (getINLINE_PRAGs happy_var_1) (getINLINE happy_var_1) + (snd happy_var_2)))))}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_516 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_516 = happyMonadReduce 3# 200# happyReduction_516 +happyReduction_516 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField (InlineSig (glR happy_var_1, epTok happy_var_3, noAnn) happy_var_2 + (mkOpaquePragma (getOPAQUE_PRAGs happy_var_1)))))}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_517 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_517 = happyMonadReduce 3# 200# happyReduction_517 +happyReduction_517 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 (SigD noExtField (SCCFunSig ((glR happy_var_1, epTok happy_var_3), (getSCC_PRAGs happy_var_1)) happy_var_2 Nothing))))}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_518 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_518 = happyMonadReduce 4# 200# happyReduction_518 +happyReduction_518 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( do { scc <- getSCC happy_var_3 + ; let str_lit = StringLiteral (getSTRINGs happy_var_3) scc Nothing + ; amsA' (sLL happy_var_1 happy_var_4 (SigD noExtField (SCCFunSig ((glR happy_var_1, epTok happy_var_4), (getSCC_PRAGs happy_var_1)) happy_var_2 (Just ( sL1a happy_var_3 str_lit))))) })}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_519 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_519 = happyMonadReduce 6# 200# happyReduction_519 +happyReduction_519 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut218 happy_x_2 of { (HappyWrap218 happy_var_2) -> + case happyOut143 happy_x_3 of { (HappyWrap143 happy_var_3) -> + case happyOut224 happy_x_4 of { (HappyWrap224 happy_var_4) -> + case happyOut217 happy_x_5 of { (HappyWrap217 happy_var_5) -> + case happyOutTok happy_x_6 of { happy_var_6 -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> do + let inl_prag = mkInlinePragma (getSPEC_PRAGs happy_var_1) + (NoUserInlinePrag, FunLike) + (snd happy_var_2) + spec <- mkSpecSig inl_prag (AnnSpecSig (glR happy_var_1) (epTok happy_var_6) Nothing (fst happy_var_2)) happy_var_3 happy_var_4 happy_var_5 + amsA' $ sLL happy_var_1 happy_var_6 $ SigD noExtField spec)}}}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_520 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_520 = happyMonadReduce 6# 200# happyReduction_520 +happyReduction_520 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut218 happy_x_2 of { (HappyWrap218 happy_var_2) -> + case happyOut143 happy_x_3 of { (HappyWrap143 happy_var_3) -> + case happyOut224 happy_x_4 of { (HappyWrap224 happy_var_4) -> + case happyOut217 happy_x_5 of { (HappyWrap217 happy_var_5) -> + case happyOutTok happy_x_6 of { happy_var_6 -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> do + let inl_prag = mkInlinePragma (getSPEC_INLINE_PRAGs happy_var_1) + (getSPEC_INLINE happy_var_1) + (snd happy_var_2) + spec <- mkSpecSig inl_prag (AnnSpecSig (glR happy_var_1) (epTok happy_var_6) Nothing (fst happy_var_2)) happy_var_3 happy_var_4 happy_var_5 + amsA' $ sLL happy_var_1 happy_var_6 $ SigD noExtField spec)}}}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_521 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_521 = happyMonadReduce 4# 200# happyReduction_521 +happyReduction_521 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut181 happy_x_3 of { (HappyWrap181 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( amsA' (sLL happy_var_1 happy_var_4 $ SigD noExtField (SpecInstSig ((glR happy_var_1,epTok happy_var_2,epTok happy_var_4), (getSPEC_PRAGs happy_var_1)) happy_var_3)))}}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_522 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_522 = happyMonadReduce 3# 200# happyReduction_522 +happyReduction_522 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut279 happy_x_2 of { (HappyWrap279 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsA' (sLL happy_var_1 happy_var_3 $ SigD noExtField (MinimalSig ((glR happy_var_1,epTok happy_var_3), (getMINIMAL_PRAGs happy_var_1)) happy_var_2)))}}}) + ) (\r -> happyReturn (happyIn216 r)) + +happyReduce_523 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_523 = happySpecReduce_2 201# happyReduction_523 +happyReduction_523 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut165 happy_x_2 of { (HappyWrap165 happy_var_2) -> + happyIn217 + (Just (sLL happy_var_1 happy_var_2 (epUniTok happy_var_1, unLoc happy_var_2)) + )}} + +happyReduce_524 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_524 = happySpecReduce_0 201# happyReduction_524 +happyReduction_524 = happyIn217 + (Nothing + ) + +happyReduce_525 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_525 = happySpecReduce_0 202# happyReduction_525 +happyReduction_525 = happyIn218 + ((noAnn ,Nothing) + ) + +happyReduce_526 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_526 = happySpecReduce_1 202# happyReduction_526 +happyReduction_526 happy_x_1 + = case happyOut219 happy_x_1 of { (HappyWrap219 happy_var_1) -> + happyIn218 + ((fst happy_var_1,Just (snd happy_var_1)) + )} + +happyReduce_527 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_527 = happySpecReduce_3 203# happyReduction_527 +happyReduction_527 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn219 + ((ActivationAnn (epTok happy_var_1) (epTok happy_var_3) Nothing (Just (glR happy_var_2)) + ,ActiveAfter (getINTEGERs happy_var_2) (fromInteger (il_value (getINTEGER happy_var_2)))) + )}}} + +happyReduce_528 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_528 = happyReduce 4# 203# happyReduction_528 +happyReduction_528 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut141 happy_x_2 of { (HappyWrap141 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn219 + ((ActivationAnn (epTok happy_var_1) (epTok happy_var_4) happy_var_2 (Just (glR happy_var_3)) + ,ActiveBefore (getINTEGERs happy_var_3) (fromInteger (il_value (getINTEGER happy_var_3)))) + ) `HappyStk` happyRest}}}} + +happyReduce_529 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_529 = happySpecReduce_1 204# happyReduction_529 +happyReduction_529 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn220 + (let { loc = getLoc happy_var_1 + ; ITquasiQuote (quoter, quoterSpan, quote, quoteSpan) = unLoc happy_var_1 + ; quoterId = L (noAnnSrcSpan (mkSrcSpanPs quoterSpan)) (mkUnqual varName quoter) } + in sL1 happy_var_1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) + )} + +happyReduce_530 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_530 = happySpecReduce_1 204# happyReduction_530 +happyReduction_530 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn220 + (let { loc = getLoc happy_var_1 + ; ITqQuasiQuote (qual, quoter, quoterSpan, quote, quoteSpan) = unLoc happy_var_1 + ; quoterId = L (noAnnSrcSpan (mkSrcSpanPs quoterSpan)) (mkQual varName (qual, quoter)) } + in sL1 happy_var_1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) + )} + +happyReduce_531 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_531 = happySpecReduce_1 205# happyReduction_531 +happyReduction_531 happy_x_1 + = case happyOut340 happy_x_1 of { (HappyWrap340 happy_var_1) -> + happyIn221 + (happy_var_1 + )} + +happyReduce_532 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_532 = happySpecReduce_1 206# happyReduction_532 +happyReduction_532 happy_x_1 + = case happyOut341 happy_x_1 of { (HappyWrap341 happy_var_1) -> + happyIn222 + (happy_var_1 + )} + +happyReduce_533 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_533 = happySpecReduce_1 207# happyReduction_533 +happyReduction_533 happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + happyIn223 + (happy_var_1 + )} + +happyReduce_534 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_534 = happySpecReduce_3 207# happyReduction_534 +happyReduction_534 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut223 happy_x_3 of { (HappyWrap223 happy_var_3) -> + happyIn223 + (ECP $ + withArrowParsingMode' $ \mode -> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + let arr = HsUnannotated (EpArrow (epUniTok happy_var_2)) + in mkHsArrowPV (comb2 happy_var_1 happy_var_3) mode happy_var_1 arr happy_var_3 + )}}} + +happyReduce_535 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_535 = happyReduce 4# 207# happyReduction_535 +happyReduction_535 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOut174 happy_x_2 of { (HappyWrap174 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut223 happy_x_4 of { (HappyWrap223 happy_var_4) -> + happyIn223 + (ECP $ + unECP happy_var_1 >>= \ happy_var_1 -> + happy_var_2 >>= \ happy_var_2 -> + unECP happy_var_4 >>= \ happy_var_4 -> + hintLinear (getLoc happy_var_2) >> + let arr = (unLoc happy_var_2) (epUniTok happy_var_3) + in mkHsArrowPV (comb2 happy_var_1 happy_var_4) ArrowIsFunType happy_var_1 arr happy_var_4 + ) `HappyStk` happyRest}}}} + +happyReduce_536 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_536 = happySpecReduce_3 207# happyReduction_536 +happyReduction_536 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut223 happy_x_3 of { (HappyWrap223 happy_var_3) -> + happyIn223 + (ECP $ + hintLinear (getLoc happy_var_2) >> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + let arr = HsLinearAnn (EpLolly (epTok happy_var_2)) + in mkHsArrowPV (comb2 happy_var_1 happy_var_3) ArrowIsFunType happy_var_1 arr happy_var_3 + )}}} + +happyReduce_537 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_537 = happySpecReduce_3 207# happyReduction_537 +happyReduction_537 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut171 happy_x_1 of { (HappyWrap171 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut223 happy_x_3 of { (HappyWrap223 happy_var_3) -> + happyIn223 + (ECP $ + happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + mkQualPV (comb2 happy_var_1 happy_var_3) (addTrailingDarrowC happy_var_1 happy_var_2 emptyComments) happy_var_3 + )}}} + +happyReduce_538 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_538 = happySpecReduce_2 207# happyReduction_538 +happyReduction_538 happy_x_2 + happy_x_1 + = case happyOut167 happy_x_1 of { (HappyWrap167 happy_var_1) -> + case happyOut223 happy_x_2 of { (HappyWrap223 happy_var_2) -> + happyIn223 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsForallPV (comb2 happy_var_1 happy_var_2) (unLoc happy_var_1) happy_var_2 + )}} + +happyReduce_539 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_539 = happySpecReduce_1 208# happyReduction_539 +happyReduction_539 happy_x_1 + = case happyOut226 happy_x_1 of { (HappyWrap226 happy_var_1) -> + happyIn224 + (happy_var_1 + )} + +happyReduce_540 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_540 = happySpecReduce_3 208# happyReduction_540 +happyReduction_540 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOut308 happy_x_2 of { (HappyWrap308 happy_var_2) -> + case happyOut225 happy_x_3 of { (HappyWrap225 happy_var_3) -> + happyIn224 + (ECP $ + superInfixOp $ + happy_var_2 >>= \ happy_var_2 -> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + rejectPragmaPV happy_var_1 >> + (mkHsOpAppPV (comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_2 happy_var_3) + )}}} + +happyReduce_541 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_541 = happySpecReduce_1 209# happyReduction_541 +happyReduction_541 happy_x_1 + = case happyOut226 happy_x_1 of { (HappyWrap226 happy_var_1) -> + happyIn225 + (happy_var_1 + )} + +happyReduce_542 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_542 = happySpecReduce_1 209# happyReduction_542 +happyReduction_542 happy_x_1 + = case happyOut342 happy_x_1 of { (HappyWrap342 happy_var_1) -> + happyIn225 + (happy_var_1 + )} + +happyReduce_543 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_543 = happySpecReduce_2 210# happyReduction_543 +happyReduction_543 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut229 happy_x_2 of { (HappyWrap229 happy_var_2) -> + happyIn226 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsNegAppPV (comb2 happy_var_1 happy_var_2) happy_var_2 + (epTok happy_var_1) + )}} + +happyReduce_544 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_544 = happySpecReduce_1 210# happyReduction_544 +happyReduction_544 happy_x_1 + = case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> + happyIn226 + (happy_var_1 + )} + +happyReduce_545 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_545 = happySpecReduce_1 211# happyReduction_545 +happyReduction_545 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn227 + ((msemim happy_var_1,True) + )} + +happyReduce_546 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_546 = happySpecReduce_0 211# happyReduction_546 +happyReduction_546 = happyIn227 + ((Nothing,False) + ) + +happyReduce_547 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_547 = happyMonadReduce 3# 212# happyReduction_547 +happyReduction_547 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { scc <- getSCC happy_var_2 + ; return (sLL happy_var_1 happy_var_3 + (HsPragSCC + (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn (glR happy_var_2) noAnn noAnn noAnn, + (getSCC_PRAGs happy_var_1)) + (StringLiteral (getSTRINGs happy_var_2) scc Nothing)))})}}}) + ) (\r -> happyReturn (happyIn228 r)) + +happyReduce_548 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_548 = happySpecReduce_3 212# happyReduction_548 +happyReduction_548 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn228 + (sLL happy_var_1 happy_var_3 + (HsPragSCC + (AnnPragma (glR happy_var_1) (epTok happy_var_3) noAnn (glR happy_var_2) noAnn noAnn noAnn, + (getSCC_PRAGs happy_var_1)) + (StringLiteral NoSourceText (getVARID happy_var_2) Nothing)) + )}}} + +happyReduce_549 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_549 = happySpecReduce_2 213# happyReduction_549 +happyReduction_549 happy_x_2 + happy_x_1 + = case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + happyIn229 + (ECP $ + superFunArg $ + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_2 >>= \ happy_var_2 -> + spanWithComments (comb2 happy_var_1 happy_var_2) >>= \l -> + mkHsAppPV l happy_var_1 happy_var_2 + )}} + +happyReduce_550 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_550 = happySpecReduce_3 213# happyReduction_550 +happyReduction_550 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut229 happy_x_1 of { (HappyWrap229 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut180 happy_x_3 of { (HappyWrap180 happy_var_3) -> + happyIn229 + (ECP $ + unECP happy_var_1 >>= \ happy_var_1 -> + mkHsAppTypePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 (epTok happy_var_2) happy_var_3 + )}}} + +happyReduce_551 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_551 = happyMonadReduce 2# 213# happyReduction_551 +happyReduction_551 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_2 $ HsStatic (epTok happy_var_1) happy_var_2))}}) + ) (\r -> happyReturn (happyIn229 r)) + +happyReduce_552 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_552 = happySpecReduce_1 213# happyReduction_552 +happyReduction_552 happy_x_1 + = case happyOut230 happy_x_1 of { (HappyWrap230 happy_var_1) -> + happyIn229 + (happy_var_1 + )} + +happyReduce_553 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_553 = happySpecReduce_3 214# happyReduction_553 +happyReduction_553 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut230 happy_x_3 of { (HappyWrap230 happy_var_3) -> + happyIn230 + (ECP $ + unECP happy_var_3 >>= \ happy_var_3 -> + mkHsAsPatPV (comb2 happy_var_1 happy_var_3) happy_var_1 (epTok happy_var_2) happy_var_3 + )}}} + +happyReduce_554 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_554 = happySpecReduce_2 214# happyReduction_554 +happyReduction_554 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + happyIn230 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsLazyPatPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) + )}} + +happyReduce_555 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_555 = happySpecReduce_2 214# happyReduction_555 +happyReduction_555 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + happyIn230 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsBangPatPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) + )}} + +happyReduce_556 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_556 = happySpecReduce_2 214# happyReduction_556 +happyReduction_556 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + happyIn230 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsNegAppPV (comb2 happy_var_1 happy_var_2) happy_var_2 (epTok happy_var_1) + )}} + +happyReduce_557 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_557 = happyReduce 4# 214# happyReduction_557 +happyReduction_557 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut136 happy_x_2 of { (HappyWrap136 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + happyIn230 + (ECP $ + unECP happy_var_4 >>= \ happy_var_4 -> + mkHsLetPV (comb2 happy_var_1 happy_var_4) (epTok happy_var_1) (unLoc happy_var_2) (epTok happy_var_3) happy_var_4 + ) `HappyStk` happyRest}}}} + +happyReduce_558 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_558 = happyReduce 4# 214# happyReduction_558 +happyReduction_558 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut263 happy_x_2 of { (HappyWrap263 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + happyIn230 + (ECP $ + unECP happy_var_4 >>= \ happy_var_4 -> + mkHsLamPV (comb2 happy_var_1 happy_var_4) LamSingle + (sLLld happy_var_1 happy_var_4 + [sLLa happy_var_1 happy_var_4 + $ Match { m_ext = noExtField + , m_ctxt = LamAlt LamSingle + , m_pats = L (listLocation happy_var_2) happy_var_2 + , m_grhss = unguardedGRHSs (comb2 happy_var_3 happy_var_4) happy_var_4 (EpAnn (glR happy_var_3) (GrhsAnn Nothing (Right $ epUniTok happy_var_3)) emptyComments) }]) + (EpAnnLam (epTok happy_var_1) Nothing) + ) `HappyStk` happyRest}}}} + +happyReduce_559 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_559 = happySpecReduce_3 214# happyReduction_559 +happyReduction_559 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut339 happy_x_3 of { (HappyWrap339 happy_var_3) -> + happyIn230 + (ECP $ happy_var_3 >>= \ happy_var_3 -> + mkHsLamPV (comb3 happy_var_1 happy_var_2 happy_var_3) LamCase happy_var_3 (EpAnnLam (epTok happy_var_1) (Just (glR happy_var_2))) + )}}} + +happyReduce_560 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_560 = happySpecReduce_3 214# happyReduction_560 +happyReduction_560 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut338 happy_x_3 of { (HappyWrap338 happy_var_3) -> + happyIn230 + (ECP $ happy_var_3 >>= \ happy_var_3 -> + mkHsLamPV (comb3 happy_var_1 happy_var_2 happy_var_3) LamCases happy_var_3 (EpAnnLam (epTok happy_var_1) (Just (glR happy_var_2))) + )}}} + +happyReduce_561 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_561 = happyMonadReduce 8# 214# happyReduction_561 +happyReduction_561 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOut227 happy_x_3 of { (HappyWrap227 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut221 happy_x_5 of { (HappyWrap221 happy_var_5) -> + case happyOut227 happy_x_6 of { (HappyWrap227 happy_var_6) -> + case happyOutTok happy_x_7 of { happy_var_7 -> + case happyOut221 happy_x_8 of { (HappyWrap221 happy_var_8) -> + ( runPV (unECP happy_var_2) >>= \ (happy_var_2 :: LHsExpr GhcPs) -> + return $ ECP $ + unECP happy_var_5 >>= \ happy_var_5 -> + unECP happy_var_8 >>= \ happy_var_8 -> + mkHsIfPV (comb2 happy_var_1 happy_var_8) happy_var_2 (snd happy_var_3) happy_var_5 (snd happy_var_6) happy_var_8 + (AnnsIf + { aiIf = epTok happy_var_1 + , aiThen = epTok happy_var_4 + , aiElse = epTok happy_var_7 + , aiThenSemi = fst happy_var_3 + , aiElseSemi = fst happy_var_6}))}}}}}}}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_562 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_562 = happyMonadReduce 2# 214# happyReduction_562 +happyReduction_562 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut256 happy_x_2 of { (HappyWrap256 happy_var_2) -> + ( hintMultiWayIf (getLoc happy_var_1) >>= \_ -> + fmap ecpFromExp $ + do { let (L _ ((o,c),_)) = happy_var_2 + ; amsA' (sLL happy_var_1 happy_var_2 $ HsMultiIf (epTok happy_var_1, o, c) + (NE.reverse $ snd $ unLoc happy_var_2)) })}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_563 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_563 = happyMonadReduce 4# 214# happyReduction_563 +happyReduction_563 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut339 happy_x_4 of { (HappyWrap339 happy_var_4) -> + ( runPV (unECP happy_var_2) >>= \ (happy_var_2 :: LHsExpr GhcPs) -> + return $ ECP $ + happy_var_4 >>= \ happy_var_4 -> + mkHsCasePV (comb3 happy_var_1 happy_var_3 happy_var_4) happy_var_2 happy_var_4 + (EpAnnHsCase (epTok happy_var_1) (epTok happy_var_3)))}}}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_564 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_564 = happyMonadReduce 2# 214# happyReduction_564 +happyReduction_564 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut265 happy_x_2 of { (HappyWrap265 happy_var_2) -> + ( do + hintQualifiedDo happy_var_1 + return $ ECP $ + happy_var_2 >>= \ happy_var_2 -> + mkHsDoPV (comb2 happy_var_1 happy_var_2) + (fmap mkModuleNameFS (getDO happy_var_1)) + happy_var_2 + (glR happy_var_1) + (glR happy_var_2))}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_565 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_565 = happyMonadReduce 2# 214# happyReduction_565 +happyReduction_565 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut265 happy_x_2 of { (HappyWrap265 happy_var_2) -> + ( hintQualifiedDo happy_var_1 >> runPV happy_var_2 >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' (L (comb2 happy_var_1 happy_var_2) + (mkMDo (MDoExpr $ fmap mkModuleNameFS (getMDO happy_var_1)) + happy_var_2 + (glR happy_var_1) + (glR happy_var_2))))}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_566 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_566 = happyMonadReduce 4# 214# happyReduction_566 +happyReduction_566 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + ( (checkPattern <=< runPV) (unECP happy_var_2) >>= \ p -> + runPV (unECP happy_var_4) >>= \ happy_var_4@cmd -> + fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_4 $HsProc (epTok happy_var_1, epUniTok happy_var_3) p (sLLa happy_var_1 happy_var_4 $ HsCmdTop noExtField cmd)))}}}}) + ) (\r -> happyReturn (happyIn230 r)) + +happyReduce_567 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_567 = happySpecReduce_1 214# happyReduction_567 +happyReduction_567 happy_x_1 + = case happyOut231 happy_x_1 of { (HappyWrap231 happy_var_1) -> + happyIn230 + (happy_var_1 + )} + +happyReduce_568 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_568 = happyReduce 4# 215# happyReduction_568 +happyReduction_568 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut231 happy_x_1 of { (HappyWrap231 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut271 happy_x_3 of { (HappyWrap271 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn231 + (ECP $ + getBit OverloadedRecordUpdateBit >>= \ overloaded -> + unECP happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ happy_var_3 -> + mkHsRecordPV overloaded (comb2 happy_var_1 happy_var_4) (comb2 happy_var_2 happy_var_4) happy_var_1 happy_var_3 + (Just (epTok happy_var_2), Just (epTok happy_var_4)) + ) `HappyStk` happyRest}}}} + +happyReduce_569 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_569 = happyMonadReduce 3# 215# happyReduction_569 +happyReduction_569 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut231 happy_x_1 of { (HappyWrap231 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut318 happy_x_3 of { (HappyWrap318 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + fmap ecpFromExp $ amsA' ( + let fl = sLLa happy_var_2 happy_var_3 (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) happy_var_3) in + sLL happy_var_1 happy_var_3 $ mkRdrGetField happy_var_1 fl))}}}) + ) (\r -> happyReturn (happyIn231 r)) + +happyReduce_570 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_570 = happySpecReduce_1 215# happyReduction_570 +happyReduction_570 happy_x_1 + = case happyOut232 happy_x_1 of { (HappyWrap232 happy_var_1) -> + happyIn231 + (happy_var_1 + )} + +happyReduce_571 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_571 = happySpecReduce_1 216# happyReduction_571 +happyReduction_571 happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + happyIn232 + (ECP $ mkHsVarPV $! happy_var_1 + )} + +happyReduce_572 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_572 = happySpecReduce_1 216# happyReduction_572 +happyReduction_572 happy_x_1 + = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> + happyIn232 + (ECP $ mkHsVarPV $! happy_var_1 + )} + +happyReduce_573 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_573 = happyMonadReduce 1# 216# happyReduction_573 +happyReduction_573 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut277 happy_x_1 of { (HappyWrap277 happy_var_1) -> + ( fmap ecpFromExp + (ams1 happy_var_1 (HsIPVar NoExtField $! unLoc happy_var_1)))}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_574 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_574 = happyMonadReduce 1# 216# happyReduction_574 +happyReduction_574 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut278 happy_x_1 of { (HappyWrap278 happy_var_1) -> + ( fmap ecpFromExp + (ams1 happy_var_1 (HsOverLabel (fst $! unLoc happy_var_1) (snd $! unLoc happy_var_1))))}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_575 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_575 = happySpecReduce_1 216# happyReduction_575 +happyReduction_575 happy_x_1 + = case happyOut332 happy_x_1 of { (HappyWrap332 happy_var_1) -> + happyIn232 + (ECP $ mkHsLitPV $! happy_var_1 + )} + +happyReduce_576 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_576 = happySpecReduce_1 216# happyReduction_576 +happyReduction_576 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn232 + (ECP $ mkHsOverLitPV (sL1a happy_var_1 $ mkHsIntegral (getINTEGER happy_var_1)) + )} + +happyReduce_577 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_577 = happySpecReduce_1 216# happyReduction_577 +happyReduction_577 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn232 + (ECP $ mkHsOverLitPV (sL1a happy_var_1 $ mkHsFractional (getRATIONAL happy_var_1)) + )} + +happyReduce_578 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_578 = happySpecReduce_3 216# happyReduction_578 +happyReduction_578 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut241 happy_x_2 of { (HappyWrap241 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkHsParPV (comb2 happy_var_1 happy_var_3) (epTok happy_var_1) happy_var_2 (epTok happy_var_3) + )}}} + +happyReduce_579 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_579 = happySpecReduce_3 216# happyReduction_579 +happyReduction_579 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut242 happy_x_2 of { (HappyWrap242 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ + happy_var_2 >>= \ happy_var_2 -> + mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Boxed happy_var_2 + (glR happy_var_1,glR happy_var_3) + )}}} + +happyReduce_580 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_580 = happyMonadReduce 3# 216# happyReduction_580 +happyReduction_580 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut344 happy_x_2 of { (HappyWrap344 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do + { pat <- hintOrPats (sL1a happy_var_2 (OrPat NoExtField (unLoc happy_var_2))) + ; fmap ecpFromPat + (amsA' (sLL happy_var_1 happy_var_3 (ParPat (epTok happy_var_1, epTok happy_var_3) pat))) })}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_581 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_581 = happySpecReduce_3 216# happyReduction_581 +happyReduction_581 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut233 happy_x_2 of { (HappyWrap233 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ + amsA' (sLL happy_var_1 happy_var_3 $ mkRdrProjection (NE.reverse (unLoc happy_var_2)) (AnnProjection (epTok happy_var_1) (epTok happy_var_3)) ) + >>= ecpFromExp' + )}}} + +happyReduce_582 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_582 = happySpecReduce_3 216# happyReduction_582 +happyReduction_582 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut241 happy_x_2 of { (HappyWrap241 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ + unECP happy_var_2 >>= \ happy_var_2 -> + mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Unboxed (Tuple [Right happy_var_2]) + (glR happy_var_1,glR happy_var_3) + )}}} + +happyReduce_583 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_583 = happySpecReduce_3 216# happyReduction_583 +happyReduction_583 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut242 happy_x_2 of { (HappyWrap242 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ + happy_var_2 >>= \ happy_var_2 -> + mkSumOrTuplePV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) Unboxed happy_var_2 + (glR happy_var_1,glR happy_var_3) + )}}} + +happyReduce_584 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_584 = happySpecReduce_3 216# happyReduction_584 +happyReduction_584 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut245 happy_x_2 of { (HappyWrap245 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn232 + (ECP $ happy_var_2 (comb2 happy_var_1 happy_var_3) (glR happy_var_1,glR happy_var_3) + )}}} + +happyReduce_585 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_585 = happySpecReduce_1 216# happyReduction_585 +happyReduction_585 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn232 + (ECP $ mkHsWildCardPV (getLoc happy_var_1) + )} + +happyReduce_586 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_586 = happySpecReduce_1 216# happyReduction_586 +happyReduction_586 happy_x_1 + = case happyOut235 happy_x_1 of { (HappyWrap235 happy_var_1) -> + happyIn232 + (ECP $ mkHsSplicePV happy_var_1 + )} + +happyReduce_587 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_587 = happySpecReduce_1 216# happyReduction_587 +happyReduction_587 happy_x_1 + = case happyOut236 happy_x_1 of { (HappyWrap236 happy_var_1) -> + happyIn232 + (ecpFromExp $ fmap (HsTypedSplice noExtField) (reLoc happy_var_1) + )} + +happyReduce_588 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_588 = happyMonadReduce 2# 216# happyReduction_588 +happyReduction_588 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut317 happy_x_2 of { (HappyWrap317 happy_var_2) -> + ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) True happy_var_2)))}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_589 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_589 = happyMonadReduce 2# 216# happyReduction_589 +happyReduction_589 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut286 happy_x_2 of { (HappyWrap286 happy_var_2) -> + ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) True happy_var_2)))}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_590 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_590 = happyMonadReduce 2# 216# happyReduction_590 +happyReduction_590 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut313 happy_x_2 of { (HappyWrap313 happy_var_2) -> + ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) False happy_var_2)))}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_591 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_591 = happyMonadReduce 2# 216# happyReduction_591 +happyReduction_591 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut296 happy_x_2 of { (HappyWrap296 happy_var_2) -> + ( fmap ecpFromExp $ amsA' (sLL happy_var_1 happy_var_2 $ HsUntypedBracket noExtField (VarBr (glR happy_var_1) False happy_var_2)))}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_592 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_592 = happyMonadReduce 1# 216# happyReduction_592 +happyReduction_592 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( reportEmptyDoubleQuotes (getLoc happy_var_1))}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_593 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_593 = happyMonadReduce 3# 216# happyReduction_593 +happyReduction_593 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (ExpBr (if (hasE happy_var_1) then (BracketHasE (epTok happy_var_1), epUniTok happy_var_3) + else (BracketNoE (epUniTok happy_var_1), epUniTok happy_var_3)) happy_var_2)))}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_594 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_594 = happyMonadReduce 3# 216# happyReduction_594 +happyReduction_594 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_3 $ HsTypedBracket (if (hasE happy_var_1) then (BracketHasE (epTok happy_var_1),epTok happy_var_3) else (BracketNoE (epTok happy_var_1),epTok happy_var_3)) happy_var_2))}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_595 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_595 = happyMonadReduce 3# 216# happyReduction_595 +happyReduction_595 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut168 happy_x_2 of { (HappyWrap168 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (TypBr (epTok happy_var_1,epUniTok happy_var_3) happy_var_2)))}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_596 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_596 = happyMonadReduce 3# 216# happyReduction_596 +happyReduction_596 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut224 happy_x_2 of { (HappyWrap224 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( (checkPattern <=< runPV) (unECP happy_var_2) >>= \p -> + fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (PatBr (epTok happy_var_1,epUniTok happy_var_3) p)))}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_597 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_597 = happyMonadReduce 3# 216# happyReduction_597 +happyReduction_597 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut239 happy_x_2 of { (HappyWrap239 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( fmap ecpFromExp $ + amsA' (sLL happy_var_1 happy_var_3 $ HsUntypedBracket noExtField (DecBrL (epTok happy_var_1,epUniTok happy_var_3, fst happy_var_2) (snd happy_var_2))))}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_598 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_598 = happySpecReduce_1 216# happyReduction_598 +happyReduction_598 happy_x_1 + = case happyOut220 happy_x_1 of { (HappyWrap220 happy_var_1) -> + happyIn232 + (ECP $ mkHsSplicePV happy_var_1 + )} + +happyReduce_599 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_599 = happyMonadReduce 4# 216# happyReduction_599 +happyReduction_599 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut230 happy_x_2 of { (HappyWrap230 happy_var_2) -> + case happyOut237 happy_x_3 of { (HappyWrap237 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_4 $ HsCmdArrForm (AnnList (glRM happy_var_1) (ListBanana (epUniTok happy_var_1) (epUniTok happy_var_4)) [] noAnn []) happy_var_2 Prefix + (reverse happy_var_3)))}}}}) + ) (\r -> happyReturn (happyIn232 r)) + +happyReduce_600 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_600 = happySpecReduce_3 217# happyReduction_600 +happyReduction_600 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut233 happy_x_1 of { (HappyWrap233 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut318 happy_x_3 of { (HappyWrap318 happy_var_3) -> + happyIn233 + (sLL happy_var_1 happy_var_3 ((sLLa happy_var_2 happy_var_3 $ DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) happy_var_3) `NE.cons` unLoc happy_var_1) + )}}} + +happyReduce_601 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_601 = happySpecReduce_2 217# happyReduction_601 +happyReduction_601 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut318 happy_x_2 of { (HappyWrap318 happy_var_2) -> + happyIn233 + (sLL happy_var_1 happy_var_2 ((sLLa happy_var_1 happy_var_2 $ DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_1)) happy_var_2) :| []) + )}} + +happyReduce_602 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_602 = happySpecReduce_1 218# happyReduction_602 +happyReduction_602 happy_x_1 + = case happyOut235 happy_x_1 of { (HappyWrap235 happy_var_1) -> + happyIn234 + (fmap (HsUntypedSplice noExtField) (reLoc happy_var_1) + )} + +happyReduce_603 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_603 = happySpecReduce_1 218# happyReduction_603 +happyReduction_603 happy_x_1 + = case happyOut236 happy_x_1 of { (HappyWrap236 happy_var_1) -> + happyIn234 + (fmap (HsTypedSplice noExtField) (reLoc happy_var_1) + )} + +happyReduce_604 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_604 = happyMonadReduce 2# 219# happyReduction_604 +happyReduction_604 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut232 happy_x_2 of { (HappyWrap232 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + return (sLL happy_var_1 happy_var_2 $ HsUntypedSpliceExpr (epTok happy_var_1) happy_var_2))}}) + ) (\r -> happyReturn (happyIn235 r)) + +happyReduce_605 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_605 = happyMonadReduce 2# 220# happyReduction_605 +happyReduction_605 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut232 happy_x_2 of { (HappyWrap232 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + return (sLL happy_var_1 happy_var_2 $ (HsTypedSpliceExpr (epTok happy_var_1) happy_var_2)))}}) + ) (\r -> happyReturn (happyIn236 r)) + +happyReduce_606 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_606 = happySpecReduce_2 221# happyReduction_606 +happyReduction_606 happy_x_2 + happy_x_1 + = case happyOut237 happy_x_1 of { (HappyWrap237 happy_var_1) -> + case happyOut238 happy_x_2 of { (HappyWrap238 happy_var_2) -> + happyIn237 + (happy_var_2 : happy_var_1 + )}} + +happyReduce_607 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_607 = happySpecReduce_0 221# happyReduction_607 +happyReduction_607 = happyIn237 + ([] + ) + +happyReduce_608 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_608 = happyMonadReduce 1# 222# happyReduction_608 +happyReduction_608 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut230 happy_x_1 of { (HappyWrap230 happy_var_1) -> + ( runPV (unECP happy_var_1) >>= \ (cmd :: LHsCmd GhcPs) -> + runPV (checkCmdBlockArguments cmd) >>= \ _ -> + return (sL1a cmd $ HsCmdTop noExtField cmd))}) + ) (\r -> happyReturn (happyIn238 r)) + +happyReduce_609 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_609 = happySpecReduce_3 223# happyReduction_609 +happyReduction_609 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut240 happy_x_2 of { (HappyWrap240 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn239 + (((epTok happy_var_1 ,epTok happy_var_3),happy_var_2) + )}}} + +happyReduce_610 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_610 = happySpecReduce_3 223# happyReduction_610 +happyReduction_610 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut240 happy_x_2 of { (HappyWrap240 happy_var_2) -> + happyIn239 + (((NoEpTok, NoEpTok),happy_var_2) + )} + +happyReduce_611 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_611 = happySpecReduce_1 224# happyReduction_611 +happyReduction_611 happy_x_1 + = case happyOut78 happy_x_1 of { (HappyWrap78 happy_var_1) -> + happyIn240 + (cvTopDecls happy_var_1 + )} + +happyReduce_612 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_612 = happySpecReduce_1 224# happyReduction_612 +happyReduction_612 happy_x_1 + = case happyOut77 happy_x_1 of { (HappyWrap77 happy_var_1) -> + happyIn240 + (cvTopDecls happy_var_1 + )} + +happyReduce_613 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_613 = happySpecReduce_1 225# happyReduction_613 +happyReduction_613 happy_x_1 + = case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> + happyIn241 + (happy_var_1 + )} + +happyReduce_614 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_614 = happyMonadReduce 2# 225# happyReduction_614 +happyReduction_614 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOut308 happy_x_2 of { (HappyWrap308 happy_var_2) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (rejectPragmaPV happy_var_1) >> + runPV happy_var_2 >>= \ happy_var_2 -> + return $ ecpFromExp $ + sLLa happy_var_1 happy_var_2 $ SectionL noExtField happy_var_1 (n2l happy_var_2))}}) + ) (\r -> happyReturn (happyIn241 r)) + +happyReduce_615 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_615 = happySpecReduce_2 225# happyReduction_615 +happyReduction_615 happy_x_2 + happy_x_1 + = case happyOut309 happy_x_1 of { (HappyWrap309 happy_var_1) -> + case happyOut224 happy_x_2 of { (HappyWrap224 happy_var_2) -> + happyIn241 + (ECP $ + superInfixOp $ + unECP happy_var_2 >>= \ happy_var_2 -> + happy_var_1 >>= \ happy_var_1 -> + mkHsSectionR_PV (comb2 happy_var_1 happy_var_2) (n2l happy_var_1) happy_var_2 + )}} + +happyReduce_616 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_616 = happySpecReduce_2 226# happyReduction_616 +happyReduction_616 happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOut243 happy_x_2 of { (HappyWrap243 happy_var_2) -> + happyIn242 + (unECP happy_var_1 >>= \ happy_var_1 -> + happy_var_2 >>= \ happy_var_2 -> + do { t <- amsA happy_var_1 [AddCommaAnn (EpTok $ srcSpan2e $ fst happy_var_2)] + ; return (Tuple (Right t : snd happy_var_2)) } + )}} + +happyReduce_617 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_617 = happySpecReduce_2 226# happyReduction_617 +happyReduction_617 happy_x_2 + happy_x_1 + = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> + case happyOut244 happy_x_2 of { (HappyWrap244 happy_var_2) -> + happyIn242 + (happy_var_2 >>= \ happy_var_2 -> + do { let {cos = NE.map (\ll -> (Left (EpAnn (spanAsAnchor ll) True emptyComments))) (fst happy_var_1) } + ; return (Tuple (toList cos ++ happy_var_2)) } + )}} + +happyReduce_618 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_618 = happySpecReduce_2 226# happyReduction_618 +happyReduction_618 happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOut337 happy_x_2 of { (HappyWrap337 happy_var_2) -> + happyIn242 + (unECP happy_var_1 >>= \ happy_var_1 -> return $ + (Sum 1 (snd happy_var_2 + 1) happy_var_1 [] (fst happy_var_2)) + )}} + +happyReduce_619 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_619 = happySpecReduce_3 226# happyReduction_619 +happyReduction_619 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut337 happy_x_1 of { (HappyWrap337 happy_var_1) -> + case happyOut241 happy_x_2 of { (HappyWrap241 happy_var_2) -> + case happyOut336 happy_x_3 of { (HappyWrap336 happy_var_3) -> + happyIn242 + (unECP happy_var_2 >>= \ happy_var_2 -> return $ + (Sum (snd happy_var_1 + 1) (snd happy_var_1 + snd happy_var_3 + 1) happy_var_2 (fst happy_var_1) (fst happy_var_3)) + )}}} + +happyReduce_620 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_620 = happySpecReduce_2 227# happyReduction_620 +happyReduction_620 happy_x_2 + happy_x_1 + = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> + case happyOut244 happy_x_2 of { (HappyWrap244 happy_var_2) -> + happyIn243 + (happy_var_2 >>= \ happy_var_2 -> + do { let {cos = map (\l -> (Left (EpAnn (spanAsAnchor l) True emptyComments))) (tail $ fst happy_var_1) } + ; return ((head $ fst happy_var_1, cos ++ happy_var_2)) } + )}} + +happyReduce_621 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_621 = happySpecReduce_2 228# happyReduction_621 +happyReduction_621 happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOut243 happy_x_2 of { (HappyWrap243 happy_var_2) -> + happyIn244 + (unECP happy_var_1 >>= \ happy_var_1 -> + happy_var_2 >>= \ happy_var_2 -> + do { t <- amsA happy_var_1 [AddCommaAnn (EpTok $ srcSpan2e $ fst happy_var_2)] + ; return (Right t : snd happy_var_2) } + )}} + +happyReduce_622 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_622 = happySpecReduce_1 228# happyReduction_622 +happyReduction_622 happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + happyIn244 + (unECP happy_var_1 >>= \ happy_var_1 -> + return [Right happy_var_1] + )} + +happyReduce_623 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_623 = happySpecReduce_0 228# happyReduction_623 +happyReduction_623 = happyIn244 + (return [Left noAnn] + ) + +happyReduce_624 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_624 = happySpecReduce_1 229# happyReduction_624 +happyReduction_624 happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + happyIn245 + (\loc (ao,ac) -> unECP happy_var_1 >>= \ happy_var_1 -> + mkHsExplicitListPV loc [happy_var_1] (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) + )} + +happyReduce_625 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_625 = happySpecReduce_1 229# happyReduction_625 +happyReduction_625 happy_x_1 + = case happyOut246 happy_x_1 of { (HappyWrap246 happy_var_1) -> + happyIn245 + (\loc (ao,ac) -> happy_var_1 >>= \ happy_var_1 -> + mkHsExplicitListPV loc (reverse happy_var_1) (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn []) + )} + +happyReduce_626 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_626 = happySpecReduce_2 229# happyReduction_626 +happyReduction_626 happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn245 + (\loc (ao,ac) -> unECP happy_var_1 >>= \ happy_var_1 -> + amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok happy_var_2) (EpTok ac)) Nothing (From happy_var_1)) + >>= ecpFromExp' + )}} + +happyReduce_627 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_627 = happyReduce 4# 229# happyReduction_627 +happyReduction_627 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut222 happy_x_3 of { (HappyWrap222 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + happyIn245 + (\loc (ao,ac) -> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok happy_var_2)) (epTok happy_var_4) (EpTok ac)) Nothing (FromThen happy_var_1 happy_var_3)) + >>= ecpFromExp' + ) `HappyStk` happyRest}}}} + +happyReduce_628 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_628 = happySpecReduce_3 229# happyReduction_628 +happyReduction_628 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut222 happy_x_3 of { (HappyWrap222 happy_var_3) -> + happyIn245 + (\loc (ao,ac) -> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) Nothing (epTok happy_var_2) (EpTok ac)) Nothing (FromTo happy_var_1 happy_var_3)) + >>= ecpFromExp' + )}}} + +happyReduce_629 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_629 = happyReduce 5# 229# happyReduction_629 +happyReduction_629 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut222 happy_x_3 of { (HappyWrap222 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut222 happy_x_5 of { (HappyWrap222 happy_var_5) -> + happyIn245 + (\loc (ao,ac) -> + unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + unECP happy_var_5 >>= \ happy_var_5 -> + amsA' (L loc $ ArithSeq (AnnArithSeq (EpTok ao) (Just (epTok happy_var_2)) (epTok happy_var_4) (EpTok ac)) Nothing (FromThenTo happy_var_1 happy_var_3 happy_var_5)) + >>= ecpFromExp' + ) `HappyStk` happyRest}}}}} + +happyReduce_630 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_630 = happySpecReduce_3 229# happyReduction_630 +happyReduction_630 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut247 happy_x_3 of { (HappyWrap247 happy_var_3) -> + happyIn245 + (\loc (ao,ac) -> + checkMonadComp >>= \ ctxt -> + unECP happy_var_1 >>= \ happy_var_1 -> do { t <- addTrailingVbarA happy_var_1 (epTok happy_var_2) + ; amsA' (L loc $ mkHsCompAnns ctxt (unLoc happy_var_3) t (AnnList Nothing (ListSquare (EpTok ao) (EpTok ac)) [] noAnn [])) + >>= ecpFromExp' } + )}}} + +happyReduce_631 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_631 = happySpecReduce_3 230# happyReduction_631 +happyReduction_631 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut246 happy_x_1 of { (HappyWrap246 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut241 happy_x_3 of { (HappyWrap241 happy_var_3) -> + happyIn246 + (happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + case happy_var_1 of + (h:t) -> do + h' <- addTrailingCommaA h (epTok happy_var_2) + return (((:) $! happy_var_3) $! (h':t)) + )}}} + +happyReduce_632 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_632 = happySpecReduce_3 230# happyReduction_632 +happyReduction_632 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut241 happy_x_1 of { (HappyWrap241 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut241 happy_x_3 of { (HappyWrap241 happy_var_3) -> + happyIn246 + (unECP happy_var_1 >>= \ happy_var_1 -> + unECP happy_var_3 >>= \ happy_var_3 -> + do { h <- addTrailingCommaA happy_var_1 (epTok happy_var_2) + ; return [happy_var_3,h] } + )}}} + +happyReduce_633 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_633 = happySpecReduce_1 231# happyReduction_633 +happyReduction_633 happy_x_1 + = case happyOut248 happy_x_1 of { (HappyWrap248 happy_var_1) -> + happyIn247 + (case unLoc happy_var_1 of + qs:|[] -> sL1 happy_var_1 qs + -- We just had one thing in our "parallel" list so + -- we simply return that thing directly + + qss -> sL1 happy_var_1 [sL1a happy_var_1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr | + qs <- qss] + noExpr noSyntaxExpr] + -- We actually found some actual parallel lists so + -- we wrap them into as a ParStmt + )} + +happyReduce_634 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_634 = happyMonadReduce 3# 232# happyReduction_634 +happyReduction_634 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut249 happy_x_1 of { (HappyWrap249 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut248 happy_x_3 of { (HappyWrap248 happy_var_3) -> + ( case unLoc happy_var_1 of + h:|t -> do + h' <- addTrailingVbarA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (reverse (h':t) NE.<| unLoc happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn248 r)) + +happyReduce_635 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_635 = happySpecReduce_1 232# happyReduction_635 +happyReduction_635 happy_x_1 + = case happyOut249 happy_x_1 of { (HappyWrap249 happy_var_1) -> + happyIn248 + (L (getLoc happy_var_1) (NE.singleton (reverse (toList (unLoc happy_var_1)))) + )} + +happyReduce_636 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_636 = happyMonadReduce 3# 233# happyReduction_636 +happyReduction_636 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut249 happy_x_1 of { (HappyWrap249 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut250 happy_x_3 of { (HappyWrap250 happy_var_3) -> + ( case unLoc happy_var_1 of + h:|t -> do + h' <- addTrailingCommaA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (NE.singleton (sLLa happy_var_1 happy_var_3 ((unLoc happy_var_3) (reverse (h':t)))))))}}}) + ) (\r -> happyReturn (happyIn249 r)) + +happyReduce_637 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_637 = happyMonadReduce 3# 233# happyReduction_637 +happyReduction_637 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut249 happy_x_1 of { (HappyWrap249 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut270 happy_x_3 of { (HappyWrap270 happy_var_3) -> + ( runPV happy_var_3 >>= \ happy_var_3 -> + case unLoc happy_var_1 of + h:|t -> do + h' <- addTrailingCommaA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (happy_var_3 :| (h':t))))}}}) + ) (\r -> happyReturn (happyIn249 r)) + +happyReduce_638 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_638 = happySpecReduce_1 233# happyReduction_638 +happyReduction_638 happy_x_1 + = case happyOut250 happy_x_1 of { (HappyWrap250 happy_var_1) -> + happyIn249 + (sLL happy_var_1 happy_var_1 (NE.singleton (L (getLocAnn happy_var_1) ((unLoc happy_var_1) []))) + )} + +happyReduce_639 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_639 = happyMonadReduce 1# 233# happyReduction_639 +happyReduction_639 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut270 happy_x_1 of { (HappyWrap270 happy_var_1) -> + ( runPV happy_var_1 >>= \ happy_var_1 -> + return $ sL1 happy_var_1 (NE.singleton happy_var_1))}) + ) (\r -> happyReturn (happyIn249 r)) + +happyReduce_640 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_640 = happyMonadReduce 2# 234# happyReduction_640 +happyReduction_640 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + return ( + sLL happy_var_1 happy_var_2 (\ss -> (mkTransformStmt (AnnTransStmt (epTok happy_var_1) noAnn noAnn noAnn) ss happy_var_2))))}}) + ) (\r -> happyReturn (happyIn250 r)) + +happyReduce_641 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_641 = happyMonadReduce 4# 234# happyReduction_641 +happyReduction_641 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + runPV (unECP happy_var_4) >>= \ happy_var_4 -> + return (sLL happy_var_1 happy_var_4 (\ss -> (mkTransformByStmt (AnnTransStmt (epTok happy_var_1) noAnn (Just (epTok happy_var_3)) noAnn) ss happy_var_2 happy_var_4))))}}}}) + ) (\r -> happyReturn (happyIn250 r)) + +happyReduce_642 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_642 = happyMonadReduce 4# 234# happyReduction_642 +happyReduction_642 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> + return (sLL happy_var_1 happy_var_4 (\ss -> (mkGroupUsingStmt (AnnTransStmt (epTok happy_var_1) (Just (epTok happy_var_2)) noAnn (Just (epTok happy_var_3))) ss happy_var_4))))}}}}) + ) (\r -> happyReturn (happyIn250 r)) + +happyReduce_643 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_643 = happyMonadReduce 6# 234# happyReduction_643 +happyReduction_643 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + case happyOutTok happy_x_5 of { happy_var_5 -> + case happyOut221 happy_x_6 of { (HappyWrap221 happy_var_6) -> + ( runPV (unECP happy_var_4) >>= \ happy_var_4 -> + runPV (unECP happy_var_6) >>= \ happy_var_6 -> + return (sLL happy_var_1 happy_var_6 (\ss -> (mkGroupByUsingStmt (AnnTransStmt (epTok happy_var_1) (Just (epTok happy_var_2)) (Just (epTok happy_var_3)) (Just (epTok happy_var_5))) ss happy_var_4 happy_var_6))))}}}}}}) + ) (\r -> happyReturn (happyIn250 r)) + +happyReduce_644 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_644 = happySpecReduce_1 235# happyReduction_644 +happyReduction_644 happy_x_1 + = case happyOut252 happy_x_1 of { (HappyWrap252 happy_var_1) -> + happyIn251 + (L (getLoc happy_var_1) (reverse (unLoc happy_var_1)) + )} + +happyReduce_645 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_645 = happyMonadReduce 3# 236# happyReduction_645 +happyReduction_645 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut252 happy_x_1 of { (HappyWrap252 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut270 happy_x_3 of { (HappyWrap270 happy_var_3) -> + ( runPV happy_var_3 >>= \ happy_var_3 -> + case unLoc happy_var_1 of + (h:t) -> do + h' <- addTrailingCommaA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (happy_var_3 : (h':t))))}}}) + ) (\r -> happyReturn (happyIn252 r)) + +happyReduce_646 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_646 = happyMonadReduce 1# 236# happyReduction_646 +happyReduction_646 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut270 happy_x_1 of { (HappyWrap270 happy_var_1) -> + ( runPV happy_var_1 >>= \ happy_var_1 -> + return $ sL1 happy_var_1 [happy_var_1])}) + ) (\r -> happyReturn (happyIn252 r)) + +happyReduce_647 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_647 = happySpecReduce_2 237# happyReduction_647 +happyReduction_647 happy_x_2 + happy_x_1 + = case happyOut254 happy_x_1 of { (HappyWrap254 happy_var_1) -> + case happyOut137 happy_x_2 of { (HappyWrap137 happy_var_2) -> + happyIn253 + (happy_var_1 >>= \alt -> + do { let {L l (bs, csw) = adaptWhereBinds happy_var_2} + ; acs (comb2 alt (L l bs)) (\loc cs -> L loc (GRHSs (cs Semi.<> csw) (unLoc alt) bs)) } + )}} + +happyReduce_648 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_648 = happySpecReduce_2 238# happyReduction_648 +happyReduction_648 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut221 happy_x_2 of { (HappyWrap221 happy_var_2) -> + happyIn254 + (unECP happy_var_2 >>= \ happy_var_2 -> + acs (comb2 happy_var_1 happy_var_2) (\loc cs -> L loc (unguardedRHS (EpAnn (spanAsAnchor $ comb2 happy_var_1 happy_var_2) (GrhsAnn Nothing (Right $ epUniTok happy_var_1)) cs) (comb2 happy_var_1 happy_var_2) happy_var_2)) + )}} + +happyReduce_649 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_649 = happySpecReduce_1 238# happyReduction_649 +happyReduction_649 happy_x_1 + = case happyOut255 happy_x_1 of { (HappyWrap255 happy_var_1) -> + happyIn254 + (happy_var_1 >>= \gdpats -> + return $ sL1 gdpats (NE.reverse (unLoc gdpats)) + )} + +happyReduce_650 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_650 = happySpecReduce_2 239# happyReduction_650 +happyReduction_650 happy_x_2 + happy_x_1 + = case happyOut255 happy_x_1 of { (HappyWrap255 happy_var_1) -> + case happyOut257 happy_x_2 of { (HappyWrap257 happy_var_2) -> + happyIn255 + (happy_var_1 >>= \gdpats -> + happy_var_2 >>= \gdpat -> + return $ sLL gdpats gdpat (gdpat NE.<| unLoc gdpats) + )}} + +happyReduce_651 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_651 = happySpecReduce_1 239# happyReduction_651 +happyReduction_651 happy_x_1 + = case happyOut257 happy_x_1 of { (HappyWrap257 happy_var_1) -> + happyIn255 + (happy_var_1 >>= \gdpat -> return $ sL1 gdpat (NE.singleton gdpat) + )} + +happyReduce_652 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_652 = happyMonadReduce 3# 240# happyReduction_652 +happyReduction_652 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut255 happy_x_2 of { (HappyWrap255 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( runPV happy_var_2 >>= \ happy_var_2 -> + return $ sLL happy_var_1 happy_var_3 ((epTok happy_var_1,epTok happy_var_3),unLoc happy_var_2))}}}) + ) (\r -> happyReturn (happyIn256 r)) + +happyReduce_653 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_653 = happyMonadReduce 2# 240# happyReduction_653 +happyReduction_653 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut255 happy_x_1 of { (HappyWrap255 happy_var_1) -> + ( runPV happy_var_1 >>= \ happy_var_1 -> + return $ sL1 happy_var_1 ((NoEpTok, NoEpTok),unLoc happy_var_1))}) + ) (\r -> happyReturn (happyIn256 r)) + +happyReduce_654 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_654 = happyReduce 4# 241# happyReduction_654 +happyReduction_654 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut251 happy_x_2 of { (HappyWrap251 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + case happyOut221 happy_x_4 of { (HappyWrap221 happy_var_4) -> + happyIn257 + (unECP happy_var_4 >>= \ happy_var_4 -> + acsA (comb2 happy_var_1 happy_var_4) (\loc cs -> sL loc $ GRHS (EpAnn (glEE happy_var_1 happy_var_4) (GrhsAnn (Just $ epTok happy_var_1) (Right $ epUniTok happy_var_3)) cs) (unLoc happy_var_2) happy_var_4) + ) `HappyStk` happyRest}}}} + +happyReduce_655 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_655 = happyMonadReduce 1# 242# happyReduction_655 +happyReduction_655 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> + ( (checkPattern <=< runPV) (unECP happy_var_1))}) + ) (\r -> happyReturn (happyIn258 r)) + +happyReduce_656 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_656 = happyMonadReduce 1# 243# happyReduction_656 +happyReduction_656 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut343 happy_x_1 of { (HappyWrap343 happy_var_1) -> + ( case unLoc happy_var_1 of + pat :| [] -> return pat + pats -> hintOrPats (sL1a happy_var_1 (OrPat NoExtField pats)))}) + ) (\r -> happyReturn (happyIn259 r)) + +happyReduce_657 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_657 = happySpecReduce_1 244# happyReduction_657 +happyReduction_657 happy_x_1 + = case happyOut259 happy_x_1 of { (HappyWrap259 happy_var_1) -> + happyIn260 + ([ happy_var_1 ] + )} + +happyReduce_658 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_658 = happyMonadReduce 1# 245# happyReduction_658 +happyReduction_658 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> + ( -- See Note [Parser-Validator Details] in GHC.Parser.PostProcess + checkPattern_details incompleteDoBlock + (unECP happy_var_1))}) + ) (\r -> happyReturn (happyIn261 r)) + +happyReduce_659 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_659 = happySpecReduce_1 246# happyReduction_659 +happyReduction_659 happy_x_1 + = case happyOut264 happy_x_1 of { (HappyWrap264 happy_var_1) -> + happyIn262 + (happy_var_1 + )} + +happyReduce_660 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_660 = happySpecReduce_2 246# happyReduction_660 +happyReduction_660 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + happyIn262 + (sLLa happy_var_1 happy_var_2 (InvisPat (epTok happy_var_1, SpecifiedSpec) (mkHsTyPat happy_var_2)) + )}} + +happyReduce_661 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_661 = happySpecReduce_2 247# happyReduction_661 +happyReduction_661 happy_x_2 + happy_x_1 + = case happyOut262 happy_x_1 of { (HappyWrap262 happy_var_1) -> + case happyOut263 happy_x_2 of { (HappyWrap263 happy_var_2) -> + happyIn263 + (happy_var_1 : happy_var_2 + )}} + +happyReduce_662 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_662 = happySpecReduce_0 247# happyReduction_662 +happyReduction_662 = happyIn263 + ([] + ) + +happyReduce_663 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_663 = happyMonadReduce 1# 248# happyReduction_663 +happyReduction_663 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut230 happy_x_1 of { (HappyWrap230 happy_var_1) -> + ( (checkPattern <=< runPV) (unECP happy_var_1))}) + ) (\r -> happyReturn (happyIn264 r)) + +happyReduce_664 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_664 = happySpecReduce_3 249# happyReduction_664 +happyReduction_664 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut266 happy_x_2 of { (HappyWrap266 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn265 + (happy_var_2 >>= \ happy_var_2 -> + amsr (sLL happy_var_1 happy_var_3 (reverse $ snd $ unLoc happy_var_2)) (AnnList (stmtsAnchor happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fromOL $ fst $ unLoc happy_var_2) noAnn []) + )}}} + +happyReduce_665 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_665 = happySpecReduce_3 249# happyReduction_665 +happyReduction_665 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut266 happy_x_2 of { (HappyWrap266 happy_var_2) -> + happyIn265 + (happy_var_2 >>= \ happy_var_2 -> amsr + (L (stmtsLoc happy_var_2) (reverse $ snd $ unLoc happy_var_2)) (AnnList (stmtsAnchor happy_var_2) ListNone (fromOL $ fst $ unLoc happy_var_2) noAnn []) + )} + +happyReduce_666 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_666 = happySpecReduce_3 250# happyReduction_666 +happyReduction_666 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut266 happy_x_1 of { (HappyWrap266 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut269 happy_x_3 of { (HappyWrap269 happy_var_3) -> + happyIn266 + (happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ (happy_var_3 :: LStmt GhcPs (LocatedA b)) -> + case (snd $ unLoc happy_var_1) of + [] -> return (sLL happy_var_1 happy_var_3 ( (fst $ unLoc happy_var_1) `snocOL` (epTok happy_var_2) + , happy_var_3 : (snd $ unLoc happy_var_1))) + (h:t) -> do + { h' <- addTrailingSemiA h (epTok happy_var_2) + ; return $ sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 :(h':t)) } + )}}} + +happyReduce_667 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_667 = happySpecReduce_2 250# happyReduction_667 +happyReduction_667 happy_x_2 + happy_x_1 + = case happyOut266 happy_x_1 of { (HappyWrap266 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn266 + (happy_var_1 >>= \ happy_var_1 -> + case (snd $ unLoc happy_var_1) of + [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) `snocOL` (epTok happy_var_2),snd $ unLoc happy_var_1)) + (h:t) -> do + { h' <- addTrailingSemiA h (epTok happy_var_2) + ; return $ sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1,h':t) } + )}} + +happyReduce_668 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_668 = happySpecReduce_1 250# happyReduction_668 +happyReduction_668 happy_x_1 + = case happyOut269 happy_x_1 of { (HappyWrap269 happy_var_1) -> + happyIn266 + (happy_var_1 >>= \ happy_var_1 -> + return $ sL1 happy_var_1 (nilOL,[happy_var_1]) + )} + +happyReduce_669 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_669 = happySpecReduce_0 250# happyReduction_669 +happyReduction_669 = happyIn266 + (return $ noLoc (nilOL,[]) + ) + +happyReduce_670 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_670 = happyMonadReduce 1# 251# happyReduction_670 +happyReduction_670 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut269 happy_x_1 of { (HappyWrap269 happy_var_1) -> + ( fmap Just (runPV happy_var_1))}) + ) (\r -> happyReturn (happyIn267 r)) + +happyReduce_671 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_671 = happySpecReduce_0 251# happyReduction_671 +happyReduction_671 = happyIn267 + (Nothing + ) + +happyReduce_672 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_672 = happyMonadReduce 1# 252# happyReduction_672 +happyReduction_672 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut269 happy_x_1 of { (HappyWrap269 happy_var_1) -> + ( runPV happy_var_1)}) + ) (\r -> happyReturn (happyIn268 r)) + +happyReduce_673 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_673 = happySpecReduce_1 253# happyReduction_673 +happyReduction_673 happy_x_1 + = case happyOut270 happy_x_1 of { (HappyWrap270 happy_var_1) -> + happyIn269 + (happy_var_1 + )} + +happyReduce_674 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_674 = happySpecReduce_2 253# happyReduction_674 +happyReduction_674 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut265 happy_x_2 of { (HappyWrap265 happy_var_2) -> + happyIn269 + (happy_var_2 >>= \ happy_var_2 -> + amsA' (sLL happy_var_1 happy_var_2 $ mkRecStmt (hsDoAnn (epTok happy_var_1) happy_var_2) happy_var_2) + )}} + +happyReduce_675 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_675 = happySpecReduce_3 254# happyReduction_675 +happyReduction_675 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut261 happy_x_1 of { (HappyWrap261 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut221 happy_x_3 of { (HappyWrap221 happy_var_3) -> + happyIn270 + (unECP happy_var_3 >>= \ happy_var_3 -> + amsA' (sLL happy_var_1 happy_var_3 $ mkPsBindStmt (epUniTok happy_var_2) happy_var_1 happy_var_3) + )}}} + +happyReduce_676 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_676 = happySpecReduce_1 254# happyReduction_676 +happyReduction_676 happy_x_1 + = case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> + happyIn270 + (unECP happy_var_1 >>= \ happy_var_1 -> + return $ sL1a happy_var_1 $ mkBodyStmt happy_var_1 + )} + +happyReduce_677 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_677 = happySpecReduce_2 254# happyReduction_677 +happyReduction_677 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut136 happy_x_2 of { (HappyWrap136 happy_var_2) -> + happyIn270 + (amsA' (sLL happy_var_1 happy_var_2 $ mkLetStmt (epTok happy_var_1) (unLoc happy_var_2)) + )}} + +happyReduce_678 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_678 = happySpecReduce_1 255# happyReduction_678 +happyReduction_678 happy_x_1 + = case happyOut272 happy_x_1 of { (HappyWrap272 happy_var_1) -> + happyIn271 + (happy_var_1 + )} + +happyReduce_679 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_679 = happySpecReduce_0 255# happyReduction_679 +happyReduction_679 = happyIn271 + (return ([], Nothing) + ) + +happyReduce_680 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_680 = happySpecReduce_3 256# happyReduction_680 +happyReduction_680 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut273 happy_x_1 of { (HappyWrap273 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut272 happy_x_3 of { (HappyWrap272 happy_var_3) -> + happyIn272 + (happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ happy_var_3 -> do + h <- addTrailingCommaFBind happy_var_1 (epTok happy_var_2) + return (case happy_var_3 of (flds, dd) -> (h : flds, dd)) + )}}} + +happyReduce_681 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_681 = happySpecReduce_1 256# happyReduction_681 +happyReduction_681 happy_x_1 + = case happyOut273 happy_x_1 of { (HappyWrap273 happy_var_1) -> + happyIn272 + (happy_var_1 >>= \ happy_var_1 -> + return ([happy_var_1], Nothing) + )} + +happyReduce_682 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_682 = happySpecReduce_1 256# happyReduction_682 +happyReduction_682 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn272 + (return ([], Just (getLoc happy_var_1)) + )} + +happyReduce_683 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_683 = happySpecReduce_3 257# happyReduction_683 +happyReduction_683 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut241 happy_x_3 of { (HappyWrap241 happy_var_3) -> + happyIn273 + (unECP happy_var_3 >>= \ happy_var_3 -> + fmap Left $ amsA' (sLL happy_var_1 happy_var_3 $ HsFieldBind (Just (epTok happy_var_2)) (sL1a happy_var_1 $ mkFieldOcc happy_var_1) happy_var_3 False) + )}}} + +happyReduce_684 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_684 = happySpecReduce_1 257# happyReduction_684 +happyReduction_684 happy_x_1 + = case happyOut317 happy_x_1 of { (HappyWrap317 happy_var_1) -> + happyIn273 + (placeHolderPunRhs >>= \rhs -> + fmap Left $ amsA' (sL1 happy_var_1 $ HsFieldBind Nothing (sL1a happy_var_1 $ mkFieldOcc happy_var_1) rhs True) + )} + +happyReduce_685 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_685 = happyReduce 5# 257# happyReduction_685 +happyReduction_685 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut274 happy_x_3 of { (HappyWrap274 happy_var_3) -> + case happyOutTok happy_x_4 of { happy_var_4 -> + case happyOut241 happy_x_5 of { (HappyWrap241 happy_var_5) -> + happyIn273 + (do + let top = sL1a happy_var_1 $ DotFieldOcc noAnn happy_var_1 + ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc happy_var_3) + lf' = comb2 happy_var_2 (L lf ()) + fields = top :| L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) f) : t + final = last fields + l = comb2 happy_var_1 happy_var_3 + isPun = False + happy_var_5 <- unECP happy_var_5 + fmap Right $ mkHsProjUpdatePV (comb2 happy_var_1 happy_var_5) (L l fields) happy_var_5 isPun + (Just (epTok happy_var_4)) + ) `HappyStk` happyRest}}}}} + +happyReduce_686 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_686 = happySpecReduce_3 257# happyReduction_686 +happyReduction_686 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut274 happy_x_3 of { (HappyWrap274 happy_var_3) -> + happyIn273 + (do + let top = sL1a happy_var_1 $ DotFieldOcc noAnn happy_var_1 + ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc happy_var_3) + lf' = comb2 happy_var_2 (L lf ()) + fields = top :| L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ epTok happy_var_2)) f) : t + final = last fields + l = comb2 happy_var_1 happy_var_3 + isPun = True + var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) + fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun Nothing + )}}} + +happyReduce_687 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_687 = happySpecReduce_3 258# happyReduction_687 +happyReduction_687 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut274 happy_x_1 of { (HappyWrap274 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut318 happy_x_3 of { (HappyWrap318 happy_var_3) -> + happyIn274 + (sLL happy_var_1 happy_var_3 ((sLLa happy_var_2 happy_var_3 (DotFieldOcc (AnnFieldLabel $ Just $ epTok happy_var_2) happy_var_3)) : unLoc happy_var_1) + )}}} + +happyReduce_688 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_688 = happySpecReduce_1 258# happyReduction_688 +happyReduction_688 happy_x_1 + = case happyOut318 happy_x_1 of { (HappyWrap318 happy_var_1) -> + happyIn274 + (sL1 happy_var_1 [sL1a happy_var_1 (DotFieldOcc (AnnFieldLabel Nothing) happy_var_1)] + )} + +happyReduce_689 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_689 = happyMonadReduce 3# 259# happyReduction_689 +happyReduction_689 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut275 happy_x_1 of { (HappyWrap275 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut276 happy_x_3 of { (HappyWrap276 happy_var_3) -> + ( case unLoc happy_var_1 of + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (let { this = happy_var_3; rest = h':t } + in rest `seq` this `seq` sLL happy_var_1 happy_var_3 (this : rest)))}}}) + ) (\r -> happyReturn (happyIn275 r)) + +happyReduce_690 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_690 = happyMonadReduce 2# 259# happyReduction_690 +happyReduction_690 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut275 happy_x_1 of { (HappyWrap275 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( case unLoc happy_var_1 of + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (h':t)))}}) + ) (\r -> happyReturn (happyIn275 r)) + +happyReduce_691 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_691 = happySpecReduce_1 259# happyReduction_691 +happyReduction_691 happy_x_1 + = case happyOut276 happy_x_1 of { (HappyWrap276 happy_var_1) -> + happyIn275 + (let this = happy_var_1 in this `seq` (sL1 happy_var_1 [this]) + )} + +happyReduce_692 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_692 = happyMonadReduce 3# 260# happyReduction_692 +happyReduction_692 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut277 happy_x_1 of { (HappyWrap277 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut221 happy_x_3 of { (HappyWrap221 happy_var_3) -> + ( runPV (unECP happy_var_3) >>= \ happy_var_3 -> + amsA' (sLL happy_var_1 happy_var_3 (IPBind (epTok happy_var_2) (reLoc happy_var_1) happy_var_3)))}}}) + ) (\r -> happyReturn (happyIn276 r)) + +happyReduce_693 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_693 = happySpecReduce_1 261# happyReduction_693 +happyReduction_693 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn277 + (sL1 happy_var_1 (HsIPName (getIPDUPVARID happy_var_1)) + )} + +happyReduce_694 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_694 = happySpecReduce_1 262# happyReduction_694 +happyReduction_694 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn278 + (sL1 happy_var_1 (getLABELVARIDs happy_var_1, getLABELVARID happy_var_1) + )} + +happyReduce_695 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_695 = happySpecReduce_1 263# happyReduction_695 +happyReduction_695 happy_x_1 + = case happyOut280 happy_x_1 of { (HappyWrap280 happy_var_1) -> + happyIn279 + (happy_var_1 + )} + +happyReduce_696 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_696 = happySpecReduce_0 263# happyReduction_696 +happyReduction_696 = happyIn279 + (noLocA mkTrue + ) + +happyReduce_697 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_697 = happySpecReduce_1 264# happyReduction_697 +happyReduction_697 happy_x_1 + = case happyOut281 happy_x_1 of { (HappyWrap281 happy_var_1) -> + happyIn280 + (happy_var_1 + )} + +happyReduce_698 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_698 = happyMonadReduce 3# 264# happyReduction_698 +happyReduction_698 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut281 happy_x_1 of { (HappyWrap281 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut280 happy_x_3 of { (HappyWrap280 happy_var_3) -> + ( do { h <- addTrailingVbarL happy_var_1 (epTok happy_var_2) + ; return (sLLa happy_var_1 happy_var_3 (Or [h,happy_var_3])) })}}}) + ) (\r -> happyReturn (happyIn280 r)) + +happyReduce_699 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_699 = happySpecReduce_1 265# happyReduction_699 +happyReduction_699 happy_x_1 + = case happyOut282 happy_x_1 of { (HappyWrap282 happy_var_1) -> + happyIn281 + (sLLa (head happy_var_1) (last happy_var_1) (And (toList happy_var_1)) + )} + +happyReduce_700 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_700 = happySpecReduce_1 266# happyReduction_700 +happyReduction_700 happy_x_1 + = case happyOut283 happy_x_1 of { (HappyWrap283 happy_var_1) -> + happyIn282 + (NE.singleton happy_var_1 + )} + +happyReduce_701 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_701 = happyMonadReduce 3# 266# happyReduction_701 +happyReduction_701 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut283 happy_x_1 of { (HappyWrap283 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut282 happy_x_3 of { (HappyWrap282 happy_var_3) -> + ( do { h <- addTrailingCommaL happy_var_1 (epTok happy_var_2) + ; return (h NE.<| happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn282 r)) + +happyReduce_702 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_702 = happyMonadReduce 3# 267# happyReduction_702 +happyReduction_702 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut280 happy_x_2 of { (HappyWrap280 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (Parens happy_var_2)) + (AnnList Nothing (ListParens (epTok happy_var_1) (epTok happy_var_3)) [] noAnn []))}}}) + ) (\r -> happyReturn (happyIn283 r)) + +happyReduce_703 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_703 = happySpecReduce_1 267# happyReduction_703 +happyReduction_703 happy_x_1 + = case happyOut285 happy_x_1 of { (HappyWrap285 happy_var_1) -> + happyIn283 + (sL1a happy_var_1 (Var happy_var_1) + )} + +happyReduce_704 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_704 = happySpecReduce_1 268# happyReduction_704 +happyReduction_704 happy_x_1 + = case happyOut285 happy_x_1 of { (HappyWrap285 happy_var_1) -> + happyIn284 + (sL1 happy_var_1 [happy_var_1] + )} + +happyReduce_705 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_705 = happyMonadReduce 3# 268# happyReduction_705 +happyReduction_705 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut285 happy_x_1 of { (HappyWrap285 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut284 happy_x_3 of { (HappyWrap284 happy_var_3) -> + ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) + ; return (sLL happy_var_1 happy_var_3 (h : unLoc happy_var_3)) })}}}) + ) (\r -> happyReturn (happyIn284 r)) + +happyReduce_706 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_706 = happySpecReduce_1 269# happyReduction_706 +happyReduction_706 happy_x_1 + = case happyOut316 happy_x_1 of { (HappyWrap316 happy_var_1) -> + happyIn285 + (happy_var_1 + )} + +happyReduce_707 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_707 = happySpecReduce_1 269# happyReduction_707 +happyReduction_707 happy_x_1 + = case happyOut288 happy_x_1 of { (HappyWrap288 happy_var_1) -> + happyIn285 + (happy_var_1 + )} + +happyReduce_708 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_708 = happySpecReduce_1 270# happyReduction_708 +happyReduction_708 happy_x_1 + = case happyOut287 happy_x_1 of { (HappyWrap287 happy_var_1) -> + happyIn286 + (happy_var_1 + )} + +happyReduce_709 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_709 = happySpecReduce_1 270# happyReduction_709 +happyReduction_709 happy_x_1 + = case happyOut292 happy_x_1 of { (HappyWrap292 happy_var_1) -> + happyIn286 + (happy_var_1 + )} + +happyReduce_710 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_710 = happySpecReduce_1 271# happyReduction_710 +happyReduction_710 happy_x_1 + = case happyOut328 happy_x_1 of { (HappyWrap328 happy_var_1) -> + happyIn287 + (happy_var_1 + )} + +happyReduce_711 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_711 = happyMonadReduce 3# 271# happyReduction_711 +happyReduction_711 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut330 happy_x_2 of { (HappyWrap330 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn287 r)) + +happyReduce_712 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_712 = happySpecReduce_1 272# happyReduction_712 +happyReduction_712 happy_x_1 + = case happyOut329 happy_x_1 of { (HappyWrap329 happy_var_1) -> + happyIn288 + (happy_var_1 + )} + +happyReduce_713 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_713 = happyMonadReduce 3# 272# happyReduction_713 +happyReduction_713 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut331 happy_x_2 of { (HappyWrap331 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn288 r)) + +happyReduce_714 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_714 = happySpecReduce_1 272# happyReduction_714 +happyReduction_714 happy_x_1 + = case happyOut292 happy_x_1 of { (HappyWrap292 happy_var_1) -> + happyIn288 + (happy_var_1 + )} + +happyReduce_715 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_715 = happySpecReduce_1 273# happyReduction_715 +happyReduction_715 happy_x_1 + = case happyOut288 happy_x_1 of { (HappyWrap288 happy_var_1) -> + happyIn289 + (sL1 happy_var_1 (pure happy_var_1) + )} + +happyReduce_716 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_716 = happyMonadReduce 3# 273# happyReduction_716 +happyReduction_716 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut288 happy_x_1 of { (HappyWrap288 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut289 happy_x_3 of { (HappyWrap289 happy_var_3) -> + ( sLL happy_var_1 happy_var_3 . (:| toList (unLoc happy_var_3)) <$> addTrailingCommaN happy_var_1 (gl happy_var_2))}}}) + ) (\r -> happyReturn (happyIn289 r)) + +happyReduce_717 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_717 = happySpecReduce_1 274# happyReduction_717 +happyReduction_717 happy_x_1 + = case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> + happyIn290 + ([happy_var_1] + )} + +happyReduce_718 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_718 = happyMonadReduce 3# 274# happyReduction_718 +happyReduction_718 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut286 happy_x_1 of { (HappyWrap286 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut290 happy_x_3 of { (HappyWrap290 happy_var_3) -> + ( do { h <- addTrailingCommaN happy_var_1 (gl happy_var_2) + ; return (h : happy_var_3) })}}}) + ) (\r -> happyReturn (happyIn290 r)) + +happyReduce_719 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_719 = happyMonadReduce 3# 275# happyReduction_719 +happyReduction_719 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 $ tupleDataCon Boxed (snd happy_var_2 + 1)) + (NameAnnCommas (NameParens (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (toList $ fst happy_var_2)) []))}}}) + ) (\r -> happyReturn (happyIn291 r)) + +happyReduce_720 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_720 = happyMonadReduce 2# 275# happyReduction_720 +happyReduction_720 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 $ unboxedUnitDataCon) (NameAnnOnly (NameParensHash (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn291 r)) + +happyReduce_721 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_721 = happyMonadReduce 3# 275# happyReduction_721 +happyReduction_721 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 $ tupleDataCon Unboxed (snd happy_var_2 + 1)) + (NameAnnCommas (NameParensHash (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (toList $ fst happy_var_2)) []))}}}) + ) (\r -> happyReturn (happyIn291 r)) + +happyReduce_722 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_722 = happySpecReduce_1 276# happyReduction_722 +happyReduction_722 happy_x_1 + = case happyOut293 happy_x_1 of { (HappyWrap293 happy_var_1) -> + happyIn292 + (L (getLoc happy_var_1) $ nameRdrName (dataConName (unLoc happy_var_1)) + )} + +happyReduce_723 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_723 = happyMonadReduce 3# 276# happyReduction_723 +happyReduction_723 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 $ getRdrName unrestrictedFunTyCon) + (NameAnnRArrow (Just $ epTok happy_var_1) (epUniTok happy_var_2) (Just $ epTok happy_var_3) []))}}}) + ) (\r -> happyReturn (happyIn292 r)) + +happyReduce_724 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_724 = happySpecReduce_1 277# happyReduction_724 +happyReduction_724 happy_x_1 + = case happyOut291 happy_x_1 of { (HappyWrap291 happy_var_1) -> + happyIn293 + (happy_var_1 + )} + +happyReduce_725 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_725 = happyMonadReduce 2# 277# happyReduction_725 +happyReduction_725 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 unitDataCon) (NameAnnOnly (NameParens (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn293 r)) + +happyReduce_726 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_726 = happyMonadReduce 2# 277# happyReduction_726 +happyReduction_726 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 nilDataCon) (NameAnnOnly (NameSquare (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn293 r)) + +happyReduce_727 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_727 = happySpecReduce_1 278# happyReduction_727 +happyReduction_727 happy_x_1 + = case happyOut331 happy_x_1 of { (HappyWrap331 happy_var_1) -> + happyIn294 + (happy_var_1 + )} + +happyReduce_728 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_728 = happyMonadReduce 3# 278# happyReduction_728 +happyReduction_728 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut329 happy_x_2 of { (HappyWrap329 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn294 r)) + +happyReduce_729 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_729 = happySpecReduce_1 279# happyReduction_729 +happyReduction_729 happy_x_1 + = case happyOut330 happy_x_1 of { (HappyWrap330 happy_var_1) -> + happyIn295 + (happy_var_1 + )} + +happyReduce_730 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_730 = happyMonadReduce 3# 279# happyReduction_730 +happyReduction_730 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut328 happy_x_2 of { (HappyWrap328 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn295 r)) + +happyReduce_731 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_731 = happySpecReduce_1 280# happyReduction_731 +happyReduction_731 happy_x_1 + = case happyOut297 happy_x_1 of { (HappyWrap297 happy_var_1) -> + happyIn296 + (happy_var_1 + )} + +happyReduce_732 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_732 = happyMonadReduce 2# 280# happyReduction_732 +happyReduction_732 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 $ getRdrName unitTyCon) + (NameAnnOnly (NameParens (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn296 r)) + +happyReduce_733 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_733 = happyMonadReduce 2# 280# happyReduction_733 +happyReduction_733 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 $ getRdrName unboxedUnitTyCon) + (NameAnnOnly (NameParensHash (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn296 r)) + +happyReduce_734 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_734 = happyMonadReduce 2# 280# happyReduction_734 +happyReduction_734 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + ( amsr (sLL happy_var_1 happy_var_2 $ listTyCon_RDR) + (NameAnnOnly (NameSquare (epTok happy_var_1) (epTok happy_var_2)) []))}}) + ) (\r -> happyReturn (happyIn296 r)) + +happyReduce_735 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_735 = happySpecReduce_1 281# happyReduction_735 +happyReduction_735 happy_x_1 + = case happyOut298 happy_x_1 of { (HappyWrap298 happy_var_1) -> + happyIn297 + (happy_var_1 + )} + +happyReduce_736 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_736 = happyMonadReduce 3# 281# happyReduction_736 +happyReduction_736 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { n <- mkTupleSyntaxTycon Boxed (snd happy_var_2 + 1) + ; amsr (sLL happy_var_1 happy_var_3 n) (NameAnnCommas (NameParens (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (toList $ fst happy_var_2)) []) })}}}) + ) (\r -> happyReturn (happyIn297 r)) + +happyReduce_737 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_737 = happyMonadReduce 3# 281# happyReduction_737 +happyReduction_737 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut335 happy_x_2 of { (HappyWrap335 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { n <- mkTupleSyntaxTycon Unboxed (snd happy_var_2 + 1) + ; amsr (sLL happy_var_1 happy_var_3 n) (NameAnnCommas (NameParensHash (epTok happy_var_1) (epTok happy_var_3)) (map (EpTok . srcSpan2e) (toList $ fst happy_var_2)) []) })}}}) + ) (\r -> happyReturn (happyIn297 r)) + +happyReduce_738 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_738 = happyMonadReduce 3# 281# happyReduction_738 +happyReduction_738 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut337 happy_x_2 of { (HappyWrap337 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( do { requireLTPuns PEP_SumSyntaxType happy_var_1 happy_var_3 + ; amsr (sLL happy_var_1 happy_var_3 $ (getRdrName (sumTyCon (snd happy_var_2 + 1)))) + (NameAnnBars (epTok happy_var_1, epTok happy_var_3) (toList $ fst happy_var_2) []) })}}}) + ) (\r -> happyReturn (happyIn297 r)) + +happyReduce_739 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_739 = happyMonadReduce 3# 281# happyReduction_739 +happyReduction_739 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 $ getRdrName unrestrictedFunTyCon) + (NameAnnRArrow (Just $ epTok happy_var_1) (epUniTok happy_var_2) (Just $ epTok happy_var_3) []))}}}) + ) (\r -> happyReturn (happyIn297 r)) + +happyReduce_740 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_740 = happySpecReduce_1 282# happyReduction_740 +happyReduction_740 happy_x_1 + = case happyOut301 happy_x_1 of { (HappyWrap301 happy_var_1) -> + happyIn298 + (happy_var_1 + )} + +happyReduce_741 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_741 = happyMonadReduce 3# 282# happyReduction_741 +happyReduction_741 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut303 happy_x_2 of { (HappyWrap303 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn298 r)) + +happyReduce_742 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_742 = happySpecReduce_1 283# happyReduction_742 +happyReduction_742 happy_x_1 + = case happyOut301 happy_x_1 of { (HappyWrap301 happy_var_1) -> + happyIn299 + (happy_var_1 + )} + +happyReduce_743 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_743 = happyMonadReduce 3# 283# happyReduction_743 +happyReduction_743 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( let { name :: Located RdrName + ; name = sL1 happy_var_2 $! mkQual tcClsName (getQCONSYM happy_var_2) } + in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn299 r)) + +happyReduce_744 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_744 = happyMonadReduce 3# 283# happyReduction_744 +happyReduction_744 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( let { name :: Located RdrName + ; name = sL1 happy_var_2 $! mkUnqual tcClsName (getCONSYM happy_var_2) } + in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn299 r)) + +happyReduce_745 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_745 = happyMonadReduce 3# 283# happyReduction_745 +happyReduction_745 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( let { name :: Located RdrName + ; name = sL1 happy_var_2 $! consDataCon_RDR } + in amsr (sLL happy_var_1 happy_var_3 (unLoc name)) (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn299 r)) + +happyReduce_746 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_746 = happySpecReduce_1 284# happyReduction_746 +happyReduction_746 happy_x_1 + = case happyOut303 happy_x_1 of { (HappyWrap303 happy_var_1) -> + happyIn300 + (happy_var_1 + )} + +happyReduce_747 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_747 = happyMonadReduce 3# 284# happyReduction_747 +happyReduction_747 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut301 happy_x_2 of { (HappyWrap301 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn300 r)) + +happyReduce_748 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_748 = happySpecReduce_1 285# happyReduction_748 +happyReduction_748 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn301 + (sL1n happy_var_1 $! mkQual tcClsName (getQCONID happy_var_1) + )} + +happyReduce_749 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_749 = happySpecReduce_1 285# happyReduction_749 +happyReduction_749 happy_x_1 + = case happyOut302 happy_x_1 of { (HappyWrap302 happy_var_1) -> + happyIn301 + (happy_var_1 + )} + +happyReduce_750 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_750 = happySpecReduce_1 286# happyReduction_750 +happyReduction_750 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn302 + (sL1n happy_var_1 $! mkUnqual tcClsName (getCONID happy_var_1) + )} + +happyReduce_751 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_751 = happySpecReduce_1 287# happyReduction_751 +happyReduction_751 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn303 + (sL1n happy_var_1 $! mkQual tcClsName (getQCONSYM happy_var_1) + )} + +happyReduce_752 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_752 = happySpecReduce_1 287# happyReduction_752 +happyReduction_752 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn303 + (sL1n happy_var_1 $! mkQual tcClsName (getQVARSYM happy_var_1) + )} + +happyReduce_753 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_753 = happySpecReduce_1 287# happyReduction_753 +happyReduction_753 happy_x_1 + = case happyOut304 happy_x_1 of { (HappyWrap304 happy_var_1) -> + happyIn303 + (happy_var_1 + )} + +happyReduce_754 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_754 = happySpecReduce_1 288# happyReduction_754 +happyReduction_754 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn304 + (sL1n happy_var_1 $! mkUnqual tcClsName (getCONSYM happy_var_1) + )} + +happyReduce_755 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_755 = happySpecReduce_1 288# happyReduction_755 +happyReduction_755 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn304 + (sL1n happy_var_1 $! mkUnqual tcClsName (getVARSYM happy_var_1) + )} + +happyReduce_756 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_756 = happySpecReduce_1 288# happyReduction_756 +happyReduction_756 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn304 + (sL1n happy_var_1 $! consDataCon_RDR + )} + +happyReduce_757 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_757 = happySpecReduce_1 288# happyReduction_757 +happyReduction_757 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn304 + (sL1n happy_var_1 $! mkUnqual tcClsName (fsLit "-") + )} + +happyReduce_758 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_758 = happySpecReduce_1 288# happyReduction_758 +happyReduction_758 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn304 + (sL1n happy_var_1 $! mkUnqual tcClsName (fsLit ".") + )} + +happyReduce_759 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_759 = happySpecReduce_1 289# happyReduction_759 +happyReduction_759 happy_x_1 + = case happyOut302 happy_x_1 of { (HappyWrap302 happy_var_1) -> + happyIn305 + (happy_var_1 + )} + +happyReduce_760 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_760 = happyMonadReduce 3# 289# happyReduction_760 +happyReduction_760 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut304 happy_x_2 of { (HappyWrap304 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn305 r)) + +happyReduce_761 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_761 = happySpecReduce_1 290# happyReduction_761 +happyReduction_761 happy_x_1 + = case happyOut307 happy_x_1 of { (HappyWrap307 happy_var_1) -> + happyIn306 + (happy_var_1 + )} + +happyReduce_762 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_762 = happySpecReduce_1 290# happyReduction_762 +happyReduction_762 happy_x_1 + = case happyOut294 happy_x_1 of { (HappyWrap294 happy_var_1) -> + happyIn306 + (happy_var_1 + )} + +happyReduce_763 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_763 = happyMonadReduce 1# 290# happyReduction_763 +happyReduction_763 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + ( amsr (sLL happy_var_1 happy_var_1 $ getRdrName unrestrictedFunTyCon) + (NameAnnRArrow Nothing (epUniTok happy_var_1) Nothing []))}) + ) (\r -> happyReturn (happyIn306 r)) + +happyReduce_764 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_764 = happySpecReduce_1 291# happyReduction_764 +happyReduction_764 happy_x_1 + = case happyOut324 happy_x_1 of { (HappyWrap324 happy_var_1) -> + happyIn307 + (happy_var_1 + )} + +happyReduce_765 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_765 = happyMonadReduce 3# 291# happyReduction_765 +happyReduction_765 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut320 happy_x_2 of { (HappyWrap320 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn307 r)) + +happyReduce_766 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_766 = happySpecReduce_1 292# happyReduction_766 +happyReduction_766 happy_x_1 + = case happyOut311 happy_x_1 of { (HappyWrap311 happy_var_1) -> + happyIn308 + (mkHsVarOpPV happy_var_1 + )} + +happyReduce_767 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_767 = happySpecReduce_1 292# happyReduction_767 +happyReduction_767 happy_x_1 + = case happyOut295 happy_x_1 of { (HappyWrap295 happy_var_1) -> + happyIn308 + (mkHsConOpPV happy_var_1 + )} + +happyReduce_768 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_768 = happySpecReduce_1 292# happyReduction_768 +happyReduction_768 happy_x_1 + = case happyOut310 happy_x_1 of { (HappyWrap310 happy_var_1) -> + happyIn308 + (mkHsInfixHolePV happy_var_1 + )} + +happyReduce_769 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_769 = happySpecReduce_1 293# happyReduction_769 +happyReduction_769 happy_x_1 + = case happyOut312 happy_x_1 of { (HappyWrap312 happy_var_1) -> + happyIn309 + (mkHsVarOpPV happy_var_1 + )} + +happyReduce_770 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_770 = happySpecReduce_1 293# happyReduction_770 +happyReduction_770 happy_x_1 + = case happyOut295 happy_x_1 of { (HappyWrap295 happy_var_1) -> + happyIn309 + (mkHsConOpPV happy_var_1 + )} + +happyReduce_771 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_771 = happySpecReduce_1 293# happyReduction_771 +happyReduction_771 happy_x_1 + = case happyOut310 happy_x_1 of { (HappyWrap310 happy_var_1) -> + happyIn309 + (mkHsInfixHolePV happy_var_1 + )} + +happyReduce_772 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_772 = happyMonadReduce 3# 294# happyReduction_772 +happyReduction_772 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (mkUnqual varName (fsLit "_"))) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn310 r)) + +happyReduce_773 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_773 = happySpecReduce_1 295# happyReduction_773 +happyReduction_773 happy_x_1 + = case happyOut321 happy_x_1 of { (HappyWrap321 happy_var_1) -> + happyIn311 + (happy_var_1 + )} + +happyReduce_774 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_774 = happyMonadReduce 3# 295# happyReduction_774 +happyReduction_774 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut319 happy_x_2 of { (HappyWrap319 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn311 r)) + +happyReduce_775 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_775 = happySpecReduce_1 296# happyReduction_775 +happyReduction_775 happy_x_1 + = case happyOut322 happy_x_1 of { (HappyWrap322 happy_var_1) -> + happyIn312 + (happy_var_1 + )} + +happyReduce_776 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_776 = happyMonadReduce 3# 296# happyReduction_776 +happyReduction_776 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut319 happy_x_2 of { (HappyWrap319 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn312 r)) + +happyReduce_777 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_777 = happySpecReduce_1 297# happyReduction_777 +happyReduction_777 happy_x_1 + = case happyOut315 happy_x_1 of { (HappyWrap315 happy_var_1) -> + happyIn313 + (happy_var_1 + )} + +happyReduce_778 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_778 = happyMonadReduce 3# 298# happyReduction_778 +happyReduction_778 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut315 happy_x_2 of { (HappyWrap315 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameBackquotes (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn314 r)) + +happyReduce_779 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_779 = happySpecReduce_1 299# happyReduction_779 +happyReduction_779 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn315 + (sL1n happy_var_1 $! mkUnqual tvName (getVARID happy_var_1) + )} + +happyReduce_780 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_780 = happySpecReduce_1 299# happyReduction_780 +happyReduction_780 happy_x_1 + = case happyOut326 happy_x_1 of { (HappyWrap326 happy_var_1) -> + happyIn315 + (sL1n happy_var_1 $! mkUnqual tvName (unLoc happy_var_1) + )} + +happyReduce_781 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_781 = happySpecReduce_1 299# happyReduction_781 +happyReduction_781 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn315 + (sL1n happy_var_1 $! mkUnqual tvName (fsLit "unsafe") + )} + +happyReduce_782 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_782 = happySpecReduce_1 299# happyReduction_782 +happyReduction_782 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn315 + (sL1n happy_var_1 $! mkUnqual tvName (fsLit "safe") + )} + +happyReduce_783 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_783 = happySpecReduce_1 299# happyReduction_783 +happyReduction_783 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn315 + (sL1n happy_var_1 $! mkUnqual tvName (fsLit "interruptible") + )} + +happyReduce_784 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_784 = happySpecReduce_1 300# happyReduction_784 +happyReduction_784 happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + happyIn316 + (happy_var_1 + )} + +happyReduce_785 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_785 = happyMonadReduce 3# 300# happyReduction_785 +happyReduction_785 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut324 happy_x_2 of { (HappyWrap324 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn316 r)) + +happyReduce_786 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_786 = happySpecReduce_1 301# happyReduction_786 +happyReduction_786 happy_x_1 + = case happyOut319 happy_x_1 of { (HappyWrap319 happy_var_1) -> + happyIn317 + (happy_var_1 + )} + +happyReduce_787 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_787 = happyMonadReduce 3# 301# happyReduction_787 +happyReduction_787 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut324 happy_x_2 of { (HappyWrap324 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn317 r)) + +happyReduce_788 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_788 = happyMonadReduce 3# 301# happyReduction_788 +happyReduction_788 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut323 happy_x_2 of { (HappyWrap323 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + ( amsr (sLL happy_var_1 happy_var_3 (unLoc happy_var_2)) + (NameAnn (NameParens (epTok happy_var_1) (epTok happy_var_3)) (glR happy_var_2) []))}}}) + ) (\r -> happyReturn (happyIn317 r)) + +happyReduce_789 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_789 = happySpecReduce_1 302# happyReduction_789 +happyReduction_789 happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + happyIn318 + (fmap (FieldLabelString . occNameFS . rdrNameOcc) happy_var_1 + )} + +happyReduce_790 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_790 = happySpecReduce_1 303# happyReduction_790 +happyReduction_790 happy_x_1 + = case happyOut320 happy_x_1 of { (HappyWrap320 happy_var_1) -> + happyIn319 + (happy_var_1 + )} + +happyReduce_791 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_791 = happySpecReduce_1 303# happyReduction_791 +happyReduction_791 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn319 + (sL1n happy_var_1 $! mkQual varName (getQVARID happy_var_1) + )} + +happyReduce_792 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_792 = happySpecReduce_1 304# happyReduction_792 +happyReduction_792 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (getVARID happy_var_1) + )} + +happyReduce_793 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_793 = happySpecReduce_1 304# happyReduction_793 +happyReduction_793 happy_x_1 + = case happyOut326 happy_x_1 of { (HappyWrap326 happy_var_1) -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (unLoc happy_var_1) + )} + +happyReduce_794 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_794 = happySpecReduce_1 304# happyReduction_794 +happyReduction_794 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (fsLit "unsafe") + )} + +happyReduce_795 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_795 = happySpecReduce_1 304# happyReduction_795 +happyReduction_795 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (fsLit "safe") + )} + +happyReduce_796 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_796 = happySpecReduce_1 304# happyReduction_796 +happyReduction_796 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (fsLit "interruptible") + )} + +happyReduce_797 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_797 = happySpecReduce_1 304# happyReduction_797 +happyReduction_797 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (fsLit "family") + )} + +happyReduce_798 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_798 = happySpecReduce_1 304# happyReduction_798 +happyReduction_798 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn320 + (sL1n happy_var_1 $! mkUnqual varName (fsLit "role") + )} + +happyReduce_799 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_799 = happySpecReduce_1 305# happyReduction_799 +happyReduction_799 happy_x_1 + = case happyOut324 happy_x_1 of { (HappyWrap324 happy_var_1) -> + happyIn321 + (happy_var_1 + )} + +happyReduce_800 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_800 = happySpecReduce_1 305# happyReduction_800 +happyReduction_800 happy_x_1 + = case happyOut323 happy_x_1 of { (HappyWrap323 happy_var_1) -> + happyIn321 + (happy_var_1 + )} + +happyReduce_801 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_801 = happySpecReduce_1 306# happyReduction_801 +happyReduction_801 happy_x_1 + = case happyOut325 happy_x_1 of { (HappyWrap325 happy_var_1) -> + happyIn322 + (happy_var_1 + )} + +happyReduce_802 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_802 = happySpecReduce_1 306# happyReduction_802 +happyReduction_802 happy_x_1 + = case happyOut323 happy_x_1 of { (HappyWrap323 happy_var_1) -> + happyIn322 + (happy_var_1 + )} + +happyReduce_803 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_803 = happySpecReduce_1 307# happyReduction_803 +happyReduction_803 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn323 + (sL1n happy_var_1 $ mkQual varName (getQVARSYM happy_var_1) + )} + +happyReduce_804 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_804 = happySpecReduce_1 308# happyReduction_804 +happyReduction_804 happy_x_1 + = case happyOut325 happy_x_1 of { (HappyWrap325 happy_var_1) -> + happyIn324 + (happy_var_1 + )} + +happyReduce_805 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_805 = happySpecReduce_1 308# happyReduction_805 +happyReduction_805 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn324 + (sL1n happy_var_1 $ mkUnqual varName (fsLit "-") + )} + +happyReduce_806 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_806 = happySpecReduce_1 309# happyReduction_806 +happyReduction_806 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn325 + (sL1n happy_var_1 $ mkUnqual varName (getVARSYM happy_var_1) + )} + +happyReduce_807 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_807 = happySpecReduce_1 309# happyReduction_807 +happyReduction_807 happy_x_1 + = case happyOut327 happy_x_1 of { (HappyWrap327 happy_var_1) -> + happyIn325 + (sL1n happy_var_1 $ mkUnqual varName (unLoc happy_var_1) + )} + +happyReduce_808 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_808 = happySpecReduce_1 310# happyReduction_808 +happyReduction_808 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "as") + )} + +happyReduce_809 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_809 = happySpecReduce_1 310# happyReduction_809 +happyReduction_809 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "qualified") + )} + +happyReduce_810 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_810 = happySpecReduce_1 310# happyReduction_810 +happyReduction_810 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "hiding") + )} + +happyReduce_811 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_811 = happySpecReduce_1 310# happyReduction_811 +happyReduction_811 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "export") + )} + +happyReduce_812 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_812 = happySpecReduce_1 310# happyReduction_812 +happyReduction_812 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "label") + )} + +happyReduce_813 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_813 = happySpecReduce_1 310# happyReduction_813 +happyReduction_813 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "dynamic") + )} + +happyReduce_814 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_814 = happySpecReduce_1 310# happyReduction_814 +happyReduction_814 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "stdcall") + )} + +happyReduce_815 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_815 = happySpecReduce_1 310# happyReduction_815 +happyReduction_815 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "ccall") + )} + +happyReduce_816 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_816 = happySpecReduce_1 310# happyReduction_816 +happyReduction_816 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "capi") + )} + +happyReduce_817 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_817 = happySpecReduce_1 310# happyReduction_817 +happyReduction_817 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "prim") + )} + +happyReduce_818 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_818 = happySpecReduce_1 310# happyReduction_818 +happyReduction_818 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "javascript") + )} + +happyReduce_819 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_819 = happySpecReduce_1 310# happyReduction_819 +happyReduction_819 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "group") + )} + +happyReduce_820 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_820 = happySpecReduce_1 310# happyReduction_820 +happyReduction_820 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "stock") + )} + +happyReduce_821 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_821 = happySpecReduce_1 310# happyReduction_821 +happyReduction_821 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "anyclass") + )} + +happyReduce_822 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_822 = happySpecReduce_1 310# happyReduction_822 +happyReduction_822 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "via") + )} + +happyReduce_823 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_823 = happySpecReduce_1 310# happyReduction_823 +happyReduction_823 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "unit") + )} + +happyReduce_824 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_824 = happySpecReduce_1 310# happyReduction_824 +happyReduction_824 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "dependency") + )} + +happyReduce_825 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_825 = happySpecReduce_1 310# happyReduction_825 +happyReduction_825 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "signature") + )} + +happyReduce_826 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_826 = happySpecReduce_1 310# happyReduction_826 +happyReduction_826 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "quote") + )} + +happyReduce_827 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_827 = happySpecReduce_1 310# happyReduction_827 +happyReduction_827 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn326 + (sL1 happy_var_1 (fsLit "splice") + )} + +happyReduce_828 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_828 = happySpecReduce_1 311# happyReduction_828 +happyReduction_828 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn327 + (sL1 happy_var_1 (fsLit ".") + )} + +happyReduce_829 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_829 = happySpecReduce_1 311# happyReduction_829 +happyReduction_829 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn327 + (sL1 happy_var_1 (starSym (isUnicode happy_var_1)) + )} + +happyReduce_830 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_830 = happySpecReduce_1 312# happyReduction_830 +happyReduction_830 happy_x_1 + = case happyOut329 happy_x_1 of { (HappyWrap329 happy_var_1) -> + happyIn328 + (happy_var_1 + )} + +happyReduce_831 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_831 = happySpecReduce_1 312# happyReduction_831 +happyReduction_831 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn328 + (sL1n happy_var_1 $! mkQual dataName (getQCONID happy_var_1) + )} + +happyReduce_832 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_832 = happySpecReduce_1 313# happyReduction_832 +happyReduction_832 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn329 + (sL1n happy_var_1 $ mkUnqual dataName (getCONID happy_var_1) + )} + +happyReduce_833 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_833 = happySpecReduce_1 314# happyReduction_833 +happyReduction_833 happy_x_1 + = case happyOut331 happy_x_1 of { (HappyWrap331 happy_var_1) -> + happyIn330 + (happy_var_1 + )} + +happyReduce_834 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_834 = happySpecReduce_1 314# happyReduction_834 +happyReduction_834 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn330 + (sL1n happy_var_1 $ mkQual dataName (getQCONSYM happy_var_1) + )} + +happyReduce_835 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_835 = happySpecReduce_1 315# happyReduction_835 +happyReduction_835 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn331 + (sL1n happy_var_1 $ mkUnqual dataName (getCONSYM happy_var_1) + )} + +happyReduce_836 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_836 = happySpecReduce_1 315# happyReduction_836 +happyReduction_836 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn331 + (sL1n happy_var_1 $ consDataCon_RDR + )} + +happyReduce_837 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_837 = happySpecReduce_1 316# happyReduction_837 +happyReduction_837 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsChar (getCHARs happy_var_1) $ getCHAR happy_var_1 + )} + +happyReduce_838 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_838 = happySpecReduce_1 316# happyReduction_838 +happyReduction_838 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsString (getSTRINGs happy_var_1) + $ getSTRING happy_var_1 + )} + +happyReduce_839 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_839 = happySpecReduce_1 316# happyReduction_839 +happyReduction_839 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsMultilineString (getSTRINGMULTIs happy_var_1) + $ getSTRINGMULTI happy_var_1 + )} + +happyReduce_840 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_840 = happySpecReduce_1 316# happyReduction_840 +happyReduction_840 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsIntPrim (getPRIMINTEGERs happy_var_1) + $ getPRIMINTEGER happy_var_1 + )} + +happyReduce_841 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_841 = happySpecReduce_1 316# happyReduction_841 +happyReduction_841 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsWordPrim (getPRIMWORDs happy_var_1) + $ getPRIMWORD happy_var_1 + )} + +happyReduce_842 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_842 = happySpecReduce_1 316# happyReduction_842 +happyReduction_842 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsInt8Prim (getPRIMINTEGER8s happy_var_1) + $ getPRIMINTEGER8 happy_var_1 + )} + +happyReduce_843 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_843 = happySpecReduce_1 316# happyReduction_843 +happyReduction_843 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsInt16Prim (getPRIMINTEGER16s happy_var_1) + $ getPRIMINTEGER16 happy_var_1 + )} + +happyReduce_844 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_844 = happySpecReduce_1 316# happyReduction_844 +happyReduction_844 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsInt32Prim (getPRIMINTEGER32s happy_var_1) + $ getPRIMINTEGER32 happy_var_1 + )} + +happyReduce_845 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_845 = happySpecReduce_1 316# happyReduction_845 +happyReduction_845 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsInt64Prim (getPRIMINTEGER64s happy_var_1) + $ getPRIMINTEGER64 happy_var_1 + )} + +happyReduce_846 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_846 = happySpecReduce_1 316# happyReduction_846 +happyReduction_846 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsWord8Prim (getPRIMWORD8s happy_var_1) + $ getPRIMWORD8 happy_var_1 + )} + +happyReduce_847 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_847 = happySpecReduce_1 316# happyReduction_847 +happyReduction_847 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsWord16Prim (getPRIMWORD16s happy_var_1) + $ getPRIMWORD16 happy_var_1 + )} + +happyReduce_848 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_848 = happySpecReduce_1 316# happyReduction_848 +happyReduction_848 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsWord32Prim (getPRIMWORD32s happy_var_1) + $ getPRIMWORD32 happy_var_1 + )} + +happyReduce_849 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_849 = happySpecReduce_1 316# happyReduction_849 +happyReduction_849 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsWord64Prim (getPRIMWORD64s happy_var_1) + $ getPRIMWORD64 happy_var_1 + )} + +happyReduce_850 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_850 = happySpecReduce_1 316# happyReduction_850 +happyReduction_850 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsCharPrim (getPRIMCHARs happy_var_1) + $ getPRIMCHAR happy_var_1 + )} + +happyReduce_851 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_851 = happySpecReduce_1 316# happyReduction_851 +happyReduction_851 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsStringPrim (getPRIMSTRINGs happy_var_1) + $ getPRIMSTRING happy_var_1 + )} + +happyReduce_852 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_852 = happySpecReduce_1 316# happyReduction_852 +happyReduction_852 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsFloatPrim noExtField $ getPRIMFLOAT happy_var_1 + )} + +happyReduce_853 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_853 = happySpecReduce_1 316# happyReduction_853 +happyReduction_853 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn332 + (sL1 happy_var_1 $ HsDoublePrim noExtField $ getPRIMDOUBLE happy_var_1 + )} + +happyReduce_854 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_854 = happySpecReduce_1 317# happyReduction_854 +happyReduction_854 happy_x_1 + = happyIn333 + (() + ) + +happyReduce_855 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_855 = happyMonadReduce 1# 317# happyReduction_855 +happyReduction_855 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((( popContext)) + ) (\r -> happyReturn (happyIn333 r)) + +happyReduce_856 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_856 = happySpecReduce_1 318# happyReduction_856 +happyReduction_856 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn334 + (sL1a happy_var_1 $ mkModuleNameFS (getCONID happy_var_1) + )} + +happyReduce_857 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_857 = happySpecReduce_1 318# happyReduction_857 +happyReduction_857 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn334 + (sL1a happy_var_1 $ let (mod,c) = getQCONID happy_var_1 in + mkModuleNameFS + (concatFS [mod, fsLit ".", c]) + )} + +happyReduce_858 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_858 = happySpecReduce_2 319# happyReduction_858 +happyReduction_858 happy_x_2 + happy_x_1 + = case happyOut335 happy_x_1 of { (HappyWrap335 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn335 + ((foldr (NE.<|) (NE.singleton $ gl happy_var_2) (fst happy_var_1) ,snd happy_var_1 + 1) + )}} + +happyReduce_859 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_859 = happySpecReduce_1 319# happyReduction_859 +happyReduction_859 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn335 + ((NE.singleton $ gl happy_var_1, 1) + )} + +happyReduce_860 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_860 = happySpecReduce_1 320# happyReduction_860 +happyReduction_860 happy_x_1 + = case happyOut337 happy_x_1 of { (HappyWrap337 happy_var_1) -> + happyIn336 + (happy_var_1 + )} + +happyReduce_861 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_861 = happySpecReduce_0 320# happyReduction_861 +happyReduction_861 = happyIn336 + (([], 0) + ) + +happyReduce_862 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_862 = happySpecReduce_2 321# happyReduction_862 +happyReduction_862 happy_x_2 + happy_x_1 + = case happyOut337 happy_x_1 of { (HappyWrap337 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn337 + (((fst happy_var_1)++[epTok happy_var_2],snd happy_var_1 + 1) + )}} + +happyReduce_863 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_863 = happySpecReduce_1 321# happyReduction_863 +happyReduction_863 happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + happyIn337 + (([epTok happy_var_1],1) + )} + +happyReduce_864 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_864 = happySpecReduce_3 322# happyReduction_864 +happyReduction_864 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut345 happy_x_2 of { (HappyWrap345 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn338 + (happy_var_2 >>= \ happy_var_2 -> amsr + (sLL happy_var_1 happy_var_3 (reverse (snd $ unLoc happy_var_2))) + (AnnList (Just $ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fst $ unLoc happy_var_2) noAnn []) + )}}} + +happyReduce_865 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_865 = happySpecReduce_3 322# happyReduction_865 +happyReduction_865 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut345 happy_x_2 of { (HappyWrap345 happy_var_2) -> + happyIn338 + (happy_var_2 >>= \ happy_var_2 -> amsr + (L (getLoc happy_var_2) (reverse (snd $ unLoc happy_var_2))) + (AnnList (Just $ glR happy_var_2) ListNone (fst $ unLoc happy_var_2) noAnn []) + )} + +happyReduce_866 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_866 = happySpecReduce_2 322# happyReduction_866 +happyReduction_866 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn338 + (amsr (sLL happy_var_1 happy_var_2 []) (AnnList Nothing (ListBraces (epTok happy_var_1) (epTok happy_var_2)) [] noAnn []) + )}} + +happyReduce_867 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_867 = happySpecReduce_2 322# happyReduction_867 +happyReduction_867 happy_x_2 + happy_x_1 + = happyIn338 + (return $ noLocA [] + ) + +happyReduce_868 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_868 = happySpecReduce_3 323# happyReduction_868 +happyReduction_868 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut346 happy_x_2 of { (HappyWrap346 happy_var_2) -> + case happyOutTok happy_x_3 of { happy_var_3 -> + happyIn339 + (happy_var_2 >>= \ happy_var_2 -> amsr + (sLL happy_var_1 happy_var_3 (reverse (snd $ unLoc happy_var_2))) + (AnnList (Just $ glR happy_var_2) (ListBraces (epTok happy_var_1) (epTok happy_var_3)) (fst $ unLoc happy_var_2) noAnn []) + )}}} + +happyReduce_869 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_869 = happySpecReduce_3 323# happyReduction_869 +happyReduction_869 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut346 happy_x_2 of { (HappyWrap346 happy_var_2) -> + happyIn339 + (happy_var_2 >>= \ happy_var_2 -> amsr + (L (getLoc happy_var_2) (reverse (snd $ unLoc happy_var_2))) + (AnnList (Just $ glR happy_var_2) ListNone (fst $ unLoc happy_var_2) noAnn []) + )} + +happyReduce_870 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_870 = happySpecReduce_2 323# happyReduction_870 +happyReduction_870 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn339 + (amsr (sLL happy_var_1 happy_var_2 []) (AnnList Nothing (ListBraces (epTok happy_var_1) (epTok happy_var_2)) [] noAnn []) + )}} + +happyReduce_871 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_871 = happySpecReduce_2 323# happyReduction_871 +happyReduction_871 happy_x_2 + happy_x_1 + = happyIn339 + (return $ noLocA [] + ) + +happyReduce_872 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_872 = happySpecReduce_3 324# happyReduction_872 +happyReduction_872 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + happyIn340 + (ECP $ + unECP happy_var_1 >>= \ happy_var_1 -> + rejectPragmaPV happy_var_1 >> + mkHsTySigPV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_3 + (epUniTok happy_var_2) + )}}} + +happyReduce_873 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_873 = happyMonadReduce 3# 324# happyReduction_873 +happyReduction_873 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut340 happy_x_3 of { (HappyWrap340 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 + HsFirstOrderApp True))}}}) + ) (\r -> happyReturn (happyIn340 r)) + +happyReduce_874 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_874 = happyMonadReduce 3# 324# happyReduction_874 +happyReduction_874 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut340 happy_x_3 of { (HappyWrap340 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 + HsFirstOrderApp False))}}}) + ) (\r -> happyReturn (happyIn340 r)) + +happyReduce_875 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_875 = happyMonadReduce 3# 324# happyReduction_875 +happyReduction_875 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut340 happy_x_3 of { (HappyWrap340 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 + HsHigherOrderApp True))}}}) + ) (\r -> happyReturn (happyIn340 r)) + +happyReduce_876 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_876 = happyMonadReduce 3# 324# happyReduction_876 +happyReduction_876 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut340 happy_x_3 of { (HappyWrap340 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 + HsHigherOrderApp False))}}}) + ) (\r -> happyReturn (happyIn340 r)) + +happyReduce_877 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_877 = happySpecReduce_1 324# happyReduction_877 +happyReduction_877 happy_x_1 + = case happyOut224 happy_x_1 of { (HappyWrap224 happy_var_1) -> + happyIn340 + (happy_var_1 + )} + +happyReduce_878 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_878 = happySpecReduce_1 324# happyReduction_878 +happyReduction_878 happy_x_1 + = case happyOut348 happy_x_1 of { (HappyWrap348 happy_var_1) -> + happyIn340 + (happy_var_1 + )} + +happyReduce_879 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_879 = happySpecReduce_2 324# happyReduction_879 +happyReduction_879 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + happyIn340 + (ECP $ mkHsEmbTyPV (comb2 happy_var_1 happy_var_2) (epTok happy_var_1) happy_var_2 + )}} + +happyReduce_880 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_880 = happySpecReduce_3 325# happyReduction_880 +happyReduction_880 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut169 happy_x_3 of { (HappyWrap169 happy_var_3) -> + happyIn341 + (ECP $ + unECP happy_var_1 >>= \ happy_var_1 -> + rejectPragmaPV happy_var_1 >> + mkHsTySigPV (noAnnSrcSpan $ comb2 happy_var_1 happy_var_3) happy_var_1 happy_var_3 + (epUniTok happy_var_2) + )}}} + +happyReduce_881 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_881 = happyMonadReduce 3# 325# happyReduction_881 +happyReduction_881 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut341 happy_x_3 of { (HappyWrap341 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 + HsFirstOrderApp True))}}}) + ) (\r -> happyReturn (happyIn341 r)) + +happyReduce_882 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_882 = happyMonadReduce 3# 325# happyReduction_882 +happyReduction_882 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut341 happy_x_3 of { (HappyWrap341 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 + HsFirstOrderApp False))}}}) + ) (\r -> happyReturn (happyIn341 r)) + +happyReduce_883 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_883 = happyMonadReduce 3# 325# happyReduction_883 +happyReduction_883 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut341 happy_x_3 of { (HappyWrap341 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_1 happy_var_3 + HsHigherOrderApp True))}}}) + ) (\r -> happyReturn (happyIn341 r)) + +happyReduce_884 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_884 = happyMonadReduce 3# 325# happyReduction_884 +happyReduction_884 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut341 happy_x_3 of { (HappyWrap341 happy_var_3) -> + ( runPV (unECP happy_var_1) >>= \ happy_var_1 -> + runPV (unECP happy_var_3) >>= \ happy_var_3 -> + fmap ecpFromCmd $ + amsA' (sLL happy_var_1 happy_var_3 $ HsCmdArrApp (isUnicodeSyntax happy_var_2, glR happy_var_2) happy_var_3 happy_var_1 + HsHigherOrderApp False))}}}) + ) (\r -> happyReturn (happyIn341 r)) + +happyReduce_885 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_885 = happySpecReduce_1 325# happyReduction_885 +happyReduction_885 happy_x_1 + = case happyOut223 happy_x_1 of { (HappyWrap223 happy_var_1) -> + happyIn341 + (happy_var_1 + )} + +happyReduce_886 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_886 = happySpecReduce_1 325# happyReduction_886 +happyReduction_886 happy_x_1 + = case happyOut347 happy_x_1 of { (HappyWrap347 happy_var_1) -> + happyIn341 + (happy_var_1 + )} + +happyReduce_887 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_887 = happySpecReduce_2 325# happyReduction_887 +happyReduction_887 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut180 happy_x_2 of { (HappyWrap180 happy_var_2) -> + happyIn341 + (ECP $ mkHsEmbTyPV (comb2 happy_var_1 happy_var_2) (epTok happy_var_1) happy_var_2 + )}} + +happyReduce_888 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_888 = happyMonadReduce 2# 326# happyReduction_888 +happyReduction_888 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> + case happyOut225 happy_x_2 of { (HappyWrap225 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) + ) (\r -> happyReturn (happyIn342 r)) + +happyReduce_889 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_889 = happyMonadReduce 1# 327# happyReduction_889 +happyReduction_889 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> + ( do + { pat <- (checkPattern <=< runPV) (unECP happy_var_1) + ; return (sL1 pat (NE.singleton pat)) })}) + ) (\r -> happyReturn (happyIn343 r)) + +happyReduce_890 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_890 = happyMonadReduce 3# 327# happyReduction_890 +happyReduction_890 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut221 happy_x_1 of { (HappyWrap221 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut343 happy_x_3 of { (HappyWrap343 happy_var_3) -> + ( do + { pat <- (checkPattern <=< runPV) (unECP happy_var_1) + ; pat <- addTrailingSemiA pat (epTok happy_var_2) + ; return (sLL pat happy_var_3 (pat NE.<| unLoc happy_var_3)) })}}}) + ) (\r -> happyReturn (happyIn343 r)) + +happyReduce_891 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_891 = happyMonadReduce 1# 328# happyReduction_891 +happyReduction_891 (happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> + ( do + { pat <- (checkPattern <=< runPV) (unECP happy_var_1) + ; return (sL1 pat (NE.singleton pat)) })}) + ) (\r -> happyReturn (happyIn344 r)) + +happyReduce_892 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_892 = happyMonadReduce 3# 328# happyReduction_892 +happyReduction_892 (happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut222 happy_x_1 of { (HappyWrap222 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut344 happy_x_3 of { (HappyWrap344 happy_var_3) -> + ( do + { pat <- (checkPattern <=< runPV) (unECP happy_var_1) + ; pat <- addTrailingSemiA pat (epTok happy_var_2) + ; return (sLL pat happy_var_3 (pat NE.<| unLoc happy_var_3)) })}}}) + ) (\r -> happyReturn (happyIn344 r)) + +happyReduce_893 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_893 = happySpecReduce_1 329# happyReduction_893 +happyReduction_893 happy_x_1 + = case happyOut349 happy_x_1 of { (HappyWrap349 happy_var_1) -> + happyIn345 + (happy_var_1 >>= \ happy_var_1 -> return $ + sL1 happy_var_1 (fst $ unLoc happy_var_1,snd $ unLoc happy_var_1) + )} + +happyReduce_894 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_894 = happySpecReduce_2 329# happyReduction_894 +happyReduction_894 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut345 happy_x_2 of { (HappyWrap345 happy_var_2) -> + happyIn345 + (happy_var_2 >>= \ happy_var_2 -> return $ + sLL happy_var_1 happy_var_2 (((mzEpTok happy_var_1) : (fst $ unLoc happy_var_2) ) + ,snd $ unLoc happy_var_2) + )}} + +happyReduce_895 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_895 = happySpecReduce_1 330# happyReduction_895 +happyReduction_895 happy_x_1 + = case happyOut350 happy_x_1 of { (HappyWrap350 happy_var_1) -> + happyIn346 + (happy_var_1 >>= \ happy_var_1 -> return $ + sL1 happy_var_1 (fst $ unLoc happy_var_1,snd $ unLoc happy_var_1) + )} + +happyReduce_896 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_896 = happySpecReduce_2 330# happyReduction_896 +happyReduction_896 happy_x_2 + happy_x_1 + = case happyOutTok happy_x_1 of { happy_var_1 -> + case happyOut346 happy_x_2 of { (HappyWrap346 happy_var_2) -> + happyIn346 + (happy_var_2 >>= \ happy_var_2 -> return $ + sLL happy_var_1 happy_var_2 (((mzEpTok happy_var_1) : (fst $ unLoc happy_var_2) ) + ,snd $ unLoc happy_var_2) + )}} + +happyReduce_897 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_897 = happyMonadReduce 2# 331# happyReduction_897 +happyReduction_897 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> + case happyOut341 happy_x_2 of { (HappyWrap341 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) + ) (\r -> happyReturn (happyIn347 r)) + +happyReduce_898 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_898 = happyMonadReduce 2# 332# happyReduction_898 +happyReduction_898 (happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) tk + = happyThen ((case happyOut228 happy_x_1 of { (HappyWrap228 happy_var_1) -> + case happyOut340 happy_x_2 of { (HappyWrap340 happy_var_2) -> + ( runPV (unECP happy_var_2) >>= \ happy_var_2 -> + fmap ecpFromExp $ + amsA' $ (sLL happy_var_1 happy_var_2 $ HsPragE noExtField (unLoc happy_var_1) happy_var_2))}}) + ) (\r -> happyReturn (happyIn348 r)) + +happyReduce_899 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_899 = happySpecReduce_3 333# happyReduction_899 +happyReduction_899 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut349 happy_x_1 of { (HappyWrap349 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut351 happy_x_3 of { (HappyWrap351 happy_var_3) -> + happyIn349 + (happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ happy_var_3 -> + case snd $ unLoc happy_var_1 of + [] -> return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,[happy_var_3])) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 : h' : t)) + )}}} + +happyReduce_900 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_900 = happySpecReduce_2 333# happyReduction_900 +happyReduction_900 happy_x_2 + happy_x_1 + = case happyOut349 happy_x_1 of { (HappyWrap349 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn349 + (happy_var_1 >>= \ happy_var_1 -> + case snd $ unLoc happy_var_1 of + [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,[])) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1, h' : t)) + )}} + +happyReduce_901 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_901 = happySpecReduce_1 333# happyReduction_901 +happyReduction_901 happy_x_1 + = case happyOut351 happy_x_1 of { (HappyWrap351 happy_var_1) -> + happyIn349 + (happy_var_1 >>= \ happy_var_1 -> return $ sL1 happy_var_1 ([],[happy_var_1]) + )} + +happyReduce_902 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_902 = happySpecReduce_3 334# happyReduction_902 +happyReduction_902 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut350 happy_x_1 of { (HappyWrap350 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + case happyOut352 happy_x_3 of { (HappyWrap352 happy_var_3) -> + happyIn350 + (happy_var_1 >>= \ happy_var_1 -> + happy_var_3 >>= \ happy_var_3 -> + case snd $ unLoc happy_var_1 of + [] -> return (sLL happy_var_1 happy_var_3 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,[happy_var_3])) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLL happy_var_1 happy_var_3 (fst $ unLoc happy_var_1,happy_var_3 : h' : t)) + )}}} + +happyReduce_903 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_903 = happySpecReduce_2 334# happyReduction_903 +happyReduction_903 happy_x_2 + happy_x_1 + = case happyOut350 happy_x_1 of { (HappyWrap350 happy_var_1) -> + case happyOutTok happy_x_2 of { happy_var_2 -> + happyIn350 + (happy_var_1 >>= \ happy_var_1 -> + case snd $ unLoc happy_var_1 of + [] -> return (sLZ happy_var_1 happy_var_2 ((fst $ unLoc happy_var_1) ++ [mzEpTok happy_var_2] + ,[])) + (h:t) -> do + h' <- addTrailingSemiA h (epTok happy_var_2) + return (sLZ happy_var_1 happy_var_2 (fst $ unLoc happy_var_1, h' : t)) + )}} + +happyReduce_904 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_904 = happySpecReduce_1 334# happyReduction_904 +happyReduction_904 happy_x_1 + = case happyOut352 happy_x_1 of { (HappyWrap352 happy_var_1) -> + happyIn350 + (happy_var_1 >>= \ happy_var_1 -> return $ sL1 happy_var_1 ([],[happy_var_1]) + )} + +happyReduce_905 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_905 = happySpecReduce_2 335# happyReduction_905 +happyReduction_905 happy_x_2 + happy_x_1 + = case happyOut263 happy_x_1 of { (HappyWrap263 happy_var_1) -> + case happyOut253 happy_x_2 of { (HappyWrap253 happy_var_2) -> + happyIn351 + (happy_var_2 >>= \ happy_var_2 -> + amsA' (sLLAsl happy_var_1 happy_var_2 + (Match { m_ext = noExtField + , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing + , m_pats = L (listLocation happy_var_1) happy_var_1 + , m_grhss = unLoc happy_var_2 })) + )}} + +happyReduce_906 :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) +happyReduce_906 = happySpecReduce_2 336# happyReduction_906 +happyReduction_906 happy_x_2 + happy_x_1 + = case happyOut260 happy_x_1 of { (HappyWrap260 happy_var_1) -> + case happyOut253 happy_x_2 of { (HappyWrap253 happy_var_2) -> + happyIn352 + (happy_var_2 >>= \ happy_var_2 -> + amsA' (sLLAsl happy_var_1 happy_var_2 + (Match { m_ext = noExtField + , m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing + , m_pats = L (listLocation happy_var_1) happy_var_1 + , m_grhss = unLoc happy_var_2 })) + )}} + +happyNewToken action sts stk + = (lexer True)(\tk -> + let cont i = happyDoAction i tk action sts stk in + case tk of { + L _ ITeof -> happyDoAction 161# tk action sts stk; + L _ ITunderscore -> cont 1#; + L _ ITas -> cont 2#; + L _ ITcase -> cont 3#; + L _ ITclass -> cont 4#; + L _ ITdata -> cont 5#; + L _ ITdefault -> cont 6#; + L _ ITderiving -> cont 7#; + L _ ITelse -> cont 8#; + L _ IThiding -> cont 9#; + L _ ITif -> cont 10#; + L _ ITimport -> cont 11#; + L _ ITin -> cont 12#; + L _ ITinfix -> cont 13#; + L _ ITinfixl -> cont 14#; + L _ ITinfixr -> cont 15#; + L _ ITinstance -> cont 16#; + L _ ITlet -> cont 17#; + L _ ITmodule -> cont 18#; + L _ ITnewtype -> cont 19#; + L _ ITof -> cont 20#; + L _ ITqualified -> cont 21#; + L _ ITthen -> cont 22#; + L _ ITtype -> cont 23#; + L _ ITwhere -> cont 24#; + L _ (ITforall _) -> cont 25#; + L _ ITforeign -> cont 26#; + L _ ITexport -> cont 27#; + L _ ITlabel -> cont 28#; + L _ ITdynamic -> cont 29#; + L _ ITsafe -> cont 30#; + L _ ITinterruptible -> cont 31#; + L _ ITunsafe -> cont 32#; + L _ ITfamily -> cont 33#; + L _ ITrole -> cont 34#; + L _ ITstdcallconv -> cont 35#; + L _ ITccallconv -> cont 36#; + L _ ITcapiconv -> cont 37#; + L _ ITprimcallconv -> cont 38#; + L _ ITjavascriptcallconv -> cont 39#; + L _ ITproc -> cont 40#; + L _ ITrec -> cont 41#; + L _ ITgroup -> cont 42#; + L _ ITby -> cont 43#; + L _ ITusing -> cont 44#; + L _ ITpattern -> cont 45#; + L _ ITstatic -> cont 46#; + L _ ITstock -> cont 47#; + L _ ITanyclass -> cont 48#; + L _ ITvia -> cont 49#; + L _ ITsplice -> cont 50#; + L _ ITquote -> cont 51#; + L _ ITunit -> cont 52#; + L _ ITsignature -> cont 53#; + L _ ITdependency -> cont 54#; + L _ (ITinline_prag _ _ _) -> cont 55#; + L _ (ITopaque_prag _) -> cont 56#; + L _ (ITspec_prag _) -> cont 57#; + L _ (ITspec_inline_prag _ _) -> cont 58#; + L _ (ITsource_prag _) -> cont 59#; + L _ (ITrules_prag _) -> cont 60#; + L _ (ITscc_prag _) -> cont 61#; + L _ (ITdeprecated_prag _) -> cont 62#; + L _ (ITwarning_prag _) -> cont 63#; + L _ (ITunpack_prag _) -> cont 64#; + L _ (ITnounpack_prag _) -> cont 65#; + L _ (ITann_prag _) -> cont 66#; + L _ (ITminimal_prag _) -> cont 67#; + L _ (ITctype _) -> cont 68#; + L _ (IToverlapping_prag _) -> cont 69#; + L _ (IToverlappable_prag _) -> cont 70#; + L _ (IToverlaps_prag _) -> cont 71#; + L _ (ITincoherent_prag _) -> cont 72#; + L _ (ITcomplete_prag _) -> cont 73#; + L _ ITclose_prag -> cont 74#; + L _ ITdotdot -> cont 75#; + L _ ITcolon -> cont 76#; + L _ (ITdcolon _) -> cont 77#; + L _ ITequal -> cont 78#; + L _ ITlam -> cont 79#; + L _ ITlcase -> cont 80#; + L _ ITlcases -> cont 81#; + L _ ITvbar -> cont 82#; + L _ (ITlarrow _) -> cont 83#; + L _ (ITrarrow _) -> cont 84#; + L _ ITlolly -> cont 85#; + L _ ITat -> cont 86#; + L _ (ITdarrow _) -> cont 87#; + L _ ITminus -> cont 88#; + L _ ITtilde -> cont 89#; + L _ ITbang -> cont 90#; + L _ ITprefixminus -> cont 91#; + L _ (ITstar _) -> cont 92#; + L _ (ITlarrowtail _) -> cont 93#; + L _ (ITrarrowtail _) -> cont 94#; + L _ (ITLarrowtail _) -> cont 95#; + L _ (ITRarrowtail _) -> cont 96#; + L _ ITdot -> cont 97#; + L _ (ITproj True) -> cont 98#; + L _ (ITproj False) -> cont 99#; + L _ ITtypeApp -> cont 100#; + L _ ITpercent -> cont 101#; + L _ ITocurly -> cont 102#; + L _ ITccurly -> cont 103#; + L _ ITvocurly -> cont 104#; + L _ ITvccurly -> cont 105#; + L _ ITobrack -> cont 106#; + L _ ITcbrack -> cont 107#; + L _ IToparen -> cont 108#; + L _ ITcparen -> cont 109#; + L _ IToubxparen -> cont 110#; + L _ ITcubxparen -> cont 111#; + L _ (IToparenbar _) -> cont 112#; + L _ (ITcparenbar _) -> cont 113#; + L _ ITsemi -> cont 114#; + L _ ITcomma -> cont 115#; + L _ ITbackquote -> cont 116#; + L _ ITsimpleQuote -> cont 117#; + L _ (ITvarid _) -> cont 118#; + L _ (ITconid _) -> cont 119#; + L _ (ITvarsym _) -> cont 120#; + L _ (ITconsym _) -> cont 121#; + L _ (ITqvarid _) -> cont 122#; + L _ (ITqconid _) -> cont 123#; + L _ (ITqvarsym _) -> cont 124#; + L _ (ITqconsym _) -> cont 125#; + L _ (ITdo _) -> cont 126#; + L _ (ITmdo _) -> cont 127#; + L _ (ITdupipvarid _) -> cont 128#; + L _ (ITlabelvarid _ _) -> cont 129#; + L _ (ITchar _ _) -> cont 130#; + L _ (ITstring _ _) -> cont 131#; + L _ (ITstringMulti _ _) -> cont 132#; + L _ (ITinteger _) -> cont 133#; + L _ (ITrational _) -> cont 134#; + L _ (ITprimchar _ _) -> cont 135#; + L _ (ITprimstring _ _) -> cont 136#; + L _ (ITprimint _ _) -> cont 137#; + L _ (ITprimword _ _) -> cont 138#; + L _ (ITprimint8 _ _) -> cont 139#; + L _ (ITprimint16 _ _) -> cont 140#; + L _ (ITprimint32 _ _) -> cont 141#; + L _ (ITprimint64 _ _) -> cont 142#; + L _ (ITprimword8 _ _) -> cont 143#; + L _ (ITprimword16 _ _) -> cont 144#; + L _ (ITprimword32 _ _) -> cont 145#; + L _ (ITprimword64 _ _) -> cont 146#; + L _ (ITprimfloat _) -> cont 147#; + L _ (ITprimdouble _) -> cont 148#; + L _ (ITopenExpQuote _ _) -> cont 149#; + L _ ITopenPatQuote -> cont 150#; + L _ ITopenTypQuote -> cont 151#; + L _ ITopenDecQuote -> cont 152#; + L _ (ITcloseQuote _) -> cont 153#; + L _ (ITopenTExpQuote _) -> cont 154#; + L _ ITcloseTExpQuote -> cont 155#; + L _ ITdollar -> cont 156#; + L _ ITdollardollar -> cont 157#; + L _ ITtyQuote -> cont 158#; + L _ (ITquasiQuote _) -> cont 159#; + L _ (ITqQuasiQuote _) -> cont 160#; + _ -> happyError' (tk, []) + }) + +happyError_ explist 161# tk = happyError' (tk, explist) +happyError_ explist _ tk = happyError' (tk, explist) + +happyThen :: () => P a -> (a -> P b) -> P b +happyThen = (>>=) +happyReturn :: () => a -> P a +happyReturn = (return) +happyParse :: () => Happy_GHC_Exts.Int# -> P (HappyAbsSyn ) + +happyNewToken :: () => Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) + +happyDoAction :: () => Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn ) + +happyReduceArr :: () => Happy_Data_Array.Array Prelude.Int (Happy_GHC_Exts.Int# -> (Located Token) -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn ) -> P (HappyAbsSyn )) + +happyThen1 :: () => P a -> (a -> P b) -> P b +happyThen1 = happyThen +happyReturn1 :: () => a -> P a +happyReturn1 = happyReturn +happyError' :: () => (((Located Token)), [Prelude.String]) -> P a +happyError' tk = (\(tokens, explist) -> happyError) tk +parseModuleNoHaddock = happySomeParser where + happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (let {(HappyWrap35 x') = happyOut35 x} in x')) + +parseSignatureNoHaddock = happySomeParser where + happySomeParser = happyThen (happyParse 1#) (\x -> happyReturn (let {(HappyWrap34 x') = happyOut34 x} in x')) + +parseImport = happySomeParser where + happySomeParser = happyThen (happyParse 2#) (\x -> happyReturn (let {(HappyWrap62 x') = happyOut62 x} in x')) + +parseStatement = happySomeParser where + happySomeParser = happyThen (happyParse 3#) (\x -> happyReturn (let {(HappyWrap268 x') = happyOut268 x} in x')) + +parseDeclaration = happySomeParser where + happySomeParser = happyThen (happyParse 4#) (\x -> happyReturn (let {(HappyWrap82 x') = happyOut82 x} in x')) + +parseExpression = happySomeParser where + happySomeParser = happyThen (happyParse 5#) (\x -> happyReturn (let {(HappyWrap221 x') = happyOut221 x} in x')) + +parsePattern = happySomeParser where + happySomeParser = happyThen (happyParse 6#) (\x -> happyReturn (let {(HappyWrap259 x') = happyOut259 x} in x')) + +parseTypeSignature = happySomeParser where + happySomeParser = happyThen (happyParse 7#) (\x -> happyReturn (let {(HappyWrap216 x') = happyOut216 x} in x')) + +parseStmt = happySomeParser where + happySomeParser = happyThen (happyParse 8#) (\x -> happyReturn (let {(HappyWrap267 x') = happyOut267 x} in x')) + +parseIdentifier = happySomeParser where + happySomeParser = happyThen (happyParse 9#) (\x -> happyReturn (let {(HappyWrap16 x') = happyOut16 x} in x')) + +parseType = happySomeParser where + happySomeParser = happyThen (happyParse 10#) (\x -> happyReturn (let {(HappyWrap168 x') = happyOut168 x} in x')) + +parseBackpack = happySomeParser where + happySomeParser = happyThen (happyParse 11#) (\x -> happyReturn (let {(HappyWrap17 x') = happyOut17 x} in x')) + +parseHeader = happySomeParser where + happySomeParser = happyThen (happyParse 12#) (\x -> happyReturn (let {(HappyWrap42 x') = happyOut42 x} in x')) + +happySeq = happyDoSeq + + +happyError :: P a +happyError = srcParseFail + +getVARID (L _ (ITvarid x)) = x +getCONID (L _ (ITconid x)) = x +getVARSYM (L _ (ITvarsym x)) = x +getCONSYM (L _ (ITconsym x)) = x +getDO (L _ (ITdo x)) = x +getMDO (L _ (ITmdo x)) = x +getQVARID (L _ (ITqvarid x)) = x +getQCONID (L _ (ITqconid x)) = x +getQVARSYM (L _ (ITqvarsym x)) = x +getQCONSYM (L _ (ITqconsym x)) = x +getIPDUPVARID (L _ (ITdupipvarid x)) = x +getLABELVARID (L _ (ITlabelvarid _ x)) = x +getCHAR (L _ (ITchar _ x)) = x +getSTRING (L _ (ITstring _ x)) = x +getSTRINGMULTI (L _ (ITstringMulti _ x)) = x +getINTEGER (L _ (ITinteger x)) = x +getRATIONAL (L _ (ITrational x)) = x +getPRIMCHAR (L _ (ITprimchar _ x)) = x +getPRIMSTRING (L _ (ITprimstring _ x)) = x +getPRIMINTEGER (L _ (ITprimint _ x)) = x +getPRIMWORD (L _ (ITprimword _ x)) = x +getPRIMINTEGER8 (L _ (ITprimint8 _ x)) = x +getPRIMINTEGER16 (L _ (ITprimint16 _ x)) = x +getPRIMINTEGER32 (L _ (ITprimint32 _ x)) = x +getPRIMINTEGER64 (L _ (ITprimint64 _ x)) = x +getPRIMWORD8 (L _ (ITprimword8 _ x)) = x +getPRIMWORD16 (L _ (ITprimword16 _ x)) = x +getPRIMWORD32 (L _ (ITprimword32 _ x)) = x +getPRIMWORD64 (L _ (ITprimword64 _ x)) = x +getPRIMFLOAT (L _ (ITprimfloat x)) = x +getPRIMDOUBLE (L _ (ITprimdouble x)) = x +getINLINE (L _ (ITinline_prag _ inl conl)) = (inl,conl) +getSPEC_INLINE (L _ (ITspec_inline_prag src True)) = (Inline src,FunLike) +getSPEC_INLINE (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike) +getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x +getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l + +getINTEGERs (L _ (ITinteger (IL src _ _))) = src +getCHARs (L _ (ITchar src _)) = src +getSTRINGs (L _ (ITstring src _)) = src +getSTRINGMULTIs (L _ (ITstringMulti src _)) = src +getPRIMCHARs (L _ (ITprimchar src _)) = src +getPRIMSTRINGs (L _ (ITprimstring src _)) = src +getPRIMINTEGERs (L _ (ITprimint src _)) = src +getPRIMWORDs (L _ (ITprimword src _)) = src +getPRIMINTEGER8s (L _ (ITprimint8 src _)) = src +getPRIMINTEGER16s (L _ (ITprimint16 src _)) = src +getPRIMINTEGER32s (L _ (ITprimint32 src _)) = src +getPRIMINTEGER64s (L _ (ITprimint64 src _)) = src +getPRIMWORD8s (L _ (ITprimword8 src _)) = src +getPRIMWORD16s (L _ (ITprimword16 src _)) = src +getPRIMWORD32s (L _ (ITprimword32 src _)) = src +getPRIMWORD64s (L _ (ITprimword64 src _)) = src + +getLABELVARIDs (L _ (ITlabelvarid src _)) = src + +-- See Note [Pragma source text] in "GHC.Types.SourceText" for the following +getINLINE_PRAGs (L _ (ITinline_prag _ inl _)) = inlineSpecSource inl +getOPAQUE_PRAGs (L _ (ITopaque_prag src)) = src +getSPEC_PRAGs (L _ (ITspec_prag src)) = src +getSPEC_INLINE_PRAGs (L _ (ITspec_inline_prag src _)) = src +getSOURCE_PRAGs (L _ (ITsource_prag src)) = src +getRULES_PRAGs (L _ (ITrules_prag src)) = src +getWARNING_PRAGs (L _ (ITwarning_prag src)) = src +getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src +getSCC_PRAGs (L _ (ITscc_prag src)) = src +getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src +getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src +getANN_PRAGs (L _ (ITann_prag src)) = src +getMINIMAL_PRAGs (L _ (ITminimal_prag src)) = src +getOVERLAPPABLE_PRAGs (L _ (IToverlappable_prag src)) = src +getOVERLAPPING_PRAGs (L _ (IToverlapping_prag src)) = src +getOVERLAPS_PRAGs (L _ (IToverlaps_prag src)) = src +getINCOHERENT_PRAGs (L _ (ITincoherent_prag src)) = src +getCTYPEs (L _ (ITctype src)) = src + +getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) Nothing +getStringMultiLiteral l = StringLiteral (getSTRINGMULTIs l) (getSTRINGMULTI l) Nothing + +isUnicode :: Located Token -> Bool +isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITdarrow iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITdcolon iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITlarrow iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITrarrow iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITlarrowtail iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITrarrowtail iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITLarrowtail iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITRarrowtail iu)) = iu == UnicodeSyntax +isUnicode (L _ (IToparenbar iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITcparenbar iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITopenExpQuote _ iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITcloseQuote iu)) = iu == UnicodeSyntax +isUnicode (L _ (ITstar iu)) = iu == UnicodeSyntax +isUnicode (L _ ITlolly) = True +isUnicode _ = False + +hasE :: Located Token -> Bool +hasE (L _ (ITopenExpQuote HasE _)) = True +hasE (L _ (ITopenTExpQuote HasE)) = True +hasE _ = False + +getSCC :: Located Token -> P FastString +getSCC lt = do let s = getSTRING lt + -- We probably actually want to be more restrictive than this + if ' ' `elem` unpackFS s + then addFatalError $ mkPlainErrorMsgEnvelope (getLoc lt) $ PsErrSpaceInSCC + else return s + +stringLiteralToHsDocWst :: Located StringLiteral -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs) +stringLiteralToHsDocWst sl = reLoc $ lexStringLiteral parseIdentifier sl + +-- Utilities for combining source spans +comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan +comb2 !a !b = combineHasLocs a b + +comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan +comb3 !a !b !c = combineSrcSpans (getHasLoc a) (combineHasLocs b c) + +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan +comb4 !a !b !c !d = + combineSrcSpans (getHasLoc a) $ + combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d) + +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan +comb5 !a !b !c !d !e = + combineSrcSpans (getHasLoc a) $ + combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ + combineSrcSpans (getHasLoc d) (getHasLoc e) + +comb6 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e, HasLoc f) => a -> b -> c -> d -> e -> f -> SrcSpan +comb6 !a !b !c !d !e !f = + combineSrcSpans (getHasLoc a) $ + combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ + combineSrcSpans (getHasLoc d) $ + combineSrcSpans (getHasLoc e) (getHasLoc f) -- strict constructor version: {-# INLINE sL #-} diff --git a/GHC/Parser/Annotation.hs b/GHC/Parser/Annotation.hs --- a/GHC/Parser/Annotation.hs +++ b/GHC/Parser/Annotation.hs @@ -10,6 +10,7 @@ -- * Core Exact Print Annotation types EpToken(..), EpUniToken(..), getEpTokenSrcSpan, + getEpTokenBufSpan, getEpTokenLocs, getEpTokenLoc, getEpUniTokenLoc, TokDcolon, TokDarrow, TokRarrow, TokForall, EpLayout(..), @@ -19,7 +20,6 @@ -- * In-tree Exact Print Annotations EpaLocation, EpaLocation'(..), epaLocationRealSrcSpan, - TokenLocation(..), DeltaPos(..), deltaPos, getDeltaLine, EpAnn(..), @@ -65,7 +65,6 @@ srcSpan2e, realSrcSpan, -- ** Building up annotations - reAnnL, reAnnC, addAnnsA, widenSpanL, widenSpanT, widenAnchorT, widenAnchorS, widenLocatedAnL, listLocation, @@ -93,7 +92,6 @@ noComments, comment, addCommentsToEpAnn, setCommentsEpAnn, transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA, transferPriorCommentsA, transferFollowingA, - commentsOnlyA, removeCommentsA, placeholderRealSpan, ) where @@ -102,13 +100,14 @@ import Data.Data import Data.Function (on) -import Data.List (sortBy, foldl1') +import Data.List (sortBy) import Data.Semigroup import GHC.Data.FastString import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Hs.DocString +import GHC.Utils.Misc import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict @@ -254,6 +253,11 @@ getEpTokenSrcSpan (EpTok EpaDelta{}) = noSrcSpan getEpTokenSrcSpan (EpTok (EpaSpan span)) = span +getEpTokenBufSpan :: EpToken tok -> Strict.Maybe BufSpan +getEpTokenBufSpan NoEpTok = Strict.Nothing +getEpTokenBufSpan (EpTok EpaDelta{}) = Strict.Nothing +getEpTokenBufSpan (EpTok (EpaSpan span)) = getBufSpan span + getEpTokenLocs :: [EpToken tok] -> [EpaLocation] getEpTokenLocs ls = concatMap go ls where @@ -340,14 +344,6 @@ noCommentsToEpaLocation (EpaSpan ss) = EpaSpan ss noCommentsToEpaLocation (EpaDelta ss dp NoComments) = EpaDelta ss dp [] --- | Tokens embedded in the AST have an EpaLocation, unless they come from --- generated code (e.g. by TH). -data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation - deriving (Data,Eq) - -instance Outputable a => Outputable (GenLocated TokenLocation a) where - ppr (L _ x) = ppr x - -- | Used in the parser only, extract the 'RealSrcSpan' from an -- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the -- partial function is safe. @@ -489,7 +485,9 @@ So - type instance XRec (GhcPass p) a = GenLocated (Anno a) a + type instance XRec (GhcPass p) a = XRecGhc a + type XRecGhc a = GenLocated (Anno a) a + type instance Anno RdrName = SrcSpanAnnN type LocatedN = GenLocated SrcSpanAnnN @@ -908,8 +906,7 @@ getHasLoc (EpUniTok l _) = getHasLoc l getHasLocList :: HasLoc a => [a] -> SrcSpan -getHasLocList [] = noSrcSpan -getHasLocList xs = foldl1' combineSrcSpans $ map getHasLoc xs +getHasLocList = foldl1WithDefault' noSrcSpan combineSrcSpans . map getHasLoc -- --------------------------------------------------------------------- @@ -923,12 +920,6 @@ srcSpan2e ss@(RealSrcSpan _ _) = EpaSpan ss srcSpan2e span = EpaSpan (RealSrcSpan (realSrcSpan span) Strict.Nothing) -reAnnC :: AnnContext -> EpAnnComments -> Located a -> LocatedC a -reAnnC anns cs (L l a) = L (EpAnn (spanAsAnchor l) anns cs) a - -reAnnL :: ann -> EpAnnComments -> Located e -> GenLocated (EpAnn ann) e -reAnnL anns cs (L l a) = L (EpAnn (spanAsAnchor l) anns cs) a - getLocAnn :: Located a -> SrcSpanAnnA getLocAnn (L l _) = noAnnSrcSpan l @@ -1087,16 +1078,6 @@ fc = getFollowingComments cs1 cs1' = setFollowingComments emptyComments fc cs2' = setPriorComments cs2 (priorComments cs2 <> pc) - - --- | Remove the exact print annotations payload, leaving only the --- anchor and comments. -commentsOnlyA :: NoAnn ann => EpAnn ann -> EpAnn ann -commentsOnlyA (EpAnn a _ cs) = EpAnn a noAnn cs - --- | Remove the comments, leaving the exact print annotations payload -removeCommentsA :: EpAnn ann -> EpAnn ann -removeCommentsA (EpAnn a an _) = EpAnn a an emptyComments -- --------------------------------------------------------------------- -- Semigroup instances, to allow easy combination of annotation elements diff --git a/GHC/Parser/Errors/Ppr.hs b/GHC/Parser/Errors/Ppr.hs --- a/GHC/Parser/Errors/Ppr.hs +++ b/GHC/Parser/Errors/Ppr.hs @@ -33,7 +33,6 @@ import GHC.Hs.Expr (prependQualified, HsExpr(..), HsLamVariant(..), lamCaseKeyword) import GHC.Hs.Type (pprLHsContext, pprHsArrow, pprHsForAll) import GHC.Builtin.Names (allNameStringList) -import GHC.Builtin.Types (filterCTuple) import qualified GHC.LanguageExtensions as LangExt import Data.List.NonEmpty (NonEmpty((:|))) import GHC.Hs.Pat (Pat(..), LPat) @@ -44,7 +43,7 @@ instance Diagnostic PsMessage where type DiagnosticOpts PsMessage = NoDiagnosticOpts diagnosticMessage opts = \case - PsUnknownMessage (UnknownDiagnostic f m) + PsUnknownMessage (UnknownDiagnostic f _ m) -> diagnosticMessage (f opts) m PsHeaderMessage m @@ -274,10 +273,15 @@ 2 (pprWithCommas ppr vs) , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details." ] - PsErrIllegalExplicitNamespace + PsErrIllegalExplicitNamespace kw -> mkSimpleDecorated $ - text "Illegal keyword 'type'" + text "Illegal keyword" <+> quotes kw_doc + where + kw_doc = case kw of + ExplicitTypeNamespace{} -> text "type" + ExplicitDataNamespace{} -> text "data" + PsErrUnallowedPragma prag -> mkSimpleDecorated $ hang (text "A pragma is not allowed in this position:") 2 @@ -288,6 +292,8 @@ <+> text "in postpositive position. " PsErrImportQualifiedTwice -> mkSimpleDecorated $ text "Multiple occurrences of 'qualified'" + PsErrSpliceOrQuoteTwice + -> mkSimpleDecorated $ text "Multiple occurrences of a splice or quote keyword" PsErrIllegalImportBundleForm -> mkSimpleDecorated $ text "Illegal import form, this syntax can only be used to bundle" @@ -462,12 +468,6 @@ -> let msg = parse_error_in_pat body = case details of PEIP_NegApp -> text "-" <> ppr s - PEIP_TypeArgs peipd_tyargs - | not (null peipd_tyargs) -> ppr s <+> vcat [ - hsep (map ppr peipd_tyargs) - , text "Type applications in patterns are only allowed on data constructors." - ] - | otherwise -> ppr s PEIP_OtherPatDetails (ParseContext (Just fun) _) -> ppr s <+> text "In a function binding for the" <+> quotes (ppr fun) @@ -497,19 +497,14 @@ -> mkSimpleDecorated $ vcat [ text "Unexpected type" <+> quotes (ppr t) , text "In the" <+> what - <+> text "declaration for" <+> quotes tc' + <+> text "declaration for" <+> quotes (ppr tc) , vcat[ (text "A" <+> what <+> text "declaration should have form") , nest 2 (what - <+> tc' + <+> ppr tc <+> hsep (map text (takeList tparms allNameStringList)) <+> equals_or_where) ] ] - where - -- Avoid printing a constraint tuple in the error message. Print - -- a plain old tuple instead (since that's what the user probably - -- wrote). See #14907 - tc' = ppr $ filterCTuple tc PsErrInvalidPackageName pkg -> mkSimpleDecorated $ vcat [ text "Parse error" <> colon <+> quotes (ftext pkg) @@ -571,6 +566,18 @@ PsErrIllegalOrPat pat -> mkSimpleDecorated $ vcat [text "Illegal or-pattern:" <+> ppr (unLoc pat)] + PsErrSpecExprMultipleTypeAscription + -> mkSimpleDecorated $ + text "SPECIALISE expression doesn't support multiple type ascriptions" + + PsWarnSpecMultipleTypeAscription + -> mkSimpleDecorated $ + text "SPECIALISE pragmas with multiple type ascriptions are deprecated, and will be removed in GHC 9.18" + + PsWarnPatternNamespaceSpecifier _explicit_namespaces + -> mkSimpleDecorated $ + text "The" <+> quotes (text "pattern") <+> "namespace specifier is deprecated." + diagnosticReason = \case PsUnknownMessage m -> diagnosticReason m PsHeaderMessage m -> psHeaderMessageReason m @@ -617,10 +624,11 @@ PsErrNoSingleWhereBindInPatSynDecl{} -> ErrorWithoutFlag PsErrDeclSpliceNotAtTopLevel{} -> ErrorWithoutFlag PsErrMultipleNamesInStandaloneKindSignature{} -> ErrorWithoutFlag - PsErrIllegalExplicitNamespace -> ErrorWithoutFlag + PsErrIllegalExplicitNamespace{} -> ErrorWithoutFlag PsErrUnallowedPragma{} -> ErrorWithoutFlag PsErrImportPostQualified -> ErrorWithoutFlag PsErrImportQualifiedTwice -> ErrorWithoutFlag + PsErrSpliceOrQuoteTwice -> ErrorWithoutFlag PsErrIllegalImportBundleForm -> ErrorWithoutFlag PsErrInvalidRuleActivationMarker -> ErrorWithoutFlag PsErrMissingBlock -> ErrorWithoutFlag @@ -689,6 +697,9 @@ PsErrInvalidPun {} -> ErrorWithoutFlag PsErrIllegalOrPat{} -> ErrorWithoutFlag PsErrTypeSyntaxInPat{} -> ErrorWithoutFlag + PsErrSpecExprMultipleTypeAscription{} -> ErrorWithoutFlag + PsWarnSpecMultipleTypeAscription{} -> WarningWithFlag Opt_WarnDeprecatedPragmas + PsWarnPatternNamespaceSpecifier{} -> WarningWithFlag Opt_WarnPatternNamespaceSpecifier diagnosticHints = \case PsUnknownMessage m -> diagnosticHints m @@ -753,10 +764,11 @@ PsErrNoSingleWhereBindInPatSynDecl{} -> noHints PsErrDeclSpliceNotAtTopLevel{} -> noHints PsErrMultipleNamesInStandaloneKindSignature{} -> noHints - PsErrIllegalExplicitNamespace -> [suggestExtension LangExt.ExplicitNamespaces] + PsErrIllegalExplicitNamespace{} -> [suggestExtension LangExt.ExplicitNamespaces] PsErrUnallowedPragma{} -> noHints PsErrImportPostQualified -> [suggestExtension LangExt.ImportQualifiedPost] PsErrImportQualifiedTwice -> noHints + PsErrSpliceOrQuoteTwice -> noHints PsErrIllegalImportBundleForm -> noHints PsErrInvalidRuleActivationMarker -> noHints PsErrMissingBlock -> noHints @@ -858,8 +870,16 @@ PsErrInvalidPun {} -> [suggestExtension LangExt.ListTuplePuns] PsErrIllegalOrPat{} -> [suggestExtension LangExt.OrPatterns] PsErrTypeSyntaxInPat{} -> noHints + PsErrSpecExprMultipleTypeAscription {} -> [SuggestSplittingIntoSeveralSpecialisePragmas] + PsWarnSpecMultipleTypeAscription{} -> [SuggestSplittingIntoSeveralSpecialisePragmas] + PsWarnPatternNamespaceSpecifier explicit_namespaces + | explicit_namespaces -> [SuggestDataKeyword] + | otherwise -> + let info = text "and replace" <+> quotes (text "pattern") + <+> text "with" <+> quotes (text "data") <> "." + in [useExtensionInOrderTo info LangExt.ExplicitNamespaces] - diagnosticCode = constructorCode + diagnosticCode = constructorCode @GHC psHeaderMessageDiagnostic :: PsHeaderMessage -> DecoratedSDoc psHeaderMessageDiagnostic = \case diff --git a/GHC/Parser/Errors/Types.hs b/GHC/Parser/Errors/Types.hs --- a/GHC/Parser/Errors/Types.hs +++ b/GHC/Parser/Errors/Types.hs @@ -69,7 +69,7 @@ arbitrary messages to be embedded. The typical use case would be GHC plugins willing to emit custom diagnostics. -} - PsUnknownMessage (UnknownDiagnostic (DiagnosticOpts PsMessage)) + PsUnknownMessage (UnknownDiagnosticFor PsMessage) {-| A group of parser messages emitted in 'GHC.Parser.Header'. See Note [Messages from GHC.Parser.Header]. @@ -207,11 +207,14 @@ -- | Import: multiple occurrences of 'qualified' | PsErrImportQualifiedTwice + -- | Multiple occurrences of a splice or quote keyword + | PsErrSpliceOrQuoteTwice + -- | Post qualified import without 'ImportQualifiedPost' | PsErrImportPostQualified -- | Explicit namespace keyword without 'ExplicitNamespaces' - | PsErrIllegalExplicitNamespace + | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword -- | Expecting a type constructor but found a variable | PsErrVarForTyCon !RdrName @@ -466,7 +469,7 @@ | PsErrParseRightOpSectionInPat !RdrName !(PatBuilder GhcPs) -- | Illegal linear arrow or multiplicity annotation in GADT record syntax - | PsErrIllegalGadtRecordMultiplicity !(HsArrow GhcPs) + | PsErrIllegalGadtRecordMultiplicity !(HsMultAnn GhcPs) | PsErrInvalidCApiImport @@ -491,6 +494,27 @@ -- T24159_pat_parse_error_6 | PsErrTypeSyntaxInPat !PsErrTypeSyntaxDetails + -- | 'PsErrSpecExprMultipleTypeAscription' is an error that occurs when + -- a user attempts to use the new form SPECIALISE pragma syntax with + -- multiple type signatures, e.g. + -- + -- @{-# SPECIALISE foo 3 :: Float -> Float; Double -> Double #-} + | PsErrSpecExprMultipleTypeAscription + + -- | 'PsWarnSpecMultipleTypeAscription' is a warning that occurs when + -- a user uses the old-form SPECIALISE pragma syntax with + -- multiple type signatures, e.g. + -- + -- @{-# SPECIALISE bar :: Float -> Float; Double -> Double #-} + -- + -- This constructor is deprecated and will be removed in GHC 9.18. + | PsWarnSpecMultipleTypeAscription + + -- | The deprecated ``pattern`` namespace specifier was used in an import or + -- export list. Suggested fix: use the ``data`` keyword instead. + | PsWarnPatternNamespaceSpecifier + !Bool -- ^ Is ExplicitNamespaces on? + deriving Generic -- | Extra details about a parse error, which helps @@ -539,8 +563,6 @@ data PsErrInPatDetails = PEIP_NegApp -- ^ Negative application pattern? - | PEIP_TypeArgs [HsConPatTyArg GhcPs] - -- ^ The list of type arguments for the pattern | PEIP_RecPattern [LPat GhcPs] -- ^ The pattern arguments !PatIsRecursive -- ^ Is the parsed pattern recursive? !ParseContext @@ -554,7 +576,7 @@ data PsErrTypeSyntaxDetails = PETS_FunctionArrow !(LocatedA (PatBuilder GhcPs)) - !(HsArrowOf (LocatedA (PatBuilder GhcPs)) GhcPs) + !(HsMultAnnOf (LocatedA (PatBuilder GhcPs)) GhcPs) !(LocatedA (PatBuilder GhcPs)) | PETS_Multiplicity !(EpToken "%") diff --git a/GHC/Parser/HaddockLex.hs b/GHC/Parser/HaddockLex.hs --- a/GHC/Parser/HaddockLex.hs +++ b/GHC/Parser/HaddockLex.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LINE 1 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/HaddockLex.x" #-} +{-# LINE 1 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/HaddockLex.x" #-} {-# OPTIONS_GHC -funbox-strict-fields #-} module GHC.Parser.HaddockLex (lexHsDoc, lexStringLiteral) where @@ -353,7 +353,7 @@ -- match when checking the right context, just -- the first match will do. #endif -{-# LINE 85 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/HaddockLex.x" #-} +{-# LINE 85 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/HaddockLex.x" #-} data AlexInput = AlexInput { alexInput_position :: !RealSrcLoc , alexInput_string :: !ByteString @@ -447,7 +447,6 @@ pflags = mkParserOpts (EnumSet.fromList [LangExt.MagicHash]) dopts - [] False False False False dopts = emptyDiagOpts buffer = stringBufferFromByteString str0 diff --git a/GHC/Parser/Header.hs b/GHC/Parser/Header.hs --- a/GHC/Parser/Header.hs +++ b/GHC/Parser/Header.hs @@ -31,7 +31,6 @@ import GHC.Parser.Lexer import GHC.Hs -import GHC.Unit.Module import GHC.Builtin.Names import GHC.Types.Error @@ -39,6 +38,7 @@ import GHC.Types.SourceError import GHC.Types.SourceText import GHC.Types.PkgQual +import GHC.Types.Basic (ImportLevel(..), convImportLevel) import GHC.Utils.Misc import GHC.Utils.Panic @@ -74,9 +74,8 @@ -- in the function result) -> IO (Either (Messages PsMessage) - ([(RawPkgQual, Located ModuleName)], - [(RawPkgQual, Located ModuleName)], - Bool, -- Is GHC.Prim imported or not + ([Located ModuleName], + [(ImportLevel, RawPkgQual, Located ModuleName)], Located ModuleName)) -- ^ The source imports and normal imports (with optional package -- names from -XPackageImports), and the module name. @@ -101,21 +100,17 @@ mod = mb_mod `orElse` L (noAnnSrcSpan main_loc) mAIN_NAME (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps - -- GHC.Prim doesn't exist physically, so don't go looking for it. - (ordinary_imps, ghc_prim_import) - = partition ((/= moduleName gHC_PRIM) . unLoc - . ideclName . unLoc) - ord_idecls - implicit_imports = mkPrelImports (unLoc mod) main_loc implicit_prelude imps - convImport (L _ i) = (ideclPkgQual i, reLoc $ ideclName i) + convImport (L _ (i :: ImportDecl GhcPs)) = (convImportLevel (ideclLevelSpec i), ideclPkgQual i, reLoc $ ideclName i) + convImport_src (L _ (i :: ImportDecl GhcPs)) = (reLoc $ ideclName i) in - return (map convImport src_idecls - , map convImport (implicit_imports ++ ordinary_imps) - , not (null ghc_prim_import) + return (map convImport_src src_idecls + , map convImport (implicit_imports ++ ord_idecls) , reLoc mod) + + mkPrelImports :: ModuleName -> SrcSpan -- Attribute the "import Prelude" to this location -> Bool -> [LImportDecl GhcPs] @@ -134,13 +129,17 @@ where explicit_prelude_import = any is_prelude_import import_decls - is_prelude_import (L _ decl) = + is_prelude_import (L _ (decl::ImportDecl GhcPs)) = unLoc (ideclName decl) == pRELUDE_NAME -- See #17045, package qualified imports are never counted as -- explicit prelude imports && case ideclPkgQual decl of NoRawPkgQual -> True RawPkgQual {} -> False + -- Only a "normal" level import will override the implicit prelude import. + && case ideclLevelSpec decl of + NotLevelled -> True + _ -> False loc' = noAnnSrcSpan loc @@ -157,6 +156,7 @@ ideclSafe = False, -- Not a safe import ideclQualified = NotQualified, ideclAs = Nothing, + ideclLevelSpec = NotLevelled, ideclImportList = Nothing } -------------------------------------------------------------- @@ -167,14 +167,15 @@ -- -- Throws a 'SourceError' if flag parsing fails (including unsupported flags.) getOptionsFromFile :: ParserOpts + -> [String] -- ^ Supported LANGUAGE pragmas -> FilePath -- ^ Input file -> IO (Messages PsMessage, [Located String]) -- ^ Parsed options, if any. -getOptionsFromFile opts filename +getOptionsFromFile opts supported filename = Exception.bracket (openBinaryFile filename ReadMode) (hClose) (\handle -> do - (warns, opts) <- fmap (getOptions' opts) + (warns, opts) <- fmap (getOptions' opts supported) (lazyGetToks opts' filename handle) seqList opts $ seqList (bagToList $ getMessages warns) @@ -248,20 +249,22 @@ -- -- Throws a 'SourceError' if flag parsing fails (including unsupported flags.) getOptions :: ParserOpts + -> [String] -- ^ Supported LANGUAGE pragmas -> StringBuffer -- ^ Input Buffer -> FilePath -- ^ Source filename. Used for location info. -> (Messages PsMessage,[Located String]) -- ^ warnings and parsed options. -getOptions opts buf filename - = getOptions' opts (getToks opts filename buf) +getOptions opts supported buf filename + = getOptions' opts supported (getToks opts filename buf) -- The token parser is written manually because Happy can't -- return a partial result when it encounters a lexer error. -- We want to extract options before the buffer is passed through -- CPP, so we can't use the same trick as 'getImports'. getOptions' :: ParserOpts + -> [String] -> [Located Token] -- Input buffer -> (Messages PsMessage,[Located String]) -- Options. -getOptions' opts toks +getOptions' opts supported toks = parseToks toks where parseToks (open:close:xs) @@ -273,7 +276,7 @@ Right args -> fmap (args ++) (parseToks xs) where src_span = getLoc open - real_src_span = expectJust "getOptions'" (srcSpanToRealSrcSpan src_span) + real_src_span = expectJust (srcSpanToRealSrcSpan src_span) starting_loc = realSrcSpanStart real_src_span parseToks (open:close:xs) | ITinclude_prag str <- unLoc open @@ -295,7 +298,7 @@ parseToks xs = (unionManyMessages $ mapMaybe mkMessage xs ,[]) parseLanguage ((L loc (ITconid fs)):rest) - = fmap (checkExtension opts (L loc fs) :) $ + = fmap (checkExtension supported (L loc fs) :) $ case rest of (L _loc ITcomma):more -> parseLanguage more (L _loc ITclose_prag):more -> parseToks more @@ -445,13 +448,13 @@ ----------------------------------------------------------------------------- -checkExtension :: ParserOpts -> Located FastString -> Located String -checkExtension opts (L l ext) +checkExtension :: [String] -> Located FastString -> Located String +checkExtension supported (L l ext) -- Checks if a given extension is valid, and if so returns -- its corresponding flag. Otherwise it throws an exception. - = if ext' `elem` (pSupportedExts opts) + = if ext' `elem` supported then L l ("-X"++ext') - else unsupportedExtnError opts l ext' + else unsupportedExtnError supported l ext' where ext' = unpackFS ext @@ -459,9 +462,9 @@ languagePragParseError loc = throwErr loc $ PsErrParseLanguagePragma -unsupportedExtnError :: ParserOpts -> SrcSpan -> String -> a -unsupportedExtnError opts loc unsup = - throwErr loc $ PsErrUnsupportedExt unsup (pSupportedExts opts) +unsupportedExtnError :: [String] -> SrcSpan -> String -> a +unsupportedExtnError supported loc unsup = + throwErr loc $ PsErrUnsupportedExt unsup supported optionsParseError :: String -> SrcSpan -> a -- #15053 optionsParseError str loc = diff --git a/GHC/Parser/Lexer.hs b/GHC/Parser/Lexer.hs --- a/GHC/Parser/Lexer.hs +++ b/GHC/Parser/Lexer.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LINE 43 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/Lexer.x" #-} +{-# LINE 43 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/Lexer.x" #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} @@ -1118,7 +1118,7 @@ -- match when checking the right context, just -- the first match will do. #endif -{-# LINE 762 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/Lexer.x" #-} +{-# LINE 762 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/Lexer.x" #-} -- Operator whitespace occurrence. See Note [Whitespace-sensitive operator parsing]. data OpWs = OpWsPrefix -- a !b @@ -1305,15 +1305,18 @@ | ITdollar -- prefix $ | ITdollardollar -- prefix $$ | ITtyQuote -- '' - | ITquasiQuote (FastString,FastString,PsSpan) - -- ITquasiQuote(quoter, quote, loc) + | ITquasiQuote (FastString, PsSpan, FastString, PsSpan) + -- ITquasiQuote(quoter, quoter_loc, quote, quote_loc) -- represents a quasi-quote of the form -- [quoter| quote |] - | ITqQuasiQuote (FastString,FastString,FastString,PsSpan) - -- ITqQuasiQuote(Qual, quoter, quote, loc) + | ITqQuasiQuote (FastString,FastString,PsSpan, FastString, PsSpan) + -- ITqQuasiQuote(Qual, quoter, quoter_loc, quote, quote_loc) -- represents a qualified quasi-quote of the form -- [Qual.quoter| quote |] + | ITsplice + | ITquote + -- Arrow notation extension | ITproc | ITrec @@ -1453,7 +1456,9 @@ ( "rec", ITrec, xbit ArrowsBit .|. xbit RecursiveDoBit), - ( "proc", ITproc, xbit ArrowsBit) + ( "proc", ITproc, xbit ArrowsBit), + ( "splice", ITsplice, xbit LevelImportsBit), + ( "quote", ITquote, xbit LevelImportsBit) ] {----------------------------------- @@ -2641,11 +2646,16 @@ lex_qquasiquote_tok span buf len _buf2 = do let (qual, quoter) = splitQualName (stepOn buf) (len - 2) False quoteStart <- getParsedLoc + let quoter_span_start = advancePsLoc (psSpanStart span) '[' + quoter_span_end = foldl' advancePsLoc quoter_span_start + (take (len - 2) (repeat 'a')) + quoter_span = mkPsSpan quoter_span_start quoter_span_end quote <- lex_quasiquote (psRealLoc quoteStart) "" end <- getParsedLoc return (L (mkPsSpan (psSpanStart span) end) (ITqQuasiQuote (qual, quoter, + quoter_span, mkFastString (reverse quote), mkPsSpan quoteStart end))) @@ -2655,10 +2665,14 @@ -- 'tail' drops the initial '[', -- while the -1 drops the trailing '|' quoteStart <- getParsedLoc + let quoter_span_start = advancePsLoc (psSpanStart span) '[' + quoter_span_end = foldl' advancePsLoc quoter_span_start quoter + quoter_span = mkPsSpan quoter_span_start quoter_span_end quote <- lex_quasiquote (psRealLoc quoteStart) "" end <- getParsedLoc return (L (mkPsSpan (psSpanStart span) end) (ITquasiQuote (mkFastString quoter, + quoter_span, mkFastString (reverse quote), mkPsSpan quoteStart end))) @@ -2777,8 +2791,6 @@ { pExtsBitmap :: !ExtsBitmap -- ^ bitmap of permitted extensions , pDiagOpts :: !DiagOpts -- ^ Options to construct diagnostic messages. - , pSupportedExts :: [String] - -- ^ supported extensions (only used for suggestions in error messages) } pWarningFlags :: ParserOpts -> EnumSet WarningFlag @@ -3135,6 +3147,7 @@ | ViewPatternsBit | RequiredTypeArgumentsBit | MultilineStringsBit + | LevelImportsBit -- Flags that are updated once parsing starts | InRulePragBit @@ -3149,7 +3162,6 @@ mkParserOpts :: EnumSet LangExt.Extension -- ^ permitted language extensions enabled -> DiagOpts -- ^ diagnostic options - -> [String] -- ^ Supported Languages and Extensions -> Bool -- ^ are safe imports on? -> Bool -- ^ keeping Haddock comment tokens -> Bool -- ^ keep regular comment tokens @@ -3161,12 +3173,11 @@ -> ParserOpts -- ^ Given exactly the information needed, set up the 'ParserOpts' -mkParserOpts extensionFlags diag_opts supported +mkParserOpts extensionFlags diag_opts safeImports isHaddock rawTokStream usePosPrags = ParserOpts { pDiagOpts = diag_opts , pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits - , pSupportedExts = supported } where safeHaskellBit = SafeHaskellBit `setBitIf` safeImports @@ -3220,6 +3231,7 @@ .|. ViewPatternsBit `xoptBit` LangExt.ViewPatterns .|. RequiredTypeArgumentsBit `xoptBit` LangExt.RequiredTypeArguments .|. MultilineStringsBit `xoptBit` LangExt.MultilineStrings + .|. LevelImportsBit `xoptBit` LangExt.ExplicitLevelImports optBits = HaddockBit `setBitIf` isHaddock .|. RawTokenStreamBit `setBitIf` rawTokStream diff --git a/GHC/Parser/Lexer/String.hs b/GHC/Parser/Lexer/String.hs --- a/GHC/Parser/Lexer/String.hs +++ b/GHC/Parser/Lexer/String.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# LINE 1 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/Lexer/String.x" #-} +{-# LINE 1 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/Lexer/String.x" #-} {- | This module defines lex states for strings. @@ -346,7 +346,7 @@ -- match when checking the right context, just -- the first match will do. #endif -{-# LINE 91 "_build/source-dist/ghc-9.12.4-src/ghc-9.12.4/compiler/GHC/Parser/Lexer/String.x" #-} +{-# LINE 91 "_build/source-dist/ghc-9.14.1-src/ghc-9.14.1/compiler/GHC/Parser/Lexer/String.x" #-} -- | Dummy action that should never be called. Should only be used in lex states -- that are manually lexed in tok_string_multi. string_multi_content_action :: a diff --git a/GHC/Parser/PostProcess.hs b/GHC/Parser/PostProcess.hs --- a/GHC/Parser/PostProcess.hs +++ b/GHC/Parser/PostProcess.hs @@ -62,26 +62,29 @@ checkValDef, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl checkValSigLhs, LRuleTyTmVar, RuleTyTmVar(..), - mkRuleBndrs, mkRuleTyVarBndrs, + mkRuleBndrs, + ruleBndrsOrDef, checkRuleTyVarBndrNames, + mkSpecSig, checkRecordSyntax, checkEmptyGADTs, addFatalError, hintBangPat, mkBangTy, UnpackednessPragma(..), - mkMultTy, mkMultAnn, - - -- Token location - mkTokenLocation, + mkMultField, + mkConDeclField, -- Help with processing exports ImpExpSubSpec(..), ImpExpQcSpec(..), mkModuleImpExp, + mkPlainImpExp, mkTypeImpExp, + mkDataImpExp, mkImpExpSubSpec, checkImportSpec, + warnPatternNamespaceSpecifier, -- Token symbols starSym, @@ -92,6 +95,7 @@ failOpFewArgs, failNotEnabledImportQualifiedPost, failImportQualifiedTwice, + failSpliceOrQuoteTwice, SumOrTuple (..), @@ -108,7 +112,6 @@ withArrowParsingMode, withArrowParsingMode', setTelescopeBndrsNameSpace, PatBuilder, - hsHoleExpr, -- Type/datacon ambiguity resolution DisambTD(..), @@ -174,7 +177,7 @@ import Data.Char import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs ) import Data.Kind ( Type ) -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty ( NonEmpty (..) ) {- ********************************************************************** @@ -732,9 +735,9 @@ -- conAnn should only be AnnOpenP, AnnCloseP, so the rest should be empty ; let ann_fun = mk_ann_funrhs [] [] ; match <- case details of - PrefixCon _ pats -> return $ Match { m_ext = noExtField - , m_ctxt = ctxt, m_pats = L l pats - , m_grhss = rhs } + PrefixCon pats -> return $ Match { m_ext = noExtField + , m_ctxt = ctxt, m_pats = L l pats + , m_grhss = rhs } where l = listLocation pats ctxt = FunRhs { mc_fun = ln @@ -803,9 +806,9 @@ (args, res_ty, (ops, cps), csa) <- case body_ty of - L ll (HsFunTy _ hsArr (L (EpAnn anc _ cs) (HsRecTy an rf)) res_ty) -> do + L ll (HsFunTy _ hsArr (L (EpAnn anc _ cs) (XHsType (HsRecTy an rf))) res_ty) -> do arr <- case hsArr of - HsUnrestrictedArrow arr -> return arr + HsUnannotated (EpArrow arr) -> return arr _ -> do addError $ mkPlainErrorMsgEnvelope (getLocA body_ty) $ (PsErrIllegalGadtRecordMultiplicity hsArr) return noAnn @@ -816,23 +819,24 @@ let ((ops, cps), cs, arg_types, res_type) = splitHsFunType body_ty return (PrefixConGADT noExtField arg_types, res_type, (ops,cps), cs) - let bndrs_loc = case outer_bndrs of - HsOuterImplicit{} -> getLoc ty - HsOuterExplicit an _ -> EpAnn (entry an) noAnn emptyComments - let l = EpAnn (spanAsAnchor loc) noAnn csa pure $ L l ConDeclGADT { con_g_ext = AnnConDeclGADT ops cps dcol , con_names = names - , con_bndrs = L bndrs_loc outer_bndrs + , con_outer_bndrs = L outer_bndrs_loc outer_bndrs + , con_inner_bndrs = inner_bndrs , con_mb_cxt = mcxt , con_g_args = args , con_res_ty = res_ty , con_doc = Nothing } where - (outer_bndrs, mcxt, body_ty) = splitLHsGadtTy ty + (outer_bndrs, inner_bndrs, mcxt, body_ty) = splitLHsGadtTy ty + outer_bndrs_loc = case outer_bndrs of + HsOuterImplicit{} -> getLoc ty + HsOuterExplicit an _ -> EpAnn (entry an) noAnn emptyComments + setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. -- @@ -1006,30 +1010,86 @@ data RuleTyTmVar = RuleTyTmVar AnnTyVarBndr (LocatedN RdrName) (Maybe (LHsType GhcPs)) -- ^ Essentially a wrapper for a @RuleBndr GhcPs@ --- turns RuleTyTmVars into RuleBnrs - this is straightforward -mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs] -mkRuleBndrs = fmap (fmap cvt_one) - where cvt_one (RuleTyTmVar ann v Nothing) = RuleBndr ann v - cvt_one (RuleTyTmVar ann v (Just sig)) = - RuleBndrSig ann v (mkHsPatSigType noAnn sig) +ruleBndrsOrDef :: Maybe (RuleBndrs GhcPs) -> RuleBndrs GhcPs +ruleBndrsOrDef (Just bndrs) = bndrs +ruleBndrsOrDef Nothing = mkRuleBndrs noAnn Nothing [] --- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting -mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr () GhcPs] -mkRuleTyVarBndrs = fmap (setLHsTyVarBndrNameSpace tvName . cvt_one) - where cvt_one (L l (RuleTyTmVar ann v msig)) +mkRuleBndrs :: HsRuleBndrsAnn -> Maybe [LRuleTyTmVar] -> [LRuleTyTmVar] -> RuleBndrs GhcPs +mkRuleBndrs ann tvbs tmbs + = RuleBndrs { rb_ext = ann + , rb_tyvs = fmap (fmap (setLHsTyVarBndrNameSpace tvName . cvt_tv)) tvbs + , rb_tmvs = fmap (fmap cvt_tm) tmbs } + where + -- cvt_tm turns RuleTyTmVars into RuleBnrs - this is straightforward + cvt_tm (RuleTyTmVar ann v Nothing) = RuleBndr ann v + cvt_tm (RuleTyTmVar ann v (Just sig)) = RuleBndrSig ann v (mkHsPatSigType noAnn sig) + + -- cvt_tv turns RuleTyTmVars into HsTyVarBndrs - this is more interesting + cvt_tv (L l (RuleTyTmVar ann v msig)) = L (l2l l) (HsTvb ann () (HsBndrVar noExtField v) (cvt_sig msig)) - cvt_sig Nothing = HsBndrNoKind noExtField - cvt_sig (Just sig) = HsBndrKind noExtField sig + cvt_sig Nothing = HsBndrNoKind noExtField + cvt_sig (Just sig) = HsBndrKind noExtField sig +checkRuleTyVarBndrNames :: [LRuleTyTmVar] -> P () -- See Note [Parsing explicit foralls in Rules] in Parser.y -checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P () -checkRuleTyVarBndrNames = mapM_ check . mapMaybe (hsTyVarLName . unLoc) - where check (L loc (Unqual occ)) = - when (occNameFS occ `elem` [fsLit "family",fsLit "role"]) - (addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ - (PsErrParseErrorOnInput occ)) - check _ = panic "checkRuleTyVarBndrNames" +checkRuleTyVarBndrNames bndrs + = sequence_ [ check lname | L _ (RuleTyTmVar _ lname _) <- bndrs ] + where + check (L loc (Unqual occ)) = + when (occNameFS occ `elem` [fsLit "family",fsLit "role"]) $ + addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ + PsErrParseErrorOnInput occ + check _ = panic "checkRuleTyVarBndrNames" +-- | Deal with both old-form and new-form specialise pragmas, using the new +-- 'SpecSigE' form unless there are multiple comma-separated type signatures, +-- in which case we use the old-form. +-- +-- See Note [Overview of SPECIALISE pragmas] in GHC.Tc.Gen.Sig. +mkSpecSig :: InlinePragma + -> AnnSpecSig + -> Maybe (RuleBndrs GhcPs) + -> LHsExpr GhcPs + -> Maybe (Located (TokDcolon, OrdList (LHsSigType GhcPs))) + -> P (Sig GhcPs) +mkSpecSig inl_prag activation_anns m_rule_binds expr m_sigtypes_ascr + = case m_sigtypes_ascr of + Nothing + -- New form, no trailing type signature, e.g {-# SPECIALISE f @Int #-} + -> pure $ + SpecSigE activation_anns + (ruleBndrsOrDef m_rule_binds) expr inl_prag + + Just (L lt (colon_ann, sigtype_ol)) + + -- Singleton, e.g. {-# SPECIALISE f :: ty #-} + -- Use the SpecSigE route + | [sigtype] <- sigtype_list + -> pure $ + SpecSigE activation_anns + (ruleBndrsOrDef m_rule_binds) + (L ((combineSrcSpansA (getLoc expr) (noAnnSrcSpan lt))) + (ExprWithTySig colon_ann expr (mkHsWildCardBndrs sigtype))) + inl_prag + + -- So we must have the old form {# SPECIALISE f :: ty1, ty2, ty3 #-} + -- Use the old SpecSig route + | Nothing <- m_rule_binds + , L _ (HsVar _ var) <- expr + -> do addPsMessage sigs_loc PsWarnSpecMultipleTypeAscription + pure $ + SpecSig (activation_anns {ass_dcolon = Just colon_ann }) + var sigtype_list inl_prag + + | otherwise -> + addFatalError $ + mkPlainErrorMsgEnvelope sigs_loc PsErrSpecExprMultipleTypeAscription + + where + sigtype_list = fromOL sigtype_ol + sigs_loc = + getHasLoc colon_ann `combineSrcSpans` getHasLoc (last sigtype_list) + checkRecordSyntax :: (MonadP m, Outputable a) => LocatedA a -> m (LocatedA a) checkRecordSyntax lr@(L loc r) = do allowed <- getBit TraditionalRecordSyntaxBit @@ -1221,8 +1281,11 @@ checkImportDecl :: Maybe (EpToken "qualified") -> Maybe (EpToken "qualified") - -> P () -checkImportDecl mPre mPost = do + -> Maybe EpAnnLevel + -> Maybe EpAnnLevel + -> P ((Maybe (EpToken "qualified"), ImportDeclQualifiedStyle) + , (Maybe EpAnnLevel, ImportDeclLevelStyle)) +checkImportDecl mPre mPost preLevel postLevel = do let whenJust mg f = maybe (pure ()) f mg tokenSpan tok = RealSrcSpan (epaLocationRealSrcSpan $ getEpTokenLoc tok) Strict.Nothing @@ -1236,15 +1299,47 @@ -- Error if 'qualified' occurs in both pre and postpositive -- positions. - whenJust mPost $ \post -> - when (isJust mPre) $ - failImportQualifiedTwice (tokenSpan post) + qualSpec <- importDeclQualifiedStyle mPre mPost + levelSpec <- importDeclLevelStyle preLevel postLevel -- Warn if 'qualified' found in prepositive position and -- 'Opt_WarnPrepositiveQualifiedModule' is enabled. whenJust mPre $ \pre -> warnPrepositiveQualifiedModule (tokenSpan pre) + return (qualSpec, levelSpec) + +-- | Given two possible located 'qualified' tokens, compute a style +-- (in a conforming Haskell program only one of the two can be not +-- 'Nothing'). This is called from "GHC.Parser". +importDeclQualifiedStyle :: Maybe (EpToken "qualified") + -> Maybe (EpToken "qualified") + -> P (Maybe (EpToken "qualified"), ImportDeclQualifiedStyle) +importDeclQualifiedStyle mPre mPost = + case (mPre, mPost) of + (Just {}, Just post) -> failImportQualifiedTwice (getEpTokenSrcSpan post) + >> return (Just post, QualifiedPost) + (Nothing, Just post) -> pure (Just post, QualifiedPost) + (Just pre, Nothing) -> pure (Just pre, QualifiedPre) + (Nothing, Nothing) -> pure (Nothing, NotQualified) + +importDeclLevelStyle :: (Maybe EpAnnLevel) + -> (Maybe EpAnnLevel) + -> P (Maybe EpAnnLevel, ImportDeclLevelStyle) +importDeclLevelStyle preImportLevel postImportLevel = + case (preImportLevel, postImportLevel) of + (Just {}, Just tok) -> failSpliceOrQuoteTwice tok + >> return (Just tok, LevelStylePost (tokToLevel tok)) + (Nothing, Just post) -> pure (Just post, LevelStylePost (tokToLevel post)) + (Just pre, Nothing) -> pure (Just pre, LevelStylePre (tokToLevel pre)) + (Nothing, Nothing) -> pure (Nothing, NotLevelled) + where + tokToLevel tok = case tok of + EpAnnLevelSplice {} -> ImportDeclSplice + EpAnnLevelQuote {} -> ImportDeclQuote + + + -- ------------------------------------------------------------------------- -- Checking Patterns. @@ -1257,41 +1352,44 @@ checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (LPat GhcPs) checkPattern_details extraDetails pp = runPV_details extraDetails (pp >>= checkLPat) -checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs) -checkLArgPat (L l (ArgPatBuilderVisPat p)) = checkLPat (L l p) -checkLArgPat (L l (ArgPatBuilderArgPat p)) = return (L l p) - checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs) checkLPat (L l@(EpAnn anc an _) p) = do - (L l' p', cs) <- checkPat (EpAnn anc an emptyComments) emptyComments (L l p) [] [] + (L l' p', cs) <- checkPat (EpAnn anc an emptyComments) emptyComments (L l p) [] return (L (addCommentsToEpAnn l' cs) p') -checkPat :: SrcSpanAnnA -> EpAnnComments -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs] +checkPat :: SrcSpanAnnA -> EpAnnComments -> LocatedA (PatBuilder GhcPs) -> [LPat GhcPs] -> PV (LPat GhcPs, EpAnnComments) -- SG: I think this function checks what Haskell2010 calls the `pat` and `lpat` -- productions -checkPat loc cs (L l e@(PatBuilderVar (L ln c))) tyargs args +checkPat loc cs (L l e@(PatBuilderVar (L ln c))) args | isRdrDataCon c || isRdrTc c = return (L loc $ ConPat { pat_con_ext = noAnn -- AZ: where should this come from? , pat_con = L ln c - , pat_args = PrefixCon tyargs args + , pat_args = PrefixCon args }, comments l Semi.<> cs) | (not (null args) && patIsRec c) = do ctx <- askParseContext patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx -checkPat loc cs (L la (PatBuilderAppType f at t)) tyargs args = - checkPat loc (cs Semi.<> comments la) f (HsConPatTyArg at t : tyargs) args -checkPat loc cs (L la (PatBuilderApp f e)) [] args = do +checkPat loc cs (L la (PatBuilderAppType f at t)) args = + checkPat loc (cs Semi.<> comments la) f (mkInvisLPat at t : args) +checkPat loc cs (L la (PatBuilderApp f e)) args = do p <- checkLPat e - checkPat loc (cs Semi.<> comments la) f [] (p : args) -checkPat loc cs (L l e) [] [] = do + checkPat loc (cs Semi.<> comments la) f (p : args) +checkPat loc cs (L l e) [] = do p <- checkAPat loc e return (L l p, cs) -checkPat loc _ e _ _ = do +checkPat loc _ e _ = do details <- fromParseContext <$> askParseContext patFail (locA loc) (PsErrInPat (unLoc e) details) +mkInvisLPat :: EpToken "@" -> HsTyPat GhcPs -> LPat GhcPs +mkInvisLPat tok ty_pat = L l invis_pat + where + HsTP _ (L (EpAnn anc _ _) _) = ty_pat + l = EpAnn (widenAnchorT anc tok) noAnn emptyComments + invis_pat = InvisPat (tok, SpecifiedSpec) ty_pat + checkAPat :: SrcSpanAnnA -> PatBuilder GhcPs -> PV (Pat GhcPs) checkAPat loc e0 = do nPlusKPatterns <- getBit NPlusKPatternsBit @@ -1374,7 +1472,7 @@ checkPatBind loc lhs' grhss mult checkValDef loc lhs (mult_ann, Nothing) grhss - | HsNoMultAnn{} <- mult_ann + | HsUnannotated{} <- mult_ann = do { mb_fun <- isFunLhs lhs ; case mb_fun of Just (fun, is_infix, pats, ops, cps) -> do @@ -1398,11 +1496,11 @@ -> AnnFunRhs -> LocatedN RdrName -> LexicalFixity - -> LocatedE [LocatedA (ArgPatBuilder GhcPs)] + -> LocatedE [LocatedA (PatBuilder GhcPs)] -> Located (GRHSs GhcPs (LHsExpr GhcPs)) -> P (HsBind GhcPs) checkFunBind locF ann_fun (L lf fun) is_infix (L lp pats) (L _ grhss) - = do ps <- runPV_details extraDetails (mapM checkLArgPat pats) + = do ps <- runPV_details extraDetails (mapM checkLPat pats) let match_span = noAnnSrcSpan $ locF return (makeFunBind (L (l2l lf) fun) (L (noAnnSrcSpan $ locA match_span) [L match_span (Match { m_ext = noExtField @@ -1435,7 +1533,7 @@ -> HsMultAnn GhcPs -> P (HsBind GhcPs) checkPatBind loc (L _ (BangPat an (L _ (VarPat _ v)))) - (L _match_span grhss) (HsNoMultAnn _) + (L _match_span grhss) (HsUnannotated _) = return (makeFunBind v (L (noAnnSrcSpan loc) [L (noAnnSrcSpan loc) (m an v)])) where @@ -1483,20 +1581,18 @@ isFunLhs :: LocatedA (PatBuilder GhcPs) -> P (Maybe (LocatedN RdrName, LexicalFixity, - [LocatedA (ArgPatBuilder GhcPs)],[EpToken "("],[EpToken ")"])) + [LocatedA (PatBuilder GhcPs)],[EpToken "("],[EpToken ")"])) -- A variable binding is parsed as a FunBind. -- Just (fun, is_infix, arg_pats) if e is a function LHS isFunLhs e = go e [] [] [] where - mk = fmap ArgPatBuilderVisPat - go (L l (PatBuilderVar (L loc f))) es ops cps | not (isRdrDataCon f) = do let (_l, loc') = transferCommentsOnlyA l loc return (Just (L loc' f, Prefix, es, (reverse ops), cps)) go (L l (PatBuilderApp (L lf f) e)) es ops cps = do let (_l, lf') = transferCommentsOnlyA l lf - go (L lf' f) (mk e:es) ops cps + go (L lf' f) (e:es) ops cps go (L l (PatBuilderPar _ (L le e) _)) es@(_:_) ops cps = go (L le' e) es (o:ops) (c:cps) -- NB: es@(_:_) means that there must be an arg after the parens for the -- LHS to be a function LHS. This corresponds to the Haskell Report's definition @@ -1507,36 +1603,28 @@ go (L loc (PatBuilderOpApp (L ll l) (L loc' op) r (os,cs))) es ops cps | not (isRdrDataCon op) -- We have found the function! = do { let (_l, ll') = transferCommentsOnlyA loc ll - ; return (Just (L loc' op, Infix, (mk (L ll' l):mk r:es), (os ++ reverse ops), (cs ++ cps))) } + ; return (Just (L loc' op, Infix, ((L ll' l):r:es), (os ++ reverse ops), (cs ++ cps))) } | otherwise -- Infix data con; keep going = do { let (_l, ll') = transferCommentsOnlyA loc ll ; mb_l <- go (L ll' l) es ops cps ; return (reassociate =<< mb_l) } where - reassociate (op', Infix, j : L k_loc (ArgPatBuilderVisPat k) : es', ops', cps') + reassociate (op', Infix, j : L k_loc k : es', ops', cps') = Just (op', Infix, j : op_app : es', ops', cps') where - op_app = mk $ L loc (PatBuilderOpApp (L k_loc k) + op_app = L loc (PatBuilderOpApp (L k_loc k) (L loc' op) r (reverse ops, cps)) reassociate _other = Nothing go (L l (PatBuilderAppType (L lp pat) tok ty_pat@(HsTP _ (L (EpAnn anc ann cs) _)))) es ops cps - = go (L lp' pat) (L (EpAnn anc' ann cs) (ArgPatBuilderArgPat invis_pat) : es) ops cps + = go (L lp' pat) (L (EpAnn anc' ann cs) (PatBuilderPat invis_pat) : es) ops cps where invis_pat = InvisPat (tok, SpecifiedSpec) ty_pat anc' = widenAnchorT anc tok (_l, lp') = transferCommentsOnlyA l lp go _ _ _ _ = return Nothing -data ArgPatBuilder p - = ArgPatBuilderVisPat (PatBuilder p) - | ArgPatBuilderArgPat (Pat p) - -instance Outputable (ArgPatBuilder GhcPs) where - ppr (ArgPatBuilderVisPat p) = ppr p - ppr (ArgPatBuilderArgPat p) = ppr p - mkBangTy :: EpaLocation -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs -mkBangTy tok_loc strictness = - HsBangTy ((noAnn, noAnn, tok_loc), NoSourceText) (HsBang NoSrcUnpack strictness) +mkBangTy tok_loc strictness lty = + XHsType (HsBangTy (noAnn, noAnn, tok_loc) (HsSrcBang NoSourceText NoSrcUnpack strictness) lty) -- | Result of parsing @{-\# UNPACK \#-}@ or @{-\# NOUNPACK \#-}@. data UnpackednessPragma = @@ -1553,11 +1641,11 @@ -- such as ~T or !T, then add the pragma to the existing HsBangTy. -- -- Otherwise, wrap the type in a new HsBangTy constructor. - addUnpackedness (o,c) (L _ (HsBangTy ((_,_,tl), NoSourceText) bang t)) - | HsBang NoSrcUnpack strictness <- bang - = HsBangTy ((o,c,tl), prag) (HsBang unpk strictness) t + addUnpackedness (o,c) (L _ (XHsType (HsBangTy (_,_,tl) bang t))) + | HsSrcBang NoSourceText NoSrcUnpack strictness <- bang + = XHsType (HsBangTy (o,c,tl) (HsSrcBang prag unpk strictness) t) addUnpackedness (o,c) t - = HsBangTy ((o,c,noAnn), prag) (HsBang unpk NoSrcStrict) t + = XHsType (HsBangTy (o,c,noAnn) (HsSrcBang prag unpk NoSrcStrict) t) --------------------------------------------------------------------------- -- | Check for monad comprehensions @@ -1610,12 +1698,12 @@ class DisambInfixOp b where mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b) mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b) - mkHsInfixHolePV :: LocatedN (HsExpr GhcPs) -> PV (LocatedN b) + mkHsInfixHolePV :: LocatedN RdrName -> PV (LocatedN b) instance DisambInfixOp (HsExpr GhcPs) where mkHsVarOpPV v = return $ L (getLoc v) (HsVar noExtField v) mkHsConOpPV v = return $ L (getLoc v) (HsVar noExtField v) - mkHsInfixHolePV h = return h + mkHsInfixHolePV v = return $ L (getLoc v) (HsHole (HoleVar v)) instance DisambInfixOp RdrName where mkHsConOpPV (L l v) = return $ L l v @@ -1643,7 +1731,7 @@ ecpFromExp' :: LHsExpr GhcPs -> PV (LocatedA b) -- | Return a pattern without ambiguity, or fail in a non-pattern context. ecpFromPat' :: LPat GhcPs -> PV (LocatedA b) - mkHsProjUpdatePV :: SrcSpan -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] + mkHsProjUpdatePV :: SrcSpan -> Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) -> LocatedA b -> Bool -> Maybe (EpToken "=") -> PV (LHsRecProj GhcPs (LocatedA b)) -- | Disambiguate "let ... in ..." mkHsLetPV @@ -1728,10 +1816,10 @@ :: SrcSpan -> LocatedA (InfixOp b) -> LocatedA b -> PV (LocatedA b) -- | Disambiguate "(a -> b)" (view pattern or function type arrow) mkHsArrowPV - :: SrcSpan -> ArrowParsingMode lhs b -> LocatedA lhs -> HsArrowOf (LocatedA b) GhcPs -> LocatedA b -> PV (LocatedA b) + :: SrcSpan -> ArrowParsingMode lhs b -> LocatedA lhs -> HsMultAnnOf (LocatedA b) GhcPs -> LocatedA b -> PV (LocatedA b) -- | Disambiguate "%m" to the left of "->" (multiplicity) mkHsMultPV - :: EpToken "%" -> LocatedA b -> PV (TokRarrow -> HsArrowOf (LocatedA b) GhcPs) + :: EpToken "%" -> LocatedA b -> PV (TokRarrow -> HsMultAnnOf (LocatedA b) GhcPs) -- | Disambiguate "forall a. b" and "forall a -> b" (forall telescope) mkHsForallPV :: SrcSpan -> HsForAllTelescope GhcPs -> LocatedA b -> PV (LocatedA b) -- | Disambiguate "(a,b,c)" to the left of "=>" (constraint list) @@ -1849,7 +1937,7 @@ mkHsLitPV (L l a) = cmdFail l (ppr a) mkHsOverLitPV (L l a) = cmdFail (locA l) (ppr a) mkHsWildCardPV l = cmdFail l (text "_") - mkHsTySigPV l a sig _ = cmdFail (locA l) (ppr a <+> text "::" <+> ppr sig) + mkHsTySigPV l a sig _ = cmdFail (locA l) (ppr a <+> dcolon <+> ppr sig) mkHsExplicitListPV l xs _ = cmdFail l $ brackets (pprWithCommas ppr xs) mkHsSplicePV (L l sp) = cmdFail l (pprUntypedSplice True Nothing sp) @@ -1897,11 +1985,11 @@ type Body (HsExpr GhcPs) = HsExpr ecpFromCmd' (L l c) = do addError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInExpr c - return (L l (hsHoleExpr noAnn)) + return (L l parseError) ecpFromExp' = return ecpFromPat' p@(L l _) = do addError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrOrPatInExpr p - return (L l (hsHoleExpr noAnn)) + return (L l parseError) mkHsProjUpdatePV l fields arg isPun anns = do !cs <- getCommentsFor l return $ mkRdrProjUpdate (EpAnn (spanAsAnchor l) noAnn cs) fields arg isPun anns @@ -1950,7 +2038,7 @@ mkHsOverLitPV (L (EpAnn l an csIn) a) = do !cs <- getCommentsFor (locA l) return $ L (EpAnn l an (cs Semi.<> csIn)) (HsOverLit NoExtField a) - mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (hsHoleExpr noAnn) + mkHsWildCardPV l = return $ L (noAnnSrcSpan l) (HsHole (HoleVar (L (noAnnSrcSpan l) (mkUnqual varName (fsLit "_"))))) mkHsTySigPV l@(EpAnn anc an csIn) a sig anns = do !cs <- getCommentsFor (locA l) return $ L (EpAnn anc an (csIn Semi.<> cs)) (ExprWithTySig anns a (hsTypeToHsSigWcType sig)) @@ -1971,11 +2059,11 @@ !cs <- getCommentsFor l return $ L (EpAnn (spanAsAnchor l) noAnn cs) (SectionR noExtField op e) mkHsAsPatPV l v _ e = addError (mkPlainErrorMsgEnvelope l $ PsErrTypeAppWithoutSpace (unLoc v) e) - >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn)) + >> return (L (noAnnSrcSpan l) parseError) mkHsLazyPatPV l e _ = addError (mkPlainErrorMsgEnvelope l $ PsErrLazyPatWithoutSpace e) - >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn)) + >> return (L (noAnnSrcSpan l) parseError) mkHsBangPatPV l e _ = addError (mkPlainErrorMsgEnvelope l $ PsErrBangPatWithoutSpace e) - >> return (L (noAnnSrcSpan l) (hsHoleExpr noAnn)) + >> return (L (noAnnSrcSpan l) parseError) mkSumOrTuplePV = mkSumOrTupleExpr mkHsEmbTyPV l toktype ty = return $ L (noAnnSrcSpan l) $ @@ -2002,9 +2090,6 @@ (PsErrUnallowedPragma prag) rejectPragmaPV _ = return () -hsHoleExpr :: Maybe EpAnnUnboundVar -> HsExpr GhcPs -hsHoleExpr anns = HsUnboundVar anns (mkRdrUnqual (mkVarOccFS (fsLit "_"))) - instance DisambECP (PatBuilder GhcPs) where type Body (PatBuilder GhcPs) = PatBuilder ecpFromCmd' (L l c) = addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrArrowCmdInPat c @@ -2071,10 +2156,10 @@ where tok :: TokRarrow tok = case arr of - HsUnrestrictedArrow x -> x + HsUnannotated (EpArrow x) -> x _ -> -- unreachable case because in Parser.y the reduction rules for -- (a %m -> b) and (a ->. b) use ArrowIsFunType - panic "mkHsArrowPV ArrowIsViewPat: expected HsUnrestrictedArrow" + panic "mkHsArrowPV ArrowIsViewPat: expected HsUnannotated" mkHsArrowPV l ArrowIsFunType a arr b = patFail l (PsErrTypeSyntaxInPat (PETS_FunctionArrow a arr b)) mkHsMultPV tok arg = @@ -2331,16 +2416,16 @@ -- Detect when the record syntax is used: -- data T = MkT { ... } dataConBuilderDetails (L _ (PrefixDataConBuilder flds _)) - | [L (EpAnn anc _ cs) (HsRecTy an fields)] <- toList flds + | [L (EpAnn anc _ cs) (XHsType (HsRecTy an fields))] <- toList flds = RecCon (L (EpAnn anc an cs) fields) -- Normal prefix constructor, e.g. data T = MkT A B C dataConBuilderDetails (L _ (PrefixDataConBuilder flds _)) - = PrefixCon noTypeArgs (map hsLinear (toList flds)) + = PrefixCon (map hsPlainTypeField (toList flds)) -- Infix constructor, e.g. data T = Int :! Bool dataConBuilderDetails (L (EpAnn _ _ csl) (InfixDataConBuilder (L (EpAnn anc ann csll) lhs) _ rhs)) - = InfixCon (hsLinear (L (EpAnn anc ann (csl Semi.<> csll)) lhs)) (hsLinear rhs) + = InfixCon (hsPlainTypeField (L (EpAnn anc ann (csl Semi.<> csll)) lhs)) (hsPlainTypeField rhs) instance DisambTD DataConBuilder where @@ -2367,7 +2452,7 @@ return $ L (addCommentsToEpAnn l cs) (InfixDataConBuilder lhs data_con rhs) where l = combineLocsA lhs rhs - check_no_ops (HsBangTy _ _ t) = check_no_ops (unLoc t) + check_no_ops (XHsType (HsBangTy _ _ t)) = check_no_ops (unLoc t) check_no_ops (HsOpTy{}) = addError $ mkPlainErrorMsgEnvelope (locA l) $ (PsErrInvalidInfixDataCon (unLoc lhs) (unLoc tc) (unLoc rhs)) @@ -2408,7 +2493,7 @@ mkUnboxedSumCon :: LHsType GhcPs -> ConTag -> Arity -> (LocatedN RdrName, HsConDeclH98Details GhcPs) mkUnboxedSumCon t tag arity = - (noLocA (getRdrName (sumDataCon tag arity)), PrefixCon noTypeArgs [hsLinear t]) + (noLocA (getRdrName (sumDataCon tag arity)), PrefixCon [hsPlainTypeField t]) {- Note [Ambiguous syntactic categories] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2934,7 +3019,7 @@ let f = occNameFS . rdrNameOcc $ rdr fl = DotFieldOcc noAnn (L loc (FieldLabelString f)) lf = locA loc - in mkRdrProjUpdate l (L lf [L (l2l loc) fl]) (punnedVar f) pun anns + in mkRdrProjUpdate l (L lf (L (l2l loc) fl :| [])) (punnedVar f) pun anns where -- If punning, compute HsVar "f" otherwise just arg. This -- has the effect that sentinel HsVar "pun-rhs" is replaced @@ -3157,8 +3242,7 @@ | ImpExpList [LocatedA ImpExpQcSpec] | ImpExpAllWith [LocatedA ImpExpQcSpec] -data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName) - | ImpExpQcType (EpToken "type") (LocatedN RdrName) +data ImpExpQcSpec = ImpExpQcName (Maybe ExplicitNamespaceKeyword) (LocatedN RdrName) | ImpExpQcWildcard (EpToken "..") (EpToken ",") mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec @@ -3202,23 +3286,38 @@ (PsErrVarForTyCon name) else return $ ieNameFromSpec specname - ieNameVal (ImpExpQcName ln) = unLoc ln - ieNameVal (ImpExpQcType _ ln) = unLoc ln + ieNameVal (ImpExpQcName _ ln) = unLoc ln ieNameVal ImpExpQcWildcard{} = panic "ieNameVal got wildcard" ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs - ieNameFromSpec (ImpExpQcName (L l n)) = IEName noExtField (L l n) - ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n) - ieNameFromSpec ImpExpQcWildcard{} = panic "ieName got wildcard" + ieNameFromSpec (ImpExpQcName m_kw name) = case m_kw of + Nothing -> IEName noExtField name + Just (ExplicitTypeNamespace tok) -> IEType tok name + Just (ExplicitDataNamespace tok) -> IEData tok name + ieNameFromSpec ImpExpQcWildcard{} = panic "ieNameFromSpec got wildcard" wrapped = map (fmap ieNameFromSpec) -mkTypeImpExp :: LocatedN RdrName -- TcCls or Var name space - -> P (LocatedN RdrName) -mkTypeImpExp name = - do requireExplicitNamespaces (getLocA name) - return (fmap (`setRdrNameSpace` tcClsName) name) +mkPlainImpExp :: LocatedN RdrName -> ImpExpQcSpec +mkPlainImpExp name = ImpExpQcName Nothing name +mkTypeImpExp :: EpToken "type" + -> LocatedN RdrName -- TcCls or Var name space + -> P ImpExpQcSpec +mkTypeImpExp tok name = do + let name' = fmap (`setRdrNameSpace` tcClsName) name + ns_kw = ExplicitTypeNamespace tok + requireExplicitNamespaces ns_kw + return (ImpExpQcName (Just ns_kw) name') + +mkDataImpExp :: EpToken "data" + -> LocatedN RdrName + -> P ImpExpQcSpec +mkDataImpExp tok name = do + let ns_kw = ExplicitDataNamespace tok + requireExplicitNamespaces ns_kw + return (ImpExpQcName (Just ns_kw) name) + checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs]) checkImportSpec ie@(L _ specs) = case [l | (L l (IEThingWith _ _ (IEWildcard _) _ _)) <- specs] of @@ -3257,6 +3356,14 @@ failImportQualifiedTwice loc = addError $ mkPlainErrorMsgEnvelope loc $ PsErrImportQualifiedTwice +failSpliceOrQuoteTwice :: EpAnnLevel -> P () +failSpliceOrQuoteTwice lvl = + addError $ mkPlainErrorMsgEnvelope loc $ PsErrSpliceOrQuoteTwice + where + loc = case lvl of + EpAnnLevelSplice tok -> getEpTokenSrcSpan tok + EpAnnLevelQuote tok -> getEpTokenSrcSpan tok + warnStarIsType :: SrcSpan -> P () warnStarIsType span = addPsMessage span PsWarnStarIsType @@ -3267,12 +3374,21 @@ ; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrOpFewArgs is_star_type op) } -requireExplicitNamespaces :: MonadP m => SrcSpan -> m () -requireExplicitNamespaces l = do +requireExplicitNamespaces :: MonadP m => ExplicitNamespaceKeyword -> m () +requireExplicitNamespaces kw = do allowed <- getBit ExplicitNamespacesBit unless allowed $ - addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace + addError $ mkPlainErrorMsgEnvelope loc $ PsErrIllegalExplicitNamespace kw + where + loc = case kw of + ExplicitTypeNamespace tok -> getEpTokenSrcSpan tok + ExplicitDataNamespace tok -> getEpTokenSrcSpan tok +warnPatternNamespaceSpecifier :: MonadP m => SrcSpan -> m () +warnPatternNamespaceSpecifier l = do + explicit_namespaces <- getBit ExplicitNamespacesBit + addPsMessage l (PsWarnPatternNamespaceSpecifier explicit_namespaces) + ----------------------------------------------------------------------------- -- Misc utils @@ -3488,39 +3604,28 @@ let loc = locA x `combineSrcSpans` locA op `combineSrcSpans` locA y in L (noAnnSrcSpan loc) (mkHsOpTy prom x op y) -mkMultTy :: EpToken "%" -> LHsType GhcPs -> TokRarrow -> HsArrow GhcPs -mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1))) arr - -- See #18888 for the use of (SourceText "1") above - = HsLinearArrow (EpPct1 pct1 arr) - where - -- The location of "%" combined with the location of "1". - pct1 :: EpToken "%1" - pct1 = epTokenWidenR pct (locA (getLoc t)) -mkMultTy pct t arr = HsExplicitMult (pct, arr) t - -mkMultExpr :: EpToken "%" -> LHsExpr GhcPs -> TokRarrow -> HsArrowOf (LHsExpr GhcPs) GhcPs +mkMultExpr :: EpToken "%" -> LHsExpr GhcPs -> TokRarrow -> HsMultAnnOf (LHsExpr GhcPs) GhcPs mkMultExpr pct t@(L _ (HsOverLit _ (OverLit _ (HsIntegral (IL (SourceText (unpackFS -> "1")) _ 1))))) arr -- See #18888 for the use of (SourceText "1") above - = HsLinearArrow (EpPct1 pct1 arr) + = HsLinearAnn (EpPct1 pct1 (EpArrow arr)) where -- The location of "%" combined with the location of "1". pct1 :: EpToken "%1" pct1 = epTokenWidenR pct (locA (getLoc t)) -mkMultExpr pct t arr = HsExplicitMult (pct, arr) t +mkMultExpr pct t arr = HsExplicitMult (pct, EpArrow arr) t -mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs -mkMultAnn pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1))) +mkMultAnn :: EpToken "%" -> LHsType GhcPs -> EpArrowOrColon -> HsMultAnn GhcPs +mkMultAnn pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1))) ep -- See #18888 for the use of (SourceText "1") above - = HsPct1Ann pct1 + = HsLinearAnn (EpPct1 pct1 ep) where -- The location of "%" combined with the location of "1". pct1 :: EpToken "%1" pct1 = epTokenWidenR pct (locA (getLoc t)) -mkMultAnn pct t = HsMultAnn pct t +mkMultAnn pct t ep = HsExplicitMult (pct, ep) t -mkTokenLocation :: SrcSpan -> TokenLocation -mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc -mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan (RealSrcSpan r mb)) +mkMultField :: EpToken "%" -> LHsType GhcPs -> TokDcolon -> LHsType GhcPs -> HsConDeclField GhcPs +mkMultField pct mult col t = mkConDeclField (mkMultAnn pct mult (EpColon col)) t -- Precondition: the EpToken has EpaSpan, never EpaDelta. epTokenWidenR :: EpToken tok -> SrcSpan -> EpToken tok' @@ -3557,10 +3662,9 @@ , proj_flds = fmap unLoc flds } -mkRdrProjUpdate :: SrcSpanAnnA -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] +mkRdrProjUpdate :: SrcSpanAnnA -> Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) -> LHsExpr GhcPs -> Bool -> Maybe (EpToken "=") -> LHsRecProj GhcPs (LHsExpr GhcPs) -mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!" mkRdrProjUpdate loc (L l flds) arg isPun anns = L loc HsFieldBind { hfbAnn = anns @@ -3678,3 +3782,6 @@ annsKeyword = (NoEpTok, brkOpen, brkClose) annParen = AnnParensSquare brkOpen brkClose + +parseError :: HsExpr GhcPs +parseError = HsHole HoleError diff --git a/GHC/Parser/PostProcess/Haddock.hs b/GHC/Parser/PostProcess/Haddock.hs --- a/GHC/Parser/PostProcess/Haddock.hs +++ b/GHC/Parser/PostProcess/Haddock.hs @@ -59,7 +59,6 @@ import Data.Traversable import qualified Data.List.NonEmpty as NE import Control.Applicative -import Control.Monad import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import Data.Functor.Identity @@ -215,9 +214,8 @@ -- But having a single name for all of them is just easier to read, and makes it clear -- that they all are of the form t -> HdkA t for some t. -- --- If you need to handle a more complicated scenario that doesn't fit this --- pattern, it's always possible to define separate functions outside of this --- class, as is done in case of e.g. addHaddockConDeclField. +-- If you need to handle a more complicated scenario that doesn't fit this pattern, +-- it's always possible to define separate functions outside of this class. -- -- See Note [Adding Haddock comments to the syntax tree]. class HasHaddock a where @@ -238,6 +236,8 @@ -- instance HasHaddock (Located (HsModule GhcPs)) where addHaddock (L l_mod mod) = do + let mod_anns = anns (hsmodAnn (hsmodExt mod)) + -- Step 1, get the module header documentation comment: -- -- -- | Module header comment @@ -245,14 +245,19 @@ -- -- Only do this when the module header exists. headerDocs <- - for @Maybe (hsmodName mod) $ \(L l_name _) -> - extendHdkA (locA l_name) $ liftHdkA $ do - -- todo: register keyword location of 'module', see Note [Register keyword location] - docs <- - inLocRange (locRangeTo (getBufPos (srcSpanStart (locA l_name)))) $ - takeHdkComments mkDocNext - dc <- selectDocString docs - pure $ lexLHsDocString <$> dc + case hsmodName mod of + Nothing -> pure Nothing + Just (L l_name _) -> do + let modspan = + getEpTokenBufSpan (am_mod mod_anns) <> + getEpTokenBufSpan (am_sig mod_anns) <> + getBufSpan (locA l_name) + HdkA modspan $ do + docs <- + inLocRange (locRangeTo (fmap bufSpanStart modspan)) $ + takeHdkComments mkDocNext + dc <- selectDocString docs + pure $ lexLHsDocString <$> dc -- Step 2, process documentation comments in the export list: -- @@ -290,7 +295,7 @@ pure $ L l_mod $ mod { hsmodExports = hsmodExports' , hsmodDecls = hsmodDecls' - , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = join @Maybe headerDocs } } + , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = headerDocs } } lexHsDocString :: HsDocString -> HsDoc GhcPs lexHsDocString = lexHsDoc parseIdentifier @@ -510,7 +515,7 @@ tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl = do registerHdkA tcdLName - -- todo: register keyword location of 'where', see Note [Register keyword location] + registerEpTokenHdkA (acd_where x) where_cls' <- addHaddockInterleaveItems layout (mkDocHsDecl layout) $ flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], []) @@ -555,7 +560,6 @@ | SynDecl { tcdSExt, tcdLName, tcdTyVars, tcdFixity, tcdRhs } <- decl = do registerHdkA tcdLName - -- todo: register keyword location of '=', see Note [Register keyword location] tcdRhs' <- addHaddock tcdRhs pure $ TyClD noExtField (SynDecl { @@ -585,7 +589,7 @@ -- data D :: Type -> Type where ... -- data instance D Bool :: Type where ... traverse_ @Maybe registerHdkA (dd_kindSig defn) - -- todo: register keyword location of '=' or 'where', see Note [Register keyword location] + registerEpTokenHdkA (andd_where (dd_ext defn)) -- Process the data constructors: -- @@ -705,17 +709,19 @@ addHaddock (L l_con_decl con_decl) = extendHdkA (locA l_con_decl) $ case con_decl of - ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do + ConDeclGADT { con_g_ext, con_names, con_outer_bndrs, con_inner_bndrs + , con_mb_cxt, con_g_args, con_res_ty } -> do con_doc' <- getConDoc (getLocA (NE.head con_names)) con_g_args' <- case con_g_args of PrefixConGADT x ts -> PrefixConGADT x <$> addHaddock ts RecConGADT arr (L l_rec flds) -> do - flds' <- traverse addHaddockConDeclField flds + flds' <- traverse addHaddock flds pure $ RecConGADT arr (L l_rec flds') con_res_ty' <- addHaddock con_res_ty pure $ L l_con_decl $ - ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, + ConDeclGADT { con_g_ext, con_names, + con_outer_bndrs, con_inner_bndrs, con_mb_cxt, con_doc = lexLHsDocString <$> con_doc', con_g_args = con_g_args', con_res_ty = con_res_ty' } @@ -733,24 +739,24 @@ getMixed :: HdkA (LocatedA (ConDecl GhcPs)) getMixed = case con_args of - PrefixCon _ ts -> do + PrefixCon ts -> do con_doc' <- getConDoc (getLocA con_name) - ts' <- traverse addHaddockConDeclFieldTy ts + ts' <- traverse addHaddock ts pure $ L l_con_decl $ ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_doc = lexLHsDocString <$> con_doc', - con_args = PrefixCon noTypeArgs ts' } + con_args = PrefixCon ts' } InfixCon t1 t2 -> do - t1' <- addHaddockConDeclFieldTy t1 + t1' <- addHaddock t1 con_doc' <- getConDoc (getLocA con_name) - t2' <- addHaddockConDeclFieldTy t2 + t2' <- addHaddock t2 pure $ L l_con_decl $ ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_doc = lexLHsDocString <$> con_doc', con_args = InfixCon t1' t2' } RecCon (L l_rec flds) -> do con_doc' <- getConDoc (getLocA con_name) - flds' <- traverse addHaddockConDeclField flds + flds' <- traverse addHaddock flds pure $ L l_con_decl $ ConDeclH98 { con_ext, con_name, con_forall, con_ex_tvs, con_mb_cxt, con_doc = lexLHsDocString <$> con_doc', @@ -785,25 +791,11 @@ -> HdkA (Maybe (Located HsDocString)) getConDoc l = extendHdkA l $ liftHdkA $ getPrevNextDoc l --- Add documentation comment to a data constructor field. --- Used for PrefixCon and InfixCon. -addHaddockConDeclFieldTy - :: HsScaled GhcPs (LHsType GhcPs) - -> HdkA (HsScaled GhcPs (LHsType GhcPs)) -addHaddockConDeclFieldTy (HsScaled mult (L l t)) = - extendHdkA (locA l) $ liftHdkA $ do - mDoc <- getPrevNextDoc (locA l) - return (HsScaled mult (mkLHsDocTy (L l t) mDoc)) - --- Add documentation comment to a data constructor field. --- Used for RecCon. -addHaddockConDeclField - :: LConDeclField GhcPs - -> HdkA (LConDeclField GhcPs) -addHaddockConDeclField (L l_fld fld) = - extendHdkA (locA l_fld) $ liftHdkA $ do - cd_fld_doc <- fmap lexLHsDocString <$> getPrevNextDoc (locA l_fld) - return (L l_fld (fld { cd_fld_doc })) +instance HasHaddock (LocatedA (HsConDeclRecField GhcPs)) where + addHaddock (L l_fld (HsConDeclRecField ext nms cfs)) = + extendHdkA (locA l_fld) $ liftHdkA $ do + cdf_doc <- fmap lexLHsDocString <$> getPrevNextDoc (locA l_fld) + return $ L l_fld (HsConDeclRecField ext nms (cfs { cdf_doc })) {- Note [Leading and trailing comments on H98 constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -906,8 +898,12 @@ including its field types -} -instance HasHaddock a => HasHaddock (HsScaled GhcPs a) where - addHaddock (HsScaled mult a) = HsScaled mult <$> addHaddock a +instance HasHaddock (HsConDeclField GhcPs) where + addHaddock cfs = do + cdf_type <- addHaddock (cdf_type cfs) + return $ case cdf_type of + L _ (HsDocTy _ ty doc) -> cfs { cdf_type = ty, cdf_doc = Just doc } + _ -> cfs { cdf_type } instance HasHaddock a => HasHaddock (HsWildCardBndrs GhcPs a) where addHaddock (HsWC _ t) = HsWC noExtField <$> addHaddock t @@ -1130,6 +1126,13 @@ -- See Note [Adding Haddock comments to the syntax tree]. registerHdkA :: GenLocated (EpAnn a) e -> HdkA () registerHdkA a = registerLocHdkA (getLocA a) + +-- Let the neighbours know about a token at this location. +-- Similar to registerLocHdkA and registerHdkA. +-- +-- See Note [Adding Haddock comments to the syntax tree]. +registerEpTokenHdkA :: EpToken tok -> HdkA () +registerEpTokenHdkA tok = HdkA (getEpTokenBufSpan tok) (pure ()) -- Modify the action of a HdkA computation. hoistHdkA :: (HdkM a -> HdkM b) -> HdkA a -> HdkA b diff --git a/GHC/Parser/Types.hs b/GHC/Parser/Types.hs --- a/GHC/Parser/Types.hs +++ b/GHC/Parser/Types.hs @@ -8,6 +8,7 @@ , pprSumOrTuple , PatBuilder(..) , DataConBuilder(..) + , ExplicitNamespaceKeyword(..) ) where @@ -111,3 +112,7 @@ ppr lhs <+> ppr data_con <+> ppr rhs type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW + +data ExplicitNamespaceKeyword + = ExplicitTypeNamespace !(EpToken "type") + | ExplicitDataNamespace !(EpToken "data") diff --git a/GHC/Platform.hs b/GHC/Platform.hs --- a/GHC/Platform.hs +++ b/GHC/Platform.hs @@ -269,6 +269,7 @@ = SSE1 | SSE2 | SSE3 + | SSSE3 | SSE4 | SSE42 deriving (Eq, Ord) diff --git a/GHC/Platform/LA64.hs b/GHC/Platform/LA64.hs new file mode 100644 --- /dev/null +++ b/GHC/Platform/LA64.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module GHC.Platform.LA64 where + +import GHC.Prelude + +#define MACHREGS_NO_REGS 0 +#define MACHREGS_loongarch64 1 +#include "CodeGen.Platform.h" diff --git a/GHC/Platform/LoongArch64.hs b/GHC/Platform/LoongArch64.hs deleted file mode 100644 --- a/GHC/Platform/LoongArch64.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE CPP #-} - -module GHC.Platform.LoongArch64 where - -import GHC.Prelude - -#define MACHREGS_NO_REGS 0 -#define MACHREGS_loongarch64 1 -#include "CodeGen.Platform.h" diff --git a/GHC/Platform/Regs.hs b/GHC/Platform/Regs.hs --- a/GHC/Platform/Regs.hs +++ b/GHC/Platform/Regs.hs @@ -16,7 +16,7 @@ import qualified GHC.Platform.X86_64 as X86_64 import qualified GHC.Platform.RISCV64 as RISCV64 import qualified GHC.Platform.Wasm32 as Wasm32 -import qualified GHC.Platform.LoongArch64 as LoongArch64 +import qualified GHC.Platform.LA64 as LA64 import qualified GHC.Platform.NoRegs as NoRegs -- | Returns 'True' if this global register is stored in a caller-saves @@ -34,7 +34,7 @@ ArchAArch64 -> AArch64.callerSaves ArchRISCV64 -> RISCV64.callerSaves ArchWasm32 -> Wasm32.callerSaves - ArchLoongArch64 -> LoongArch64.callerSaves + ArchLoongArch64 -> LA64.callerSaves arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.callerSaves @@ -58,7 +58,7 @@ ArchAArch64 -> AArch64.activeStgRegs ArchRISCV64 -> RISCV64.activeStgRegs ArchWasm32 -> Wasm32.activeStgRegs - ArchLoongArch64 -> LoongArch64.activeStgRegs + ArchLoongArch64 -> LA64.activeStgRegs arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.activeStgRegs @@ -77,7 +77,7 @@ ArchAArch64 -> AArch64.haveRegBase ArchRISCV64 -> RISCV64.haveRegBase ArchWasm32 -> Wasm32.haveRegBase - ArchLoongArch64 -> LoongArch64.haveRegBase + ArchLoongArch64 -> LA64.haveRegBase arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.haveRegBase @@ -96,7 +96,7 @@ ArchAArch64 -> AArch64.globalRegMaybe ArchRISCV64 -> RISCV64.globalRegMaybe ArchWasm32 -> Wasm32.globalRegMaybe - ArchLoongArch64 -> LoongArch64.globalRegMaybe + ArchLoongArch64 -> LA64.globalRegMaybe arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.globalRegMaybe @@ -112,10 +112,21 @@ ArchX86_64 -> X86_64.freeReg ArchS390X -> S390X.freeReg ArchARM {} -> ARM.freeReg - ArchAArch64 -> AArch64.freeReg + ArchAArch64 -> + -- See Note [Aarch64 Register x18 at Darwin and Windows]. + -- It already has `freeReg 18 = False` but that line does not work for cross-compile when + -- we use host not from the list (darwin_HOST_OS, ios_HOST_OS, mingw32_HOST_OS) i.e. Linux + if platformOS platform == OSMinGW32 || platformOS platform == OSDarwin + then + let + x18Check :: RegNo -> Bool + x18Check 18 = False + x18Check a = AArch64.freeReg a + in x18Check + else AArch64.freeReg ArchRISCV64 -> RISCV64.freeReg ArchWasm32 -> Wasm32.freeReg - ArchLoongArch64 -> LoongArch64.freeReg + ArchLoongArch64 -> LA64.freeReg arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.freeReg diff --git a/GHC/Platform/Ways.hs b/GHC/Platform/Ways.hs --- a/GHC/Platform/Ways.hs +++ b/GHC/Platform/Ways.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} -- | Ways -- @@ -220,8 +219,6 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamic_ :: Int --- we need this until the bootstrap GHC is always recent enough -#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) -- | Consult the RTS to find whether it is threaded. hostIsThreaded :: Bool @@ -242,18 +239,6 @@ foreign import ccall unsafe "rts_isTracing" rtsIsTracing_ :: Int -#else - -hostIsThreaded :: Bool -hostIsThreaded = False - -hostIsDebugged :: Bool -hostIsDebugged = False - -hostIsTracing :: Bool -hostIsTracing = False - -#endif -- | Host ways. diff --git a/GHC/Plugins.hs b/GHC/Plugins.hs --- a/GHC/Plugins.hs +++ b/GHC/Plugins.hs @@ -202,7 +202,8 @@ -- ensures everything in that session will get the same name cache. thNameToGhcNameIO :: NameCache -> TH.Name -> IO (Maybe Name) thNameToGhcNameIO cache th_name - = do { names <- mapMaybeM lookup (thRdrNameGuesses th_name) + = do { let listTuplePuns = True -- conservative assumption + ; names <- mapMaybeM lookup (thRdrNameGuesses listTuplePuns th_name) -- Pick the first that works -- E.g. reify (mkName "A") will pick the class A in preference -- to the data constructor A diff --git a/GHC/Prelude/Basic.hs b/GHC/Prelude/Basic.hs --- a/GHC/Prelude/Basic.hs +++ b/GHC/Prelude/Basic.hs @@ -24,7 +24,9 @@ , bit , shiftL, shiftR , setBit, clearBit - , head, tail + , head, tail, unzip + + , strictGenericLength ) where @@ -57,24 +59,19 @@ -} import qualified Prelude -import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail) +import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip) import Control.Applicative (Applicative(..)) -import Data.Foldable as X (Foldable(elem, foldMap, foldr, foldl, foldl', foldr1, foldl1, maximum, minimum, product, sum, null, length)) +import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum)) +import Data.Foldable1 as X hiding (head, last) +import qualified Data.List as List +import qualified GHC.Data.List.NonEmpty as NE import GHC.Stack.Types (HasCallStack) -#if MIN_VERSION_base(4,16,0) import GHC.Bits as Bits hiding (bit, shiftL, shiftR, setBit, clearBit) # if defined(DEBUG) import qualified GHC.Bits as Bits (shiftL, shiftR) # endif -#else ---base <4.15 -import Data.Bits as Bits hiding (bit, shiftL, shiftR, setBit, clearBit) -# if defined(DEBUG) -import qualified Data.Bits as Bits (shiftL, shiftR) -# endif -#endif {- Note [Default to unsafe shifts inside GHC] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -138,3 +135,22 @@ tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-} + +{- | +The 'genericLength' function defined in base can't be specialised due to the +NOINLINE pragma. + +It is also not strict in the accumulator, and strictGenericLength is not exported. + +See #25706 for why it is important to use a strict, specialised version. + +-} +strictGenericLength :: Num a => [x] -> a +strictGenericLength = fromIntegral . length + +-- This is `Data.Functor.unzip`. Unfortunately, that function lacks the RULES for specialization. +unzip :: Functor f => f (a, b) -> (f a, f b) +unzip = \ xs -> (fmap fst xs, fmap snd xs) +{-# NOINLINE [1] unzip #-} +{-# RULES "unzip/List" unzip = List.unzip #-} +{-# RULES "unzip/NonEmpty" unzip = NE.unzip #-} diff --git a/GHC/Rename/Bind.hs b/GHC/Rename/Bind.hs --- a/GHC/Rename/Bind.hs +++ b/GHC/Rename/Bind.hs @@ -1,8 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -22,7 +20,7 @@ rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS, -- Other bindings - rnMethodBinds, renameSigs, + rnMethodBinds, renameSigs, bindRuleBndrs, rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl, makeMiniFixityEnv, MiniFixityEnv, emptyMiniFixityEnv, HsSigCtxt(..), @@ -46,32 +44,37 @@ import GHC.Rename.Names import GHC.Rename.Env import GHC.Rename.Fixity -import GHC.Rename.Utils ( mapFvRn - , checkDupRdrNames - , warnUnusedLocalBinds - , checkUnusedRecordWildcard - , checkDupAndShadowedNames, bindLocalNamesFV - , addNoNestedForallsContextsErr, checkInferredVars ) +import GHC.Rename.Utils import GHC.Driver.DynFlags -import GHC.Unit.Module + +import GHC.Data.BooleanFormula ( bfTraverse ) +import GHC.Data.Graph.Directed ( SCC(..) ) +import GHC.Data.Maybe ( orElse, mapMaybe ) +import GHC.Data.OrdList +import GHC.Data.List.SetOps ( findDupsEq ) + + import GHC.Types.Error import GHC.Types.FieldLabel import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set -import GHC.Types.Name.Reader ( RdrName, rdrNameOcc ) +import GHC.Types.Name.Reader import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc -import GHC.Data.List.SetOps ( findDupsEq ) import GHC.Types.Basic ( RecFlag(..), TypeOrKind(..) ) -import GHC.Data.Graph.Directed ( SCC(..) ) + +import GHC.Types.CompleteMatch +import GHC.Types.Hint ( SigLike(..) ) +import GHC.Types.Unique.DSet ( mkUniqDSet ) +import GHC.Types.Unique.Set + +import GHC.Unit.Module + import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Types.CompleteMatch -import GHC.Types.Unique.Set -import GHC.Data.Maybe ( orElse, mapMaybe ) -import GHC.Data.OrdList + import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) @@ -79,7 +82,6 @@ import Control.Monad import Data.List ( partition ) import Data.List.NonEmpty ( NonEmpty(..) ) -import GHC.Types.Unique.DSet (mkUniqDSet) {- -- ToDo: Put the annotations into the monad, so that they arrive in the proper @@ -336,7 +338,8 @@ -- Update the TcGblEnv with renamed COMPLETE pragmas from the current -- module, for pattern irrefutability checking in do notation. ; let localCompletePrags = localCompletePragmas sigs' - ; updGblEnv (\gblEnv -> gblEnv { tcg_complete_matches = tcg_complete_matches gblEnv ++ localCompletePrags}) $ + ; updGblEnv (\gblEnv -> gblEnv { tcg_complete_matches = tcg_complete_matches gblEnv ++ localCompletePrags + , tcg_complete_match_env = tcg_complete_match_env gblEnv ++ localCompletePrags }) $ do { binds_w_dus <- mapM (rnLBind (mkScopedTvFn sigs')) mbinds ; let !(anal_binds, anal_dus) = depAnalBinds binds_w_dus @@ -454,7 +457,7 @@ = do -- we don't actually use the FV processing of rnPatsAndThen here (pat',pat'_fvs) <- rnBindPat name_maker pat - (pat_mult', mult'_fvs) <- rnHsMultAnn pat_mult + (pat_mult', mult'_fvs) <- rnHsMultAnnWith (rnLHsType PatCtx) pat_mult return (bind { pat_lhs = pat', pat_ext = pat'_fvs `plusFV` mult'_fvs, pat_mult = pat_mult' }) -- We temporarily store the pat's FVs in bind_fvs; -- gets updated to the FVs of the whole bind @@ -469,7 +472,7 @@ | isTopRecNameMaker name_maker = do { addLocM checkConName rdrname ; name <- - lookupLocatedTopConstructorRnN rdrname -- Should be in scope already + lookupLocatedTopBndrRnN WL_ConLike rdrname -- Should be in scope already ; return (PatSynBind x psb{ psb_ext = noAnn, psb_id = name }) } | otherwise -- Pattern synonym, not at top level @@ -741,16 +744,6 @@ DataNamespaceSpecifier{} -> env { mfe_data_level_names = (extendFsEnv mfe_data_level_names fs fix_item)} - --- | Multiplicity annotations are a simple wrapper around types. As such, --- renaming them is a straightforward wrapper around 'rnLHsType'. -rnHsMultAnn :: HsMultAnn GhcPs -> RnM (HsMultAnn GhcRn, FreeVars) -rnHsMultAnn (HsNoMultAnn _) = return (HsNoMultAnn noExtField, emptyFVs) -rnHsMultAnn (HsPct1Ann _) = return (HsPct1Ann noExtField, emptyFVs) -rnHsMultAnn (HsMultAnn _ p) = do - (p', freeVars') <- rnLHsType PatCtx p - return $ (HsMultAnn noExtField p', freeVars') - {- ********************************************************************* * * Pattern synonym bindings @@ -775,10 +768,10 @@ -- so that the binding locations are reported -- from the left-hand side case details of - PrefixCon _ vars -> + PrefixCon vars -> do { checkDupRdrNames vars ; names <- mapM lookupPatSynBndr vars - ; return ( (pat', PrefixCon noTypeArgs names) + ; return ( (pat', PrefixCon names) , mkFVs (map unLoc names)) } InfixCon var1 var2 -> do { checkDupRdrNames [var1, var2] @@ -789,7 +782,7 @@ , mkFVs (map unLoc [name1, name2])) } RecCon vars -> do { checkDupRdrNames (map (foLabel . recordPatSynField) vars) - ; fls <- lookupConstructorFields name + ; fls <- lookupConstructorFields $ noUserRdr name ; let fld_env = mkFsEnv [ (field_label $ flLabel fl, fl) | fl <- fls ] ; let rnRecordPatSynField (RecordPatSynField { recordPatSynField = visible @@ -955,7 +948,8 @@ ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds') sig_ctxt | is_cls_decl = ClsDeclCtxt cls - | otherwise = InstDeclCtxt bound_nms + | otherwise = InstDeclCtxt (mkOccEnv [ (nameOccName n, n) + | n <- nonDetEltsUniqSet bound_nms ]) ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $ renameSigs sig_ctxt other_sigs @@ -963,7 +957,8 @@ -- Update the TcGblEnv with renamed COMPLETE pragmas from the current -- module, for pattern irrefutability checking in do notation. - ; updGblEnv (\gblEnv -> gblEnv { tcg_complete_matches = tcg_complete_matches gblEnv ++ localCompletePrags}) $ + ; updGblEnv (\gblEnv -> gblEnv { tcg_complete_matches = tcg_complete_matches gblEnv ++ localCompletePrags + , tcg_complete_match_env = tcg_complete_match_env gblEnv ++ localCompletePrags}) $ do { -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. @@ -1022,7 +1017,7 @@ -> RnM (LHsBindsLR GhcRn GhcPs) rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest = setSrcSpanA loc $ do - do { sel_name <- wrapLocMA (lookupInstDeclBndr cls (text "method")) name + do { sel_name <- wrapLocMA (lookupInstDeclBndr cls MethodOfClass) name -- We use the selector name as the binder ; let bind' = bind { fun_id = sel_name, fun_ext = noExtField } ; return (L loc bind' : rest ) } @@ -1070,19 +1065,10 @@ ; return (good_sigs, sig_fvs) } ---------------------- --- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory --- because this won't work for: --- instance Foo T where --- {-# INLINE op #-} --- Baz.op = ... --- We'll just rename the INLINE prag to refer to whatever other 'op' --- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.) --- Doesn't seem worth much trouble to sort this. - renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars) renameSig ctxt sig@(TypeSig _ vs ty) - = do { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs - ; let doc = TypeSigCtx (ppr_sig_bndrs vs) + = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs + ; let doc = TypeSigCtx vs ; (new_ty, fvs) <- rnHsSigWcType doc ty ; return (TypeSig noAnn new_vs new_ty, fvs) } @@ -1090,13 +1076,12 @@ = do { defaultSigs_on <- xoptM LangExt.DefaultSignatures ; when (is_deflt && not defaultSigs_on) $ addErr (TcRnUnexpectedDefaultSig sig) - ; new_v <- mapM (lookupSigOccRnN ctxt sig) vs + ; new_v <- mapM (lookupSigOccRn ctxt sig) vs ; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty ; return (ClassOpSig noAnn is_deflt new_v new_ty, fvs) } where - (v1:_) = vs - ty_ctxt = GenericCtx (text "a class method signature for" - <+> quotes (ppr v1)) + v1:|_ = expectNonEmpty vs + ty_ctxt = ClassMethodSigCtx v1 renameSig _ (SpecInstSig (_, src) ty) = do { checkInferredVars doc ty @@ -1117,19 +1102,24 @@ -- then the SPECIALISE pragma is ambiguous, unlike all other signatures renameSig ctxt sig@(SpecSig _ v tys inl) = do { new_v <- case ctxt of - TopSigCtxt {} -> lookupLocatedOccRn v - _ -> lookupSigOccRnN ctxt sig v + TopSigCtxt {} -> lookupLocatedOccRn WL_TermVariable v + _ -> lookupSigOccRn ctxt sig v ; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys ; return (SpecSig noAnn new_v new_ty inl, fvs) } where - ty_ctxt = GenericCtx (text "a SPECIALISE signature for" - <+> quotes (ppr v)) do_one (tys,fvs) ty - = do { (new_ty, fvs_ty) <- rnHsSigType ty_ctxt TypeLevel ty + = do { (new_ty, fvs_ty) <- rnHsSigType (SpecialiseSigCtx v) TypeLevel ty ; return ( new_ty:tys, fvs_ty `plusFV` fvs) } +renameSig _ctxt (SpecSigE _ bndrs spec_e inl) + = do { fn_rdr <- checkSpecESigShape spec_e + ; fn_name <- lookupOccRn WL_TermVariable fn_rdr -- Checks that the head isn't forall-bound + ; bindRuleBndrs (SpecECtx fn_rdr) bndrs $ \_ bndrs' -> + do { (spec_e', fvs) <- rnLExpr spec_e + ; return (SpecSigE fn_name bndrs' spec_e' inl, fvs) } } + renameSig ctxt sig@(InlineSig _ v s) - = do { new_v <- lookupSigOccRnN ctxt sig v + = do { new_v <- lookupSigOccRn ctxt sig v ; return (InlineSig noAnn new_v s, emptyFVs) } renameSig ctxt (FixSig _ fsig) @@ -1137,35 +1127,50 @@ ; return (FixSig noAnn new_fsig, emptyFVs) } renameSig ctxt sig@(MinimalSig (_, s) (L l bf)) - = do new_bf <- traverse (lookupSigOccRnN ctxt sig) bf + = do new_bf <- bfTraverse (lookupSigOccRn ctxt sig) bf return (MinimalSig (noAnn, s) (L l new_bf), emptyFVs) renameSig ctxt sig@(PatSynSig _ vs ty) - = do { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs + = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs ; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty ; return (PatSynSig noAnn new_vs ty', fvs) } where - ty_ctxt = GenericCtx (text "a pattern synonym signature for" - <+> ppr_sig_bndrs vs) + ty_ctxt = PatSynSigCtx vs renameSig ctxt sig@(SCCFunSig (_, st) v s) - = do { new_v <- lookupSigOccRnN ctxt sig v + = do { new_v <- lookupSigOccRn ctxt sig v ; return (SCCFunSig (noAnn, st) new_v s, emptyFVs) } -- COMPLETE Sigs can refer to imported IDs which is why we use -- lookupLocatedOccRn rather than lookupSigOccRn -renameSig _ctxt sig@(CompleteMatchSig (_, s) bf mty) - = do new_bf <- traverse lookupLocatedOccRn bf - new_mty <- traverse lookupLocatedOccRn mty +renameSig _ctxt (CompleteMatchSig (_, s) bf mty) + = do new_bf <- traverse (lookupLocatedOccRn WL_ConLike) bf + new_mty <- traverse (lookupLocatedOccRn WL_TyCon) mty this_mod <- fmap tcg_mod getGblEnv + let rn_sig = CompleteMatchSig (noAnn, s) new_bf new_mty unless (any (nameIsLocalOrFrom this_mod . unLoc) new_bf) $ -- Why 'any'? See Note [Orphan COMPLETE pragmas] - addErrCtxt (text "In" <+> ppr sig) $ failWithTc TcRnOrphanCompletePragma + addErrCtxt (SigCtxt rn_sig) $ failWithTc TcRnOrphanCompletePragma - return (CompleteMatchSig (noAnn, s) new_bf new_mty, emptyFVs) + return (rn_sig, emptyFVs) +checkSpecESigShape :: LHsExpr GhcPs -> RnM RdrName +-- Checks the shape of a SPECIALISE +-- That it looks like (f a1 .. an [ :: ty ]) +checkSpecESigShape spec_e = go_l spec_e + where + go_l (L _ e) = go e + + go :: HsExpr GhcPs -> RnM RdrName + go (ExprWithTySig _ fn _) = go_l fn + go (HsApp _ fn _) = go_l fn + go (HsAppType _ fn _) = go_l fn + go (HsVar _ (L _ fn)) = return fn + go (HsPar _ e) = go_l e + go _ = failWithTc (TcRnSpecSigShape spec_e) + {- Note [Orphan COMPLETE pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1188,9 +1193,6 @@ complexity of supporting them properly doesn't seem worthwhile. -} -ppr_sig_bndrs :: [LocatedN RdrName] -> SDoc -ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) - okHsSig :: HsSigCtxt -> LSig (GhcPass a) -> Bool okHsSig ctxt (L _ sig) = case (sig, ctxt) of @@ -1211,10 +1213,8 @@ (InlineSig {}, HsBootCtxt {}) -> False (InlineSig {}, _) -> True - (SpecSig {}, TopSigCtxt {}) -> True - (SpecSig {}, LocalBindCtxt {}) -> True - (SpecSig {}, InstDeclCtxt {}) -> True - (SpecSig {}, _) -> False + (SpecSig {}, ctxt) -> ok_spec_ctxt ctxt + (SpecSigE {}, ctxt) -> ok_spec_ctxt ctxt (SpecInstSig {}, InstDeclCtxt {}) -> True (SpecInstSig {}, _) -> False @@ -1232,6 +1232,12 @@ (XSig {}, InstDeclCtxt {}) -> True (XSig {}, _) -> False +ok_spec_ctxt ::HsSigCtxt -> Bool +-- Contexts where SPECIALISE can occur +ok_spec_ctxt (TopSigCtxt {}) = True +ok_spec_ctxt (LocalBindCtxt {}) = True +ok_spec_ctxt (InstDeclCtxt {}) = True +ok_spec_ctxt _ = False ------------------- findDupSigs :: [LSig GhcPs] -> [NonEmpty (LocatedN RdrName, Sig GhcPs)] @@ -1283,7 +1289,55 @@ -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. +bindRuleBndrs :: HsDocContext -> RuleBndrs GhcPs + -> ([Name] -> RuleBndrs GhcRn -> RnM (a,FreeVars)) + -> RnM (a,FreeVars) +bindRuleBndrs doc (RuleBndrs { rb_tyvs = tyvs, rb_tmvs = tmvs }) thing_inside + = do { let rdr_names_w_loc = map (get_var . unLoc) tmvs + ; checkDupRdrNames rdr_names_w_loc + ; checkShadowedRdrNames rdr_names_w_loc + ; names <- newLocalBndrsRn rdr_names_w_loc + ; bindRuleTyVars doc tyvs $ \ tyvs' -> + bindRuleTmVars doc tyvs' tmvs names $ \ tmvs' -> + thing_inside names (RuleBndrs { rb_ext = noExtField + , rb_tyvs = tyvs', rb_tmvs = tmvs' }) } + where + get_var :: RuleBndr GhcPs -> LocatedN RdrName + get_var (RuleBndrSig _ v _) = v + get_var (RuleBndr _ v) = v + +bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs + -> [LRuleBndr GhcPs] -> [Name] + -> ([LRuleBndr GhcRn] -> RnM (a, FreeVars)) + -> RnM (a, FreeVars) +bindRuleTmVars doc tyvs vars names thing_inside + = go vars names $ \ vars' -> + bindLocalNamesFV names (thing_inside vars') + where + go ((L l (RuleBndr _ (L loc _))) : vars) (n : ns) thing_inside + = go vars ns $ \ vars' -> + thing_inside (L l (RuleBndr noAnn (L loc n)) : vars') + + go ((L l (RuleBndrSig _ (L loc _) bsig)) : vars) + (n : ns) thing_inside + = rnHsPatSigType bind_free_tvs doc bsig $ \ bsig' -> + go vars ns $ \ vars' -> + thing_inside (L l (RuleBndrSig noAnn (L loc n) bsig') : vars') + + go [] [] thing_inside = thing_inside [] + go vars names _ = pprPanic "bindRuleVars" (ppr vars $$ ppr names) + + bind_free_tvs = case tyvs of Nothing -> AlwaysBind + Just _ -> NeverBind + +bindRuleTyVars :: HsDocContext -> Maybe [LHsTyVarBndr () GhcPs] + -> (Maybe [LHsTyVarBndr () GhcRn] -> RnM (b, FreeVars)) + -> RnM (b, FreeVars) +bindRuleTyVars doc (Just bndrs) thing_inside + = bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs (thing_inside . Just) +bindRuleTyVars _ _ thing_inside = thing_inside Nothing + {- ************************************************************************ * * @@ -1464,9 +1518,8 @@ = setSrcSpanA name_loc $ -- This lookup will fail if the name is not defined in the -- same binding group as this fixity declaration. - do names <- lookupLocalTcNames sig_ctxt what ns_spec rdr_name + do names <- lookupLocalTcNames sig_ctxt SigLikeFixitySig ns_spec rdr_name return [ L name_loc name | (_, name) <- names ] - what = text "fixity signature" {- ************************************************************************ diff --git a/GHC/Rename/Env.hs b/GHC/Rename/Env.hs --- a/GHC/Rename/Env.hs +++ b/GHC/Rename/Env.hs @@ -14,8 +14,7 @@ module GHC.Rename.Env ( newTopSrcBinder, - lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn, - lookupLocatedTopConstructorRn, lookupLocatedTopConstructorRnN, + lookupLocatedTopBndrRnN, lookupTopBndrRn, lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField, lookupLocatedOccRnNone, @@ -23,7 +22,7 @@ lookupLocalOccRn_maybe, lookupInfoOccRn, lookupLocalOccThLvl_maybe, lookupLocalOccRn, lookupTypeOccRn, - lookupGlobalOccRn, lookupGlobalOccRn_maybe, + lookupGlobalOccRn_maybe, lookupExprOccRn, lookupRecFieldOcc, @@ -34,7 +33,7 @@ ChildLookupResult(..), lookupSubBndrOcc_helper, - HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN, + HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigCtxtOccRn, lookupInstDeclBndr, lookupFamInstName, @@ -51,8 +50,7 @@ lookupIfThenElse, -- QualifiedDo - lookupQualifiedDoExpr, lookupQualifiedDo, - lookupQualifiedDoName, lookupNameWithQualifier, + lookupQualifiedDo, lookupQualifiedDoName, lookupNameWithQualifier, -- Constructing usage information DeprecationWarnings(..), @@ -82,7 +80,6 @@ import GHC.Types.Name.Env import GHC.Types.Avail import GHC.Types.Hint -import GHC.Types.Error import GHC.Unit.Module import GHC.Unit.Module.ModIface import GHC.Core.ConLike @@ -241,8 +238,8 @@ -- Binders should not be qualified; if they are, and with a different -- module name, we get a confusing "M.T is not in scope" error later - ; stage <- getStage - ; if isBrackStage stage then + ; level <- getThLevel + ; if isBrackLevel level then -- We are inside a TH bracket, so make an *Internal* name -- See Note [Top-level Names in Template Haskell decl quotes] in GHC.Rename.Names do { uniq <- newUnique @@ -277,7 +274,7 @@ -- Can be made to not be exposed -- Only used unwrapped in rnAnnProvenance -lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name +lookupTopBndrRn :: WhatLooking -> RdrName -> RnM (WithUserRdr Name) -- Look up a top-level source-code binder. We may be looking up an unqualified 'f', -- and there may be several imported 'f's too, which must not confuse us. -- For example, this is OK: @@ -289,7 +286,7 @@ -- A separate function (importsFromLocalDecls) reports duplicate top level -- decls, so here it's safe just to choose an arbitrary one. lookupTopBndrRn which_suggest rdr_name = - lookupExactOrOrig rdr_name greName $ + lookupExactOrOrig rdr_name (WithUserRdr rdr_name . greName) $ do { -- Check for operators in type or class declarations -- See Note [Type and class operator definitions] let occ = rdrNameOcc rdr_name @@ -297,24 +294,17 @@ (do { op_ok <- xoptM LangExt.TypeOperators ; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) }) ; env <- getGlobalRdrEnv - ; case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS WantNormal) of + ; WithUserRdr rdr_name <$> + case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS WantNormal) of [gre] -> return (greName gre) _ -> do -- Ambiguous (can't happen) or unbound traceRn "lookupTopBndrRN fail" (ppr rdr_name) unboundName (LF which_suggest WL_LocalTop) rdr_name } -lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name) -lookupLocatedTopConstructorRn = wrapLocM (lookupTopBndrRn WL_Constructor) - -lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name) -lookupLocatedTopConstructorRnN = wrapLocMA (lookupTopBndrRn WL_Constructor) - -lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name) -lookupLocatedTopBndrRn = wrapLocM (lookupTopBndrRn WL_Anything) - -lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name) -lookupLocatedTopBndrRnN = wrapLocMA (lookupTopBndrRn WL_Anything) +lookupLocatedTopBndrRnN :: WhatLooking -> LocatedN RdrName -> RnM (LocatedN Name) +lookupLocatedTopBndrRnN what_look = + wrapLocMA (fmap getName . lookupTopBndrRn what_look) -- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames]. -- This never adds an error, but it may return one, see @@ -386,7 +376,7 @@ -- Ugh! See Note [Template Haskell ambiguity] } ----------------------------------------------- -lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name +lookupInstDeclBndr :: Name -> Subordinate -> RdrName -> RnM Name -- This is called on the method name on the left-hand side of an -- instance declaration binding. eg. instance Functor T where -- fmap = ... @@ -401,7 +391,7 @@ -- -- The "what" parameter says "method" or "associated type", -- depending on what we are looking up -lookupInstDeclBndr cls what rdr +lookupInstDeclBndr cls what_subordinate rdr = do { when (isQual rdr) (addErr (badQualBndrErr rdr)) -- In an instance decl you aren't allowed @@ -413,13 +403,11 @@ -- warnings when a deprecated class -- method is defined. We only warn -- when it's used - cls doc rdr + (ParentGRE cls (IAmTyCon ClassFlavour)) what_subordinate rdr ; case mb_name of - Left err -> do { addErr (mkTcRnNotInScope rdr err) + Left err -> do { addErr $ TcRnNotInScope err rdr ; return (mkUnboundNameRdr rdr) } Right nm -> return nm } - where - doc = what <+> text "of class" <+> quotes (ppr cls) ----------------------------------------------- lookupFamInstName :: Maybe Name -> LocatedN RdrName @@ -427,22 +415,22 @@ -- Used for TyData and TySynonym family instances only, -- See Note [Family instance binders] lookupFamInstName (Just cls) tc_rdr -- Associated type; c.f GHC.Rename.Bind.rnMethodBind - = wrapLocMA (lookupInstDeclBndr cls (text "associated type")) tc_rdr + = wrapLocMA (lookupInstDeclBndr cls AssociatedTypeOfClass) tc_rdr lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrence* - = lookupLocatedOccRnConstr tc_rdr + = lookupLocatedOccRn WL_TyCon tc_rdr ----------------------------------------------- -lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel] +lookupConstructorFields :: HasDebugCallStack => WithUserRdr Name -> RnM [FieldLabel] lookupConstructorFields = fmap conInfoFields . lookupConstructorInfo -- | Look up the arity and record fields of a constructor. -lookupConstructorInfo :: HasDebugCallStack => Name -> RnM ConInfo -lookupConstructorInfo con_name +lookupConstructorInfo :: HasDebugCallStack => WithUserRdr Name -> RnM ConInfo +lookupConstructorInfo qcon@(WithUserRdr _ con_name) = do { info <- lookupGREInfo_GRE con_name ; case info of IAmConLike con_info -> return con_info UnboundGRE -> return $ ConInfo (ConIsData []) ConHasPositionalArgs - IAmTyCon {} -> failIllegalTyCon WL_Constructor con_name + IAmTyCon {} -> failIllegalTyCon WL_ConLike qcon _ -> pprPanic "lookupConstructorInfo: not a ConLike" $ vcat [ text "name:" <+> ppr con_name ] } @@ -457,7 +445,7 @@ FoundExactOrOrig gre -> return $ res gre NotExactOrOrig -> k ExactOrOrigError e -> - do { addErr (mkTcRnNotInScope rdr_name e) + do { addErr $ TcRnNotInScope e rdr_name ; return $ res (mkUnboundGRERdr rdr_name) } } -- Variant of 'lookupExactOrOrig' that does not report an error @@ -529,18 +517,19 @@ -- If -XDisambiguateRecordFields is off, then we will pass 'Nothing' for the -- 'DataCon' 'Name', i.e. we don't use the data constructor for disambiguation. -- See Note [DisambiguateRecordFields] and Note [NoFieldSelectors]. -lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual - -- Just con => use data con to disambiguate +lookupRecFieldOcc :: Maybe (WithUserRdr Name) + -- Nothing => just look it up as usual + -- Just con => use data con to disambiguate -> RdrName -> RnM Name lookupRecFieldOcc mb_con rdr_name - | Just con <- mb_con + | Just (WithUserRdr _ con) <- mb_con , isUnboundName con -- Avoid error cascade = return $ mk_unbound_rec_fld con - | Just con <- mb_con + | Just qcon@(WithUserRdr _ con) <- mb_con = do { let lbl = FieldLabelString $ occNameFS (rdrNameOcc rdr_name) ; mb_nm <- lookupExactOrOrig rdr_name ensure_recfld $ -- See Note [Record field names and Template Haskell] - do { flds <- lookupConstructorFields con + do { flds <- lookupConstructorFields qcon ; env <- getGlobalRdrEnv ; let mb_gre = do fl <- find ((== lbl) . flLabel) flds -- We have the label, now check it is in scope. If @@ -564,11 +553,18 @@ ; Just nm -> return nm } } | otherwise -- Can't use the data constructor to disambiguate - = lookupGlobalOccRn' (RelevantGREsFOS WantField) rdr_name - -- This use of Global is right as we are looking up a selector, - -- which can only be defined at the top level. - + = lookupExactOrOrig rdr_name greName $ + do { mb_gre <- lookupGlobalOccRn_base which_gres rdr_name + ; case mb_gre of + Just gre -> return (greName gre) + Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) + ; unboundName looking_for rdr_name } } where + which_gres = RelevantGREsFOS WantField + looking_for = LF { lf_which = WL_RecField, lf_where = WL_Global } + -- This use of Global is right as we are looking up a selector, + -- which can only be defined at the top level. + -- When lookup fails, make an unbound name with the right record field -- namespace, as that's what we expect to be returned -- from 'lookupRecFieldOcc'. See T14307. @@ -685,25 +681,24 @@ -} -- | Used in export lists to lookup the children. -lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings - -> Name - -> RdrName -- ^ thing we are looking up - -> LookupChild -- ^ how to look it up (e.g. which - -- 'NameSpace's to look in) +lookupSubBndrOcc_helper :: Bool + -> DeprecationWarnings + -> ParentGRE -- ^ parent + -> RdrName -- ^ thing we are looking up -> RnM ChildLookupResult -lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup - | isUnboundName parent +lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent_gre rdr_name + | isUnboundName (parentGRE_name parent_gre) -- Avoid an error cascade = return (FoundChild (mkUnboundGRERdr rdr_name)) | otherwise = do gre_env <- getGlobalRdrEnv - let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc rdr_name) how_lkup) + let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name)) picked_gres = pick_gres original_gres -- The remaining GREs are things that we *could* export here. -- Note that this includes things which have `NoParent`; -- those are sorted in `checkPatSynParent`. - traceRn "parent" (ppr parent) + traceRn "parent" (ppr (parentGRE_name parent_gre)) traceRn "lookupExportChild original_gres:" (ppr original_gres) traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent) case picked_gres of @@ -739,12 +734,12 @@ dup_fields_ok <- xoptM LangExt.DuplicateRecordFields case original_gres of [] -> return NameNotFound - [g] -> return $ IncorrectParent parent g + [g] -> return $ IncorrectParent parent_gre g [p | ParentIs p <- [greParent g]] gss@(g:gss'@(_:_)) -> if all isRecFldGRE gss && dup_fields_ok then return $ - IncorrectParent parent g + IncorrectParent parent_gre g [p | x <- gss, ParentIs p <- [greParent x]] else mkNameClashErr $ g NE.:| gss' @@ -754,22 +749,29 @@ return (FoundChild (NE.head gres)) pick_gres :: [GlobalRdrElt] -> DisambigInfo - -- For Unqual, find GREs that are in scope qualified or unqualified - -- For Qual, find GREs that are in scope with that qualification pick_gres gres | isUnqual rdr_name + -- The child is not qualified: find GREs that are in scope, whether + -- qualified or unqualified, as per the Haskell 2010 report, 5.2.2: + -- + -- - In all cases, the parent type constructor T must be in scope. + -- - A subordinate name is legal if and only if: + -- (a) it names a constructor or field of T, and + -- (b) the constructor or field is in scope, regardless of whether + -- it is in scope under a qualified or unqualified name. = mconcat (map right_parent gres) | otherwise + -- The child is qualified: find GREs that are in scope + -- with that qualification. = mconcat (map right_parent (pickGREs rdr_name gres)) right_parent :: GlobalRdrElt -> DisambigInfo right_parent gre = case greParent gre of ParentIs cur_parent - | parent == cur_parent -> DisambiguatedOccurrence gre + | parentGRE_name parent_gre == cur_parent -> DisambiguatedOccurrence gre | otherwise -> NoOccurrence NoParent -> UniqueOccurrence gre -{-# INLINEABLE lookupSubBndrOcc_helper #-} -- | This domain specific datatype is used to record why we decided it was -- possible that a GRE could be exported with a parent. @@ -821,44 +823,41 @@ -- | We couldn't find a suitable name = NameNotFound -- | The child has an incorrect parent - | IncorrectParent Name -- ^ parent - GlobalRdrElt -- ^ child we were looking for - [Name] -- ^ list of possible parents + | IncorrectParent ParentGRE -- ^ parent + GlobalRdrElt -- ^ child we were looking for + [Name] -- ^ list of possible parents -- | We resolved to a child | FoundChild GlobalRdrElt instance Outputable ChildLookupResult where ppr NameNotFound = text "NameNotFound" ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n - ppr (IncorrectParent p g ns) + ppr (IncorrectParent parent g ns) = text "IncorrectParent" - <+> hsep [ppr p, ppr $ greName g, ppr ns] + <+> hsep [ppr (parentGRE_name parent), ppr $ greName g, ppr ns] lookupSubBndrOcc :: DeprecationWarnings - -> Name -- Parent - -> SDoc + -> ParentGRE + -> Subordinate -> RdrName -> RnM (Either NotInScopeError Name) -- ^ Find all the things the 'RdrName' maps to, -- and pick the one with the right 'Parent' 'Name'. -lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = +lookupSubBndrOcc warn_if_deprec the_parent what_subordinate rdr_name = lookupExactOrOrig rdr_name (Right . greName) $ -- This happens for built-in classes, see mod052 for example - do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name what_lkup + do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name ; return $ case child of FoundChild g -> Right (greName g) - NameNotFound -> Left (UnknownSubordinate doc) - IncorrectParent {} -> Left (UnknownSubordinate doc) } + NameNotFound -> Left unknown_sub + IncorrectParent {} -> Left unknown_sub } -- See [Mismatched class methods and associated type families] -- in TcInstDecls. where - what_lkup = LookupChild { wantedParent = the_parent - , lookupDataConFirst = False - , prioritiseParent = True -- See T23664. - } -{- -Note [Family instance binders] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + unknown_sub = UnknownSubordinate (parentGRE_name the_parent) what_subordinate + +{- Note [Family instance binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider data family F a data instance F T = X1 | X2 @@ -993,10 +992,10 @@ -------------------------------------------------- -} - -lookupLocatedOccRn :: GenLocated (EpAnn ann) RdrName +lookupLocatedOccRn :: WhatLooking + -> GenLocated (EpAnn ann) RdrName -> TcRn (GenLocated (EpAnn ann) Name) -lookupLocatedOccRn = wrapLocMA lookupOccRn +lookupLocatedOccRn what = wrapLocMA (lookupOccRn what) lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName -> TcRn (GenLocated (EpAnn ann) Name) @@ -1016,25 +1015,20 @@ = do { local_env <- getLocalRdrEnv ; return (lookupLocalRdrEnv local_env rdr_name) } -lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel)) +lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevelIndex)) -- Just look in the local environment lookupLocalOccThLvl_maybe name = do { lcl_env <- getLclEnv ; return (lookupNameEnv (getLclEnvThBndrs lcl_env) name) } --- lookupOccRn' looks up an occurrence of a RdrName, and uses its argument to +-- | lookupOccRn looks up an occurrence of a RdrName, and uses its argument to -- determine what kind of suggestions should be displayed if it is not in scope -lookupOccRn' :: WhatLooking -> RdrName -> RnM Name -lookupOccRn' which_suggest rdr_name +lookupOccRn :: WhatLooking -> RdrName -> RnM Name +lookupOccRn which_suggest rdr_name = do { mb_gre <- lookupOccRn_maybe rdr_name ; case mb_gre of Just gre -> return $ greName gre - Nothing -> reportUnboundName' which_suggest rdr_name } - --- lookupOccRn looks up an occurrence of a RdrName and displays suggestions if --- it is not in scope -lookupOccRn :: RdrName -> RnM Name -lookupOccRn = lookupOccRn' WL_Anything + Nothing -> reportUnboundName which_suggest rdr_name } -- | Look up an occurrence of a 'RdrName'. -- @@ -1051,7 +1045,9 @@ { mb_ty_gre <- lookup_promoted rdr_name ; case mb_ty_gre of Just gre -> return $ greName gre - Nothing -> reportUnboundName' WL_Constructor rdr_name} } + Nothing -> + reportUnboundName WL_ConLike rdr_name + } } {- Note [lookupOccRnConstr] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1078,12 +1074,12 @@ -- lookupOccRnRecField looks up an occurrence of a RdrName and displays -- record fields as suggestions if it is not in scope lookupOccRnRecField :: RdrName -> RnM Name -lookupOccRnRecField = lookupOccRn' WL_RecField +lookupOccRnRecField = lookupOccRn WL_RecField -- lookupOccRnRecField looks up an occurrence of a RdrName and displays -- no suggestions if it is not in scope lookupOccRnNone :: RdrName -> RnM Name -lookupOccRnNone = lookupOccRn' WL_None +lookupOccRnNone = lookupOccRn WL_None -- Only used in one place, to rename pattern synonym binders. -- See Note [Renaming pattern synonym variables] in GHC.Rename.Bind @@ -1092,7 +1088,7 @@ = do { mb_name <- lookupLocalOccRn_maybe rdr_name ; case mb_name of Just name -> return name - Nothing -> unboundName (LF WL_Anything WL_LocalOnly) rdr_name } + Nothing -> unboundName (LF WL_TermVariable WL_LocalOnly) rdr_name } -- lookupTypeOccRn looks up an optionally promoted RdrName. -- Used for looking up type variables. @@ -1124,7 +1120,7 @@ -- Used when looking up a term name (varName or dataName) in a type lookup_demoted :: RdrName -> RnM Name lookup_demoted rdr_name - | Just demoted_rdr <- demoteRdrName rdr_name + | Just demoted_rdr <- demoteRdrNameTcCls rdr_name -- Maybe it's the name of a *data* constructor = do { data_kinds <- xoptM LangExt.DataKinds ; star_is_type <- xoptM LangExt.StarIsType @@ -1169,7 +1165,7 @@ = unboundName looking_for rdr_name where - looking_for = LF WL_Constructor WL_Anywhere + looking_for = LF WL_Type WL_Anywhere {- Note [Demotion of unqualified variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1259,7 +1255,7 @@ report_qualified_term_in_types rdr_name demoted_rdr_name = do { mName <- lookupGlobalOccRn_maybe (RelevantGREsFOS WantNormal) demoted_rdr_name ; case mName of - (Just _) -> termNameInType looking_for rdr_name demoted_rdr_name [] + Just _ -> termNameInType looking_for rdr_name demoted_rdr_name [] Nothing -> unboundTermNameInTypes looking_for rdr_name demoted_rdr_name } where looking_for = LF WL_Constructor WL_Global @@ -1322,11 +1318,11 @@ (see the functions promotedRdrName and lookup_promoted). In particular, we have the following error message - • Illegal term-level use of the type constructor ‘Int’ - imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) - • In the first argument of ‘id’, namely ‘Int’ + • Illegal term-level use of the type constructor ‘Int' + imported from ‘Prelude' (and originally defined in ‘GHC.Types') + • In the first argument of ‘id' In the expression: id Int - In an equation for ‘x’: x = id Int + In an equation for ‘x': x = id Int when the user writes the following declaration @@ -1399,28 +1395,6 @@ lookupExactOrOrig_maybe rdr_name id $ lookupGlobalOccRn_base which_gres rdr_name -lookupGlobalOccRn :: RdrName -> RnM Name --- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global --- environment. Adds an error message if the RdrName is not in scope. --- You usually want to use "lookupOccRn" which also looks in the local --- environment. --- --- Used by exports_from_avail -lookupGlobalOccRn = lookupGlobalOccRn' (RelevantGREsFOS WantNormal) - -lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name -lookupGlobalOccRn' which_gres rdr_name = - lookupExactOrOrig rdr_name greName $ do - mb_gre <- lookupGlobalOccRn_base which_gres rdr_name - case mb_gre of - Just gre -> return (greName gre) - Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) - ; unboundName (LF which_suggest WL_Global) rdr_name } - where which_suggest = case includeFieldSelectors which_gres of - WantBoth -> WL_RecField - WantField -> WL_RecField - WantNormal -> WL_Anything - -- Looks up a RdrName occurrence in the GlobalRdrEnv and with -- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first. -- lookupQualifiedNameGHCi here is used when we're in GHCi and a name like @@ -1510,11 +1484,16 @@ -- Add an error if lookup failed. ; case res of - gre : gres -> return $ gre NE.:| gres - [] -> do { (imp_errs, hints) <- - unknownNameSuggestions emptyLocalRdrEnv WL_RecField rdr - ; failWithTc $ - TcRnNotInScope NotARecordField rdr imp_errs hints } } + { gre : gres -> return $ gre NE.:| gres + ; [] -> + do { show_helpful_errors <- goptM Opt_HelpfulErrors + ; (imp_errs, hints) <- + if show_helpful_errors + then unknownNameSuggestions emptyLocalRdrEnv WL_RecField rdr + else return ([], []) + ; err_msg <- unknownNameSuggestionsMessage (TcRnNotInScope NotARecordField rdr) imp_errs hints + ; failWithTc err_msg + } } } -- | Look up a 'RdrName', which might refer to an overloaded record field. -- @@ -1801,18 +1780,18 @@ -- until we know which is meant (gre:others) -> return (MultipleNames (gre NE.:| others)) } -lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt) +lookupGreAvailRn :: WhatLooking -> RdrName -> RnM (Maybe GlobalRdrElt) -- Used in export lists -- If not found or ambiguous, add error message, and fake with UnboundName -- Uses addUsedRdrName to record use and deprecations -lookupGreAvailRn rdr_name +lookupGreAvailRn what_looking rdr_name = do mb_gre <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name ExportDeprecationWarnings case mb_gre of GreNotFound -> do traceRn "lookupGreAvailRn" (ppr rdr_name) - _ <- unboundName (LF WL_Anything WL_Global) rdr_name + _ <- unboundName (LF what_looking WL_Global) rdr_name return Nothing MultipleNames gres -> do @@ -1913,7 +1892,7 @@ `Data.List` as if the user had written `import qualified Data.List`. If we fail we just return Nothing, rather than bleating -about "attempting to use module ‘D’ (./D.hs) which is not loaded" +about "attempting to use module 'D' (./D.hs) which is not loaded" which is what loadSrcInterface does. It is enabled by default and disabled by the flag @@ -2016,7 +1995,13 @@ , gre_info = info } where info = lookupGREInfo hsc_env nm - spec = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, is_pkg_qual = NoPkgQual, is_qual = True, is_isboot = NotBoot, is_dloc = noSrcSpan } + spec = ImpDeclSpec { is_mod = mod + , is_as = moduleName mod + , is_pkg_qual = NoPkgQual + , is_qual = True + , is_isboot = NotBoot + , is_dloc = noSrcSpan + , is_level = NormalLevel } is = ImpSpec { is_decl = spec, is_item = ImpAll } -- | Look up the 'GREInfo' associated with the given 'Name' @@ -2030,6 +2015,8 @@ -- and looks up the TyThing in the type environment. -- -- See Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo. + -- Note: This function is very similar to 'tcIfaceGlobal', it would be better to + -- use that if possible. = case nameModule_maybe nm of Nothing -> UnboundGRE Just mod -> @@ -2087,6 +2074,28 @@ f :: C a => a -> a -- No, not ok class C a where f :: a -> a + +Note [Signatures in instance decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + class C a where + op :: a -> a + nop :: a -> a + + instance C ty where + bop :: [a] -> [a] + bop x = x + + nop :: [a] -> [a] + +When renameing the `bop` binding we'll give it an UnboundName (still with +OccName "bop") because `bop` is not a method of C. Then + +* when doing lookupSigOcc on `bop :: blah` we want to find `bop`, even though it + is an UnboundName (failing to do this causes #16610, and #25437) + +* When doing lookupSigOcc on `nop :: blah` we want to complain that there + is no accompanying binding, even though `nop` is a class method -} data HsSigCtxt @@ -2094,8 +2103,8 @@ -- See Note [Signatures for top level things] | LocalBindCtxt NameSet -- In a local binding, binding these names | ClsDeclCtxt Name -- Class decl for this class - | InstDeclCtxt NameSet -- Instance decl whose user-written method - -- bindings are for these methods + | InstDeclCtxt (OccEnv Name) -- Instance decl whose user-written method + -- bindings are described by this OccEnv | HsBootCtxt NameSet -- Top level of a hs-boot file, binding these names | RoleAnnotCtxt NameSet -- A role annotation, with the names of all types -- in the group @@ -2110,18 +2119,13 @@ lookupSigOccRn :: HsSigCtxt -> Sig GhcPs - -> LocatedA RdrName -> RnM (LocatedA Name) -lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig) - -lookupSigOccRnN :: HsSigCtxt - -> Sig GhcPs - -> LocatedN RdrName -> RnM (LocatedN Name) -lookupSigOccRnN ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig) + -> GenLocated (EpAnn ann) RdrName + -> RnM (GenLocated (EpAnn ann) Name) +lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (SigLikeSig sig) -- | Lookup a name in relation to the names in a 'HsSigCtxt' lookupSigCtxtOccRn :: HsSigCtxt - -> SDoc -- ^ description of thing we're looking up, - -- like "type family" + -> SigLike -- ^ what are we looking for, e.g. a type family -> GenLocated (EpAnn ann) RdrName -> RnM (GenLocated (EpAnn ann) Name) lookupSigCtxtOccRn ctxt what @@ -2134,12 +2138,12 @@ vcat (text "lookupSigCtxtOccRn" <+> ppr name : map (either (pprScopeError rdr_name) ppr) rest) ; return name } Left err NE.:| _ -> - do { addErr (mkTcRnNotInScope rdr_name err) + do { addErr $ TcRnNotInScope err rdr_name ; return (mkUnboundNameRdr rdr_name) } } lookupBindGroupOcc :: HsSigCtxt - -> SDoc + -> SigLike -- ^ what kind of thing are we looking for? -> RdrName -- ^ what to look up -> Bool -- ^ if the 'RdrName' we are looking up is in -- a value 'NameSpace', should we also look up @@ -2170,34 +2174,38 @@ RoleAnnotCtxt ns -> lookup_top (elem_name_set_with_namespace ns) LocalBindCtxt ns -> lookup_group ns ClsDeclCtxt cls -> lookup_cls_op cls - InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610 - then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name - else lookup_top (elem_name_set_with_namespace ns) + InstDeclCtxt occ_env-> lookup_inst occ_env where elem_name_set_with_namespace ns n = check_namespace n && (n `elemNameSet` ns) check_namespace = coveredByNamespaceSpecifier ns_spec . nameNameSpace namespace = occNameSpace occ - occ = rdrNameOcc rdr_name - relevant_gres = - RelevantGREs - { includeFieldSelectors = WantBoth - , lookupVariablesForFields = True - , lookupTyConsAsWell = also_try_tycon_ns } - ok_gre = greIsRelevant relevant_gres namespace + occ = rdrNameOcc rdr_name + ok_gre = greIsRelevant relevant_gres namespace + relevant_gres = RelevantGREs { includeFieldSelectors = WantBoth + , lookupVariablesForFields = True + , lookupTyConsAsWell = also_try_tycon_ns } finish err gre | ok_gre gre - = NE.singleton (Right $ greName gre) + = NE.singleton (Right (greName gre)) | otherwise = NE.singleton (Left err) + succeed_with n = return $ NE.singleton $ Right n + lookup_cls_op cls - = NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name - where - doc = text "method of class" <+> quotes (ppr cls) + = NE.singleton <$> + lookupSubBndrOcc AllDeprecationWarnings + (ParentGRE cls (IAmTyCon ClassFlavour)) + MethodOfClass rdr_name + lookup_inst occ_env -- See Note [Signatures in instance decls] + = case lookupOccEnv occ_env occ of + Nothing -> bale_out_with [] + Just n -> succeed_with n + lookup_top keep_me = do { env <- getGlobalRdrEnv ; let occ = rdrNameOcc rdr_name @@ -2220,7 +2228,7 @@ ; let candidates_msg = candidates $ localRdrEnvElts env ; case mname of Just n - | n `elemNameSet` bound_names -> return $ NE.singleton $ Right n + | n `elemNameSet` bound_names -> succeed_with n | otherwise -> bale_out_with local_msg Nothing -> bale_out_with candidates_msg } @@ -2243,7 +2251,7 @@ --------------- -lookupLocalTcNames :: HsSigCtxt -> SDoc -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)] +lookupLocalTcNames :: HsSigCtxt -> SigLike -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)] -- GHC extension: look up both the tycon and data con or variable. -- Used for top-level fixity signatures and deprecations. -- Complain if neither is in scope. @@ -2260,13 +2268,13 @@ where -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233 guard_builtin_syntax this_mod rdr (Right name) - | Just _ <- isBuiltInOcc_maybe (occName rdr) + | isBuiltInOcc (occName rdr) , this_mod /= nameModule name = Left $ TcRnIllegalBuiltinSyntax what rdr | otherwise = Right (rdr, name) guard_builtin_syntax _ _ (Left err) - = Left $ mkTcRnNotInScope rdr err + = Left $ TcRnNotInScope err rdr dataTcOccs :: RdrName -> [RdrName] -- Return both the given name and the same name promoted to the TcClsName @@ -2367,14 +2375,14 @@ -> RnM (HsExpr GhcRn, FreeVars) -- ^ Possibly a non-standard name lookupSyntaxExpr std_name = do { (name, fvs) <- lookupSyntaxName std_name - ; return (nl_HsVar name, fvs) } + ; return (genHsVar name, fvs) } lookupSyntax :: Name -- The standard name -> RnM (SyntaxExpr GhcRn, FreeVars) -- Possibly a non-standard -- name lookupSyntax std_name - = do { (expr, fvs) <- lookupSyntaxExpr std_name - ; return (mkSyntaxExpr expr, fvs) } + = do { (name, fvs) <- lookupSyntaxName std_name + ; return (mkRnSyntaxExpr name, fvs) } lookupSyntaxNames :: [Name] -- Standard names -> RnM ([HsExpr GhcRn], FreeVars) -- See comments with HsExpr.ReboundNames @@ -2382,11 +2390,11 @@ lookupSyntaxNames std_names = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if not rebindable_on then - return (map (HsVar noExtField . noLocA) std_names, emptyFVs) + return (map (mkHsVar . noLocA) std_names, emptyFVs) else do { usr_names <- mapM (lookupOccRnNone . mkRdrUnqual . nameOccName) std_names - ; return (map (HsVar noExtField . noLocA) usr_names, mkFVs usr_names) } } + ; return (map (mkHsVar . noLocA) usr_names, mkFVs usr_names) } } {- @@ -2404,15 +2412,9 @@ -- Lookup operations for a qualified do. If the context is not a qualified -- do, then use lookupSyntaxExpr. See Note [QualifiedDo]. -lookupQualifiedDoExpr :: HsStmtContext fn -> Name -> RnM (HsExpr GhcRn, FreeVars) -lookupQualifiedDoExpr ctxt std_name - = first nl_HsVar <$> lookupQualifiedDoName ctxt std_name - --- Like lookupQualifiedDoExpr but for producing SyntaxExpr. --- See Note [QualifiedDo]. lookupQualifiedDo :: HsStmtContext fn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars) lookupQualifiedDo ctxt std_name - = first mkSyntaxExpr <$> lookupQualifiedDoExpr ctxt std_name + = first mkRnSyntaxExpr <$> lookupQualifiedDoName ctxt std_name lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars) lookupNameWithQualifier std_name modName @@ -2423,7 +2425,7 @@ lookupQualifiedDoName :: HsStmtContext fn -> Name -> RnM (Name, FreeVars) lookupQualifiedDoName ctxt std_name = case qualifiedDoModuleName_maybe ctxt of - Nothing -> lookupSyntaxName std_name + Nothing -> lookupSyntaxName std_name Just modName -> lookupNameWithQualifier std_name modName -------------------------------------------------------------------------------- @@ -2437,9 +2439,9 @@ => HscEnv -> GlobalRdrEnv -> CompleteMatches -- ^ in-scope COMPLETE pragmas - -> Name -- ^ the 'Name' of the 'ConLike' + -> WithUserRdr Name -- ^ the 'Name' of the 'ConLike' -> Bool -irrefutableConLikeRn hsc_env rdr_env comps con_nm +irrefutableConLikeRn hsc_env rdr_env comps (WithUserRdr _ con_nm) | Just gre <- lookupGRE_Name rdr_env con_nm = go $ greInfo gre | otherwise diff --git a/GHC/Rename/Expr.hs b/GHC/Rename/Expr.hs --- a/GHC/Rename/Expr.hs +++ b/GHC/Rename/Expr.hs @@ -3,6 +3,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -10,7 +11,6 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -29,33 +29,28 @@ AnnoBody, UnexpectedStatement(..) ) where -import GHC.Prelude -import GHC.Data.FastString - -import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS - , rnMatchGroup, rnGRHS, makeMiniFixityEnv) +import GHC.Prelude hiding (head, init, last, scanl, tail) import GHC.Hs + import GHC.Tc.Errors.Types -import GHC.Tc.Utils.Env ( isBrackStage ) +import GHC.Tc.Utils.Env ( isBrackLevel ) import GHC.Tc.Utils.Monad -import GHC.Unit.Module ( getModule, isInteractiveModule ) + +import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS + , rnMatchGroup, rnGRHS, makeMiniFixityEnv) import GHC.Rename.Env import GHC.Rename.Fixity -import GHC.Rename.Utils ( bindLocalNamesFV, checkDupNames - , bindLocalNames - , mapMaybeFvRn, mapFvRn - , warnUnusedLocalBinds, typeAppErr - , checkUnusedRecordWildcard - , wrapGenSpan, genHsIntegralLit, genHsTyLit - , genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps' - , genAppType ) +import GHC.Rename.Utils import GHC.Rename.Unbound ( reportUnboundName ) -import GHC.Rename.Splice ( rnTypedBracket, rnUntypedBracket, rnTypedSplice, rnUntypedSpliceExpr, checkThLocalName ) +import GHC.Rename.Splice ( rnTypedBracket, rnUntypedBracket, rnTypedSplice + , rnUntypedSpliceExpr, checkThLocalNameWithLift, checkThLocalNameNoLift ) import GHC.Rename.HsType import GHC.Rename.Pat + import GHC.Driver.DynFlags import GHC.Builtin.Names import GHC.Builtin.Types ( nilDataConName ) +import GHC.Unit.Module ( getModule, isInteractiveModule ) import GHC.Types.Basic (TypeOrKind (TypeLevel)) import GHC.Types.FieldLabel @@ -67,25 +62,30 @@ import GHC.Types.Unique.Set import GHC.Types.SourceText import GHC.Types.SrcLoc + import GHC.Utils.Misc -import GHC.Data.List.SetOps ( removeDupsOn ) -import GHC.Data.Maybe +import qualified GHC.Data.List.NonEmpty as NE import GHC.Utils.Error import GHC.Utils.Panic import GHC.Utils.Outputable as Outputable +import GHC.Data.FastString +import GHC.Data.List.SetOps ( removeDupsOn ) +import GHC.Data.Maybe + import qualified GHC.LanguageExtensions as LangExt import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Control.Monad -import Data.List (unzip4, minimumBy) -import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) +import qualified Data.Foldable as Partial (maximum) +import Data.List (unzip4) +import Data.List.NonEmpty ( NonEmpty(..), head, init, last, nonEmpty, scanl, tail ) import Control.Arrow (first) import Data.Ord import Data.Array -import qualified Data.List.NonEmpty as NE import GHC.Driver.Env (HscEnv) +import Data.Foldable (toList) {- Note [Handling overloaded and rebindable constructs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -306,27 +306,19 @@ rnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars) -finishHsVar :: LocatedA Name -> RnM (HsExpr GhcRn, FreeVars) --- Separated from rnExpr because it's also used --- when renaming infix expressions -finishHsVar (L l name) - = do { this_mod <- getModule - ; when (nameIsLocalOrFrom this_mod name) $ - checkThLocalName name - ; return (HsVar noExtField (L (l2l l) name), unitFV name) } - -rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars) -rnUnboundVar v = do +rnUnboundVar :: SrcSpanAnnN -> RdrName -> RnM (HsExpr GhcRn, FreeVars) +rnUnboundVar l v = do deferOutofScopeVariables <- goptM Opt_DeferOutOfScopeVariables -- See Note [Reporting unbound names] for difference between qualified and unqualified names. - unless (isUnqual v || deferOutofScopeVariables) (reportUnboundName v >> return ()) - return (HsUnboundVar noExtField v, emptyFVs) + unless (isUnqual v || deferOutofScopeVariables) $ + void $ reportUnboundName WL_Term v + return (HsHole (HoleVar (L l v)), emptyFVs) rnExpr (HsVar _ (L l v)) = do { dflags <- getDynFlags ; mb_gre <- lookupExprOccRn v ; case mb_gre of { - Nothing -> rnUnboundVar v ; + Nothing -> rnUnboundVar l v ; Just gre -> do { let nm = greName gre info = greInfo gre @@ -336,9 +328,7 @@ -- matching GRE and add a name clash error -- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn). -> do { let sel_name = flSelector $ recFieldLabel fld_info - ; this_mod <- getModule - ; when (nameIsLocalOrFrom this_mod sel_name) $ - checkThLocalName sel_name + ; checkThLocalNameNoLift (L (l2l l) (WithUserRdr v sel_name)) ; return (XExpr (HsRecSelRn (FieldOcc v (L l sel_name))), unitFV sel_name) } | nm == nilDataConName @@ -349,14 +339,16 @@ -> rnExpr (ExplicitList noAnn []) | otherwise - -> finishHsVar (L (l2l l) nm) + -> do { res_expr <- checkThLocalNameWithLift (L (l2l l) (WithUserRdr v nm)) + ; return (res_expr, unitFV nm) } }}} + rnExpr (HsIPVar x v) = return (HsIPVar x v, emptyFVs) -rnExpr (HsUnboundVar _ v) - = return (HsUnboundVar noExtField v, emptyFVs) +rnExpr (HsHole h) + = return (HsHole h, emptyFVs) -- HsOverLabel: see Note [Handling overloaded and rebindable constructs] rnExpr (HsOverLabel src v) @@ -383,7 +375,7 @@ rnExpr (HsLit x lit) = do { rnLit lit - ; return (HsLit x(convertLit lit), emptyFVs) } + ; return (HsLit x (convertLit lit), emptyFVs) } rnExpr (HsOverLit x lit) = do { ((lit', mb_neg), fvs) <- rnOverLit lit -- See Note [Negative zero] @@ -416,7 +408,7 @@ -- more, so I've removed the test. Adding HsPars in GHC.Tc.Deriv.Generate -- should prevent bad things happening. ; fixity <- case op' of - L _ (HsVar _ (L _ n)) -> lookupFixityRn n + L _ (HsVar _ (L _ (WithUserRdr _ n))) -> lookupFixityRn n L _ (XExpr (HsRecSelRn f)) -> lookupFieldFixityRn f _ -> return (Fixity minPrecedence InfixL) -- c.f. lookupFixity for unbound @@ -447,7 +439,7 @@ rnExpr (HsProjection _ fs) = do { (getField, fv_getField) <- lookupSyntaxName getFieldName - ; circ <- lookupOccRn compose_RDR + ; circ <- lookupOccRn WL_TermVariable compose_RDR ; let fs' = NE.map rnDotFieldOcc fs ; return ( mkExpandedExpr (HsProjection noExtField fs') @@ -541,15 +533,17 @@ rnExpr (RecordCon { rcon_con = con_rdr , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) }) - = do { con_lname@(L _ con_name) <- lookupLocatedOccRnConstr con_rdr - ; (flds, fvs) <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds + = do { L con_loc con_name <- lookupLocatedOccRnConstr con_rdr + ; let qcon = WithUserRdr (unLoc con_rdr) con_name + ; (flds, fvs) <- rnHsRecFields (HsRecFieldCon qcon) mk_hs_var rec_binds ; (flds', fvss) <- mapAndUnzipM rn_field flds ; let rec_binds' = HsRecFields { rec_ext = noExtField, rec_flds = flds', rec_dotdot = dd } ; return (RecordCon { rcon_ext = noExtField - , rcon_con = con_lname, rcon_flds = rec_binds' } + , rcon_con = L con_loc qcon + , rcon_flds = rec_binds' } , fvs `plusFV` plusFVs fvss `addOneFV` con_name) } where - mk_hs_var l n = HsVar noExtField (L (noAnnSrcSpan l) n) + mk_hs_var l n = mkHsVarWithUserRdr (unLoc con_rdr) (L (noAnnSrcSpan l) n) rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hfbRHS fld) ; return (L l (fld { hfbRHS = arg' }), fvs) } @@ -634,7 +628,7 @@ rnExpr (HsFunArr _ mult arg res) = do { (arg', fvs1) <- rnLExpr arg - ; (mult', fvs2) <- rnHsArrowWith rnLExpr mult + ; (mult', fvs2) <- rnHsMultAnnWith rnLExpr mult ; (res', fvs3) <- rnLExpr res ; checkTypeSyntaxExtension FunctionArrowSyntax ; return (HsFunArr noExtField mult' arg' res', plusFVs [fvs1, fvs2, fvs3]) } @@ -662,9 +656,9 @@ unlessXOptM LangExt.StaticPointers $ addErr $ TcRnIllegalStaticExpression e (expr',fvExpr) <- rnLExpr expr - stage <- getStage - case stage of - Splice _ -> addErr $ TcRnTHError $ IllegalStaticFormInSplice e + level <- getThLevel + case level of + Splice _ _ -> addErr $ TcRnTHError $ IllegalStaticFormInSplice e _ -> return () mod <- getModule let fvExpr' = filterNameSet (nameIsLocalOrFrom mod) fvExpr @@ -861,8 +855,8 @@ Note [Reporting unbound names] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Faced with an out-of-scope `RdrName` there are two courses of action -A. Report an error immediately (and return a HsUnboundVar). This will halt GHC after the renamer is complete -B. Return a HsUnboundVar without reporting an error. That will allow the typechecker to run, which in turn +A. Report an error immediately (and return a `HsHole (HoleVar ...)`). This will halt GHC after the renamer is complete +B. Return a `HsHole (HoleVar ...)` without reporting an error. That will allow the typechecker to run, which in turn can give a better error message, notably giving the type of the variable via the "typed holes" mechanism. When `-fdefer-out-of-scope-variables` is on we follow plan B. @@ -893,7 +887,7 @@ rnDotFieldOcc (DotFieldOcc x label) = DotFieldOcc x label rnFieldLabelStrings :: FieldLabelStrings GhcPs -> FieldLabelStrings GhcRn -rnFieldLabelStrings (FieldLabelStrings fls) = FieldLabelStrings (map (fmap rnDotFieldOcc) fls) +rnFieldLabelStrings (FieldLabelStrings fls) = FieldLabelStrings (fmap (fmap rnDotFieldOcc) fls) {- ************************************************************************ @@ -1036,7 +1030,8 @@ ------------------------------------------------- -- gaw 2004 methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars -methodNamesGRHSs (GRHSs _ grhss _) = plusFVs (map methodNamesGRHS grhss) +methodNamesGRHSs (GRHSs _ grhss _) + = foldl' (flip plusFV) emptyFVs (NE.map methodNamesGRHS grhss) ------------------------------------------------- @@ -1157,7 +1152,7 @@ | otherwise = False -- don't apply the transformation inside TH brackets, because -- GHC.HsToCore.Quote does not handle ApplicativeDo. - ; in_th_bracket <- isBrackStage <$> getStage + ; in_th_bracket <- isBrackLevel <$> getThLevel ; if ado_is_on && is_do_expr && not in_th_bracket then do { traceRn "ppsfa" (ppr stmts) ; rearrangeForApplicativeDo ctxt stmts } @@ -1378,34 +1373,40 @@ rnParallelStmts :: forall thing. HsStmtContextRn -> SyntaxExpr GhcRn - -> [ParStmtBlock GhcPs GhcPs] + -> NonEmpty (ParStmtBlock GhcPs GhcPs) -> ([Name] -> RnM (thing, FreeVars)) - -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars) + -> RnM ((NonEmpty (ParStmtBlock GhcRn GhcRn), thing), FreeVars) -- Note [Renaming parallel Stmts] rnParallelStmts ctxt return_op segs thing_inside = do { orig_lcl_env <- getLocalRdrEnv - ; rn_segs orig_lcl_env [] segs } + ; rn_segs (:|) orig_lcl_env [] segs } where - rn_segs :: LocalRdrEnv - -> [Name] -> [ParStmtBlock GhcPs GhcPs] - -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars) - rn_segs _ bndrs_so_far [] - = do { let (bndrs', dups) = removeDupsOn nameOccName bndrs_so_far - ; mapM_ dupErr dups - ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs') - ; return (([], thing), fvs) } - - rn_segs env bndrs_so_far (ParStmtBlock x stmts _ _ : segs) + -- The `cons` argument is how we cons the first `ParStmtBlock` onto the rest. + -- It is called with `cons = (:)` or `cons = (:|)`. + -- Thus, the return type `parStmtBlocks` is `[ParStmtBlock _ _]` or + -- `NonEmpty (ParStmtBlock _ _)`, in turn. + rn_segs :: (ParStmtBlock GhcRn GhcRn -> [ParStmtBlock GhcRn GhcRn] -> parStmtBlocks) + -> LocalRdrEnv + -> [Name] -> NonEmpty (ParStmtBlock GhcPs GhcPs) + -> RnM ((parStmtBlocks, thing), FreeVars) + rn_segs cons env bndrs_so_far (ParStmtBlock x stmts _ _ :| segs) = do { ((stmts', (used_bndrs, segs', thing)), fvs) <- rnStmts ctxt rnExpr stmts $ \ bndrs -> setLocalRdrEnv env $ do - { ((segs', thing), fvs) <- rn_segs env (bndrs ++ bndrs_so_far) segs + { ((segs', thing), fvs) <- rn_segs1 env (bndrs ++ bndrs_so_far) segs ; let used_bndrs = filter (`elemNameSet` fvs) bndrs ; return ((used_bndrs, segs', thing), fvs) } ; let seg' = ParStmtBlock x stmts' used_bndrs return_op - ; return ((seg':segs', thing), fvs) } + ; return ((cons seg' segs', thing), fvs) } + rn_segs1 _ bndrs [] = do + { let (bndrs', dups) = removeDupsOn nameOccName bndrs + ; mapM_ dupErr dups + ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs') + ; return (([], thing), fvs) } + rn_segs1 env bndrs (x:xs) = rn_segs (:) env bndrs (x:|xs) + dupErr vs = addErr $ TcRnListComprehensionDuplicateBinding (NE.head vs) lookupQualifiedDoStmtName :: HsStmtContextRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars) @@ -1414,7 +1415,7 @@ = case qualifiedDoModuleName_maybe ctxt of Nothing -> lookupStmtName ctxt n Just modName -> - first (mkSyntaxExpr . nl_HsVar) <$> lookupNameWithQualifier n modName + first mkRnSyntaxExpr <$> lookupNameWithQualifier n modName lookupStmtName :: HsStmtContextRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars) -- Like lookupSyntax, but respects contexts @@ -1429,13 +1430,13 @@ | rebindableContext ctxt = do { rebindable_on <- xoptM LangExt.RebindableSyntax ; if rebindable_on - then do { fm <- lookupOccRn (nameRdrName name) - ; return (HsVar noExtField (noLocA fm), unitFV fm) } + then do { fm <- lookupOccRn WL_TermVariable (nameRdrName name) + ; return (mkHsVar (noLocA fm), unitFV fm) } else not_rebindable } | otherwise = not_rebindable where - not_rebindable = return (HsVar noExtField (noLocA name), emptyFVs) + not_rebindable = return (mkHsVar (noLocA name), emptyFVs) -- | Is this a context where we respect RebindableSyntax? -- but ListComp are never rebindable @@ -1806,7 +1807,7 @@ glomSegments :: HsStmtContextRn -> [Segment (LStmt GhcRn body)] - -> [Segment [LStmt GhcRn body]] + -> [Segment (NonEmpty (LStmt GhcRn body))] -- Each segment has a non-empty list of Stmts -- See Note [Glomming segments] @@ -1822,7 +1823,7 @@ seg_defs = plusFVs ds `plusFV` defs seg_uses = plusFVs us `plusFV` uses seg_fwds = plusFVs fs `plusFV` fwds - seg_stmts = stmt : concat ss + seg_stmts = stmt :| concatMap toList ss grab :: NameSet -- The client -> [Segment a] @@ -1838,24 +1839,23 @@ ---------------------------------------------------- segsToStmts :: Stmt GhcRn (LocatedA (body GhcRn)) -- A RecStmt with the SyntaxOps filled in - -> [Segment [LStmt GhcRn (LocatedA (body GhcRn))]] + -> [Segment (NonEmpty (LStmt GhcRn (LocatedA (body GhcRn))))] -- Each Segment has a non-empty list of Stmts -> FreeVars -- Free vars used 'later' -> ([LStmt GhcRn (LocatedA (body GhcRn))], FreeVars) segsToStmts _ [] fvs_later = ([], fvs_later) segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later - = assert (not (null ss)) - (new_stmt : later_stmts, later_uses `plusFV` uses) + = (new_stmt : later_stmts, later_uses `plusFV` uses) where (later_stmts, later_uses) = segsToStmts empty_rec_stmt segs fvs_later new_stmt | non_rec = head ss | otherwise = L (getLoc (head ss)) rec_stmt - rec_stmt = empty_rec_stmt { recS_stmts = noLocA ss + rec_stmt = empty_rec_stmt { recS_stmts = noLocA (toList ss) , recS_later_ids = nameSetElemsStable used_later , recS_rec_ids = nameSetElemsStable fwds } -- See Note [Deterministic ApplicativeDo and RecursiveDo desugaring] - non_rec = isSingleton ss && isEmptyNameSet fwds + non_rec = NE.isSingleton ss && isEmptyNameSet fwds used_later = defs `intersectNameSet` later_uses -- The ones needed after the RecStmt @@ -2031,10 +2031,9 @@ rearrangeForApplicativeDo ctxt [(one,_)] = do (return_name, _) <- lookupQualifiedDoName (HsDoStmt ctxt) returnMName (pure_name, _) <- lookupQualifiedDoName (HsDoStmt ctxt) pureAName - let pure_expr = nl_HsVar pure_name let monad_names = MonadNames { return_name = return_name , pure_name = pure_name } - return $ case needJoin monad_names [one] (Just pure_expr) of + return $ case needJoin monad_names [one] (Just pure_name) of (False, one') -> (one', emptyNameSet) (True, _) -> ([one], emptyNameSet) rearrangeForApplicativeDo ctxt stmts0 = do @@ -2115,9 +2114,10 @@ case segments [ stmt_arr ! i | i <- [lo..hi] ] of [] -> panic "mkStmtTree" [_one] -> split lo hi - segs -> (StmtTreeApplicative trees, maximum costs) + segs -> (StmtTreeApplicative trees, Partial.maximum costs) where bounds = scanl (\(_,hi) a -> (hi+1, hi + length a)) (0,lo-1) segs + -- We know `costs` must be non-empty, as `length segs >= 2` here. (trees,costs) = unzip (map (uncurry split) (tail bounds)) -- find the best place to split the segment [lo..hi] @@ -2136,21 +2136,21 @@ -- in the case that these two have the same cost do we need -- to do the exhaustive search. -- - ((before,c1),(after,c2)) - | hi - lo == 1 - = ((StmtTreeOne (stmt_arr ! lo), 1), - (StmtTreeOne (stmt_arr ! hi), 1)) - | left_cost < right_cost - = ((left,left_cost), (StmtTreeOne (stmt_arr ! hi), 1)) - | left_cost > right_cost - = ((StmtTreeOne (stmt_arr ! lo), 1), (right,right_cost)) - | otherwise = minimumBy (comparing cost) alternatives + ((before,c1),(after,c2)) = case nonEmpty [lo .. hi-1] of + Nothing -> + ( (StmtTreeOne (stmt_arr ! lo), 1), + (StmtTreeOne (stmt_arr ! hi), 1) ) + Just ks + | left_cost < right_cost + -> ((left,left_cost), (StmtTreeOne (stmt_arr ! hi), 1)) + | left_cost > right_cost + -> ((StmtTreeOne (stmt_arr ! lo), 1), (right,right_cost)) + | otherwise -> minimumBy (comparing cost) + [ (arr ! (lo,k), arr ! (k+1,hi)) | k <- ks ] where (left, left_cost) = arr ! (lo,hi-1) (right, right_cost) = arr ! (lo+1,hi) cost ((_,c1),(_,c2)) = c1 + c2 - alternatives = [ (arr ! (lo,k), arr ! (k+1,hi)) - | k <- [lo .. hi-1] ] -- | Turn the ExprStmtTree back into a sequence of statements, using @@ -2196,8 +2196,8 @@ }] False tail' stmtTreeToStmts monad_names ctxt (StmtTreeOne (let_stmt@(L _ LetStmt{}),_)) tail _tail_fvs = do - (pure_expr, _) <- lookupQualifiedDoExpr (HsDoStmt ctxt) pureAName - return $ case needJoin monad_names tail (Just pure_expr) of + (pure_name, _) <- lookupQualifiedDoName (HsDoStmt ctxt) pureAName + return $ case needJoin monad_names tail (Just pure_name) of (False, tail') -> (let_stmt : tail', emptyNameSet) (True, _) -> (let_stmt : tail, emptyNameSet) @@ -2250,13 +2250,13 @@ tup = mkBigLHsVarTup pvars noExtField (stmts',fvs2) <- stmtTreeToStmts monad_names ctxt tree [] pvarset (mb_ret, fvs1) <- - if | L _ (XStmtLR ApplicativeStmt{}) <- last stmts' -> + if | Just (L _ (XStmtLR ApplicativeStmt{})) <- lastMaybe stmts' -> return (unLoc tup, emptyNameSet) | otherwise -> do -- Need 'pureAName' and not 'returnMName' here, so that it requires -- 'Applicative' and not 'Monad' whenever possible (until #20540 is fixed). - (ret, _) <- lookupQualifiedDoExpr (HsDoStmt ctxt) pureAName - let expr = HsApp noExtField (noLocA ret) tup + (pure_name, _) <- lookupQualifiedDoName (HsDoStmt ctxt) pureAName + let expr = HsApp noExtField (noLocA (genHsVar pure_name)) tup return (expr, emptyFVs) return ( ApplicativeArgMany { xarg_app_arg_many = noExtField @@ -2522,7 +2522,7 @@ -> [ExprLStmt GhcRn] -- If this is @Just pure@, replace return by pure -- If this is @Nothing@, strip the return/pure - -> Maybe (HsExpr GhcRn) + -> Maybe Name -> (Bool, [ExprLStmt GhcRn]) needJoin _monad_names [] _mb_pure = (False, []) -- we're in an ApplicativeArg needJoin monad_names [L loc (LastStmt _ e _ t)] mb_pure @@ -2543,30 +2543,30 @@ -> LHsExpr GhcRn -- If this is @Just pure@, replace return by pure -- If this is @Nothing@, strip the return/pure - -> Maybe (HsExpr GhcRn) + -> Maybe Name -> Maybe (LHsExpr GhcRn, Maybe Bool) isReturnApp monad_names (L _ (HsPar _ expr)) mb_pure = isReturnApp monad_names expr mb_pure isReturnApp monad_names (L loc e) mb_pure = case e of OpApp x l op r - | Just pure_expr <- mb_pure, is_return l, is_dollar op -> - Just (L loc (OpApp x (to_pure l pure_expr) op r), Nothing) + | Just pure_name <- mb_pure, is_return l, is_dollar op -> + Just (L loc (OpApp x (to_pure l pure_name) op r), Nothing) | is_return l, is_dollar op -> Just (r, Just True) HsApp x f arg - | Just pure_expr <- mb_pure, is_return f -> - Just (L loc (HsApp x (to_pure f pure_expr) arg), Nothing) + | Just pure_name <- mb_pure, is_return f -> + Just (L loc (HsApp x (to_pure f pure_name) arg), Nothing) | is_return f -> Just (arg, Just False) _otherwise -> Nothing where is_var f (L _ (HsPar _ e)) = is_var f e is_var f (L _ (HsAppType _ e _)) = is_var f e - is_var f (L _ (HsVar _ (L _ r))) = f r + is_var f (L _ (HsVar _ (L _ (WithUserRdr _q r)))) = f r -- TODO: I don't know how to get this right for rebindable syntax is_var _ _ = False is_return = is_var (\n -> n == return_name monad_names || n == pure_name monad_names) - to_pure (L loc _) pure_expr = L loc pure_expr + to_pure (L loc _) pure_name = L loc (genHsVar pure_name) is_dollar = is_var (`hasKey` dollarIdKey) {- @@ -2792,13 +2792,13 @@ reallyGetMonadFailOp rebindableSyntax overloadedStrings | (isQualifiedDo || rebindableSyntax) && overloadedStrings = do - (failExpr, failFvs) <- lookupQualifiedDoExpr ctxt failMName + (failName, failFvs) <- lookupQualifiedDoName ctxt failMName (fromStringExpr, fromStringFvs) <- lookupSyntaxExpr fromStringName let arg_lit = mkVarOccFS (fsLit "arg") arg_name <- newSysName arg_lit let arg_syn_expr = nlHsVar arg_name body :: LHsExpr GhcRn = - nlHsApp (noLocA failExpr) + nlHsApp (noLocA (genHsVar failName)) (nlHsApp (noLocA $ fromStringExpr) arg_syn_expr) let failAfterFromStringExpr :: HsExpr GhcRn = unLoc $ mkHsLam (noLocA [noLocA $ VarPat noExtField $ noLocA arg_name]) body @@ -2844,18 +2844,18 @@ -- mkGetField arg field calculates a get_field @field arg expression. -- e.g. z.x = mkGetField z x = get_field @x z mkGetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn -mkGetField get_field arg field = unLoc (head $ mkGet get_field [arg] field) +mkGetField get_field arg field = unLoc (head $ mkGet get_field (arg :| []) field) -- mkSetField a field b calculates a set_field @field expression. --- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' on a to b"). +-- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' to a on b"). +-- NB: the order of aruments is specified by GHC Proposal 583: HasField redesign. mkSetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> LHsExpr GhcRn -> HsExpr GhcRn mkSetField set_field a (L _ (FieldLabelString field)) b = - genHsApp (genHsApp (genHsVar set_field `genAppType` genHsTyLit field) a) b + genHsApp (genHsApp (genHsVar set_field `genAppType` genHsTyLit field) b) a -mkGet :: Name -> [LHsExpr GhcRn] -> LocatedAn NoEpAnns FieldLabelString -> [LHsExpr GhcRn] -mkGet get_field l@(r : _) (L _ (FieldLabelString field)) = - wrapGenSpan (genHsApp (genHsVar get_field `genAppType` genHsTyLit field) r) : l -mkGet _ [] _ = panic "mkGet : The impossible has happened!" +mkGet :: Name -> NonEmpty (LHsExpr GhcRn) -> LocatedAn NoEpAnns FieldLabelString -> NonEmpty (LHsExpr GhcRn) +mkGet get_field l@(r :| _) (L _ (FieldLabelString field)) = + wrapGenSpan (genHsApp (genHsVar get_field `genAppType` genHsTyLit field) r) NE.<| l mkSet :: Name -> LHsExpr GhcRn -> (LocatedAn NoEpAnns FieldLabelString, LHsExpr GhcRn) -> LHsExpr GhcRn mkSet set_field acc (field, g) = wrapGenSpan (mkSetField set_field g field acc) @@ -2878,10 +2878,10 @@ mkProjUpdateSetField :: Name -> Name -> LHsRecProj GhcRn (LHsExpr GhcRn) -> (LHsExpr GhcRn -> LHsExpr GhcRn) mkProjUpdateSetField get_field set_field (L _ (HsFieldBind { hfbLHS = (L _ (FieldLabelStrings flds')), hfbRHS = arg } )) = let { - ; flds = map (fmap (unLoc . dfoLabel)) flds' + ; flds = NE.map (fmap (unLoc . dfoLabel)) flds' ; final = last flds -- quux ; fields = init flds -- [foo, bar, baz] - ; getters = \a -> foldl' (mkGet get_field) [a] fields -- Ordered from deep to shallow. + ; getters = \a -> foldl' (mkGet get_field) (a :| []) fields -- Ordered from deep to shallow. -- [getField@"baz"(getField@"bar"(getField@"foo" a), getField@"bar"(getField@"foo" a), getField@"foo" a, a] ; zips = \a -> (final, head (getters a)) : zip (reverse fields) (tail (getters a)) -- Ordered from deep to shallow. -- [("quux", getField@"baz"(getField@"bar"(getField@"foo" a)), ("baz", getField@"bar"(getField@"foo" a)), ("bar", getField@"foo" a), ("foo", a)] diff --git a/GHC/Rename/Fixity.hs b/GHC/Rename/Fixity.hs --- a/GHC/Rename/Fixity.hs +++ b/GHC/Rename/Fixity.hs @@ -183,7 +183,7 @@ -- loadInterfaceForName will find B.hi even if B is a hidden module, -- and that's what we want. = do { iface <- loadInterfaceForName doc name - ; let mb_fix = mi_fix_fn (mi_final_exts iface) occ + ; let mb_fix = mi_fix_fn iface occ ; let msg = case mb_fix of Nothing -> text "looking up name" <+> ppr name diff --git a/GHC/Rename/HsType.hs b/GHC/Rename/HsType.hs --- a/GHC/Rename/HsType.hs +++ b/GHC/Rename/HsType.hs @@ -14,14 +14,14 @@ -- Type related stuff rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext, rnLHsKind, rnLHsTypeArgs, - rnHsSigType, rnHsWcType, rnHsTyLit, rnHsArrowWith, + rnHsSigType, rnHsWcType, rnHsTyLit, rnHsMultAnnWith, HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, rnHsPatSigKind, newTyVarNameRn, - rnConDeclFields, + rnHsConDeclRecFields, lookupField, mkHsOpTyRn, rnLTyVar, - rnScaledLHsType, + rnHsConDeclField, -- Precence related stuff NegationHandling(..), @@ -30,6 +30,7 @@ -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, + bindHsForAllTelescopes, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, FreeKiTyVars, filterInScopeM, @@ -37,6 +38,7 @@ extractHsTysRdrTyVars, extractRdrKindSigVars, extractConDeclGADTDetailsTyVars, extractDataDefnKindVars, extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars, + extractHsForAllTelescopes, nubL, nubN, -- Error helpers @@ -450,14 +452,19 @@ rnLHsTypes :: HsDocContext -> [LHsType GhcPs] -> RnM ([LHsType GhcRn], FreeVars) rnLHsTypes doc tys = mapFvRn (rnLHsType doc) tys -rnScaledLHsType :: HsDocContext -> HsScaled GhcPs (LHsType GhcPs) - -> RnM (HsScaled GhcRn (LHsType GhcRn), FreeVars) -rnScaledLHsType doc (HsScaled w ty) = do - (w' , fvs_w) <- rnHsArrow (mkTyKiEnv doc TypeLevel RnTypeBody) w - (ty', fvs) <- rnLHsType doc ty - return (HsScaled w' ty', fvs `plusFV` fvs_w) +rnHsConDeclField :: HsDocContext -> HsConDeclField GhcPs + -> RnM (HsConDeclField GhcRn, FreeVars) +rnHsConDeclField doc = rnHsConDeclFieldTyKi (mkTyKiEnv doc TypeLevel RnTypeBody) +rnHsConDeclFieldTyKi :: RnTyKiEnv -> HsConDeclField GhcPs + -> RnM (HsConDeclField GhcRn, FreeVars) +rnHsConDeclFieldTyKi env cdf@(CDF { cdf_multiplicity, cdf_type, cdf_doc }) = do + (w , fvs_w) <- rnHsMultAnnWith (rnLHsTyKi env) cdf_multiplicity + (ty, fvs) <- rnLHsTyKi env cdf_type + doc <- traverse rnLHsDoc cdf_doc + return (cdf { cdf_multiplicity = w, cdf_type = ty, cdf_doc = doc }, fvs `plusFV` fvs_w) + rnHsType :: HsDocContext -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars) rnHsType ctxt ty = rnHsTyKi (mkTyKiEnv ctxt TypeLevel RnTypeBody) ty @@ -549,16 +556,17 @@ ; when (isDataConName name && not (isPromoted ip)) $ -- NB: a prefix symbolic operator such as (:) is represented as HsTyVar. addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Prefix name) - ; return (HsTyVar noAnn ip (L loc name), unitFV name) } + ; return (HsTyVar noAnn ip (L loc $ WithUserRdr rdr_name name), unitFV name) } rnHsTyKi env ty@(HsOpTy _ prom ty1 l_op ty2) = setSrcSpan (getLocA l_op) $ - do { (l_op', fvs1) <- rnHsTyOp env (ppr ty) l_op + do { let op_rdr = unLoc l_op + ; (l_op', fvs1) <- rnHsTyOp env (ppr ty) l_op ; let op_name = unLoc l_op' ; fix <- lookupTyFixityRn l_op' ; (ty1', fvs2) <- rnLHsTyKi env ty1 ; (ty2', fvs3) <- rnLHsTyKi env ty2 - ; res_ty <- mkHsOpTyRn prom l_op' fix ty1' ty2' + ; res_ty <- mkHsOpTyRn prom (fmap (WithUserRdr op_rdr) l_op') fix ty1' ty2' ; when (isDataConName op_name && not (isPromoted prom)) $ addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name) ; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) } @@ -567,35 +575,10 @@ = do { (ty', fvs) <- rnLHsTyKi env ty ; return (HsParTy noAnn ty', fvs) } -rnHsTyKi env (HsBangTy x b ty) - = do { (ty', fvs) <- rnLHsTyKi env ty - ; return (HsBangTy x b ty', fvs) } - -rnHsTyKi env ty@(HsRecTy _ flds) - = do { let ctxt = rtke_ctxt env - ; fls <- get_fields ctxt - ; (flds', fvs) <- rnConDeclFields ctxt fls flds - ; return (HsRecTy noExtField flds', fvs) } - where - get_fields ctxt@(ConDeclCtx names) - = do res <- concatMapM (lookupConstructorFields . unLoc) names - if equalLength res names - -- Lookup can fail when the record syntax is incorrect, e.g. - -- data D = D Int { fld :: Bool }. See T7943. - then return res - else err ctxt - get_fields ctxt = err ctxt - - err ctxt = - do { addErr $ - TcRnWithHsDocContext ctxt $ - TcRnIllegalRecordSyntax (Left ty) - ; return [] } - rnHsTyKi env (HsFunTy u mult ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 ; (ty2', fvs2) <- rnLHsTyKi env ty2 - ; (mult', w_fvs) <- rnHsArrow env mult + ; (mult', w_fvs) <- rnHsMultAnnWith (rnLHsTyKi env) mult ; return (HsFunTy u mult' ty1' ty2' , plusFVs [fvs1, fvs2, w_fvs]) } @@ -662,7 +645,7 @@ ; return (HsDocTy x ty' haddock_doc', fvs) } -- See Note [Renaming HsCoreTys] -rnHsTyKi env (XHsType ty) +rnHsTyKi env (XHsType (HsCoreTy ty)) = do mapM_ (check_in_scope . nameRdrName) fvs_list return (XHsType ty, fvs) where @@ -675,8 +658,25 @@ when (isNothing mb_name) $ addErr $ TcRnWithHsDocContext (rtke_ctxt env) $ - TcRnNotInScope (notInScopeErr WL_LocalOnly rdr_name) rdr_name [] [] + TcRnNotInScope (notInScopeErr WL_LocalOnly rdr_name) rdr_name +rnHsTyKi env ty@(XHsType (HsBangTy _ bang (L _ inner))) = do + -- While top-level bangs at this point are eliminated (eg !(Maybe Int)), + -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of + -- bangs are invalid, so fail. (#7210, #14761) + addErr $ + TcRnWithHsDocContext (rtke_ctxt env) $ + TcRnUnexpectedAnnotation ty bang + rnHsTyKi env inner + +rnHsTyKi env ty@(XHsType (HsRecTy {})) = do + -- Record types (which only show up temporarily in constructor + -- signatures) should have been removed by now + addErr $ + TcRnWithHsDocContext (rtke_ctxt env) $ + TcRnIllegalRecordSyntax ty + return (HsWildCardTy noExtField, emptyFVs) -- trick to avoid `failWithTc` + rnHsTyKi env ty@(HsExplicitListTy _ ip tys) = do { checkDataKinds env ty ; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys @@ -703,15 +703,12 @@ rnHsTyLit (HsCharTy x c) = pure (HsCharTy x c) -rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars) -rnHsArrow env = rnHsArrowWith (rnLHsTyKi env) - -rnHsArrowWith :: (LocatedA (mult GhcPs) -> RnM (LocatedA (mult GhcRn), FreeVars)) - -> HsArrowOf (LocatedA (mult GhcPs)) GhcPs - -> RnM (HsArrowOf (LocatedA (mult GhcRn)) GhcRn, FreeVars) -rnHsArrowWith _rn (HsUnrestrictedArrow _) = pure (HsUnrestrictedArrow noExtField, emptyFVs) -rnHsArrowWith _rn (HsLinearArrow _) = pure (HsLinearArrow noExtField, emptyFVs) -rnHsArrowWith rn (HsExplicitMult _ p) +rnHsMultAnnWith :: (LocatedA (mult GhcPs) -> RnM (LocatedA (mult GhcRn), FreeVars)) + -> HsMultAnnOf (LocatedA (mult GhcPs)) GhcPs + -> RnM (HsMultAnnOf (LocatedA (mult GhcRn)) GhcRn, FreeVars) +rnHsMultAnnWith _rn (HsUnannotated _) = pure (HsUnannotated noExtField, emptyFVs) +rnHsMultAnnWith _rn (HsLinearAnn _) = pure (HsLinearAnn noExtField, emptyFVs) +rnHsMultAnnWith rn (HsExplicitMult _ p) = (\(mult, fvs) -> (HsExplicitMult noExtField mult, fvs)) <$> rn p {- @@ -825,6 +822,7 @@ ExprWithTySigCtx {} -> True PatCtx {} -> True RuleCtx {} -> True + SpecECtx {} -> True FamPatCtx {} -> True -- Not named wildcards though GHCiCtx {} -> True HsTypeCtx {} -> True @@ -1144,6 +1142,17 @@ checkForAllTelescopeWildcardBndrs doc bndrs' thing_inside $ mkHsForAllInvisTele noAnn bndrs' +bindHsForAllTelescopes :: HsDocContext + -> [HsForAllTelescope GhcPs] + -> ([HsForAllTelescope GhcRn] -> RnM (a, FreeVars)) + -> RnM (a, FreeVars) +bindHsForAllTelescopes _ [] thing_inside = + thing_inside [] +bindHsForAllTelescopes doc (tele:teles) thing_inside = + bindHsForAllTelescope doc tele $ \tele' -> + bindHsForAllTelescopes doc teles $ \teles' -> + thing_inside (tele':teles') + -- See Note [Wildcard binders in disallowed contexts] in GHC.Hs.Type checkForAllTelescopeWildcardBndrs :: HsDocContext -> [LHsTyVarBndr flag (GhcPass p)] @@ -1310,34 +1319,33 @@ {- ********************************************************* * * - ConDeclField + HsConDeclRecField * * ********************************************************* -When renaming a ConDeclField, we have to find the FieldLabel +When renaming a HsConDeclRecField, we have to find the FieldLabel associated with each field. But we already have all the FieldLabels available (since they were brought into scope by GHC.Rename.Names.getLocalNonValBinders), so we just take the list as an argument, build a map and look them up. -} -rnConDeclFields :: HsDocContext -> [FieldLabel] -> [LConDeclField GhcPs] - -> RnM ([LConDeclField GhcRn], FreeVars) +rnHsConDeclRecFields :: HsDocContext -> [FieldLabel] -> [LHsConDeclRecField GhcPs] + -> RnM ([LHsConDeclRecField GhcRn], FreeVars) -- Also called from GHC.Rename.Module -- No wildcards can appear in record fields -rnConDeclFields ctxt fls fields +rnHsConDeclRecFields ctxt fls fields = mapFvRn (rnField fl_env env) fields where env = mkTyKiEnv ctxt TypeLevel RnTypeBody fl_env = mkFsEnv [ (field_label $ flLabel fl, fl) | fl <- fls ] -rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs - -> RnM (LConDeclField GhcRn, FreeVars) -rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) +rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LHsConDeclRecField GhcPs + -> RnM (LHsConDeclRecField GhcRn, FreeVars) +rnField fl_env env (L l (HsConDeclRecField _ names ty)) = do { let new_names = map (fmap (lookupField fl_env)) names - ; (new_ty, fvs) <- rnLHsTyKi env ty - ; haddock_doc' <- traverse rnLHsDoc haddock_doc - ; return (L l (ConDeclField noAnn new_names new_ty haddock_doc') + ; (new_ty, fvs) <- rnHsConDeclFieldTyKi env ty + ; return (L l (HsConDeclRecField noExtField new_names new_ty) , fvs) } lookupField :: FastStringEnv FieldLabel -> FieldOcc GhcPs -> FieldOcc GhcRn @@ -1346,7 +1354,7 @@ where lbl = occNameFS $ rdrNameOcc rdr sel = flSelector - $ expectJust "lookupField" + $ expectJust $ lookupFsEnv fl_env lbl {- @@ -1381,19 +1389,19 @@ --------------- -- Building (ty1 `op1` (ty2a `op2` ty2b)) mkHsOpTyRn :: PromotionFlag - -> LocatedN Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn + -> LocatedN (WithUserRdr Name) -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> RnM (HsType GhcRn) mkHsOpTyRn prom1 op1 fix1 ty1 (L loc2 (HsOpTy _ prom2 ty2a op2 ty2b)) - = do { fix2 <- lookupTyFixityRn op2 + = do { fix2 <- lookupTyFixityRn (fmap getName op2) ; mk_hs_op_ty prom1 op1 fix1 ty1 prom2 op2 fix2 ty2a ty2b loc2 } mkHsOpTyRn prom1 op1 _ ty1 ty2 -- Default case, no rearrangement = return (HsOpTy noExtField prom1 ty1 op1 ty2) --------------- -mk_hs_op_ty :: PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn - -> PromotionFlag -> LocatedN Name -> Fixity -> LHsType GhcRn +mk_hs_op_ty :: PromotionFlag -> LocatedN (WithUserRdr Name) -> Fixity -> LHsType GhcRn + -> PromotionFlag -> LocatedN (WithUserRdr Name) -> Fixity -> LHsType GhcRn -> LHsType GhcRn -> SrcSpanAnnA -> RnM (HsType GhcRn) mk_hs_op_ty prom1 op1 fix1 ty1 prom2 op2 fix2 ty2a ty2b loc2 @@ -1466,10 +1474,10 @@ ---------------------------- get_op :: LHsExpr GhcRn -> OpName --- An unbound name could be either HsVar or HsUnboundVar +-- An unbound name could be either HsVar or (HsHole (HoleVar _, _)) -- See GHC.Rename.Expr.rnUnboundVar get_op (L _ (HsVar _ n)) = NormalOp (unLoc n) -get_op (L _ (HsUnboundVar _ uv)) = UnboundOp uv +get_op (L _ (HsHole (HoleVar (L _ uv)))) = UnboundOp uv get_op (L _ (XExpr (HsRecSelRn fld))) = RecFldOp fld get_op other = pprPanic "get_op" (ppr other) @@ -1496,11 +1504,12 @@ not_op_app _ = True -------------------------------------- -mkConOpPatRn :: LocatedN Name -> Fixity -> LPat GhcRn -> LPat GhcRn +mkConOpPatRn :: LocatedN (WithUserRdr Name) + -> Fixity -> LPat GhcRn -> LPat GhcRn -> RnM (Pat GhcRn) mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p1a p1b))) p2 - = do { fix1 <- lookupFixityRn (unLoc op1) + = do { fix1 <- lookupFixityRn (getName op1) ; let (nofix_error, associate_right) = compareFixity fix1 fix2 ; if nofix_error then do @@ -1508,7 +1517,7 @@ (NormalOp (unLoc op2),fix2) ; return $ ConPat { pat_con_ext = noExtField - , pat_con = op2 + , pat_con = op2 , pat_args = InfixCon p1 p2 } } @@ -1569,14 +1578,14 @@ checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) () checkPrec op (ConPat NoExtField op1 (InfixCon _ _)) right = do op_fix@(Fixity op_prec op_dir) <- lookupFixityRn op - op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1) + op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (getName op1) let inf_ok = op1_prec > op_prec || (op1_prec == op_prec && (op1_dir == InfixR && op_dir == InfixR && right || op1_dir == InfixL && op_dir == InfixL && not right)) - info = (NormalOp op, op_fix) + info = (NormalOp (noUserRdr op), op_fix) info1 = (NormalOp (unLoc op1), op1_fix) (infol, infor) = if right then (info, info1) else (info1, info) unless inf_ok (precParseErr infol infor) @@ -1606,7 +1615,7 @@ -- | Look up the fixity for an operator name. lookupFixityOp :: OpName -> RnM Fixity -lookupFixityOp (NormalOp n) = lookupFixityRn n +lookupFixityOp (NormalOp n) = lookupFixityRn (getName n) lookupFixityOp NegateOp = lookupFixityRn negateName lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (occName u)) lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f @@ -1628,7 +1637,7 @@ = addErr $ TcRnSectionPrecedenceError op arg_op section is_unbound :: OpName -> Bool -is_unbound (NormalOp n) = isUnboundName n +is_unbound (NormalOp n) = isUnboundName (getName n) is_unbound UnboundOp{} = True is_unbound _ = False @@ -2031,7 +2040,7 @@ HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars extractConDeclGADTDetailsTyVars con_args = case con_args of PrefixConGADT _ args -> extract_scaled_ltys args - RecConGADT _ (L _ flds) -> extract_ltys $ map (cd_fld_type . unLoc) $ flds + RecConGADT _ (L _ flds) -> extract_scaled_ltys $ map (cdrf_spec . unLoc) $ flds -- | Get type/kind variables mentioned in the kind signature, preserving -- left-to-right order: @@ -2047,13 +2056,14 @@ extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars extract_lctxt ctxt = extract_ltys (unLoc ctxt) -extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)] +extract_scaled_ltys :: [HsConDeclField GhcPs] -> FreeKiTyVars -> FreeKiTyVars extract_scaled_ltys args acc = foldr extract_scaled_lty acc args -extract_scaled_lty :: HsScaled GhcPs (LHsType GhcPs) +extract_scaled_lty :: HsConDeclField GhcPs -> FreeKiTyVars -> FreeKiTyVars -extract_scaled_lty (HsScaled m ty) acc = extract_lty ty $ extract_hs_arrow m acc +extract_scaled_lty (CDF { cdf_multiplicity, cdf_type }) acc + = extract_lty cdf_type $ extract_hs_mult_ann cdf_multiplicity acc extract_ltys :: [LHsType GhcPs] -> FreeKiTyVars -> FreeKiTyVars extract_ltys tys acc = foldr extract_lty acc tys @@ -2062,10 +2072,6 @@ extract_lty (L _ ty) acc = case ty of HsTyVar _ _ ltv -> extract_tv ltv acc - HsBangTy _ _ ty -> extract_lty ty acc - HsRecTy _ flds -> foldr (extract_lty - . cd_fld_type . unLoc) acc - flds HsAppTy _ ty1 ty2 -> extract_lty ty1 $ extract_lty ty2 acc HsAppKindTy _ ty k -> extract_lty ty $ @@ -2074,7 +2080,7 @@ HsTupleTy _ _ tys -> extract_ltys tys acc HsSumTy _ tys -> extract_ltys tys acc HsFunTy _ m ty1 ty2 -> extract_lty ty1 $ - extract_hs_arrow m $ -- See Note [Ordering of implicit variables] + extract_hs_mult_ann m $ -- See Note [Ordering of implicit variables] extract_lty ty2 acc HsIParamTy _ _ ty -> extract_lty ty acc HsOpTy _ _ ty1 tv ty2 -> extract_lty ty1 $ @@ -2115,10 +2121,9 @@ extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = extractHsOuterTvBndrs outer_bndrs $ extract_lty body [] -extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars -> - FreeKiTyVars -extract_hs_arrow (HsExplicitMult _ p) acc = extract_lty p acc -extract_hs_arrow _ acc = acc +extract_hs_mult_ann :: HsMultAnn GhcPs -> FreeKiTyVars -> FreeKiTyVars +extract_hs_mult_ann (HsExplicitMult _ p) acc = extract_lty p acc +extract_hs_mult_ann _ acc = acc extract_hs_for_all_telescope :: HsForAllTelescope GhcPs -> FreeKiTyVars -- Accumulator @@ -2138,6 +2143,14 @@ case outer_bndrs of HsOuterImplicit{} -> body_fvs HsOuterExplicit{hso_bndrs = bndrs} -> extract_hs_tv_bndrs bndrs [] body_fvs + +extractHsForAllTelescopes :: [HsForAllTelescope GhcPs] + -> FreeKiTyVars -- Free in body + -> FreeKiTyVars -- Free in result +extractHsForAllTelescopes [] body_fvs = body_fvs +extractHsForAllTelescopes (tele:teles) body_fvs = + extract_hs_for_all_telescope tele [] $ + extractHsForAllTelescopes teles body_fvs extract_hs_tv_bndrs :: [LHsTyVarBndr flag GhcPs] -> FreeKiTyVars -- Accumulator diff --git a/GHC/Rename/Module.hs b/GHC/Rename/Module.hs --- a/GHC/Rename/Module.hs +++ b/GHC/Rename/Module.hs @@ -1,13 +1,16 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -24,26 +27,23 @@ import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls ) import GHC.Hs -import GHC.Types.FieldLabel -import GHC.Types.Name.Reader + import GHC.Rename.HsType import GHC.Rename.Bind import GHC.Rename.Doc import GHC.Rename.Env import GHC.Rename.Utils ( mapFvRn, bindLocalNames , checkDupRdrNames, bindLocalNamesFV - , checkShadowedRdrNames, warnUnusedTypePatterns - , newLocalBndrsRn + , warnUnusedTypePatterns , noNestedForallsContextsErr , addNoNestedForallsContextsErr, checkInferredVars ) import GHC.Rename.Unbound ( mkUnboundName, notInScopeErr, WhereLooking(WL_Global) ) import GHC.Rename.Names + import GHC.Tc.Errors.Types -import GHC.Tc.Gen.Annotation ( annCtxt ) import GHC.Tc.Utils.Monad import GHC.Tc.Types.Origin ( TypedThing(..) ) -import GHC.Types.ForeignCall ( CCallTarget(..) ) import GHC.Unit import GHC.Unit.Module.Warnings import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName @@ -51,23 +51,30 @@ , semigroupClassName, sappendName , monoidClassName, mappendName ) + +import GHC.Types.FieldLabel +import GHC.Types.Name.Reader +import GHC.Types.ForeignCall ( CCallTarget(..) ) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Utils.Outputable -import GHC.Types.Basic (Arity) -import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Data.FastString +import GHC.Types.Basic ( VisArity, TyConFlavour(..), TypeOrKind(..), RuleName ) +import GHC.Types.GREInfo (ConLikeInfo (..), ConInfo, mkConInfo, conInfoFields) +import GHC.Types.Hint (SigLike(..)) +import GHC.Types.Unique.Set import GHC.Types.SrcLoc as SrcLoc + import GHC.Driver.DynFlags -import GHC.Utils.Misc ( lengthExceeds, partitionWith ) -import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) + +import GHC.Utils.Misc ( lengthExceeds ) +import GHC.Utils.Panic +import GHC.Utils.Outputable + +import GHC.Data.FastString import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) -import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..) +import GHC.Data.Graph.Directed ( SCC, flattenSCC, Node(..) , stronglyConnCompFromEdgedVerticesUniq ) -import GHC.Types.GREInfo (ConLikeInfo (..), ConInfo, mkConInfo, conInfoFields) -import GHC.Types.Unique.Set import GHC.Data.OrdList import qualified GHC.LanguageExtensions as LangExt import GHC.Core.DataCon ( isSrcStrict ) @@ -75,7 +82,6 @@ import Control.Monad import Control.Arrow ( first ) import Data.Foldable ( toList, for_ ) -import Data.List ( mapAccumL ) import Data.List.NonEmpty ( NonEmpty(..), head, nonEmpty ) import Data.Maybe ( isNothing, fromMaybe, mapMaybe, maybeToList ) import qualified Data.Set as Set ( difference, fromList, toList, null ) @@ -216,7 +222,8 @@ last_tcg_env0 <- getGblEnv ; let { last_tcg_env = last_tcg_env0 - { tcg_complete_matches = tcg_complete_matches last_tcg_env0 ++ localCompletePragmas sigs' } + { tcg_complete_matches = tcg_complete_matches last_tcg_env0 ++ localCompletePragmas sigs' + , tcg_complete_match_env = tcg_complete_match_env last_tcg_env0 ++ localCompletePragmas sigs'} } ; -- (I) Compute the results and return let {rn_group = HsGroup { hs_ext = noExtField, @@ -293,7 +300,7 @@ rn_deprec w@(Warning (ns_spec, _) rdr_names txt) -- ensures that the names are defined locally - = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what ns_spec . unLoc) + = do { names <- concatMapM (lookupLocalTcNames sig_ctxt SigLikeDeprecation ns_spec . unLoc) rdr_names ; unlessXOptM LangExt.ExplicitNamespaces $ when (ns_spec /= NoNamespaceSpecifier) $ @@ -304,8 +311,6 @@ -- as we might hit multiple different NameSpaces when looking up -- (e.g. deprecating both a variable and a record field). - what = text "deprecation" - warn_rdr_dups = find_dup_warning_names $ concatMap (\(L _ (Warning (ns_spec, _) ns _)) -> (ns_spec,) <$> ns) decls @@ -342,9 +347,10 @@ rnAnnDecl :: AnnDecl GhcPs -> RnM (AnnDecl GhcRn, FreeVars) rnAnnDecl ann@(HsAnnotation (_, s) provenance expr) - = addErrCtxt (annCtxt ann) $ + = addErrCtxt (AnnCtxt ann) $ do { (provenance', provenance_fvs) <- rnAnnProvenance provenance - ; (expr', expr_fvs) <- setStage (Splice Untyped) $ + ; cur_level <- getThLevel + ; (expr', expr_fvs) <- setThLevel (Splice Untyped cur_level) $ rnLExpr expr ; return (HsAnnotation (noAnn, s) provenance' expr', provenance_fvs `plusFV` expr_fvs) } @@ -354,9 +360,9 @@ rnAnnProvenance provenance = do provenance' <- case provenance of ValueAnnProvenance n -> ValueAnnProvenance - <$> lookupLocatedTopBndrRnN n + <$> lookupLocatedTopBndrRnN WL_Term n TypeAnnProvenance n -> TypeAnnProvenance - <$> lookupLocatedTopConstructorRnN n + <$> lookupLocatedTopBndrRnN WL_Type n ModuleAnnProvenance -> return ModuleAnnProvenance return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance')) @@ -371,7 +377,7 @@ rnDefaultDecl :: DefaultDecl GhcPs -> RnM (DefaultDecl GhcRn, FreeVars) rnDefaultDecl (DefaultDecl _ mb_cls tys) = do { - ; mb_cls' <- traverse (traverse lookupOccRn) mb_cls + ; mb_cls' <- traverse (traverse $ lookupOccRn WL_TyCon) mb_cls ; (tys', ty_fvs) <- rnLHsTypes doc_str tys ; return (DefaultDecl noExtField mb_cls' tys', ty_fvs) } where @@ -388,7 +394,7 @@ rnHsForeignDecl :: ForeignDecl GhcPs -> RnM (ForeignDecl GhcRn, FreeVars) rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec }) = do { topEnv :: HscEnv <- getTopEnv - ; name' <- lookupLocatedTopBndrRnN name + ; name' <- lookupLocatedTopBndrRnN WL_TermVariable name ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty -- Mark any PackageTarget style imports as coming from the current package @@ -400,7 +406,7 @@ , fd_fi = spec' }, fvs) } rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec }) - = do { name' <- lookupLocatedOccRn name + = do { name' <- lookupLocatedOccRn WL_TermVariable name ; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty ; return (ForeignExport { fd_e_ext = noExtField , fd_name = name', fd_sig_ty = ty' @@ -559,9 +565,10 @@ isAliasMG :: MatchGroup GhcRn (LHsExpr GhcRn) -> Maybe Name isAliasMG MG {mg_alts = (L _ [L _ (Match { m_pats = L _ [] , m_grhss = grhss })])} - | GRHSs _ [L _ (GRHS _ [] body)] lbinds <- grhss + | GRHSs _ (L _ (GRHS _ [] body) :| []) lbinds <- grhss , EmptyLocalBinds _ <- lbinds - , HsVar _ lrhsName <- unLoc body = Just (unLoc lrhsName) + , HsVar _ lrhsName <- unLoc body + = Just (getName lrhsName) isAliasMG _ = Nothing addWarnNonCanonicalMonoid reason = @@ -579,34 +586,59 @@ , cid_sigs = uprags, cid_tyfam_insts = ats , cid_overlap_mode = oflag , cid_datafam_insts = adts }) - = do { checkInferredVars ctxt inst_ty - ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty - ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty' - -- Check if there are any nested `forall`s or contexts, which are - -- illegal in the type of an instance declaration (see - -- Note [No nested foralls or contexts in instance types] in - -- GHC.Hs.Type)... - mb_nested_msg = noNestedForallsContextsErr - NFC_InstanceHead head_ty' - -- ...then check if the instance head is actually headed by a - -- class type constructor... - eith_cls = case hsTyGetAppHead_maybe head_ty' of - Just (L _ cls) -> Right cls - Nothing -> - Left - ( getLocA head_ty' - , TcRnIllegalInstance $ - IllegalClassInstance (HsTypeRnThing $ unLoc head_ty') $ - IllegalInstanceHead $ InstHeadNonClass Nothing - ) + = do { rec { let ctxt = ClassInstanceCtx head_ty' + ; checkInferredVars ctxt inst_ty + ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty + ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty' + } + ; env <- getGlobalRdrEnv + ; let + -- Check if there are any nested `forall`s or contexts, which are + -- illegal in the type of an instance declaration (see + -- Note [No nested foralls or contexts in instance types] in + -- GHC.Hs.Type)... + mb_nested_msg = noNestedForallsContextsErr NFC_InstanceHead head_ty' + -- ...then check if the instance head is actually headed by a + -- class type constructor... + instance_head :: Either IllegalInstanceHeadReason Name + instance_head = + case hsTyGetAppHead_maybe head_ty' of + Just (L _ nm_with_rdr) -> + let nm = getName nm_with_rdr in + case lookupGRE_Name env nm of + Just (GRE { gre_info = IAmTyCon flav }) -> + if + | flav == ClassFlavour + -> Right nm + | flav == AbstractTypeFlavour + -> Left $ InstHeadAbstractClass nm_with_rdr + | otherwise + -> Left $ InstHeadNonClassHead $ InstNonClassTyCon nm_with_rdr flav + _ -> + -- The head of the instance head is out of scope; + -- we'll deal with that later. Continue for now. + Right nm + + Nothing -> + Left $ InstHeadNonClassHead InstNonTyCon + eith_cls = + case instance_head of + Right cls -> Right cls + Left illegal_head_reason -> + Left + ( getLocA head_ty' + , TcRnIllegalInstance $ + IllegalClassInstance (HsTypeRnThing $ unLoc head_ty') $ + IllegalInstanceHead illegal_head_reason + ) -- ...finally, attempt to retrieve the class type constructor, failing -- with an error message if there isn't one. To avoid excessive -- amounts of error messages, we will only report one of the errors -- from mb_nested_msg or eith_cls at a time. ; cls <- case (mb_nested_msg, eith_cls) of (Nothing, Right cls) -> pure cls - (Just err1, _) -> bail_out err1 - (_, Left err2) -> bail_out err2 + (Just err1, _) -> bail_out ctxt err1 + (_, Left err2) -> bail_out ctxt err2 -- Rename the bindings -- The typechecker (not the renamer) checks that all @@ -646,14 +678,12 @@ -- strange, but should not matter (and it would be more work -- to remove the context). where - ctxt = GenericCtx $ text "an instance declaration" - -- The instance is malformed. We'd still like to make *some* progress -- (rather than failing outright), so we report an error and continue for -- as long as we can. Importantly, this error should be thrown before we -- reach the typechecker, lest we encounter different errors that are -- hopelessly confusing (such as the one in #16114). - bail_out (l, err_msg) = do + bail_out ctxt (l, err_msg) = do addErrAt l $ TcRnWithHsDocContext ctxt err_msg pure $ mkUnboundName (mkTcOccFS (fsLit "")) @@ -717,7 +747,7 @@ groups :: [NonEmpty (LocatedN RdrName)] groups = equivClasses cmpLocated pat_kity_vars - ; nms_dups <- mapM (lookupOccRn . unLoc) $ + ; nms_dups <- mapM (lookupOccRn WL_TyVar . unLoc) $ [ tv | (tv :| (_:_)) <- groups ] -- Add to the used variables -- a) any variables that appear *more than once* on the LHS @@ -1160,65 +1190,23 @@ , rds_rules = rn_rules }, fvs) } rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars) -rnHsRuleDecl (HsRule { rd_ext = (_, st) - , rd_name = rule_name - , rd_act = act - , rd_tyvs = tyvs - , rd_tmvs = tmvs - , rd_lhs = lhs - , rd_rhs = rhs }) - = do { let rdr_names_w_loc = map (get_var . unLoc) tmvs - ; checkDupRdrNames rdr_names_w_loc - ; checkShadowedRdrNames rdr_names_w_loc - ; names <- newLocalBndrsRn rdr_names_w_loc - ; let doc = RuleCtx (unLoc rule_name) - ; bindRuleTyVars doc tyvs $ \ tyvs' -> - bindRuleTmVars doc tyvs' tmvs names $ \ tmvs' -> +rnHsRuleDecl (HsRule { rd_ext = (_, st) + , rd_name = lrule_name@(L _ rule_name) + , rd_act = act + , rd_bndrs = bndrs + , rd_lhs = lhs + , rd_rhs = rhs }) + = bindRuleBndrs (RuleCtx rule_name) bndrs $ \tm_names bndrs' -> do { (lhs', fv_lhs') <- rnLExpr lhs ; (rhs', fv_rhs') <- rnLExpr rhs - ; checkValidRule (unLoc rule_name) names lhs' fv_lhs' - ; return (HsRule { rd_ext = (HsRuleRn fv_lhs' fv_rhs', st) - , rd_name = rule_name - , rd_act = act - , rd_tyvs = tyvs' - , rd_tmvs = tmvs' - , rd_lhs = lhs' - , rd_rhs = rhs' }, fv_lhs' `plusFV` fv_rhs') } } - where - get_var :: RuleBndr GhcPs -> LocatedN RdrName - get_var (RuleBndrSig _ v _) = v - get_var (RuleBndr _ v) = v - -bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs - -> [LRuleBndr GhcPs] -> [Name] - -> ([LRuleBndr GhcRn] -> RnM (a, FreeVars)) - -> RnM (a, FreeVars) -bindRuleTmVars doc tyvs vars names thing_inside - = go vars names $ \ vars' -> - bindLocalNamesFV names (thing_inside vars') - where - go ((L l (RuleBndr _ (L loc _))) : vars) (n : ns) thing_inside - = go vars ns $ \ vars' -> - thing_inside (L l (RuleBndr noAnn (L loc n)) : vars') - - go ((L l (RuleBndrSig _ (L loc _) bsig)) : vars) - (n : ns) thing_inside - = rnHsPatSigType bind_free_tvs doc bsig $ \ bsig' -> - go vars ns $ \ vars' -> - thing_inside (L l (RuleBndrSig noAnn (L loc n) bsig') : vars') - - go [] [] thing_inside = thing_inside [] - go vars names _ = pprPanic "bindRuleVars" (ppr vars $$ ppr names) - - bind_free_tvs = case tyvs of Nothing -> AlwaysBind - Just _ -> NeverBind - -bindRuleTyVars :: HsDocContext -> Maybe [LHsTyVarBndr () GhcPs] - -> (Maybe [LHsTyVarBndr () GhcRn] -> RnM (b, FreeVars)) - -> RnM (b, FreeVars) -bindRuleTyVars doc (Just bndrs) thing_inside - = bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs (thing_inside . Just) -bindRuleTyVars _ _ thing_inside = thing_inside Nothing + ; checkValidRule rule_name tm_names lhs' fv_lhs' + ; return (HsRule { rd_ext = (HsRuleRn fv_lhs' fv_rhs', st) + , rd_name = lrule_name + , rd_act = act + , rd_bndrs = bndrs' + , rd_lhs = lhs' + , rd_rhs = rhs' } + , fv_lhs' `plusFV` fv_rhs') } {- Note [Rule LHS validity checking] @@ -1245,7 +1233,7 @@ So we should accommodate them. -} -checkValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM () +checkValidRule :: RuleName -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM () checkValidRule rule_name ids lhs' fv_lhs' = do { -- Check for the form of the LHS case (validRuleLhs ids lhs') of @@ -1269,7 +1257,7 @@ check (HsApp _ e1 e2) = checkl e1 `mplus` checkl_e e2 check (HsAppType _ e _) = checkl e check (HsVar _ lv) - | (unLoc lv) `notElem` foralls = Nothing + | getName lv `notElem` foralls = Nothing -- See Note [Parens on the LHS of a RULE] check (HsPar _ e) = checkl e check other = Just other -- Failure @@ -1299,7 +1287,7 @@ = TcRnIllegalRuleLhs errReason name lhs bad_e where errReason = case bad_e of - HsUnboundVar _ uv -> + HsHole (HoleVar (L _ uv)) -> UnboundVariable uv $ notInScopeErr WL_Global uv _ -> IllegalExpression @@ -1322,13 +1310,12 @@ and then go over it again to rename the tyvars! However, we can also do some scoping checks at the same time. -Note [Dependency analysis of type, class, and instance decls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A TyClGroup represents a strongly connected components of -type/class/instance decls, together with the role annotations for the -type/class declarations. The renamer uses strongly connected -component analysis to build these groups. We do this for a number of -reasons: +Note [Dependency analysis of type and class decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A TyClGroup represents a strongly connected component of type/class/instance +decls, together with the role annotations and standalone kind signatures for the +type/class declarations. The renamer uses strongly connected component analysis +to build these groups. We do this for a number of reasons: * Improve kind error messages. Consider @@ -1340,90 +1327,153 @@ inference together, you might get an error reported in S, which is jolly confusing. See #4875 - * Increase kind polymorphism. See GHC.Tc.TyCl Note [Grouping of type and class declarations] -Why do the instance declarations participate? At least two reasons +What about instances? Based on a number of tickets (#12088, #12239, #14668, +#15561, #16410, #16448, #16693, #19611, #20875, #21172, #22257, #25238, #25834, +etc) we concluded that we cannot handle them at this stage. -* Consider (#11348) +It is not possible, by looking at the free variables of a declaration, to +determine which instances a declaration depends on; furthermore, it is not +possible to discover dependencies between instances, for the same reason. - type family F a - type instance F Int = Bool +Previously GHC inserted instances at the earliest positions where their FVs are +bound, but it only helped with a subset of tickets. The current approach is to +accept that the dependency analysis here is incomplete and recover in the kind +checker with a retrying mechanism. See Note [Retrying TyClGroups] in GHC.Tc.TyCl - data R = MkR (F Int) +------------------------------------ +So much for why we want SCCs. What about how and when we construct them? - type Foo = 'MkR 'True +First, an overview: + (TCDEP1) Flatten TyClGroups from the parser + (TCDEP2) Rename the type/class declarations, standalone kind signatures, role + declarations, and instances individually + (TCDEP3) Preprocess FVs and build a dependency graph + (TCDEP4) Find strongly connected components (SCCs) of declarations + (TCDEP5) Attach roles and kind signatures to the appropriate SCC + (TCDEP6) Create one singleton "SCC" per instance and put them at the end - For Foo to kind-check we need to know that (F Int) ~ Bool. But we won't - know that unless we've looked at the type instance declaration for F - before kind-checking Foo. +And now the deep dive: -* Another example is this (#3990). +(TCDEP1) We start with a `HsGroup GhcPs`, containing a `[TyClGroup GhcPs]`: + a big pile of declarations. It is not important how the parser distributes + declarations across those TyClGroups, as the first thing we do in `rnTyClDecls` + is flatten them using a few helpers: - data family Complex a - data instance Complex Double = CD {-# UNPACK #-} !Double - {-# UNPACK #-} !Double + tyClGroupTyClDecls = Data.List.concatMap group_tyclds + tyClGroupInstDecls = Data.List.concatMap group_instds + tyClGroupRoleDecls = Data.List.concatMap group_roles + tyClGroupKindSigs = Data.List.concatMap group_kisigs - data T = T {-# UNPACK #-} !(Complex Double) + In practice, the parser just puts all declarations in a single `TyClGroup`, + so the `concatMap` is a no-op. - Here, to generate the right kind of unpacked implementation for T, - we must have access to the 'data instance' declaration. +(TCDEP2) Rename each declaration separately, yielding the following lists + in `rnTyClDecls`: -* Things become more complicated when we introduce transitive - dependencies through imported definitions, like in this scenario: + tycls_w_fvs :: [(LTyClDecl GhcRn, FreeVars)] + instds_w_fvs :: [(LInstDecl GhcRn, FreeVars)] + kisigs_w_fvs :: [(LStandaloneKindSig GhcRn, FreeVars)] + role_annots :: [LRoleAnnotDecl GhcRn] - A.hs - type family Closed (t :: Type) :: Type where - Closed t = Open t + The `FreeVars` are the free type/data constructors of the decl. For example: - type family Open (t :: Type) :: Type + type family F (a :: k) -- FVs: {} + data X = MkX Char (Maybe X) -- FVs: {Char, Maybe, X} + data Y = MkY X (Maybe Y) -- FVs: {Maybe, Y, X} + type instance F MkX = X -- FVs: {F, MkX, X} + type instance F MkY = Int -- FVs: {F, MkY, Int} - B.hs - data Q where - Q :: Closed Bool -> Q +(TCDEP3) Build a graph where each node is a `TyClDecl` keyed by its name, and + its `FreeVars` give rise to edges. Happens in `depAnalTyClDecls`. Examples: - type instance Open Int = Bool + data A x = MkA x -- node `A`, edges: {} + data B x = MkB (A x) -- node `B`, edges: {B -> A} + data C = MkC (B C) -- node `C`, edges: {C -> B, C -> C} - type S = 'Q 'True + The `FreeVars` are not used "as is" to create the edges. They first undergo a + few transformations. - Somehow, we must ensure that the instance Open Int = Bool is checked before - the type synonym S. While we know that S depends upon 'Q depends upon Closed, - we have no idea that Closed depends upon Open! + (TCDEP3.fvs_kisig) If a standalone kind signature is present, add its free + variables to those of the declaration. Consider: - To accommodate for these situations, we ensure that an instance is checked - before every @TyClDecl@ on which it does not depend. That's to say, instances - are checked as early as possible in @tcTyAndClassDecls@. + data A = MkA + data B = MkB ------------------------------------- -So much for WHY. What about HOW? It's pretty easy: + type P :: A -> Type -- sig FVs: {A, Type} + data P x = MkP (Proxy MkB) -- decl FVs: {Proxy, MkB} -(1) Rename the type/class, instance, and role declarations - individually + By adding the sig and decl FVs together, we get {A, Type, Proxy, MkB}. + Then proceed to the next step. -(2) Do strongly-connected component analysis of the type/class decls, - We'll make a TyClGroup for each SCC + (TCDEP3.fvs_parent) Replace any mention of a (promoted) data constructor + with its parent TyCon. Consider the FVs from the previous step: - In this step we treat a reference to a (promoted) data constructor - K as a dependency on its parent type. Thus - data T = K1 | K2 - data S = MkS (Proxy 'K1) - Here S depends on 'K1 and hence on its parent T. + the name set {A, Type, Proxy, MkB} + turns into {A, Type, Proxy, B} - In this step we ignore instances; see - Note [No dependencies on data instances] + MkB does not get its own node in the graph, so an edge to it must actually + point to B. -(3) Attach roles to the appropriate SCC + (TCDEP3.fvs_nogbl) Filter out references to type constructors outside this + `HsGroup`. They just clutter things up: -(4) Attach instances to the appropriate SCC. - We add an instance decl to SCC when: - all its free types/classes are bound in this SCC or earlier ones + the name set {A, Type, Proxy, B} + turns into {A, B} -(5) We make an initial TyClGroup, with empty group_tyclds, for any - (orphan) instances that affect only imported types/classes + Note [Prepare TyClGroup FVs] describes these transformations in more detail. + Back to our `P` example, the final nodes and edges are as follows: -Steps (3) and (4) are done by the (mapAccumL mk_group) call. + data A = MkA -- node `A`, edges: {} + data B = MkB -- node `B`, edges: {} + type P :: A -> Type + data P x = MkP (Proxy MkB) -- node `P`, edges: {P -> A, P -> B} + +(TCDEP4) Find strongly connected components (SCCs) of `TyClDecl`s. + This happens immediately after building the dependency graph in + `depAnalTyClDecls`. As the result, in `rnTyClDecls` we get + + tycl_sccs :: [SCC (LTyClDecl GhcRn, NameSet)] + + These SCCs are topologically sorted, but only according to lexical + dependencies (i.e. dependencies that can be found by looking at the FVs). + Non-lexical dependencies (i.e. dependencies on instances) are ignored because + they can't be reliably found prior to type checking. + + More on that in Note [Retrying TyClGroups] in GHC.Tc.TyCl. + +(TCDEP5) For each SCC, create a `TyClGroup GhcRn`. Standalone kind signatures + and role annotations are looked up by name and included in the same + `TyClGroup` as the corresponding type/class declarations. + + The extension field `group_ext` of `TyClGroup GhcRn` contains the dependencies + of the SCC computed from FVs in step (TCDEP3), but /excluding/ the type + constructors bound by the group itself. Example: + + -- TyClGroup: binds {Z} + -- depends on {} + data Z = MkZ -- FVs: {} + + -- TyClGroup: binds {X, Y} + -- depends on {Z} rather than {X, Y, Z} + data X = MkX Y Z -- FVs: {Y, Z} + data Y = MkY X Z -- FVs: {X, Z} + + Reason: `isReadyTyClGroup` in GHC.Tc.TyCl is a function that checks whether + all of a TyClGroup's dependencies are present in the type checking env, and we + wouldn't want it to consider a group to be "blocked" on its own declarations. + +(TCDEP6) For each instance, create a singleton `TyClGroup GhcRn`, and put them + all at the end, where their lexical dependencies are surely satisfied. + More on that in Note [Put instances at the end]. + + The `group_ext` field in an instance TyClGroup is set to the FVs of the + instance, preprocessed much in the same way as declaration FVs in step + (TCDEP3). See Note [Prepare TyClGroup FVs] for details. + Note [No dependencies on data instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this @@ -1440,6 +1490,32 @@ Ugh. For now we simply don't allow promotion of data constructors for data instances. See Note [AFamDataCon: not promoting data family constructors] in GHC.Tc.Utils.Env + +Note [Put instances at the end] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There is no point including type family instances or class instances in the +graph for SCC analysis because instances are not referred to by name. We cannot +discover, by looking at the free variables of a declaration, what instances it +depends on. + +Instead, we create one singleton "SCC" per instance using mkInstGroups and put +them at the end. This is simple and guarantees that the FVs of all instances are +bound in the preceding TyClGroups. + +The problem is that if there are any declarations that depend on instances, +they're going to fail kind checking, because instances come after the +declarations. To account for that, the kind checker goes through a multipass +ordeal described in Note [Retrying TyClGroups] in GHC.Tc.TyCl. + +One might ask, "why not insert instances at the earliest positions where their +FVs are bound?" Indeed, this sounds like a plausible solution, and GHC used to +do it at one point. However, there are many tickets (and now test cases) +demonstrating its inadequacy: #12088, #12239, #14668, #15561, #16410, #16448, +#16693, #19611, #20875, #21172, #22257, #25238, #25834, etc. + +As to why we put each instance in its own group, as opposed to using just one +group with all the instances, the reason is that an instance may depend on +another instance, so we better add them to the environment one by one. -} @@ -1447,7 +1523,8 @@ -> RnM ([TyClGroup GhcRn], FreeVars) -- Rename the declarations and do dependency analysis on them rnTyClDecls tycl_ds - = do { -- Rename the type/class, instance, and role declarations + = do { -- Flatten TyClGroups and rename each declaration individually. + -- Steps (TCDEP1) and (TCDEP2) of Note [Dependency analysis of type and class decls] ; tycls_w_fvs <- mapM (wrapLocFstMA rnTyClDecl) (tyClGroupTyClDecls tycl_ds) ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs) ; traceRn "rnTyClDecls" $ @@ -1457,61 +1534,47 @@ ; instds_w_fvs <- mapM (wrapLocFstMA rnSrcInstDecl) (tyClGroupInstDecls tycl_ds) ; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds) - -- Do SCC analysis on the type/class decls + -- Do SCC analysis on the type/class declarations. + -- Steps (TCDEP3) and (TCDEP4) of Note [Dependency analysis of type and class decls] ; rdr_env <- getGlobalRdrEnv ; traceRn "rnTyClDecls SCC analysis" $ vcat [ text "rdr_env:" <+> ppr rdr_env ] - ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs - role_annot_env = mkRoleAnnotEnv role_annots + ; let tycl_sccs = depAnalTyClDecls rdr_env tc_names kisig_fv_env tycls_w_fvs (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs - - inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs - (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map + role_annot_env = mkRoleAnnotEnv role_annots - first_group - | null init_inst_ds = [] - | otherwise = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [] - , group_roles = [] - , group_instds = init_inst_ds }] + -- Construct renamed TyClGroups. + -- Steps (TCDEP5) and (TCDEP6) of Note [Dependency analysis of type and class decls] + ; let tycl_groups = map (mk_group role_annot_env kisig_env) tycl_sccs + inst_groups = mkInstGroups rdr_env tc_names instds_w_fvs + all_groups = tycl_groups ++ inst_groups - (final_inst_ds, groups) - = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs + ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) - all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` + ; let all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs kisigs_w_fvs - all_groups = first_group ++ groups - - ; massertPpr (null final_inst_ds) - (ppr instds_w_fvs - $$ ppr inst_ds_map - $$ ppr (flattenSCCs tycl_sccs) - $$ ppr final_inst_ds) - - ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) ; return (all_groups, all_fvs) } where + -- Construct a type/class declaration TyClGroup. + -- Step (TCDEP5) of Note [Dependency analysis of type and class decls] mk_group :: RoleAnnotEnv -> KindSigEnv - -> InstDeclFreeVarsMap - -> SCC (LTyClDecl GhcRn) - -> (InstDeclFreeVarsMap, TyClGroup GhcRn) - mk_group role_env kisig_env inst_map scc - = (inst_map', group) + -> SCC (LTyClDecl GhcRn, NameSet) + -> TyClGroup GhcRn + mk_group role_env kisig_env scc = group where - tycl_ds = flattenSCC scc - bndrs = map (tcdName . unLoc) tycl_ds - roles = getRoleAnnots bndrs role_env - kisigs = getKindSigs bndrs kisig_env - (inst_ds, inst_map') = getInsts bndrs inst_map - group = TyClGroup { group_ext = noExtField + (tycl_ds, nodes_deps) = unzip (flattenSCC scc) + node_bndrs = map (tcdName . unLoc) tycl_ds + deps = delFVs node_bndrs (plusFVs nodes_deps) + -- (delFVs node_bndrs) removes the self-references. + -- See Note [Prepare TyClGroup FVs] + group = TyClGroup { group_ext = deps , group_tyclds = tycl_ds - , group_kisigs = kisigs - , group_roles = roles - , group_instds = inst_ds } + , group_kisigs = getKindSigs node_bndrs kisig_env + , group_roles = getRoleAnnots node_bndrs role_env + , group_instds = [] } -- | Free variables of standalone kind signatures. newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars) @@ -1552,32 +1615,39 @@ rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki) = do { standalone_ki_sig_ok <- xoptM LangExt.StandaloneKindSignatures ; unless standalone_ki_sig_ok $ addErr TcRnUnexpectedStandaloneKindSig - ; new_v <- lookupSigCtxtOccRn (TopSigCtxt tc_names) (text "standalone kind signature") v - ; let doc = StandaloneKindSigCtx (ppr v) - ; (new_ki, fvs) <- rnHsSigType doc KindLevel ki + ; new_v <- lookupSigCtxtOccRn (TopSigCtxt tc_names) SigLikeStandaloneKindSig v + ; (new_ki, fvs) <- rnHsSigType (StandaloneKindSigCtx v) KindLevel ki ; return (StandaloneKindSig noExtField new_v new_ki, fvs) } +-- See Note [Dependency analysis of type and class decls] depAnalTyClDecls :: GlobalRdrEnv - -> KindSig_FV_Env + -> NameSet -- Names in the current HsGroup + -> KindSig_FV_Env -- FVs of standalone kind signatures -> [(LTyClDecl GhcRn, FreeVars)] - -> [SCC (LTyClDecl GhcRn)] --- See Note [Dependency analysis of type, class, and instance decls] -depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs + -> [SCC (LTyClDecl GhcRn, NameSet)] +depAnalTyClDecls rdr_env tc_names kisig_fv_env ds_w_fvs = stronglyConnCompFromEdgedVerticesUniq edges where - edges :: [ Node Name (LTyClDecl GhcRn) ] - edges = [ DigraphNode d name (map (getParent rdr_env) (nonDetEltsUniqSet deps)) + -- Build a graph where each node is a `TyClDecl` keyed by its name, and + -- its `FreeVars` give rise to edges. + -- Step (TCDEP3) of Note [Dependency analysis of type and class decls] + edges :: [ Node Name (LTyClDecl GhcRn, NameSet) ] + edges = [ DigraphNode (d, deps) name (nonDetEltsUniqSet deps) + -- nonDetEltsUniqSet is OK to use here because the order of the edges + -- has no effect on the result of stronglyConnCompFromEdgedVerticesUniq. + -- See Note [Deterministic SCC] in GHC.Data.Graph.Directed. + | (d, fvs) <- ds_w_fvs, let { name = tcdName (unLoc d) ; kisig_fvs = lookupKindSig_FV_Env kisig_fv_env name - ; deps = fvs `plusFV` kisig_fvs + ; node_fvs = fvs `plusFV` kisig_fvs -- (TCDEP3.fvs_kisig) + ; deps = toParents rdr_env node_fvs `intersectFVs` tc_names + -- (toParents rdr_env) maps datacons to parent tycons (TCDEP3.fvs_parent), + -- (`intersectFVs` tc_names) filters out imported names (TCDEP3.fvs_nogbl). + -- See also Note [Prepare TyClGroup FVs] } ] - -- It's OK to use nonDetEltsUFM here as - -- stronglyConnCompFromEdgedVertices is still deterministic - -- even if the edges are in nondeterministic order as explained - -- in Note [Deterministic SCC] in GHC.Data.Graph.Directed. toParents :: GlobalRdrEnv -> NameSet -> NameSet toParents rdr_env ns @@ -1595,7 +1665,82 @@ _ -> n Nothing -> n +{- Note [Prepare TyClGroup FVs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The renamer returns, alongside each renamed type/class declaration or instance, +the set of its free variables: + rnTyClDecl :: TyClDecl GhcPs -> RnM (TyClDecl GhcRn, FreeVars) + rnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars) + +For example: + + type family F (a :: k) -- FVs: {} + data X = MkX Char (Maybe X) -- FVs: {Char, Maybe, X} + data Y = MkY X (Maybe Y) -- FVs: {Maybe, Y, X} + type instance F MkX = X -- FVs: {F, MkX, X} + type instance F MkY = Int -- FVs: {F, MkY, Int} + +This is almost what we need for dependency analysis (i.e. to figure out in which +order to check the declarations), but first we apply a few transformations: + +* toParents rdr_env inst_fvs `intersectFVs` tc_names -- in mkInstGroups +* toParents rdr_env node_fvs `intersectFVs` tc_names -- in depAnalTyClDecls +* delFVs node_bndrs (plusFVs nodes_deps) -- in rnTyClGroups + +The cited lines of code are somewhat far apart; to see the big picture, refer +to Note [Dependency analysis of type and class decls], and more specifically +steps TCDEP3, TCDEP5, and TCDEP6. + +The cumulative effect of these transformations is as follows: + +* Data constructor names are replaced by the parent type constructors: + {MkX} ==> {X} + Part of the code: + toParents rdr_env + Reason: + MkX does not get its own node in the dependency graph, + so we cannot make an edge to it in `depAnalTyClDecls` + +* Names defined outside the current HsGroup are filtered out: + {Char,Maybe} ==> {} + Part of the code: + `intersectFVs` tc_names + Reason: + makes the NameSet smaller, so there are fewer subsequent lookups + in `graphFromEdgedVertices` (GHC.Data.Graph.Directed) + and in `isReadyTyClGroup` (GHC.Tc.TyCl) + +* Self-references are removed: + {A,B,C} ==> {C}, iff in the TyClGroup that defines {A,B} + Part of the code: + delFVs node_bndrs + Reason: + avoids the problem that `isReadyTyClGroup` would otherwise consider + a recursive TyClGroup to be blocked on itself + Note: + needs to happen after the SCC analysis because of + mutually-recursive data types + +These "prepared" FVs are the lexical dependencies of a TyClGroup that are stored +in the XCTyClGroup extension field: + + type family F (a :: k) -- XCTyClGroup: {} + data X = MkX Char (Maybe X) -- XCTyClGroup: {} + data Y = MkY X (Maybe Y) -- XCTyClGroup: {X} + type instance F MkX = X -- XCTyClGroup: {F, X} + type instance F MkY = Int -- XCTyClGroup: {F, Y} + +Before attempting to kind-check a TyClGroup, all of its lexical dependencies +need to be satisfied, i.e. there must be a TyThing in the TypeEnv for each of +these names. + +Imported names {Char,Maybe} don't need to be explicitly included in the set of +lexical dependencies because `isReadyTyClGroup` can safely assume those are +definitely already in the env. +-} + + {- ****************************************************** * * Role annotations @@ -1621,7 +1766,7 @@ = do { -- the name is an *occurrence*, but look it up only in the -- decls defined in this group (see #10263) tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names) - (text "role annotation") + SigLikeRoleAnnotation tycon ; return $ RoleAnnotDecl noExtField tycon' roles } @@ -1659,43 +1804,27 @@ ****************************************************** -} ---------------------------------------------------------- --- | 'InstDeclFreeVarsMap is an association of an --- @InstDecl@ with @FreeVars@. The @FreeVars@ are --- the tycon names that are both --- a) free in the instance declaration --- b) bound by this group of type/class/instance decls -type InstDeclFreeVarsMap = [(LInstDecl GhcRn, FreeVars)] - --- | Construct an @InstDeclFreeVarsMap@ by eliminating any @Name@s from the --- @FreeVars@ which are *not* the binders of a @TyClDecl@. -mkInstDeclFreeVarsMap :: GlobalRdrEnv - -> NameSet - -> [(LInstDecl GhcRn, FreeVars)] - -> InstDeclFreeVarsMap -mkInstDeclFreeVarsMap rdr_env tycl_bndrs inst_ds_fvs - = [ (inst_decl, toParents rdr_env fvs `intersectFVs` tycl_bndrs) - | (inst_decl, fvs) <- inst_ds_fvs ] - --- | Get the @LInstDecl@s which have empty @FreeVars@ sets, and the --- @InstDeclFreeVarsMap@ with these entries removed. --- We call (getInsts tcs instd_map) when we've completed the declarations --- for 'tcs'. The call returns (inst_decls, instd_map'), where --- inst_decls are the instance declarations all of --- whose free vars are now defined --- instd_map' is the inst-decl map with 'tcs' removed from --- the free-var set -getInsts :: [Name] -> InstDeclFreeVarsMap - -> ([LInstDecl GhcRn], InstDeclFreeVarsMap) -getInsts bndrs inst_decl_map - = partitionWith pick_me inst_decl_map +-- | Construct a @TyClGroup@ for each @InstDecl@. +-- Step (TCDEP6) of Note [Dependency analysis of type and class decls] +mkInstGroups :: GlobalRdrEnv + -> NameSet + -> [(LInstDecl GhcRn, FreeVars)] + -> [TyClGroup GhcRn] +mkInstGroups rdr_env tc_names inst_ds_fvs + = [ mk_inst_group deps inst_decl + | (inst_decl, inst_fvs) <- inst_ds_fvs + , let deps = toParents rdr_env inst_fvs `intersectFVs` tc_names ] + -- (toParents rdr_env) maps datacons to parent tycons, + -- (`intersectFVs` tc_names) filters out imported names. + -- See Note [Prepare TyClGroup FVs] where - pick_me :: (LInstDecl GhcRn, FreeVars) - -> Either (LInstDecl GhcRn) (LInstDecl GhcRn, FreeVars) - pick_me (decl, fvs) - | isEmptyNameSet depleted_fvs = Left decl - | otherwise = Right (decl, depleted_fvs) - where - depleted_fvs = delFVs bndrs fvs + mk_inst_group :: NameSet -> LInstDecl GhcRn -> TyClGroup GhcRn + mk_inst_group deps inst_d = + TyClGroup { group_ext = deps + , group_tyclds = [] + , group_kisigs = [] + , group_roles = [] + , group_instds = [inst_d] } {- ****************************************************** * * @@ -1714,7 +1843,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs }) - = do { tycon' <- lookupLocatedTopConstructorRnN tycon + = do { tycon' <- lookupLocatedTopBndrRnN WL_TyCon tycon ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) @@ -1734,7 +1863,7 @@ { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn@HsDataDefn{ dd_cons = cons, dd_kindSig = kind_sig} }) - = do { tycon' <- lookupLocatedTopConstructorRnN tycon + = do { tycon' <- lookupLocatedTopBndrRnN WL_TyCon tycon ; let kvs = extractDataDefnKindVars defn doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons @@ -1756,7 +1885,7 @@ tcdFDs = fds, tcdSigs = sigs, tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs, tcdDocs = docs}) - = do { lcls' <- lookupLocatedTopConstructorRnN lcls + = do { lcls' <- lookupLocatedTopBndrRnN WL_TyCon lcls ; let cls' = unLoc lcls' kvs = [] -- No scoped kind vars except those in -- kind signatures on the tyvars @@ -1923,19 +2052,17 @@ } has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True - has_labelled_fields (ConDeclH98 { con_args = RecCon rec }) - = not (null (unLoc rec)) + has_labelled_fields (ConDeclH98 { con_args = RecCon flds }) + = not (null (unLoc flds)) has_labelled_fields _ = False has_strictness_flags condecl - = any (is_strict . getBangStrictness . hsScaledThing) (con_args condecl) - - is_strict (HsSrcBang _ (HsBang _ s)) = isSrcStrict s + = any isSrcStrict (con_arg_bangs condecl) - con_args (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = args - con_args (ConDeclH98 { con_args = PrefixCon _ args }) = args - con_args (ConDeclH98 { con_args = InfixCon arg1 arg2 }) = [arg1, arg2] - con_args _ = [] + con_arg_bangs (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = map cdf_bang args + con_arg_bangs (ConDeclH98 { con_args = PrefixCon args }) = map cdf_bang args + con_arg_bangs (ConDeclH98 { con_args = InfixCon arg1 arg2 }) = [cdf_bang arg1, cdf_bang arg2] + con_arg_bangs _ = [] {- Note [Type data declarations] @@ -2102,7 +2229,7 @@ from `type data`, which do not use the distinguishing quote mark added to constructors promoted by DataKinds. -* GHC.Core.TyCon.isDataTyCon ignores types coming from a `type data` +* GHC.Core.TyCon.isBoxedDataTyCon ignores types coming from a `type data` declaration (by checking the `is_type_data` field), so that these do not contribute executable code such as constructor wrappers. @@ -2213,7 +2340,7 @@ , fdFixity = fixity , fdInfo = info, fdResultSig = res_sig , fdInjectivityAnn = injectivity }) - = do { tycon' <- lookupLocatedTopConstructorRnN tycon + = do { tycon' <- lookupLocatedTopBndrRnN WL_TyCon tycon ; ((tyvars', res_sig', injectivity'), fv1) <- bindHsQTyVars doc mb_cls kvs tyvars $ \ tyvars' _ -> do { let rn_sig = rnFamResultSig doc @@ -2398,7 +2525,7 @@ , con_mb_cxt = mcxt, con_args = args , con_doc = mb_doc, con_forall = forall_ }) = do { _ <- addLocM checkConName name - ; new_name <- lookupLocatedTopConstructorRnN name + ; new_name <- lookupLocatedTopBndrRnN WL_ConLike name -- We bind no implicit binders here; this is just like -- a nested HsForAllTy. E.g. consider @@ -2428,13 +2555,14 @@ all_fvs) }} rnConDecl (ConDeclGADT { con_names = names - , con_bndrs = L l outer_bndrs + , con_outer_bndrs = L outer_bndrs_loc outer_bndrs + , con_inner_bndrs = inner_bndrs , con_mb_cxt = mcxt , con_g_args = args , con_res_ty = res_ty , con_doc = mb_doc }) = do { mapM_ (addLocM checkConName) names - ; new_names <- mapM (lookupLocatedTopConstructorRnN) names + ; new_names <- mapM (lookupLocatedTopBndrRnN WL_ConLike) names ; let -- We must ensure that we extract the free tkvs in left-to-right -- order of their appearance in the constructor type. @@ -2443,6 +2571,7 @@ -- See #14808. implicit_bndrs = extractHsOuterTvBndrs outer_bndrs $ + extractHsForAllTelescopes inner_bndrs $ extractHsTysRdrTyVars (hsConDeclTheta mcxt) $ extractConDeclGADTDetailsTyVars args $ extractHsTysRdrTyVars [res_ty] [] @@ -2450,6 +2579,7 @@ ; let ctxt = ConDeclCtx (toList new_names) ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' -> + bindHsForAllTelescopes ctxt inner_bndrs $ \inner_bndrs' -> do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt ; (new_args, fvs2) <- rnConDeclGADTDetails (unLoc (head new_names)) ctxt args ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty @@ -2463,10 +2593,12 @@ ; let all_fvs = fvs1 `plusFV` fvs2 `plusFV` fvs3 ; traceRn "rnConDecl (ConDeclGADT)" - (ppr names $$ ppr outer_bndrs') + (ppr names $$ ppr outer_bndrs' $$ ppr inner_bndrs') ; new_mb_doc <- traverse rnLHsDoc mb_doc ; return (ConDeclGADT { con_g_ext = noExtField, con_names = new_names - , con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt + , con_outer_bndrs = L outer_bndrs_loc outer_bndrs' + , con_inner_bndrs = inner_bndrs' + , con_mb_cxt = new_cxt , con_g_args = new_args, con_res_ty = new_res_ty , con_doc = new_mb_doc }, all_fvs) } } @@ -2482,15 +2614,15 @@ -> HsDocContext -> HsConDeclH98Details GhcPs -> RnM (HsConDeclH98Details GhcRn, FreeVars) -rnConDeclH98Details _ doc (PrefixCon _ tys) - = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys - ; return (PrefixCon noTypeArgs new_tys, fvs) } +rnConDeclH98Details _ doc (PrefixCon tys) + = do { (new_tys, fvs) <- mapFvRn (rnHsConDeclField doc) tys + ; return (PrefixCon new_tys, fvs) } rnConDeclH98Details _ doc (InfixCon ty1 ty2) - = do { (new_ty1, fvs1) <- rnScaledLHsType doc ty1 - ; (new_ty2, fvs2) <- rnScaledLHsType doc ty2 + = do { (new_ty1, fvs1) <- rnHsConDeclField doc ty1 + ; (new_ty2, fvs2) <- rnHsConDeclField doc ty2 ; return (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2) } rnConDeclH98Details con doc (RecCon flds) - = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds + = do { (new_flds, fvs) <- rnRecHsConDeclRecFields con doc flds ; return (RecCon new_flds, fvs) } rnConDeclGADTDetails :: @@ -2499,20 +2631,20 @@ -> HsConDeclGADTDetails GhcPs -> RnM (HsConDeclGADTDetails GhcRn, FreeVars) rnConDeclGADTDetails _ doc (PrefixConGADT _ tys) - = do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys + = do { (new_tys, fvs) <- mapFvRn (rnHsConDeclField doc) tys ; return (PrefixConGADT noExtField new_tys, fvs) } rnConDeclGADTDetails con doc (RecConGADT _ flds) - = do { (new_flds, fvs) <- rnRecConDeclFields con doc flds + = do { (new_flds, fvs) <- rnRecHsConDeclRecFields con doc flds ; return (RecConGADT noExtField new_flds, fvs) } -rnRecConDeclFields :: +rnRecHsConDeclRecFields :: Name -> HsDocContext - -> LocatedL [LConDeclField GhcPs] - -> RnM (LocatedL [LConDeclField GhcRn], FreeVars) -rnRecConDeclFields con doc (L l fields) - = do { fls <- lookupConstructorFields con - ; (new_fields, fvs) <- rnConDeclFields doc fls fields + -> LocatedL [LHsConDeclRecField GhcPs] + -> RnM (LocatedL [LHsConDeclRecField GhcRn], FreeVars) +rnRecHsConDeclRecFields con doc (L l fields) + = do { fls <- lookupConstructorFields (noUserRdr con) + ; (new_fields, fvs) <- rnHsConDeclRecFields doc fls fields -- No need to check for duplicate fields -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn ; pure (L l new_fields, fvs) } @@ -2552,20 +2684,20 @@ bnd_name <- newTopSrcBinder (L (l2l bind_loc) n) let field_occs = map ((\ f -> L (noAnnSrcSpan $ getLocA (foLabel f)) f) . recordPatSynField) as flds <- mapM (newRecordFieldLabel dup_fields_ok has_sel [bnd_name]) field_occs - let con_info = mkConInfo ConIsPatSyn (conDetailsArity length (RecCon as)) flds + let con_info = mkConInfo ConIsPatSyn (conDetailsVisArity (RecCon as)) flds return ((PatSynName bnd_name, con_info) : names) | L bind_loc (PatSynBind _ (PSB { psb_id = L _ n, psb_args = as })) <- bind = do bnd_name <- newTopSrcBinder (L (l2l bind_loc) n) - let con_info = mkConInfo ConIsPatSyn (conDetailsArity length as) [] + let con_info = mkConInfo ConIsPatSyn (conDetailsVisArity as) [] return ((PatSynName bnd_name, con_info) : names) | otherwise = return names -conDetailsArity :: (rec -> Arity) -> HsConDetails tyarg arg rec -> Arity -conDetailsArity recToArity = \case - PrefixCon _ args -> length args - RecCon rec -> recToArity rec +conDetailsVisArity :: HsPatSynDetails (GhcPass p) -> VisArity +conDetailsVisArity = \case + PrefixCon args -> length args + RecCon flds -> length flds InfixCon _ _ -> 2 {- @@ -2591,7 +2723,7 @@ rnHsTyVar :: LocatedN RdrName -> RnM (LocatedN Name) rnHsTyVar (L l tyvar) = do - tyvar' <- lookupOccRn tyvar + tyvar' <- lookupOccRn WL_TyVar tyvar return (L l tyvar') {- @@ -2688,8 +2820,8 @@ add gp l (DocD _ d) ds = addl (gp { hs_docs = (L l d) : (hs_docs gp) }) ds -add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] +add_tycld :: LTyClDecl GhcPs -> [TyClGroup GhcPs] + -> [TyClGroup GhcPs] add_tycld d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [d] , group_kisigs = [] @@ -2700,8 +2832,8 @@ add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss) = ds { group_tyclds = d : tyclds } : dss -add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] +add_instd :: LInstDecl GhcPs -> [TyClGroup GhcPs] + -> [TyClGroup GhcPs] add_instd d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_kisigs = [] @@ -2712,8 +2844,8 @@ add_instd d (ds@(TyClGroup { group_instds = instds }):dss) = ds { group_instds = d : instds } : dss -add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)] - -> [TyClGroup (GhcPass p)] +add_role_annot :: LRoleAnnotDecl GhcPs -> [TyClGroup GhcPs] + -> [TyClGroup GhcPs] add_role_annot d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_kisigs = [] @@ -2724,8 +2856,8 @@ add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest) = tycls { group_roles = d : roles } : rest -add_kisig :: LStandaloneKindSig (GhcPass p) - -> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)] +add_kisig :: LStandaloneKindSig GhcPs + -> [TyClGroup GhcPs] -> [TyClGroup GhcPs] add_kisig d [] = [TyClGroup { group_ext = noExtField , group_tyclds = [] , group_kisigs = [d] diff --git a/GHC/Rename/Names.hs b/GHC/Rename/Names.hs --- a/GHC/Rename/Names.hs +++ b/GHC/Rename/Names.hs @@ -54,7 +54,7 @@ import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) -import GHC.Core.Type +import GHC.Core.TyCo.Tidy import GHC.Core.PatSyn import GHC.Core.TyCon ( TyCon, tyConName ) import qualified GHC.LanguageExtensions as LangExt @@ -74,10 +74,9 @@ import GHC.Types.Hint import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc -import GHC.Types.Basic ( TopLevelFlag(..) ) +import GHC.Types.Basic ( TopLevelFlag(..), TyConFlavour (..), convImportLevel ) import GHC.Types.SourceText import GHC.Types.Id -import GHC.Types.HpcInfo import GHC.Types.PkgQual import GHC.Types.GREInfo (ConInfo(..), ConFieldInfo (..), ConLikeInfo (ConIsData)) @@ -205,21 +204,21 @@ -- Note: Do the non SOURCE ones first, so that we get a helpful warning -- for SOURCE ones that are unnecessary rnImports :: [(LImportDecl GhcPs, SDoc)] - -> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, AnyHpcUsage) + -> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails) rnImports imports = do tcg_env <- getGblEnv -- NB: want an identity module here, because it's OK for a signature -- module to import from its implementor let this_mod = tcg_mod tcg_env let (source, ordinary) = partition (is_source_import . fst) imports - is_source_import d = ideclSource (unLoc d) == IsBoot + is_source_import (d::LImportDecl GhcPs) = ideclSource (unLoc d) == IsBoot stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary stuff2 <- mapAndReportM (rnImportDecl this_mod) source -- Safe Haskell: See Note [Tracking Trust Transitively] - let (decls, imp_user_spec, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2) + let (decls, imp_user_spec, rdr_env, imp_avails) = combine (stuff1 ++ stuff2) -- Update imp_boot_mods if imp_direct_mods mentions any of them let merged_import_avail = clobberSourceImports imp_avails - return (decls, imp_user_spec, rdr_env, merged_import_avail, hpc_usage) + return (decls, imp_user_spec, rdr_env, merged_import_avail) where clobberSourceImports imp_avails = @@ -229,25 +228,24 @@ (imp_boot_mods imp_avails) (imp_direct_dep_mods imp_avails) - combJ (GWIB _ IsBoot) x = Just x - combJ r _ = Just r + combJ (GWIB _ IsBoot) (_, x) = Just x + combJ r _ = Just r -- See Note [Combining ImportAvails] - combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails, AnyHpcUsage)] - -> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, AnyHpcUsage) + combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails)] + -> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails) combine ss = - let (decls, imp_user_spec, rdr_env, imp_avails, hpc_usage, finsts) = foldr + let (decls, imp_user_spec, rdr_env, imp_avails, finsts) = foldr plus - ([], [], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet) + ([], [], emptyGlobalRdrEnv, emptyImportAvails, emptyModuleSet) ss - in (decls, imp_user_spec, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts }, hpc_usage) + in (decls, imp_user_spec, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts }) - plus (decl, us, gbl_env1, imp_avails1, hpc_usage1) - (decls, uss, gbl_env2, imp_avails2, hpc_usage2, finsts_set) + plus (decl, us, gbl_env1, imp_avails1) + (decls, uss, gbl_env2, imp_avails2, finsts_set) = ( decl:decls, us:uss, gbl_env1 `plusGlobalRdrEnv` gbl_env2, imp_avails1' `plusImportAvails` imp_avails2, - hpc_usage1 || hpc_usage2, extendModuleSetList finsts_set new_finsts ) where imp_avails1' = imp_avails1 { imp_finsts = [] } @@ -311,11 +309,13 @@ -- 4. A boolean 'AnyHpcUsage' which is true if the imported module -- used HPC. rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) - -> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails, AnyHpcUsage) + -> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails) rnImportDecl this_mod (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name , ideclPkgQual = raw_pkg_qual - , ideclSource = want_boot, ideclSafe = mod_safe + , ideclSource = want_boot + , ideclSafe = mod_safe + , ideclLevelSpec = import_level , ideclQualified = qual_style , ideclExt = XImportDeclPass { ideclImplicit = implicit } , ideclAs = as_mod, ideclImportList = imp_details }), import_reason) @@ -393,7 +393,8 @@ qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name imp_spec = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only, is_dloc = locA loc, is_as = qual_mod_name, - is_pkg_qual = pkg_qual, is_isboot = want_boot } + is_pkg_qual = pkg_qual, is_isboot = want_boot, + is_level = convImportLevel import_level } -- filter the imports according to the import declaration (new_imp_details, imp_user_list, gbl_env) <- filterImports hsc_env iface imp_spec imp_details @@ -420,6 +421,7 @@ , imv_is_hiding = is_hiding , imv_all_exports = potential_gres , imv_qualified = qual_only + , imv_is_level = convImportLevel import_level } imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) @@ -437,9 +439,10 @@ , ideclQualified = ideclQualified decl , ideclAs = ideclAs decl , ideclImportList = new_imp_details + , ideclLevelSpec = ideclLevelSpec decl } - return (L loc new_imp_decl, ImpUserSpec imp_spec imp_user_list, gbl_env, imports, mi_hpc iface) + return (L loc new_imp_decl, ImpUserSpec imp_spec imp_user_list, gbl_env, imports) -- | Rename raw package imports @@ -460,7 +463,7 @@ | Just (uid, _) <- find (fromMaybe False . fmap (== pkg_fs) . snd) home_names -> ThisPkg uid - | Just uid <- resolvePackageImport (ue_units unit_env) mn (PackageName pkg_fs) + | Just uid <- resolvePackageImport unit_state mn (PackageName pkg_fs) -> OtherPkg uid | otherwise @@ -470,10 +473,10 @@ where home_names = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps - units = ue_units unit_env + unit_state = ue_homeUnitState unit_env hpt_deps :: [UnitId] - hpt_deps = homeUnitDepends units + hpt_deps = homeUnitDepends unit_state -- | Calculate the 'ImportAvails' induced by an import of a particular @@ -488,8 +491,8 @@ calculateAvails home_unit other_home_units iface mod_safe' want_boot imported_by = let imp_mod = mi_module iface imp_sem_mod= mi_semantic_module iface - orph_iface = mi_orphan (mi_final_exts iface) - has_finsts = mi_finsts (mi_final_exts iface) + orph_iface = mi_orphan iface + has_finsts = mi_finsts iface deps = mi_deps iface trust = getSafeMode $ mi_trust iface trust_pkg = mi_trust_pkg iface @@ -549,14 +552,20 @@ dependent_pkgs = if toUnitId pkg `S.member` other_home_units then S.empty - else S.singleton ipkg + else S.singleton (lvl, ipkg) - direct_mods = mkModDeps $ if toUnitId pkg `S.member` other_home_units - then S.singleton (moduleUnitId imp_mod, (GWIB (moduleName imp_mod) want_boot)) - else S.empty + lvl = case imported_by of + ImportedByUser imv -> imv_is_level imv + ImportedBySystem -> NormalLevel + + direct_mods = if toUnitId pkg `S.member` other_home_units + then mkPlusModDeps (moduleUnitId imp_mod) lvl (GWIB (moduleName imp_mod) want_boot) + else emptyInstalledModuleEnv + dep_boot_mods_map = mkModDeps (dep_boot_mods deps) + boot_mods -- If we are looking for a boot module, it must be HPT | IsBoot <- want_boot = extendInstalledModuleEnv dep_boot_mods_map (toUnitId <$> imp_mod) (GWIB (moduleName imp_mod) IsBoot) @@ -592,6 +601,9 @@ imp_trust_own_pkg = pkg_trust_req } +mkPlusModDeps :: UnitId -> ImportLevel -> ModuleNameWithIsBoot + -> InstalledModuleEnv (S.Set ImportLevel, ModuleNameWithIsBoot) +mkPlusModDeps uid st elt = extendInstalledModuleEnv emptyInstalledModuleEnv (mkModule uid (gwib_mod elt)) (S.singleton st, elt) {- ************************************************************************ @@ -623,7 +635,7 @@ See Note [GlobalRdrEnv shadowing] 3. We find out whether we are inside a [d| ... |] by testing the TH - stage. This is a slight hack, because the stage field was really + level. This is a slight hack, because the level field was really meant for the type checker, and here we are not interested in the fields of Brack, hence the error thunks in thRnBrack. -} @@ -639,18 +651,18 @@ extendGlobalRdrEnvRn new_gres new_fixities = checkNoErrs $ -- See Note [Fail fast on duplicate definitions] do { (gbl_env, lcl_env) <- getEnvs - ; stage <- getStage + ; level <- getThLevel ; isGHCi <- getIsGHCi ; let rdr_env = tcg_rdr_env gbl_env fix_env = tcg_fix_env gbl_env th_bndrs = getLclEnvThBndrs lcl_env - th_lvl = thLevel stage + th_lvl = thLevelIndex level -- Delete new_occs from global and local envs -- If we are in a TemplateHaskell decl bracket, -- we are going to shadow them -- See Note [GlobalRdrEnv shadowing] - inBracket = isBrackStage stage + inBracket = isBrackLevel level lcl_env_TH = modifyLclCtxt (\lcl_env -> lcl_env { tcl_rdr = minusLocalRdrEnv (tcl_rdr lcl_env) new_gres_env }) lcl_env -- See Note [GlobalRdrEnv shadowing] @@ -1189,8 +1201,10 @@ (gres, imp_user_list) = case want_hiding of Exactly -> - let gre_env = mkGlobalRdrEnv $ concatMap (gresFromIE decl_spec) items2 - in (gre_env, ImpUserExplicit gre_env) + let gres = concatMap (gresFromIE decl_spec) items2 + gre_env = mkGlobalRdrEnv gres + implicit_parents = mkNameSet $ mapMaybe parentOfImplicitlyImportedGRE gres + in (gre_env, ImpUserExplicit (gresToAvailInfo $ globalRdrEnvElts $ gre_env) implicit_parents) EverythingBut -> let hidden_names = mkNameSet $ concatMap (map greName . snd) items2 in (importsFromIface hsc_env iface decl_spec (Just hidden_names), ImpUserEverythingBut hidden_names) @@ -1241,8 +1255,7 @@ lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) = setSrcSpanA loc $ - do (stuff, warns) <- liftM (fromMaybe ([],[])) $ - run_lookup (lookup_ie ieRdr) + do (stuff, warns) <- run_lookup ([],[]) (lookup_ie ieRdr) mapM_ (addTcRnDiagnostic <=< warning_msg) warns return [ (L loc ie, gres) | (ie,gres) <- stuff ] where @@ -1252,11 +1265,10 @@ pure (TcRnDodgyImports (DodgyImportsEmptyParent n)) warning_msg MissingImportList = pure (TcRnMissingImportList ieRdr) - warning_msg (BadImportW ie) = do - -- 'BadImportW' is only constructed below in 'handle_bad_import', in - -- the 'EverythingBut' case, so that's what we pass to - -- 'badImportItemErr'. - reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails + warning_msg (BadImportW ie sub) = do + -- 'BadImportW' is only constructed below in 'bad_import_w', in + -- the 'EverythingBut' case, so here we assume a 'hiding' clause. + (reason :| _) <- badImportItemErr iface decl_spec ie sub all_avails pure (TcRnDodgyImports (DodgyImportsHiding reason)) warning_msg (DeprecatedExport n w) = pure $ TcRnPragmaWarning @@ -1265,18 +1277,18 @@ , pwarn_impmod = moduleName import_mod } w - run_lookup :: IELookupM a -> TcRn (Maybe a) - run_lookup m = case m of + run_lookup :: a -> IELookupM a -> TcRn a + run_lookup def m = case m of Failed err -> do - msg <- lookup_err_msg err - addErr (TcRnImportLookup msg) - return Nothing - Succeeded a -> return (Just a) + msgs <- lookup_err_msgs err + forM_ msgs $ \msg -> addErr (TcRnImportLookup msg) + return def + Succeeded a -> return a - lookup_err_msg err = case err of + lookup_err_msgs err = case err of BadImport ie sub -> badImportItemErr iface decl_spec ie sub all_avails - IllegalImport -> pure ImportLookupIllegal - QualImportError rdr -> pure (ImportLookupQualified rdr) + IllegalImport -> pure $ NE.singleton ImportLookupIllegal + QualImportError rdr -> pure $ NE.singleton (ImportLookupQualified rdr) -- For each import item, we convert its RdrNames to Names, -- and at the same time compute all the GlobalRdrElt corresponding @@ -1360,26 +1372,28 @@ -- Look up the children in the sub-names of the parent -- See Note [Importing DuplicateRecordFields] - case lookupChildren subnames rdr_ns of - - Failed rdrs -> failLookupWith $ - BadImport (IEThingWith (deprecation, ann) ltc wc rdrs noDocstring) IsSubordinate - -- We are trying to import T( a,b,c,d ), and failed - -- to find 'b' and 'd'. So we make up an import item - -- to report as failing, namely T( b, d ). - -- c.f. #15412 + let (children_errs, childnames) = lookupChildren subnames rdr_ns - Succeeded childnames -> - return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames' noDocstring - ,gres)] - , export_depr_warns) + bad_import_warns <- + if null children_errs then return [] else + let items = map lce_wrapped_name children_errs + ie = IEThingWith (deprecation, ann) ltc wc items noDocstring + -- We are trying to import T( a,b,c,d ), and failed + -- to find 'b' and 'd'. So we make up an import item + -- to report as failing, namely T( b, d ). + -- c.f. #15413 + subordinate_err = mkSubordinateError gre children_errs + in bad_import_w ie subordinate_err - where name' = replaceWrappedName rdr_tc name - childnames' = map (to_ie_post_rn . fmap greName) childnames - gres = gre : map unLoc childnames - export_depr_warns - | want_hiding == Exactly = mapMaybe mk_depr_export_warning gres - | otherwise = [] + let name' = replaceWrappedName rdr_tc name + childnames' = map (to_ie_post_rn . fmap greName) childnames + gres = gre : map unLoc childnames + export_depr_warns + | want_hiding == Exactly = mapMaybe mk_depr_export_warning gres + | otherwise = [] + return ([ (IEThingWith (Nothing, ann) (L l name') wc childnames' noDocstring + ,gres)] + , bad_import_warns ++ export_depr_warns) _other -> failLookupWith IllegalImport -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed... @@ -1393,32 +1407,59 @@ -- N.B. imports never have docstrings noDocstring = Nothing - handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie _ - | want_hiding == EverythingBut - -> return ([], [BadImportW ie]) - _ -> failLookupWith err + handle_bad_import m = catchIELookup m $ \case + BadImport ie sub -> do + ws <- bad_import_w ie sub + return ([], ws) + err -> failLookupWith err + bad_import_w :: IE GhcPs -> IsSubordinateError -> IELookupM [IELookupWarning] + bad_import_w ie sub + | want_hiding == EverythingBut = return [BadImportW ie sub] + | otherwise = failLookupWith (BadImport ie sub) + mk_depr_export_warning gre - = DeprecatedExport name <$> mi_export_warn_fn (mi_final_exts iface) name + = DeprecatedExport name <$> mi_export_warn_fn iface name where name = greName gre type IELookupM = MaybeErr IELookupError data IELookupWarning - = BadImportW (IE GhcPs) + = BadImportW (IE GhcPs) IsSubordinateError | MissingImportList | DodgyImport GlobalRdrElt | DeprecatedExport Name (WarningTxt GhcRn) -- | Is this import/export item a subordinate or not? -data IsSubordinate - = IsSubordinate | IsNotSubordinate +data IsSubordinateError + = IsSubordinateError { subordinate_err_parent :: !GlobalRdrElt + , subordinate_err_unavailable :: [FastString] + , subordinate_err_nontype :: [GlobalRdrElt] + , subordinate_err_nondata :: [GlobalRdrElt] } + | IsNotSubordinate +mkSubordinateError :: GlobalRdrElt -> [LookupChildError] -> IsSubordinateError +mkSubordinateError gre children_errs = foldr add init_acc children_errs + where + init_acc :: IsSubordinateError + init_acc = IsSubordinateError gre [] [] [] + + add :: LookupChildError -> IsSubordinateError -> IsSubordinateError + add children_err sub@IsSubordinateError{} = + case children_err of + LookupChildNonType{lce_nontype_item = g} -> + sub { subordinate_err_nontype = g : subordinate_err_nontype sub } + LookupChildNonData{lce_nondata_item = g} -> + sub { subordinate_err_nondata = g : subordinate_err_nondata sub } + LookupChildNotFound (L _ wname) -> + let fs = (occNameFS . rdrNameOcc . ieWrappedName) wname + in sub { subordinate_err_unavailable = fs : subordinate_err_unavailable sub } + add _ IsNotSubordinate = panic "mkSubordinateError: IsNotSubordinate" + data IELookupError = QualImportError RdrName - | BadImport (IE GhcPs) IsSubordinate + | BadImport (IE GhcPs) IsSubordinateError | IllegalImport failLookupWith :: IELookupError -> IELookupM a @@ -1559,9 +1600,25 @@ set_gre_imp gre@( GRE { gre_name = nm } ) = gre { gre_imp = unitBag $ prov_fn nm } -{- -Note [Children for duplicate record fields] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +parentOfImplicitlyImportedGRE :: Outputable info => GlobalRdrEltX info -> Maybe Name +parentOfImplicitlyImportedGRE gre = + if any (explicit_import . is_item) $ gre_imp gre + then Nothing + else + case greParent gre of + NoParent -> + pprPanic "parentOfImplicitlyImportedGRE" $ + (text "implicitly imported GRE with no parent" <+> ppr gre) + ParentIs par -> + Just par + where + explicit_import :: ImpItemSpec -> Bool + explicit_import (ImpAll {}) = + pprPanic "parentOfImplicitlyImportedGRE: ImpAll" (ppr gre) + explicit_import (ImpSome { is_explicit }) = is_explicit + +{- Note [Children for duplicate record fields] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider the module {-# LANGUAGE DuplicateRecordFields #-} @@ -1585,45 +1642,103 @@ findChildren :: NameEnv [a] -> Name -> [a] findChildren env n = lookupNameEnv env n `orElse` [] +data LookupChildError + = LookupChildNotFound { lce_wrapped_name :: !(LIEWrappedName GhcPs) } + | LookupChildNonType { lce_wrapped_name :: !(LIEWrappedName GhcPs) + , lce_nontype_item :: !GlobalRdrElt } + | LookupChildNonData { lce_wrapped_name :: !(LIEWrappedName GhcPs) + , lce_nondata_item :: !GlobalRdrElt } + lookupChildren :: [GlobalRdrElt] -> [LIEWrappedName GhcPs] - -> MaybeErr [LIEWrappedName GhcPs] -- The ones for which the lookup failed - [LocatedA GlobalRdrElt] + -> ( [LookupChildError] -- The ones for which the lookup failed + , [LocatedA GlobalRdrElt] ) -- (lookupChildren all_kids rdr_items) maps each rdr_item to its --- corresponding Name all_kids, if the former exists +-- corresponding Name in all_kids, if the former exists -- The matching is done by FastString, not OccName, so that -- Cls( meth, AssocTy ) -- will correctly find AssocTy among the all_kids of Cls, even though -- the RdrName for AssocTy may have a (bogus) DataName namespace -- (Really the rdr_items should be FastStrings in the first place.) -lookupChildren all_kids rdr_items - | null fails - = Succeeded (concat oks) - -- This 'fmap concat' trickily applies concat to the /second/ component - -- of the pair, whose type is ([LocatedA Name], [[Located FieldLabel]]) - | otherwise - = Failed fails +lookupChildren all_kids rdr_items = (fails, successes) where - mb_xs = map doOne rdr_items - fails = [ bad_rdr | Failed bad_rdr <- mb_xs ] - oks = [ ok | Succeeded ok <- mb_xs ] - oks :: [[LocatedA GlobalRdrElt]] + mb_xs = map do_one rdr_items + fails = [ err | Failed err <- mb_xs ] + successes = [ ok | Succeeded oks <- mb_xs, ok <- NE.toList oks ] - doOne item@(L l r) - = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc . ieWrappedName) r of - Just [g] - | not $ isRecFldGRE g - -> Succeeded [L l g] - Just gs - | all isRecFldGRE gs - -> Succeeded $ map (L l) gs - _ -> Failed item + do_one :: LIEWrappedName GhcPs -> MaybeErr LookupChildError (NonEmpty (LocatedA GlobalRdrElt)) + do_one item@(L l r) = + case r of + IEName{} + -- IEName (unadorned name) places no restriction on the namespace of + -- the imported entity, so we look in both `val_gres` and `typ_gres`. + -- In case of conflict (punning), the value namespace takes priority. + -- See Note [Prioritise the value namespace in subordinate import lists] + | (gre:gres) <- val_gres -> Succeeded $ fmap (L l) (gre:|gres) + | (gre:gres) <- typ_gres -> Succeeded $ fmap (L l) (gre:|gres) + | otherwise -> Failed $ LookupChildNotFound item + IEType{} + -- IEType ('type' namespace specifier) restricts the lookup to the + -- type namespace, i.e. to `typ_gres`. In case of failure, we check + -- `val_gres` to produce a more helpful error message. + | (gre:gres) <- typ_gres -> Succeeded $ fmap (L l) (gre:|gres) + | (gre:_) <- val_gres -> Failed $ LookupChildNonType item gre + | otherwise -> Failed $ LookupChildNotFound item + + IEData{} + -- IEData ('data' namespace specifier) restricts the lookup to the + -- data namespace, i.e. to `val_gres`. In case of failure, we check + -- `typ_gres` to produce a more helpful error message. + | (gre:gres) <- val_gres -> Succeeded $ fmap (L l) (gre:|gres) + | (gre:_) <- typ_gres -> Failed $ LookupChildNonData item gre + | otherwise -> Failed $ LookupChildNotFound item + + IEPattern{} -> panic "lookupChildren: IEPattern" -- Never happens (invalid syntax) + IEDefault{} -> panic "lookupChildren: IEDefault" -- Never happens (invalid syntax) + where + fs = (occNameFS . rdrNameOcc . ieWrappedName) r + gres = fromMaybe [] (lookupFsEnv kid_env fs) + (val_gres, typ_gres) = partition (isValNameSpace . greNameSpace) gres + -- See Note [Children for duplicate record fields] + kid_env :: FastStringEnv [GlobalRdrElt] kid_env = extendFsEnvList_C (++) emptyFsEnv [(occNameFS (occName x), [x]) | x <- all_kids] +{- Note [Prioritise the value namespace in subordinate import lists] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this program that defines a class that has both an associated type +named (#) and a method named (#) + + module M_assoc where + class C a b where + type a # b + (#) :: a -> b -> () + module N_assoc where + import M_assoc( C((#)) ) + +In the import declaration, when we see the unadorned name (#) in the subordinate +import list of C, which children should we bring into scope? Our options are: + + a) only the method (#) + b) only the associated type (#) + c) both the method and the associated type + +To follow the precedent established by top-level items, we go with option (a). +Indeed, consider a slightly different program + + module M_top where + type family a # b + a # b = () + module N_top where + import M_top( (#) ) + +Here the import brings only the function (#) into scope, and one has to say +`type (#)` to get the type family. +-} + ------------------------------- {- @@ -2122,7 +2237,7 @@ -- to say "T(A,B,C)". So we have to find out what the module exports. to_ie rdr_env _ (Avail c) -- Note [Overloaded field import] = do { let - gre = expectJust "getMinimalImports Avail" $ lookupGRE_Name rdr_env c + gre = expectJust $ lookupGRE_Name rdr_env c ; return $ [IEVar Nothing (to_ie_post_rn $ noLocA $ greName gre) Nothing] } to_ie _ _ avail@(AvailTC n [_]) -- Exporting the main decl and nothing else | availExportsDecl avail @@ -2136,13 +2251,13 @@ | all_used xs -> return [IEThingAll (Nothing, noAnn) (to_ie_post_rn $ noLocA n) Nothing] | otherwise - -> do { let ns_gres = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs + -> do { let ns_gres = map (expectJust . lookupGRE_Name rdr_env) cs ns = map greName ns_gres ; return [IEThingWith (Nothing, noAnn) (to_ie_post_rn $ noLocA n) NoIEWildcard (map (to_ie_post_rn . noLocA) (filter (/= n) ns)) Nothing] } -- Note [Overloaded field import] _other - -> do { let infos = map (expectJust "getMinimalImports AvailTC" . lookupGRE_Name rdr_env) cs + -> do { let infos = map (expectJust . lookupGRE_Name rdr_env) cs (ns_gres,fs_gres) = classifyGREs infos ns = map greName (ns_gres ++ fs_gres) fs = map fieldGREInfo fs_gres @@ -2279,29 +2394,46 @@ -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate + :: ModIface -> ImpDeclSpec -> IE GhcPs + -> IsSubordinateError -> [AvailInfo] - -> TcRn ImportLookupReason + -> TcRn (NonEmpty ImportLookupReason) badImportItemErr iface decl_spec ie sub avails = do - patsyns_enabled <- xoptM LangExt.PatternSynonyms - expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces + exts <- importLookupExtensions + let import_lookup_bad :: BadImportKind -> ImportLookupReason + import_lookup_bad k = ImportLookupBad k iface decl_spec ie exts dflags <- getDynFlags hsc_env <- getTopEnv let rdr_env = mkGlobalRdrEnv $ gresFromAvails hsc_env (Just imp_spec) all_avails - pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled) + pure $ fmap import_lookup_bad (importErrorKind dflags rdr_env) where - importErrorKind dflags rdr_env expl_ns_enabled + importErrorKind :: DynFlags -> GlobalRdrEnv -> NonEmpty BadImportKind + importErrorKind dflags rdr_env | any checkIfTyCon avails = case sub of - IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled - IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren - | any checkIfVarName avails = BadImportAvailVar - | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) - | otherwise = BadImportNotExported suggs + IsNotSubordinate -> NE.singleton BadImportAvailTyCon + IsSubordinateError { subordinate_err_parent = gre + , subordinate_err_unavailable = unavailable + , subordinate_err_nontype = nontype + , subordinate_err_nondata = nondata } + -> NE.fromList $ catMaybes $ + [ fmap (BadImportNotExportedSubordinates gre) (NE.nonEmpty unavailable) + , fmap (BadImportNonTypeSubordinates gre) (NE.nonEmpty nontype) + , fmap (BadImportNonDataSubordinates gre) (NE.nonEmpty nondata) ] + | any checkIfVarName avails = NE.singleton BadImportAvailVar + | Just con <- find checkIfDataCon avails = NE.singleton (BadImportAvailDataCon (availOccName con)) + | otherwise = NE.singleton (BadImportNotExported suggs) where suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr + what_look = case sub of + IsNotSubordinate -> WL_TyCon_or_TermVar + IsSubordinateError { subordinate_err_parent = gre } -> + case greInfo gre of + IAmTyCon ClassFlavour + -> WL_TyCon_or_TermVar + _ -> WL_Term similar_names = - similarNameSuggestions (Unbound.LF WL_Anything WL_Global) + similarNameSuggestions (Unbound.LF what_look WL_Global) dflags rdr_env emptyLocalRdrEnv rdr similar_suggs = case NE.nonEmpty $ mapMaybe imported_item $ similar_names of @@ -2334,9 +2466,12 @@ importedFS = occNameFS $ rdrNameOcc rdr imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } all_avails = mi_exports iface - unavailableChildren = case ie of - IEThingWith _ _ _ ns _ -> map (rdrNameOcc . ieWrappedName . unLoc) ns - _ -> panic "importedChildren failed pattern match: no children" + +importLookupExtensions :: TcRn ImportLookupExtensions +importLookupExtensions = do + ile_pattern_synonyms <- xoptM LangExt.PatternSynonyms + ile_explicit_namespaces <- xoptM LangExt.ExplicitNamespaces + return ImportLookupExtensions{ile_pattern_synonyms, ile_explicit_namespaces} addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () addDupDeclErr gres@(gre :| _) diff --git a/GHC/Rename/Pat.hs b/GHC/Rename/Pat.hs --- a/GHC/Rename/Pat.hs +++ b/GHC/Rename/Pat.hs @@ -53,6 +53,7 @@ import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcMType ( hsOverLitName ) +import GHC.Rename.Doc (rnLHsDoc) import GHC.Rename.Env import GHC.Rename.Fixity import GHC.Rename.Utils ( newLocalBndrRn, bindLocalNames @@ -63,17 +64,19 @@ import GHC.Rename.HsType import GHC.Builtin.Names +import GHC.Types.Hint +import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Types.Unique.Set - import GHC.Types.Basic import GHC.Types.SourceText -import GHC.Utils.Misc + import GHC.Data.FastString ( uniqCompareFS ) import GHC.Data.List.SetOps( removeDups ) -import GHC.Utils.Outputable + +import GHC.Utils.Misc import GHC.Utils.Panic.Plain import GHC.Types.SrcLoc import GHC.Types.Literal ( inCharRange ) @@ -88,15 +91,11 @@ import Data.Function ( on ) import Data.Functor.Identity ( Identity (..) ) import qualified Data.List.NonEmpty as NE -import Data.Maybe import Data.Ratio import Control.Monad.Trans.Writer.CPS import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.Functor ((<&>)) -import GHC.Rename.Doc (rnLHsDoc) -import GHC.Types.Hint -import GHC.Types.Fixity (LexicalFixity(..)) import Data.Coerce {- @@ -161,11 +160,12 @@ unCpsRn (fn a) $ \v -> k (L loc v)) -lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN Name) -lookupConCps con_rdr - = CpsRn (\k -> do { con_name <- lookupLocatedOccRnConstr con_rdr - ; (r, fvs) <- k con_name - ; return (r, addOneFV fvs (unLoc con_name)) }) +lookupConCps :: LocatedN RdrName -> CpsRn (LocatedN (WithUserRdr Name)) +lookupConCps lcon_rdr@(L _ con_rdr) + = CpsRn $ \k -> + do { con_name <- lookupLocatedOccRnConstr lcon_rdr + ; (r, fvs) <- k (fmap (WithUserRdr con_rdr) con_name) + ; return (r, addOneFV fvs (unLoc con_name)) } -- We add the constructor name to the free vars -- See Note [Patterns are uses] @@ -447,13 +447,12 @@ -- -- See Note [Don't report shadowing for pattern synonyms] let bndrs = collectPatsBinders CollVarTyVarBinders (toList pats') - addErrCtxt doc_pat $ + addErrCtxt (MatchCtxt ctxt) $ if isPatSynCtxt ctxt then checkDupNames bndrs else checkDupAndShadowedNames envs_before bndrs thing_inside pats' where - doc_pat = text "In" <+> pprMatchContext ctxt -- See Note [Invisible binders in functions] in GHC.Hs.Pat -- @@ -510,9 +509,9 @@ rnLArgPatAndThen mk = wrapSrcSpanCps rnArgPatAndThen where rnArgPatAndThen (InvisPat (_, spec) tp) = do - liftCps $ unlessXOptM LangExt.TypeAbstractions $ - addErr (TcRnIllegalInvisibleTypePattern tp) tp' <- rnHsTyPat HsTypePatCtx tp + liftCps $ unlessXOptM LangExt.TypeAbstractions $ + addErr (TcRnIllegalInvisibleTypePattern tp' InvisPatWithoutFlag) pure (InvisPat spec tp') rnArgPatAndThen p = rnPatAndThen mk p @@ -526,6 +525,9 @@ {-# SPECIALISE rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn] #-} {-# SPECIALISE rnLPatsAndThen :: NameMaker -> NE.NonEmpty (LPat GhcPs) -> CpsRn (NE.NonEmpty (LPat GhcRn)) #-} +rnLArgPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn] +rnLArgPatsAndThen mk = traverse (rnLArgPatAndThen mk) + -------------------- -- The workhorse rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn) @@ -680,10 +682,10 @@ = do { tp' <- rnHsTyPat HsTypePatCtx tp ; return (EmbTyPat noExtField tp') } rnPatAndThen _ (InvisPat (_, spec) tp) - = do { liftCps $ addErr (TcRnMisplacedInvisPat tp) - -- Invisible patterns are handled in `rnLArgPatAndThen` + = do { -- Invisible patterns are handled in `rnLArgPatAndThen` -- so unconditionally emit error here ; tp' <- rnHsTyPat HsTypePatCtx tp + ; liftCps $ addErr (TcRnIllegalInvisibleTypePattern tp' InvisPatMisplaced) ; return (InvisPat spec tp') } @@ -693,39 +695,21 @@ -> HsConPatDetails GhcPs -> CpsRn (Pat GhcRn) -rnConPatAndThen mk con (PrefixCon tyargs pats) +rnConPatAndThen mk con (PrefixCon pats) = do { con' <- lookupConCps con - ; liftCps check_lang_exts - ; tyargs' <- mapM rnConPatTyArg tyargs - ; pats' <- rnLPatsAndThen mk pats + ; pats' <- rnLArgPatsAndThen mk pats ; return $ ConPat { pat_con_ext = noExtField , pat_con = con' - , pat_args = PrefixCon tyargs' pats' + , pat_args = PrefixCon pats' } } - where - check_lang_exts :: RnM () - check_lang_exts = - for_ (listToMaybe tyargs) $ \ arg -> - do { type_abs <- xoptM LangExt.TypeAbstractions - ; type_app <- xoptM LangExt.TypeApplications - ; scoped_tvs <- xoptM LangExt.ScopedTypeVariables - -- See Note [Deprecated type abstractions in constructor patterns] - ; if | type_abs -> return () - | type_app && scoped_tvs -> addDiagnostic TcRnDeprecatedInvisTyArgInConPat - | otherwise -> addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg) - } - rnConPatTyArg (HsConPatTyArg _ t) = do - t' <- rnHsTyPat HsTypePatCtx t - return (HsConPatTyArg noExtField t') - rnConPatAndThen mk con (InfixCon pat1 pat2) = do { con' <- lookupConCps con ; pat1' <- rnLPatAndThen mk pat1 ; pat2' <- rnLPatAndThen mk pat2 - ; fixity <- liftCps $ lookupFixityRn (unLoc con') + ; fixity <- liftCps $ lookupFixityRn (getName con') ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' } rnConPatAndThen mk con (RecCon rpats) @@ -733,34 +717,10 @@ ; rpats' <- rnHsRecPatsAndThen mk con' rpats ; return $ ConPat { pat_con_ext = noExtField - , pat_con = con' - , pat_args = RecCon rpats' + , pat_con = con' + , pat_args = RecCon rpats' } } - -{- Note [Deprecated type abstractions in constructor patterns] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Type abstractions in constructor patterns allow the user to bind -existential type variables: - - import Type.Reflection (Typeable, typeRep) - data Ex = forall e. (Typeable e, Show e) => MkEx e - showEx (MkEx @e a) = show a ++ " :: " ++ show (typeRep @e) - -Note the pattern `MkEx @e a`, and specifically the `@e` binder. - -For historical reasons, using this feature only required TypeApplications -and ScopedTypeVariables to be enabled. As per GHC Proposal #448 (and especially -its amendment #604) we are now transitioning towards guarding this feature -behind TypeAbstractions instead. - -As a compatibility measure, we continue to support old programs that use -TypeApplications with ScopedTypeVariables instead of TypeAbstractions, -but emit the appropriate compatibility warning, -Wdeprecated-type-abstractions. -This warning is scheduled to become an error in GHC 9.14, at which point -we can simply require TypeAbstractions. --} - checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [ImplicitFieldBinders] -> CpsRn () @@ -772,7 +732,7 @@ -------------------- rnHsRecPatsAndThen :: NameMaker - -> LocatedN Name -- Constructor + -> LocatedN (WithUserRdr Name) -- constructor -> HsRecFields GhcPs (LPat GhcPs) -> CpsRn (HsRecFields GhcRn (LPat GhcRn)) rnHsRecPatsAndThen mk (L _ con) @@ -827,8 +787,8 @@ -} data HsRecFieldContext - = HsRecFieldCon Name - | HsRecFieldPat Name + = HsRecFieldCon (WithUserRdr Name) + | HsRecFieldPat (WithUserRdr Name) | HsRecFieldUpd rnHsRecFields @@ -863,7 +823,9 @@ HsRecFieldPat con -> Just con HsRecFieldUpd -> Nothing - rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg) + rn_fld :: Bool + -> Maybe (WithUserRdr Name) + -> LHsRecField GhcPs (LocatedA arg) -> RnM (LHsRecField GhcRn (LocatedA arg)) rn_fld pun_ok parent (L l (HsFieldBind @@ -887,11 +849,11 @@ , hfbPun = pun } } rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat - -> Maybe Name -- The constructor (Nothing for an - -- out of scope constructor) + -> Maybe (WithUserRdr Name) + -- The constructor (Nothing for an out of scope constructor) -> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields -> RnM [LHsRecField GhcRn (LocatedA arg)] -- Field Labels we need to fill in - rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match + rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just qcon@(WithUserRdr _ con)) flds -- ".." on record construction / pat match | not (isUnboundName con) -- This test is because if the constructor -- isn't in scope the constructor lookup will add -- an error but still return an unbound name. We @@ -900,7 +862,7 @@ do { dd_flag <- xoptM LangExt.RecordWildCards ; checkErr dd_flag (needFlagDotDot ctxt) ; (rdr_env, lcl_env) <- getRdrEnvs - ; conInfo <- lookupConstructorInfo con + ; conInfo <- lookupConstructorInfo qcon ; when (conFieldInfo conInfo == ConHasPositionalArgs) (addErr (TcRnIllegalWildcardsInConstructor con)) ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldRdrs flds) @@ -1027,7 +989,7 @@ checkErr pun_ok (TcRnIllegalFieldPunning (L (locA loc) lbl)) -- Discard any module qualifier (#11662) ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl) - ; return (L (l2l loc) (HsVar noExtField (L (l2l loc) arg_rdr))) } + ; return (L (l2l loc) (mkHsVarWithUserRdr lbl (L (l2l loc) arg_rdr))) } else return arg ; (arg'', fvs) <- rnLExpr arg' ; let lbl' :: FieldOcc GhcRn @@ -1053,8 +1015,9 @@ getFieldRdrs :: [LHsRecField GhcRn arg] -> [RdrName] getFieldRdrs flds = map (foExt . unXRec @GhcRn . hfbLHS . unLoc) flds -getFieldLbls :: forall p arg . UnXRec p => [LHsRecField p arg] -> [IdP p] -getFieldLbls = map (unXRec @p . foLabel . unXRec @p . hfbLHS . unXRec @p) +getFieldLbls :: [LHsRecField (GhcPass p) arg] -> [IdGhcP p] +getFieldLbls flds + = map (unLoc . foLabel . unLoc . hfbLHS . unLoc) flds needFlagDotDot :: HsRecFieldContext -> TcRnMessage needFlagDotDot = TcRnIllegalWildcardsInRecord . toRecordFieldPart @@ -1063,8 +1026,8 @@ dupFieldErr ctxt = TcRnDuplicateFieldName (toRecordFieldPart ctxt) toRecordFieldPart :: HsRecFieldContext -> RecordFieldPart -toRecordFieldPart (HsRecFieldCon n) = RecordFieldConstructor n -toRecordFieldPart (HsRecFieldPat n) = RecordFieldPattern n +toRecordFieldPart (HsRecFieldCon n) = RecordFieldConstructor (getName n) +toRecordFieldPart (HsRecFieldPat n) = RecordFieldPattern (getName n) toRecordFieldPart (HsRecFieldUpd {}) = RecordFieldUpdate {- Note [Disambiguating record updates] @@ -1126,16 +1089,15 @@ the fields fld1, ..., fld99" and instead report e.g. "No constructor has all the fields { fld3, fld17 }". +Wrinkle [Qualified names in record updates] -Note that (1) takes into account qualified names, so that a record update such -as + Note that we must take into account qualified names in (1), so that a record + update such as import qualified M ( R (fld1, fld2) ) f r = r { M.fld1 = 3 } -is unambiguous, as only R contains the field fld1 with the M qualifier. -(See however #22122 for issues relating to the usage of exact Names in -record fields.) + is unambiguous: only R contains the field fld1 with the M qualifier. The function that looks up the GREs for the record update is 'lookupFieldGREs', which uses 'lookupGRE env (LookupRdrName ...)', ensuring that we correctly @@ -1170,32 +1132,6 @@ Note that we do need (1), as (2) does not handle constructors defined in the current module being renamed (as those have not yet been added to the TypeEnv). -Wrinkle [Out of scope constructors] - - For (3)(b), we have an invalid record update because no constructor has - all of the fields of the record update. The 'badFieldsUpd' then tries to - compute a minimal set of fields which are not children of any single - constructor. The way this is done is explained in - Note [Finding the conflicting fields] in GHC.Rename.Env, but in short that - function needs a mapping from ConLike to all of its fields to do its business. - (You may remark that we did not need such a mapping for step (2).) - - This means we need to look up each constructor and find its fields; this - information is stored in the GREInfo field of a constructor GRE. - We need this information even if the constructor itself is not in scope, so - we proceed as follows: - - 1. First look up the constructor in the GlobalRdrEnv, using lookupGRE_Name. - This handles constructors defined in the current module being renamed, - as well as in-scope imported constructors. - 2. If that fails (e.g. the field is imported but the constructor is not), - then look up the GREInfo of the constructor in the TypeEnv, using - lookupGREInfo. This makes sure we give the right error message even when - the constructors are not in scope (#26391). - - Note that we do need (1), as (2) does not handle constructors defined in the - current module being renamed (as those have not yet been added to the TypeEnv). - Note [Using PatSyn FreeVars] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When we are disambiguating a non-overloaded record update, as per @@ -1275,9 +1211,9 @@ lit' = lit { ol_ext = OverLitRn { ol_rebindable = rebindable , ol_from_fun = L (noAnnSrcSpan loc) from_thing_name } } ; if isNegativeZeroOverLit lit' - then do { (negate_name, fvs2) <- lookupSyntaxExpr negateName - ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name) - , fvs1 `plusFV` fvs2) } + then do { (negate_expr, fvs2) <- lookupSyntaxExpr negateName + ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_expr) + , fvs1 `plusFV` fvs2) } else return ((lit', Nothing), fvs1) } @@ -1357,7 +1293,7 @@ hs_ty' <- rn_ty_pat hs_ty pure (L l hs_ty') -rn_ty_pat_var :: LocatedN RdrName -> TPRnM (LocatedN Name) +rn_ty_pat_var :: LocatedN RdrName -> TPRnM (LocatedN (WithUserRdr Name)) rn_ty_pat_var lrdr@(L l rdr) = do locals <- askLocals if isRdrTyVar rdr @@ -1366,11 +1302,11 @@ then do -- binder name <- liftTPRnCps $ newPatName (LamMk True) lrdr tellTPB (tpBuilderExplicitTV name) - pure (L l name) + pure (L l $ WithUserRdr rdr name) else do -- usage name <- lookupTypeOccTPRnM rdr - pure (L l name) + pure (L l $ WithUserRdr rdr name) -- | Rename type patterns -- @@ -1378,13 +1314,13 @@ -- and Note [Implicit and explicit type variable binders] rn_ty_pat :: HsType GhcPs -> TPRnM (HsType GhcRn) rn_ty_pat tv@(HsTyVar an prom lrdr) = do - lname@(L _ name) <- rn_ty_pat_var lrdr + L l (WithUserRdr _ name) <- rn_ty_pat_var lrdr when (isDataConName name && not (isKindName name)) $ -- Any use of a promoted data constructor name (that is not specifically -- exempted by isKindName) is illegal without the use of DataKinds. -- See Note [Checking for DataKinds] in GHC.Tc.Validity. check_data_kinds tv - pure (HsTyVar an prom lname) + pure (HsTyVar an prom (L l $ WithUserRdr (unLoc lrdr) name)) rn_ty_pat (HsForAllTy an tele body) = liftTPRnRaw $ \ctxt locals thing_inside -> bindHsForAllTelescope ctxt tele $ \tele' -> do @@ -1415,7 +1351,7 @@ rn_ty_pat (HsFunTy an mult lhs rhs) = do lhs' <- rn_lty_pat lhs - mult' <- rn_ty_pat_arrow mult + mult' <- rn_ty_pat_mult mult rhs' <- rn_lty_pat rhs pure (HsFunTy an mult' lhs' rhs') @@ -1435,8 +1371,8 @@ ty1' <- rn_lty_pat ty1 l_op' <- rn_ty_pat_var l_op ty2' <- rn_lty_pat ty2 - fix <- liftRn $ lookupTyFixityRn l_op' - let op_name = unLoc l_op' + fix <- liftRn $ lookupTyFixityRn $ fmap getName l_op' + let op_name = getName l_op' when (isDataConName op_name && not (isPromoted prom)) $ liftRn $ addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name) liftRn $ mkHsOpTyRn prom l_op' fix ty1' ty2' @@ -1503,29 +1439,14 @@ | hsTypeNeedsParens maxPrec hs_ty = L loc (HsParTy noAnn lhs_ty) | otherwise = lhs_ty -rn_ty_pat (HsBangTy an bang_src lty) = do - ctxt <- askDocContext - lty'@(L _ ty') <- rn_lty_pat lty - liftRn $ addErr $ - TcRnWithHsDocContext ctxt $ - TcRnUnexpectedAnnotation ty' bang_src - pure (HsBangTy an bang_src lty') - -rn_ty_pat ty@HsRecTy{} = do - ctxt <- askDocContext - liftRn $ addErr $ - TcRnWithHsDocContext ctxt $ - TcRnIllegalRecordSyntax (Left ty) - pure (HsWildCardTy noExtField) -- trick to avoid `failWithTc` - rn_ty_pat ty@(XHsType{}) = do ctxt <- askDocContext liftRnFV $ rnHsType ctxt ty -rn_ty_pat_arrow :: HsArrow GhcPs -> TPRnM (HsArrow GhcRn) -rn_ty_pat_arrow (HsUnrestrictedArrow _) = pure (HsUnrestrictedArrow noExtField) -rn_ty_pat_arrow (HsLinearArrow _) = pure (HsLinearArrow noExtField) -rn_ty_pat_arrow (HsExplicitMult _ p) +rn_ty_pat_mult :: HsMultAnn GhcPs -> TPRnM (HsMultAnn GhcRn) +rn_ty_pat_mult (HsUnannotated _) = pure (HsUnannotated noExtField) +rn_ty_pat_mult (HsLinearAnn _) = pure (HsLinearAnn noExtField) +rn_ty_pat_mult (HsExplicitMult _ p) = rn_lty_pat p <&> (\mult -> HsExplicitMult noExtField mult) check_data_kinds :: HsType GhcPs -> TPRnM () @@ -1632,7 +1553,7 @@ So we have at least three options where we could do free variable extraction: -HsConPatTyArg, ConPat, or a Match (used to represent a function LHS). And none +HsTyPat, ConPat, or a Match (used to represent a function LHS). And none of those would be general enough. Rather than make an arbitrary choice, we embrace left-to-right scoping in types and implement it with CPS, just like it's done for view patterns in terms. diff --git a/GHC/Rename/Splice.hs b/GHC/Rename/Splice.hs --- a/GHC/Rename/Splice.hs +++ b/GHC/Rename/Splice.hs @@ -13,7 +13,7 @@ -- Brackets rnTypedBracket, rnUntypedBracket, - checkThLocalName, traceSplice, SpliceInfo(..), + checkThLocalName, checkThLocalNameWithLift, checkThLocalNameNoLift, traceSplice, SpliceInfo(..), checkThLocalTyName, ) where @@ -44,14 +44,14 @@ import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr ) -import GHC.Tc.Utils.Env ( checkWellStaged, tcMetaTy ) +import GHC.Tc.Utils.Env ( tcMetaTy ) import GHC.Driver.DynFlags import GHC.Data.FastString import GHC.Utils.Logger import GHC.Utils.Panic import GHC.Driver.Hooks -import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName, liftName +import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName , patQTyConName, quoteDecName, quoteExpName , quotePatName, quoteTypeName, typeQTyConName) @@ -70,6 +70,7 @@ import qualified GHC.Boot.TH.Syntax as TH (Q) import qualified GHC.LanguageExtensions as LangExt +import qualified Data.Set as Set {- ************************************************************************ @@ -119,13 +120,13 @@ rnTypedBracket :: HsExpr GhcPs -> LHsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars) rnTypedBracket e br_body - = addErrCtxt (typedQuotationCtxtDoc br_body) $ + = addErrCtxt (TypedTHBracketCtxt br_body) $ do { checkForTemplateHaskellQuotes e -- Check for nested brackets - ; cur_stage <- getStage - ; case cur_stage of - { Splice _ -> return () + ; cur_level <- getThLevel + ; case cur_level of + { Splice _ _ -> return () -- See Note [Untyped quotes in typed splices and vice versa] ; RunSplice _ -> -- See Note [RunSplice ThLevel] in GHC.Tc.Types. @@ -140,21 +141,20 @@ ; recordThUse ; traceRn "Renaming typed TH bracket" empty - ; (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $ rnLExpr br_body - + ; (body', fvs_e) <- setThLevel (Brack cur_level RnPendingTyped) $ rnLExpr br_body ; return (HsTypedBracket noExtField body', fvs_e) } rnUntypedBracket :: HsExpr GhcPs -> HsQuote GhcPs -> RnM (HsExpr GhcRn, FreeVars) rnUntypedBracket e br_body - = addErrCtxt (untypedQuotationCtxtDoc br_body) $ + = addErrCtxt (UntypedTHBracketCtxt br_body) $ do { checkForTemplateHaskellQuotes e -- Check for nested brackets - ; cur_stage <- getStage - ; case cur_stage of - { Splice _ -> return () + ; cur_level <- getThLevel + ; case cur_level of + { Splice _ _ -> return () -- See Note [Untyped quotes in typed splices and vice versa] ; RunSplice _ -> -- See Note [RunSplice ThLevel] in GHC.Tc.Types. @@ -173,49 +173,31 @@ ; (body', fvs_e) <- -- See Note [Rebindable syntax and Template Haskell] unsetXOptM LangExt.RebindableSyntax $ - setStage (Brack cur_stage (RnPendingUntyped ps_var)) $ - rn_utbracket cur_stage br_body + setThLevel (UntypedBrack cur_level ps_var) $ + rn_utbracket br_body ; pendings <- readMutVar ps_var ; return (HsUntypedBracket pendings body', fvs_e) } -rn_utbracket :: ThStage -> HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeVars) -rn_utbracket outer_stage br@(VarBr _ flg rdr_name) - = do { name <- lookupOccRn (unLoc rdr_name) +rn_utbracket :: HsQuote GhcPs -> RnM (HsQuote GhcRn, FreeVars) +rn_utbracket (VarBr _ flg rdr_name) + = do { name <- lookupOccRn (if flg then WL_Term else WL_Type) (unLoc rdr_name) + ; let res_name = L (l2l (locA rdr_name)) (WithUserRdr (unLoc rdr_name) name) + ; if flg then checkThLocalNameNoLift res_name else checkThLocalTyName name ; check_namespace flg name - ; this_mod <- getModule - - ; when (flg && nameIsLocalOrFrom this_mod name) $ - -- Type variables can be quoted in TH. See #5721. - do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name - ; case mb_bind_lvl of - { Nothing -> return () -- Can happen for data constructors, - -- but nothing needs to be done for them - - ; Just (top_lvl, bind_lvl) -- See Note [Quoting names] - | isTopLevel top_lvl - -> when (isExternalName name) (keepAlive name) - | otherwise - -> do { traceRn "rn_utbracket VarBr" - (ppr name <+> ppr bind_lvl - <+> ppr outer_stage) - ; checkTc (thLevel outer_stage + 1 == bind_lvl) $ - TcRnTHError $ THNameError $ QuotedNameWrongStage br } - } - } ; return (VarBr noExtField flg (noLocA name), unitFV name) } -rn_utbracket _ (ExpBr _ e) = do { (e', fvs) <- rnLExpr e +rn_utbracket (ExpBr _ e) = do { (e', fvs) <- rnLExpr e ; return (ExpBr noExtField e', fvs) } -rn_utbracket _ (PatBr _ p) +rn_utbracket (PatBr _ p) = rnPat ThPatQuote p $ \ p' -> return (PatBr noExtField p', emptyFVs) -rn_utbracket _ (TypBr _ t) = do { (t', fvs) <- rnLHsType TypBrCtx t +rn_utbracket (TypBr _ t) = do { (t', fvs) <- rnLHsType TypBrCtx t ; return (TypBr noExtField t', fvs) } -rn_utbracket _ (DecBrL _ decls) +rn_utbracket (DecBrL _ decls) = do { group <- groupDecls decls ; gbl_env <- getGblEnv ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs } @@ -241,7 +223,7 @@ } }} -rn_utbracket _ (DecBrG {}) = panic "rn_ut_bracket: unexpected DecBrG" +rn_utbracket (DecBrG {}) = panic "rn_ut_bracket: unexpected DecBrG" -- | Ensure that we are not using a term-level name in a type-level namespace @@ -253,16 +235,6 @@ where ns = nameNameSpace nm -typedQuotationCtxtDoc :: LHsExpr GhcPs -> SDoc -typedQuotationCtxtDoc br_body - = hang (text "In the Template Haskell typed quotation") - 2 (thTyBrackets . ppr $ br_body) - -untypedQuotationCtxtDoc :: HsQuote GhcPs -> SDoc -untypedQuotationCtxtDoc br_body - = hang (text "In the Template Haskell quotation") - 2 (ppr br_body) - {- ********************************************************* * * @@ -301,32 +273,33 @@ rnUntypedSpliceGen :: (HsUntypedSplice GhcRn -> RnM (a, FreeVars)) -- Outside brackets, run splice - -> (Name -> HsUntypedSplice GhcRn -> (PendingRnSplice, a)) + -> (UntypedSpliceFlavour, HsUntypedSpliceResult z -> HsUntypedSplice GhcRn -> RnM a) -- Inside brackets, make it pending -> HsUntypedSplice GhcPs -> RnM (a, FreeVars) -rnUntypedSpliceGen run_splice pend_splice splice - = addErrCtxt (spliceCtxt splice) $ do - { stage <- getStage - ; case stage of - Brack _ RnPendingTyped +rnUntypedSpliceGen run_splice (flavour, run_pending) splice + = addErrCtxt (UntypedSpliceCtxt splice) $ do + { level <- getThLevel + ; case level of + TypedBrack {} -> failWithTc $ thSyntaxError $ MismatchedSpliceType Untyped IsSplice - Brack pop_stage (RnPendingUntyped ps_var) - -> do { (splice', fvs) <- setStage pop_stage $ - rnUntypedSplice splice + UntypedBrack pop_level ps_var + -> do { (splice', fvs) <- setThLevel pop_level $ + rnUntypedSplice splice flavour ; loc <- getSrcSpanM ; splice_name <- newLocalBndrRn (L (noAnnSrcSpan loc) unqualSplice) - ; let (pending_splice, result) = pend_splice splice_name splice' + ; result <- run_pending (HsUntypedSpliceNested splice_name) splice' ; ps <- readMutVar ps_var - ; writeMutVar ps_var (pending_splice : ps) + ; writeMutVar ps_var (PendingRnSplice splice_name splice' : ps) ; return (result, fvs) } _ -> do { checkTopSpliceAllowed splice + ; cur_level <- getThLevel ; (splice', fvs1) <- checkNoErrs $ - setStage (Splice Untyped) $ - rnUntypedSplice splice + setThLevel (Splice Untyped cur_level) $ + rnUntypedSplice splice flavour -- checkNoErrs: don't attempt to run the splice if -- renaming it failed; otherwise we get a cascade of -- errors from e.g. unbound variables @@ -365,9 +338,11 @@ Nothing -> return splice Just h -> h splice + -- TODO: Should call tcUntypedSplice here ; let the_expr = case splice' of HsUntypedSpliceExpr _ e -> e HsQuasiQuote _ q str -> mkQuasiQuoteExpr flavour q str + XUntypedSplice {} -> pprPanic "runRnSplice: XUntypedSplice" (pprUntypedSplice False Nothing splice') -- Typecheck the expression ; meta_exp_ty <- tcMetaTy meta_ty_name @@ -377,7 +352,7 @@ -- Run the expression ; mod_finalizers_ref <- newTcRef [] - ; result <- setStage (RunSplice mod_finalizers_ref) $ + ; result <- setThLevel (RunSplice mod_finalizers_ref) $ run_meta zonked_q_expr ; mod_finalizers <- readTcRef mod_finalizers_ref ; traceSplice (SpliceInfo { spliceDescription = what @@ -402,18 +377,22 @@ UntypedDeclSplice -> True _ -> False ------------------- -makePending :: UntypedSpliceFlavour - -> Name - -> HsUntypedSplice GhcRn - -> PendingRnSplice -makePending flavour n (HsUntypedSpliceExpr _ e) - = PendingRnSplice flavour n e -makePending flavour n (HsQuasiQuote _ quoter quote) - = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter quote) +-- See Note [Lifecycle of an untyped splice, and PendingRnSplice] +recordPendingSplice :: SplicePointName -> HsImplicitLiftSplice -> PendingStuff -> TcM (HsExpr GhcRn) +recordPendingSplice sp pn (RnPending ref) = do + let untyped_splice = XUntypedSplice pn + updTcRef ref (PendingRnSplice sp untyped_splice : ) + return (HsUntypedSplice (HsUntypedSpliceNested sp) untyped_splice) +-- Splices are not lifted for typed brackets +-- See Note [Lifecycle of an typed splice, and PendingTcSplice] +recordPendingSplice sp pn (RnPendingTyped) = do + let typed_splice = XTypedSplice pn + return (HsTypedSplice (HsTypedSpliceNested sp) typed_splice) +recordPendingSplice _ _ (TcPending _ _ _) = panic "impossible" + ------------------ -mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name +mkQuasiQuoteExpr :: UntypedSpliceFlavour -> LIdP GhcRn -> XRec GhcPs FastString -> LHsExpr GhcRn -- Return the expression (quoter "...quote...") @@ -421,12 +400,12 @@ mkQuasiQuoteExpr flavour quoter (L q_span' quote) = L q_span $ HsApp noExtField (L q_span $ HsApp noExtField (L q_span - (HsVar noExtField (L (l2l q_span) quote_selector))) + (mkHsVar (L (l2l q_span) quote_selector))) quoterExpr) quoteExpr where q_span = noAnnSrcSpan (locA q_span') - quoterExpr = L q_span $! HsVar noExtField $! (L (l2l q_span) quoter) + quoterExpr = L (l2l quoter) $! mkHsVar $! quoter quoteExpr = L q_span $! HsLit noExtField $! HsString NoSourceText quote quote_selector = case flavour of UntypedExpSplice -> quoteExpName @@ -441,38 +420,44 @@ -- We use "spn" (which is arbitrary) because it is brief but grepable-for. unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "spn")) -rnUntypedSplice :: HsUntypedSplice GhcPs -> RnM (HsUntypedSplice GhcRn, FreeVars) +rnUntypedSplice :: HsUntypedSplice GhcPs + -> UntypedSpliceFlavour + -> RnM ( HsUntypedSplice GhcRn + , FreeVars) -- Not exported...used for all -rnUntypedSplice (HsUntypedSpliceExpr annCo expr) +rnUntypedSplice (HsUntypedSpliceExpr _ expr) flavour = do { (expr', fvs) <- rnLExpr expr - ; return (HsUntypedSpliceExpr annCo expr', fvs) } + ; return (HsUntypedSpliceExpr (HsUserSpliceExt flavour) expr', fvs) } -rnUntypedSplice (HsQuasiQuote ext quoter quote) +rnUntypedSplice (HsQuasiQuote _ quoter quote) flavour = do { -- Rename the quoter; akin to the HsVar case of rnExpr - ; quoter' <- lookupOccRn quoter - ; this_mod <- getModule - ; when (nameIsLocalOrFrom this_mod quoter') $ - checkThLocalName quoter' - - ; return (HsQuasiQuote ext quoter' quote, unitFV quoter') } + ; quoter' <- lookupLocatedOccRn WL_TermVariable quoter + ; let res_name = WithUserRdr (unLoc quoter) <$> quoter' + ; checkThLocalNameNoLift res_name + ; return (HsQuasiQuote (HsQuasiQuoteExt flavour) quoter' quote, unitFV (unLoc quoter')) } --------------------- -rnTypedSplice :: LHsExpr GhcPs -- Typed splice expression +rnTypedSplice :: HsTypedSplice GhcPs -- Typed splice expression -> RnM (HsExpr GhcRn, FreeVars) -rnTypedSplice expr - = addErrCtxt (hang (text "In the typed splice:") 2 (pprTypedSplice Nothing expr)) $ do - { stage <- getStage - ; case stage of - Brack pop_stage RnPendingTyped - -> setStage pop_stage rn_splice +rnTypedSplice sp@(HsTypedSpliceExpr _ expr) + = addErrCtxt (TypedSpliceCtxt Nothing sp) $ do + { level <- getThLevel + ; case level of + TypedBrack pop_level + -> do { loc <- getSrcSpanM + ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) unqualSplice) + ; (e, fvs) <- setThLevel pop_level rn_splice + ; return (HsTypedSplice (HsTypedSpliceNested n') (HsTypedSpliceExpr noExtField e), fvs) + } - Brack _ (RnPendingUntyped _) + UntypedBrack {} -> failWithTc $ thSyntaxError $ MismatchedSpliceType Typed IsSplice _ -> do { unlessXOptM LangExt.TemplateHaskell (failWith $ thSyntaxError IllegalTHSplice) - ; (result, fvs1) <- checkNoErrs $ setStage (Splice Typed) rn_splice + ; cur_level <- getThLevel + ; (result, fvs1) <- checkNoErrs $ setThLevel (Splice Typed cur_level) rn_splice -- checkNoErrs: don't attempt to run the splice if -- renaming it failed; otherwise we get a cascade of -- errors from e.g. unbound variables @@ -488,24 +473,18 @@ lcl_names = mkNameSet (localRdrEnvElts lcl_rdr) fvs2 = lcl_names `plusFV` gbl_names - ; return (result, fvs1 `plusFV` fvs2) } } + ; return (HsTypedSplice HsTypedSpliceTop (HsTypedSpliceExpr noExtField result), fvs1 `plusFV` fvs2) } } where - rn_splice :: RnM (HsExpr GhcRn, FreeVars) - rn_splice = - do { loc <- getSrcSpanM - -- The renamer allocates a splice-point name to every typed splice - -- (incl the top level ones for which it will not ultimately be used) - ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) unqualSplice) - ; (expr', fvs) <- rnLExpr expr - ; return (HsTypedSplice n' expr', fvs) } + rn_splice :: RnM (LHsExpr GhcRn, FreeVars) + rn_splice = rnLExpr expr rnUntypedSpliceExpr :: HsUntypedSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars) rnUntypedSpliceExpr splice = rnUntypedSpliceGen run_expr_splice pend_expr_splice splice where - pend_expr_splice :: Name -> HsUntypedSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn) - pend_expr_splice name rn_splice - = (makePending UntypedExpSplice name rn_splice, HsUntypedSplice (HsUntypedSpliceNested name) rn_splice) + pend_expr_splice :: (UntypedSpliceFlavour, HsUntypedSpliceResult (HsExpr GhcRn) -> HsUntypedSplice GhcRn -> RnM (HsExpr GhcRn)) + pend_expr_splice + = (UntypedExpSplice, \x y -> pure $ HsUntypedSplice x y) run_expr_splice rn_splice = do { traceRn "rnUntypedSpliceExpr: untyped expression splice" empty @@ -687,9 +666,9 @@ rnSpliceType splice = rnUntypedSpliceGen run_type_splice pend_type_splice splice where - pend_type_splice name rn_splice - = ( makePending UntypedTypeSplice name rn_splice - , HsSpliceTy (HsUntypedSpliceNested name) rn_splice) + pend_type_splice + = ( UntypedTypeSplice + , \x y -> pure $ HsSpliceTy x y) run_type_splice :: HsUntypedSplice GhcRn -> RnM (HsType GhcRn, FreeVars) run_type_splice rn_splice @@ -767,9 +746,9 @@ rnSplicePat splice = rnUntypedSpliceGen run_pat_splice pend_pat_splice splice where - pend_pat_splice name rn_splice - = (makePending UntypedPatSplice name rn_splice - , (rn_splice, HsUntypedSpliceNested name)) -- Pat splice is nested and thus simply renamed + pend_pat_splice + = (UntypedPatSplice + , \x y -> pure (y, x)) -- Pat splice is nested and thus simply renamed run_pat_splice rn_splice = do { traceRn "rnSplicePat: untyped pattern splice" empty @@ -787,9 +766,9 @@ rnSpliceTyPat splice = rnUntypedSpliceGen run_ty_pat_splice pend_ty_pat_splice splice where - pend_ty_pat_splice name rn_splice - = (makePending UntypedTypeSplice name rn_splice - , (rn_splice, HsUntypedSpliceNested name)) -- HsType splice is nested and thus simply renamed + pend_ty_pat_splice + = (UntypedTypeSplice + , \x y -> pure (y, x)) run_ty_pat_splice rn_splice = do { traceRn "rnSpliceTyPat: untyped pattern splice" empty @@ -806,9 +785,9 @@ rnSpliceDecl (SpliceDecl _ (L loc splice) flg) = rnUntypedSpliceGen run_decl_splice pend_decl_splice splice where - pend_decl_splice name rn_splice - = ( makePending UntypedDeclSplice name rn_splice - , SpliceDecl noExtField (L loc rn_splice) flg) + pend_decl_splice + = ( UntypedDeclSplice + , \_ y -> pure $ SpliceDecl noExtField (L loc y) flg) run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (pprUntypedSplice True Nothing rn_splice) @@ -816,9 +795,10 @@ -- Declaration splice at the very top level of the module rnTopSpliceDecls splice = do { checkTopSpliceAllowed splice + ; cur_level <- getThLevel ; (rn_splice, fvs) <- checkNoErrs $ - setStage (Splice Untyped) $ - rnUntypedSplice splice + setThLevel (Splice Untyped cur_level) $ + rnUntypedSplice splice UntypedDeclSplice -- As always, be sure to checkNoErrs above lest we end up with -- holes making it to typechecking, hence #12584. -- @@ -881,14 +861,6 @@ or its splice point name if nested (HsUntypedSpliceNested) -} -spliceCtxt :: HsUntypedSplice GhcPs -> SDoc -spliceCtxt splice - = hang (text "In the" <+> what) 2 (pprUntypedSplice True Nothing splice) - where - what = case splice of - HsUntypedSpliceExpr {} -> text "untyped splice:" - HsQuasiQuote {} -> text "quasi-quotation:" - -- | The splice data to be logged data SpliceInfo = SpliceInfo @@ -942,113 +914,126 @@ | otherwise = do { traceRn "checkThLocalTyName" (ppr name) - ; mb_local_use <- getStageAndBindLevel name + ; mb_local_use <- getCurrentAndBindLevel name ; case mb_local_use of { Nothing -> return () ; -- Not a locally-bound thing - Just (top_lvl, bind_lvl, use_stage) -> - do { let use_lvl = thLevel use_stage - -- We don't check the well stageness of name here. + Just (top_lvl, bind_lvl, use_lvl) -> + do { let use_lvl_idx = thLevelIndex use_lvl + -- We don't check the well levelledness of name here. -- this would break test for #20969 -- -- Consequently there is no check&restiction for top level splices. -- But it's annoying anyway. -- - -- Therefore checkCrossStageLiftingTy shouldn't assume anything + -- Therefore checkCrossLevelLiftingTy shouldn't assume anything -- about bind_lvl and use_lvl relation. -- - -- ; checkWellStaged (StageCheckSplice name) bind_lvl use_lvl - ; traceRn "checkThLocalTyName" (ppr name <+> ppr bind_lvl - <+> ppr use_stage + <+> ppr use_lvl <+> ppr use_lvl) - ; checkCrossStageLiftingTy top_lvl bind_lvl use_stage use_lvl name } } } + ; dflags <- getDynFlags + ; checkCrossLevelLiftingTy dflags top_lvl bind_lvl use_lvl use_lvl_idx name } } } -checkThLocalName :: Name -> RnM () -checkThLocalName name - | isUnboundName name -- Do not report two errors for - = return () -- $(not_in_scope args) +-- | Check whether we are allowed to use a Name in this context (for TH purposes) +-- In the case of a level incorrect program, attempt to fix it by using +-- a Lift constraint. +checkThLocalNameWithLift :: LIdOccP GhcRn -> RnM (HsExpr GhcRn) +checkThLocalNameWithLift = checkThLocalName True +-- | Check whether we are allowed to use a Name in this context (for TH purposes) +-- In the case of a level incorrect program, do not attempt to fix it by using +-- a Lift constraint. +checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM () +checkThLocalNameNoLift name = checkThLocalName False name >> return () + +-- | Implemenation of the level checks +-- See Note [Template Haskell levels] +checkThLocalName :: Bool -> LIdOccP GhcRn -> RnM (HsExpr GhcRn) +checkThLocalName allow_lifting name_var + -- Exact and Orig names are not imported, so presumed available at all levels. + | isExact (userRdrName (unLoc name_var)) || isOrig (userRdrName (unLoc name_var)) + = return (HsVar noExtField name_var) + | isUnboundName name -- Do not report two errors for + = return (HsVar noExtField name_var) -- $(not_in_scope args) + | isWiredInName name + = return (HsVar noExtField name_var) | otherwise - = do { traceRn "checkThLocalName" (ppr name) - ; mb_local_use <- getStageAndBindLevel name + = do { + mb_local_use <- getCurrentAndBindLevel name ; case mb_local_use of { - Nothing -> return () ; -- Not a locally-bound thing - Just (top_lvl, bind_lvl, use_stage) -> - do { let use_lvl = thLevel use_stage - ; checkWellStaged (StageCheckSplice name) bind_lvl use_lvl - ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl - <+> ppr use_stage - <+> ppr use_lvl) - ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } } + Nothing -> return (HsVar noExtField name_var) ; -- Not a locally-bound thing + Just (top_lvl, bind_lvl, use_lvl) -> + do { let use_lvl_idx = thLevelIndex use_lvl + ; cur_mod <- extractModule <$> getGblEnv + ; let is_local + | Just mod <- nameModule_maybe name = mod == cur_mod + | otherwise = True + ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl <+> ppr use_lvl <+> ppr use_lvl) + ; dflags <- getDynFlags + ; env <- getGlobalRdrEnv + ; let mgre = lookupGRE_Name env name + ; checkCrossLevelLifting dflags (LevelCheckSplice name mgre) top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name_var } } } + where + name = getName name_var -------------------------------------- -checkCrossStageLifting :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel - -> Name -> TcM () --- We are inside brackets, and (use_lvl > bind_lvl) --- Now we must check whether there's a cross-stage lift to do --- Examples \x -> [| x |] --- [| map |] --- --- This code is similar to checkCrossStageLifting in GHC.Tc.Gen.Expr, but --- this is only run on *untyped* brackets. - -checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name - | Brack _ (RnPendingUntyped ps_var) <- use_stage -- Only for untyped brackets - , use_lvl > bind_lvl -- Cross-stage condition - = check_cross_stage_lifting top_lvl name ps_var - | otherwise - = return () - -check_cross_stage_lifting :: TopLevelFlag -> Name -> TcRef [PendingRnSplice] -> TcM () -check_cross_stage_lifting top_lvl name ps_var +checkCrossLevelLifting :: DynFlags + -> LevelCheckReason + -> TopLevelFlag + -> Bool + -> Bool + -> Set.Set ThLevelIndex + -> ThLevel + -> ThLevelIndex + -> LIdOccP GhcRn + -> TcM (HsExpr GhcRn) +checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use_lvl use_lvl_idx name_var + -- 1. If name is in-scope, at the correct level. + | use_lvl_idx `Set.member` bind_lvl = return (HsVar noExtField name_var) + -- 2. Name is imported with -XImplicitStagePersistence + | not is_local + , xopt LangExt.ImplicitStagePersistence dflags = return (HsVar noExtField name_var) + -- 3. Name is top-level, with -XImplicitStagePersistence, and needs + -- to be persisted into the future. | isTopLevel top_lvl - -- Top-level identifiers in this module, - -- (which have External Names) - -- are just like the imported case: - -- no need for the 'lifting' treatment - -- E.g. this is fine: - -- f x = x - -- g y = [| f 3 |] - = when (isExternalName name) (keepAlive name) - -- See Note [Keeping things alive for Template Haskell] - - | otherwise - = -- Nested identifiers, such as 'x' in - -- E.g. \x -> [| h x |] - -- We must behave as if the reference to x was - -- h $(lift x) - -- We use 'x' itself as the SplicePointName, used by - -- the desugarer to stitch it all back together. - -- If 'x' occurs many times we may get many identical - -- bindings of the same SplicePointName, but that doesn't - -- matter, although it's a mite untidy. - do { traceRn "checkCrossStageLifting" (ppr name) - - -- Construct the (lift x) expression - ; let lift_expr = nlHsApp (nlHsVar liftName) (nlHsVar name) - pend_splice = PendingRnSplice UntypedExpSplice name lift_expr - - -- Warning for implicit lift (#17804) - ; addDetailedDiagnostic (TcRnImplicitLift name) + , is_local + , any (use_lvl_idx >=) (Set.toList bind_lvl) + , xopt LangExt.ImplicitStagePersistence dflags = when (isExternalName name) (keepAlive name) >> return (HsVar noExtField name_var) + -- 4. Name is in a bracket, and lifting is allowed + | Brack _ pending <- use_lvl + , any (use_lvl_idx >=) (Set.toList bind_lvl) + , allow_lifting + = do + let mgre = case reason of + LevelCheckSplice _ gre -> gre + _ -> Nothing + (splice_name :: Name) <- newLocalBndrRn (noLocA unqualSplice) + let pend_splice :: HsImplicitLiftSplice + pend_splice = HsImplicitLiftSplice bind_lvl use_lvl_idx mgre name_var + -- Warning for implicit lift (#17804) + addDetailedDiagnostic (TcRnImplicitLift name) - -- Update the pending splices - ; ps <- readMutVar ps_var - ; writeMutVar ps_var (pend_splice : ps) } + -- Update the pending splices if we are renaming a typed bracket + recordPendingSplice splice_name pend_splice pending + -- Otherwise, we have a level error, report. + | otherwise = addErrTc (TcRnBadlyLevelled reason bind_lvl use_lvl_idx Nothing ErrorWithoutFlag ) >> return (HsVar noExtField name_var) + where + name = getName name_var -checkCrossStageLiftingTy :: TopLevelFlag -> ThLevel -> ThStage -> ThLevel -> Name -> TcM () -checkCrossStageLiftingTy top_lvl bind_lvl _use_stage use_lvl name +checkCrossLevelLiftingTy :: DynFlags -> TopLevelFlag -> Set.Set ThLevelIndex -> ThLevel -> ThLevelIndex -> Name -> TcM () +checkCrossLevelLiftingTy dflags top_lvl bind_lvl _use_lvl use_lvl_idx name | isTopLevel top_lvl + , xopt LangExt.ImplicitStagePersistence dflags = return () -- There is no liftType (yet), so we could error, or more conservatively, just warn. -- -- For now, we check here for both untyped and typed splices, as we don't create splices. - | use_lvl > bind_lvl - = addDiagnostic $ TcRnBadlyStagedType name bind_lvl use_lvl - -- See comment in checkThLocalTyName: this can also happen. - | bind_lvl < use_lvl - = addDiagnostic $ TcRnBadlyStagedType name bind_lvl use_lvl + -- Can also happen for negative cases + -- See comment in checkThLocalTyName: + | use_lvl_idx `notElem` bind_lvl + = addDiagnostic $ TcRnBadlyLevelledType name bind_lvl use_lvl_idx | otherwise = return () @@ -1089,7 +1074,7 @@ Note [Quoting names] ~~~~~~~~~~~~~~~~~~~~ A quoted name 'n is a bit like a quoted expression [| n |], except that we -have no cross-stage lifting (c.f. GHC.Tc.Gen.Expr.thBrackId). So, after incrementing +have no cross-level lifting (c.f. GHC.Tc.Gen.Expr.thBrackId). So, after incrementing the use-level to account for the brackets, the cases are: bind > use Error @@ -1108,7 +1093,7 @@ \x. f 'x -- Not ok (bind = 1, use = 1) -- (whereas \x. f [| x |] might have been ok, by - -- cross-stage lifting + -- cross-level lifting \y. [| \x. $(f 'y) |] -- Not ok (bind =1, use = 1) diff --git a/GHC/Rename/Unbound.hs b/GHC/Rename/Unbound.hs --- a/GHC/Rename/Unbound.hs +++ b/GHC/Rename/Unbound.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {- @@ -13,8 +14,8 @@ , mkUnboundGRERdr , isUnboundName , reportUnboundName - , reportUnboundName' , unknownNameSuggestions + , unknownNameSuggestionsMessage , similarNameSuggestions , fieldSelectorSuggestions , WhatLooking(..) @@ -25,7 +26,8 @@ , unboundTermNameInTypes , IsTermInTypes(..) , notInScopeErr - , nameSpacesRelated + , relevantNameSpace + , suggestionIsRelevant , termNameInType ) where @@ -34,10 +36,13 @@ import GHC.Driver.DynFlags import GHC.Driver.Ppr +import GHC.Driver.Env (hsc_units) +import GHC.Driver.Env.Types +import {-# SOURCE #-} GHC.Tc.Errors.Hole ( getHoleFitDispConfig ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad -import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique) +import GHC.Builtin.Names ( mkUnboundName, isUnboundName ) import GHC.Utils.Misc import GHC.Utils.Panic (panic) @@ -53,17 +58,18 @@ import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Name import GHC.Types.Name.Reader -import GHC.Types.Unique.DFM (udfmToList) import GHC.Unit.Module import GHC.Unit.Module.Imported -import GHC.Unit.Home.ModInfo +import GHC.Utils.Outputable +import GHC.Runtime.Context import GHC.Data.Bag -import GHC.Utils.Outputable (empty) +import Language.Haskell.Syntax.ImpExp -import Data.List (sortBy, partition, nub) +import Data.List (sortBy, partition) import Data.List.NonEmpty ( pattern (:|), NonEmpty ) +import qualified Data.List.NonEmpty as NE ( nonEmpty ) import Data.Function ( on ) import qualified Data.Semigroup as S import qualified Data.Map as M @@ -76,19 +82,6 @@ ************************************************************************ -} --- What kind of suggestion are we looking for? #19843 -data WhatLooking = WL_Anything -- Any binding - | WL_Constructor -- Constructors and pattern synonyms - -- E.g. in K { f1 = True }, if K is not in scope, - -- suggest only constructors - | WL_RecField -- Record fields - -- E.g. in K { f1 = True, f2 = False }, if f2 is not in - -- scope, suggest only constructor fields - | WL_None -- No suggestions - -- WS_None is used for rebindable syntax, where there - -- is no point in suggesting alternative spellings - deriving Eq - data WhereLooking = WL_Anywhere -- Any binding | WL_Global -- Any top-level binding (local or imported) | WL_LocalTop -- Any top-level binding in this module @@ -113,11 +106,8 @@ mkUnboundGRERdr :: RdrName -> GlobalRdrElt mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr -reportUnboundName' :: WhatLooking -> RdrName -> RnM Name -reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr - -reportUnboundName :: RdrName -> RnM Name -reportUnboundName = reportUnboundName' WL_Anything +reportUnboundName :: WhatLooking -> RdrName -> RnM Name +reportUnboundName what_look rdr = unboundName (LF what_look WL_Anywhere) rdr unboundName :: LookingFor -> RdrName -> RnM Name unboundName lf rdr = unboundNameX lf rdr [] @@ -141,17 +131,23 @@ = do { dflags <- getDynFlags ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags ; if not show_helpful_errors - then addErr $ make_error [] hints + then addErr =<< make_error [] hints else do { local_env <- getLocalRdrEnv ; global_env <- getGlobalRdrEnv ; impInfo <- getImports ; currmod <- getModule - ; hpt <- getHpt + ; ic <- hsc_IC <$> getTopEnv ; let (imp_errs, suggs) = unknownNameSuggestions_ looking_for - dflags hpt currmod global_env local_env impInfo + dflags ic currmod global_env local_env impInfo rdr_name - ; addErr $ + ; traceTc "unboundNameOrTermInType" $ + vcat [ text "rdr_name:" <+> ppr rdr_name + , text "what_looking:" <+> text (show $ lf_which looking_for) + , text "imp_errs:" <+> ppr imp_errs + , text "suggs:" <+> ppr suggs + ] + ; addErr =<< make_error imp_errs (hints ++ suggs) } ; return (mkUnboundNameRdr rdr_name) } where @@ -162,10 +158,28 @@ err = notInScopeErr (lf_where looking_for) name_to_search - make_error imp_errs hints = case if_term_in_type of - TermInTypes demoted_name -> TcRnTermNameInType demoted_name hints - _ -> TcRnNotInScope err name_to_search imp_errs hints + make_error imp_errs hints = + case if_term_in_type of + TermInTypes demoted_name -> + unknownNameSuggestionsMessage (TcRnTermNameInType demoted_name) + [] -- no import errors + hints + _ -> unknownNameSuggestionsMessage (TcRnNotInScope err name_to_search) + imp_errs hints +unknownNameSuggestionsMessage :: TcRnMessage -> [ImportError] -> [GhcHint] -> RnM TcRnMessage +unknownNameSuggestionsMessage msg imp_errs hints + = do { unit_state <- hsc_units <$> getTopEnv + ; hfdc <- getHoleFitDispConfig + ; let supp = case NE.nonEmpty imp_errs of + Nothing -> Nothing + Just ne_imp_errs -> + (Just (hfdc, [SupplementaryImportErrors ne_imp_errs])) + ; return $ + TcRnMessageWithInfo unit_state $ + mkDetailedMessage (ErrInfo [] supp hints) msg + } + notInScopeErr :: WhereLooking -> RdrName -> NotInScopeError notInScopeErr where_look rdr_name | Just name <- isExact_maybe rdr_name @@ -179,17 +193,17 @@ unknownNameSuggestions :: LocalRdrEnv -> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint]) unknownNameSuggestions lcl_env what_look tried_rdr_name = do { dflags <- getDynFlags - ; hpt <- getHpt ; rdr_env <- getGlobalRdrEnv ; imp_info <- getImports ; curr_mod <- getModule + ; interactive_context <- hsc_IC <$> getTopEnv ; return $ unknownNameSuggestions_ (LF what_look WL_Anywhere) - dflags hpt curr_mod rdr_env lcl_env imp_info tried_rdr_name } + dflags interactive_context curr_mod rdr_env lcl_env imp_info tried_rdr_name } -unknownNameSuggestions_ :: LookingFor -> DynFlags - -> HomePackageTable -> Module +unknownNameSuggestions_ :: LookingFor -> DynFlags -> InteractiveContext + -> Module -> GlobalRdrEnv -> LocalRdrEnv -> ImportAvails -> RdrName -> ([ImportError], [GhcHint]) unknownNameSuggestions_ looking_for dflags hpt curr_mod global_env local_env @@ -201,7 +215,7 @@ , map (ImportSuggestion $ rdrNameOcc tried_rdr_name) imp_suggs , extensionSuggestions tried_rdr_name , fieldSelectorSuggestions global_env tried_rdr_name ] - (imp_errs, imp_suggs) = importSuggestions looking_for global_env hpt curr_mod imports tried_rdr_name + (imp_errs, imp_suggs) = importSuggestions looking_for hpt curr_mod imports tried_rdr_name if_ne :: (NonEmpty a -> b) -> [a] -> [b] if_ne _ [] = [] @@ -234,12 +248,11 @@ tried_occ = rdrNameOcc tried_rdr_name tried_is_sym = isSymOcc tried_occ - tried_ns = occNameSpace tried_occ tried_is_qual = isQual tried_rdr_name - correct_name_space occ = - (nameSpacesRelated dflags what_look tried_ns (occNameSpace occ)) - && isSymOcc occ == tried_is_sym + is_relevant sugg_occ = + suggestionIsRelevant dflags what_look sugg_occ + && isSymOcc sugg_occ == tried_is_sym -- Treat operator and non-operators as non-matching -- This heuristic avoids things like -- Not in scope 'f'; perhaps you meant '+' (from Prelude) @@ -255,7 +268,8 @@ | otherwise = [ (mkRdrUnqual occ, nameSrcSpan name) | name <- localRdrEnvElts env , let occ = nameOccName name - , correct_name_space occ] + , is_relevant occ + ] global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)] global_possibilities global_env @@ -263,7 +277,7 @@ | gre <- globalRdrEnvElts global_env , isGreOk looking_for gre , let occ = greOccName gre - , correct_name_space occ + , is_relevant occ , (mod, how) <- qualsInScope gre , let rdr_qual = mkRdrQual mod occ ] @@ -272,7 +286,7 @@ , isGreOk looking_for gre , let occ = greOccName gre rdr_unqual = mkRdrUnqual occ - , correct_name_space occ + , is_relevant occ , sim <- case (unquals_in_scope gre, quals_only gre) of (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] @@ -308,21 +322,19 @@ -- | Generate errors and helpful suggestions if a qualified name Mod.foo is not in scope. importSuggestions :: LookingFor - -> GlobalRdrEnv - -> HomePackageTable -> Module + -> InteractiveContext -> Module -> ImportAvails -> RdrName -> ([ImportError], [ImportSuggestion]) -importSuggestions looking_for global_env hpt currMod imports rdr_name +importSuggestions looking_for ic currMod imports rdr_name | WL_LocalOnly <- lf_where looking_for = ([], []) | WL_LocalTop <- lf_where looking_for = ([], []) | not (isQual rdr_name || isUnqual rdr_name) = ([], []) - | null interesting_imports - , Just name <- mod_name + | Just name <- mod_name , show_not_imported_line name = ([MissingModule name], []) | is_qualified , null helpful_imports , (mod : mods) <- map fst interesting_imports - = ([ModulesDoNotExport (mod :| mods) occ_name], []) + = ([ModulesDoNotExport (mod :| mods) (lf_which looking_for) occ_name], []) | mod : mods <- helpful_imports_non_hiding = ([], [CouldImportFrom (mod :| mods)]) | mod : mods <- helpful_imports_hiding @@ -344,6 +356,17 @@ , Just imp <- return $ pick (importedByUser mod_imports) ] + -- Choose the imports from the interactive context which might have provided + -- a module. + interactive_imports = + filter pick_interactive (ic_imports ic) + + pick_interactive :: InteractiveImport -> Bool + pick_interactive (IIDecl d) | mod_name == Just (unLoc (ideclName d)) = True + | mod_name == fmap unLoc (ideclAs d) = True + pick_interactive (IIModule m) | mod_name == Just (moduleName m) = True + pick_interactive _ = False + -- We want to keep only one for each original module; preferably one with an -- explicit import list (for no particularly good reason) pick :: [ImportedModsVal] -> Maybe ImportedModsVal @@ -369,17 +392,10 @@ -- See Note [When to show/hide the module-not-imported line] show_not_imported_line :: ModuleName -> Bool -- #15611 show_not_imported_line modnam - | modnam `elem` glob_mods = False -- #14225 -- 1 - | moduleName currMod == modnam = False -- 2.1 - | is_last_loaded_mod modnam hpt_uniques = False -- 2.2 + | not (null interactive_imports) = False -- 1 (interactive context) + | not (null interesting_imports) = False -- 1 (normal module import) + | moduleName currMod == modnam = False -- 2 | otherwise = True - where - hpt_uniques = map fst (udfmToList hpt) - is_last_loaded_mod modnam uniqs = lastMaybe uniqs == Just (getUnique modnam) - glob_mods = nub [ mod - | gre <- globalRdrEnvElts global_env - , (mod, _) <- qualsInScope gre - ] extensionSuggestions :: RdrName -> [GhcHint] extensionSuggestions rdrName @@ -414,41 +430,44 @@ WL_LocalOnly -> False _ -> True --- see Note [Related name spaces] -nameSpacesRelated :: DynFlags -- ^ to find out whether -XDataKinds is enabled - -> WhatLooking -- ^ What kind of name are we looking for - -> NameSpace -- ^ Name space of the original name - -> NameSpace -- ^ Name space of a name that might have been meant +-- | Is it OK to suggest an identifier in some other 'NameSpace', +-- given what we are looking for? +-- +-- See Note [Related name spaces] +suggestionIsRelevant + :: DynFlags -- ^ to find out whether -XDataKinds is enabled + -> WhatLooking -- ^ What kind of name are we looking for? + -> OccName -- ^ The suggestion + -- + -- We only look at the suggestion's 'NameSpace', + -- but passing the whole 'OccName' is convenient + -- for debugging. + -> Bool +suggestionIsRelevant dflags what_looking suggestion = + relevantNameSpace data_kinds what_looking suggestion_ns + where + suggestion_ns = occNameSpace suggestion + data_kinds = xopt LangExt.DataKinds dflags + +-- | Is a 'NameSpace' relevant for what we are looking for? +relevantNameSpace :: Bool -- ^ is @-XDataKinds@ enabled? + -> WhatLooking -- ^ what are we looking for? + -> NameSpace -- ^ is this 'NameSpace' relevant? -> Bool -nameSpacesRelated dflags what_looking ns ns' - | ns == ns' - = True - | otherwise - = or [ other_ns ns' - | (orig_ns, others) <- other_namespaces - , orig_ns ns - , (other_ns, wls) <- others - , what_looking `elem` WL_Anything : wls - ] - where - -- explanation: - -- [(orig_ns, [(other_ns, what_looking_possibilities)])] - -- A particular other_ns is related if the original namespace is orig_ns - -- and what_looking is either WL_Anything or is one of - -- what_looking_possibilities - other_namespaces = - [ (isVarNameSpace , [(isFieldNameSpace , [WL_RecField]) - ,(isDataConNameSpace, [WL_Constructor])]) - , (isDataConNameSpace , [(isVarNameSpace , [WL_RecField])]) - , (isTvNameSpace , (isTcClsNameSpace , [WL_Constructor]) - : promoted_datacons) - , (isTcClsNameSpace , (isTvNameSpace , []) - : promoted_datacons) - ] - -- If -XDataKinds is enabled, the data constructor name space is also - -- related to the type-level name spaces - data_kinds = xopt LangExt.DataKinds dflags - promoted_datacons = [(isDataConNameSpace, [WL_Constructor]) | data_kinds] +relevantNameSpace data_kinds = \case + WL_Anything -> const True + WL_TyCon -> isTcClsNameSpace + WL_TyCon_or_TermVar -> isTcClsNameSpace <||> isTermVarOrFieldNameSpace + WL_TyVar -> isTvNameSpace + WL_Constructor -> isTcClsNameSpace <||> isDataConNameSpace + WL_ConLike -> isDataConNameSpace + WL_RecField -> isFieldNameSpace + WL_Term -> isValNameSpace + WL_TermVariable -> isTermVarOrFieldNameSpace + WL_Type -> if data_kinds + then not . isTermVarOrFieldNameSpace + else not . isValNameSpace + WL_None -> const False {- Note [Related name spaces] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -478,13 +497,8 @@ Module X does not export Y No module named ‘X’ is imported: there are 2 cases, where we hide the last "no module is imported" line: -1. If the module X has been imported. -2. If the module X is the current module. There are 2 subcases: - 2.1 If the unknown module name is in a input source file, - then we can use the getModule function to get the current module name. - (See test T15611a) - 2.2 If the unknown module name has been entered by the user in GHCi, - then the getModule function returns something like "interactive:Ghci1", - and we have to check the current module in the last added entry of - the HomePackageTable. (See test T15611b) +1. If the module X has been imported (normally or via interactive context). +2. It is the current module we are trying to compile + then we can use the getModule function to get the current module name. + (See test T15611a) -} diff --git a/GHC/Rename/Utils.hs b/GHC/Rename/Utils.hs --- a/GHC/Rename/Utils.hs +++ b/GHC/Rename/Utils.hs @@ -25,10 +25,9 @@ genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat, genVarPat, genWildPat, genSimpleFunBind, genFunBind, - - genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, + genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, genHsLet, - genHsLet, + mkRnSyntaxExpr, newLocalBndrRn, newLocalBndrsRn, @@ -43,7 +42,7 @@ where -import GHC.Prelude hiding (unzip) +import GHC.Prelude import GHC.Core.Type import GHC.Hs @@ -75,9 +74,8 @@ import GHC.Iface.Load import qualified GHC.LanguageExtensions as LangExt -import qualified Data.List as List import qualified Data.List.NonEmpty as NE -import Data.Foldable +import Data.Foldable (for_) import Data.Maybe @@ -108,7 +106,7 @@ bindLocalNames :: [Name] -> RnM a -> RnM a bindLocalNames names = updLclCtxt $ \ lcl_env -> - let th_level = thLevel (tcl_th_ctxt lcl_env) + let th_level = thLevelIndex (tcl_th_ctxt lcl_env) th_bndrs' = extendNameEnvList (tcl_th_bndrs lcl_env) [ (n, (NotTopLevel, th_level)) | n <- names ] rdr_env' = extendLocalRdrEnvList (tcl_rdr lcl_env) names @@ -347,11 +345,6 @@ (ys, fvs_s) -> return (ys, foldl' (flip plusFV) emptyFVs fvs_s) {-# SPECIALIZE mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) #-} -unzip :: Functor f => f (a, b) -> (f a, f b) -unzip = \ xs -> (fmap fst xs, fmap snd xs) -{-# NOINLINE [1] unzip #-} -{-# RULES "unzip/List" unzip = List.unzip #-} - mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars) mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs) mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) } @@ -546,9 +539,9 @@ lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) lookupImpDeclDeprec iface gre -- Bleat if the thing, or its parent, is warn'd - = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` + = mi_decl_warn_fn iface (greOccName gre) `mplus` case greParent gre of - ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p) + ParentIs p -> mi_decl_warn_fn iface (nameOccName p) NoParent -> Nothing warnIfExportDeprecated :: GlobalRdrElt -> RnM () @@ -569,7 +562,7 @@ process_import_spec is = do let mod = is_mod $ is_decl is iface <- loadInterfaceForModule doc mod - let mb_warn_txt = mi_export_warn_fn (mi_final_exts iface) name + let mb_warn_txt = mi_export_warn_fn iface name return $ (moduleName mod, ) <$> mb_warn_txt ------------------------- @@ -679,7 +672,7 @@ badQualBndrErr rdr_name = TcRnQualifiedBinder rdr_name typeAppErr :: TypeOrKind -> LHsType GhcPs -> TcRnMessage -typeAppErr what (L _ k) = TcRnTypeApplicationsDisabled (TypeApplication k what) +typeAppErr what (L _ k) = TcRnTypeApplicationsDisabled k what badFieldConErr :: Name -> FieldLabelString -> TcRnMessage badFieldConErr con field = TcRnInvalidRecordField con field @@ -713,6 +706,14 @@ -- See Note [Rebindable syntax and XXExprGhcRn] wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x +-- | Make a 'SyntaxExpr' from a 'Name' (the "rn" is because this is used in the +-- renamer). +mkRnSyntaxExpr :: Name -> SyntaxExprRn +mkRnSyntaxExpr = SyntaxExprRn . genHsVar + +genHsVar :: Name -> HsExpr GhcRn +genHsVar n = mkHsVar (wrapGenSpan n) + genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn genHsApps fun args = foldl genHsApp (genHsVar fun) args @@ -733,9 +734,6 @@ genLHsVar :: Name -> LHsExpr GhcRn genLHsVar nm = wrapGenSpan $ genHsVar nm -genHsVar :: Name -> HsExpr GhcRn -genHsVar nm = HsVar noExtField $ wrapGenSpan nm - genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) (mkEmptyWildCardBndrs (wrapGenSpan ty)) @@ -752,8 +750,8 @@ -- The pattern (C p1 .. pn) genSimpleConPat con pats = wrapGenSpan $ ConPat { pat_con_ext = noExtField - , pat_con = wrapGenSpan con - , pat_args = PrefixCon [] pats } + , pat_con = wrapGenSpan $ noUserRdr con + , pat_args = PrefixCon pats } genVarPat :: Name -> LPat GhcRn genVarPat n = wrapGenSpan $ VarPat noExtField (wrapGenSpan n) diff --git a/GHC/Runtime/Context.hs b/GHC/Runtime/Context.hs --- a/GHC/Runtime/Context.hs +++ b/GHC/Runtime/Context.hs @@ -115,6 +115,51 @@ modules. +Note [Relation between the 'InteractiveContext' and 'interactiveGhciUnitId'] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'InteractiveContext' is used to store 'DynFlags', 'Plugins' and similar +information about the so-called interactive "home unit". We are using +quotes here, since, originally, GHC wasn't aware of more than one 'HomeUnitEnv's. +So the 'InteractiveContext' was a hack/solution to have 'DynFlags' and 'Plugins' +independent of the 'DynFlags' and 'Plugins' stored in 'HscEnv'. +Nowadays, GHC has support for multiple home units via the 'HomeUnitGraph', thus, +this part of the 'InteractiveContext' is strictly speaking redundant, as we +can simply manage one 'HomeUnitEnv' for the 'DynFlags' and 'Plugins' that are +currently stored in the 'InteractiveContext'. + +As a matter of fact, that's exactly what we do nowadays. +That means, we can also lift other restrictions in the future, for example +allowing @:seti@ commands to modify the package-flags, since we now have a +separate 'UnitState' for the interactive session. +However, we did not rip out 'ic_dflags' and 'ic_plugins', yet, as it makes +it easier to access them for functions that want to use the interactive 'DynFlags', +such as 'runInteractiveHsc' and 'mkInteractiveHscEnv', without having to look that +information up in the 'HomeUnitGraph'. +It is reasonable to change this in the future, and remove 'ic_dflags' and 'ic_plugins'. + +We keep 'ic_dflags' and 'ic_plugins' around, but we also store a 'HomeUnitEnv' +for the 'DynFlags' and 'Plugins' of the interactive session. + +It is important to keep the 'DynFlags' in these two places consistent. + +In other words, whenever you update the 'DynFlags' of the 'interactiveGhciUnitId' +in the 'HscEnv', then you also need to update the 'DynFlags' of the +'InteractiveContext'. +The easiest way to update them is via 'setInteractiveDynFlags'. +However, careful, footgun! It is very easy to call 'setInteractiveDynFlags' +and forget to call 'normaliseInteractiveDynFlags' on the 'DynFlags' in the +'HscEnv'! This is important, because you may, accidentally, have enabled +Language Extensions that are not supported in the interactive ghc session, +which we do not want. + +To summarise, the 'ic_dflags' and 'ic_plugins' are currently used to +conveniently cache them for easy access. +The 'ic_dflags' must be identical to the 'DynFlags' stored in the 'HscEnv' +for the 'HomeUnitEnv' identified by 'interactiveGhciUnitId'. + +See Note [Multiple Home Units aware GHCi] for the design and rationale for +the current 'interactiveGhciUnitId'. + Note [Interactively-bound Ids in GHCi] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Ids bound by previous Stmts in GHCi are currently @@ -296,7 +341,7 @@ -- ^ Bring the exports of a particular module -- (filtered by an import decl) into scope - | IIModule ModuleName + | IIModule Module -- ^ Bring into scope the entire top-level envt of -- of this module, including the things imported -- into it. diff --git a/GHC/Runtime/Debugger.hs b/GHC/Runtime/Debugger.hs --- a/GHC/Runtime/Debugger.hs +++ b/GHC/Runtime/Debugger.hs @@ -16,6 +16,9 @@ import GHC +import GHC.Data.List.Infinite (Infinite (..)) +import qualified GHC.Data.List.Infinite as Inf + import GHC.Driver.DynFlags import GHC.Driver.Ppr import GHC.Driver.Monad @@ -30,6 +33,7 @@ import GHC.Iface.Syntax ( showToHeader ) import GHC.Iface.Env ( newInteractiveBinder ) import GHC.Core.Type +import GHC.Core.TyCo.Tidy( tidyOpenType ) import GHC.Utils.Outputable import GHC.Utils.Error @@ -48,7 +52,7 @@ import Control.Monad import Control.Monad.Catch as MC -import Data.List ( (\\), partition ) +import Data.List ( partition ) import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.IORef @@ -149,7 +153,7 @@ let ictxt = hsc_IC hsc_env prefix = "_t" alreadyUsedNames = map (occNameString . nameOccName . getName) inScope - availNames = map ((prefix++) . show) [(1::Int)..] \\ alreadyUsedNames + availNames = (Inf.filter (`notElem` alreadyUsedNames) . fmap ((prefix++) . show)) (Inf.enumFrom (1::Int)) availNames_var <- liftIO $ newIORef availNames (t', stuff) <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env availNames_var) t let (names, tys, fhvs) = unzip3 stuff @@ -163,7 +167,7 @@ where -- Processing suspensions. Give names and collect info - nameSuspensionsAndGetInfos :: HscEnv -> IORef [String] + nameSuspensionsAndGetInfos :: HscEnv -> IORef (Infinite String) -> TermFold (IO (Term, [(Name,Type,ForeignHValue)])) nameSuspensionsAndGetInfos hsc_env freeNames = TermFold { @@ -181,10 +185,10 @@ (term, names) <- t return (RefWrap ty term, names) } - doSuspension hsc_env freeNames ct ty hval _name = do - name <- atomicModifyIORef' freeNames (\x->(tail x, head x)) + doSuspension hsc_env freeNames ct ty hval _name ipe = do + name <- atomicModifyIORef' freeNames (\(Inf x xs)->(xs, x)) n <- newGrimName hsc_env name - return (Suspension ct ty hval (Just n), [(n,ty,hval)]) + return (Suspension ct ty hval (Just n) ipe, [(n,ty,hval)]) -- A custom Term printer to enable the use of Show instances diff --git a/GHC/Runtime/Debugger/Breakpoints.hs b/GHC/Runtime/Debugger/Breakpoints.hs new file mode 100644 --- /dev/null +++ b/GHC/Runtime/Debugger/Breakpoints.hs @@ -0,0 +1,298 @@ + +-- | GHC API debugger module for finding and setting breakpoints. +-- +-- This module is user facing and is at least used by `GHCi` and `ghc-debugger` +-- to find and set breakpoints. +module GHC.Runtime.Debugger.Breakpoints where + +import GHC.Prelude + +import Control.Monad.Catch +import Control.Monad +import Data.Array +import Data.Function +import Data.List +import Data.Maybe +import qualified Data.List.NonEmpty as NE +import qualified Data.Semigroup as S + +import GHC.HsToCore.Breakpoints +import GHC.ByteCode.Breakpoints +import GHC.Driver.Env +import GHC.Driver.Monad +import GHC.Driver.Session.Inspect +import GHC.Runtime.Eval +import GHC.Runtime.Eval.Utils +import GHC.Types.Name +import GHC.Types.SrcLoc +import GHC.Unit.Module +import GHC.Unit.Module.Graph +import GHC.Unit.Module.ModSummary +import GHC.Utils.Outputable +import GHC.Utils.Panic +import qualified GHC.Data.Strict as Strict +import qualified Data.IntMap.Strict as IntMap +import qualified GHC.Unit.Home.Graph as HUG +import qualified GHC.Unit.Home.PackageTable as HPT + +-------------------------------------------------------------------------------- +-- Finding Module breakpoints +-------------------------------------------------------------------------------- + +-- | Find a breakpoint given a Module's 'TickArray' and the line number. +-- +-- When a line number is specified, the current policy for choosing +-- the best breakpoint is this: +-- - the leftmost complete subexpression on the specified line, or +-- - the leftmost subexpression starting on the specified line, or +-- - the rightmost subexpression enclosing the specified line +-- +findBreakByLine :: Int {-^ Line number -} -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan) +findBreakByLine line arr + | not (inRange (bounds arr) line) = Nothing + | otherwise = + listToMaybe (sortBy (leftmostLargestRealSrcSpan `on` snd) comp) `mplus` + listToMaybe (sortBy (compare `on` snd) incomp) `mplus` + listToMaybe (sortBy (flip compare `on` snd) ticks) + where + ticks = arr ! line + + starts_here = [ (ix,pan) | (ix, pan) <- ticks, + srcSpanStartLine pan == line ] + + (comp, incomp) = partition ends_here starts_here + where ends_here (_,pan) = srcSpanEndLine pan == line + +-- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate. +findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakTickIndex, RealSrcSpan) +findBreakByCoord (line, col) arr + | not (inRange (bounds arr) line) = Nothing + | otherwise = + listToMaybe (sortBy (flip compare `on` snd) contains ++ + sortBy (compare `on` snd) after_here) + where + ticks = arr ! line + + -- the ticks that span this coordinate + contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Strict.Nothing `spans` (line,col) ] + + after_here = [ tick | tick@(_,pan) <- ticks, + srcSpanStartLine pan == line, + srcSpanStartCol pan >= col ] + +leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering +leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd + +-- | Returns the span of the largest tick containing the srcspan given +enclosingTickSpan :: TickArray -> SrcSpan -> RealSrcSpan +enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan" +enclosingTickSpan ticks (RealSrcSpan src _) = + assert (inRange (bounds ticks) line) $ + Data.List.minimumBy leftmostLargestRealSrcSpan $ enclosing_spans + where + line = srcSpanStartLine src + enclosing_spans = [ pan | (_,pan) <- ticks ! line + , realSrcSpanEnd pan >= realSrcSpanEnd src] + +-------------------------------------------------------------------------------- +-- Finding Function breakpoints +-------------------------------------------------------------------------------- + +-- | Process and validate the user string of form @[Module.]function@ into the +-- relevant module information and function name. +-- +-- Validation guarantees +-- 1. The module exists +-- 2. The identifier is in an interpreted module +-- 3. The identifier has a breakpoint entry in the module's 'ModBreaks' +-- +-- Returns either an error SDoc or the 'Module' and 'ModuleInfo' for the relevant module +-- paired with the function name +-- +-- See also Note [Setting Breakpoints by Id] +resolveFunctionBreakpoint :: GhcMonad m => String -> m (Either SDoc (Module, ModuleInfo, String)) +resolveFunctionBreakpoint inp = do + let (mod_str, top_level, fun_str) = splitIdent inp + mod_top_lvl = combineModIdent mod_str top_level + mb_mod <- catch (lookupModuleInscope mod_top_lvl) + (\(_ :: SomeException) -> lookupModuleInGraph mod_str) + -- If the top-level name is not in scope, `lookupModuleInscope` will + -- throw an exception, then lookup the module name in the module graph. + mb_err_msg <- validateBP mod_str fun_str mb_mod + case mb_err_msg of + Just err_msg -> pure . Left $ + text "Cannot set breakpoint on" <+> quotes (text inp) + <> text ":" <+> err_msg + Nothing -> do + -- No errors found, go and return the module info + let mod = fromMaybe (panic "resolveFunctionBreakpoint") mb_mod + mb_mod_info <- getModuleInfo mod + case mb_mod_info of + Nothing -> pure . Left $ + text "Could not find ModuleInfo of " <> ppr mod + Just mod_info -> pure $ Right (mod, mod_info, fun_str) + where + -- Try to lookup the module for an identifier that is in scope. + -- `parseName` throws an exception, if the identifier is not in scope + lookupModuleInscope :: GhcMonad m => String -> m (Maybe Module) + lookupModuleInscope mod_top_lvl = do + names <- parseName mod_top_lvl + pure $ Just $ NE.head $ nameModule <$> names + + -- Lookup the Module of a module name in the module graph + lookupModuleInGraph :: GhcMonad m => String -> m (Maybe Module) + lookupModuleInGraph mod_str = do + graph <- getModuleGraph + let hmods = ms_mod <$> mgModSummaries graph + pure $ find ((== mod_str) . moduleNameString . moduleName) hmods + + -- Check validity of an identifier to set a breakpoint: + -- 1. The module of the identifier must exist + -- 2. the identifier must be in an interpreted module + -- 3. the ModBreaks array for module `mod` must have an entry + -- for the function + validateBP :: GhcMonad m => String -> String -> Maybe Module + -> m (Maybe SDoc) + validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text + (combineModIdent mod_str (takeWhile (/= '.') fun_str))) + <+> text "not in scope" + validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing" + validateBP _ fun_str (Just modl) = do + isInterpr <- moduleIsInterpreted modl + mb_err_msg <- case isInterpr of + False -> pure $ Just $ text "Module" <+> quotes (ppr modl) <+> text "is not interpreted" + True -> do + mb_modbreaks <- getModBreak modl + let found = case mb_modbreaks of + Nothing -> False + Just mb -> fun_str `elem` (intercalate "." <$> elems (modBreaks_decls mb)) + if found + then pure Nothing + else pure $ Just $ text "No breakpoint found for" <+> quotes (text fun_str) + <+> text "in module" <+> quotes (ppr modl) + pure mb_err_msg + +-- | The aim of this function is to find the breakpoints for all the RHSs of +-- the equations corresponding to a binding. So we find all breakpoints +-- for +-- (a) this binder only (it maybe a top-level or a nested declaration) +-- (b) that do not have an enclosing breakpoint +findBreakForBind :: String {-^ Name of bind to break at -} -> ModBreaks -> [(BreakTickIndex, RealSrcSpan)] +findBreakForBind str_name modbreaks = filter (not . enclosed) ticks + where + ticks = [ (index, span) + | (index, decls) <- assocs (modBreaks_decls modbreaks), + str_name == intercalate "." decls, + RealSrcSpan span _ <- [modBreaks_locs modbreaks ! index] ] + enclosed (_,sp0) = any subspan ticks + where subspan (_,sp) = sp /= sp0 && + realSrcSpanStart sp <= realSrcSpanStart sp0 && + realSrcSpanEnd sp0 <= realSrcSpanEnd sp + +-------------------------------------------------------------------------------- +-- Mapping line numbers to ticks +-------------------------------------------------------------------------------- + +-- | Maps line numbers to the breakpoint ticks existing at that line for a module. +type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)] + +-- | Construct the 'TickArray' for the given module. +makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray) +makeModuleLineMap m = do + mi <- getModuleInfo m + return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi) + where + mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray + mkTickArray ticks + = accumArray (flip (:)) [] (1, max_line) + [ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ] + where + max_line = foldr max 0 [ srcSpanEndLine sp | (_, RealSrcSpan sp _) <- ticks ] + srcSpanLines pan = [ srcSpanStartLine pan .. srcSpanEndLine pan ] + +-- | Get the 'ModBreaks' of the given 'Module' when available +getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks) +getModBreak m = do + mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m + pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info + +-------------------------------------------------------------------------------- +-- Mapping source-level BreakpointIds to IBI occurrences +-- (See Note [Breakpoint identifiers]) +-------------------------------------------------------------------------------- + +-- | A source-level breakpoint may have been inlined into many occurrences, now +-- referred by 'InternalBreakpointId'. When a breakpoint is set on a certain +-- source breakpoint, it means all *ocurrences* of that breakpoint across +-- modules should be stopped at -- hence we keep a trie from BreakpointId to +-- the list of internal break ids using it. +-- See also Note [Breakpoint identifiers] +type BreakpointOccurrences = ModuleEnv (IntMap.IntMap [InternalBreakpointId]) + +-- | Lookup all InternalBreakpointIds matching the given BreakpointId +-- Nothing if BreakpointId not in map +lookupBreakpointOccurrences :: BreakpointOccurrences -> BreakpointId -> Maybe [InternalBreakpointId] +lookupBreakpointOccurrences bmp (BreakpointId md tick) = + lookupModuleEnv bmp md >>= IntMap.lookup tick + +-- | Construct a mapping from Source 'BreakpointId's to 'InternalBreakpointId's from the given list of 'ModInfo's +mkBreakpointOccurrences :: forall m. GhcMonad m => m BreakpointOccurrences +mkBreakpointOccurrences = do + hug <- hsc_HUG <$> getSession + liftIO $ foldr go (pure emptyModuleEnv) hug + where + go :: HUG.HomeUnitEnv -> IO BreakpointOccurrences -> IO BreakpointOccurrences + go hue mbmp = do + bmp <- mbmp + ibrkss <- HPT.concatHpt (\hmi -> maybeToList (getModBreaks hmi)) + (HUG.homeUnitEnv_hpt hue) + return $ foldr addBreakToMap bmp ibrkss + + addBreakToMap :: InternalModBreaks -> BreakpointOccurrences -> BreakpointOccurrences + addBreakToMap ibrks bmp0 = do + let imod = modBreaks_module $ imodBreaks_modBreaks ibrks + IntMap.foldrWithKey (\info_ix cgi bmp -> do + let ibi = InternalBreakpointId imod info_ix + case cgb_tick_id cgi of + Right (BreakpointId tick_mod tick_ix) + -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi]) + Left _ + -- Do not include internal breakpoints in the visible breakpoint + -- occurrences! + -> bmp + ) bmp0 (imodBreaks_breakInfo ibrks) + +-------------------------------------------------------------------------------- +-- Getting current breakpoint information +-------------------------------------------------------------------------------- + +getCurrentBreakSpan :: GhcMonad m => m (Maybe SrcSpan) +getCurrentBreakSpan = do + hug <- hsc_HUG <$> getSession + resumes <- getResumeContext + case resumes of + [] -> return Nothing + (r:_) -> do + let ix = resumeHistoryIx r + if ix == 0 + then return (Just (resumeSpan r)) + else do + let hist = resumeHistory r !! (ix-1) + pan <- liftIO $ getHistorySpan hug hist + return (Just pan) + +getCurrentBreakModule :: GhcMonad m => m (Maybe Module) +getCurrentBreakModule = do + resumes <- getResumeContext + hug <- hsc_HUG <$> getSession + liftIO $ case resumes of + [] -> pure Nothing + (r:_) -> case resumeHistoryIx r of + 0 -> case resumeBreakpointId r of + Nothing -> pure Nothing + Just ibi -> do + brks <- readIModBreaks hug ibi + return $ Just $ getBreakSourceMod ibi brks + ix -> + Just <$> getHistoryModule hug (resumeHistory r !! (ix-1)) + diff --git a/GHC/Runtime/Eval.hs b/GHC/Runtime/Eval.hs --- a/GHC/Runtime/Eval.hs +++ b/GHC/Runtime/Eval.hs @@ -2,8 +2,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow, 2005-2007 @@ -20,12 +18,12 @@ abandon, abandonAll, getResumeContext, getHistorySpan, - getModBreaks, + getModBreaks, readIModBreaks, readIModModBreaks, getHistoryModule, setupBreakpoint, back, forward, setContext, getContext, - mkTopLevEnv, + mkTopLevEnv, mkTopLevImportedEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -55,7 +53,7 @@ import GHC.Driver.Ppr import GHC.Driver.Config -import GHC.Rename.Names (importsFromIface) +import GHC.Rename.Names (importsFromIface, gresFromAvails) import GHC.Runtime.Eval.Types import GHC.Runtime.Interpreter as GHCi @@ -66,6 +64,7 @@ import GHC.ByteCode.Types import GHC.Linker.Loader as Loader +import GHC.Linker.Types (LinkedBreaks (..)) import GHC.Hs @@ -74,6 +73,7 @@ import GHC.Core.InstEnv import GHC.Core.Predicate import GHC.Core.TyCo.Ppr +import GHC.Core.TyCo.Tidy( tidyType, tidyOpenTypes ) import GHC.Core.TyCon import GHC.Core.Type hiding( typeKind ) import qualified GHC.Core.Type as Type @@ -112,35 +112,31 @@ import GHC.Types.Unique.Supply import GHC.Types.Unique.DSet import GHC.Types.TyThing -import GHC.Types.Breakpoint import GHC.Types.Unique.Map +import GHC.Types.Avail import GHC.Unit import GHC.Unit.Module.Graph import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModSummary import GHC.Unit.Home.ModInfo -import GHC.Tc.Module ( runTcInteractive, tcRnType, loadUnqualIfaces ) +import GHC.Tc.Module ( runTcInteractive, tcRnTypeSkolemising, loadUnqualIfaces ) import GHC.Tc.Solver (simplifyWantedsTcM) -import GHC.Tc.Utils.Env (tcGetInstEnvs, lookupGlobal) +import GHC.Tc.Utils.Env (tcGetInstEnvs) import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad -import GHC.Tc.Zonk.Env ( ZonkFlexi (SkolemiseFlexi) ) -import GHC.Unit.Env import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad -import Control.Monad.Catch as MC -import Data.Array import Data.Dynamic import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) -import System.Directory import Unsafe.Coerce ( unsafeCoerce ) +import qualified GHC.Unit.Home.Graph as HUG +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -148,27 +144,29 @@ getResumeContext :: GhcMonad m => m [Resume] getResumeContext = withSession (return . ic_resume . hsc_IC) -mkHistory :: HscEnv -> ForeignHValue -> InternalBreakpointId -> History -mkHistory hsc_env hval ibi = History hval ibi (findEnclosingDecls hsc_env ibi) +mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO History +mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi -getHistoryModule :: History -> Module -getHistoryModule = ibi_tick_mod . historyBreakpointId +getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module +getHistoryModule hug hist = do + let ibi = historyBreakpointId hist + brks <- readIModBreaks hug ibi + return $ getBreakSourceMod ibi brks -getHistorySpan :: HscEnv -> History -> SrcSpan -getHistorySpan hsc_env hist = - let ibi = historyBreakpointId hist in - case lookupHugByModule (ibi_tick_mod ibi) (hsc_HUG hsc_env) of - Just hmi -> modBreaks_locs (getModBreaks hmi) ! ibi_tick_index ibi - _ -> panic "getHistorySpan" +getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan +getHistorySpan hug hist = do + let ibi = historyBreakpointId hist + brks <- readIModBreaks hug ibi + getBreakLoc (readIModModBreaks hug) ibi brks {- | Finds the enclosing top level function name -} -- ToDo: a better way to do this would be to keep hold of the decl_path computed -- by the coverage pass, which gives the list of lexically-enclosing bindings -- for each tick. -findEnclosingDecls :: HscEnv -> InternalBreakpointId -> [String] -findEnclosingDecls hsc_env ibi = - let hmi = expectJust "findEnclosingDecls" $ lookupHugByModule (ibi_tick_mod ibi) (hsc_HUG hsc_env) - in modBreaks_decls (getModBreaks hmi) ! ibi_tick_index ibi +findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String] +findEnclosingDecls hug ibi = do + brks <- readIModBreaks hug ibi + getBreakDecls (readIModModBreaks hug) ibi brks -- | Update fixity environment in the current interactive context. updateFixityEnv :: GhcMonad m => FixityEnv -> m () @@ -232,10 +230,9 @@ updateFixityEnv fix_env status <- - withVirtualCWD $ - liftIO $ do - let eval_opts = initEvalOpts idflags' (isStep execSingleStep) - evalStmt interp eval_opts (execWrap hval) + liftIO $ do + let eval_opts = initEvalOpts idflags' (enableGhcStepMode execSingleStep) + evalStmt interp eval_opts (execWrap hval) let ic = hsc_IC hsc_env bindings = (ic_tythings ic, ic_gre_cache ic) @@ -282,38 +279,17 @@ See #11051 for more background and examples. -} -withVirtualCWD :: GhcMonad m => m a -> m a -withVirtualCWD m = do - hsc_env <- getSession - - -- a virtual CWD is only necessary when we're running interpreted code in - -- the same process as the compiler. - case interpInstance <$> hsc_interp hsc_env of - Just (ExternalInterp {}) -> m - _ -> do - let ic = hsc_IC hsc_env - let set_cwd = do - dir <- liftIO $ getCurrentDirectory - case ic_cwd ic of - Just dir -> liftIO $ setCurrentDirectory dir - Nothing -> return () - return dir - - reset_cwd orig_dir = do - virt_dir <- liftIO $ getCurrentDirectory - hsc_env <- getSession - let old_IC = hsc_IC hsc_env - setSession hsc_env{ hsc_IC = old_IC{ ic_cwd = Just virt_dir } } - liftIO $ setCurrentDirectory orig_dir - - MC.bracket set_cwd reset_cwd $ \_ -> m - parseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs) parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr emptyHistory :: Int -> BoundedList History emptyHistory size = nilBL size +-- | Turn an 'EvalStatus_' result from interpreting Haskell into a GHCi 'ExecResult'. +-- +-- This function is responsible for resuming execution at an intermediate +-- breakpoint if we don't care about that breakpoint (e.g. if using :steplocal +-- or :stepmodule, rather than :step, we only care about certain breakpoints). handleRunStatus :: GhcMonad m => SingleStep -> String -> ResumeBindings @@ -322,87 +298,115 @@ -> BoundedList History -> m ExecResult -handleRunStatus step expr bindings final_ids status history - | RunAndLogSteps <- step = tracing - | otherwise = not_tracing - where - tracing - | EvalBreak apStack_ref (Just eval_break) resume_ctxt _ccs <- status - = do - hsc_env <- getSession - let interp = hscInterp hsc_env - let dflags = hsc_dflags hsc_env - let ibi = evalBreakpointToId (hsc_HPT hsc_env) eval_break - let hmi = expectJust "handleRunStatus" $ lookupHpt (hsc_HPT hsc_env) (moduleName (ibi_tick_mod ibi)) - breaks = getModBreaks hmi +handleRunStatus step expr bindings final_ids status history0 = do + hsc_env <- getSession + let + interp = hscInterp hsc_env + dflags = hsc_dflags hsc_env + case status of - b <- liftIO $ - breakpointStatus interp (modBreaks_flags breaks) (ibi_tick_index ibi) - if b - then not_tracing - -- This breakpoint is explicitly enabled; we want to stop - -- instead of just logging it. - else do - apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref - let !history' = mkHistory hsc_env apStack_fhv ibi `consBL` history - -- history is strict, otherwise our BoundedList is pointless. - fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - let eval_opts = initEvalOpts dflags True - status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv - handleRunStatus RunAndLogSteps expr bindings final_ids - status history' - | otherwise - = not_tracing + -- Completed successfully + EvalComplete allocs (EvalSuccess hvals) -> do + let + final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids + final_names = map getName final_ids + liftIO $ Loader.extendLoadedEnv interp (zip final_names hvals) + hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic} + setSession hsc_env' + return (ExecComplete (Right final_names) allocs) - not_tracing - -- Hit a breakpoint - | EvalBreak apStack_ref maybe_break resume_ctxt ccs <- status - = do - hsc_env <- getSession - let interp = hscInterp hsc_env - resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref - let ibi = evalBreakpointToId (hsc_HPT hsc_env) <$> maybe_break - (hsc_env1, names, span, decl) <- liftIO $ - bindLocalsAtBreakpoint hsc_env apStack_fhv ibi - let - resume = Resume - { resumeStmt = expr - , resumeContext = resume_ctxt_fhv - , resumeBindings = bindings - , resumeFinalIds = final_ids - , resumeApStack = apStack_fhv - , resumeBreakpointId = ibi - , resumeSpan = span - , resumeHistory = toListBL history - , resumeDecl = decl - , resumeCCS = ccs - , resumeHistoryIx = 0 - } - hsc_env2 = pushResume hsc_env1 resume + -- Completed with an exception + EvalComplete alloc (EvalException e) -> + return (ExecComplete (Left (fromSerializableException e)) alloc) - setSession hsc_env2 - return (ExecBreak names ibi) + -- Nothing case: we stopped when an exception was raised, not at a breakpoint. + EvalBreak apStack_ref Nothing resume_ctxt ccs -> do + resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt + apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref + let span = mkGeneralSrcSpan (fsLit "") + (hsc_env1, names) <- liftIO $ + bindLocalsAtBreakpoint hsc_env apStack_fhv span Nothing + let + resume = Resume + { resumeStmt = expr + , resumeContext = resume_ctxt_fhv + , resumeBindings = bindings + , resumeFinalIds = final_ids + , resumeApStack = apStack_fhv + , resumeBreakpointId = Nothing + , resumeSpan = span + , resumeHistory = toListBL history0 + , resumeDecl = "" + , resumeCCS = ccs + , resumeHistoryIx = 0 + } + hsc_env2 = pushResume hsc_env1 resume - -- Completed successfully - | EvalComplete allocs (EvalSuccess hvals) <- status - = do hsc_env <- getSession - let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids - final_names = map getName final_ids - interp = hscInterp hsc_env - liftIO $ Loader.extendLoadedEnv interp (zip final_names hvals) - hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic} - setSession hsc_env' - return (ExecComplete (Right final_names) allocs) + setSession hsc_env2 + return (ExecBreak names Nothing) - -- Completed with an exception - | EvalComplete alloc (EvalException e) <- status - = return (ExecComplete (Left (fromSerializableException e)) alloc) + -- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint + -- + -- The interpreter yields on a breakpoint if: + -- - the breakpoint was explicitly enabled (in @BreakArray@) + -- - or one of the stepping options in @EvalOpts@ caused us to stop at one + EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do + let ibi = evalBreakpointToId eval_break + let hug = hsc_HUG hsc_env + info_brks <- liftIO $ readIModBreaks hug ibi + span <- liftIO $ getBreakLoc (readIModModBreaks hug) ibi info_brks + decl <- liftIO $ intercalate "." <$> getBreakDecls (readIModModBreaks hug) ibi info_brks + -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? + bactive <- liftIO $ do + breakArray <- getBreakArray interp ibi info_brks + breakpointStatus interp breakArray (ibi_info_index ibi) -resumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> Maybe Int + apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref + resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt + + -- This breakpoint is enabled or we mean to break here; + -- we want to stop instead of just logging it. + if breakHere bactive step span then do + -- This function only returns control to ghci with 'ExecBreak' when it is really meant to break. + -- Specifically, for :steplocal or :stepmodule, don't return control + -- and simply resume execution from here until we hit a breakpoint we do want to stop at. + (hsc_env1, names) <- liftIO $ + bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) + let + resume = Resume + { resumeStmt = expr + , resumeContext = resume_ctxt_fhv + , resumeBindings = bindings + , resumeFinalIds = final_ids + , resumeApStack = apStack_fhv + , resumeBreakpointId = Just ibi + , resumeSpan = span + , resumeHistory = toListBL history0 + , resumeDecl = decl + , resumeCCS = ccs + , resumeHistoryIx = 0 + } + hsc_env2 = pushResume hsc_env1 resume + setSession hsc_env2 + return (ExecBreak names (Just ibi)) + else do + -- resume with the same step type + let eval_opts = initEvalOpts dflags (enableGhcStepMode step) + status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv + history <- if not tracing then pure history0 else do + history1 <- liftIO $ mkHistory hug apStack_fhv ibi + let !history' = history1 `consBL` history0 + -- history is strict, otherwise our BoundedList is pointless. + return history' + handleRunStatus step expr bindings final_ids status history + where + tracing | RunAndLogSteps <- step = True + | otherwise = False + +resumeExec :: GhcMonad m => SingleStep -> Maybe Int -> m ExecResult -resumeExec canLogSpan step mbCnt +resumeExec step mbCnt = do hsc_env <- getSession let ic = hsc_IC hsc_env @@ -440,42 +444,61 @@ , resumeBreakpointId = mb_brkpt , resumeSpan = span , resumeHistory = hist } -> - withVirtualCWD $ do + do -- When the user specified a break ignore count, set it -- in the interpreter case (mb_brkpt, mbCnt) of - (Just brkpt, Just cnt) -> setupBreakpoint hsc_env (toBreakpointId brkpt) cnt + (Just brkpt, Just cnt) -> setupBreakpoint interp brkpt cnt _ -> return () - let eval_opts = initEvalOpts dflags (isStep step) + let eval_opts = initEvalOpts dflags (enableGhcStepMode step) status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv let prevHistoryLst = fromListBL 50 hist + hug = hsc_HUG hsc_env hist' = case mb_brkpt of - Nothing -> prevHistoryLst + Nothing -> pure prevHistoryLst Just bi - | not $ canLogSpan span -> prevHistoryLst - | otherwise -> mkHistory hsc_env apStack bi `consBL` - fromListBL 50 hist - handleRunStatus step expr bindings final_ids status hist' + | breakHere False step span -> do + hist1 <- liftIO (mkHistory hug apStack bi) + return $ hist1 `consBL` fromListBL 50 hist + | otherwise -> pure prevHistoryLst + handleRunStatus step expr bindings final_ids status =<< hist' -setupBreakpoint :: GhcMonad m => HscEnv -> BreakpointId -> Int -> m () -- #19157 -setupBreakpoint hsc_env bi cnt = do - let modl = bi_tick_mod bi - breaks hsc_env modl = getModBreaks $ expectJust "setupBreakpoint" $ - lookupHpt (hsc_HPT hsc_env) (moduleName modl) - modBreaks = breaks hsc_env modl - breakarray = modBreaks_flags modBreaks - interp = hscInterp hsc_env - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () +setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157 +setupBreakpoint interp ibi cnt = do + hug <- hsc_HUG <$> getSession + liftIO $ do + modBreaks <- readIModBreaks hug ibi + breakArray <- getBreakArray interp ibi modBreaks + GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt -back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String) +getBreakArray :: Interp -> InternalBreakpointId -> InternalModBreaks -> IO (ForeignRef BreakArray) +getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do + breaks0 <- linked_breaks . fromMaybe (panic "Loader not initialised") <$> getLoaderState interp + case lookupModuleEnv (breakarray_env breaks0) ibi_info_mod of + Just ba -> return ba + Nothing -> do + modifyLoaderState interp $ \ld_st -> do + let lb = linked_breaks ld_st + + -- Recall that BreakArrays are allocated only at BCO link time, so if we + -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here. + ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs] + + let ld_st' = ld_st { linked_breaks = lb{breakarray_env = ba_env} } + let ba = expectJust {- just computed -} $ lookupModuleEnv ba_env ibi_info_mod + + return + ( ld_st' + , ba + ) +back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) -forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String) +forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) forward n = moveHist (subtract n) -moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan, String) +moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan) moveHist fn = do hsc_env <- getSession case ic_resume (hsc_IC hsc_env) of @@ -493,15 +516,21 @@ let update_ic apStack mb_info = do - (hsc_env1, names, span, decl) <- - liftIO $ bindLocalsAtBreakpoint hsc_env apStack mb_info + span <- case mb_info of + Nothing -> return $ mkGeneralSrcSpan (fsLit "") + Just ibi -> liftIO $ do + let hug = hsc_HUG hsc_env + brks <- readIModBreaks hug ibi + getBreakLoc (readIModModBreaks hug) ibi brks + (hsc_env1, names) <- + liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info let ic = hsc_IC hsc_env1 r' = r { resumeHistoryIx = new_ix } ic' = ic { ic_resume = r':rs } setSession hsc_env1{ hsc_IC = ic' } - return (names, new_ix, span, decl) + return (names, new_ix, span) -- careful: we want apStack to be the AP_STACK itself, not a thunk -- around it, hence the cases are carefully constructed below to @@ -525,16 +554,16 @@ bindLocalsAtBreakpoint :: HscEnv -> ForeignHValue + -> SrcSpan -> Maybe InternalBreakpointId - -> IO (HscEnv, [Name], SrcSpan, String) + -> IO (HscEnv, [Name]) -- Nothing case: we stopped when an exception was raised, not at a -- breakpoint. We have no location information or local variables to -- bind, all we can do is bind a local variable to the exception -- value. -bindLocalsAtBreakpoint hsc_env apStack Nothing = do +bindLocalsAtBreakpoint hsc_env apStack span Nothing = do let exn_occ = mkVarOccFS (fsLit "_exception") - span = mkGeneralSrcSpan (fsLit "") exn_name <- newInteractiveBinder hsc_env exn_occ span let e_fs = fsLit "e" @@ -547,30 +576,21 @@ interp = hscInterp hsc_env -- Loader.extendLoadedEnv interp [(exn_name, apStack)] - return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, "") + return (hsc_env{ hsc_IC = ictxt1 }, [exn_name]) -- Just case: we stopped at a breakpoint, we have information about the location -- of the breakpoint and the free variables of the expression. -bindLocalsAtBreakpoint hsc_env apStack_fhv (Just ibi) = do - let - interp = hscInterp hsc_env - - info_mod = ibi_info_mod ibi - info_hmi = expectJust "bindLocalsAtBreakpoint" $ lookupHpt (hsc_HPT hsc_env) (moduleName info_mod) - info_brks = getModBreaks info_hmi - info = expectJust "bindLocalsAtBreakpoint2" $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks) - - tick_mod = ibi_tick_mod ibi - tick_hmi = expectJust "bindLocalsAtBreakpoint" $ lookupHpt (hsc_HPT hsc_env) (moduleName tick_mod) - tick_brks = getModBreaks tick_hmi - occs = modBreaks_vars tick_brks ! ibi_tick_index ibi - span = modBreaks_locs tick_brks ! ibi_tick_index ibi - decl = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi +bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do + let hug = hsc_HUG hsc_env + info_brks <- readIModBreaks hug ibi + let info = getInternalBreak ibi info_brks + interp = hscInterp hsc_env + occs <- getBreakVars (readIModModBreaks hug) ibi info_brks -- Rehydrate to understand the breakpoint info relative to the current environment. -- This design is critical to preventing leaks (#22530) (mbVars, result_ty) <- initIfaceLoad hsc_env - $ initIfaceLcl info_mod (text "debugger") NotBoot + $ initIfaceLcl (ibi_info_mod ibi) (text "debugger") NotBoot $ hydrateCgBreakInfo info let @@ -617,7 +637,7 @@ Loader.extendLoadedEnv interp (zip names fhvs) when result_ok $ Loader.extendLoadedEnv interp [(result_name, apStack_fhv)] hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 } - return (hsc_env1, if result_ok then result_name:names else names, span, decl) + return (hsc_env1, if result_ok then result_name:names else names) where -- We need a fresh Unique for each Id we bind, because the linker -- state is single-threaded and otherwise we'd spam old bindings @@ -654,7 +674,7 @@ syncOccs mbVs ocs = unzip3 $ catMaybes $ joinOccs mbVs ocs where joinOccs :: [Maybe (a,b)] -> [c] -> [Maybe (a,b,c)] - joinOccs = zipWithEqual "bindLocalsAtBreakpoint" joinOcc + joinOccs = zipWithEqual joinOcc joinOcc mbV oc = (\(a,b) c -> (a,b,c)) <$> mbV <*> pure oc rttiEnvironment :: HscEnv -> IO HscEnv @@ -669,7 +689,7 @@ noSkolems = noFreeVarsOfType . idType improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do let tmp_ids = [id | AnId id <- ic_tythings ic] - Just id = find (\i -> idName i == name) tmp_ids + id = expectJust $ find (\i -> idName i == name) tmp_ids if noSkolems id then return hsc_env else do @@ -815,7 +835,7 @@ text "to context:" <+> text err findGlobalRdrEnv :: HscEnv -> [InteractiveImport] - -> IO (Either (ModuleName, String) GlobalRdrEnv) + -> IO (Either (Module, String) GlobalRdrEnv) -- Compute the GlobalRdrEnv for the interactive context findGlobalRdrEnv hsc_env imports = do { idecls_env <- hscRnImportDecls hsc_env idecls @@ -828,38 +848,50 @@ idecls :: [LImportDecl GhcPs] idecls = [noLocA d | IIDecl d <- imports] - imods :: [ModuleName] + imods :: [Module] imods = [m | IIModule m <- imports] - mkEnv mod = mkTopLevEnv hsc_env mod >>= \case - Left err -> pure $ Left (mod, err) - Right env -> pure $ Right env + mkEnv mod = do + mkTopLevEnv hsc_env mod >>= \case + Left err -> pure $ Left (mod, err) + Right env -> pure $ Right env -mkTopLevEnv :: HscEnv -> ModuleName -> IO (Either String GlobalRdrEnv) +mkTopLevEnv :: HscEnv -> Module -> IO (Either String GlobalRdrEnv) mkTopLevEnv hsc_env modl - = case lookupHpt hpt modl of + = HUG.lookupHugByModule modl hug >>= \case Nothing -> pure $ Left "not a home module" Just details -> case mi_top_env (hm_iface details) of - Nothing -> pure $ Left "not interpreted" - Just (IfaceTopEnv exports imports) -> do - imports_env <- - runInteractiveHsc hsc_env - $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env - $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) - $ forM imports $ \iface_import -> do - let ImpUserSpec spec details = tcIfaceImport hsc_env iface_import - iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) - pure $ case details of - ImpUserAll -> importsFromIface hsc_env iface spec Nothing - ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) - ImpUserExplicit x -> x - let get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm - let exports_env = hydrateGlobalRdrEnv get_GRE_info exports + (IfaceTopEnv exports _imports) -> do + imports_env <- mkTopLevImportedEnv hsc_env details + let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing (getDetOrdAvails exports) pure $ Right $ plusGlobalRdrEnv imports_env exports_env where - hpt = hsc_HPT hsc_env + hug = hsc_HUG hsc_env +-- | Make the top-level environment with all bindings imported by this module. +-- Exported bindings from this module are not included in the result. +mkTopLevImportedEnv :: HscEnv -> HomeModInfo -> IO GlobalRdrEnv +mkTopLevImportedEnv hsc_env details = do + runInteractiveHsc hsc_env + $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env + $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv) + $ forM imports $ \iface_import -> do + let ImpUserSpec spec details = tcIfaceImport iface_import + iface <- loadInterfaceForModule (text "imported by GHCi") (is_mod spec) + pure $ case details of + ImpUserAll -> importsFromIface hsc_env iface spec Nothing + ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns) + ImpUserExplicit x _parents_of_implicits -> + -- TODO: Not quite right, is_explicit should refer to whether the user wrote A(..) or A(x,y). + -- It is only used for error messages. It seems dubious even to add an import context to these GREs as + -- they are not "imported" into the top-level scope of the REPL. I changed this for now so that + -- the test case produce the same output as before. + let spec' = ImpSpec { is_decl = spec, is_item = ImpSome { is_explicit = True, is_iloc = noSrcSpan } } + in mkGlobalRdrEnv $ gresFromAvails hsc_env (Just spec') x + where + IfaceTopEnv _ imports = mi_top_env (hm_iface details) + -- | Get the interactive evaluation context, consisting of a pair of the -- set of modules from which we take the full top-level scope, and the set -- of modules from which we take just the exports respectively. @@ -871,11 +903,9 @@ -- its full top-level scope available. moduleIsInterpreted :: GhcMonad m => Module -> m Bool moduleIsInterpreted modl = withSession $ \h -> - if notHomeModule (hsc_home_unit h) modl - then return False - else case lookupHpt (hsc_HPT h) (moduleName modl) of - Just details -> return (isJust (mi_top_env (hm_iface details))) - _not_a_home_module -> return False + liftIO (HUG.lookupHugByModule modl (hsc_HUG h)) >>= \case + Just hmi -> return (isJust $ homeModInfoByteCode hmi) + _not_a_home_module -> return False -- | Looks up an identifier in the current interactive context (for :info) -- Filter the instances by the ones whose tycons (or classes resp) @@ -1072,8 +1102,9 @@ (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do hsc_env <- getHscEnv ty <- hscParseType str - ioMsgMaybe $ hoistTcRnMessage $ tcRnType hsc_env SkolemiseFlexi True ty - + ioMsgMaybe $ hoistTcRnMessage $ + tcRnTypeSkolemising hsc_env ty + -- I'm not sure what to do about those zonked skolems return ty -- Get all the constraints required of a dictionary binding @@ -1083,7 +1114,7 @@ let dict_var = mkVanillaGlobal dictName theta loc <- getCtLocM (GivenOrigin (getSkolemInfo unkSkol)) Nothing - return CtWanted { + return $ CtWanted $ WantedCt { ctev_pred = varType dict_var, ctev_dest = EvVarDest dict_var, ctev_loc = loc, @@ -1240,7 +1271,7 @@ _ -> panic "compileParsedExprRemote" updateFixityEnv fix_env - let eval_opts = initEvalOpts dflags False + let eval_opts = initEvalOpts dflags EvalStepNone status <- liftIO $ evalStmt interp eval_opts (EvalThis hvals_io) case status of EvalComplete _ (EvalSuccess [hval]) -> return hval @@ -1260,29 +1291,30 @@ parsed_expr <- parseExpr expr -- > Data.Dynamic.toDyn expr let loc = getLoc parsed_expr - to_dyn_expr = mkHsApp (L loc . HsVar noExtField . L (l2l loc) $ getRdrName toDynName) + to_dyn_expr = mkHsApp (L loc . mkHsVar . L (l2l loc) $ getRdrName toDynName) parsed_expr hval <- compileParsedExpr to_dyn_expr return (unsafeCoerce hval :: Dynamic) ----------------------------------------------------------------------------- --- show a module and it's source/object filenames +-- show a module and its source/object filenames -showModule :: GhcMonad m => ModSummary -> m String -showModule mod_summary = +showModule :: GhcMonad m => ModuleNodeInfo -> m String +showModule mni = do + let mod = moduleNodeInfoModule mni withSession $ \hsc_env -> do let dflags = hsc_dflags hsc_env - let interpreted = - case lookupHug (hsc_HUG hsc_env) (ms_unitid mod_summary) (ms_mod_name mod_summary) of - Nothing -> panic "missing linkable" - Just mod_info -> isJust (homeModInfoByteCode mod_info) && isNothing (homeModInfoObject mod_info) - return (showSDoc dflags $ showModMsg dflags interpreted (ModuleNode [] mod_summary)) + interpreted <- liftIO $ + HUG.lookupHug (hsc_HUG hsc_env) (moduleUnitId mod) (moduleName mod) >>= pure . \case + Nothing -> panic "missing linkable" + Just mod_info -> isJust (homeModInfoByteCode mod_info) && isNothing (homeModInfoObject mod_info) + return (showSDoc dflags $ showModMsg dflags interpreted (ModuleNode [] mni)) -moduleIsBootOrNotObjectLinkable :: GhcMonad m => ModSummary -> m Bool -moduleIsBootOrNotObjectLinkable mod_summary = withSession $ \hsc_env -> - case lookupHug (hsc_HUG hsc_env) (ms_unitid mod_summary) (ms_mod_name mod_summary) of - Nothing -> panic "missing linkable" - Just mod_info -> return . isNothing $ homeModInfoByteCode mod_info +moduleIsBootOrNotObjectLinkable :: GhcMonad m => Module -> m Bool +moduleIsBootOrNotObjectLinkable mod = withSession $ \hsc_env -> liftIO $ + HUG.lookupHug (hsc_HUG hsc_env) (moduleUnitId mod) (moduleName mod) >>= pure . \case + Nothing -> panic "missing linkable" + Just mod_info -> isNothing $ homeModInfoByteCode mod_info ---------------------------------------------------------------------------- -- RTTI primitives diff --git a/GHC/Runtime/Eval/Types.hs b/GHC/Runtime/Eval/Types.hs --- a/GHC/Runtime/Eval/Types.hs +++ b/GHC/Runtime/Eval/Types.hs @@ -9,17 +9,19 @@ module GHC.Runtime.Eval.Types ( Resume(..), ResumeBindings, IcGlobalRdrEnv(..), History(..), ExecResult(..), - SingleStep(..), isStep, ExecOptions(..) + SingleStep(..), enableGhcStepMode, breakHere, + ExecOptions(..) ) where import GHC.Prelude import GHCi.RemoteTypes import GHCi.Message (EvalExpr, ResumeContext) +import GHC.ByteCode.Types (InternalBreakpointId(..)) +import GHC.Driver.Config (EvalStep(..)) import GHC.Types.Id import GHC.Types.Name import GHC.Types.TyThing -import GHC.Types.Breakpoint import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Utils.Exception @@ -35,21 +37,121 @@ , execWrap :: ForeignHValue -> EvalExpr ForeignHValue } +-- | What kind of stepping are we doing? data SingleStep = RunToCompletion - | SingleStep + + -- | :trace [expr] | RunAndLogSteps -isStep :: SingleStep -> Bool -isStep RunToCompletion = False -isStep _ = True + -- | :step [expr] + | SingleStep + -- | :stepout + | StepOut + { initiatedFrom :: Maybe SrcSpan + -- ^ Step-out locations are filtered to make sure we don't stop at a + -- continuation that is within the function from which step-out was + -- initiated. See Note [Debugger: Step-out] + } + + -- | :steplocal [expr] + | LocalStep + { breakAt :: SrcSpan } + + -- | :stepmodule [expr] + | ModuleStep + { breakAt :: SrcSpan } + +-- | Whether this 'SingleStep' mode requires instructing the interpreter to +-- step at every breakpoint or after every return (see @'EvalStep'@). +enableGhcStepMode :: SingleStep -> EvalStep +enableGhcStepMode RunToCompletion = EvalStepNone +enableGhcStepMode StepOut{} = EvalStepOut +-- for the remaining step modes we need to stop at every single breakpoint. +enableGhcStepMode _ = EvalStepSingle + +-- | Given a 'SingleStep' mode, whether the breakpoint was explicitly active, +-- and the SrcSpan of a breakpoint we hit, return @True@ if we should stop at +-- this breakpoint. +-- +-- In particular, this will always be @False@ for @'RunToCompletion'@ and +-- @'RunAndLogSteps'@. We'd need further information e.g. about the user +-- breakpoints to determine whether to break in those modes. +breakHere :: Bool -- ^ Was this breakpoint explicitly active (in the @BreakArray@s)? + -> SingleStep -- ^ What kind of stepping were we doing + -> SrcSpan -- ^ The span of the breakpoint we hit + -> Bool -- ^ Should we stop here then? +breakHere b RunToCompletion _ = b +breakHere b RunAndLogSteps _ = b +breakHere _ SingleStep _ = True +breakHere b step break_span = case step of + LocalStep start_span -> b || break_span `isSubspanOf` start_span + ModuleStep start_span -> b || srcSpanFileName_maybe start_span == srcSpanFileName_maybe break_span + StepOut Nothing -> True + StepOut (Just start) -> + -- See Note [Debugger: Filtering step-out stops] + not (break_span `isSubspanOf` start) + +{- +Note [Debugger: Filtering step-out stops] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Recall from Note [Debugger: Step-out] that the RTS explicitly enables the +breakpoint at the start of the first continuation frame on the stack, when +the step-out flag is set. + +Often, the continuation on top of the stack will be part of the same function +from which step-out was initiated. A trivial example is a case expression: + + f x = case g x of ... + +If we're stopped in , the continuation will be in the case alternatives rather +than in the function which called `f`. This is especially relevant for monadic +do-blocks which may end up being compiled to long chains of case expressions, +such as IO, and we don't want to stop at every line in the block while stepping out! + +To make sure we only stop at a continuation outside of the current function, we +compare the continuation breakpoint `SrcSpan` against the current one. If the +continuation breakpoint is within the current function, instead of stopping, we +re-trigger step-out and return to the RTS interpreter right away. + +This behaviour is very similar to `:steplocal`, which is implemented by +yielding from the RTS at every breakpoint (using `:step`) but only really +stopping when the breakpoint's `SrcSpan` is contained in the current function. + +The function which determines if we should stop at the current breakpoint is +`breakHere`. For `StepOut`, `breakHere` will only return `True` if the +breakpoint is not contained in the function from which step-out was initiated. + +Notably, this means we will ignore breakpoints enabled by the user if they are +contained in the function we are stepping out of. + +If we had a way to distinguish whether a breakpoint was explicitly enabled (in +`BreakArrays`) by the user vs by step-out we could additionally break on +user-enabled breakpoints; however, it's not straightforward to determine this +and arguably it may be uncommon for a user to use step-out to run until the +next breakpoint in the same function. Of course, if a breakpoint in any other +function is hit before returning to the continuation, we will still stop there +(`breakHere` will be `True` because the break point is not within the initiator +function). +-} + data ExecResult + + -- | Execution is complete with either an exception or the list of + -- user-visible names that were brought into scope. = ExecComplete { execResult :: Either SomeException [Name] , execAllocation :: Word64 } - | ExecBreak + + -- | Execution stopped at a breakpoint. + -- + -- Note: `ExecBreak` is only returned by `handleRunStatus` when GHCi should + -- definitely stop at this breakpoint. GHCi is /not/ responsible for + -- subsequently deciding whether to really stop here. + -- `ExecBreak` always means GHCi breaks. + | ExecBreak { breakNames :: [Name] , breakPointId :: Maybe InternalBreakpointId } @@ -74,7 +176,7 @@ , resumeApStack :: ForeignHValue -- The object from which we can get -- value of the free variables. , resumeBreakpointId :: Maybe InternalBreakpointId - -- ^ the breakpoint we stopped at + -- ^ the internal breakpoint we stopped at -- (Nothing <=> exception) , resumeSpan :: SrcSpan -- just a copy of the SrcSpan -- from the ModBreaks, diff --git a/GHC/Runtime/Eval/Utils.hs b/GHC/Runtime/Eval/Utils.hs new file mode 100644 --- /dev/null +++ b/GHC/Runtime/Eval/Utils.hs @@ -0,0 +1,48 @@ +module GHC.Runtime.Eval.Utils where + +import GHC.Prelude +import Data.Char +import Data.List (elemIndices) + +-- | Split up a string with an eventually qualified declaration name into 3 components +-- +-- 1. module name +-- 2. top-level decl +-- 3. full-name of the eventually nested decl, but without module qualification +-- +-- === __Example__ +-- +-- @ +-- "foo" = ("", "foo", "foo") +-- "A.B.C.foo" = ("A.B.C", "foo", "foo") +-- "M.N.foo.bar" = ("M.N", "foo", "foo.bar") +-- @ +splitIdent :: String -> (String, String, String) +splitIdent [] = ("", "", "") +splitIdent inp@(a : _) + | (isUpper a) = case fixs of + [] -> (inp, "", "") + (i1 : [] ) -> (upto i1, from i1, from i1) + (i1 : i2 : _) -> (upto i1, take (i2 - i1 - 1) (from i1), from i1) + | otherwise = case ixs of + [] -> ("", inp, inp) + (i1 : _) -> ("", upto i1, inp) + where + ixs = elemIndices '.' inp -- indices of '.' in whole input + fixs = dropWhile isNextUc ixs -- indices of '.' in function names -- + isNextUc ix = isUpper $ safeInp !! (ix+1) + safeInp = inp ++ " " + upto i = take i inp + from i = drop (i + 1) inp + +-- | Qualify an identifier name with a module name +-- +-- @ +-- combineModIdent "A" "foo" = "A.foo" +-- combineModIdent "" "foo" = "foo" +-- @ +combineModIdent :: String -> String -> String +combineModIdent mod ident + | null mod = ident + | null ident = mod + | otherwise = mod ++ "." ++ ident diff --git a/GHC/Runtime/Heap/Inspect.hs b/GHC/Runtime/Heap/Inspect.hs --- a/GHC/Runtime/Heap/Inspect.hs +++ b/GHC/Runtime/Heap/Inspect.hs @@ -1,5 +1,16 @@ {-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ > 912 +{-# OPTIONS_GHC -Wwarn=incomplete-record-selectors #-} +-- This module has a bunch of uses of incomplete record selectors +-- and it is FAR from obvious that they won't cause crashes. +-- But I don't want them to kill CI, so the above flag turns +-- them into warnings +#endif + + ----------------------------------------------------------------------------- -- -- GHC Interactive support for inspecting arbitrary closures at runtime @@ -33,6 +44,7 @@ import GHC.Core.DataCon import GHC.Core.Type +import GHC.Core.Predicate( tyCoVarsOfTypeWellScoped ) import GHC.Types.RepType import GHC.Core.Multiplicity import qualified GHC.Core.Unify as U @@ -75,6 +87,7 @@ import Data.Sequence (viewl, ViewL(..)) import Foreign hiding (shiftL, shiftR) import System.IO.Unsafe +import GHC.InfoProv --------------------------------------------- -- * A representation of semi evaluated Terms @@ -95,6 +108,7 @@ , ty :: RttiType , val :: ForeignHValue , bound_to :: Maybe Name -- Useful for printing + , infoprov :: Maybe InfoProv -- Provenance is printed when available } | NewtypeWrap{ -- At runtime there are no newtypes, and hence no -- newtype constructors. A NewtypeWrap is just a @@ -117,6 +131,11 @@ isFullyEvaluatedTerm RefWrap{wrapped_term=t} = isFullyEvaluatedTerm t isFullyEvaluatedTerm _ = False +-- | Gives an error if the term doesn't have subterms +expectSubTerms :: Term -> [Term] +expectSubTerms (Term { subTerms = subTerms} ) = subTerms +expectSubTerms _ = panic "expectSubTerms" + instance Outputable (Term) where ppr t | Just doc <- cPprTerm cPprTermBase t = doc | otherwise = panic "Outputable Term instance" @@ -148,7 +167,7 @@ data TermFold a = TermFold { fTerm :: TermProcessor a a , fPrim :: RttiType -> [Word] -> a , fSuspension :: ClosureType -> RttiType -> ForeignHValue - -> Maybe Name -> a + -> Maybe Name -> Maybe InfoProv -> a , fNewtypeWrap :: RttiType -> Either String DataCon -> a -> a , fRefWrap :: RttiType -> a -> a @@ -159,7 +178,7 @@ TermFoldM {fTermM :: TermProcessor a (m a) , fPrimM :: RttiType -> [Word] -> m a , fSuspensionM :: ClosureType -> RttiType -> ForeignHValue - -> Maybe Name -> m a + -> Maybe Name -> Maybe InfoProv -> m a , fNewtypeWrapM :: RttiType -> Either String DataCon -> a -> m a , fRefWrapM :: RttiType -> a -> m a @@ -168,7 +187,7 @@ foldTerm :: TermFold a -> Term -> a foldTerm tf (Term ty dc v tt) = fTerm tf ty dc v (map (foldTerm tf) tt) foldTerm tf (Prim ty v ) = fPrim tf ty v -foldTerm tf (Suspension ct ty v b) = fSuspension tf ct ty v b +foldTerm tf (Suspension ct ty v b i) = fSuspension tf ct ty v b i foldTerm tf (NewtypeWrap ty dc t) = fNewtypeWrap tf ty dc (foldTerm tf t) foldTerm tf (RefWrap ty t) = fRefWrap tf ty (foldTerm tf t) @@ -176,7 +195,7 @@ foldTermM :: Monad m => TermFoldM m a -> Term -> m a foldTermM tf (Term ty dc v tt) = mapM (foldTermM tf) tt >>= fTermM tf ty dc v foldTermM tf (Prim ty v ) = fPrimM tf ty v -foldTermM tf (Suspension ct ty v b) = fSuspensionM tf ct ty v b +foldTermM tf (Suspension ct ty v b i) = fSuspensionM tf ct ty v b i foldTermM tf (NewtypeWrap ty dc t) = foldTermM tf t >>= fNewtypeWrapM tf ty dc foldTermM tf (RefWrap ty t) = foldTermM tf t >>= fRefWrapM tf ty @@ -192,8 +211,8 @@ mapTermType :: (RttiType -> Type) -> Term -> Term mapTermType f = foldTerm idTermFold { fTerm = \ty dc hval tt -> Term (f ty) dc hval tt, - fSuspension = \ct ty hval n -> - Suspension ct (f ty) hval n, + fSuspension = \ct ty hval n i -> + Suspension ct (f ty) hval n i, fNewtypeWrap= \ty dc t -> NewtypeWrap (f ty) dc t, fRefWrap = \ty t -> RefWrap (f ty) t} @@ -201,8 +220,8 @@ mapTermTypeM f = foldTermM TermFoldM { fTermM = \ty dc hval tt -> f ty >>= \ty' -> return $ Term ty' dc hval tt, fPrimM = (return.) . Prim, - fSuspensionM = \ct ty hval n -> - f ty >>= \ty' -> return $ Suspension ct ty' hval n, + fSuspensionM = \ct ty hval n i -> + f ty >>= \ty' -> return $ Suspension ct ty' hval n i, fNewtypeWrapM= \ty dc t -> f ty >>= \ty' -> return $ NewtypeWrap ty' dc t, fRefWrapM = \ty t -> f ty >>= \ty' -> return $ RefWrap ty' t} @@ -210,7 +229,7 @@ termTyCoVars = foldTerm TermFold { fTerm = \ty _ _ tt -> tyCoVarsOfType ty `unionVarSet` concatVarEnv tt, - fSuspension = \_ ty _ _ -> tyCoVarsOfType ty, + fSuspension = \_ ty _ _ _ -> tyCoVarsOfType ty, fPrim = \ _ _ -> emptyVarSet, fNewtypeWrap= \ty _ t -> tyCoVarsOfType ty `unionVarSet` t, fRefWrap = \ty t -> tyCoVarsOfType ty `unionVarSet` t} @@ -268,8 +287,24 @@ ppr_termM1 :: Monad m => Term -> m SDoc ppr_termM1 Prim{valRaw=words, ty=ty} = return $ repPrim (tyConAppTyCon ty) words -ppr_termM1 Suspension{ty=ty, bound_to=Nothing} = - return (char '_' <+> whenPprDebug (dcolon <> pprSigmaType ty)) +ppr_termM1 Suspension{ty=ty, bound_to=Nothing, infoprov=mipe} = + return $ hcat $ +    [ char '_' +    , whenPprDebug $ + space <> + dcolon <> + pprSigmaType ty +    ] ++ +    [ whenPprDebug $ + space <> + char '<' <> + text (ipSrcFile ipe) <> + char ':' <> + text (ipSrcSpan ipe) <> + char '>' +    | Just ipe <- [mipe] + , not $ null $ ipSrcFile ipe +    ] ppr_termM1 Suspension{ty=ty, bound_to=Just n} | otherwise = return$ parens$ ppr n <> dcolon <> pprSigmaType ty ppr_termM1 Term{} = panic "ppr_termM1 - Term" @@ -321,8 +356,8 @@ cPprTermBase y = [ ifTerm (isTupleTy.ty) (\_p -> liftM (parens . hcat . punctuate comma) . mapM (y (-1)) - . subTerms) - , ifTerm (\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2) + . expectSubTerms) + , ifTerm (\t -> isTyCon listTyCon (ty t) && expectSubTerms t `lengthIs` 2) ppr_list , ifTerm' (isTyCon intTyCon . ty) ppr_int , ifTerm' (isTyCon charTyCon . ty) ppr_char @@ -757,12 +792,18 @@ traceTR (text "Gave up reconstructing a term after" <> int max_depth <> text " steps") clos <- trIO $ GHCi.getClosure interp a - return (Suspension (tipe (info clos)) my_ty a Nothing) + ipe <- trIO $ GHCi.whereFrom interp a +#if MIN_VERSION_ghc_heap(9,15,0) + return (Suspension (tipe (getClosureInfoTbl clos)) my_ty a Nothing ipe) +#else + return (Suspension (tipe (info clos)) my_ty a Nothing ipe) +#endif go !max_depth my_ty old_ty a = do let monomorphic = not(isTyVarTy my_ty) -- This ^^^ is a convention. The ancestor tests for -- monomorphism and passes a type instead of a tv clos <- trIO $ GHCi.getClosure interp a + ipe <- trIO $ GHCi.whereFrom interp a case clos of -- Thunks we may want to force t | isThunk t && force -> do @@ -781,7 +822,8 @@ BlackholeClosure{indirectee=ind} -> do traceTR (text "Following a BLACKHOLE") ind_clos <- trIO (GHCi.getClosure interp ind) - let return_bh_value = return (Suspension BLACKHOLE my_ty a Nothing) + ind_ipe <- trIO (GHCi.whereFrom interp ind) + let return_bh_value = return (Suspension BLACKHOLE my_ty a Nothing ind_ipe) case ind_clos of -- TSO and BLOCKING_QUEUE cases BlockingQueueClosure{} -> return_bh_value @@ -839,7 +881,7 @@ Just dc -> do traceTR (text "Is constructor" <+> (ppr dc $$ ppr my_ty)) subTtypes <- getDataConArgTys dc my_ty - subTerms <- extractSubTerms (\ty -> go (pred max_depth) ty ty) clos subTtypes + subTerms <- extractSubTerms (\ty -> go (pred max_depth) ty ty) pArgs dArgs subTtypes return (Term my_ty (Right dc) a subTerms) -- This is to support printing of Integers. It's not a general @@ -853,8 +895,11 @@ _ -> do traceTR (text "Unknown closure:" <+> text (show (fmap (const ()) clos))) - return (Suspension (tipe (info clos)) my_ty a Nothing) - +#if MIN_VERSION_ghc_heap(9,15,0) + return (Suspension (tipe (getClosureInfoTbl clos)) my_ty a Nothing ipe) +#else + return (Suspension (tipe (info clos)) my_ty a Nothing ipe) +#endif -- insert NewtypeWraps around newtypes expandNewtypes = foldTerm idTermFold { fTerm = worker } where worker ty dc hval tt @@ -869,15 +914,16 @@ -- Avoid returning types where predicates have been expanded to dictionaries. fixFunDictionaries = foldTerm idTermFold {fSuspension = worker} where - worker ct ty hval n | isFunTy ty = Suspension ct (dictsView ty) hval n - | otherwise = Suspension ct ty hval n + worker ct ty hval n i | isFunTy ty = Suspension ct (dictsView ty) hval n i + | otherwise = Suspension ct ty hval n i extractSubTerms :: (Type -> ForeignHValue -> TcM Term) - -> GenClosure ForeignHValue -> [Type] -> TcM [Term] -extractSubTerms recurse clos = liftM thdOf3 . go 0 0 + -> [ForeignHValue] -- ^ pointer arguments + -> [Word] -- ^ data arguments + -> [Type] + -> TcM [Term] +extractSubTerms recurse ptr_args data_args = liftM thdOf3 . go 0 0 where - array = dataArgs clos - go ptr_i arr_i [] = return (ptr_i, arr_i, []) go ptr_i arr_i (ty:tys) | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty @@ -907,7 +953,7 @@ go_rep ptr_i arr_i ty rep | isGcPtrRep rep = do - t <- recurse ty $ (ptrArgs clos)!!ptr_i + t <- recurse ty $ ptr_args !! ptr_i return (ptr_i + 1, arr_i, t) | otherwise = do -- This is a bit involved since we allow packing multiple fields @@ -928,7 +974,7 @@ | otherwise = let (q, r) = size_b `quotRem` word_size in assert (r == 0 ) - [ array!!i + [ data_args !! i | o <- [0.. q - 1] , let i = (aligned_idx `quot` word_size) + o ] @@ -951,7 +997,7 @@ LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits where (q, r) = aligned_idx `quotRem` word_size - word = array!!q + word = data_args !! q moveBits = r * 8 zeroOutBits = (word_size - size_b) * 8 @@ -1093,7 +1139,7 @@ -- The types can contain skolem type variables, which need to be treated as normal vars. -- In particular, we want them to unify with things. improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe Subst -improveRTTIType _ base_ty new_ty = U.tcUnifyTyKi base_ty new_ty +improveRTTIType _ base_ty new_ty = U.tcUnifyDebugger base_ty new_ty getDataConArgTys :: DataCon -> Type -> TR [Type] -- Given the result type ty of a constructor application (D a b c :: ty) @@ -1370,8 +1416,8 @@ zonkTerm = foldTermM (TermFoldM { fTermM = \ty dc v tt -> zonkRttiType ty >>= \ty' -> return (Term ty' dc v tt) - , fSuspensionM = \ct ty v b -> zonkRttiType ty >>= \ty -> - return (Suspension ct ty v b) + , fSuspensionM = \ct ty v b i -> zonkRttiType ty >>= \ty -> + return (Suspension ct ty v b i) , fNewtypeWrapM = \ty dc t -> zonkRttiType ty >>= \ty' -> return$ NewtypeWrap ty' dc t , fRefWrapM = \ty t -> return RefWrap `ap` diff --git a/GHC/Runtime/Interpreter.hs b/GHC/Runtime/Interpreter.hs --- a/GHC/Runtime/Interpreter.hs +++ b/GHC/Runtime/Interpreter.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} -- | Interacting with the iserv interpreter, whether it is running on an -- external process or in the current process. @@ -20,16 +21,17 @@ , mkCostCentres , costCentreStackInfo , newBreakArray - , newModuleName , storeBreakpoint , breakpointStatus , getBreakpointVar , getClosure + , whereFrom , getModBreaks + , readIModBreaks + , readIModBreaksMaybe + , readIModModBreaks , seqHValue , evalBreakpointToId - , interpreterDynamic - , interpreterProfiled -- * The object-code linker , initObjLinker @@ -74,16 +76,15 @@ import GHCi.RemoteTypes import GHCi.ResolvedBCO import GHCi.BreakArray (BreakArray) -import GHC.Types.Breakpoint -import GHC.ByteCode.Types +import GHC.ByteCode.Breakpoints +import GHC.ByteCode.Types import GHC.Linker.Types import GHC.Data.Maybe import GHC.Data.FastString import GHC.Types.SrcLoc -import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Utils.Panic @@ -92,13 +93,11 @@ import GHC.Utils.Fingerprint import GHC.Unit.Module -import GHC.Unit.Module.ModIface import GHC.Unit.Home.ModInfo import GHC.Unit.Env #if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.Run -import GHC.Platform.Ways #endif import Control.Concurrent @@ -107,14 +106,20 @@ import Control.Monad.Catch as MC (mask) import Data.Binary import Data.ByteString (ByteString) -import Data.Array ((!)) -import Data.IORef import Foreign hiding (void) import qualified GHC.Exts.Heap as Heap import GHC.Stack.CCS (CostCentre,CostCentreStack) import System.Directory import System.Process +import qualified GHC.InfoProv as InfoProv +import GHC.Builtin.Names +import GHC.Types.Name +import qualified GHC.Unit.Home.Graph as HUG + +-- Standard libraries +import GHC.Exts + {- Note [Remote GHCi] ~~~~~~~~~~~~~~~~~~ When the flag -fexternal-interpreter is given to GHC, interpreted code @@ -369,10 +374,6 @@ breakArray <- interpCmd interp (NewBreakArray size) mkFinalizedHValue interp breakArray -newModuleName :: Interp -> ModuleName -> IO (RemotePtr ModuleName) -newModuleName interp mod_name = - castRemotePtr <$> interpCmd interp (NewBreakModule (moduleNameString mod_name)) - storeBreakpoint :: Interp -> ForeignRef BreakArray -> Int -> Int -> IO () storeBreakpoint interp ref ix cnt = do -- #19157 withForeignRef ref $ \breakarray -> @@ -395,6 +396,11 @@ mb <- interpCmd interp (GetClosure hval) mapM (mkFinalizedHValue interp) mb +whereFrom :: Interp -> ForeignHValue -> IO (Maybe InfoProv.InfoProv) +whereFrom interp ref = + withForeignRef ref $ \hval -> do + interpCmd interp (WhereFrom hval) + -- | Send a Seq message to the iserv process to force a value #2950 seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ()) seqHValue interp unit_env ref = @@ -402,15 +408,16 @@ status <- interpCmd interp (Seq hval) handleSeqHValueStatus interp unit_env status -evalBreakpointToId :: HomePackageTable -> EvalBreakpoint -> InternalBreakpointId -evalBreakpointToId hpt eval_break = - let load_mod x = mi_module $ hm_iface $ expectJust "evalBreakpointToId" $ lookupHpt hpt (mkModuleName x) - in InternalBreakpointId - { ibi_tick_mod = load_mod (eb_tick_mod eval_break) - , ibi_tick_index = eb_tick_index eval_break - , ibi_info_mod = load_mod (eb_info_mod eval_break) - , ibi_info_index = eb_info_index eval_break - } +evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId +evalBreakpointToId eval_break = + let + mkUnitId u = fsToUnit $ mkFastStringShortByteString u + toModule u n = mkModule (mkUnitId u) (mkModuleName n) + in + InternalBreakpointId + { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break) + , ibi_info_index = eb_info_index eval_break + } -- | Process the result of a Seq or ResumeSeq message. #2950 handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ()) @@ -420,27 +427,33 @@ -- A breakpoint was hit; inform the user and tell them -- which breakpoint was hit. resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt - let bp = evalBreakpointToId (ue_hpt unit_env) <$> maybe_break - sdocBpLoc = brackets . ppr . getSeqBpSpan - putStrLn ("*** Ignoring breakpoint " ++ - (showSDocUnsafe $ sdocBpLoc bp)) + + let put x = putStrLn ("*** Ignoring breakpoint " ++ (showSDocUnsafe x)) + let nothing_case = put $ brackets . ppr $ mkGeneralSrcSpan (fsLit "") + case maybe_break of + Nothing -> nothing_case + -- Nothing case - should not occur! + -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq + + Just break -> do + let ibi = evalBreakpointToId break + hug = ue_home_unit_graph unit_env + + -- Just case: Stopped at a breakpoint, extract SrcSpan information + -- from the breakpoint. + mb_modbreaks <- readIModBreaksMaybe hug (ibi_info_mod ibi) + case mb_modbreaks of + -- Nothing case - should not occur! We should have the appropriate + -- breakpoint information + Nothing -> nothing_case + Just modbreaks -> put . brackets . ppr =<< + getBreakLoc (readIModModBreaks hug) ibi modbreaks + -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do status <- interpCmd interp (ResumeSeq hval) handleSeqHValueStatus interp unit_env status (EvalComplete _ r) -> return r - where - getSeqBpSpan :: Maybe InternalBreakpointId -> SrcSpan - getSeqBpSpan = \case - Just bi -> (modBreaks_locs (breaks (ibi_tick_mod bi))) ! ibi_tick_index bi - -- Just case: Stopped at a breakpoint, extract SrcSpan information - -- from the breakpoint. - Nothing -> mkGeneralSrcSpan (fsLit "") - -- Nothing case - should not occur! - -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq - -- - breaks mod = getModBreaks $ expectJust "getSeqBpSpan" $ - lookupHpt (ue_hpt unit_env) (moduleName mod) -- ----------------------------------------------------------------------------- @@ -449,38 +462,65 @@ initObjLinker :: Interp -> IO () initObjLinker interp = interpCmd interp InitLinker -lookupSymbol :: Interp -> FastString -> IO (Maybe (Ptr ())) +lookupSymbol :: Interp -> InterpSymbol s -> IO (Maybe (Ptr ())) lookupSymbol interp str = withSymbolCache interp str $ case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbol (unpackFS (interpSymbolToCLabel str))) #endif ExternalInterp ext -> case ext of ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) + sendMessage inst (LookupSymbol (unpackFS (interpSymbolToCLabel str))) ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) ExtWasm i -> withWasmInterp i $ \inst -> fmap fromRemotePtr <$> do uninterruptibleMask_ $ - sendMessage inst (LookupSymbol (unpackFS str)) + sendMessage inst (LookupSymbol (unpackFS (interpSymbolToCLabel str))) -lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> FastString -> IO (Maybe (Ptr ())) +lookupSymbolInDLL :: Interp -> RemotePtr LoadedDLL -> InterpSymbol s -> IO (Maybe (Ptr ())) lookupSymbolInDLL interp dll str = withSymbolCache interp str $ case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS str)) + InternalInterp -> fmap fromRemotePtr <$> run (LookupSymbolInDLL dll (unpackFS (interpSymbolToCLabel str))) #endif ExternalInterp ext -> case ext of ExtIServ i -> withIServ i $ \inst -> fmap fromRemotePtr <$> do uninterruptibleMask_ $ - sendMessage inst (LookupSymbolInDLL dll (unpackFS str)) + sendMessage inst (LookupSymbolInDLL dll (unpackFS (interpSymbolToCLabel str))) ExtJS {} -> pprPanic "lookupSymbol not supported by the JS interpreter" (ppr str) -- wasm dyld doesn't track which symbol comes from which .so ExtWasm {} -> lookupSymbol interp str -lookupClosure :: Interp -> String -> IO (Maybe HValueRef) +interpSymbolToCLabel :: forall s . InterpSymbol s -> FastString +interpSymbolToCLabel s = eliminateInterpSymbol s interpretedInterpSymbol $ \is -> + let + n = interpSymbolName is + suffix = interpSymbolSuffix is + + encodeZ = fastZStringToByteString . zEncodeFS + (Module pkgKey modName) = assert (isExternalName n) $ case nameModule n of + -- Primops are exported from GHC.Prim, their HValues live in GHC.PrimopWrappers + -- See Note [Primop wrappers] in GHC.Builtin.PrimOps. + mod | mod == gHC_PRIM -> gHC_PRIMOPWRAPPERS + mod -> mod + packagePart = encodeZ (unitFS pkgKey) + modulePart = encodeZ (moduleNameFS modName) + occPart = encodeZ $ occNameMangledFS (nameOccName n) + + label = mconcat $ + [ packagePart `mappend` "_" | pkgKey /= mainUnit ] + ++ + [modulePart + , "_" + , occPart + , "_" + , fromString suffix + ] + in mkFastStringByteString label + +lookupClosure :: Interp -> InterpSymbol s -> IO (Maybe HValueRef) lookupClosure interp str = - interpCmd interp (LookupClosure str) + interpCmd interp (LookupClosure (unpackFS (interpSymbolToCLabel str))) -- | 'withSymbolCache' tries to find a symbol in the 'interpLookupSymbolCache' -- which maps symbols to the address where they are loaded. @@ -488,7 +528,7 @@ -- a miss we run the action which determines the symbol's address and populate -- the cache with the answer. withSymbolCache :: Interp - -> FastString + -> InterpSymbol s -- ^ The symbol we are looking up in the cache -> IO (Maybe (Ptr ())) -- ^ An action which determines the address of the symbol we @@ -505,21 +545,19 @@ -- The analysis in #23415 further showed this cache should also benefit the -- internal interpreter's loading times, and needn't be used by the external -- interpreter only. - cache <- readMVar (interpLookupSymbolCache interp) - case lookupUFM cache str of - Just p -> return (Just p) + cached_val <- lookupInterpSymbolCache str (interpSymbolCache interp) + case cached_val of + Just {} -> return cached_val Nothing -> do - maddr <- determine_addr case maddr of Nothing -> return Nothing Just p -> do - let upd_cache cache' = addToUFM cache' str p - modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache) - return (Just p) + updateInterpSymbolCache str (interpSymbolCache interp) p + return maddr purgeLookupSymbolCache :: Interp -> IO () -purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM)) +purgeLookupSymbolCache interp = purgeInterpSymbolCache (interpSymbolCache interp) -- | loadDLL loads a dynamic library using the OS's native linker -- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either @@ -577,12 +615,11 @@ (ph, rh, wh) <- runWithPipes createProc (iservConfProgram conf) [] (iservConfOpts conf) - lo_ref <- newIORef Nothing + interpPipe <- mkPipeFromHandles rh wh lock <- newMVar () - let pipe = Pipe { pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref } let process = InterpProcess { interpHandle = ph - , interpPipe = pipe + , interpPipe , interpLock = lock } @@ -690,40 +727,38 @@ ExternalInterp {} -> throwIO (InstallationError "this operation requires -fno-external-interpreter") --- ----------------------------------------------------------------------------- --- Misc utils - -fromEvalResult :: EvalResult a -> IO a -fromEvalResult (EvalException e) = throwIO (fromSerializableException e) -fromEvalResult (EvalSuccess a) = return a +-------------------------------------------------------------------------------- +-- * Finding breakpoint information +-------------------------------------------------------------------------------- -getModBreaks :: HomeModInfo -> ModBreaks +-- | Get the breakpoint information from the ByteCode object associated to this +-- 'HomeModInfo'. +getModBreaks :: HomeModInfo -> Maybe InternalModBreaks getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. [cbc] <- linkableBCOs linkable - = fromMaybe emptyModBreaks (bc_breaks cbc) + = bc_breaks cbc | otherwise - = emptyModBreaks -- probably object code + = Nothing -- probably object code --- | Interpreter uses Profiling way -interpreterProfiled :: Interp -> Bool -interpreterProfiled interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> hostIsProfiled -#endif - ExternalInterp ext -> case ext of - ExtIServ i -> iservConfProfiled (interpConfig i) - ExtJS {} -> False -- we don't support profiling yet in the JS backend - ExtWasm i -> wasmInterpProfiled $ interpConfig i +-- | Read the 'InternalModBreaks' of the given home 'Module' (via +-- 'InternalBreakpointId') from the 'HomeUnitGraph'. +readIModBreaks :: HomeUnitGraph -> InternalBreakpointId -> IO InternalModBreaks +readIModBreaks hug ibi = expectJust <$> readIModBreaksMaybe hug (ibi_info_mod ibi) --- | Interpreter uses Dynamic way -interpreterDynamic :: Interp -> Bool -interpreterDynamic interp = case interpInstance interp of -#if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> hostIsDynamic -#endif - ExternalInterp ext -> case ext of - ExtIServ i -> iservConfDynamic (interpConfig i) - ExtJS {} -> False -- dynamic doesn't make sense for JS - ExtWasm {} -> True -- wasm dyld can only load dynamic code +-- | Read the 'InternalModBreaks' of the given home 'Module' from the 'HomeUnitGraph'. +readIModBreaksMaybe :: HomeUnitGraph -> Module -> IO (Maybe InternalModBreaks) +readIModBreaksMaybe hug mod = getModBreaks . expectJust <$> HUG.lookupHugByModule mod hug + +-- | Read the 'ModBreaks' from the given module's 'InternalModBreaks' +readIModModBreaks :: HUG.HomeUnitGraph -> Module -> IO ModBreaks +readIModModBreaks hug mod = imodBreaks_modBreaks . expectJust <$> readIModBreaksMaybe hug mod + +-- ----------------------------------------------------------------------------- +-- Misc utils + +fromEvalResult :: EvalResult a -> IO a +fromEvalResult (EvalException e) = throwIO (fromSerializableException e) +fromEvalResult (EvalSuccess a) = return a + diff --git a/GHC/Runtime/Interpreter/JS.hs b/GHC/Runtime/Interpreter/JS.hs --- a/GHC/Runtime/Interpreter/JS.hs +++ b/GHC/Runtime/Interpreter/JS.hs @@ -129,12 +129,11 @@ (nodeExtraArgs settings) std_in <- readIORef interp_in - lo_ref <- newIORef Nothing + interpPipe <- mkPipeFromHandles rh wh lock <- newMVar () - let pipe = Pipe { pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref } let proc = InterpProcess { interpHandle = hdl - , interpPipe = pipe + , interpPipe , interpLock = lock } pure (std_in, proc) @@ -166,7 +165,7 @@ -- get the unit-id of the ghci package. We need this to load the -- interpreter code. - ghci_unit_id <- case lookupPackageName (ue_units unit_env) (PackageName (fsLit "ghci")) of + ghci_unit_id <- case lookupPackageName (ue_homeUnitState unit_env) (PackageName (fsLit "ghci")) of Nothing -> cmdLineErrorIO "JS interpreter: couldn't find \"ghci\" package" Just i -> pure i @@ -228,9 +227,9 @@ , lcLinkCsources = False -- we know that there are no C sources to load for the RTS } - -- link the RTS and its dependencies (things it uses from `base`, etc.) + -- link the RTS and its dependencies (things it uses from `ghc-internal`, etc.) let link_spec = LinkSpec - { lks_unit_ids = [rtsUnitId, ghcInternalUnitId, primUnitId] + { lks_unit_ids = [rtsUnitId, ghcInternalUnitId] , lks_obj_root_filter = const False , lks_extra_roots = mempty , lks_objs_hs = mempty @@ -265,7 +264,7 @@ let ghci_unit_id = instGhciUnitId (instExtra inst) -- compute unit dependencies of ghc_unit_id - let unit_map = unitInfoMap (ue_units unit_env) + let unit_map = unitInfoMap (ue_homeUnitState unit_env) dep_units <- mayThrowUnitErr $ closeUnitDeps unit_map [(ghci_unit_id,Nothing)] let units = dep_units ++ [ghci_unit_id] @@ -304,7 +303,7 @@ , lcLinkCsources = True -- enable C sources, if any } - let units = preloadUnits (ue_units unit_env) + let units = preloadUnits (ue_homeUnitState unit_env) -- compute dependencies let link_spec = LinkSpec diff --git a/GHC/Runtime/Interpreter/Types.hs b/GHC/Runtime/Interpreter/Types.hs --- a/GHC/Runtime/Interpreter/Types.hs +++ b/GHC/Runtime/Interpreter/Types.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} -- | Types used by the runtime interpreter module GHC.Runtime.Interpreter.Types @@ -10,6 +12,21 @@ , ExtInterpInstance (..) , ExtInterpState (..) , InterpStatus(..) + -- * InterpSymbolCache + , InterpSymbolCache(..) + , mkInterpSymbolCache + , lookupInterpSymbolCache + , updateInterpSymbolCache + , purgeInterpSymbolCache + , InterpSymbol(..) + , SuffixOrInterpreted(..) + , interpSymbolName + , interpSymbolSuffix + , eliminateInterpSymbol + , interpretedInterpSymbol + , interpreterProfiled + , interpreterDynamic + -- * IServ , IServ , IServConfig(..) @@ -30,11 +47,11 @@ import GHCi.RemoteTypes import GHCi.Message ( Pipe ) -import GHC.Types.Unique.FM -import GHC.Data.FastString ( FastString ) -import Foreign import GHC.Platform +#if defined(HAVE_INTERNAL_INTERPRETER) +import GHC.Platform.Ways +#endif import GHC.Utils.TmpFs import GHC.Utils.Logger import GHC.Unit.Env @@ -42,6 +59,7 @@ import GHC.Unit.Types import GHC.StgToJS.Types import GHC.StgToJS.Linker.Types +import GHC.Runtime.Interpreter.Types.SymbolCache import Control.Concurrent import System.Process ( ProcessHandle, CreateProcess ) @@ -56,7 +74,7 @@ , interpLoader :: !Loader -- ^ Interpreter loader - , interpLookupSymbolCache :: !(MVar (UniqFM FastString (Ptr ()))) + , interpSymbolCache :: !InterpSymbolCache -- ^ LookupSymbol cache } @@ -122,6 +140,28 @@ -- ^ Instance specific extra fields } +-- | Interpreter uses Profiling way +interpreterProfiled :: Interp -> Bool +interpreterProfiled interp = case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> hostIsProfiled +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> iservConfProfiled (interpConfig i) + ExtJS {} -> False -- we don't support profiling yet in the JS backend + ExtWasm i -> wasmInterpProfiled $ interpConfig i + +-- | Interpreter uses Dynamic way +interpreterDynamic :: Interp -> Bool +interpreterDynamic interp = case interpInstance interp of +#if defined(HAVE_INTERNAL_INTERPRETER) + InternalInterp -> hostIsDynamic +#endif + ExternalInterp ext -> case ext of + ExtIServ i -> iservConfDynamic (interpConfig i) + ExtJS {} -> False -- dynamic doesn't make sense for JS + ExtWasm {} -> True -- wasm dyld can only load dynamic code + ------------------------ -- JS Stuff ------------------------ @@ -176,6 +216,16 @@ { wasmInterpDyLD :: !FilePath -- ^ Location of dyld.mjs script , wasmInterpLibDir :: FilePath -- ^ wasi-sdk sysroot libdir containing libc.so, etc , wasmInterpOpts :: ![String] -- ^ Additional command line arguments for iserv + + -- wasm ghci browser mode + , wasmInterpBrowser :: !Bool + , wasmInterpBrowserHost :: !String + , wasmInterpBrowserPort :: !Int + , wasmInterpBrowserRedirectWasiConsole :: !Bool + , wasmInterpBrowserPuppeteerLaunchOpts :: !(Maybe String) + , wasmInterpBrowserPlaywrightBrowserType :: !(Maybe String) + , wasmInterpBrowserPlaywrightLaunchOpts :: !(Maybe String) + , wasmInterpTargetPlatform :: !Platform , wasmInterpProfiled :: !Bool -- ^ Are we profiling yet? , wasmInterpHsSoSuffix :: !String -- ^ Shared lib filename common suffix sans .so, e.g. p-ghc9.13.20241001 diff --git a/GHC/Runtime/Interpreter/Types/SymbolCache.hs b/GHC/Runtime/Interpreter/Types/SymbolCache.hs new file mode 100644 --- /dev/null +++ b/GHC/Runtime/Interpreter/Types/SymbolCache.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} + +-- | The SymbolCache is used to cache lookups for specific symbols when using +-- the interpreter. +module GHC.Runtime.Interpreter.Types.SymbolCache ( + InterpSymbolCache(..) + , mkInterpSymbolCache + , lookupInterpSymbolCache + , updateInterpSymbolCache + , purgeInterpSymbolCache + , InterpSymbol(..) + , SuffixOrInterpreted(..) + , interpSymbolName + , interpSymbolSuffix + , eliminateInterpSymbol + , interpretedInterpSymbol + ) where + +import GHC.Prelude + +import GHC.Types.Unique.FM +import GHC.Types.Name +import GHC.Data.FastString +import Foreign + +import Control.Concurrent +import GHC.Utils.Outputable +import GHC.TypeLits + + +-- The symbols records the suffix which each cache deals with. +newtype SymbolCache (s :: Symbol) = SymbolCache { _getSymbolCache :: UniqFM Name (Ptr ()) } + +-- Each cache is keyed by Name, there is one cache for each type of symbol we will +-- potentially lookup. The caches are keyed by 'Name' so that it is not necessary to consult +-- a complicated `FastString` each time. +data InterpSymbolCache = InterpSymbolCache { + interpClosureCache :: MVar (SymbolCache "closure") + , interpConInfoCache :: MVar (SymbolCache "con_info") + , interpStaticInfoCache :: MVar (SymbolCache "static_info") + , interpBytesCache :: MVar (SymbolCache "bytes") + , interpFaststringCache :: MVar (UniqFM FastString (Ptr ())) + } + +data SuffixOrInterpreted = Suffix Symbol | Interpreted + +data InterpSymbol (s :: SuffixOrInterpreted) where + IClosureSymbol :: Name -> InterpSymbol (Suffix "closure") + IConInfoSymbol :: Name -> InterpSymbol (Suffix "con_info") + IStaticInfoSymbol :: Name -> InterpSymbol (Suffix "static_info") + IBytesSymbol :: Name -> InterpSymbol (Suffix "bytes") + IFaststringSymbol :: FastString -> InterpSymbol Interpreted + +instance Outputable (InterpSymbol s) where + ppr s = eliminateInterpSymbol s + (\(IFaststringSymbol s) -> text "interpreted:" <> ppr s) + (\s -> text (interpSymbolSuffix s) <> colon <> ppr (interpSymbolName s)) + +eliminateInterpSymbol :: InterpSymbol s -> (InterpSymbol Interpreted -> r) + -> (forall x . InterpSymbol (Suffix x) -> r) + -> r +eliminateInterpSymbol s k1 k2 = + case s of + IFaststringSymbol {} -> k1 s + IBytesSymbol {} -> k2 s + IStaticInfoSymbol {} -> k2 s + IConInfoSymbol {} -> k2 s + IClosureSymbol {} -> k2 s + + +interpSymbolName :: InterpSymbol (Suffix s) -> Name +interpSymbolName (IClosureSymbol n) = n +interpSymbolName (IConInfoSymbol n) = n +interpSymbolName (IStaticInfoSymbol n) = n +interpSymbolName (IBytesSymbol n) = n + +interpretedInterpSymbol :: InterpSymbol Interpreted -> FastString +interpretedInterpSymbol (IFaststringSymbol s) = s + +interpSymbolSuffix :: InterpSymbol (Suffix s) -> String +interpSymbolSuffix (IClosureSymbol {}) = "closure" +interpSymbolSuffix (IConInfoSymbol {}) = "con_info" +interpSymbolSuffix (IStaticInfoSymbol {}) = "static_info" +interpSymbolSuffix (IBytesSymbol {}) = "bytes" + +emptySymbolCache :: SymbolCache s +emptySymbolCache = SymbolCache emptyUFM + +lookupSymbolCache :: InterpSymbol (Suffix s) -> SymbolCache s -> Maybe (Ptr ()) +lookupSymbolCache s (SymbolCache cache) = lookupUFM cache (interpSymbolName s) + +insertSymbolCache :: InterpSymbol (Suffix s) -> Ptr () -> SymbolCache s -> SymbolCache s +insertSymbolCache s v (SymbolCache cache) = SymbolCache (addToUFM cache (interpSymbolName s) v) + +lookupInterpSymbolCache :: InterpSymbol s -> InterpSymbolCache -> IO (Maybe (Ptr ())) +lookupInterpSymbolCache = withInterpSymbolCache + (\(IFaststringSymbol f) mvar_var -> (\cache -> lookupUFM cache f) <$> readMVar mvar_var) + (\s mvar_var -> lookupSymbolCache s <$> readMVar mvar_var) + + +updateInterpSymbolCache :: InterpSymbol s + -> InterpSymbolCache -> Ptr () -> IO () +updateInterpSymbolCache = withInterpSymbolCache + (\(IFaststringSymbol f) mvar_var v -> modifyMVar_ mvar_var (\cache -> pure $ addToUFM cache f v)) + (\s mvar_var v -> modifyMVar_ mvar_var (\cache -> pure $ insertSymbolCache s v cache)) + +withInterpSymbolCache :: + (InterpSymbol Interpreted -> MVar (UniqFM FastString (Ptr ())) -> r) + -> (forall x . InterpSymbol (Suffix x) -> MVar (SymbolCache x) -> r) + -> InterpSymbol s + -> InterpSymbolCache + -> r +withInterpSymbolCache k1 k2 key InterpSymbolCache{..} = + case key of + IClosureSymbol {} -> k2 key interpClosureCache + IConInfoSymbol {} -> k2 key interpConInfoCache + IStaticInfoSymbol {} -> k2 key interpStaticInfoCache + IBytesSymbol {} -> k2 key interpBytesCache + IFaststringSymbol {} -> k1 key interpFaststringCache + +-- | Clear all symbol caches. +purgeInterpSymbolCache :: InterpSymbolCache -> IO () +purgeInterpSymbolCache (InterpSymbolCache a b c d e) = do + modifyMVar_ a (\_ -> do + modifyMVar_ b (\_ -> do + modifyMVar_ c (\_ -> do + modifyMVar_ d (\_ -> do + modifyMVar_ e (\_ -> pure emptyUFM) + pure emptySymbolCache) + pure emptySymbolCache) + pure emptySymbolCache) + pure emptySymbolCache) + +mkInterpSymbolCache :: IO InterpSymbolCache +mkInterpSymbolCache = do + InterpSymbolCache <$> newMVar emptySymbolCache + <*> newMVar emptySymbolCache + <*> newMVar emptySymbolCache + <*> newMVar emptySymbolCache + <*> newMVar emptyUFM diff --git a/GHC/Runtime/Interpreter/Wasm.hs b/GHC/Runtime/Interpreter/Wasm.hs --- a/GHC/Runtime/Interpreter/Wasm.hs +++ b/GHC/Runtime/Interpreter/Wasm.hs @@ -10,13 +10,14 @@ #if !defined(mingw32_HOST_OS) import Control.Concurrent.MVar -import Data.IORef +import Data.Maybe import GHC.Data.FastString import qualified GHC.Data.ShortText as ST import GHC.Platform import GHC.Unit import GHCi.Message import System.Directory +import System.Environment.Blank import System.IO import qualified System.Posix.IO as Posix import System.Process @@ -47,20 +48,29 @@ (rfd2, wfd2) <- Posix.createPipe Posix.setFdOption rfd1 Posix.CloseOnExec True Posix.setFdOption wfd2 Posix.CloseOnExec True + ghc_env <- getEnvironment + let dyld_env = + [("GHCI_BROWSER", "1") | wasmInterpBrowser] + ++ [("GHCI_BROWSER_HOST", wasmInterpBrowserHost), ("GHCI_BROWSER_PORT", show wasmInterpBrowserPort)] + ++ [("GHCI_BROWSER_REDIRECT_WASI_CONSOLE", "1") | wasmInterpBrowserRedirectWasiConsole] + ++ [("GHCI_BROWSER_PUPPETEER_LAUNCH_OPTS", f) | f <- maybeToList wasmInterpBrowserPuppeteerLaunchOpts] + ++ [("GHCI_BROWSER_PLAYWRIGHT_BROWSER_TYPE", f) | f <- maybeToList wasmInterpBrowserPlaywrightBrowserType] + ++ [("GHCI_BROWSER_PLAYWRIGHT_LAUNCH_OPTS", f) | f <- maybeToList wasmInterpBrowserPlaywrightLaunchOpts] + ++ ghc_env (_, _, _, ph) <- createProcess ( proc wasmInterpDyLD $ [wasmInterpLibDir, ghci_so_path, show wfd1, show rfd2] ++ wasmInterpOpts ++ ["+RTS", "-H64m", "-RTS"] - ) + ) { env = Just dyld_env } Posix.closeFd wfd1 Posix.closeFd rfd2 rh <- Posix.fdToHandle rfd1 wh <- Posix.fdToHandle wfd2 hSetBuffering wh NoBuffering hSetBuffering rh NoBuffering - lo_ref <- newIORef Nothing + interpPipe <- mkPipeFromHandles rh wh pending_frees <- newMVar [] lock <- newMVar () pure @@ -68,7 +78,7 @@ { instProcess = InterpProcess { interpHandle = ph, - interpPipe = Pipe {pipeRead = rh, pipeWrite = wh, pipeLeftovers = lo_ref}, + interpPipe, interpLock = lock }, instPendingFrees = pending_frees, diff --git a/GHC/Runtime/Loader.hs b/GHC/Runtime/Loader.hs --- a/GHC/Runtime/Loader.hs +++ b/GHC/Runtime/Loader.hs @@ -56,7 +56,6 @@ import GHC.Types.Unique.DFM import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) -import GHC.Driver.Config.Finder ( initFinderOpts ) import GHC.Driver.Config.Diagnostic ( initIfaceMessageOpts ) import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit), IsBootInterface(NotBoot) ) import GHC.Unit.Module.ModIface @@ -215,7 +214,7 @@ ; case eith_plugin of Left actual_type -> throwGhcExceptionIO (CmdLineError $ - showSDocForUser dflags (ue_units (hsc_unit_env hsc_env)) + showSDocForUser dflags (ue_homeUnitState (hsc_unit_env hsc_env)) alwaysQualify $ hsep [ text "The value", ppr name , text "with type", ppr actual_type @@ -343,13 +342,8 @@ -> IO (Maybe (Name, ModIface)) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags - let fc = hsc_FC hsc_env - let unit_env = hsc_unit_env hsc_env - let unit_state = ue_units unit_env - let mhome_unit = hsc_home_unit_maybe hsc_env -- First find the unit the module resides in by searching exposed units and home modules - found_module <- findPluginModule fc fopts unit_state mhome_unit mod_name + found_module <- findPluginModule hsc_env mod_name case found_module of Found _ mod -> do -- Find the exports of the module @@ -360,7 +354,7 @@ Just iface -> do -- Try and find the required name in the exports let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name, is_pkg_qual = NoPkgQual - , is_qual = False, is_dloc = noSrcSpan, is_isboot = NotBoot } + , is_qual = False, is_dloc = noSrcSpan, is_isboot = NotBoot, is_level = SpliceLevel } imp_spec = ImpSpec decl_spec ImpAll env = mkGlobalRdrEnv $ gresFromAvails hsc_env (Just imp_spec) (mi_exports iface) diff --git a/GHC/Settings.hs b/GHC/Settings.hs --- a/GHC/Settings.hs +++ b/GHC/Settings.hs @@ -5,6 +5,7 @@ ( Settings (..) , ToolSettings (..) , FileSettings (..) + , UnitSettings(..) , GhcNameVersion (..) , Platform (..) , PlatformMisc (..) @@ -73,6 +74,7 @@ import GHC.Utils.CliOption import GHC.Utils.Fingerprint import GHC.Platform +import GHC.Unit.Types data Settings = Settings { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion @@ -80,11 +82,14 @@ , sTargetPlatform :: Platform -- Filled in by SysTools , sToolSettings :: {-# UNPACK #-} !ToolSettings , sPlatformMisc :: {-# UNPACK #-} !PlatformMisc + , sUnitSettings :: !UnitSettings -- You shouldn't need to look things up in rawSettings directly. -- They should have their own fields instead. , sRawSettings :: [(String, String)] } + +data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId } -- | Settings for other executables GHC calls. -- diff --git a/GHC/Settings/IO.hs b/GHC/Settings/IO.hs --- a/GHC/Settings/IO.hs +++ b/GHC/Settings/IO.hs @@ -19,6 +19,7 @@ import GHC.ResponseFile import GHC.Settings import GHC.SysTools.BaseDir +import GHC.Unit.Types import Control.Monad.Trans.Except import Control.Monad.IO.Class @@ -172,9 +173,10 @@ llvmTarget <- getSetting_raw "LLVM target" -- We just assume on command line - lc_prog <- getSetting "LLVM llc command" - lo_prog <- getSetting "LLVM opt command" - las_prog <- getSetting "LLVM llvm-as command" + lc_prog <- getToolSetting "LLVM llc command" + lo_prog <- getToolSetting "LLVM opt command" + las_prog <- getToolSetting "LLVM llvm-as command" + las_args <- map Option <$> getFlagsSetting "LLVM llvm-as flags" let iserv_prog = libexec "ghc-iserv" @@ -182,6 +184,8 @@ ghcWithInterpreter <- getBooleanSetting "Use interpreter" useLibFFI <- getBooleanSetting "Use LibFFI" + baseUnitId <- getSetting_raw "base unit-id" + return $ Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc" @@ -196,6 +200,11 @@ , fileSettings_globalPackageDatabase = globalpkgdb_path } + , sUnitSettings = UnitSettings + { + unitSettings_baseUnitId = stringToUnitId baseUnitId + } + , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist @@ -225,7 +234,7 @@ , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) - , toolSettings_pgm_las = (las_prog, []) + , toolSettings_pgm_las = (las_prog, las_args) , toolSettings_pgm_i = iserv_prog , toolSettings_opt_L = [] , toolSettings_opt_P = [] diff --git a/GHC/Stg/BcPrep.hs b/GHC/Stg/BcPrep.hs --- a/GHC/Stg/BcPrep.hs +++ b/GHC/Stg/BcPrep.hs @@ -49,7 +49,7 @@ bcPrepExpr :: StgExpr -> BcPrepM StgExpr -- explicitly match all constructors so we get a warning if we miss any -bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _ _) rhs) +bcPrepExpr (StgTick bp@(Breakpoint tick_ty _ _) rhs) | isLiftedTypeKind (typeKind tick_ty) = do id <- newId tick_ty rhs' <- bcPrepExpr rhs diff --git a/GHC/Stg/CSE.hs b/GHC/Stg/CSE.hs --- a/GHC/Stg/CSE.hs +++ b/GHC/Stg/CSE.hs @@ -142,6 +142,8 @@ foldTM k m = foldTM k (sam_var m) . foldTM k (sam_lit m) filterTM f (SAM {sam_var = varm, sam_lit = litm}) = SAM { sam_var = filterTM f varm, sam_lit = filterTM f litm } + mapMaybeTM f (SAM {sam_var = varm, sam_lit = litm}) = + SAM { sam_var = mapMaybeTM f varm, sam_lit = mapMaybeTM f litm } newtype ConAppMap a = CAM { un_cam :: DNameEnv (ListMap StgArgMap a) } @@ -158,6 +160,7 @@ m { un_cam = un_cam m |> xtDNamed dataCon |>> alterTM args f } foldTM k = un_cam >.> foldTM (foldTM k) filterTM f = un_cam >.> fmap (filterTM f) >.> CAM + mapMaybeTM f = un_cam >.> fmap (mapMaybeTM f) >.> CAM ----------------- -- The CSE Env -- diff --git a/GHC/Stg/EnforceEpt.hs b/GHC/Stg/EnforceEpt.hs new file mode 100644 --- /dev/null +++ b/GHC/Stg/EnforceEpt.hs @@ -0,0 +1,750 @@ +{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} + -- To permit: type instance XLet 'InferTaggedBinders = XLet 'SomePass + +{-# OPTIONS_GHC -Wname-shadowing #-} +module GHC.Stg.EnforceEpt ( enforceEpt ) where + +import GHC.Prelude hiding (id) + +import GHC.Core.DataCon +import GHC.Core.Type +import GHC.Types.Id +import GHC.Types.Id.Info (tagSigInfo) +import GHC.Types.Name +import GHC.Stg.Syntax +import GHC.Types.Basic ( CbvMark (..) ) +import GHC.Types.Demand (isDeadEndAppSig) +import GHC.Types.Unique.Supply (mkSplitUniqSupply) +import GHC.Types.RepType (dataConRuntimeRepStrictness) +import GHC.Core (AltCon(..)) +import Data.List (mapAccumL) +import GHC.Utils.Outputable +import GHC.Utils.Misc( zipWithEqual, zipEqual, notNull ) + +import GHC.Stg.EnforceEpt.Types +import GHC.Stg.EnforceEpt.Rewrite (rewriteTopBinds) +import Data.Maybe +import GHC.Types.Name.Env (mkNameEnv, NameEnv) +import GHC.Driver.DynFlags +import GHC.Utils.Logger +import qualified GHC.Unit.Types + +{- Note [Evaluated and Properly Tagged] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A pointer is Evaluated and Properly Tagged (EPT) when the pointer + + (a) points directly to the value (not to an indirection, and not to a thunk) + (b) is tagged with the tag corresponding to said value (e.g. constructor tag + or arity of a function). + +A binder is EPT when all the runtime pointers it binds are EPT. + +Note that a lifted EPT pointer will never point to a thunk, nor will it be +tagged `000` (meaning "might be a thunk"). + +See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/rts/haskell-execution/pointer-tagging +for more information on pointer tagging. + +Examples: +* Case binders are always EPT; hence an eval + case x of x' { __DEFAULT -> ... } + ensures that x' is EPT even if x was not. +* Data constructor bindings + let x = Just y in ... + are EPT: x will point to the heap-allocated constructor closure for (Just y), + and the tag-bits of the pointer will encode the tag for Just (i.e. `010`). +* In practice, GHC also guarantees that strict fields (and others) are EPT; + see Note [EPT enforcement]. + +Caveat: +Currently, the proper tag for builtin *unlifted* data types such as `Array#` is +not `001` but `000`, which is not a proper tag for lifted data. +This means that UnliftedRep is not a proper sub-rep of LiftedRep. +SG thinks it would be good to fix this; see #21792. + +Note [EPT enforcement] +~~~~~~~~~~~~~~~~~~~~~~ +The goal of EnforceEPT pass is to mark as many binders as possible as EPT +(see Note [Evaluated and Properly Tagged]). +To find more EPT binders, it establishes the following + +EPT INVARIANT: +> Any binder of +> * a strict field (see Note [Strict fields in Core]), or +> * a CBV argument (see Note [CBV Function Ids]) +> is EPT. + +(Note that prior to EPT enforcement, this invariant may *not* always be upheld. +An example can be found at the end of this Note.) +This is all to optimise code such as the following: + + data SPair a b = SP !a !b + case p :: SP Bool Bool of + SP x y -> + case x of + True -> ... + False -> ... + +We can infer that the strict field x is EPT and hence may safely +omit the code to enter x and the check for the presence of a tag that goes along +with it. However we still branch on the tag as usual to jump to the True or +False case. + +Note that for every example involving strict fields we could find a similar +example using CBV functions, e.g. + + $wf x[EPT] y = + case x of + True -> ... + False -> ... + +is the above example translated to use a CBV function $wf. +Note that /any/ strict function can in principle be chosen as a CBV function; +however, we presently only promote worker functions such as $wf to CBV because +we see all its call sites and can use the proper by-value calling convention. +More precisely, with -O0, we guarantee that no CBV functions are visible in +the interface file, so that naïve clients do not need to know how to call CBV +functions. See Note [CBV Function Ids] for more details. + +Specification +------------- +EPT enforcement works like implicit type conversions in C, such as from int to +float, only much simpler (no overloaded operations such as +). +For EPT enforcement, the "type system" in question is whether a binder is +statically EPT. We differentiate "EPT binder" from "non-EPT binder", where the +latter means "might be EPT, but we could not prove it so". +In this sense, EPT binders form a subtype of non-EPT binders. +We differentiate two conversion directions: + + * Downcast: EPT binders can be converted into non-EPT binders for free. + * Upcast: non-EPT binders can be converted into EPT binders by inserting an eval. + +The EPT invariant expresses type signatures. In particular, these type +signatures entail two things: + + * A _precondition_: Any binder that is passed as a CBV arg/strict field + must be EPT (i.e. must have type "EPT binder"). + * A _postcondition_: Any binder of a CBV arg/strict field is EPT. + +EPT enforcement is then simply a matter of figuring out where to insert +Upcasts (remember that Downcasts are free). +Since Upcasts (evals!) are not free, it is desirable to insert as few as possible. +To this end, we run a static *EPT analysis*, the purpose of which is to identify +as many EPT binders as possible. +Beyond discovering case binders and value bindings, EPT analysis exploits the +type signatures provided by the EPT invariant, looks inside returned tuples and +does some limited amount of fixpointing. +Afterwards, the *EPT rewriter* inserts the actual evals realising Upcasts. + +Implementation +-------------- + +* EPT analysis is implemented in GHC.Stg.EnforceEpt.inferTags. + It attaches its result to /binders/, not occurrence sites. +* The EPT rewriter establishes the EPT invariant by inserting evals. That is, if + (a) a binder x is used to + * construct a strict field (`SP x y`), or + * passed as a CBV argument (`$wf x`), + and + (b) x was not inferred EPT, + then the EPT rewriter inserts an eval prior to the call, e.g. + case x of x' { __ DEFAULT -> SP x' y }. + case x of x' { __ DEFAULT -> $wf x' }. + (Recall that the case binder x' is always EPT.) + This is implemented in GHC.Stg.EnforceEpt.Rewrite.rewriteTopBinds. + This pass also propagates the EPTness from binders to occurrences. + It is sound to insert evals on strict fields (Note [Strict fields in Core]), + and on CBV arguments as well (Note [CBV Function Ids]). +* We also export the EPTness of top level bindings to allow this optimisation + to work across module boundaries. + NB: The EPT Invariant *must* be upheld, regardless of the optimisation level; + hence EPTness is practically part of the internal ABI of a strict data + constructor or CBV function. Note [CBV Function Ids] contains the details. +* Finally, code generation skips the thunk check when branching on binders that + are EPT. This is done by `cgExpr`/`cgCase` in the backend. + +Evaluation +---------- +EPT enforcement can have large impact on spine-strict tree data structure +performance. For containers the reduction in runtimes with this optimization +was as follows: + +intmap-benchmarks: 89.30% +intset-benchmarks: 90.87% +map-benchmarks: 88.00% +sequence-benchmarks: 99.84% +set-benchmarks: 85.00% +set-operations-intmap:88.64% +set-operations-map: 74.23% +set-operations-set: 76.50% +lookupge-intmap: 89.57% +lookupge-map: 70.95% + +With nofib being ~0.3% faster as well. + +Note that EPT enforcement may cause regressions in rare cases. +For example consider this code: + + foo x = ... + let c = StrictJust x + in ... + +When x cannot be inferred EPT, the rewriter transforms to + + foo x = ... + let c = case x of x' -> StrictJust x' + in ... + +which allocates an additional thunk for `c` that returns the constructor. Boo! + +Note [EPT enforcement lowers strict constructor worker semantics] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In Core, a saturated application of a strict constructor worker evaluates its +strict fields and thus is *not* a value; see Note [Strict fields in Core]. +This is also the semantics of strict constructor workers in STG *before* EPT +enforcement (see Note [EPT enforcement]) + +However, after enforcing the EPT Invariant, all constructor workers can +effectively be lazy. That is, when actually generating code to allocate the +data constructor, the code generator does not need to evaluate the argument; +that has already been done by the EPT pass. + +Thus for code-gen reasons (StgToX), all constructor workers are considered lazy +after EPT enforcement. + +Note [Why isn't the EPT Invariant enforced during Core passes?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Recall the definition of the EPT Invariant from Note [EPT enforcement]. +Why can't it be established as an invariant right while desugaring to Core? +The reason is that some Core optimisations, such as FloatOut, will drop or delay +evals whenever they think it useful and thus destroy the Invariant. Example: + + data Set a = Tip | Bin !a (Set a) (Set a) + +We start with + + thk = f () + g x = ...(case thk of xv -> Bin xv Tip Tip)... + +So far so good; the argument to Bin (which is strict) is evaluated. +Now we do float-out. And in doing so we do a reverse binder-swap (see +Note [Binder-swap during float-out] in SetLevels) thus + + g x = ...(case thk of xv -> Bin thk Nil Nil)... + +The goal of the reverse binder-swap is to allow more floating -- and +indeed it does! We float the Bin to top level: + + lvl = Bin thk Tip Tip + g x = ...(case thk of xv -> lvl)... + +Now you can see that the argument of Bin, namely thk, points to the +thunk, not to the value as it did before. + +In short, although it may be rare, the output of Core optimisation passes +might destroy the EPT Invariant, hence we need to enforce the EPT invariant +*after* passes such as FloatOut. +-} + +{- Note [TagInfo of functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The purpose of tag inference is really to figure out when we don't have to enter +value closures. There the meaning of the tag is fairly obvious. +For functions we never make use of the tag info so we have two choices: +* Treat them as TagDunno +* Treat them as TagProper (as they *are* tagged with their arity) and be really + careful to make sure we still enter them when needed. +As it makes little difference for runtime performance I've treated functions as TagDunno in a few places where +it made the code simpler. But besides implementation complexity there isn't any reason +why we couldn't be more rigorous in dealing with functions. + +NB: It turned in #21193 that PAPs get tag zero, so the tag check can't be omitted for functions. +So option two isn't really an option without reworking this anyway. + +Note [EPT enforcement debugging] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There is a flag -dtag-inference-checks which inserts various +compile/runtime checks in order to ensure the EPT Invariant +holds. It should cover all places +where tags matter and disable optimizations which interfere with checking +the invariant like generation of AP-Thunks. + +Note [Polymorphic StgPass for inferTagExpr] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In order to reach a fixpoint we sometimes have to re-analyse an expression +multiple times. But after the initial run the Ast will be parameterized by +a different StgPass! To handle this a large part of the analysis is polymorphic +over the exact StgPass we are using. Which allows us to run the analysis on +the output of itself. + +Note [EPT enforcement for interpreted code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The bytecode interpreter has a different behaviour when it comes +to the tagging of binders in certain situations than the StgToCmm code generator. + +a) Tags for let-bindings: + + When compiling a binding for a constructor like `let x = Just True` + Whether `x` will be properly tagged depends on the backend. + For the interpreter x points to a BCO which once + evaluated returns a properly tagged pointer to the heap object. + In the Cmm backend for the same binding we would allocate the constructor right + away and x will immediately be represented by a tagged pointer. + This means for interpreted code we can not assume let bound constructors are + properly tagged. Hence we distinguish between targeting bytecode and native in + the analysis. + We make this differentiation in `mkLetSig` where we simply never assume + lets are tagged when targeting bytecode. + +b) When referencing ids from other modules the Cmm backend will try to put a + proper tag on these references through various means. When doing analysis we + usually predict these cases to improve precision of the analysis. + But to my knowledge the bytecode generator makes no such attempts so we must + not infer imported bindings as tagged. + This is handled in GHC.Stg.EnforceEpt.Types.lookupInfo + + +-} + +{- ********************************************************************* +* * + EPT enforcement pass +* * +********************************************************************* -} + +enforceEpt :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) +enforceEpt ppr_opts !for_bytecode logger this_mod stg_binds = do + -- pprTraceM "enforceEpt for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) + -- Annotate binders with tag information. + let (!stg_binds_w_tags) = {-# SCC "StgEptInfer" #-} + inferTags for_bytecode stg_binds + putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) + + let export_tag_info = collectExportInfo stg_binds_w_tags + + -- Rewrite STG to uphold the strict field invariant + us_t <- mkSplitUniqSupply 't' + let rewritten_binds = {-# SCC "StgEptRewrite" #-} rewriteTopBinds this_mod us_t stg_binds_w_tags :: [TgStgTopBinding] + + return (rewritten_binds,export_tag_info) + +{- ********************************************************************* +* * + Main inference algorithm +* * +********************************************************************* -} + +type OutputableInferPass p = (Outputable (TagEnv p) + , Outputable (GenStgExpr p) + , Outputable (BinderP p) + , Outputable (GenStgRhs p)) + +-- | This constraint encodes the fact that no matter what pass +-- we use the Let/Closure extension points are the same as these for +-- 'InferTaggedBinders. +type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders + , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders + , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) + +inferTags :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] +inferTags for_bytecode binds = + -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ + snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) + +----------------------- +inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen + -> (TagEnv 'CodeGen, GenStgTopBinding 'InferTaggedBinders) +inferTagTopBind env (StgTopStringLit id bs) + = (env, StgTopStringLit id bs) +inferTagTopBind env (StgTopLifted bind) + = (env', StgTopLifted bind') + where + (env', bind') = inferTagBind env bind + + +-- Why is this polymorphic over the StgPass? See Note [Polymorphic StgPass for inferTagExpr] +----------------------- +inferTagExpr :: forall p. (OutputableInferPass p, InferExtEq p) + => TagEnv p -> GenStgExpr p -> (TagInfo, GenStgExpr 'InferTaggedBinders) +inferTagExpr env (StgApp fun args) + = --pprTrace "inferTagExpr1" + -- (ppr fun <+> ppr args $$ ppr info $$ + -- text "deadEndInfo:" <> ppr (isDeadEndId fun, idArity fun, length args) + -- ) + (info, StgApp fun args) + where + !fun_arity = idArity fun + info + -- It's important that we check for bottoms before all else. + -- See Note [Bottom functions are TagTagged] and #24806 for why. + | isDeadEndAppSig (idDmdSig fun) (length args) + = TagTagged + + | fun_arity == 0 -- Unknown arity => Thunk or unknown call + = TagDunno + + | Just (TagSig res_info) <- tagSigInfo (idInfo fun) + , fun_arity == length args -- Saturated + = res_info + + | Just (TagSig res_info) <- lookupSig env fun + , fun_arity == length args -- Saturated + = res_info + + | otherwise + = --pprTrace "inferAppUnknown" (ppr fun) $ + TagDunno + +inferTagExpr env (StgConApp con cn args tys) + = (inferConTag env con args, StgConApp con cn args tys) + +inferTagExpr _ (StgLit l) + = (TagTagged, StgLit l) + +inferTagExpr env (StgTick tick body) + = (info, StgTick tick body') + where + (info, body') = inferTagExpr env body + +inferTagExpr _ (StgOpApp op args ty) + -- Which primops guarantee to return a properly tagged value? + -- Probably none, and that is the conservative assumption anyway. + -- (And foreign calls definitely need not make promises.) + = (TagDunno, StgOpApp op args ty) + +inferTagExpr env (StgLet ext bind body) + = (info, StgLet ext bind' body') + where + (env', bind') = inferTagBind env bind + (info, body') = inferTagExpr env' body + +inferTagExpr env (StgLetNoEscape ext bind body) + = (info, StgLetNoEscape ext bind' body') + where + (env', bind') = inferTagBind env bind + (info, body') = inferTagExpr env' body + +inferTagExpr in_env (StgCase scrut bndr ty alts) + -- Unboxed tuples get their info from the expression we scrutinise if any + | [GenStgAlt{alt_con=DataAlt con, alt_bndrs=bndrs, alt_rhs=rhs}] <- alts + , isUnboxedTupleDataCon con + , Just infos <- scrut_infos bndrs + , let bndrs' = zipWithEqual mk_bndr bndrs infos + mk_bndr :: BinderP p -> TagInfo -> (Id, TagSig) + mk_bndr tup_bndr tup_info = + -- pprTrace "mk_ubx_bndr_info" ( ppr bndr <+> ppr info ) $ + (getBinderId in_env tup_bndr, TagSig tup_info) + -- no case binder in alt_env here, unboxed tuple binders are dead after unarise + alt_env = extendSigEnv in_env bndrs' + (info, rhs') = inferTagExpr alt_env rhs + = + -- pprTrace "inferCase1" ( + -- text "scrut:" <> ppr scrut $$ + -- text "bndr:" <> ppr bndr $$ + -- text "infos" <> ppr infos $$ + -- text "out_bndrs" <> ppr bndrs') $ + (info, StgCase scrut' (noSig in_env bndr) ty [GenStgAlt{ alt_con=DataAlt con + , alt_bndrs=bndrs' + , alt_rhs=rhs'}]) + + | null alts -- Empty case, but I might just be paranoid. + = -- pprTrace "inferCase2" empty $ + (TagDunno, StgCase scrut' bndr' ty []) + -- More than one alternative OR non-TagTuple single alternative. + | otherwise + = + let + case_env = extendSigEnv in_env [bndr'] + + (infos, alts') + = unzip [ (info, g {alt_bndrs=bndrs', alt_rhs=rhs'}) + | g@GenStgAlt{ alt_con = con + , alt_bndrs = bndrs + , alt_rhs = rhs + } <- alts + , let (alt_env,bndrs') = addAltBndrInfo case_env con bndrs + (info, rhs') = inferTagExpr alt_env rhs + ] + alt_info = foldr combineAltInfo TagTagged infos + in ( alt_info, StgCase scrut' bndr' ty alts') + where + -- Single unboxed tuple alternative + scrut_infos bndrs = case scrut_info of + TagTagged -> Just $ replicate (length bndrs) TagProper + TagTuple infos -> Just infos + _ -> Nothing + (scrut_info, scrut') = inferTagExpr in_env scrut + bndr' = (getBinderId in_env bndr, TagSig TagProper) + +-- Compute binder sigs based on the constructors strict fields. +-- NB: Not used if we have tuple info from the scrutinee. +addAltBndrInfo :: forall p. TagEnv p -> AltCon -> [BinderP p] -> (TagEnv p, [BinderP 'InferTaggedBinders]) +addAltBndrInfo env (DataAlt con) bndrs + | not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) + = (out_env, out_bndrs) + where + marks = dataConRuntimeRepStrictness con :: [StrictnessMark] + out_bndrs = zipWith mk_bndr bndrs marks + out_env = extendSigEnv env out_bndrs + + mk_bndr :: (BinderP p -> StrictnessMark -> (Id, TagSig)) + mk_bndr bndr mark + | isUnliftedType (idType id) || isMarkedStrict mark + = (id, TagSig TagProper) + | otherwise + = noSig env bndr + where + id = getBinderId env bndr + +addAltBndrInfo env _ bndrs = (env, map (noSig env) bndrs) + +----------------------------- +inferTagBind :: (OutputableInferPass p, InferExtEq p) + => TagEnv p -> GenStgBinding p -> (TagEnv p, GenStgBinding 'InferTaggedBinders) +inferTagBind in_env (StgNonRec bndr rhs) + = + -- pprTrace "inferBindNonRec" ( + -- ppr bndr $$ + -- ppr (isDeadEndId id) $$ + -- ppr sig) + (env', StgNonRec (id, out_sig) rhs') + where + id = getBinderId in_env bndr + (in_sig,rhs') = inferTagRhs id in_env rhs + out_sig = mkLetSig in_env in_sig + env' = extendSigEnv in_env [(id, out_sig)] + +inferTagBind in_env (StgRec pairs) + = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ + (in_env { te_env = out_env }, StgRec pairs') + where + (bndrs, rhss) = unzip pairs + in_ids = map (getBinderId in_env) bndrs + init_sigs = map (initSig) $ zip in_ids rhss + (out_env, pairs') = go in_env init_sigs rhss + + go :: forall q. (OutputableInferPass q , InferExtEq q) => TagEnv q -> [TagSig] -> [GenStgRhs q] + -> (TagSigEnv, [((Id,TagSig), GenStgRhs 'InferTaggedBinders)]) + go go_env in_sigs go_rhss + -- | pprTrace "go" (ppr in_ids $$ ppr in_sigs $$ ppr out_sigs $$ ppr rhss') False + -- = undefined + | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') + | otherwise = go env' out_sigs rhss' + where + in_bndrs = in_ids `zip` in_sigs + out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive + rhs_env = extendSigEnv go_env in_bndrs + (out_sigs, rhss') = unzip (zipWithEqual anaRhs in_ids go_rhss) + env' = makeTagged go_env + + anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) + anaRhs bnd rhs = + let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs + in (mkLetSig go_env sig_rhs, rhs') + + + updateBndr :: (Id,TagSig) -> (Id,TagSig) + updateBndr (v,sig) = (setIdTagSig v sig, sig) + +initSig :: forall p. (Id, GenStgRhs p) -> TagSig +-- Initial signature for the fixpoint loop +initSig (_bndr, StgRhsCon {}) = TagSig TagTagged +initSig (bndr, StgRhsClosure _ _ _ _ _ _) = + fromMaybe defaultSig (idTagSig_maybe bndr) + where defaultSig = (TagSig TagTagged) + +{- Note [Bottom functions are TagTagged] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have a function with two branches with one +being bottom, and the other returning a tagged +unboxed tuple what is the result? We give it TagTagged! +To answer why consider this function: + +foo :: Bool -> (# Bool, Bool #) +foo x = case x of + True -> (# True,True #) + False -> undefined + +The true branch is obviously tagged. The other branch isn't. +We want to treat the *result* of foo as tagged as well so that +the combination of the branches also is tagged if all non-bottom +branches are tagged. +This is safe because the function is still always called/entered as long +as it's applied to arguments. Since the function will never return we can give +it safely any tag sig we like. +So we give it TagTagged, as it allows the combined tag sig of the case expression +to be the combination of all non-bottoming branches. + +NB: After the analysis is done we go back to treating bottoming functions as +untagged to ensure they are evaluated as expected in code like: + + case bottom_id of { ...} + +-} + +----------------------------- +inferTagRhs :: forall p. + (OutputableInferPass p, InferExtEq p) + => Id -- ^ Id we are binding to. + -> TagEnv p -- ^ + -> GenStgRhs p -- ^ + -> (TagSig, GenStgRhs 'InferTaggedBinders) +inferTagRhs bnd_id in_env (StgRhsClosure ext cc upd bndrs body typ) + | isDeadEndId bnd_id && (notNull) bndrs + -- See Note [Bottom functions are TagTagged] + = (TagSig TagTagged, StgRhsClosure ext cc upd out_bndrs body' typ) + | otherwise + = --pprTrace "inferTagRhsClosure" (ppr (_top, _grp_ids, env,info')) $ + (TagSig info', StgRhsClosure ext cc upd out_bndrs body' typ) + where + out_bndrs + | Just marks <- idCbvMarks_maybe bnd_id + -- Sometimes an we eta-expand foo with additional arguments after ww, and we also trim + -- the list of marks to the last strict entry. So we can conservatively + -- assume these are not strict + = zipWith (mkArgSig) bndrs (marks ++ repeat NotMarkedCbv) + | otherwise = map (noSig env') bndrs :: [(Id,TagSig)] + + env' = extendSigEnv in_env out_bndrs + (info, body') = inferTagExpr env' body + info' + -- It's a thunk + | null bndrs + = TagDunno + -- TODO: We could preserve tuple fields for thunks + -- as well. But likely not worth the complexity. + + | otherwise = info + + mkArgSig :: BinderP p -> CbvMark -> (Id,TagSig) + mkArgSig bndp mark = + let id = getBinderId in_env bndp + tag = case mark of + MarkedCbv -> TagProper + _ + | isUnliftedType (idType id) -> TagProper + | otherwise -> TagDunno + in (id, TagSig tag) + +inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args typ) +-- Constructors, which have untagged arguments to strict fields +-- become thunks. We encode this by giving changing RhsCon nodes the info TagDunno + = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ + (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args typ) + +-- Adjust let semantics to the targeted backend. +-- See Note [EPT enforcement for interpreted code] +mkLetSig :: TagEnv p -> TagSig -> TagSig +mkLetSig env in_sig + | for_bytecode = TagSig TagDunno + | otherwise = in_sig + where + for_bytecode = te_bytecode env + +{- Note [Constructor TagSigs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +@inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor +or a StgConApp expression. +Usually these will simply be TagProper. But there are exceptions. +If any of the fields in the constructor are strict, but any argument to these +fields is not tagged then we will have to case on the argument before storing +in the constructor. Which means for let bindings the RHS turns into a thunk +which obviously is no longer properly tagged. +For example we might start with: + + let x = f ... + let c = StrictPair x True + +But we know during the rewrite stage x will need to be evaluated in the RHS +of `c` so we will infer: + + let x = f ... + let c = StrictPair x True + +Which in the rewrite stage will then be rewritten into: + + let x = f ... + let c = case x of x' -> StrictPair x' True + +The other exception is unboxed tuples. These will get a TagTuple +signature with a list of TagInfo about their individual binders +as argument. As example: + + let c = True + let x = ... + let f z = case z of z' -> (# c, x #) + +Here we will infer for f the Signature . +This information will be used if we scrutinize a saturated application of +`f` in order to determine the taggedness of the result. +That is for `case f x of (# r1,r2 #) -> rhs` we can infer +r1 and r2 which allows us to skip all tag checks on `r1` +in `rhs`. + +Things get a bit more complicated with nesting: + + let closeFd = ... + let f x = ... + case x of + _ -> Solo# closeFd + +The "natural" signature for the Solo# branch in `f` would be . +But we flatten this out to for the time being as it improves compile +time and there doesn't seem to huge benefit to doing differently. + + -} + +-- See Note [Constructor TagSigs] +inferConTag :: TagEnv p -> DataCon -> [StgArg] -> TagInfo +inferConTag env con args + | isUnboxedTupleDataCon con + = TagTuple $ map (flatten_arg_tag . lookupInfo env) args + | otherwise = + -- pprTrace "inferConTag" + -- ( text "con:" <> ppr con $$ + -- text "args:" <> ppr args $$ + -- text "marks:" <> ppr (dataConRuntimeRepStrictness con) $$ + -- text "arg_info:" <> ppr (map (lookupInfo env) args) $$ + -- text "info:" <> ppr info) $ + info + where + info = if any arg_needs_eval strictArgs then TagDunno else TagProper + strictArgs = zipEqual args (dataConRuntimeRepStrictness con) :: ([(StgArg, StrictnessMark)]) + arg_needs_eval (arg,strict) + -- lazy args + | not (isMarkedStrict strict) = False + | tag <- (lookupInfo env arg) + -- banged args need to be tagged, or require eval + = not (isTaggedInfo tag) + + flatten_arg_tag (TagTagged) = TagProper + flatten_arg_tag (TagProper ) = TagProper + flatten_arg_tag (TagTuple _) = TagDunno -- See Note [Constructor TagSigs] + flatten_arg_tag (TagDunno) = TagDunno + + +collectExportInfo :: [GenStgTopBinding 'InferTaggedBinders] -> NameEnv TagSig +collectExportInfo binds = + mkNameEnv bndr_info + where + bndr_info = concatMap collect binds :: [(Name,TagSig)] + + collect (StgTopStringLit {}) = [] + collect (StgTopLifted bnd) = + case bnd of + StgNonRec (id,sig) _rhs + | TagSig TagDunno <- sig -> [] + | otherwise -> [(idName id,sig)] + StgRec bnds -> collectRec bnds + + collectRec :: [(BinderP 'InferTaggedBinders, rhs)] -> [(Name,TagSig)] + collectRec [] = [] + collectRec (bnd:bnds) + | (p,_rhs) <- bnd + , (id,sig) <- p + , TagSig TagDunno <- sig + = (idName id,sig) : collectRec bnds + | otherwise = collectRec bnds diff --git a/GHC/Stg/EnforceEpt/Rewrite.hs b/GHC/Stg/EnforceEpt/Rewrite.hs new file mode 100644 --- /dev/null +++ b/GHC/Stg/EnforceEpt/Rewrite.hs @@ -0,0 +1,562 @@ + +-- Copyright (c) 2019 Andreas Klebinger +-- + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} + +module GHC.Stg.EnforceEpt.Rewrite (rewriteTopBinds, rewriteOpApp) +where + +import GHC.Prelude + +import GHC.Builtin.PrimOps ( PrimOp(..) ) +import GHC.Types.Basic ( CbvMark (..), isMarkedCbv + , TopLevelFlag(..), isTopLevel ) +import GHC.Types.Id +import GHC.Types.Name +import GHC.Types.Unique.Supply +import GHC.Types.Unique.FM +import GHC.Types.RepType +import GHC.Types.Var.Set +import GHC.Unit.Types + +import GHC.Core.DataCon +import GHC.Core ( AltCon(..) ) +import GHC.Core.Type + +import GHC.StgToCmm.Types +import GHC.StgToCmm.Closure (importedIdLFInfo) + +import GHC.Stg.Utils +import GHC.Stg.Syntax as StgSyn + +import GHC.Data.Maybe +import GHC.Utils.Panic + +import GHC.Utils.Outputable +import GHC.Utils.Monad.State.Strict +import GHC.Utils.Misc + +import GHC.Stg.EnforceEpt.Types + +import Control.Monad + +newtype RM a = RM { unRM :: (State (UniqFM Id TagSig, UniqSupply, Module, IdSet) a) } + deriving (Functor, Monad, Applicative) + +------------------------------------------------------------ +-- Add cases around strict fields where required. +------------------------------------------------------------ +{- +The work of this pass is simple: +* We traverse the STG AST looking for constructor allocations. +* For all allocations we check if there are strict fields in the constructor. +* For any strict field we check if the argument is known to be properly tagged. +* If it's not known to be properly tagged, we wrap the whole thing in a case, + which will force the argument before allocation. +This is described in detail in Note [Evaluated and Properly Tagged]. + +The only slight complication is that we have to make sure not to invalidate free +variable analysis in the process. + +Note [Partially applied workers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Sometimes we will get a function f of the form + -- Arity 1 + f :: Dict a -> a -> b -> (c -> d) + f dict a b = case dict of + C m1 m2 -> m1 a b + +Which will result in a W/W split along the lines of + -- Arity 1 + f :: Dict a -> a -> b -> (c -> d) + f dict a = case dict of + C m1 m2 -> $wf m1 a b + + -- Arity 4 + $wf :: (a -> b -> d -> c) -> a -> b -> c -> d + $wf m1 a b c = m1 a b c + +It's notable that the worker is called *undersaturated* in the wrapper. +At runtime what happens is that the wrapper will allocate a PAP which +once fully applied will call the worker. And all is fine. + +But what about a call by value function! Well the function returned by `f` would +be a unknown call, so we lose the ability to enforce the invariant that +cbv marked arguments from StictWorkerId's are actually properly tagged +as the annotations would be unavailable at the (unknown) call site. + +The fix is easy. We eta-expand all calls to functions taking call-by-value +arguments during CorePrep just like we do with constructor allocations. + +Note [Upholding free variable annotations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The code generator requires us to maintain exact information +about free variables about closures. Since we convert some +RHSs from constructor allocations to closures we have to provide +fvs of these closures. Not all constructor arguments will become +free variables. Only these which are not bound at the top level +have to be captured. +To facilitate this we keep track of a set of locally bound variables in +the current context which we then use to filter constructor arguments +when building the free variable list. +-} + +-------------------------------- +-- Utilities +-------------------------------- + +instance MonadUnique RM where + getUniqueSupplyM = RM $ do + (m, us, mod,lcls) <- get + let (us1, us2) = splitUniqSupply us + (put) (m,us2,mod,lcls) + return us1 + +getMap :: RM (UniqFM Id TagSig) +getMap = RM $ ((\(fst,_,_,_) -> fst) <$> get) + +setMap :: (UniqFM Id TagSig) -> RM () +setMap !m = RM $ do + (_,us,mod,lcls) <- get + put (m, us,mod,lcls) + +getMod :: RM Module +getMod = RM $ ( (\(_,_,thrd,_) -> thrd) <$> get) + +getFVs :: RM IdSet +getFVs = RM $ ((\(_,_,_,lcls) -> lcls) <$> get) + +setFVs :: IdSet -> RM () +setFVs !fvs = RM $ do + (tag_map,us,mod,_lcls) <- get + put (tag_map, us,mod,fvs) + +-- Rewrite the RHS(s) while making the id and it's sig available +-- to determine if things are tagged/need to be captured as FV. +withBind :: TopLevelFlag -> GenStgBinding 'InferTaggedBinders -> RM a -> RM a +withBind top_flag (StgNonRec bnd _) cont = withBinder top_flag bnd cont +withBind top_flag (StgRec binds) cont = do + let (bnds,_rhss) = unzip binds :: ([(Id, TagSig)], [GenStgRhs 'InferTaggedBinders]) + withBinders top_flag bnds cont + +addTopBind :: GenStgBinding 'InferTaggedBinders -> RM () +addTopBind (StgNonRec (id, tag) _) = do + s <- getMap + -- pprTraceM "AddBind" (ppr id) + setMap $ addToUFM s id tag + return () +addTopBind (StgRec binds) = do + let (bnds,_rhss) = unzip binds + !s <- getMap + -- pprTraceM "AddBinds" (ppr $ map fst bnds) + setMap $! addListToUFM s bnds + +withBinder :: TopLevelFlag -> (Id, TagSig) -> RM a -> RM a +withBinder top_flag (id,sig) cont = do + oldMap <- getMap + setMap $ addToUFM oldMap id sig + a <- if isTopLevel top_flag + then cont + else withLcl id cont + setMap oldMap + return a + +withBinders :: TopLevelFlag -> [(Id, TagSig)] -> RM a -> RM a +withBinders TopLevel sigs cont = do + oldMap <- getMap + setMap $ addListToUFM oldMap sigs + a <- cont + setMap oldMap + return a +withBinders NotTopLevel sigs cont = do + oldMap <- getMap + oldFvs <- getFVs + setMap $ addListToUFM oldMap sigs + setFVs $ extendVarSetList oldFvs (map fst sigs) + a <- cont + setMap oldMap + setFVs oldFvs + return a + +-- | Compute the argument with the given set of ids treated as requiring capture +-- as free variables. +withClosureLcls :: DIdSet -> RM a -> RM a +withClosureLcls fvs act = do + old_fvs <- getFVs + let !fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs + setFVs fvs' + !r <- act + setFVs old_fvs + return r + +-- | Compute the argument with the given id treated as requiring capture +-- as free variables in closures. +withLcl :: Id -> RM a -> RM a +withLcl fv act = do + old_fvs <- getFVs + let !fvs' = extendVarSet old_fvs fv + setFVs fvs' + !r <- act + setFVs old_fvs + return r + +{- Note [Tag inference for interactive contexts] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When compiling bytecode we call myCoreToStg to get STG code first. +myCoreToStg in turn calls out to stg2stg which runs the STG to STG +passes followed by free variables analysis and the tag inference pass including +its rewriting phase at the end. +Running tag inference is important as it upholds Note [Evaluated and Properly Tagged]. +While code executed by GHCi doesn't take advantage of the SFI it can call into +compiled code which does. So it must still make sure that the SFI is upheld. +See also #21083 and #22042. + +However there one important difference in code generation for GHCi and regular +compilation. When compiling an entire module (not a GHCi expression), we call +`stg2stg` on the entire module which allows us to build up a map which is guaranteed +to have an entry for every binder in the current module. +For non-interactive compilation the tag inference rewrite pass takes advantage +of this by building up a map from binders to their tag signatures. + +When compiling a GHCi expression on the other hand we invoke stg2stg separately +for each expression on the prompt. This means in GHCi for a sequence of: + > let x = True + > let y = StrictJust x +We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. + +While computing the tag signature for `y` during tag inference inferConTag will check +if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. +However since this mapping isn't persistent between stg2stg +invocations the lookup will fail. This isn't a correctness issue since it's always +safe to assume a binding isn't tagged and that's what we do in such cases. + +However for non-interactive mode we *don't* want to do this. Since in non-interactive mode +we have all binders of the module available for each invocation we can expect the binder->signature +mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup +indicates a bug in the tag inference implementation. +For this reason we assert that we are running in interactive mode if a lookup fails. +-} +isTagged :: Id -> RM Bool +isTagged v + -- See Note [Bottom functions are TagTagged] + | isDeadEndId v = pure False + | otherwise = do + this_mod <- getMod + -- See Note [Tag inference for interactive contexts] + let lookupDefault v = assertPpr (isInteractiveModule this_mod) + (text "unknown Id:" <> ppr this_mod <+> ppr v) + (TagSig TagDunno) + case nameIsLocalOrFrom this_mod (idName v) of + True + | definitelyUnliftedType (idType v) + -- NB: v might be the Id of a representation-polymorphic join point, + -- so we shouldn't use isUnliftedType here. See T22212. + -> return True + | otherwise -> do -- Local binding + !s <- getMap + let !sig = lookupWithDefaultUFM s (lookupDefault v) v + return $ case sig of + TagSig info -> + case info of + TagDunno -> False + TagProper -> True + TagTagged -> True + TagTuple _ -> True -- Consider unboxed tuples tagged. + -- Imported + False -> return $! + -- Determine whether it is tagged from the LFInfo of the imported id. + -- See Note [The LFInfo of Imported Ids] + case importedIdLFInfo v of + -- Function, applied not entered. + LFReEntrant {} + -> True + -- Thunks need to be entered. + LFThunk {} + -> False + -- LFCon means we already know the tag, and it's tagged. + LFCon {} + -> True + LFUnknown {} + -> False + LFUnlifted {} + -> True + LFLetNoEscape {} + -- Shouldn't be possible. I don't think we can export letNoEscapes + -> True + + +isArgTagged :: StgArg -> RM Bool +isArgTagged (StgLitArg _) = return True +isArgTagged (StgVarArg v) = isTagged v + +mkLocalArgId :: Id -> RM Id +mkLocalArgId id = do + !u <- getUniqueM + return $! setIdUnique (localiseId id) u + +--------------------------- +-- Actual rewrite pass +--------------------------- + + +rewriteTopBinds :: Module -> UniqSupply -> [GenStgTopBinding 'InferTaggedBinders] -> [TgStgTopBinding] +rewriteTopBinds mod us binds = + let doBinds = mapM rewriteTop binds + + in evalState (unRM doBinds) (mempty, us, mod, mempty) + +rewriteTop :: InferStgTopBinding -> RM TgStgTopBinding +rewriteTop (StgTopStringLit v s) = return $! (StgTopStringLit v s) +rewriteTop (StgTopLifted bind) = do + -- Top level bindings can, and must remain in scope + addTopBind bind + (StgTopLifted) <$!> (rewriteBinds TopLevel bind) + +-- For top level binds, the wrapper is guaranteed to be `id` +rewriteBinds :: TopLevelFlag -> InferStgBinding -> RM (TgStgBinding) +rewriteBinds _top_flag (StgNonRec v rhs) = do + (!rhs) <- rewriteRhs v rhs + return $! (StgNonRec (fst v) rhs) +rewriteBinds top_flag b@(StgRec binds) = + -- Bring sigs of binds into scope for all rhss + withBind top_flag b $ do + (rhss) <- mapM (uncurry rewriteRhs) binds + return $! (mkRec rhss) + where + mkRec :: [TgStgRhs] -> TgStgBinding + mkRec rhss = StgRec (zip (map (fst . fst) binds) rhss) + +-- Rewrite a RHS +rewriteRhs :: (Id,TagSig) -> InferStgRhs + -> RM (TgStgRhs) +rewriteRhs (_id, _tagSig) (StgRhsCon ccs con cn ticks args typ) = {-# SCC rewriteRhs_ #-} do + -- pprTraceM "rewriteRhs" (ppr _id) + + -- Look up the nodes representing the constructor arguments. + fieldInfos <- mapM isArgTagged args + + -- Filter out non-strict fields. + let strictFields = + getStrictConArgs con (zip args fieldInfos) :: [(StgArg,Bool)] -- (nth-argument, tagInfo) + -- Filter out already tagged arguments. + let needsEval = map fst . --get the actual argument + filter (not . snd) $ -- Keep untagged (False) elements. + strictFields :: [StgArg] + let evalArgs = [v | StgVarArg v <- needsEval] :: [Id] + + if (null evalArgs) + then return $! (StgRhsCon ccs con cn ticks args typ) + else do + --assert not (isTaggedSig tagSig) + -- pprTraceM "CreatingSeqs for " $ ppr _id <+> ppr node_id + + -- At this point iff we have possibly untagged arguments to strict fields + -- we convert the RHS into a RhsClosure which will evaluate the arguments + -- before allocating the constructor. + let ty_stub = panic "mkSeqs shouldn't use the type arg" + conExpr <- mkSeqs args evalArgs (\taggedArgs -> StgConApp con cn taggedArgs ty_stub) + + fvs <- fvArgs args + -- lcls <- getFVs + -- pprTraceM "RhsClosureConversion" (ppr (StgRhsClosure fvs ccs ReEntrant [] $! conExpr) $$ text "lcls:" <> ppr lcls) + + -- We mark the closure updatable to retain sharing in the case that + -- conExpr is an infinite recursive data type. See #23783. + return $! (StgRhsClosure fvs ccs Updatable [] $! conExpr) typ +rewriteRhs _binding (StgRhsClosure fvs ccs flag args body typ) = do + withBinders NotTopLevel args $ + withClosureLcls fvs $ + StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr body <*> pure typ + -- return (closure) + +fvArgs :: [StgArg] -> RM DVarSet +fvArgs args = do + fv_lcls <- getFVs + -- pprTraceM "fvArgs" (text "args:" <> ppr args $$ text "lcls:" <> pprVarSet (fv_lcls) (braces . fsep . map ppr) ) + return $ mkDVarSet [ v | StgVarArg v <- args, elemVarSet v fv_lcls] + +rewriteArgs :: [StgArg] -> RM [StgArg] +rewriteArgs = mapM rewriteArg +rewriteArg :: StgArg -> RM StgArg +rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v +rewriteArg (lit@StgLitArg{}) = return lit + +rewriteId :: Id -> RM Id +rewriteId v = do + !is_tagged <- isTagged v + if is_tagged then return $! setIdTagSig v (TagSig TagProper) + else return v + +rewriteExpr :: GenStgExpr 'InferTaggedBinders -> RM (GenStgExpr 'CodeGen) +rewriteExpr (e@StgCase {}) = rewriteCase e +rewriteExpr (e@StgLet {}) = rewriteLet e +rewriteExpr (e@StgLetNoEscape {}) = rewriteLetNoEscape e +rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e +rewriteExpr e@(StgConApp {}) = rewriteConApp e +rewriteExpr e@(StgApp {}) = rewriteApp e +rewriteExpr (StgLit lit) = return $! (StgLit lit) +rewriteExpr (StgOpApp op args res_ty) = (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty + + +rewriteCase :: InferStgExpr -> RM TgStgExpr +rewriteCase (StgCase scrut bndr alt_type alts) = + withBinder NotTopLevel bndr $ + pure StgCase <*> + rewriteExpr scrut <*> + rewriteId (fst bndr) <*> + pure alt_type <*> + mapM rewriteAlt alts + +rewriteCase _ = panic "Impossible: nodeCase" + +rewriteAlt :: InferStgAlt -> RM TgStgAlt +rewriteAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} = + withBinders NotTopLevel bndrs $ do + !rhs' <- rewriteExpr rhs + return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'} + +rewriteLet :: InferStgExpr -> RM TgStgExpr +rewriteLet (StgLet xt bind expr) = do + (!bind') <- rewriteBinds NotTopLevel bind + withBind NotTopLevel bind $ do + -- pprTraceM "withBindLet" (ppr $ bindersOfX bind) + !expr' <- rewriteExpr expr + return $! (StgLet xt bind' expr') +rewriteLet _ = panic "Impossible" + +rewriteLetNoEscape :: InferStgExpr -> RM TgStgExpr +rewriteLetNoEscape (StgLetNoEscape xt bind expr) = do + (!bind') <- rewriteBinds NotTopLevel bind + withBind NotTopLevel bind $ do + !expr' <- rewriteExpr expr + return $! (StgLetNoEscape xt bind' expr') +rewriteLetNoEscape _ = panic "Impossible" + +rewriteConApp :: InferStgExpr -> RM TgStgExpr +rewriteConApp (StgConApp con cn args tys) = do + -- We check if the strict field arguments are already known to be tagged. + -- If not we evaluate them first. + fieldInfos <- mapM isArgTagged args + let strictIndices = getStrictConArgs con (zip fieldInfos args) :: [(Bool, StgArg)] + let needsEval = map snd . filter (not . fst) $ strictIndices :: [StgArg] + let evalArgs = [v | StgVarArg v <- needsEval] :: [Id] + if (not $ null evalArgs) + then do + -- pprTraceM "Creating conAppSeqs for " $ ppr nodeId <+> parens ( ppr evalArgs ) -- <+> parens ( ppr fieldInfos ) + mkSeqs args evalArgs (\taggedArgs -> StgConApp con cn taggedArgs tys) + else return $! (StgConApp con cn args tys) + +rewriteConApp _ = panic "Impossible" + +-- Special case: Atomic binders, usually in a case context like `case f of ...`. +rewriteApp :: InferStgExpr -> RM TgStgExpr +rewriteApp (StgApp f []) = do + f' <- rewriteId f + return $! StgApp f' [] +rewriteApp (StgApp f args) + -- pprTrace "rewriteAppOther" (ppr f <+> ppr args) False + -- = undefined + | Just marks <- idCbvMarks_maybe f + , relevant_marks <- dropWhileEndLE (not . isMarkedCbv) marks + , any isMarkedCbv relevant_marks + = assertPpr (length relevant_marks <= length args) (ppr f $$ ppr args $$ ppr relevant_marks) + unliftArg relevant_marks + + where + -- If the function expects any argument to be call-by-value ensure the argument is already + -- evaluated. + unliftArg relevant_marks = do + argTags <- mapM isArgTagged args + let argInfo = zipWith3 ((,,)) args (relevant_marks++repeat NotMarkedCbv) argTags :: [(StgArg, CbvMark, Bool)] + + -- untagged cbv argument positions + cbvArgInfo = filter (\x -> sndOf3 x == MarkedCbv && thdOf3 x == False) argInfo + cbvArgIds = [x | StgVarArg x <- map fstOf3 cbvArgInfo] :: [Id] + mkSeqs args cbvArgIds (\cbv_args -> StgApp f cbv_args) + +rewriteApp (StgApp f args) = return $ StgApp f args +rewriteApp _ = panic "Impossible" + +{- +Note [Rewriting primop arguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Given an application `op# x y`, is it worth applying `rewriteArg` to +`x` and `y`? All that will do will be to set the `tagSig` for that +occurrence of `x` and `y` to record whether it is evaluated and +properly tagged. For the vast majority of primops that's a waste of +time: the argument is an `Int#` or something. + +But code generation for `seq#` and the `dataToTag#` ops /does/ consult that +tag, to statically avoid generating an eval. All three do so via `cgIdApp`, +which in turn uses `getCallMethod` which looks at the `tagSig`. + +So for these we should call `rewriteArgs`. + +-} + +rewriteOpApp :: InferStgExpr -> RM TgStgExpr +rewriteOpApp (StgOpApp op args res_ty) = case op of + op@(StgPrimOp primOp) + | primOp == DataToTagSmallOp || primOp == DataToTagLargeOp + -- see Note [Rewriting primop arguments] + -> (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty + _ -> pure $! StgOpApp op args res_ty +rewriteOpApp _ = panic "Impossible" + +-- `mkSeq` x x' e generates `case x of x' -> e` +-- We could also substitute x' for x in e but that's so rarely beneficial +-- that we don't bother. +mkSeq :: Id -> Id -> TgStgExpr -> TgStgExpr +mkSeq id bndr !expr = + -- pprTrace "mkSeq" (ppr (id,bndr)) $ + let altTy = mkStgAltTypeFromStgAlts bndr alt + alt = [GenStgAlt {alt_con = DEFAULT, alt_bndrs = [], alt_rhs = expr}] + in StgCase (StgApp id []) bndr altTy alt + +-- `mkSeqs args vs mkExpr` will force all vs, and construct +-- an argument list args' where each v is replaced by it's evaluated +-- counterpart v'. +-- That is if we call `mkSeqs [StgVar x, StgLit l] [x] mkExpr` then +-- the result will be (case x of x' { _DEFAULT -> } +{-# INLINE mkSeqs #-} -- We inline to avoid allocating mkExpr +mkSeqs :: [StgArg] -- ^ Original arguments + -> [Id] -- ^ var args to be evaluated ahead of time + -> ([StgArg] -> TgStgExpr) + -- ^ Function that reconstructs the expressions when passed + -- the list of evaluated arguments. + -> RM TgStgExpr +mkSeqs args untaggedIds mkExpr = do + argMap <- mapM (\arg -> (arg,) <$> mkLocalArgId arg ) untaggedIds :: RM [(InId, OutId)] + -- mapM_ (pprTraceM "Forcing strict args before allocation:" . ppr) argMap + let taggedArgs :: [StgArg] + = map (\v -> case v of + StgVarArg v' -> StgVarArg $ fromMaybe v' $ lookup v' argMap + lit -> lit) + args + + let conBody = mkExpr taggedArgs + let body = foldr (\(v,bndr) expr -> mkSeq v bndr expr) conBody argMap + return $! body + +-- Out of all arguments passed at runtime only return these ending up in a +-- strict field +getStrictConArgs :: Outputable a => DataCon -> [a] -> [a] +getStrictConArgs con args + -- These are always lazy in their arguments. + | isUnboxedTupleDataCon con = [] + | isUnboxedSumDataCon con = [] + -- For proper data cons we have to check. + | otherwise = + assertPpr (length args == length (dataConRuntimeRepStrictness con)) + (text "Mismatched con arg and con rep strictness lengths:" $$ + text "Con" <> ppr con <+> text "is applied to" <+> ppr args $$ + text "But seems to have arity" <> ppr (length repStrictness)) $ + [ arg | (arg,MarkedStrict) + <- zipEqual args + repStrictness] + where + repStrictness = (dataConRuntimeRepStrictness con) diff --git a/GHC/Stg/EnforceEpt/TagSig.hs b/GHC/Stg/EnforceEpt/TagSig.hs new file mode 100644 --- /dev/null +++ b/GHC/Stg/EnforceEpt/TagSig.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} + +-- We export this type from this module instead of GHC.Stg.EnforceEpt.Types +-- because it's used by more than the analysis itself. For example in interface +-- files where we record a tag signature for bindings. +-- By putting the sig into its own module we can avoid module loops. +module GHC.Stg.EnforceEpt.TagSig + +where + +import GHC.Prelude + +import GHC.Types.Var +import GHC.Types.Name.Env( NameEnv ) +import GHC.Utils.Outputable +import GHC.Utils.Binary +import GHC.Utils.Panic.Plain +import Data.Coerce + +-- | Information to be exposed in interface files which is produced +-- by the stg2stg passes. +type StgCgInfos = NameEnv TagSig + +newtype TagSig -- The signature for each binding, this is a newtype as we might + -- want to track more information in the future. + = TagSig TagInfo + deriving (Eq) + +data TagInfo + = TagDunno -- We don't know anything about the tag. + | TagTuple [TagInfo] -- Represents a function/thunk which when evaluated + -- will return a Unboxed tuple whos components have + -- the given TagInfos. + | TagProper -- Heap pointer to properly-tagged value + | TagTagged -- Bottom of the domain. + deriving (Eq) + +instance Outputable TagInfo where + ppr TagTagged = text "TagTagged" + ppr TagDunno = text "TagDunno" + ppr TagProper = text "TagProper" + ppr (TagTuple tis) = text "TagTuple" <> brackets (pprWithCommas ppr tis) + +instance Binary TagInfo where + put_ bh TagDunno = putByte bh 1 + put_ bh (TagTuple flds) = putByte bh 2 >> put_ bh flds + put_ bh TagProper = putByte bh 3 + put_ bh TagTagged = putByte bh 4 + + get bh = do tag <- getByte bh + case tag of 1 -> return TagDunno + 2 -> TagTuple <$> get bh + 3 -> return TagProper + 4 -> return TagTagged + _ -> panic ("get TagInfo " ++ show tag) + +instance Outputable TagSig where + ppr (TagSig ti) = char '<' <> ppr ti <> char '>' +instance OutputableBndr (Id,TagSig) where + pprInfixOcc = ppr + pprPrefixOcc = ppr + +instance Binary TagSig where + put_ bh (TagSig sig) = put_ bh sig + get bh = pure TagSig <*> get bh + +isTaggedSig :: TagSig -> Bool +isTaggedSig (TagSig TagProper) = True +isTaggedSig (TagSig TagTagged) = True +isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis diff --git a/GHC/Stg/EnforceEpt/Types.hs b/GHC/Stg/EnforceEpt/Types.hs new file mode 100644 --- /dev/null +++ b/GHC/Stg/EnforceEpt/Types.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} + +{-# LANGUAGE UndecidableInstances #-} + -- To permit: type instance XLet 'InferTaggedBinders = XLet 'CodeGen + +module GHC.Stg.EnforceEpt.Types + ( module GHC.Stg.EnforceEpt.Types + , module TagSig) +where + +import GHC.Prelude + +import GHC.Core.DataCon +import GHC.Core.Type (isUnliftedType) +import GHC.Types.Id +import GHC.Stg.Syntax +import GHC.Stg.EnforceEpt.TagSig as TagSig +import GHC.Types.Var.Env +import GHC.Utils.Outputable +import GHC.Utils.Misc( zipWithEqual ) +import GHC.Utils.Panic + +import GHC.StgToCmm.Types + +{- ********************************************************************* +* * + Supporting data types +* * +********************************************************************* -} + +type InferStgTopBinding = GenStgTopBinding 'InferTaggedBinders +type InferStgBinding = GenStgBinding 'InferTaggedBinders +type InferStgExpr = GenStgExpr 'InferTaggedBinders +type InferStgRhs = GenStgRhs 'InferTaggedBinders +type InferStgAlt = GenStgAlt 'InferTaggedBinders + +combineAltInfo :: TagInfo -> TagInfo -> TagInfo +combineAltInfo TagDunno _ = TagDunno +combineAltInfo _ TagDunno = TagDunno +combineAltInfo (TagTuple {}) TagProper = TagDunno -- This can happen with rep-polymorphic result, see #26107 +combineAltInfo TagProper (TagTuple {}) = TagDunno -- This can happen with rep-polymorphic result, see #26107 +combineAltInfo TagProper TagProper = TagProper +combineAltInfo (TagTuple is1) (TagTuple is2) = TagTuple (zipWithEqual combineAltInfo is1 is2) +combineAltInfo (TagTagged) ti = ti +combineAltInfo ti TagTagged = ti + +type TagSigEnv = IdEnv TagSig +data TagEnv p = TE { te_env :: TagSigEnv + , te_get :: BinderP p -> Id + , te_bytecode :: !Bool + } + +instance Outputable (TagEnv p) where + ppr te = for_txt <+> ppr (te_env te) + where + for_txt = if te_bytecode te + then text "for_bytecode" + else text "for_native" + +getBinderId :: TagEnv p -> BinderP p -> Id +getBinderId = te_get + +initEnv :: Bool -> TagEnv 'CodeGen +initEnv for_bytecode = TE { te_env = emptyVarEnv + , te_get = \x -> x + , te_bytecode = for_bytecode } + +-- | Simple convert env to a env of the 'InferTaggedBinders pass +-- with no other changes. +makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders +makeTagged env = TE { te_env = te_env env + , te_get = fst + , te_bytecode = te_bytecode env } + +noSig :: TagEnv p -> BinderP p -> (Id, TagSig) +noSig env bndr + | isUnliftedType (idType var) = (var, TagSig TagProper) + | otherwise = (var, TagSig TagDunno) + where + var = getBinderId env bndr + +-- | Look up a sig in the given env +lookupSig :: TagEnv p -> Id -> Maybe TagSig +lookupSig env fun = lookupVarEnv (te_env env) fun + +-- | Look up a sig in the env or derive it from information +-- in the arg itself. +lookupInfo :: TagEnv p -> StgArg -> TagInfo +lookupInfo env (StgVarArg var) + -- Nullary data constructors like True, False + | Just dc <- isDataConWorkId_maybe var + , isNullaryRepDataCon dc + , not for_bytecode + = TagProper + + | isUnliftedType (idType var) + = TagProper + + -- Variables in the environment. + | Just (TagSig info) <- lookupVarEnv (te_env env) var + = info + + | Just lf_info <- idLFInfo_maybe var + , not for_bytecode + = case lf_info of + -- Function, tagged (with arity) + LFReEntrant {} + -> TagProper + -- Thunks need to be entered. + LFThunk {} + -> TagDunno + -- Constructors, already tagged. + LFCon {} + -> TagProper + LFUnknown {} + -> TagDunno + LFUnlifted {} + -> TagProper + -- Shouldn't be possible. I don't think we can export letNoEscapes + LFLetNoEscape {} -> panic "LFLetNoEscape exported" + + | otherwise + = TagDunno + where + for_bytecode = te_bytecode env + +lookupInfo _ (StgLitArg {}) + = TagProper + +isDunnoSig :: TagSig -> Bool +isDunnoSig (TagSig TagDunno) = True +isDunnoSig (TagSig TagProper) = False +isDunnoSig (TagSig TagTuple{}) = False +isDunnoSig (TagSig TagTagged{}) = False + +isTaggedInfo :: TagInfo -> Bool +isTaggedInfo TagProper = True +isTaggedInfo TagTagged = True +isTaggedInfo _ = False + +extendSigEnv :: TagEnv p -> [(Id,TagSig)] -> TagEnv p +extendSigEnv env@(TE { te_env = sig_env }) bndrs + = env { te_env = extendVarEnvList sig_env bndrs } diff --git a/GHC/Stg/FVs.hs b/GHC/Stg/FVs.hs --- a/GHC/Stg/FVs.hs +++ b/GHC/Stg/FVs.hs @@ -257,8 +257,8 @@ , let lcl_fvs' = unionDVarSet (tickish tick) lcl_fvs = (StgTick tick e', imp_fvs, top_fvs, lcl_fvs') where - tickish (Breakpoint _ _ ids _) = mkDVarSet ids - tickish _ = emptyDVarSet + tickish (Breakpoint _ _ ids) = mkDVarSet ids + tickish _ = emptyDVarSet go_bind dc bind body = (dc bind' body', imp_fvs, top_fvs, lcl_fvs) where diff --git a/GHC/Stg/InferTags.hs b/GHC/Stg/InferTags.hs deleted file mode 100644 --- a/GHC/Stg/InferTags.hs +++ /dev/null @@ -1,675 +0,0 @@ -{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} - -- To permit: type instance XLet 'InferTaggedBinders = XLet 'SomePass - -{-# OPTIONS_GHC -Wname-shadowing #-} -module GHC.Stg.InferTags ( inferTags ) where - -import GHC.Prelude hiding (id) - -import GHC.Core.DataCon -import GHC.Core.Type -import GHC.Types.Id -import GHC.Types.Id.Info (tagSigInfo) -import GHC.Types.Name -import GHC.Stg.Syntax -import GHC.Types.Basic ( CbvMark (..) ) -import GHC.Types.Demand (isDeadEndAppSig) -import GHC.Types.Unique.Supply (mkSplitUniqSupply) -import GHC.Types.RepType (dataConRuntimeRepStrictness) -import GHC.Core (AltCon(..)) -import Data.List (mapAccumL) -import GHC.Utils.Outputable -import GHC.Utils.Misc( zipWithEqual, zipEqual, notNull ) - -import GHC.Stg.InferTags.Types -import GHC.Stg.InferTags.Rewrite (rewriteTopBinds) -import Data.Maybe -import GHC.Types.Name.Env (mkNameEnv, NameEnv) -import GHC.Driver.DynFlags -import GHC.Utils.Logger -import qualified GHC.Unit.Types - -{- Note [Tag Inference] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The purpose of this pass is to attach to every binder a flag -to indicate whether or not it is "properly tagged". A binder -is properly tagged if it is guaranteed: - - to point to a heap-allocated *value* - - and to have the tag of the value encoded in the pointer - -For example - let x = Just y in ... - -Here x will be properly tagged: it will point to the heap-allocated -values for (Just y), and the tag-bits of the pointer will encode -the tag for Just so there is no need to re-enter the closure or even -check for the presence of tag bits. The impacts of this can be very large. - -For containers the reduction in runtimes with this optimization was as follows: - -intmap-benchmarks: 89.30% -intset-benchmarks: 90.87% -map-benchmarks: 88.00% -sequence-benchmarks: 99.84% -set-benchmarks: 85.00% -set-operations-intmap:88.64% -set-operations-map: 74.23% -set-operations-set: 76.50% -lookupge-intmap: 89.57% -lookupge-map: 70.95% - -With nofib being ~0.3% faster as well. - -See Note [Tag inference passes] for how we proceed to generate and use this information. - -Note [Strict Field Invariant] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As part of tag inference we introduce the Strict Field Invariant. -Which consists of us saying that: - -* Pointers in strict fields must (a) point directly to the value, and - (b) must be properly tagged. - -For example, given - data T = MkT ![Int] - -the Strict Field Invariant guarantees that the first field of any `MkT` constructor -will either point directly to nil, or directly to a cons cell; -and will be tagged with `001` or `010` respectively. -It will never point to a thunk, nor will it be tagged `000` (meaning "might be a thunk"). -NB: Note that the proper tag for some objects is indeed `000`. Currently this is the case for PAPs. - -This works analogous to how `WorkerLikeId`s work. See also Note [CBV Function Ids]. - -Why do we care? Because if we have code like: - -case strictPair of - SP x y -> - case x of ... - -It allows us to safely omit the code to enter x and the check -for the presence of a tag that goes along with it. -However we might still branch on the tag as usual. -See Note [Tag Inference] for how much impact this can have for -some code. - -This is enforced by the code GHC.Stg.InferTags.Rewrite -where we: - -* Look at all constructor allocations. -* Check if arguments to their strict fields are known to be properly tagged -* If not we convert `StrictJust x` into `case x of x' -> StrictJust x'` - -This is usually very beneficial but can cause regressions in rare edge cases where -we fail to proof that x is properly tagged, or where it simply isn't. -See Note [How untagged pointers can end up in strict fields] for how the second case -can arise. - -For a full example of the worst case consider this code: - -foo ... = ... - let c = StrictJust x - in ... - -Here we would rewrite `let c = StrictJust x` into `let c = case x of x' -> StrictJust x'` -However that is horrible! We end up allocating a thunk for `c` first, which only when -evaluated will allocate the constructor. - -So we do our best to establish that `x` is already tagged (which it almost always is) -to avoid this cost. In my benchmarks I haven't seen any cases where this causes regressions. - -Note that there are similar constraints around Note [CBV Function Ids]. - -Note [How untagged pointers can end up in strict fields] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - data Set a = Tip | Bin !a (Set a) (Set a) - -We make a wrapper for Bin that evaluates its arguments - $WBin x a b = case x of xv -> Bin xv a b -Here `xv` will always be evaluated and properly tagged, just as the -Strict Field Invariant requires. - -But alas the Simplifier can destroy the invariant: see #15696. -We start with - thk = f () - g x = ...(case thk of xv -> Bin xv Tip Tip)... - -So far so good; the argument to Bin (which is strict) is evaluated. -Now we do float-out. And in doing so we do a reverse binder-swap (see -Note [Binder-swap during float-out] in SetLevels) thus - - g x = ...(case thk of xv -> Bin thk Nil Nil)... - -The goal of the reverse binder-swap is to allow more floating -- and -indeed it does! We float the Bin to top level: - - lvl = Bin thk Tip Tip - g x = ...(case thk of xv -> lvl)... - -Now you can see that the argument of Bin, namely thk, points to the -thunk, not to the value as it did before. - -In short, although it may be rare, the output of optimisation passes -cannot guarantee to obey the Strict Field Invariant. For this reason -we run tag inference. See Note [Tag inference passes]. - -Note [Tag inference passes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Tag inference proceeds in two passes: -* The first pass is an analysis to compute which binders are properly tagged. - The result is then attached to /binders/. - This is implemented by `inferTagsAnal` in GHC.Stg.InferTags -* The second pass walks over the AST checking if the Strict Field Invariant is upheld. - See Note [Strict Field Invariant]. - If required this pass modifies the program to uphold this invariant. - Tag information is also moved from /binders/ to /occurrences/ during this pass. - This is done by `GHC.Stg.InferTags.Rewrite (rewriteTopBinds)`. -* Finally the code generation uses this information to skip the thunk check when branching on - values. This is done by `cgExpr`/`cgCase` in the backend. - -Last but not least we also export the tag sigs of top level bindings to allow this optimization - to work across module boundaries. - -Note [TagInfo of functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The purpose of tag inference is really to figure out when we don't have to enter -value closures. There the meaning of the tag is fairly obvious. -For functions we never make use of the tag info so we have two choices: -* Treat them as TagDunno -* Treat them as TagProper (as they *are* tagged with their arity) and be really - careful to make sure we still enter them when needed. -As it makes little difference for runtime performance I've treated functions as TagDunno in a few places where -it made the code simpler. But besides implementation complexity there isn't any reason -why we couldn't be more rigorous in dealing with functions. - -NB: It turned in #21193 that PAPs get tag zero, so the tag check can't be omitted for functions. -So option two isn't really an option without reworking this anyway. - -Note [Tag inference debugging] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -There is a flag -dtag-inference-checks which inserts various -compile/runtime checks in order to ensure the Strict Field Invariant -holds. It should cover all places -where tags matter and disable optimizations which interfere with checking -the invariant like generation of AP-Thunks. - -Note [Polymorphic StgPass for inferTagExpr] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In order to reach a fixpoint we sometimes have to re-analyse an expression -multiple times. But after the initial run the Ast will be parameterized by -a different StgPass! To handle this a large part of the analysis is polymorphic -over the exact StgPass we are using. Which allows us to run the analysis on -the output of itself. - -Note [Tag inference for interpreted code] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The bytecode interpreter has a different behaviour when it comes -to the tagging of binders in certain situations than the StgToCmm code generator. - -a) Tags for let-bindings: - - When compiling a binding for a constructor like `let x = Just True` - Whether `x` will be properly tagged depends on the backend. - For the interpreter x points to a BCO which once - evaluated returns a properly tagged pointer to the heap object. - In the Cmm backend for the same binding we would allocate the constructor right - away and x will immediately be represented by a tagged pointer. - This means for interpreted code we can not assume let bound constructors are - properly tagged. Hence we distinguish between targeting bytecode and native in - the analysis. - We make this differentiation in `mkLetSig` where we simply never assume - lets are tagged when targeting bytecode. - -b) When referencing ids from other modules the Cmm backend will try to put a - proper tag on these references through various means. When doing analysis we - usually predict these cases to improve precision of the analysis. - But to my knowledge the bytecode generator makes no such attempts so we must - not infer imported bindings as tagged. - This is handled in GHC.Stg.InferTags.Types.lookupInfo - - --} - -{- ********************************************************************* -* * - Tag inference pass -* * -********************************************************************* -} - -inferTags :: StgPprOpts -> Bool -> Logger -> (GHC.Unit.Types.Module) -> [CgStgTopBinding] -> IO ([TgStgTopBinding], NameEnv TagSig) -inferTags ppr_opts !for_bytecode logger this_mod stg_binds = do - -- pprTraceM "inferTags for " (ppr this_mod <> text " bytecode:" <> ppr for_bytecode) - -- Annotate binders with tag information. - let (!stg_binds_w_tags) = {-# SCC "StgTagFields" #-} - inferTagsAnal for_bytecode stg_binds - putDumpFileMaybe logger Opt_D_dump_stg_tags "CodeGenAnal STG:" FormatSTG (pprGenStgTopBindings ppr_opts stg_binds_w_tags) - - let export_tag_info = collectExportInfo stg_binds_w_tags - - -- Rewrite STG to uphold the strict field invariant - us_t <- mkSplitUniqSupply 't' - let rewritten_binds = {-# SCC "StgTagRewrite" #-} rewriteTopBinds this_mod us_t stg_binds_w_tags :: [TgStgTopBinding] - - return (rewritten_binds,export_tag_info) - -{- ********************************************************************* -* * - Main inference algorithm -* * -********************************************************************* -} - -type OutputableInferPass p = (Outputable (TagEnv p) - , Outputable (GenStgExpr p) - , Outputable (BinderP p) - , Outputable (GenStgRhs p)) - --- | This constraint encodes the fact that no matter what pass --- we use the Let/Closure extension points are the same as these for --- 'InferTaggedBinders. -type InferExtEq i = ( XLet i ~ XLet 'InferTaggedBinders - , XLetNoEscape i ~ XLetNoEscape 'InferTaggedBinders - , XRhsClosure i ~ XRhsClosure 'InferTaggedBinders) - -inferTagsAnal :: Bool -> [GenStgTopBinding 'CodeGen] -> [GenStgTopBinding 'InferTaggedBinders] -inferTagsAnal for_bytecode binds = - -- pprTrace "Binds" (pprGenStgTopBindings shortStgPprOpts $ binds) $ - snd (mapAccumL inferTagTopBind (initEnv for_bytecode) binds) - ------------------------ -inferTagTopBind :: TagEnv 'CodeGen -> GenStgTopBinding 'CodeGen - -> (TagEnv 'CodeGen, GenStgTopBinding 'InferTaggedBinders) -inferTagTopBind env (StgTopStringLit id bs) - = (env, StgTopStringLit id bs) -inferTagTopBind env (StgTopLifted bind) - = (env', StgTopLifted bind') - where - (env', bind') = inferTagBind env bind - - --- Why is this polymorphic over the StgPass? See Note [Polymorphic StgPass for inferTagExpr] ------------------------ -inferTagExpr :: forall p. (OutputableInferPass p, InferExtEq p) - => TagEnv p -> GenStgExpr p -> (TagInfo, GenStgExpr 'InferTaggedBinders) -inferTagExpr env (StgApp fun args) - = --pprTrace "inferTagExpr1" - -- (ppr fun <+> ppr args $$ ppr info $$ - -- text "deadEndInfo:" <> ppr (isDeadEndId fun, idArity fun, length args) - -- ) - (info, StgApp fun args) - where - !fun_arity = idArity fun - info - -- It's important that we check for bottoms before all else. - -- See Note [Bottom functions are TagTagged] and #24806 for why. - | isDeadEndAppSig (idDmdSig fun) (length args) - = TagTagged - - | fun_arity == 0 -- Unknown arity => Thunk or unknown call - = TagDunno - - | Just (TagSig res_info) <- tagSigInfo (idInfo fun) - , fun_arity == length args -- Saturated - = res_info - - | Just (TagSig res_info) <- lookupSig env fun - , fun_arity == length args -- Saturated - = res_info - - | otherwise - = --pprTrace "inferAppUnknown" (ppr fun) $ - TagDunno - -inferTagExpr env (StgConApp con cn args tys) - = (inferConTag env con args, StgConApp con cn args tys) - -inferTagExpr _ (StgLit l) - = (TagTagged, StgLit l) - -inferTagExpr env (StgTick tick body) - = (info, StgTick tick body') - where - (info, body') = inferTagExpr env body - -inferTagExpr _ (StgOpApp op args ty) - -- Which primops guarantee to return a properly tagged value? - -- Probably none, and that is the conservative assumption anyway. - -- (And foreign calls definitely need not make promises.) - = (TagDunno, StgOpApp op args ty) - -inferTagExpr env (StgLet ext bind body) - = (info, StgLet ext bind' body') - where - (env', bind') = inferTagBind env bind - (info, body') = inferTagExpr env' body - -inferTagExpr env (StgLetNoEscape ext bind body) - = (info, StgLetNoEscape ext bind' body') - where - (env', bind') = inferTagBind env bind - (info, body') = inferTagExpr env' body - -inferTagExpr in_env (StgCase scrut bndr ty alts) - -- Unboxed tuples get their info from the expression we scrutinise if any - | [GenStgAlt{alt_con=DataAlt con, alt_bndrs=bndrs, alt_rhs=rhs}] <- alts - , isUnboxedTupleDataCon con - , Just infos <- scrut_infos bndrs - , let bndrs' = zipWithEqual "inferTagExpr" mk_bndr bndrs infos - mk_bndr :: BinderP p -> TagInfo -> (Id, TagSig) - mk_bndr tup_bndr tup_info = - -- pprTrace "mk_ubx_bndr_info" ( ppr bndr <+> ppr info ) $ - (getBinderId in_env tup_bndr, TagSig tup_info) - -- no case binder in alt_env here, unboxed tuple binders are dead after unarise - alt_env = extendSigEnv in_env bndrs' - (info, rhs') = inferTagExpr alt_env rhs - = - -- pprTrace "inferCase1" ( - -- text "scrut:" <> ppr scrut $$ - -- text "bndr:" <> ppr bndr $$ - -- text "infos" <> ppr infos $$ - -- text "out_bndrs" <> ppr bndrs') $ - (info, StgCase scrut' (noSig in_env bndr) ty [GenStgAlt{ alt_con=DataAlt con - , alt_bndrs=bndrs' - , alt_rhs=rhs'}]) - - | null alts -- Empty case, but I might just be paranoid. - = -- pprTrace "inferCase2" empty $ - (TagDunno, StgCase scrut' bndr' ty []) - -- More than one alternative OR non-TagTuple single alternative. - | otherwise - = - let - case_env = extendSigEnv in_env [bndr'] - - (infos, alts') - = unzip [ (info, g {alt_bndrs=bndrs', alt_rhs=rhs'}) - | g@GenStgAlt{ alt_con = con - , alt_bndrs = bndrs - , alt_rhs = rhs - } <- alts - , let (alt_env,bndrs') = addAltBndrInfo case_env con bndrs - (info, rhs') = inferTagExpr alt_env rhs - ] - alt_info = foldr combineAltInfo TagTagged infos - in ( alt_info, StgCase scrut' bndr' ty alts') - where - -- Single unboxed tuple alternative - scrut_infos bndrs = case scrut_info of - TagTagged -> Just $ replicate (length bndrs) TagProper - TagTuple infos -> Just infos - _ -> Nothing - (scrut_info, scrut') = inferTagExpr in_env scrut - bndr' = (getBinderId in_env bndr, TagSig TagProper) - --- Compute binder sigs based on the constructors strict fields. --- NB: Not used if we have tuple info from the scrutinee. -addAltBndrInfo :: forall p. TagEnv p -> AltCon -> [BinderP p] -> (TagEnv p, [BinderP 'InferTaggedBinders]) -addAltBndrInfo env (DataAlt con) bndrs - | not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) - = (out_env, out_bndrs) - where - marks = dataConRuntimeRepStrictness con :: [StrictnessMark] - out_bndrs = zipWith mk_bndr bndrs marks - out_env = extendSigEnv env out_bndrs - - mk_bndr :: (BinderP p -> StrictnessMark -> (Id, TagSig)) - mk_bndr bndr mark - | isUnliftedType (idType id) || isMarkedStrict mark - = (id, TagSig TagProper) - | otherwise - = noSig env bndr - where - id = getBinderId env bndr - -addAltBndrInfo env _ bndrs = (env, map (noSig env) bndrs) - ------------------------------ -inferTagBind :: (OutputableInferPass p, InferExtEq p) - => TagEnv p -> GenStgBinding p -> (TagEnv p, GenStgBinding 'InferTaggedBinders) -inferTagBind in_env (StgNonRec bndr rhs) - = - -- pprTrace "inferBindNonRec" ( - -- ppr bndr $$ - -- ppr (isDeadEndId id) $$ - -- ppr sig) - (env', StgNonRec (id, out_sig) rhs') - where - id = getBinderId in_env bndr - (in_sig,rhs') = inferTagRhs id in_env rhs - out_sig = mkLetSig in_env in_sig - env' = extendSigEnv in_env [(id, out_sig)] - -inferTagBind in_env (StgRec pairs) - = -- pprTrace "rec" (ppr (map fst pairs) $$ ppr (in_env { te_env = out_env }, StgRec pairs')) $ - (in_env { te_env = out_env }, StgRec pairs') - where - (bndrs, rhss) = unzip pairs - in_ids = map (getBinderId in_env) bndrs - init_sigs = map (initSig) $ zip in_ids rhss - (out_env, pairs') = go in_env init_sigs rhss - - go :: forall q. (OutputableInferPass q , InferExtEq q) => TagEnv q -> [TagSig] -> [GenStgRhs q] - -> (TagSigEnv, [((Id,TagSig), GenStgRhs 'InferTaggedBinders)]) - go go_env in_sigs go_rhss - -- | pprTrace "go" (ppr in_ids $$ ppr in_sigs $$ ppr out_sigs $$ ppr rhss') False - -- = undefined - | in_sigs == out_sigs = (te_env rhs_env, out_bndrs `zip` rhss') - | otherwise = go env' out_sigs rhss' - where - in_bndrs = in_ids `zip` in_sigs - out_bndrs = map updateBndr in_bndrs -- TODO: Keeps in_ids alive - rhs_env = extendSigEnv go_env in_bndrs - (out_sigs, rhss') = unzip (zipWithEqual "inferTagBind" anaRhs in_ids go_rhss) - env' = makeTagged go_env - - anaRhs :: Id -> GenStgRhs q -> (TagSig, GenStgRhs 'InferTaggedBinders) - anaRhs bnd rhs = - let (sig_rhs,rhs') = inferTagRhs bnd rhs_env rhs - in (mkLetSig go_env sig_rhs, rhs') - - - updateBndr :: (Id,TagSig) -> (Id,TagSig) - updateBndr (v,sig) = (setIdTagSig v sig, sig) - -initSig :: forall p. (Id, GenStgRhs p) -> TagSig --- Initial signature for the fixpoint loop -initSig (_bndr, StgRhsCon {}) = TagSig TagTagged -initSig (bndr, StgRhsClosure _ _ _ _ _ _) = - fromMaybe defaultSig (idTagSig_maybe bndr) - where defaultSig = (TagSig TagTagged) - -{- Note [Bottom functions are TagTagged] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we have a function with two branches with one -being bottom, and the other returning a tagged -unboxed tuple what is the result? We give it TagTagged! -To answer why consider this function: - -foo :: Bool -> (# Bool, Bool #) -foo x = case x of - True -> (# True,True #) - False -> undefined - -The true branch is obviously tagged. The other branch isn't. -We want to treat the *result* of foo as tagged as well so that -the combination of the branches also is tagged if all non-bottom -branches are tagged. -This is safe because the function is still always called/entered as long -as it's applied to arguments. Since the function will never return we can give -it safely any tag sig we like. -So we give it TagTagged, as it allows the combined tag sig of the case expression -to be the combination of all non-bottoming branches. - -NB: After the analysis is done we go back to treating bottoming functions as -untagged to ensure they are evaluated as expected in code like: - - case bottom_id of { ...} - --} - ------------------------------ -inferTagRhs :: forall p. - (OutputableInferPass p, InferExtEq p) - => Id -- ^ Id we are binding to. - -> TagEnv p -- ^ - -> GenStgRhs p -- ^ - -> (TagSig, GenStgRhs 'InferTaggedBinders) -inferTagRhs bnd_id in_env (StgRhsClosure ext cc upd bndrs body typ) - | isDeadEndId bnd_id && (notNull) bndrs - -- See Note [Bottom functions are TagTagged] - = (TagSig TagTagged, StgRhsClosure ext cc upd out_bndrs body' typ) - | otherwise - = --pprTrace "inferTagRhsClosure" (ppr (_top, _grp_ids, env,info')) $ - (TagSig info', StgRhsClosure ext cc upd out_bndrs body' typ) - where - out_bndrs - | Just marks <- idCbvMarks_maybe bnd_id - -- Sometimes an we eta-expand foo with additional arguments after ww, and we also trim - -- the list of marks to the last strict entry. So we can conservatively - -- assume these are not strict - = zipWith (mkArgSig) bndrs (marks ++ repeat NotMarkedCbv) - | otherwise = map (noSig env') bndrs :: [(Id,TagSig)] - - env' = extendSigEnv in_env out_bndrs - (info, body') = inferTagExpr env' body - info' - -- It's a thunk - | null bndrs - = TagDunno - -- TODO: We could preserve tuple fields for thunks - -- as well. But likely not worth the complexity. - - | otherwise = info - - mkArgSig :: BinderP p -> CbvMark -> (Id,TagSig) - mkArgSig bndp mark = - let id = getBinderId in_env bndp - tag = case mark of - MarkedCbv -> TagProper - _ - | isUnliftedType (idType id) -> TagProper - | otherwise -> TagDunno - in (id, TagSig tag) - -inferTagRhs _ env _rhs@(StgRhsCon cc con cn ticks args typ) --- Constructors, which have untagged arguments to strict fields --- become thunks. We encode this by giving changing RhsCon nodes the info TagDunno - = --pprTrace "inferTagRhsCon" (ppr grp_ids) $ - (TagSig (inferConTag env con args), StgRhsCon cc con cn ticks args typ) - --- Adjust let semantics to the targeted backend. --- See Note [Tag inference for interpreted code] -mkLetSig :: TagEnv p -> TagSig -> TagSig -mkLetSig env in_sig - | for_bytecode = TagSig TagDunno - | otherwise = in_sig - where - for_bytecode = te_bytecode env - -{- Note [Constructor TagSigs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -@inferConTag@ will infer the proper tag signature for a binding who's RHS is a constructor -or a StgConApp expression. -Usually these will simply be TagProper. But there are exceptions. -If any of the fields in the constructor are strict, but any argument to these -fields is not tagged then we will have to case on the argument before storing -in the constructor. Which means for let bindings the RHS turns into a thunk -which obviously is no longer properly tagged. -For example we might start with: - - let x = f ... - let c = StrictPair x True - -But we know during the rewrite stage x will need to be evaluated in the RHS -of `c` so we will infer: - - let x = f ... - let c = StrictPair x True - -Which in the rewrite stage will then be rewritten into: - - let x = f ... - let c = case x of x' -> StrictPair x' True - -The other exception is unboxed tuples. These will get a TagTuple -signature with a list of TagInfo about their individual binders -as argument. As example: - - let c = True - let x = ... - let f z = case z of z' -> (# c, x #) - -Here we will infer for f the Signature . -This information will be used if we scrutinize a saturated application of -`f` in order to determine the taggedness of the result. -That is for `case f x of (# r1,r2 #) -> rhs` we can infer -r1 and r2 which allows us to skip all tag checks on `r1` -in `rhs`. - -Things get a bit more complicated with nesting: - - let closeFd = ... - let f x = ... - case x of - _ -> Solo# closeFd - -The "natural" signature for the Solo# branch in `f` would be . -But we flatten this out to for the time being as it improves compile -time and there doesn't seem to huge benefit to doing differently. - - -} - --- See Note [Constructor TagSigs] -inferConTag :: TagEnv p -> DataCon -> [StgArg] -> TagInfo -inferConTag env con args - | isUnboxedTupleDataCon con - = TagTuple $ map (flatten_arg_tag . lookupInfo env) args - | otherwise = - -- pprTrace "inferConTag" - -- ( text "con:" <> ppr con $$ - -- text "args:" <> ppr args $$ - -- text "marks:" <> ppr (dataConRuntimeRepStrictness con) $$ - -- text "arg_info:" <> ppr (map (lookupInfo env) args) $$ - -- text "info:" <> ppr info) $ - info - where - info = if any arg_needs_eval strictArgs then TagDunno else TagProper - strictArgs = zipEqual "inferTagRhs" args (dataConRuntimeRepStrictness con) :: ([(StgArg, StrictnessMark)]) - arg_needs_eval (arg,strict) - -- lazy args - | not (isMarkedStrict strict) = False - | tag <- (lookupInfo env arg) - -- banged args need to be tagged, or require eval - = not (isTaggedInfo tag) - - flatten_arg_tag (TagTagged) = TagProper - flatten_arg_tag (TagProper ) = TagProper - flatten_arg_tag (TagTuple _) = TagDunno -- See Note [Constructor TagSigs] - flatten_arg_tag (TagDunno) = TagDunno - - -collectExportInfo :: [GenStgTopBinding 'InferTaggedBinders] -> NameEnv TagSig -collectExportInfo binds = - mkNameEnv bndr_info - where - bndr_info = concatMap collect binds :: [(Name,TagSig)] - - collect (StgTopStringLit {}) = [] - collect (StgTopLifted bnd) = - case bnd of - StgNonRec (id,sig) _rhs - | TagSig TagDunno <- sig -> [] - | otherwise -> [(idName id,sig)] - StgRec bnds -> collectRec bnds - - collectRec :: [(BinderP 'InferTaggedBinders, rhs)] -> [(Name,TagSig)] - collectRec [] = [] - collectRec (bnd:bnds) - | (p,_rhs) <- bnd - , (id,sig) <- p - , TagSig TagDunno <- sig - = (idName id,sig) : collectRec bnds - | otherwise = collectRec bnds diff --git a/GHC/Stg/InferTags/Rewrite.hs b/GHC/Stg/InferTags/Rewrite.hs deleted file mode 100644 --- a/GHC/Stg/InferTags/Rewrite.hs +++ /dev/null @@ -1,563 +0,0 @@ - --- Copyright (c) 2019 Andreas Klebinger --- - -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeFamilies #-} - -module GHC.Stg.InferTags.Rewrite (rewriteTopBinds, rewriteOpApp) -where - -import GHC.Prelude - -import GHC.Builtin.PrimOps ( PrimOp(..) ) -import GHC.Types.Basic ( CbvMark (..), isMarkedCbv - , TopLevelFlag(..), isTopLevel ) -import GHC.Types.Id -import GHC.Types.Name -import GHC.Types.Unique.Supply -import GHC.Types.Unique.FM -import GHC.Types.RepType -import GHC.Types.Var.Set -import GHC.Unit.Types - -import GHC.Core.DataCon -import GHC.Core ( AltCon(..) ) -import GHC.Core.Type - -import GHC.StgToCmm.Types -import GHC.StgToCmm.Closure (importedIdLFInfo) - -import GHC.Stg.Utils -import GHC.Stg.Syntax as StgSyn - -import GHC.Data.Maybe -import GHC.Utils.Panic - -import GHC.Utils.Outputable -import GHC.Utils.Monad.State.Strict -import GHC.Utils.Misc - -import GHC.Stg.InferTags.Types - -import Control.Monad - -newtype RM a = RM { unRM :: (State (UniqFM Id TagSig, UniqSupply, Module, IdSet) a) } - deriving (Functor, Monad, Applicative) - ------------------------------------------------------------- --- Add cases around strict fields where required. ------------------------------------------------------------- -{- -The work of this pass is simple: -* We traverse the STG AST looking for constructor allocations. -* For all allocations we check if there are strict fields in the constructor. -* For any strict field we check if the argument is known to be properly tagged. -* If it's not known to be properly tagged, we wrap the whole thing in a case, - which will force the argument before allocation. -This is described in detail in Note [Strict Field Invariant]. - -The only slight complication is that we have to make sure not to invalidate free -variable analysis in the process. - -Note [Partially applied workers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Sometimes we will get a function f of the form - -- Arity 1 - f :: Dict a -> a -> b -> (c -> d) - f dict a b = case dict of - C m1 m2 -> m1 a b - -Which will result in a W/W split along the lines of - -- Arity 1 - f :: Dict a -> a -> b -> (c -> d) - f dict a = case dict of - C m1 m2 -> $wf m1 a b - - -- Arity 4 - $wf :: (a -> b -> d -> c) -> a -> b -> c -> d - $wf m1 a b c = m1 a b c - -It's notable that the worker is called *undersaturated* in the wrapper. -At runtime what happens is that the wrapper will allocate a PAP which -once fully applied will call the worker. And all is fine. - -But what about a call by value function! Well the function returned by `f` would -be a unknown call, so we lose the ability to enforce the invariant that -cbv marked arguments from StictWorkerId's are actually properly tagged -as the annotations would be unavailable at the (unknown) call site. - -The fix is easy. We eta-expand all calls to functions taking call-by-value -arguments during CorePrep just like we do with constructor allocations. - -Note [Upholding free variable annotations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The code generator requires us to maintain exact information -about free variables about closures. Since we convert some -RHSs from constructor allocations to closures we have to provide -fvs of these closures. Not all constructor arguments will become -free variables. Only these which are not bound at the top level -have to be captured. -To facilitate this we keep track of a set of locally bound variables in -the current context which we then use to filter constructor arguments -when building the free variable list. --} - --------------------------------- --- Utilities --------------------------------- - -instance MonadUnique RM where - getUniqueSupplyM = RM $ do - (m, us, mod,lcls) <- get - let (us1, us2) = splitUniqSupply us - (put) (m,us2,mod,lcls) - return us1 - -getMap :: RM (UniqFM Id TagSig) -getMap = RM $ ((\(fst,_,_,_) -> fst) <$> get) - -setMap :: (UniqFM Id TagSig) -> RM () -setMap !m = RM $ do - (_,us,mod,lcls) <- get - put (m, us,mod,lcls) - -getMod :: RM Module -getMod = RM $ ( (\(_,_,thrd,_) -> thrd) <$> get) - -getFVs :: RM IdSet -getFVs = RM $ ((\(_,_,_,lcls) -> lcls) <$> get) - -setFVs :: IdSet -> RM () -setFVs !fvs = RM $ do - (tag_map,us,mod,_lcls) <- get - put (tag_map, us,mod,fvs) - --- Rewrite the RHS(s) while making the id and it's sig available --- to determine if things are tagged/need to be captured as FV. -withBind :: TopLevelFlag -> GenStgBinding 'InferTaggedBinders -> RM a -> RM a -withBind top_flag (StgNonRec bnd _) cont = withBinder top_flag bnd cont -withBind top_flag (StgRec binds) cont = do - let (bnds,_rhss) = unzip binds :: ([(Id, TagSig)], [GenStgRhs 'InferTaggedBinders]) - withBinders top_flag bnds cont - -addTopBind :: GenStgBinding 'InferTaggedBinders -> RM () -addTopBind (StgNonRec (id, tag) _) = do - s <- getMap - -- pprTraceM "AddBind" (ppr id) - setMap $ addToUFM s id tag - return () -addTopBind (StgRec binds) = do - let (bnds,_rhss) = unzip binds - !s <- getMap - -- pprTraceM "AddBinds" (ppr $ map fst bnds) - setMap $! addListToUFM s bnds - -withBinder :: TopLevelFlag -> (Id, TagSig) -> RM a -> RM a -withBinder top_flag (id,sig) cont = do - oldMap <- getMap - setMap $ addToUFM oldMap id sig - a <- if isTopLevel top_flag - then cont - else withLcl id cont - setMap oldMap - return a - -withBinders :: TopLevelFlag -> [(Id, TagSig)] -> RM a -> RM a -withBinders TopLevel sigs cont = do - oldMap <- getMap - setMap $ addListToUFM oldMap sigs - a <- cont - setMap oldMap - return a -withBinders NotTopLevel sigs cont = do - oldMap <- getMap - oldFvs <- getFVs - setMap $ addListToUFM oldMap sigs - setFVs $ extendVarSetList oldFvs (map fst sigs) - a <- cont - setMap oldMap - setFVs oldFvs - return a - --- | Compute the argument with the given set of ids treated as requiring capture --- as free variables. -withClosureLcls :: DIdSet -> RM a -> RM a -withClosureLcls fvs act = do - old_fvs <- getFVs - let !fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs - setFVs fvs' - !r <- act - setFVs old_fvs - return r - --- | Compute the argument with the given id treated as requiring capture --- as free variables in closures. -withLcl :: Id -> RM a -> RM a -withLcl fv act = do - old_fvs <- getFVs - let !fvs' = extendVarSet old_fvs fv - setFVs fvs' - !r <- act - setFVs old_fvs - return r - -{- Note [Tag inference for interactive contexts] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When compiling bytecode we call myCoreToStg to get STG code first. -myCoreToStg in turn calls out to stg2stg which runs the STG to STG -passes followed by free variables analysis and the tag inference pass including -its rewriting phase at the end. -Running tag inference is important as it upholds Note [Strict Field Invariant]. -While code executed by GHCi doesn't take advantage of the SFI it can call into -compiled code which does. So it must still make sure that the SFI is upheld. -See also #21083 and #22042. - -However there one important difference in code generation for GHCi and regular -compilation. When compiling an entire module (not a GHCi expression), we call -`stg2stg` on the entire module which allows us to build up a map which is guaranteed -to have an entry for every binder in the current module. -For non-interactive compilation the tag inference rewrite pass takes advantage -of this by building up a map from binders to their tag signatures. - -When compiling a GHCi expression on the other hand we invoke stg2stg separately -for each expression on the prompt. This means in GHCi for a sequence of: - > let x = True - > let y = StrictJust x -We first run stg2stg for `[x = True]`. And then again for [y = StrictJust x]`. - -While computing the tag signature for `y` during tag inference inferConTag will check -if `x` is already tagged by looking up the tagsig of `x` in the binder->signature mapping. -However since this mapping isn't persistent between stg2stg -invocations the lookup will fail. This isn't a correctness issue since it's always -safe to assume a binding isn't tagged and that's what we do in such cases. - -However for non-interactive mode we *don't* want to do this. Since in non-interactive mode -we have all binders of the module available for each invocation we can expect the binder->signature -mapping to be complete and all lookups to succeed. This means in non-interactive contexts a failed lookup -indicates a bug in the tag inference implementation. -For this reason we assert that we are running in interactive mode if a lookup fails. --} -isTagged :: Id -> RM Bool -isTagged v - -- See Note [Bottom functions are TagTagged] - | isDeadEndId v = pure False - | otherwise = do - this_mod <- getMod - -- See Note [Tag inference for interactive contexts] - let lookupDefault v = assertPpr (isInteractiveModule this_mod) - (text "unknown Id:" <> ppr this_mod <+> ppr v) - (TagSig TagDunno) - case nameIsLocalOrFrom this_mod (idName v) of - True - | definitelyUnliftedType (idType v) - -- NB: v might be the Id of a representation-polymorphic join point, - -- so we shouldn't use isUnliftedType here. See T22212. - -> return True - | otherwise -> do -- Local binding - !s <- getMap - let !sig = lookupWithDefaultUFM s (lookupDefault v) v - return $ case sig of - TagSig info -> - case info of - TagDunno -> False - TagProper -> True - TagTagged -> True - TagTuple _ -> True -- Consider unboxed tuples tagged. - -- Imported - False -> return $! - -- Determine whether it is tagged from the LFInfo of the imported id. - -- See Note [The LFInfo of Imported Ids] - case importedIdLFInfo v of - -- Function, applied not entered. - LFReEntrant {} - -> True - -- Thunks need to be entered. - LFThunk {} - -> False - -- LFCon means we already know the tag, and it's tagged. - LFCon {} - -> True - LFUnknown {} - -> False - LFUnlifted {} - -> True - LFLetNoEscape {} - -- Shouldn't be possible. I don't think we can export letNoEscapes - -> True - - -isArgTagged :: StgArg -> RM Bool -isArgTagged (StgLitArg _) = return True -isArgTagged (StgVarArg v) = isTagged v - -mkLocalArgId :: Id -> RM Id -mkLocalArgId id = do - !u <- getUniqueM - return $! setIdUnique (localiseId id) u - ---------------------------- --- Actual rewrite pass ---------------------------- - - -rewriteTopBinds :: Module -> UniqSupply -> [GenStgTopBinding 'InferTaggedBinders] -> [TgStgTopBinding] -rewriteTopBinds mod us binds = - let doBinds = mapM rewriteTop binds - - in evalState (unRM doBinds) (mempty, us, mod, mempty) - -rewriteTop :: InferStgTopBinding -> RM TgStgTopBinding -rewriteTop (StgTopStringLit v s) = return $! (StgTopStringLit v s) -rewriteTop (StgTopLifted bind) = do - -- Top level bindings can, and must remain in scope - addTopBind bind - (StgTopLifted) <$!> (rewriteBinds TopLevel bind) - --- For top level binds, the wrapper is guaranteed to be `id` -rewriteBinds :: TopLevelFlag -> InferStgBinding -> RM (TgStgBinding) -rewriteBinds _top_flag (StgNonRec v rhs) = do - (!rhs) <- rewriteRhs v rhs - return $! (StgNonRec (fst v) rhs) -rewriteBinds top_flag b@(StgRec binds) = - -- Bring sigs of binds into scope for all rhss - withBind top_flag b $ do - (rhss) <- mapM (uncurry rewriteRhs) binds - return $! (mkRec rhss) - where - mkRec :: [TgStgRhs] -> TgStgBinding - mkRec rhss = StgRec (zip (map (fst . fst) binds) rhss) - --- Rewrite a RHS -rewriteRhs :: (Id,TagSig) -> InferStgRhs - -> RM (TgStgRhs) -rewriteRhs (_id, _tagSig) (StgRhsCon ccs con cn ticks args typ) = {-# SCC rewriteRhs_ #-} do - -- pprTraceM "rewriteRhs" (ppr _id) - - -- Look up the nodes representing the constructor arguments. - fieldInfos <- mapM isArgTagged args - - -- Filter out non-strict fields. - let strictFields = - getStrictConArgs con (zip args fieldInfos) :: [(StgArg,Bool)] -- (nth-argument, tagInfo) - -- Filter out already tagged arguments. - let needsEval = map fst . --get the actual argument - filter (not . snd) $ -- Keep untagged (False) elements. - strictFields :: [StgArg] - let evalArgs = [v | StgVarArg v <- needsEval] :: [Id] - - if (null evalArgs) - then return $! (StgRhsCon ccs con cn ticks args typ) - else do - --assert not (isTaggedSig tagSig) - -- pprTraceM "CreatingSeqs for " $ ppr _id <+> ppr node_id - - -- At this point iff we have possibly untagged arguments to strict fields - -- we convert the RHS into a RhsClosure which will evaluate the arguments - -- before allocating the constructor. - let ty_stub = panic "mkSeqs shouldn't use the type arg" - conExpr <- mkSeqs args evalArgs (\taggedArgs -> StgConApp con cn taggedArgs ty_stub) - - fvs <- fvArgs args - -- lcls <- getFVs - -- pprTraceM "RhsClosureConversion" (ppr (StgRhsClosure fvs ccs ReEntrant [] $! conExpr) $$ text "lcls:" <> ppr lcls) - - -- We mark the closure updatable to retain sharing in the case that - -- conExpr is an infinite recursive data type. See #23783. - return $! (StgRhsClosure fvs ccs Updatable [] $! conExpr) typ -rewriteRhs _binding (StgRhsClosure fvs ccs flag args body typ) = do - withBinders NotTopLevel args $ - withClosureLcls fvs $ - StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr body <*> pure typ - -- return (closure) - -fvArgs :: [StgArg] -> RM DVarSet -fvArgs args = do - fv_lcls <- getFVs - -- pprTraceM "fvArgs" (text "args:" <> ppr args $$ text "lcls:" <> pprVarSet (fv_lcls) (braces . fsep . map ppr) ) - return $ mkDVarSet [ v | StgVarArg v <- args, elemVarSet v fv_lcls] - -rewriteArgs :: [StgArg] -> RM [StgArg] -rewriteArgs = mapM rewriteArg -rewriteArg :: StgArg -> RM StgArg -rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v -rewriteArg (lit@StgLitArg{}) = return lit - -rewriteId :: Id -> RM Id -rewriteId v = do - !is_tagged <- isTagged v - if is_tagged then return $! setIdTagSig v (TagSig TagProper) - else return v - -rewriteExpr :: GenStgExpr 'InferTaggedBinders -> RM (GenStgExpr 'CodeGen) -rewriteExpr (e@StgCase {}) = rewriteCase e -rewriteExpr (e@StgLet {}) = rewriteLet e -rewriteExpr (e@StgLetNoEscape {}) = rewriteLetNoEscape e -rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e -rewriteExpr e@(StgConApp {}) = rewriteConApp e -rewriteExpr e@(StgApp {}) = rewriteApp e -rewriteExpr (StgLit lit) = return $! (StgLit lit) -rewriteExpr (StgOpApp op args res_ty) = (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty - - -rewriteCase :: InferStgExpr -> RM TgStgExpr -rewriteCase (StgCase scrut bndr alt_type alts) = - withBinder NotTopLevel bndr $ - pure StgCase <*> - rewriteExpr scrut <*> - rewriteId (fst bndr) <*> - pure alt_type <*> - mapM rewriteAlt alts - -rewriteCase _ = panic "Impossible: nodeCase" - -rewriteAlt :: InferStgAlt -> RM TgStgAlt -rewriteAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} = - withBinders NotTopLevel bndrs $ do - !rhs' <- rewriteExpr rhs - return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'} - -rewriteLet :: InferStgExpr -> RM TgStgExpr -rewriteLet (StgLet xt bind expr) = do - (!bind') <- rewriteBinds NotTopLevel bind - withBind NotTopLevel bind $ do - -- pprTraceM "withBindLet" (ppr $ bindersOfX bind) - !expr' <- rewriteExpr expr - return $! (StgLet xt bind' expr') -rewriteLet _ = panic "Impossible" - -rewriteLetNoEscape :: InferStgExpr -> RM TgStgExpr -rewriteLetNoEscape (StgLetNoEscape xt bind expr) = do - (!bind') <- rewriteBinds NotTopLevel bind - withBind NotTopLevel bind $ do - !expr' <- rewriteExpr expr - return $! (StgLetNoEscape xt bind' expr') -rewriteLetNoEscape _ = panic "Impossible" - -rewriteConApp :: InferStgExpr -> RM TgStgExpr -rewriteConApp (StgConApp con cn args tys) = do - -- We check if the strict field arguments are already known to be tagged. - -- If not we evaluate them first. - fieldInfos <- mapM isArgTagged args - let strictIndices = getStrictConArgs con (zip fieldInfos args) :: [(Bool, StgArg)] - let needsEval = map snd . filter (not . fst) $ strictIndices :: [StgArg] - let evalArgs = [v | StgVarArg v <- needsEval] :: [Id] - if (not $ null evalArgs) - then do - -- pprTraceM "Creating conAppSeqs for " $ ppr nodeId <+> parens ( ppr evalArgs ) -- <+> parens ( ppr fieldInfos ) - mkSeqs args evalArgs (\taggedArgs -> StgConApp con cn taggedArgs tys) - else return $! (StgConApp con cn args tys) - -rewriteConApp _ = panic "Impossible" - --- Special case: Atomic binders, usually in a case context like `case f of ...`. -rewriteApp :: InferStgExpr -> RM TgStgExpr -rewriteApp (StgApp f []) = do - f' <- rewriteId f - return $! StgApp f' [] -rewriteApp (StgApp f args) - -- pprTrace "rewriteAppOther" (ppr f <+> ppr args) False - -- = undefined - | Just marks <- idCbvMarks_maybe f - , relevant_marks <- dropWhileEndLE (not . isMarkedCbv) marks - , any isMarkedCbv relevant_marks - = assertPpr (length relevant_marks <= length args) (ppr f $$ ppr args $$ ppr relevant_marks) - unliftArg relevant_marks - - where - -- If the function expects any argument to be call-by-value ensure the argument is already - -- evaluated. - unliftArg relevant_marks = do - argTags <- mapM isArgTagged args - let argInfo = zipWith3 ((,,)) args (relevant_marks++repeat NotMarkedCbv) argTags :: [(StgArg, CbvMark, Bool)] - - -- untagged cbv argument positions - cbvArgInfo = filter (\x -> sndOf3 x == MarkedCbv && thdOf3 x == False) argInfo - cbvArgIds = [x | StgVarArg x <- map fstOf3 cbvArgInfo] :: [Id] - mkSeqs args cbvArgIds (\cbv_args -> StgApp f cbv_args) - -rewriteApp (StgApp f args) = return $ StgApp f args -rewriteApp _ = panic "Impossible" - -{- -Note [Rewriting primop arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Given an application `op# x y`, is it worth applying `rewriteArg` to -`x` and `y`? All that will do will be to set the `tagSig` for that -occurrence of `x` and `y` to record whether it is evaluated and -properly tagged. For the vast majority of primops that's a waste of -time: the argument is an `Int#` or something. - -But code generation for `seq#` and the `dataToTag#` ops /does/ consult that -tag, to statically avoid generating an eval. All three do so via `cgIdApp`, -which in turn uses `getCallMethod` which looks at the `tagSig`. - -So for these we should call `rewriteArgs`. - --} - -rewriteOpApp :: InferStgExpr -> RM TgStgExpr -rewriteOpApp (StgOpApp op args res_ty) = case op of - op@(StgPrimOp primOp) - | primOp == DataToTagSmallOp || primOp == DataToTagLargeOp - -- see Note [Rewriting primop arguments] - -> (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty - _ -> pure $! StgOpApp op args res_ty -rewriteOpApp _ = panic "Impossible" - --- `mkSeq` x x' e generates `case x of x' -> e` --- We could also substitute x' for x in e but that's so rarely beneficial --- that we don't bother. -mkSeq :: Id -> Id -> TgStgExpr -> TgStgExpr -mkSeq id bndr !expr = - -- pprTrace "mkSeq" (ppr (id,bndr)) $ - let altTy = mkStgAltTypeFromStgAlts bndr alt - alt = [GenStgAlt {alt_con = DEFAULT, alt_bndrs = [], alt_rhs = expr}] - in StgCase (StgApp id []) bndr altTy alt - --- `mkSeqs args vs mkExpr` will force all vs, and construct --- an argument list args' where each v is replaced by it's evaluated --- counterpart v'. --- That is if we call `mkSeqs [StgVar x, StgLit l] [x] mkExpr` then --- the result will be (case x of x' { _DEFAULT -> } -{-# INLINE mkSeqs #-} -- We inline to avoid allocating mkExpr -mkSeqs :: [StgArg] -- ^ Original arguments - -> [Id] -- ^ var args to be evaluated ahead of time - -> ([StgArg] -> TgStgExpr) - -- ^ Function that reconstructs the expressions when passed - -- the list of evaluated arguments. - -> RM TgStgExpr -mkSeqs args untaggedIds mkExpr = do - argMap <- mapM (\arg -> (arg,) <$> mkLocalArgId arg ) untaggedIds :: RM [(InId, OutId)] - -- mapM_ (pprTraceM "Forcing strict args before allocation:" . ppr) argMap - let taggedArgs :: [StgArg] - = map (\v -> case v of - StgVarArg v' -> StgVarArg $ fromMaybe v' $ lookup v' argMap - lit -> lit) - args - - let conBody = mkExpr taggedArgs - let body = foldr (\(v,bndr) expr -> mkSeq v bndr expr) conBody argMap - return $! body - --- Out of all arguments passed at runtime only return these ending up in a --- strict field -getStrictConArgs :: Outputable a => DataCon -> [a] -> [a] -getStrictConArgs con args - -- These are always lazy in their arguments. - | isUnboxedTupleDataCon con = [] - | isUnboxedSumDataCon con = [] - -- For proper data cons we have to check. - | otherwise = - assertPpr (length args == length (dataConRuntimeRepStrictness con)) - (text "Mismatched con arg and con rep strictness lengths:" $$ - text "Con" <> ppr con <+> text "is applied to" <+> ppr args $$ - text "But seems to have arity" <> ppr (length repStrictness)) $ - [ arg | (arg,MarkedStrict) - <- zipEqual "getStrictConArgs" - args - repStrictness] - where - repStrictness = (dataConRuntimeRepStrictness con) diff --git a/GHC/Stg/InferTags/TagSig.hs b/GHC/Stg/InferTags/TagSig.hs deleted file mode 100644 --- a/GHC/Stg/InferTags/TagSig.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} - --- We export this type from this module instead of GHC.Stg.InferTags.Types --- because it's used by more than the analysis itself. For example in interface --- files where we record a tag signature for bindings. --- By putting the sig into its own module we can avoid module loops. -module GHC.Stg.InferTags.TagSig - -where - -import GHC.Prelude - -import GHC.Types.Var -import GHC.Types.Name.Env( NameEnv ) -import GHC.Utils.Outputable -import GHC.Utils.Binary -import GHC.Utils.Panic.Plain -import Data.Coerce - --- | Information to be exposed in interface files which is produced --- by the stg2stg passes. -type StgCgInfos = NameEnv TagSig - -newtype TagSig -- The signature for each binding, this is a newtype as we might - -- want to track more information in the future. - = TagSig TagInfo - deriving (Eq) - -data TagInfo - = TagDunno -- We don't know anything about the tag. - | TagTuple [TagInfo] -- Represents a function/thunk which when evaluated - -- will return a Unboxed tuple whos components have - -- the given TagInfos. - | TagProper -- Heap pointer to properly-tagged value - | TagTagged -- Bottom of the domain. - deriving (Eq) - -instance Outputable TagInfo where - ppr TagTagged = text "TagTagged" - ppr TagDunno = text "TagDunno" - ppr TagProper = text "TagProper" - ppr (TagTuple tis) = text "TagTuple" <> brackets (pprWithCommas ppr tis) - -instance Binary TagInfo where - put_ bh TagDunno = putByte bh 1 - put_ bh (TagTuple flds) = putByte bh 2 >> put_ bh flds - put_ bh TagProper = putByte bh 3 - put_ bh TagTagged = putByte bh 4 - - get bh = do tag <- getByte bh - case tag of 1 -> return TagDunno - 2 -> TagTuple <$> get bh - 3 -> return TagProper - 4 -> return TagTagged - _ -> panic ("get TagInfo " ++ show tag) - -instance Outputable TagSig where - ppr (TagSig ti) = char '<' <> ppr ti <> char '>' -instance OutputableBndr (Id,TagSig) where - pprInfixOcc = ppr - pprPrefixOcc = ppr - -instance Binary TagSig where - put_ bh (TagSig sig) = put_ bh sig - get bh = pure TagSig <*> get bh - -isTaggedSig :: TagSig -> Bool -isTaggedSig (TagSig TagProper) = True -isTaggedSig (TagSig TagTagged) = True -isTaggedSig _ = False - -seqTagSig :: TagSig -> () -seqTagSig = coerce seqTagInfo - -seqTagInfo :: TagInfo -> () -seqTagInfo TagTagged = () -seqTagInfo TagDunno = () -seqTagInfo TagProper = () -seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis diff --git a/GHC/Stg/InferTags/Types.hs b/GHC/Stg/InferTags/Types.hs deleted file mode 100644 --- a/GHC/Stg/InferTags/Types.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# LANGUAGE TypeFamilies, DataKinds, GADTs, FlexibleInstances #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} - -{-# LANGUAGE UndecidableInstances #-} - -- To permit: type instance XLet 'InferTaggedBinders = XLet 'CodeGen - -module GHC.Stg.InferTags.Types - ( module GHC.Stg.InferTags.Types - , module TagSig) -where - -import GHC.Prelude - -import GHC.Core.DataCon -import GHC.Core.Type (isUnliftedType) -import GHC.Types.Id -import GHC.Stg.Syntax -import GHC.Stg.InferTags.TagSig as TagSig -import GHC.Types.Var.Env -import GHC.Utils.Outputable -import GHC.Utils.Misc( zipWithEqual ) -import GHC.Utils.Panic - -import GHC.StgToCmm.Types - -{- ********************************************************************* -* * - Supporting data types -* * -********************************************************************* -} - -type InferStgTopBinding = GenStgTopBinding 'InferTaggedBinders -type InferStgBinding = GenStgBinding 'InferTaggedBinders -type InferStgExpr = GenStgExpr 'InferTaggedBinders -type InferStgRhs = GenStgRhs 'InferTaggedBinders -type InferStgAlt = GenStgAlt 'InferTaggedBinders - -combineAltInfo :: TagInfo -> TagInfo -> TagInfo -combineAltInfo TagDunno _ = TagDunno -combineAltInfo _ TagDunno = TagDunno -combineAltInfo (TagTuple {}) TagProper = panic "Combining unboxed tuple with non-tuple result" -combineAltInfo TagProper (TagTuple {}) = panic "Combining unboxed tuple with non-tuple result" -combineAltInfo TagProper TagProper = TagProper -combineAltInfo (TagTuple is1) (TagTuple is2) = TagTuple (zipWithEqual "combineAltInfo" combineAltInfo is1 is2) -combineAltInfo (TagTagged) ti = ti -combineAltInfo ti TagTagged = ti - -type TagSigEnv = IdEnv TagSig -data TagEnv p = TE { te_env :: TagSigEnv - , te_get :: BinderP p -> Id - , te_bytecode :: !Bool - } - -instance Outputable (TagEnv p) where - ppr te = for_txt <+> ppr (te_env te) - where - for_txt = if te_bytecode te - then text "for_bytecode" - else text "for_native" - -getBinderId :: TagEnv p -> BinderP p -> Id -getBinderId = te_get - -initEnv :: Bool -> TagEnv 'CodeGen -initEnv for_bytecode = TE { te_env = emptyVarEnv - , te_get = \x -> x - , te_bytecode = for_bytecode } - --- | Simple convert env to a env of the 'InferTaggedBinders pass --- with no other changes. -makeTagged :: TagEnv p -> TagEnv 'InferTaggedBinders -makeTagged env = TE { te_env = te_env env - , te_get = fst - , te_bytecode = te_bytecode env } - -noSig :: TagEnv p -> BinderP p -> (Id, TagSig) -noSig env bndr - | isUnliftedType (idType var) = (var, TagSig TagProper) - | otherwise = (var, TagSig TagDunno) - where - var = getBinderId env bndr - --- | Look up a sig in the given env -lookupSig :: TagEnv p -> Id -> Maybe TagSig -lookupSig env fun = lookupVarEnv (te_env env) fun - --- | Look up a sig in the env or derive it from information --- in the arg itself. -lookupInfo :: TagEnv p -> StgArg -> TagInfo -lookupInfo env (StgVarArg var) - -- Nullary data constructors like True, False - | Just dc <- isDataConWorkId_maybe var - , isNullaryRepDataCon dc - , not for_bytecode - = TagProper - - | isUnliftedType (idType var) - = TagProper - - -- Variables in the environment. - | Just (TagSig info) <- lookupVarEnv (te_env env) var - = info - - | Just lf_info <- idLFInfo_maybe var - , not for_bytecode - = case lf_info of - -- Function, tagged (with arity) - LFReEntrant {} - -> TagProper - -- Thunks need to be entered. - LFThunk {} - -> TagDunno - -- Constructors, already tagged. - LFCon {} - -> TagProper - LFUnknown {} - -> TagDunno - LFUnlifted {} - -> TagProper - -- Shouldn't be possible. I don't think we can export letNoEscapes - LFLetNoEscape {} -> panic "LFLetNoEscape exported" - - | otherwise - = TagDunno - where - for_bytecode = te_bytecode env - -lookupInfo _ (StgLitArg {}) - = TagProper - -isDunnoSig :: TagSig -> Bool -isDunnoSig (TagSig TagDunno) = True -isDunnoSig (TagSig TagProper) = False -isDunnoSig (TagSig TagTuple{}) = False -isDunnoSig (TagSig TagTagged{}) = False - -isTaggedInfo :: TagInfo -> Bool -isTaggedInfo TagProper = True -isTaggedInfo TagTagged = True -isTaggedInfo _ = False - -extendSigEnv :: TagEnv p -> [(Id,TagSig)] -> TagEnv p -extendSigEnv env@(TE { te_env = sig_env }) bndrs - = env { te_env = extendVarEnvList sig_env bndrs } diff --git a/GHC/Stg/Lift/Analysis.hs b/GHC/Stg/Lift/Analysis.hs --- a/GHC/Stg/Lift/Analysis.hs +++ b/GHC/Stg/Lift/Analysis.hs @@ -376,7 +376,7 @@ -- We have 5 hardware registers on x86_64 to pass arguments in. Any excess -- args are passed on the stack, which means slow memory accesses args_spill_on_stack - | Just n <- max_n_args = maximum (map n_args rhss) > n + | Just n <- max_n_args = any (> n) (map n_args rhss) | otherwise = False -- We only perform the lift if allocations didn't increase. diff --git a/GHC/Stg/Pipeline.hs b/GHC/Stg/Pipeline.hs --- a/GHC/Stg/Pipeline.hs +++ b/GHC/Stg/Pipeline.hs @@ -43,8 +43,8 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader import GHC.Settings (Platform) -import GHC.Stg.InferTags (inferTags) -import GHC.Stg.InferTags.TagSig ( StgCgInfos ) +import GHC.Stg.EnforceEpt (enforceEpt) +import GHC.Stg.EnforceEpt.TagSig ( StgCgInfos ) data StgPipelineOpts = StgPipelineOpts { stgPipeline_phases :: ![StgToDo] @@ -100,7 +100,7 @@ -- annotations (which is used by code generator to compute offsets into closures) ; let (binds_sorted_with_fvs, imp_fvs) = unzip (depSortWithAnnotStgPgm this_mod binds') -- See Note [Tag inference for interactive contexts] - ; (cg_binds, cg_infos) <- inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs + ; (cg_binds, cg_infos) <- enforceEpt (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs ; stg_linter False "StgCodeGen" cg_binds ; pure (zip cg_binds imp_fvs, cg_infos) } diff --git a/GHC/Stg/Syntax.hs b/GHC/Stg/Syntax.hs --- a/GHC/Stg/Syntax.hs +++ b/GHC/Stg/Syntax.hs @@ -72,7 +72,7 @@ import GHC.Prelude -import GHC.Stg.InferTags.TagSig( TagSig ) +import GHC.Stg.EnforceEpt.TagSig( TagSig ) import GHC.Stg.Lift.Types -- To avoid having an orphan instances for BinderP, XLet etc @@ -610,9 +610,9 @@ each binding. See Note [Late lambda lifting in STG]. - 4. Tag inference takes in 'Vanilla and produces 'InferTagged STG, while using + 4. EPT enforcement takes in 'Vanilla and produces 'InferTagged STG, while using the InferTaggedBinders annotated AST internally. - See Note [Tag Inference]. + See Note [EPT enforcement]. 5. Stg.FVs annotates closures with their free variables. To store these annotations we use the 'CodeGen parameterisation. @@ -627,9 +627,9 @@ = Vanilla | LiftLams -- ^ Use internally by the lambda lifting pass | InferTaggedBinders -- ^ Tag inference information on binders. - -- See Note [Tag inference passes] in GHC.Stg.InferTags + -- See Note [EPT enforcement] in GHC.Stg.EnforceEpt | InferTagged -- ^ Tag inference information put on relevant StgApp nodes - -- See Note [Tag inference passes] in GHC.Stg.InferTags + -- See Note [EPT enforcement] in GHC.Stg.EnforceEpt | CodeGen type family BinderP (pass :: StgPass) diff --git a/GHC/Stg/Unarise.hs b/GHC/Stg/Unarise.hs --- a/GHC/Stg/Unarise.hs +++ b/GHC/Stg/Unarise.hs @@ -928,7 +928,7 @@ layout' = layoutUbxSum sum_slots field_slots tag_arg = StgLitArg (LitNumber LitNumInt (fromIntegral tag)) - arg_idxs = IM.fromList (zipEqual "mkUbxSum" layout' args0) + arg_idxs = IM.fromList (zipEqual layout' args0) ((_idx,_idx_map,_us,wrapper),slot_args) = assert (length arg_idxs <= length sum_slots ) $ diff --git a/GHC/StgToByteCode.hs b/GHC/StgToByteCode.hs --- a/GHC/StgToByteCode.hs +++ b/GHC/StgToByteCode.hs @@ -1,15 +1,17 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DerivingVia #-} -- -- (c) The University of Glasgow 2002-2006 -- -- | GHC.StgToByteCode: Generate bytecode from STG -module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen) where +module GHC.StgToByteCode ( UnlinkedBCO, byteCodeGen ) where import GHC.Prelude @@ -29,9 +31,7 @@ import GHC.Platform import GHC.Platform.Profile -import GHC.Runtime.Interpreter import GHCi.FFI -import GHCi.RemoteTypes import GHC.Types.Basic import GHC.Utils.Outputable import GHC.Types.Name @@ -42,6 +42,7 @@ import GHC.Builtin.PrimOps import GHC.Builtin.PrimOps.Ids (primOpId) import GHC.Core.Type +import GHC.Core.Predicate( tyCoVarsOfTypesWellScoped ) import GHC.Core.TyCo.Compare (eqType) import GHC.Types.RepType import GHC.Core.DataCon @@ -62,26 +63,24 @@ assertNonVoidIds, assertNonVoidStgArgs ) import GHC.StgToCmm.Layout import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes) +import GHC.Runtime.Interpreter ( interpreterProfiled ) import GHC.Data.Bitmap import GHC.Data.FlatBag as FlatBag import GHC.Data.OrdList import GHC.Data.Maybe -import GHC.Types.Name.Env (mkNameEnv) import GHC.Types.Tickish import GHC.Types.SptEntry +import GHC.ByteCode.Breakpoints -import Data.List ( genericReplicate, genericLength, intersperse +import Data.List ( genericReplicate, intersperse , partition, scanl', sortBy, zip4, zip6 ) import Foreign hiding (shiftL, shiftR) import Control.Monad import Data.Char import GHC.Unit.Module -import GHC.Unit.Home.ModInfo (lookupHpt) -import Data.Array import Data.Coerce (coerce) -import Data.ByteString (ByteString) #if MIN_VERSION_rts(1,0,3) import qualified Data.ByteString.Char8 as BS #endif @@ -97,6 +96,11 @@ import qualified Data.IntSet as IntSet import GHC.CoreToIface +import Control.Monad.IO.Class +import Control.Monad.Trans.Reader (ReaderT(..)) +import Control.Monad.Trans.State (StateT(..)) +import Data.Bifunctor (Bifunctor(..)) + -- ----------------------------------------------------------------------------- -- Generating byte code for a complete module @@ -117,27 +121,23 @@ bnd <- binds case bnd of StgTopLifted bnd -> [Right bnd] - StgTopStringLit b str -> [Left (b, str)] + StgTopStringLit b str -> [Left (getName b, str)] flattenBind (StgNonRec b e) = [(b,e)] flattenBind (StgRec bs) = bs - stringPtrs <- allocateTopStrings interp strings - (BcM_State{..}, proto_bcos) <- + (proto_bcos, BcM_State{..}) <- runBc hsc_env this_mod mb_modBreaks $ do let flattened_binds = concatMap flattenBind (reverse lifted_binds) FlatBag.fromList (fromIntegral $ length flattened_binds) <$> mapM schemeTopBind flattened_binds - when (notNull ffis) - (panic "GHC.StgToByteCode.byteCodeGen: missing final emitBc?") - putDumpFileMaybe logger Opt_D_dump_BCOs "Proto-BCOs" FormatByteCode (vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos))) - let mod_breaks = case modBreaks of + let mod_breaks = case mb_modBreaks of Nothing -> Nothing - Just mb -> Just mb{ modBreaks_breakInfo = breakInfo } - cbc <- assembleBCOs interp profile proto_bcos tycs stringPtrs mod_breaks spt_entries + Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb + cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries -- Squash space leaks in the CompiledByteCode. This is really -- important, because when loading a set of modules into GHCi @@ -151,22 +151,8 @@ where dflags = hsc_dflags hsc_env logger = hsc_logger hsc_env - interp = hscInterp hsc_env profile = targetProfile dflags --- | see Note [Generating code for top-level string literal bindings] -allocateTopStrings - :: Interp - -> [(Id, ByteString)] - -> IO AddrEnv -allocateTopStrings interp topStrings = do - let !(bndrs, strings) = unzip topStrings - ptrs <- interpCmd interp $ MallocStrings strings - return $ mkNameEnv (zipWith mk_entry bndrs ptrs) - where - mk_entry bndr ptr = let nm = getName bndr - in (nm, (nm, AddrPtr ptr)) - {- Note [Generating code for top-level string literal bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As described in Note [Compilation plan for top-level string literals] @@ -177,9 +163,9 @@ we deal with them: 1. Top-level string literal bindings are separated from the rest of - the module. Memory for them is allocated immediately, via - interpCmd, in allocateTopStrings, and the resulting AddrEnv is - recorded in the bc_strs field of the CompiledByteCode result. + the module. Memory is not allocated until bytecode link-time, the + bc_strs field of the CompiledByteCode result records [(Name, ByteString)] + directly. 2. When we encounter a reference to a top-level string literal, we generate a PUSH_ADDR pseudo-instruction, which is assembled to @@ -240,36 +226,36 @@ -- Create a BCO and do a spot of peephole optimisation on the insns -- at the same time. mkProtoBCO - :: (Outputable name) - => Platform - -> Bool -- ^ True <=> label with @BCO_NAME@ instruction - -- see Note [BCO_NAME] - -> name + :: + Platform + -> Maybe Module + -- ^ Just cur_mod <=> label with @BCO_NAME@ instruction + -- see Note [BCO_NAME] + -> Name -> BCInstrList -> Either [CgStgAlt] (CgStgRhs) -- ^ original expression; for debugging only -> Int -- ^ arity -> WordOff -- ^ bitmap size -> [StgWord] -- ^ bitmap - -> Bool -- ^ True <=> is a return point, rather than a function - -> [FFIInfo] - -> ProtoBCO name -mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis + -> Bool -- ^ True <=> it's a case continuation, rather than a function + -- See also Note [Case continuation BCOs]. + -> ProtoBCO Name +mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret = ProtoBCO { protoBCOName = nm, protoBCOInstrs = maybe_add_bco_name $ maybe_add_stack_check peep_d, protoBCOBitmap = bitmap, protoBCOBitmapSize = fromIntegral bitmap_size, protoBCOArity = arity, - protoBCOExpr = origin, - protoBCOFFIs = ffis + protoBCOExpr = origin } where #if MIN_VERSION_rts(1,0,3) maybe_add_bco_name instrs - | _add_bco_name = BCO_NAME str : instrs - where - str = BS.pack $ showSDocOneLine defaultSDocContext (ppr nm) + | Just cur_mod <- _add_bco_name = + let str = BS.pack $ showSDocOneLine defaultSDocContext (pprFullNameWithUnique cur_mod nm) + in BCO_NAME str : instrs #endif maybe_add_bco_name instrs = instrs @@ -331,8 +317,8 @@ -- because mkConAppCode treats nullary constructor applications -- by just re-using the single top-level definition. So -- for the worker itself, we must allocate it directly. - -- ioToBc (putStrLn $ "top level BCO") - emitBc (mkProtoBCO platform add_bco_name + -- liftIO (putStrLn $ "top level BCO") + pure (mkProtoBCO platform add_bco_name (getName id) (toOL [PACK data_con 0, RETURN P]) (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-}) @@ -351,6 +337,9 @@ -- Park the resulting BCO in the monad. Also requires the -- name of the variable to which this value was bound, -- so as to give the resulting BCO a name. +-- +-- The resulting ProtoBCO expects the free variables and the function arguments +-- to be in the stack frame directly before it. schemeR :: [Id] -- Free vars of the RHS, ordered as they -- will appear in the thunk. Empty for -- top-level things, which have no free vars. @@ -389,112 +378,58 @@ -- them unlike constructor fields. szsb_args = map (wordsToBytes platform . idSizeW platform) all_args sum_szsb_args = sum szsb_args + -- Make a stack offset for each argument or free var -- they should + -- appear contiguous in the stack, in order. p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args)) -- make the arg bitmap bits = argBits platform (reverse (map (idArgRep platform) all_args)) - bitmap_size = genericLength bits + bitmap_size = strictGenericLength bits bitmap = mkBitmap platform bits body_code <- schemeER_wrk sum_szsb_args p_init body - emitBc (mkProtoBCO platform add_bco_name nm body_code (Right original_body) + pure (mkProtoBCO platform add_bco_name nm body_code (Right original_body) arity bitmap_size bitmap False{-not alts-}) -- | Introduce break instructions for ticked expressions. -- If no breakpoint information is available, the instruction is omitted. schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList -schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs tick_mod) rhs) = do - code <- schemeE d 0 p rhs - hsc_env <- getHscEnv - current_mod <- getCurrentModule - mb_current_mod_breaks <- getCurrentModBreaks - case mb_current_mod_breaks of - -- if we're not generating ModBreaks for this module for some reason, we - -- can't store breakpoint occurrence information. - Nothing -> pure code - Just current_mod_breaks -> case break_info hsc_env tick_mod current_mod mb_current_mod_breaks of - Nothing -> pure code - Just ModBreaks {modBreaks_flags = breaks, modBreaks_module = tick_mod_ptr, modBreaks_ccs = cc_arr} -> do - platform <- profilePlatform <$> getProfile - let idOffSets = getVarOffSets platform d p fvs - ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) - toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) - toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) - breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty +schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do + platform <- profilePlatform <$> getProfile - let info_mod_ptr = modBreaks_module current_mod_breaks - infox <- newBreakInfo breakInfo + -- When we find a tick we update the "last breakpoint location". + -- We use it when constructing step-out BRK_FUNs in doCase + -- See Note [Debugger: Stepout internal break locs] + code <- withBreakTick bp $ schemeE d 0 p rhs - let cc | Just interp <- hsc_interp hsc_env - , interpreterProfiled interp - = cc_arr ! tick_no - | otherwise = toRemotePtr nullPtr + -- As per Note [Stack layout when entering run_BCO], the breakpoint AP_STACK + -- as we yield from the interpreter is headed by a stg_apply_interp + BCO to be a valid stack. + -- Therefore, the var offsets are offset by 2 words + let idOffSets = map (fmap (second (+2))) $ + getVarOffSets platform d p fvs + ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) + toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) + toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty + (Right tick_id) - let -- cast that checks that round-tripping through Word16 doesn't change the value - toW16 x = let r = fromIntegral x :: Word16 - in if fromIntegral r == x - then r - else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x) - breakInstr = BRK_FUN breaks tick_mod_ptr (toW16 tick_no) info_mod_ptr (toW16 infox) cc - return $ breakInstr `consOL` code -schemeER_wrk d p rhs = schemeE d 0 p rhs + mibi <- newBreakInfo breakInfo --- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module --- from which the breakpoint originates. --- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs --- to refer to pointers in GHCi's address space. --- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by --- 'GHC.HsToCore.deSugar'. --- --- Breakpoints might be disabled because we're in TH, because --- @-fno-break-points@ was specified, or because a module was reloaded without --- reinitializing 'ModBreaks'. --- --- If the module stored in the breakpoint is the currently processed module, use --- the 'ModBreaks' from the state. --- If that is 'Nothing', consider breakpoints to be disabled and skip the --- instruction. --- --- If the breakpoint is inlined from another module, look it up in the home --- package table. --- If the module doesn't exist there, or its module pointer is null (which means --- that the 'ModBreaks' value is uninitialized), skip the instruction. -break_info :: - HscEnv -> - Module -> - Module -> - Maybe ModBreaks -> - Maybe ModBreaks -break_info hsc_env mod current_mod current_mod_breaks - | mod == current_mod - = check_mod_ptr =<< current_mod_breaks - | Just hp <- lookupHpt (hsc_HPT hsc_env) (moduleName mod) - = check_mod_ptr (getModBreaks hp) - | otherwise - = Nothing - where - check_mod_ptr mb - | mod_ptr <- modBreaks_module mb - , fromRemotePtr mod_ptr /= nullPtr - = Just mb - | otherwise - = Nothing + return $ case mibi of + Nothing -> code + Just ibi -> BRK_FUN ibi `consOL` code +schemeER_wrk d p rhs = schemeE d 0 p rhs + +-- | Get the offset in words into this breakpoint's AP_STACK which contains the matching Id getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet where getOffSet id = case lookupBCEnv_maybe id env of - Nothing -> Nothing - Just offset -> - -- michalt: I'm not entirely sure why we need the stack - -- adjustment by 2 here. I initially thought that there's - -- something off with getIdValFromApStack (the only user of this - -- value), but it looks ok to me. My current hypothesis is that - -- this "adjustment" is needed due to stack manipulation for - -- BRK_FUN in Interpreter.c In any case, this is used only when - -- we trigger a breakpoint. - let !var_depth_ws = bytesToWords platform (depth - offset) + 2 - in Just (id, var_depth_ws) + Nothing -> Nothing + Just offset -> + let !var_depth_ws = bytesToWords platform (depth - offset) + in Just (id, var_depth_ws) fvsToEnv :: BCEnv -> CgStgRhs -> [Id] -- Takes the free variables of a right-hand side, and @@ -543,7 +478,7 @@ -- otherwise use RETURN_TUPLE with a tuple descriptor nv_reps -> do let (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 id nv_reps - tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) + tuple_bco = tupleBCO platform call_info args_offsets return $ PUSH_UBX (mkNativeCallInfoLit platform call_info) 1 `consOL` PUSH_BCO tuple_bco `consOL` unitOL RETURN_TUPLE @@ -606,7 +541,7 @@ platform <- targetPlatform <$> getDynFlags let (xs,rhss) = case binds of StgNonRec x rhs -> ([x],[rhs]) StgRec xs_n_rhss -> unzip xs_n_rhss - n_binds = genericLength xs + n_binds = strictGenericLength xs fvss = map (fvsToEnv p') rhss @@ -615,16 +550,15 @@ sizes = map (\rhs_fvs -> sum (map size_w rhs_fvs)) fvss -- the arity of each rhs - arities = map (genericLength . fst . collect) rhss + arities = map (strictGenericLength . fst . collect) rhss -- This p', d' defn is safe because all the items being pushed -- are ptrs, so all have size 1 word. d' and p' reflect the stack -- after the closures have been allocated in the heap (but not -- filled in), and pointers to them parked on the stack. offsets = mkStackOffsets d (genericReplicate n_binds (wordSize platform)) - p' = Map.insertList (zipE xs offsets) p + p' = Map.insertList (zipEqual xs offsets) p d' = d + wordsToBytes platform n_binds - zipE = zipEqual "schemeE" -- ToDo: don't build thunks for things with no free variables build_thunk @@ -669,10 +603,9 @@ thunk_codes <- sequence compile_binds return (alloc_code `appOL` concatOL thunk_codes `appOL` body_code) -schemeE _d _s _p (StgTick (Breakpoint _ bp_id _ _) _rhs) - = panic ("schemeE: Breakpoint without let binding: " ++ - show bp_id ++ - " forgot to run bcPrep?") +schemeE _d _s _p (StgTick (Breakpoint _ bp_id _) _rhs) + = pprPanic "schemeE: Breakpoint without let binding:" + (ppr bp_id <+> text "forgot to run bcPrep?") -- ignore other kinds of tick schemeE d s p (StgTick _ rhs) = schemeE d s p rhs @@ -809,7 +742,10 @@ -> BcM BCInstrList doTailCall init_d s p fn args = do platform <- profilePlatform <$> getProfile + + -- Do tail call only after do_pushes init_d args (map (atomRep platform) args) + where do_pushes !d [] reps = do assert (null reps) return () @@ -1160,6 +1096,12 @@ -- ----------------------------------------------------------------------------- -- Case expressions +-- | Generate ByteCode for a case expression. +-- +-- Note that case BCOs may be "nested" within other parent BCOs and refer to +-- its parent's variables (as in the 'BCEnv' contains variables from parent +-- frames). For more details about the interaction between case BCOs and their +-- parent frames see Note [Case continuation BCOs]. doCase :: StackDepth -> Sequel @@ -1198,43 +1140,41 @@ -- When an alt is entered, it assumes the returned value is -- on top of the itbl; see Note [Return convention for non-tuple values] -- for details. - ret_frame_size_b :: StackDepth - ret_frame_size_b | ubx_tuple_frame = - (if profiling then 5 else 4) * wordSize platform - | otherwise = 2 * wordSize platform + ctoi_frame_header_w :: WordOff + ctoi_frame_header_w + | ubx_tuple_frame = + if profiling then 5 else 4 + | otherwise = 2 + -- The size of the ret_*_info frame header, whose frame returns the + -- value to the case continuation frame (ctoi_*_info) + ret_info_header_w :: WordOff + | ubx_tuple_frame = 3 + | otherwise = 1 + -- The stack space used to save/restore the CCCS when profiling save_ccs_size_b | profiling && not ubx_tuple_frame = 2 * wordSize platform | otherwise = 0 - -- The size of the return frame info table pointer if one exists - unlifted_itbl_size_b :: StackDepth - unlifted_itbl_size_b | ubx_tuple_frame = wordSize platform - | otherwise = 0 - (bndr_size, call_info, args_offsets) | ubx_tuple_frame = let bndr_reps = typePrimRep (idType bndr) (call_info, args_offsets) = layoutNativeCall profile NativeTupleReturn 0 id bndr_reps - in ( wordsToBytes platform (nativeCallSize call_info) + in ( nativeCallSize call_info , call_info , args_offsets ) - | otherwise = ( wordsToBytes platform (idSizeW platform bndr) + | otherwise = ( idSizeW platform bndr , voidTupleReturnInfo , [] ) - -- depth of stack after the return value has been pushed + -- Depth of stack after the return value has been pushed + -- This is the stack depth at the continuation. d_bndr = - d + ret_frame_size_b + bndr_size - - -- depth of stack after the extra info table for an unlifted return - -- has been pushed, if any. This is the stack depth at the - -- continuation. - d_alts = d + ret_frame_size_b + bndr_size + unlifted_itbl_size_b + d + wordsToBytes platform bndr_size -- Env in which to compile the alts, not including -- any vars bound by the alts themselves @@ -1246,13 +1186,13 @@ -- given an alt, return a discr and code for it. codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList) codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs} - = do rhs_code <- schemeE d_alts s p_alts rhs + = do rhs_code <- schemeE d_bndr s p_alts rhs return (NoDiscr, rhs_code) codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} -- primitive or nullary constructor alt: no need to UNPACK | null real_bndrs = do - rhs_code <- schemeE d_alts s p_alts rhs + rhs_code <- schemeE d_bndr s p_alts rhs return (my_discr alt, rhs_code) | isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty = let bndr_ty = idPrimRepU . fromNonVoid @@ -1264,7 +1204,7 @@ bndr_ty (assertNonVoidIds bndrs) - stack_bot = d_alts + stack_bot = d_bndr p' = Map.insertList [ (arg, tuple_start - @@ -1282,7 +1222,7 @@ (addIdReps (assertNonVoidIds real_bndrs)) size = WordOff tot_wds - stack_bot = d_alts + wordsToBytes platform size + stack_bot = d_bndr + wordsToBytes platform size -- convert offsets from Sp into offsets into the virtual stack p' = Map.insertList @@ -1382,30 +1322,170 @@ alt_stuff <- mapM codeAlt alts alt_final0 <- mkMultiBranch maybe_ncons alt_stuff - let alt_final - | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0 - | otherwise = alt_final0 + let + -- drop the stg_ctoi_*_info header... + alt_final1 = SLIDE bndr_size ctoi_frame_header_w `consOL` alt_final0 + + -- after dropping the stg_ret_*_info header + alt_final2 = SLIDE 0 ret_info_header_w `consOL` alt_final1 + + -- When entering a case continuation BCO, the stack is always headed + -- by the stg_ret frame and the stg_ctoi frame that returned to it. + -- See Note [Stack layout when entering run_BCO] + -- + -- Right after the breakpoint instruction, a case continuation BCO + -- drops the stg_ret and stg_ctoi frame headers (see alt_final1, + -- alt_final2), leaving the stack with the scrutinee followed by the + -- free variables (with depth==d_bndr) + alt_final <- getLastBreakTick >>= \case + Just (Breakpoint tick_ty tick_id fvs) + | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env) + -- Construct an internal breakpoint to put at the start of this case + -- continuation BCO, for step-out. + -- See Note [Debugger: Stepout internal break locs] + -> do + + -- same fvs available in the surrounding tick are available in the case continuation + + -- The variable offsets into the yielded AP_STACK are adjusted + -- differently because a case continuation AP_STACK has the + -- additional stg_ret and stg_ctoi frame headers + -- (as per Note [Stack layout when entering run_BCO]): + let firstVarOff = ret_info_header_w+bndr_size+ctoi_frame_header_w + idOffSets = map (fmap (second (+firstVarOff))) $ + getVarOffSets platform d p fvs + ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) + toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) + toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty + (Left (InternalBreakLoc tick_id)) + + mibi <- newBreakInfo breakInfo + return $ case mibi of + Nothing -> alt_final2 + Just ibi -> BRK_FUN ibi `consOL` alt_final2 + _ -> pure alt_final2 + add_bco_name <- shouldAddBcoName let alt_bco_name = getName bndr alt_bco = mkProtoBCO platform add_bco_name alt_bco_name alt_final (Left alts) 0{-no arity-} bitmap_size bitmap True{-is alts-} - scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b) - (d + ret_frame_size_b + save_ccs_size_b) + scrut_code <- schemeE (d + wordsToBytes platform ctoi_frame_header_w + save_ccs_size_b) + (d + wordsToBytes platform ctoi_frame_header_w + save_ccs_size_b) p scrut - alt_bco' <- emitBc alt_bco if ubx_tuple_frame - then do tuple_bco <- emitBc (tupleBCO platform call_info args_offsets) - return (PUSH_ALTS_TUPLE alt_bco' call_info tuple_bco + then do let tuple_bco = tupleBCO platform call_info args_offsets + return (PUSH_ALTS_TUPLE alt_bco call_info tuple_bco `consOL` scrut_code) else let scrut_rep = case non_void_arg_reps of [] -> V [rep] -> rep _ -> panic "schemeE(StgCase).push_alts" - in return (PUSH_ALTS alt_bco' scrut_rep `consOL` scrut_code) + in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code) +{- +Note [Debugger: Stepout internal break locs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Step-out tells the interpreter to run until the current function +returns to where it was called from, and stop there. +This is achieved by enabling the BRK_FUN found on the first RET_BCO +frame on the stack (See [Note Debugger: Step-out]). + +Case continuation BCOs (which select an alternative branch) must +therefore be headed by a BRK_FUN. An example: + + f x = case g x of <--- end up here + 1 -> ... + 2 -> ... + + g y = ... <--- step out from here + +- `g` will return a value to the case continuation BCO in `f` +- The case continuation BCO will receive the value returned from g +- Match on it and push the alternative continuation for that branch +- And then enter that alternative. + +If we step-out of `g`, the first RET_BCO on the stack is the case +continuation of `f` -- execution should stop at its start, before +selecting an alternative. (One might ask, "why not enable the breakpoint +in the alternative instead?", because the alternative continuation is +only pushed to the stack *after* it is selected by the case cont. BCO) + +However, the case cont. BCO is not associated with any source-level +tick, it is merely the glue code which selects alternatives which do +have source level ticks. Therefore, we have to come up at code +generation time with a breakpoint location ('InternalBreakLoc') to +display to the user when it is stopped there. + +Our solution is to use the last tick seen just before reaching the case +continuation. This is robust because a case continuation will thus +always have a relevant breakpoint location: + + - The source location will be the last source-relevant expression + executed before the continuation is pushed + + - So the source location will point to the thing you've just stepped + out of + + - The variables available are the same as the ones bound just before entering + + - Doing :step-local from there will put you on the selected + alternative (which at the source level may also be the e.g. next + line in a do-block) + +Examples, using angle brackets (<<...>>) to denote the breakpoint span: + + f x = case <> {- step in here -} of + 1 -> ... + 2 -> ...> + + g y = <<...>> <--- step out from here + + ... + + f x = < ... + 2 -> ...>> + + doing :step-local ... + + f x = case g x of + 1 -> <<...>> <--- stop in the alternative + 2 -> ... + +A second example based on T26042d2, where the source is a do-block IO +action, optimised to a chain of `case expressions`. + + main = do + putStrLn "hello1" + <> <--- step-in here + putStrLn "hello3" + putStrLn "hello4" + + f = do + <> <--- step-out from here + putStrLn "hello2.2" + + ... + + main = do + putStrLn "hello1" + <> <--- end up here again, the previously executed expression + putStrLn "hello3" + putStrLn "hello4" + + doing step/step-local ... + + main = do + putStrLn "hello1" + f + <> <--- straight to the next line + putStrLn "hello4" +-} + -- ----------------------------------------------------------------------------- -- Deal with tuples @@ -1695,10 +1775,10 @@ -} -tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> ProtoBCO Name tupleBCO platform args_info args = - mkProtoBCO platform False invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + mkProtoBCO platform Nothing invented_name body_code (Left []) + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The tuple BCO is never referred to by name, so we can get away @@ -1716,10 +1796,10 @@ body_code = mkSlideW 0 1 -- pop frame header `snocOL` RETURN_TUPLE -- and add it again -primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name +primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> ProtoBCO Name primCallBCO platform args_info args = - mkProtoBCO platform False invented_name body_code (Left []) - 0{-no arity-} bitmap_size bitmap False{-is alts-} + mkProtoBCO platform Nothing invented_name body_code (Left []) + 0{-no arity-} bitmap_size bitmap False{-not alts-} where {- The primcall BCO is never referred to by name, so we can get away @@ -1825,7 +1905,7 @@ massert (off == dd + szb) go (dd + szb) (push:pushes) cs push_args <- go d [] shifted_args_offsets - args_bco <- emitBc (primCallBCO platform args_info prim_args_offsets) + let args_bco = primCallBCO platform args_info prim_args_offsets return $ mconcat push_args `appOL` (push_target `consOL` push_info `consOL` @@ -2003,13 +2083,10 @@ let ffires = primRepToFFIType platform r_rep ffiargs = map (primRepToFFIType platform) a_reps - interp <- hscInterp <$> getHscEnv - token <- ioToBc $ interpCmd interp (PrepFFI ffiargs ffires) - recordFFIBc token let -- do the call - do_call = unitOL (CCALL stk_offset token flags) + do_call = unitOL (CCALL stk_offset (FFIInfo ffiargs ffires) flags) where flags = case safety of PlaySafe -> 0x0 PlayInterruptible -> 0x1 @@ -2111,7 +2188,7 @@ extract_constr_Names ty | rep_ty <- unwrapType ty , Just tyc <- tyConAppTyCon_maybe rep_ty - , isDataTyCon tyc + , isBoxedDataTyCon tyc = map (getName . dataConWorkId) (tyConDataCons tyc) -- NOTE: use the worker name, not the source name of -- the DataCon. See "GHC.Core.DataCon" for details. @@ -2160,7 +2237,7 @@ implement_tagToId d s p arg names = assert (notNull names) $ do (push_arg, arg_bytes) <- pushAtom d p arg - labels <- getLabelsBc (genericLength names) + labels <- getLabelsBc (strictGenericLength names) label_fail <- getLabelBc label_exit <- getLabelBc dflags <- getDynFlags @@ -2197,9 +2274,7 @@ -- to 5 and not to 4. Stack locations are numbered from zero, so a -- depth 6 stack has valid words 0 .. 5. -pushAtom - :: StackDepth -> BCEnv -> StgArg -> BcM (BCInstrList, ByteOff) - +pushAtom :: StackDepth -> BCEnv -> StgArg -> BcM (BCInstrList, ByteOff) -- See Note [Empty case alternatives] in GHC.Core -- and Note [Bottoming expressions] in GHC.Core.Utils: -- The scrutinee of an empty case evaluates to bottom @@ -2255,14 +2330,17 @@ _ -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do + let varTy = idType var + massertPpr (definitelyLiftedType varTy) $ + vcat [ text "pushAtom: unhandled unlifted type" + , text "var:" <+> ppr var <+> dcolon <+> ppr varTy <> dcolon <+> ppr (typeKind varTy) + ] return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) @@ -2271,7 +2349,13 @@ platform <- targetPlatform <$> getDynFlags let code :: PrimRep -> BcM (BCInstrList, ByteOff) code rep = - return (padding_instr `snocOL` instr, size_bytes + padding_bytes) + -- TODO: It's a bit silly to use up to four instructions to put a single literal on the stack. + -- Lot's of better ways to do this. Add a instruction to push it as full word. + -- Store the literal as full word and push it as full word. + -- Maybe more, but for now this will do. + case platformByteOrder platform of + LittleEndian -> return (padding_instr `snocOL` instr, size_bytes + padding_bytes) + BigEndian -> return (instr `consOL` padding_instr, size_bytes + padding_bytes) where size_bytes = ByteOff $ primRepSizeB platform rep @@ -2597,106 +2681,96 @@ -- ----------------------------------------------------------------------------- -- The bytecode generator's monad +-- | Read only environment for generating ByteCode +data BcM_Env + = BcM_Env + { bcm_hsc_env :: !HscEnv + , bcm_module :: !Module -- current module (for breakpoints) + , modBreaks :: !(Maybe ModBreaks) + , last_bp_tick :: !(Maybe StgTickish) + } + data BcM_State = BcM_State - { bcm_hsc_env :: HscEnv - , thisModule :: Module -- current module (for breakpoints) - , nextlabel :: Word32 -- for generating local labels - , ffis :: [FFIInfo] -- ffi info blocks, to free later - -- Should be free()d when it is GCd - , modBreaks :: Maybe ModBreaks -- info about breakpoints - - , breakInfo :: IntMap CgBreakInfo -- ^ Info at breakpoint occurrence. - -- Indexed with breakpoint *info* index. - -- See Note [Breakpoint identifiers] - -- in GHC.Types.Breakpoint - , breakInfoIdx :: !Int -- ^ Next index for breakInfo array + { nextlabel :: !Word32 -- ^ For generating local labels + , breakInfoIdx :: !Int -- ^ Next index for breakInfo array + , breakInfo :: !(IntMap CgBreakInfo) + -- ^ Info at breakpoints occurrences. Indexed with + -- 'InternalBreakpointId'. See Note [Breakpoint identifiers] in + -- GHC.ByteCode.Breakpoints. } -newtype BcM r = BcM (BcM_State -> IO (BcM_State, r)) deriving (Functor) - -ioToBc :: IO a -> BcM a -ioToBc io = BcM $ \st -> do - x <- io - return (st, x) - -runBc :: HscEnv -> Module -> Maybe ModBreaks - -> BcM r - -> IO (BcM_State, r) -runBc hsc_env this_mod modBreaks (BcM m) - = m (BcM_State hsc_env this_mod 0 [] modBreaks IntMap.empty 0) - -thenBc :: BcM a -> (a -> BcM b) -> BcM b -thenBc (BcM expr) cont = BcM $ \st0 -> do - (st1, q) <- expr st0 - let BcM k = cont q - (st2, r) <- k st1 - return (st2, r) - -thenBc_ :: BcM a -> BcM b -> BcM b -thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do - (st1, _) <- expr st0 - (st2, r) <- cont st1 - return (st2, r) - -returnBc :: a -> BcM a -returnBc result = BcM $ \st -> (return (st, result)) - -instance Applicative BcM where - pure = returnBc - (<*>) = ap - (*>) = thenBc_ +newtype BcM r = BcM (BcM_Env -> BcM_State -> IO (r, BcM_State)) + deriving (Functor, Applicative, Monad, MonadIO) + via (ReaderT BcM_Env (StateT BcM_State IO)) -instance Monad BcM where - (>>=) = thenBc - (>>) = (*>) +runBc :: HscEnv -> Module -> Maybe ModBreaks -> BcM r -> IO (r, BcM_State) +runBc hsc_env this_mod mbs (BcM m) + = m (BcM_Env hsc_env this_mod mbs Nothing) (BcM_State 0 0 IntMap.empty) instance HasDynFlags BcM where - getDynFlags = BcM $ \st -> return (st, hsc_dflags (bcm_hsc_env st)) + getDynFlags = hsc_dflags <$> getHscEnv getHscEnv :: BcM HscEnv -getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st) +getHscEnv = BcM $ \env st -> return (bcm_hsc_env env, st) getProfile :: BcM Profile getProfile = targetProfile <$> getDynFlags -shouldAddBcoName :: BcM Bool -shouldAddBcoName = gopt Opt_AddBcoName <$> getDynFlags - -emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name) -emitBc bco - = BcM $ \st -> return (st{ffis=[]}, bco (ffis st)) - -recordFFIBc :: RemotePtr C_ffi_cif -> BcM () -recordFFIBc a - = BcM $ \st -> return (st{ffis = FFIInfo a : ffis st}, ()) +shouldAddBcoName :: BcM (Maybe Module) +shouldAddBcoName = do + add <- gopt Opt_AddBcoName <$> getDynFlags + if add + then Just <$> getCurrentModule + else return Nothing getLabelBc :: BcM LocalLabel -getLabelBc - = BcM $ \st -> do let nl = nextlabel st - when (nl == maxBound) $ - panic "getLabelBc: Ran out of labels" - return (st{nextlabel = nl + 1}, LocalLabel nl) +getLabelBc = BcM $ \_ st -> + do let nl = nextlabel st + when (nl == maxBound) $ + panic "getLabelBc: Ran out of labels" + return (LocalLabel nl, st{nextlabel = nl + 1}) getLabelsBc :: Word32 -> BcM [LocalLabel] -getLabelsBc n - = BcM $ \st -> let ctr = nextlabel st - in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1]) +getLabelsBc n = BcM $ \_ st -> + let ctr = nextlabel st + in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n}) -newBreakInfo :: CgBreakInfo -> BcM Int -newBreakInfo info = BcM $ \st -> - let ix = breakInfoIdx st - st' = st - { breakInfo = IntMap.insert ix info (breakInfo st) - , breakInfoIdx = ix + 1 - } - in return (st', ix) +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId) +newBreakInfo info = BcM $ \env st -> do + -- if we're not generating ModBreaks for this module for some reason, we + -- can't store breakpoint occurrence information. + case modBreaks env of + Nothing -> pure (Nothing, st) + Just modBreaks -> do + let ix = breakInfoIdx st + st' = st + { breakInfo = IntMap.insert ix info (breakInfo st) + , breakInfoIdx = ix + 1 + } + return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st') getCurrentModule :: BcM Module -getCurrentModule = BcM $ \st -> return (st, thisModule st) +getCurrentModule = BcM $ \env st -> return (bcm_module env, st) -getCurrentModBreaks :: BcM (Maybe ModBreaks) -getCurrentModBreaks = BcM $ \st -> return (st, modBreaks st) +withBreakTick :: StgTickish -> BcM a -> BcM a +withBreakTick bp (BcM act) = BcM $ \env st -> + act env{last_bp_tick=Just bp} st +getLastBreakTick :: BcM (Maybe StgTickish) +getLastBreakTick = BcM $ \env st -> + pure (last_bp_tick env, st) + tickFS :: FastString tickFS = fsLit "ticked" + +-- Dehydrating CgBreakInfo + +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo +dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid = + CgBreakInfo + { cgb_tyvars = map toIfaceTvBndr ty_vars + , cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets + , cgb_resty = toIfaceType tick_ty + , cgb_tick_id = bid + } diff --git a/GHC/StgToCmm.hs b/GHC/StgToCmm.hs --- a/GHC/StgToCmm.hs +++ b/GHC/StgToCmm.hs @@ -78,7 +78,7 @@ -- Output as a stream, so codegen can -- be interleaved with output -codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons +codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) tycons cost_centre_info stg_binds = do { -- cg: run the code generator, and yield the resulting CmmGroup -- Using an IORef to store the state is a bit crude, but otherwise @@ -117,19 +117,12 @@ ; cg (mkModuleInit cost_centre_info) ; mapM_ (cg . cgTopBinding logger tmpfs cfg) stg_binds - -- Put datatype_stuff after code_stuff, because the + -- Put datatype_stuff (cgTyCon) after code_stuff (cgTopBinding), because the -- datatype closure table (for enumeration types) to -- (say) PrelBase_True_closure, which is defined in -- code_stuff - ; let do_tycon tycon = do - -- Generate a table of static closures for an - -- enumeration type Note that the closure pointers are - -- tagged. - when (isEnumerationTyCon tycon) $ cg (cgEnumerationTyCon tycon) - -- Emit normal info_tables, for data constructors defined in this module. - mapM_ (cg . cgDataCon DefinitionSite) (tyConDataCons tycon) - ; mapM_ do_tycon data_tycons + ; mapM_ (cg . cgTyCon) tycons -- Emit special info tables for everything used in this module -- This will only do something if `-fdistinct-info-tables` is turned on. @@ -285,18 +278,37 @@ --------------------------------------------------------------- --- Generating static stuff for algebraic data types +-- Generating static stuff for algebraic data types, including +-- * entry code for each data con +-- * info table for each data con +-- * for enumerations, a table of all the closures --------------------------------------------------------------- +--------------------------------------------------------------- +-- Data type constructors +--------------------------------------------------------------- +cgTyCon :: TyCon -> FCode () +-- Generate static data for each algebraic data type +cgTyCon tycon + | not (isBoxedDataTyCon tycon) -- Type families, newtypes, and `type data` constructors + = return () + | otherwise -- An honest-to-goodness algebraic data type + = do { -- Emit normal info_tables, for data constructors defined in this module. + mapM_ (cgDataCon DefinitionSite) (tyConDataCons tycon) + + ; when (isEnumerationTyCon tycon) $ + cgEnumerationTyCon tycon } + cgEnumerationTyCon :: TyCon -> FCode () +-- Generate a table of static closures for an enumeration type. +-- Note that the closure pointers in the table are tagged. cgEnumerationTyCon tycon = do platform <- getPlatform emitRODataLits (mkClosureTableLabel (tyConName tycon) NoCafRefs) [ CmmLabelOff (mkClosureLabel (dataConName con) NoCafRefs) (tagForCon platform con) | con <- tyConDataCons tycon] - cgDataCon :: ConInfoTableLocation -> DataCon -> FCode () -- Generate the entry code, info tables, and (for niladic constructor) diff --git a/GHC/StgToCmm/Bind.hs b/GHC/StgToCmm/Bind.hs --- a/GHC/StgToCmm/Bind.hs +++ b/GHC/StgToCmm/Bind.hs @@ -391,7 +391,7 @@ -- thunk (e.g. its type) (#949) , idArity fun_id == unknownArity -- don't spoil a known call -- Ha! an Ap thunk - , not check_tags -- See Note [Tag inference debugging] + , not check_tags -- See Note [EPT enforcement debugging] = cgRhsStdThunk bndr lf_info payload where diff --git a/GHC/StgToCmm/CgUtils.hs b/GHC/StgToCmm/CgUtils.hs --- a/GHC/StgToCmm/CgUtils.hs +++ b/GHC/StgToCmm/CgUtils.hs @@ -147,7 +147,7 @@ -- | Fixup global registers so that they assign to locations within the -- RegTable if they aren't pinned for the current target. -fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl +fixStgRegisters :: Platform -> GenCmmDecl d h (GenCmmGraph CmmNode) -> GenCmmDecl d h (GenCmmGraph CmmNode) fixStgRegisters _ top@(CmmData _ _) = top fixStgRegisters platform (CmmProc info lbl live graph) = diff --git a/GHC/StgToCmm/Closure.hs b/GHC/StgToCmm/Closure.hs --- a/GHC/StgToCmm/Closure.hs +++ b/GHC/StgToCmm/Closure.hs @@ -98,7 +98,7 @@ import Data.Coerce (coerce) import qualified Data.ByteString.Char8 as BS8 import GHC.StgToCmm.Config -import GHC.Stg.InferTags.TagSig (isTaggedSig) +import GHC.Stg.EnforceEpt.TagSig (isTaggedSig) ----------------------------------------------------------------------------- -- Data types and synonyms @@ -508,8 +508,8 @@ -- or constructor), so just return it. | InferedReturnIt -- A properly tagged value, as determined by tag inference. - -- See Note [Tag Inference] and Note [Tag inference passes] in - -- GHC.Stg.InferTags. + -- See Note [Evaluated and Properly Tagged] + -- and Note [EPT enforcement] in GHC.Stg.EnforceEpt. -- It behaves /precisely/ like `ReturnIt`, except that when debugging is -- enabled we emit an extra assertion to check that the returned value is -- properly tagged. We can use this as a check that tag inference is working @@ -583,8 +583,8 @@ n_args _cg_loc _self_loop_info | Just sig <- idTagSig_maybe id - , isTaggedSig sig -- Infered to be already evaluated by Tag Inference - , n_args == 0 -- See Note [Tag Inference] + , isTaggedSig sig -- Infered to be already evaluated by EPT analysis + , n_args == 0 -- See Note [EPT enforcement] = InferedReturnIt | is_fun -- it *might* be a function, so we must "call" it (which is always safe) @@ -621,12 +621,12 @@ getCallMethod cfg name id (LFUnknown might_be_a_function) n_args _cg_locs _self_loop_info | n_args == 0 , Just sig <- idTagSig_maybe id - , isTaggedSig sig -- Infered to be already evaluated by Tag Inference + , isTaggedSig sig -- Infered to be already evaluated by EPT analysis -- When profiling we must enter all potential functions to make sure we update the SCC -- even if the function itself is already evaluated. -- See Note [Evaluating functions with profiling] in rts/Apply.cmm , not (profileIsProfiling (stgToCmmProfile cfg) && might_be_a_function) - = InferedReturnIt -- See Note [Tag Inference] + = InferedReturnIt -- See Note [EPT enforcement] | might_be_a_function = SlowCall diff --git a/GHC/StgToCmm/Config.hs b/GHC/StgToCmm/Config.hs --- a/GHC/StgToCmm/Config.hs +++ b/GHC/StgToCmm/Config.hs @@ -72,6 +72,7 @@ , stgToCmmAllowIntMul2Instr :: !Bool -- ^ Allowed to generate IntMul2 instruction , stgToCmmAllowWordMul2Instr :: !Bool -- ^ Allowed to generate WordMul2 instruction , stgToCmmAllowFMAInstr :: FMASign -> Bool -- ^ Allowed to generate FMA instruction + , stgToCmmAllowIntWord64X2MinMax :: !Bool -- ^ Allowed to generate min/max instructions for Int64X2/Word64X2 , stgToCmmTickyAP :: !Bool -- ^ Disable use of precomputed standard thunks. , stgToCmmSaveFCallTargetToLocal :: !Bool -- ^ Save a foreign call target to a Cmm local, see -- Note [Saving foreign call target to local] for details diff --git a/GHC/StgToCmm/Expr.hs b/GHC/StgToCmm/Expr.hs --- a/GHC/StgToCmm/Expr.hs +++ b/GHC/StgToCmm/Expr.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} @@ -56,7 +55,7 @@ import Control.Monad ( unless, void ) import Control.Arrow ( first ) import Data.List ( partition ) -import GHC.Stg.InferTags.TagSig (isTaggedSig) +import GHC.Stg.EnforceEpt.TagSig (isTaggedSig) import GHC.Platform.Profile (profileIsProfiling) ------------------------------------------------------------------------ @@ -178,7 +177,7 @@ cgLetNoEscapeRhs join_id local_cc bndr rhs = do { (info, rhs_code) <- cgLetNoEscapeRhsBody local_cc bndr rhs - ; let (bid, _) = expectJust "cgLetNoEscapeRhs" $ maybeLetNoEscape info + ; let (bid, _) = expectJust $ maybeLetNoEscape info ; let code = do { (_, body) <- getCodeScoped rhs_code ; emitOutOfLine bid (first (<*> mkBranch join_id) body) } ; return (info, code) @@ -729,7 +728,9 @@ ; tagged_cmms <- cgAltRhss gc_plan bndr alts ; let bndr_reg = CmmLocal (idToReg platform bndr) - (DEFAULT,deflt) = head tagged_cmms + deflt = case tagged_cmms of + (DEFAULT,deflt):_ -> deflt + _ -> panic "cgAlts PrimAlt" -- PrimAlts always have a DEFAULT case -- and it always comes first diff --git a/GHC/StgToCmm/Foreign.hs b/GHC/StgToCmm/Foreign.hs --- a/GHC/StgToCmm/Foreign.hs +++ b/GHC/StgToCmm/Foreign.hs @@ -720,7 +720,7 @@ -- Precondition: args and typs have the same length -- See Note [Unlifted boxed arguments to foreign calls] getFCallArgs args typ - = do { mb_cmms <- mapM get (zipEqual "getFCallArgs" args (collectStgFArgTypes typ)) + = do { mb_cmms <- mapM get (zipEqual args (collectStgFArgTypes typ)) ; return (catMaybes mb_cmms) } where get (arg,typ) diff --git a/GHC/StgToCmm/Layout.hs b/GHC/StgToCmm/Layout.hs --- a/GHC/StgToCmm/Layout.hs +++ b/GHC/StgToCmm/Layout.hs @@ -64,6 +64,7 @@ import Control.Monad import GHC.StgToCmm.Config (stgToCmmPlatform) import GHC.StgToCmm.Types +import Data.List.NonEmpty (nonEmpty) ------------------------------------------------------------------------ -- Call and return sequences @@ -376,24 +377,25 @@ -- pushing on the stack for "extra" arguments to a function which requires -- fewer arguments than we currently have. slowArgs :: Platform -> [(ArgRep, Maybe CmmExpr)] -> DoSCCProfiling -> [(ArgRep, Maybe CmmExpr)] -slowArgs _ [] _ = mempty slowArgs platform args sccProfilingEnabled -- careful: reps contains voids (V), but args does not - | sccProfilingEnabled = save_cccs ++ this_pat ++ slowArgs platform rest_args sccProfilingEnabled - | otherwise = this_pat ++ slowArgs platform rest_args sccProfilingEnabled - where - (arg_pat, n) = slowCallPattern (map fst args) - (call_args, rest_args) = splitAt n args + = case nonEmpty args of + Nothing -> mempty + Just args1 + | sccProfilingEnabled -> save_cccs ++ this_pat ++ slowArgs platform rest_args sccProfilingEnabled + | otherwise -> this_pat ++ slowArgs platform rest_args sccProfilingEnabled + where + (arg_pat, n) = slowCallPattern (fmap fst args) + (call_args, rest_args) = splitAt n args - stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat - this_pat = (N, Just (mkLblExpr stg_ap_pat)) : call_args - save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just $ cccsExpr platform)] - save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit $ "stg_restore_cccs_" ++ arg_reps) - arg_reps = - case maximum (map fst args) of - V64 -> "v64" - V32 -> "v32" - V16 -> "v16" - _ -> "d" + stg_ap_pat = mkCmmRetInfoLabel rtsUnitId arg_pat + this_pat = (N, Just (mkLblExpr stg_ap_pat)) : call_args + save_cccs = [(N, Just (mkLblExpr save_cccs_lbl)), (N, Just $ cccsExpr platform)] + save_cccs_lbl = mkCmmRetInfoLabel rtsUnitId (fsLit $ "stg_restore_cccs_" ++ arg_reps) + arg_reps = case maximum (fmap fst args1) of + V64 -> "v64" + V32 -> "v32" + V16 -> "v16" + _ -> "d" diff --git a/GHC/StgToCmm/Lit.hs b/GHC/StgToCmm/Lit.hs --- a/GHC/StgToCmm/Lit.hs +++ b/GHC/StgToCmm/Lit.hs @@ -51,7 +51,7 @@ CmmLit <$> newByteStringCLit s -- not unpackFS; we want the UTF-8 byte stream. cgLit (LitRubbish _ rep) = - case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants] + case expectOnly prim_reps of -- Note [Post-unarisation invariants] BoxedRep _ -> idInfoToAmode <$> getCgIdInfo unitDataConId AddrRep -> cgLit LitNullAddr VecRep n elem -> do diff --git a/GHC/StgToCmm/Prim.hs b/GHC/StgToCmm/Prim.hs --- a/GHC/StgToCmm/Prim.hs +++ b/GHC/StgToCmm/Prim.hs @@ -46,6 +46,7 @@ import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic +import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe import Control.Monad (liftM, when, unless, zipWithM_) @@ -1533,20 +1534,28 @@ (VecSubOp IntVec n w) -> opTranslate (MO_V_Sub n w) (VecMulOp IntVec n w) -> opTranslate (MO_V_Mul n w) (VecDivOp IntVec _ _) -> \_ -> panic "unsupported primop" - (VecQuotOp IntVec n w) -> opTranslate (MO_VS_Quot n w) - (VecRemOp IntVec n w) -> opTranslate (MO_VS_Rem n w) + (VecQuotOp IntVec n w) -> opCallish (MO_VS_Quot n w) + (VecRemOp IntVec n w) -> opCallish (MO_VS_Rem n w) (VecNegOp IntVec n w) -> opTranslate (MO_VS_Neg n w) + (VecMinOp IntVec 2 W64) + | not allowIntWord64X2MinMax -> opCallish MO_I64X2_Min (VecMinOp IntVec n w) -> opTranslate (MO_VS_Min n w) + (VecMaxOp IntVec 2 W64) + | not allowIntWord64X2MinMax -> opCallish MO_I64X2_Max (VecMaxOp IntVec n w) -> opTranslate (MO_VS_Max n w) (VecAddOp WordVec n w) -> opTranslate (MO_V_Add n w) (VecSubOp WordVec n w) -> opTranslate (MO_V_Sub n w) (VecMulOp WordVec n w) -> opTranslate (MO_V_Mul n w) (VecDivOp WordVec _ _) -> \_ -> panic "unsupported primop" - (VecQuotOp WordVec n w) -> opTranslate (MO_VU_Quot n w) - (VecRemOp WordVec n w) -> opTranslate (MO_VU_Rem n w) + (VecQuotOp WordVec n w) -> opCallish (MO_VU_Quot n w) + (VecRemOp WordVec n w) -> opCallish (MO_VU_Rem n w) (VecNegOp WordVec _ _) -> \_ -> panic "unsupported primop" + (VecMinOp WordVec 2 W64) + | not allowIntWord64X2MinMax -> opCallish MO_W64X2_Min (VecMinOp WordVec n w) -> opTranslate (MO_VU_Min n w) + (VecMaxOp WordVec 2 W64) + | not allowIntWord64X2MinMax -> opCallish MO_W64X2_Max (VecMaxOp WordVec n w) -> opTranslate (MO_VU_Max n w) -- Vector FMA instructions @@ -1716,9 +1725,6 @@ ReadMVarOp -> alwaysExternal TryReadMVarOp -> alwaysExternal IsEmptyMVarOp -> alwaysExternal - NewIOPortOp -> alwaysExternal - ReadIOPortOp -> alwaysExternal - WriteIOPortOp -> alwaysExternal DelayOp -> alwaysExternal WaitReadOp -> alwaysExternal WaitWriteOp -> alwaysExternal @@ -1762,10 +1768,12 @@ WhereFromOp -> alwaysExternal GetApStackValOp -> alwaysExternal ClearCCSOp -> alwaysExternal + AnnotateStackOp -> alwaysExternal TraceEventOp -> alwaysExternal TraceEventBinaryOp -> alwaysExternal TraceMarkerOp -> alwaysExternal SetThreadAllocationCounter -> alwaysExternal + SetOtherThreadAllocationCounter -> alwaysExternal KeepAliveOp -> alwaysExternal where @@ -1860,6 +1868,7 @@ allowWord2Mul = stgToCmmAllowWordMul2Instr cfg allowArith64 = stgToCmmAllowArith64 cfg allowQuot64 = stgToCmmAllowQuot64 cfg + allowIntWord64X2MinMax = stgToCmmAllowIntWord64X2MinMax cfg -- a bit of a hack, for certain code generaters, e.g. PPC, and i386 we -- continue to use the cmm versions of these functions instead of inline @@ -2271,17 +2280,21 @@ mkAssign xhyl (mul (topHalf arg_x) (bottomHalf arg_y)), mkAssign r - (sum [topHalf (CmmReg xlyl), - bottomHalf (CmmReg xhyl), - bottomHalf (CmmReg xlyh)]), + (sum $ + topHalf (CmmReg xlyl) :| + bottomHalf (CmmReg xhyl) : + bottomHalf (CmmReg xlyh) : + []), mkAssign (CmmLocal res_l) (or (bottomHalf (CmmReg xlyl)) (toTopHalf (CmmReg r))), mkAssign (CmmLocal res_h) - (sum [mul (topHalf arg_x) (topHalf arg_y), - topHalf (CmmReg xhyl), - topHalf (CmmReg xlyh), - topHalf (CmmReg r)])] + (sum $ + mul (topHalf arg_x) (topHalf arg_y) :| + topHalf (CmmReg xhyl) : + topHalf (CmmReg xlyh) : + topHalf (CmmReg r) : + [])] genericWordMul2Op _ _ = panic "genericWordMul2Op" genericIntMul2Op :: GenericOp @@ -2724,13 +2737,15 @@ doShuffleOp :: CmmType -> [CmmExpr] -> LocalReg -> FCode () doShuffleOp ty (v1:v2:idxs) res | isVecType ty + -- The type checker ensures that the indices have the correct length, + -- so we only need to check whether the indices are constants and within the valid range. = case mapMaybe idx_maybe idxs of is | length is == len -> emitAssign (CmmLocal res) (CmmMachOp (mo is) [v1,v2]) | otherwise - -> pprPanic "doShuffleOp" $ - vcat [ text "shuffle indices must be literals, 0 <= i <" <+> ppr len ] + -> pgmErrorDoc "Vector shuffle:" $ + vcat [ text "shuffle indices must be literals, 0 <= i <" <+> ppr (2 * len) ] | otherwise = pprPanic "doShuffleOp" $ vcat [ text "non-vector argument type:" <+> ppr ty ] @@ -2952,7 +2967,7 @@ let byteArrayAlignment = wordAlignment platform srcOffAlignment = cmmExprAlignment src_off dstOffAlignment = cmmExprAlignment dst_off - align = minimum [byteArrayAlignment, srcOffAlignment, dstOffAlignment] + align = minimum (byteArrayAlignment :| srcOffAlignment : dstOffAlignment : []) dst_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform dst (arrWordsHdrSize profile)) dst_off src_p <- assignTempE $ cmmOffsetExpr platform (cmmOffsetB platform src (arrWordsHdrSize profile)) src_off copy src dst dst_p src_p n align diff --git a/GHC/StgToCmm/TagCheck.hs b/GHC/StgToCmm/TagCheck.hs --- a/GHC/StgToCmm/TagCheck.hs +++ b/GHC/StgToCmm/TagCheck.hs @@ -175,4 +175,3 @@ then return () else pprPanic "Arg not tagged as expected" (ppr msg <+> ppr arg) - diff --git a/GHC/StgToJS/Apply.hs b/GHC/StgToJS/Apply.hs --- a/GHC/StgToJS/Apply.hs +++ b/GHC/StgToJS/Apply.hs @@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -46,11 +47,13 @@ import GHC.StgToJS.Symbols import GHC.StgToJS.Types import GHC.StgToJS.Utils +import GHC.StgToJS.Linker.Utils (decodeModifiedUTF8) import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre import GHC.Types.RepType (mightBeFunTy) +import GHC.Types.Literal import GHC.Stg.Syntax @@ -86,7 +89,6 @@ , moveRegs2 ] - -- | Generate an application of some args to an Id. -- -- The case where args is null is common as it's used to generate the evaluation @@ -98,6 +100,84 @@ -> [StgArg] -> G (JStgStat, ExprResult) genApp ctx i args + -- Test case moved to T24744 + -- See: https://github.com/ghcjs/ghcjs/blob/b7711fbca7c3f43a61f1dba526e6f2a2656ef44c/src/Gen2/Generator.hs#L876 + -- Comment by Luite Stegeman + -- Special cases for JSString literals. + -- We could handle unpackNBytes# here, but that's probably not common + -- enough to warrant a special case. + -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588/#note_503978 + -- Comment by Jeffrey Young + -- We detect if the Id is unsafeUnpackJSStringUtf8## applied to a string literal, + -- if so then we convert the unsafeUnpack to a call to h$decode. + | [StgVarArg v] <- args + , idName i == unsafeUnpackJSStringUtf8ShShName + -- See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10588 + -- Comment by Josh Meredith + -- `typex_expr` can throw an error for certain bindings so it's important + -- that this condition comes after matching on the function name + , [top] <- concatMap typex_expr (ctxTarget ctx) + = (,ExprInline) . (|=) top . app hdDecodeUtf8Z <$> varsForId v + + -- Test case T23479 + | [StgLitArg (LitString bs)] <- args + , Just d <- decodeModifiedUTF8 bs + , idName i == unsafeUnpackJSStringUtf8ShShName + , [top] <- concatMap typex_expr (ctxTarget ctx) + = return . (,ExprInline) $ top |= toJExpr d + + -- Test case T24495 with single occurrence at -02 and third occurrence at -01 + -- Moved back from removal at https://gitlab.haskell.org/ghc/ghc/-/merge_requests/12308 + -- See commit hash b36ee57bfbecc628b7f0919e1e59b7066495034f + -- + -- Case: unpackCStringAppend# "some string"# str + -- + -- Generates h$appendToHsStringA(str, "some string"), which has a faster + -- decoding loop. + | [StgLitArg (LitString bs), x] <- args + , Just d <- decodeModifiedUTF8 bs + , getUnique i == unpackCStringAppendIdKey + , [top] <- concatMap typex_expr (ctxTarget ctx) + = do + prof <- csProf <$> getSettings + let profArg = if prof then [jCafCCS] else [] + a <- genArg x + return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) + , ExprInline + ) + | [StgLitArg (LitString bs), x] <- args + , Just d <- decodeModifiedUTF8 bs + , getUnique i == unpackCStringAppendUtf8IdKey + , [top] <- concatMap typex_expr (ctxTarget ctx) + = do + prof <- csProf <$> getSettings + let profArg = if prof then [jCafCCS] else [] + a <- genArg x + return ( top |= app "h$appendToHsString" (toJExpr d : a ++ profArg) + , ExprInline + ) + + -- Case: unpackCString# "some string"# + -- + -- Generates h$toHsString("some string"), which has a faster + -- decoding loop. + -- + Utf8 version below + | [StgLitArg (LitString bs)] <- args + , Just d <- decodeModifiedUTF8 bs + , idName i == unpackCStringName + , [top] <- concatMap typex_expr (ctxTarget ctx) + = return + ( top |= app "h$toHsStringA" [toJExpr d] + , ExprInline + ) + | [StgLitArg (LitString bs)] <- args + , Just d <- decodeModifiedUTF8 bs + , idName i == unpackCStringUtf8Name + , [top] <- concatMap typex_expr (ctxTarget ctx) + = return + ( top |= app "h$toHsString" [toJExpr d] + , ExprInline + ) -- let-no-escape | Just n <- ctxLneBindingStackSize ctx i diff --git a/GHC/StgToJS/Arg.hs b/GHC/StgToJS/Arg.hs --- a/GHC/StgToJS/Arg.hs +++ b/GHC/StgToJS/Arg.hs @@ -22,9 +22,6 @@ , genIdArgI , genIdStackArgI , allocConStatic - , allocUnboxedConStatic - , allocateStaticList - , jsStaticArg , jsStaticArgs ) where @@ -215,7 +212,7 @@ emitStatic to (StaticUnboxed $ StaticUnboxedBool True) cc' | otherwise = do e <- identFS <$> identForDataConWorker con - emitStatic to (StaticData e []) cc' + emitStatic to (StaticApp SAKData e []) cc' allocConStatic' cc' [x] | isUnboxableCon con = case x of @@ -234,7 +231,7 @@ _ -> panic "allocConStatic: invalid args for consDataCon" else do e <- identFS <$> identForDataConWorker con - emitStatic to (StaticData e xs) cc' + emitStatic to (StaticApp SAKData e xs) cc' -- | Allocate unboxed constructors allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg diff --git a/GHC/StgToJS/CodeGen.hs b/GHC/StgToJS/CodeGen.hs --- a/GHC/StgToJS/CodeGen.hs +++ b/GHC/StgToJS/CodeGen.hs @@ -11,7 +11,7 @@ import GHC.Prelude -import GHC.Driver.Flags (DumpFlag (Opt_D_dump_js)) +import GHC.Driver.Flags (DumpFlag (Opt_D_dump_js, Opt_D_dump_stg_from_js_sinker)) import GHC.JS.Ppr import GHC.JS.JStg.Syntax @@ -21,7 +21,7 @@ import GHC.JS.Optimizer import GHC.StgToJS.Arg -import GHC.StgToJS.Sinker +import GHC.StgToJS.Sinker.Sinker import GHC.StgToJS.Types import qualified GHC.StgToJS.Object as Object import GHC.StgToJS.Utils @@ -48,6 +48,7 @@ import GHC.Types.RepType import GHC.Types.Id import GHC.Types.Unique +import GHC.Types.Unique.FM (nonDetEltsUFM) import GHC.Data.FastString import GHC.Utils.Encoding @@ -60,6 +61,7 @@ import qualified Data.Set as S import Data.Monoid +import Data.List (sortBy) import Control.Monad import System.Directory import System.FilePath @@ -81,7 +83,8 @@ -- TODO: avoid top level lifting in core-2-core when the JS backend is -- enabled instead of undoing it here - -- TODO: add dump pass for optimized STG ast for JS + putDumpFileMaybe logger Opt_D_dump_stg_from_js_sinker "STG Optimized JS Sinker:" FormatSTG + (pprGenStgTopBindings (StgPprOpts False) stg_binds) (deps,lus) <- runG config this_mod unfloated_binds $ do ifProfilingM $ initCostCentres cccs @@ -326,25 +329,27 @@ eid <- identForEntryId i idt <- identFS <$> identForId i body <- genBody (initExprCtx i) R2 args body typ - global_occs <- globalOccs body + occs <- globalOccs body + let lids = global_id <$> (sortBy cmp_cnt $ nonDetEltsUFM occs) + -- Regenerate idents from lids to restore right order of representatives. + -- Representatives have occurrence order which can be mixed. + lidents <- concat <$> traverse identsForId lids let eidt = identFS eid - let lidents = map global_ident global_occs - let lids = map global_id global_occs let lidents' = map identFS lidents CIStaticRefs sr0 <- genStaticRefsRhs rhs let sri = filter (`notElem` lidents') sr0 sr = CIStaticRefs sri et <- genEntryType args ll <- loadLiveFun lids - (static, regs, upd) <- + (appK, regs, upd) <- if et == CIThunk then do r <- updateThunk - pure (StaticThunk (Just (eidt, map StaticObjArg lidents')), CIRegs 0 [PtrV],r) - else return (StaticFun eidt (map StaticObjArg lidents'), - (if null lidents then CIRegs 1 (concatMap idJSRep args) - else CIRegs 0 (PtrV : concatMap idJSRep args)) - , mempty) + pure (SAKThunk, CIRegs 0 [PtrV], r) + else + let regs = if null lidents then CIRegs 1 (concatMap idJSRep args) + else CIRegs 0 (PtrV : concatMap idJSRep args) + in pure (SAKFun, regs, mempty) setcc <- ifProfiling $ if et == CIThunk then enterCostCentreThunk @@ -358,5 +363,8 @@ , ciStatic = sr } ccId <- costCentreStackLbl cc - emitStatic idt static ccId + emitStatic idt (StaticApp appK eidt $ map StaticObjArg lidents') ccId return $ (FuncStat eid [] (ll <> upd <> setcc <> body)) + where + cmp_cnt :: GlobalOcc -> GlobalOcc -> Ordering + cmp_cnt g1 g2 = compare (global_count g1) (global_count g2) diff --git a/GHC/StgToJS/Expr.hs b/GHC/StgToJS/Expr.hs --- a/GHC/StgToJS/Expr.hs +++ b/GHC/StgToJS/Expr.hs @@ -54,6 +54,7 @@ import GHC.StgToJS.Symbols import GHC.StgToJS.Types import GHC.StgToJS.Utils +import GHC.StgToJS.Linker.Utils (decodeModifiedUTF8) import GHC.Types.CostCentre import GHC.Types.Tickish @@ -76,7 +77,6 @@ import GHC.Core.Type hiding (typeSize) import GHC.Utils.Misc -import GHC.Utils.Encoding import GHC.Utils.Monad import GHC.Utils.Panic import GHC.Utils.Outputable (ppr, renderWithContext, defaultSDocContext) @@ -86,6 +86,7 @@ import qualified GHC.Data.List.SetOps as ListSetOps +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Monoid import Data.Maybe import Data.Function @@ -581,7 +582,7 @@ , getUnique i == unpackCStringAppendIdKey , [StgVarArg b',x] <- args , bnd == b' - , d <- utf8DecodeByteString bs + , Just d <- decodeModifiedUTF8 bs , [top] <- concatMap typex_expr (ctxTarget ctx) = do prof <- csProf <$> getSettings @@ -590,7 +591,54 @@ return ( top |= app "h$appendToHsStringA" (toJExpr d : a ++ profArg) , ExprInline ) + | StgLit (LitString bs) <- e + , [GenStgAlt DEFAULT _ rhs] <- alts + , StgApp i args <- rhs + , getUnique i == unpackCStringAppendUtf8IdKey + , [StgVarArg b',x] <- args + , bnd == b' + , Just d <- decodeModifiedUTF8 bs + , [top] <- concatMap typex_expr (ctxTarget ctx) + = do + prof <- csProf <$> getSettings + let profArg = if prof then [jCafCCS] else [] + a <- genArg x + return ( top |= app "h$appendToHsString" (toJExpr d : a ++ profArg) + , ExprInline + ) + -- The latter has a faster decoding loop. + -- + -- case "some string"# of b { + -- DEFAULT -> unpackCString# b + -- } + -- + -- + Utf8 version below + | StgLit (LitString bs) <- e + , [GenStgAlt DEFAULT _ rhs] <- alts + , StgApp i args <- rhs + , idName i == unpackCStringName + , [StgVarArg b'] <- args + , bnd == b' + , Just d <- decodeModifiedUTF8 bs + , [top] <- concatMap typex_expr (ctxTarget ctx) + = return + ( top |= app "h$toHsStringA" [toJExpr d] + , ExprInline + ) + | StgLit (LitString bs) <- e + , [GenStgAlt DEFAULT _ rhs] <- alts + , StgApp i args <- rhs + , idName i == unpackCStringUtf8Name + , [StgVarArg b'] <- args + , bnd == b' + , Just d <- decodeModifiedUTF8 bs + , [top] <- concatMap typex_expr (ctxTarget ctx) + = return + ( top |= app "h$toHsString" [toJExpr d] + , ExprInline + ) + | isInlineExpr e = do bndi <- identsForId bnd let ctx' = ctxSetTop bnd @@ -634,7 +682,7 @@ allRefs :: [Id] allRefs = S.toList . S.unions $ fmap (exprRefs emptyUFM . alt_rhs) as lneLive :: Int - lneLive = maximum $ 0 : catMaybes (map (ctxLneBindingStackSize ctx) allRefs) + lneLive = maximum $ 0 :| catMaybes (map (ctxLneBindingStackSize ctx) allRefs) ctx' = ctxLneShrinkStack ctx lneLive lneVars = map fst $ ctxLneFrameVars ctx' isLne i = ctxIsLneBinding ctx i || ctxIsLneLiveVar ctx' i @@ -870,7 +918,7 @@ -- mkEq :: [JStgExpr] -> [JStgExpr] -> JStgExpr mkEq es1 es2 - | length es1 == length es2 = foldl1 (InfixExpr LAndOp) (zipWith (InfixExpr StrictEqOp) es1 es2) + | length es1 == length es2 = L.foldl1 (InfixExpr LAndOp) (zipWith (InfixExpr StrictEqOp) es1 es2) | otherwise = panic "mkEq: incompatible expressions" mkAlgBranch :: ExprCtx -- ^ toplevel id for the result diff --git a/GHC/StgToJS/ExprCtx.hs b/GHC/StgToJS/ExprCtx.hs --- a/GHC/StgToJS/ExprCtx.hs +++ b/GHC/StgToJS/ExprCtx.hs @@ -46,7 +46,7 @@ import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Stg.InferTags.TagSig +import GHC.Stg.EnforceEpt.TagSig import GHC.Utils.Outputable import GHC.Utils.Panic @@ -85,6 +85,16 @@ -- ^ Cache the length of `ctxLneFrameVars` } + +instance Outputable ExprCtx where + ppr g = hang (text "ExprCtx") 2 $ vcat + [ hcat [text "ctxTop: ", ppr (ctxTop g)] + , hcat [text "ctxTarget:", ppr (ctxTarget g)] + , hcat [text "ctxSrcSpan:", ppr (ctxSrcSpan g)] + , hcat [text "ctxLneFrameBs:", ppr (ctxLneFrameBs g)] + , hcat [text "ctxLneFrameVars:", ppr (ctxLneFrameVars g)] + , hcat [text "ctxLneFrameSize:", ppr (ctxLneFrameSize g)] + ] -- | Initialize an expression context in the context of the given top-level -- binding Id diff --git a/GHC/StgToJS/Ids.hs b/GHC/StgToJS/Ids.hs --- a/GHC/StgToJS/Ids.hs +++ b/GHC/StgToJS/Ids.hs @@ -155,7 +155,7 @@ -- Now update the GlobalId cache, if required - let update_global_cache = isGlobalId i && isNothing mi && id_type == IdPlain + let update_global_cache = isGlobalId i && id_type == IdPlain -- fixme also allow caching entries for lifting? when (update_global_cache) $ do diff --git a/GHC/StgToJS/Linker/Linker.hs b/GHC/StgToJS/Linker/Linker.hs --- a/GHC/StgToJS/Linker/Linker.hs +++ b/GHC/StgToJS/Linker/Linker.hs @@ -25,8 +25,6 @@ ( jsLinkBinary , jsLink , embedJsFile - , staticInitStat - , staticDeclStat , mkExportedFuns , mkExportedModFuns , computeLinkDependencies @@ -102,7 +100,7 @@ import Data.Function (on) import qualified Data.IntSet as IS import Data.IORef -import Data.List ( nub, intercalate, groupBy, intersperse, sortBy) +import Data.List ( nub, intercalate, groupBy, intersperse ) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe @@ -124,6 +122,7 @@ import GHC.Unit.Finder.Types import GHC.Unit.Finder (findObjectLinkableMaybe, findHomeModule) import GHC.Driver.Config.Finder (initFinderOpts) +import qualified GHC.Unit.Home.Graph as HUG data LinkerStats = LinkerStats { bytesPerModule :: !(Map Module Word64) -- ^ number of bytes linked per module @@ -463,6 +462,9 @@ -- all the units we want to link together, without their dependencies let root_units = filter (/= ue_currentUnit unit_env) + -- fendor: GHCi uses more 'UnidIds' than just 'interactiveUnitId'. + -- If this breaks for some reason, + -- see Note [Multiple Home Units aware GHCi] for GHCi session setup. $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units @@ -484,7 +486,7 @@ new_required_blocks_var <- newIORef [] let load_info mod = do -- Adapted from the tangled code in GHC.Linker.Loader.getLinkDeps. - linkable <- case lookupHugByModule mod (ue_home_unit_graph unit_env) of + linkable <- HUG.lookupHugByModule mod (ue_home_unit_graph unit_env) >>= \case Nothing -> -- It's not in the HPT because we are in one shot mode, -- so use the Finder to get a ModLocation... @@ -549,6 +551,16 @@ , mc_frefs :: ![ForeignJSRef] } +instance Outputable ModuleCode where + ppr m = hang (text "ModuleCode") 2 $ vcat + [ hcat [text "Module: ", ppr (mc_module m)] + , hcat [text "JS Code:", pretty True (mc_js_code m)] + , hcat [text "JS Exports:", pprHsBytes (mc_exports m)] + , hang (text "JS Closures::") 2 (vcat (fmap (text . show) (mc_closures m))) + , hang (text "JS Statics::") 2 (vcat (fmap (text . show) (mc_statics m))) + , hang (text "JS ForeignRefs::") 2 (vcat (fmap (text . show) (mc_frefs m))) + ] + -- | ModuleCode after link with other modules. -- -- It contains less information than ModuleCode because they have been commoned @@ -669,7 +681,7 @@ | otherwise -> pure foundArchives where - ue_state = ue_units unit_env + ue_state = ue_homeUnitState unit_env -- XXX the profiling library name is probably wrong now profSuff | csProf cfg = "_p" @@ -925,22 +937,8 @@ module_blocks = M.fromListWith IS.union $ map (\ref -> (block_ref_mod ref, IS.singleton (block_ref_idx ref))) (S.toList blocks) - -- GHCJS had this comment: "read ghc-prim first, since we depend on that for - -- static initialization". Not sure if it's still true as we haven't ported - -- the compactor yet. Still we sort to read ghc-prim blocks first just in - -- case. - let pred x = moduleUnitId (fst x) == primUnitId - cmp x y = case (pred x, pred y) of - (True,False) -> LT - (False,True) -> GT - (True,True) -> EQ - (False,False) -> EQ - - sorted_module_blocks :: [(Module,BlockIds)] - sorted_module_blocks = sortBy cmp (M.toList module_blocks) - -- load blocks - forM sorted_module_blocks $ \(mod,bids) -> do + forM (M.toList module_blocks) $ \(mod,bids) -> do case M.lookup mod block_info of Nothing -> pprPanic "collectModuleCodes: couldn't find block info for module" (ppr mod) Just lbi -> extractBlocks ar_cache lbi bids @@ -1012,7 +1010,7 @@ -- | dependencies for the RTS, these need to be always linked rtsDeps :: ([UnitId], Set ExportedFun) rtsDeps = - ( [ghcInternalUnitId, primUnitId] + ( [ghcInternalUnitId] , S.fromList $ concat [ mkInternalFuns "GHC.Internal.Conc.Sync" ["reportError"] @@ -1053,11 +1051,11 @@ , "setCurrentThreadResultException" , "setCurrentThreadResultValue" ] - , mkPrimFuns "GHC.Types" + , mkInternalFuns "GHC.Internal.Types" [ ":" , "[]" ] - , mkPrimFuns "GHC.Tuple" + , mkInternalFuns "GHC.Internal.Tuple" [ "(,)" , "(,,)" , "(,,,)" @@ -1075,10 +1073,6 @@ mkInternalFuns :: FastString -> [FastString] -> [ExportedFun] mkInternalFuns = mkExportedFuns ghcInternalUnitId --- | Export the Prim functions -mkPrimFuns :: FastString -> [FastString] -> [ExportedFun] -mkPrimFuns = mkExportedFuns primUnitId - -- | Given a @UnitId@, a module name, and a set of symbols in the module, -- package these into an @ExportedFun@. mkExportedFuns :: UnitId -> FastString -> [FastString] -> [ExportedFun] @@ -1251,27 +1245,22 @@ staticInitStat (StaticInfo i sv mcc) = jStgStatToJS $ case sv of - StaticData con args -> appS hdStiStr $ add_cc_arg - [ global i - , global con - , jsStaticArgs args - ] - StaticFun f args -> appS hdStiStr $ add_cc_arg - [ global i - , global f - , jsStaticArgs args - ] - StaticList args mt -> appS hdStlStr $ add_cc_arg - [ global i - , jsStaticArgs args - , toJExpr $ maybe null_ (toJExpr . TxtI) mt - ] - StaticThunk (Just (f,args)) -> appS hdStcStr $ add_cc_arg - [ global i - , global f - , jsStaticArgs args - ] - _ -> mempty + (StaticApp k app args) -> appS + (if k == SAKThunk then hdStcStr else hdStiStr) + $ add_cc_arg + [ global i + , global app + , jsStaticArgs args + ] + + StaticList args mt -> appS hdStlStr + $ add_cc_arg + [ global i + , jsStaticArgs args + , toJExpr $ maybe null_ (toJExpr . TxtI) mt + ] + + StaticUnboxed _ -> mempty where -- add optional cost-center argument add_cc_arg as = case mcc of @@ -1284,20 +1273,15 @@ where global_ident = name global_name decl_init v = global_ident ||= v - decl_no_init = appS hdDiStr [toJExpr global_ident] decl = case static_value of StaticUnboxed u -> decl_init (unboxed_expr u) - StaticThunk Nothing -> decl_no_init -- CAF initialized in an alternative way _ -> decl_init (app hdDStr []) unboxed_expr = \case StaticUnboxedBool b -> app hdPStr [toJExpr b] StaticUnboxedInt i -> app hdPStr [toJExpr i] StaticUnboxedDouble d -> app hdPStr [toJExpr (unSaneDouble d)] - -- GHCJS used a function wrapper for this: - -- StaticUnboxedString str -> ApplExpr (initStr str) [] - -- But we are defining it statically for now. StaticUnboxedString str -> initStr str StaticUnboxedStringOffset {} -> 0 diff --git a/GHC/StgToJS/Linker/Utils.hs b/GHC/StgToJS/Linker/Utils.hs --- a/GHC/StgToJS/Linker/Utils.hs +++ b/GHC/StgToJS/Linker/Utils.hs @@ -77,13 +77,15 @@ -- | Generate macros MK_TUP* for tuples sized 2+. genMkTup :: Bool -> Int -> ByteString genMkTup profiling n = mconcat - [ "#define MK_TUP", sn -- #define MK_TUPn - , "(", B.intercalate "," xs, ")" -- (x1,x2,...) - , "(h$c", sn, "(" -- (h$cn( - , bytesFS symbol, "," -- h$ghczmprimZCGHCziTupleziZnT_con_e, -- , - , B.intercalate "," $ map (\x -> "(" <> x <> ")") xs -- (x1),(x2),(...) - , if profiling then ",h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM" else "" -- ,h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM - , "))\n" -- ))\n + [ "#define MK_TUP", sn -- #define MK_TUPn + , "(", B.intercalate "," xs, ")" -- (x1,x2,...) + , "(h$c", sn, "(" -- (h$cn( + , bytesFS symbol, "," -- h$ghczminternalZCGHCziInternalziTupleziZnT_con_e, + , B.intercalate "," $ map (\x -> "(" <> x <> ")") xs -- (x1),(x2),(...) + , if profiling -- ,h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM + then ",h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM" + else "" + , "))\n" -- ))\n ] where xs = take n $ map (("x" <>) . Char8.pack . show) ([1..] :: [Int]) @@ -154,20 +156,20 @@ else "#define MK_JUST(val) (h$c1(h$ghczminternalZCGHCziInternalziMaybeziJust_con_e, (val)))\n" -- Data.List - , "#define HS_NIL h$ghczmprimZCGHCziTypesziZMZN\n" - , "#define HS_NIL_CON h$ghczmprimZCGHCziTypesziZMZN_con_e\n" - , "#define IS_CONS(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZC_con_e)\n" - , "#define IS_NIL(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZMZN_con_e)\n" + , "#define HS_NIL h$ghczminternalZCGHCziInternalziTypesziZMZN\n" + , "#define HS_NIL_CON h$ghczminternalZCGHCziInternalziTypesziZMZN_con_e\n" + , "#define IS_CONS(cl) ((cl).f === h$ghczminternalZCGHCziInternalziTypesziZC_con_e)\n" + , "#define IS_NIL(cl) ((cl).f === h$ghczminternalZCGHCziInternalziTypesziZMZN_con_e)\n" , "#define CONS_HEAD(cl) ((cl).d1)\n" , "#define CONS_TAIL(cl) ((cl).d2)\n" , if profiling then mconcat - [ "#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), h$CCS_SYSTEM))\n" - , "#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), (cc)))\n" + [ "#define MK_CONS(head,tail) (h$c2(h$ghczminternalZCGHCziInternalziTypesziZC_con_e, (head), (tail), h$CCS_SYSTEM))\n" + , "#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczminternalZCGHCziInternalziTypesziZC_con_e, (head), (tail), (cc)))\n" ] else mconcat - [ "#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail)))\n" - , "#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail)))\n" + [ "#define MK_CONS(head,tail) (h$c2(h$ghczminternalZCGHCziInternalziTypesziZC_con_e, (head), (tail)))\n" + , "#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczminternalZCGHCziInternalziTypesziZC_con_e, (head), (tail)))\n" ] -- Data.Text diff --git a/GHC/StgToJS/Literal.hs b/GHC/StgToJS/Literal.hs --- a/GHC/StgToJS/Literal.hs +++ b/GHC/StgToJS/Literal.hs @@ -18,8 +18,8 @@ import GHC.StgToJS.Monad import GHC.StgToJS.Symbols import GHC.StgToJS.Types +import GHC.StgToJS.Linker.Utils (decodeModifiedUTF8) -import GHC.Data.FastString import GHC.Types.Literal import GHC.Types.Basic import GHC.Types.RepType @@ -95,9 +95,10 @@ genStaticLit :: Literal -> G [StaticLit] genStaticLit = \case LitChar c -> return [ IntLit (fromIntegral $ ord c) ] - LitString str - | True -> return [ StringLit (mkFastStringByteString str), IntLit 0] - -- \| invalid UTF8 -> return [ BinLit str, IntLit 0] + LitString str -> case decodeModifiedUTF8 str of + Just t -> return [ StringLit t, IntLit 0] + -- invalid UTF8 + Nothing -> return [ BinLit str, IntLit 0] LitNullAddr -> return [ NullLit, IntLit 0 ] LitNumber nt v -> case nt of LitNumInt -> return [ IntLit v ] @@ -117,7 +118,7 @@ , IntLit 0 ] LitRubbish _ rep -> let prim_reps = runtimeRepPrimRep (text "GHC.StgToJS.Literal.genStaticLit") rep - in case expectOnly "GHC.StgToJS.Literal.genStaticLit" prim_reps of -- Note [Post-unarisation invariants] + in case expectOnly prim_reps of -- Note [Post-unarisation invariants] BoxedRep _ -> pure [ NullLit ] AddrRep -> pure [ NullLit, IntLit 0 ] IntRep -> pure [ IntLit 0 ] diff --git a/GHC/StgToJS/Monad.hs b/GHC/StgToJS/Monad.hs --- a/GHC/StgToJS/Monad.hs +++ b/GHC/StgToJS/Monad.hs @@ -31,6 +31,7 @@ import GHC.StgToJS.Types import GHC.Unit.Module +import GHC.Utils.Outputable import GHC.Stg.Syntax import GHC.Types.SrcLoc @@ -44,7 +45,6 @@ import qualified Data.Map as M import qualified Data.Set as S -import qualified Data.List as L runG :: StgToJSConfig -> Module -> UniqFM Id CgStgExpr -> G a -> IO a runG config m unfloat action = State.evalStateT action =<< initState config m unfloat @@ -152,25 +152,30 @@ setGlobalIdCache :: GlobalIdCache -> G () setGlobalIdCache v = State.modify (\s -> s { gsGroup = (gsGroup s) { ggsGlobalIdCache = v}}) - data GlobalOcc = GlobalOcc - { global_ident :: !Ident - , global_id :: !Id + { global_id :: !Id , global_count :: !Word } --- | Return number of occurrences of every global id used in the given JStgStat. +instance Outputable GlobalOcc where + ppr g = hang (text "GlobalOcc") 2 $ vcat + [ hcat [text "Id:", ppr (global_id g)] + , hcat [text "Count:", ppr (global_count g)] + ] + +-- | Return occurrences of every global id used in the given JStgStat. -- Sort by increasing occurrence count. -globalOccs :: JStgStat -> G [GlobalOcc] +globalOccs :: JStgStat -> G (UniqFM Id GlobalOcc) globalOccs jst = do GlobalIdCache gidc <- getGlobalIdCache - -- build a map form Ident Unique to (Ident, Id, Count) + -- build a map form Ident Unique to (Id, Count) + -- Note that different Idents can map to the same Id (e.g. string payload and string offset idents) let - cmp_cnt g1 g2 = compare (global_count g1) (global_count g2) inc g1 g2 = g1 { global_count = global_count g1 + global_count g2 } + + go :: UniqFM Id GlobalOcc -> [Ident] -> UniqFM Id GlobalOcc go gids = \case - [] -> -- return global Ids used locally sorted by increased use - L.sortBy cmp_cnt $ nonDetEltsUFM gids + [] -> gids (i:is) -> -- check if the Id is global case lookupUFM gidc i of @@ -178,7 +183,7 @@ Just (_k,gid) -> -- add it to the list of already found global ids. Increasing -- count by 1 - let g = GlobalOcc i gid 1 - in go (addToUFM_C inc gids i g) is + let g = GlobalOcc gid 1 + in go (addToUFM_C inc gids gid g) is - pure $ go emptyUFM (identsS jst) + pure $ go emptyUFM $ identsS jst diff --git a/GHC/StgToJS/Object.hs b/GHC/StgToJS/Object.hs --- a/GHC/StgToJS/Object.hs +++ b/GHC/StgToJS/Object.hs @@ -255,23 +255,23 @@ -- index putObjBlock :: WriteBinHandle -> ObjBlock -> IO () putObjBlock bh (ObjBlock _syms b c d e f g) = do - put_ bh b - put_ bh c + lazyPut bh b + lazyPut bh c lazyPut bh d - put_ bh e - put_ bh f - put_ bh g + lazyPut bh e + lazyPut bh f + lazyPut bh g -- | Read an ObjBlock and associate it to the given symbols (that must have been -- read from the index) getObjBlock :: [FastString] -> ReadBinHandle -> IO ObjBlock getObjBlock syms bh = do - b <- get bh - c <- get bh + b <- lazyGet bh + c <- lazyGet bh d <- lazyGet bh - e <- get bh - f <- get bh - g <- get bh + e <- lazyGet bh + f <- lazyGet bh + g <- lazyGet bh pure $ ObjBlock { oiSymbols = syms , oiClInfo = b @@ -615,16 +615,16 @@ get bh = StaticInfo <$> get bh <*> get bh <*> get bh instance Binary StaticVal where - put_ bh (StaticFun f args) = putByte bh 1 >> put_ bh f >> put_ bh args - put_ bh (StaticThunk t) = putByte bh 2 >> put_ bh t - put_ bh (StaticUnboxed u) = putByte bh 3 >> put_ bh u - put_ bh (StaticData dc args) = putByte bh 4 >> put_ bh dc >> put_ bh args - put_ bh (StaticList xs t) = putByte bh 5 >> put_ bh xs >> put_ bh t + put_ bh (StaticApp SAKFun f args) = putByte bh 1 >> put_ bh f >> put_ bh args + put_ bh (StaticApp SAKThunk f args) = putByte bh 2 >> put_ bh f >> put_ bh args + put_ bh (StaticUnboxed u) = putByte bh 3 >> put_ bh u + put_ bh (StaticApp SAKData dc args) = putByte bh 4 >> put_ bh dc >> put_ bh args + put_ bh (StaticList xs t) = putByte bh 5 >> put_ bh xs >> put_ bh t get bh = getByte bh >>= \case - 1 -> StaticFun <$> get bh <*> get bh - 2 -> StaticThunk <$> get bh + 1 -> StaticApp SAKFun <$> get bh <*> get bh + 2 -> StaticApp SAKThunk <$> get bh <*> get bh 3 -> StaticUnboxed <$> get bh - 4 -> StaticData <$> get bh <*> get bh + 4 -> StaticApp SAKData <$> get bh <*> get bh 5 -> StaticList <$> get bh <*> get bh n -> error ("Binary get bh StaticVal: invalid tag " ++ show n) diff --git a/GHC/StgToJS/Prim.hs b/GHC/StgToJS/Prim.hs --- a/GHC/StgToJS/Prim.hs +++ b/GHC/StgToJS/Prim.hs @@ -1155,14 +1155,12 @@ ------------------------------ Unhandled primops ------------------- + AnnotateStackOp -> unhandledPrimop op + NewPromptTagOp -> unhandledPrimop op PromptOp -> unhandledPrimop op Control0Op -> unhandledPrimop op - NewIOPortOp -> unhandledPrimop op - ReadIOPortOp -> unhandledPrimop op - WriteIOPortOp -> unhandledPrimop op - GetSparkOp -> unhandledPrimop op AnyToAddrOp -> unhandledPrimop op MkApUpd0_Op -> unhandledPrimop op @@ -1173,6 +1171,7 @@ WhereFromOp -> unhandledPrimop op -- should be easily implementable with o.f.n SetThreadAllocationCounter -> unhandledPrimop op + SetOtherThreadAllocationCounter -> unhandledPrimop op ------------------------------- Vector ----------------------------------------- -- For now, vectors are unsupported on the JS backend. Simply put, they do not diff --git a/GHC/StgToJS/Sinker.hs b/GHC/StgToJS/Sinker.hs deleted file mode 100644 --- a/GHC/StgToJS/Sinker.hs +++ /dev/null @@ -1,180 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE LambdaCase #-} - -module GHC.StgToJS.Sinker (sinkPgm) where - -import GHC.Prelude -import GHC.Types.Unique.Set -import GHC.Types.Unique.FM -import GHC.Types.Var.Set -import GHC.Stg.Syntax -import GHC.Types.Id -import GHC.Types.Name -import GHC.Unit.Module -import GHC.Types.Literal -import GHC.Data.Graph.Directed - -import GHC.Utils.Misc (partitionWith) -import GHC.StgToJS.Utils - -import Data.Char -import Data.List (partition) -import Data.Maybe - - --- | Unfloat some top-level unexported things --- --- GHC floats constants to the top level. This is fine in native code, but with JS --- they occupy some global variable name. We can unfloat some unexported things: --- --- - global constructors, as long as they're referenced only once by another global --- constructor and are not in a recursive binding group --- - literals (small literals may also be sunk if they are used more than once) -sinkPgm :: Module - -> [CgStgTopBinding] - -> (UniqFM Id CgStgExpr, [CgStgTopBinding]) -sinkPgm m pgm = (sunk, map StgTopLifted pgm'' ++ stringLits) - where - selectLifted (StgTopLifted b) = Left b - selectLifted x = Right x - (pgm', stringLits) = partitionWith selectLifted pgm - (sunk, pgm'') = sinkPgm' m pgm' - -sinkPgm' - :: Module - -- ^ the module, since we treat definitions from the current module - -- differently - -> [CgStgBinding] - -- ^ the bindings - -> (UniqFM Id CgStgExpr, [CgStgBinding]) - -- ^ a map with sunken replacements for nodes, for where the replacement - -- does not fit in the 'StgBinding' AST and the new bindings -sinkPgm' m pgm = - let usedOnce = collectUsedOnce pgm - sinkables = listToUFM $ - concatMap alwaysSinkable pgm ++ - filter ((`elementOfUniqSet` usedOnce) . fst) (concatMap (onceSinkable m) pgm) - isSunkBind (StgNonRec b _e) | elemUFM b sinkables = True - isSunkBind _ = False - in (sinkables, filter (not . isSunkBind) $ topSortDecls m pgm) - --- | always sinkable, values that may be duplicated in the generated code (e.g. --- small literals) -alwaysSinkable :: CgStgBinding -> [(Id, CgStgExpr)] -alwaysSinkable (StgRec {}) = [] -alwaysSinkable (StgNonRec b rhs) = case rhs of - StgRhsClosure _ _ _ _ e@(StgLit l) _ - | isSmallSinkableLit l - , isLocal b - -> [(b,e)] - StgRhsCon _ccs dc cnum _ticks as@[StgLitArg l] _typ - | isSmallSinkableLit l - , isLocal b - , isUnboxableCon dc - -> [(b,StgConApp dc cnum as [])] - _ -> [] - -isSmallSinkableLit :: Literal -> Bool -isSmallSinkableLit (LitChar c) = ord c < 100000 -isSmallSinkableLit (LitNumber _ i) = abs i < 100000 -isSmallSinkableLit _ = False - - --- | once sinkable: may be sunk, but duplication is not ok -onceSinkable :: Module -> CgStgBinding -> [(Id, CgStgExpr)] -onceSinkable _m (StgNonRec b rhs) - | Just e <- getSinkable rhs - , isLocal b = [(b,e)] - where - getSinkable = \case - StgRhsCon _ccs dc cnum _ticks args _typ -> Just (StgConApp dc cnum args []) - StgRhsClosure _ _ _ _ e@(StgLit{}) _typ -> Just e - _ -> Nothing -onceSinkable _ _ = [] - --- | collect all idents used only once in an argument at the top level --- and never anywhere else -collectUsedOnce :: [CgStgBinding] -> IdSet -collectUsedOnce binds = intersectUniqSets (usedOnce args) (usedOnce top_args) - where - top_args = concatMap collectArgsTop binds - args = concatMap collectArgs binds - usedOnce = fst . foldr g (emptyUniqSet, emptyUniqSet) - g i t@(once, mult) - | i `elementOfUniqSet` mult = t - | i `elementOfUniqSet` once - = (delOneFromUniqSet once i, addOneToUniqSet mult i) - | otherwise = (addOneToUniqSet once i, mult) - --- | fold over all id in StgArg used at the top level in an StgRhsCon -collectArgsTop :: CgStgBinding -> [Id] -collectArgsTop = \case - StgNonRec _b r -> collectArgsTopRhs r - StgRec bs -> concatMap (collectArgsTopRhs . snd) bs - -collectArgsTopRhs :: CgStgRhs -> [Id] -collectArgsTopRhs = \case - StgRhsCon _ccs _dc _mu _ticks args _typ -> concatMap collectArgsA args - StgRhsClosure {} -> [] - --- | fold over all Id in StgArg in the AST -collectArgs :: CgStgBinding -> [Id] -collectArgs = \case - StgNonRec _b r -> collectArgsR r - StgRec bs -> concatMap (collectArgsR . snd) bs - -collectArgsR :: CgStgRhs -> [Id] -collectArgsR = \case - StgRhsClosure _x0 _x1 _x2 _x3 e _typ -> collectArgsE e - StgRhsCon _ccs _con _mu _ticks args _typ -> concatMap collectArgsA args - -collectArgsAlt :: CgStgAlt -> [Id] -collectArgsAlt alt = collectArgsE (alt_rhs alt) - -collectArgsE :: CgStgExpr -> [Id] -collectArgsE = \case - StgApp x args - -> x : concatMap collectArgsA args - StgConApp _con _mn args _ts - -> concatMap collectArgsA args - StgOpApp _x args _t - -> concatMap collectArgsA args - StgCase e _b _a alts - -> collectArgsE e ++ concatMap collectArgsAlt alts - StgLet _x b e - -> collectArgs b ++ collectArgsE e - StgLetNoEscape _x b e - -> collectArgs b ++ collectArgsE e - StgTick _i e - -> collectArgsE e - StgLit _ - -> [] - -collectArgsA :: StgArg -> [Id] -collectArgsA = \case - StgVarArg i -> [i] - StgLitArg _ -> [] - -isLocal :: Id -> Bool -isLocal i = isNothing (nameModule_maybe . idName $ i) && not (isExportedId i) - --- | since we have sequential initialization, topsort the non-recursive --- constructor bindings -topSortDecls :: Module -> [CgStgBinding] -> [CgStgBinding] -topSortDecls _m binds = rest ++ nr' - where - (nr, rest) = partition isNonRec binds - isNonRec StgNonRec{} = True - isNonRec _ = False - vs = map getV nr - keys = mkUniqSet (map node_key vs) - getV e@(StgNonRec b _) = DigraphNode e b [] - getV _ = error "topSortDecls: getV, unexpected binding" - collectDeps (StgNonRec b (StgRhsCon _cc _dc _cnum _ticks args _typ)) = - [ (i, b) | StgVarArg i <- args, i `elementOfUniqSet` keys ] - collectDeps _ = [] - g = graphFromVerticesAndAdjacency vs (concatMap collectDeps nr) - nr' | (not . null) [()| CyclicSCC _ <- stronglyConnCompG g] - = error "topSortDecls: unexpected cycle" - | otherwise = map node_payload (topologicalSortG g) diff --git a/GHC/StgToJS/Sinker/Collect.hs b/GHC/StgToJS/Sinker/Collect.hs new file mode 100644 --- /dev/null +++ b/GHC/StgToJS/Sinker/Collect.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE LambdaCase #-} + +module GHC.StgToJS.Sinker.Collect + ( collectArgsTop + , collectArgs + , selectUsedOnce + ) + where + +import GHC.Prelude +import GHC.Types.Unique.Set +import GHC.Stg.Syntax +import GHC.Types.Id +import GHC.Types.Unique + +-- | fold over all id in StgArg used at the top level in an StgRhsCon +collectArgsTop :: CgStgBinding -> [Id] +collectArgsTop = \case + StgNonRec _b r -> collectArgsTopRhs r + StgRec bs -> concatMap (collectArgsTopRhs . snd) bs + where + collectArgsTopRhs :: CgStgRhs -> [Id] + collectArgsTopRhs = \case + StgRhsCon _ccs _dc _mu _ticks args _typ -> concatMap collectArgsA args + StgRhsClosure {} -> [] + +-- | fold over all Id in StgArg in the AST +collectArgs :: CgStgBinding -> [Id] +collectArgs = \case + StgNonRec _b r -> collectArgsR r + StgRec bs -> concatMap (collectArgsR . snd) bs + where + collectArgsR :: CgStgRhs -> [Id] + collectArgsR = \case + StgRhsClosure _x0 _x1 _x2 _x3 e _typ -> collectArgsE e + StgRhsCon _ccs _con _mu _ticks args _typ -> concatMap collectArgsA args + + collectArgsAlt :: CgStgAlt -> [Id] + collectArgsAlt alt = collectArgsE (alt_rhs alt) + + collectArgsE :: CgStgExpr -> [Id] + collectArgsE = \case + StgApp x args + -> x : concatMap collectArgsA args + StgConApp _con _mn args _ts + -> concatMap collectArgsA args + StgOpApp _x args _t + -> concatMap collectArgsA args + StgCase e _b _a alts + -> collectArgsE e ++ concatMap collectArgsAlt alts + StgLet _x b e + -> collectArgs b ++ collectArgsE e + StgLetNoEscape _x b e + -> collectArgs b ++ collectArgsE e + StgTick _i e + -> collectArgsE e + StgLit _ + -> [] + +collectArgsA :: StgArg -> [Id] +collectArgsA = \case + StgVarArg i -> [i] + StgLitArg _ -> [] + +selectUsedOnce :: (Foldable t, Uniquable a) => t a -> UniqSet a +selectUsedOnce = fst . foldr g (emptyUniqSet, emptyUniqSet) + where + g i t@(once, mult) + | i `elementOfUniqSet` mult = t + | i `elementOfUniqSet` once + = (delOneFromUniqSet once i, addOneToUniqSet mult i) + | otherwise = (addOneToUniqSet once i, mult) diff --git a/GHC/StgToJS/Sinker/Sinker.hs b/GHC/StgToJS/Sinker/Sinker.hs new file mode 100644 --- /dev/null +++ b/GHC/StgToJS/Sinker/Sinker.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE LambdaCase #-} + +module GHC.StgToJS.Sinker.Sinker (sinkPgm) where + +import GHC.Prelude +import GHC.Types.Unique.Set +import GHC.Types.Unique.FM +import GHC.Types.Var.Set +import GHC.Stg.Syntax +import GHC.Types.Id +import GHC.Types.Name +import GHC.Unit.Module +import GHC.Types.Literal +import GHC.Data.Graph.Directed +import GHC.StgToJS.Sinker.Collect +import GHC.StgToJS.Sinker.StringsUnfloat + +import GHC.Utils.Misc (partitionWith) +import GHC.StgToJS.Utils + +import Data.Char +import Data.List (partition) +import Data.Maybe +import Data.ByteString (ByteString) + +-- | Unfloat some top-level unexported things +-- +-- GHC floats constants to the top level. This is fine in native code, but with JS +-- they occupy some global variable name. We can unfloat some unexported things: +-- +-- - global constructors, as long as they're referenced only once by another global +-- constructor and are not in a recursive binding group +-- - literals (small literals may also be sunk if they are used more than once) +sinkPgm :: Module + -> [CgStgTopBinding] + -> (UniqFM Id CgStgExpr, [CgStgTopBinding]) +sinkPgm m pgm + = (sunk, map StgTopLifted pgm''' ++ stringLits) + where + selectLifted :: CgStgTopBinding -> Either CgStgBinding (Id, ByteString) + selectLifted (StgTopLifted b) = Left b + selectLifted (StgTopStringLit i b) = Right (i, b) + + (pgm', allStringLits) = partitionWith selectLifted pgm + usedOnceIds = selectUsedOnce $ concatMap collectArgs pgm' + + stringLitsUFM = listToUFM $ (\(i, b) -> (idName i, (i, b))) <$> allStringLits + (pgm'', _actuallyUnfloatedStringLitNames) = + unfloatStringLits + (idName `mapUniqSet` usedOnceIds) + (snd `mapUFM` stringLitsUFM) + pgm' + + stringLits = uncurry StgTopStringLit <$> allStringLits + + (sunk, pgm''') = sinkPgm' m usedOnceIds pgm'' + +sinkPgm' + :: Module + -- ^ the module, since we treat definitions from the current module + -- differently + -> IdSet + -- ^ the set of used once ids + -> [CgStgBinding] + -- ^ the bindings + -> (UniqFM Id CgStgExpr, [CgStgBinding]) + -- ^ a map with sunken replacements for nodes, for where the replacement + -- does not fit in the 'StgBinding' AST and the new bindings +sinkPgm' m usedOnceIds pgm = + let usedOnce = collectTopLevelUsedOnce usedOnceIds pgm + sinkables = listToUFM $ + concatMap alwaysSinkable pgm ++ + concatMap (filter ((`elementOfUniqSet` usedOnce) . fst) . onceSinkable m) pgm + isSunkBind (StgNonRec b _e) | elemUFM b sinkables = True + isSunkBind _ = False + in (sinkables, filter (not . isSunkBind) $ topSortDecls m pgm) + +-- | always sinkable, values that may be duplicated in the generated code (e.g. +-- small literals) +alwaysSinkable :: CgStgBinding -> [(Id, CgStgExpr)] +alwaysSinkable (StgRec {}) = [] +alwaysSinkable (StgNonRec b rhs) = case rhs of + StgRhsClosure _ _ _ _ e@(StgLit l) _ + | isSmallSinkableLit l + , isLocal b + -> [(b,e)] + StgRhsCon _ccs dc cnum _ticks as@[StgLitArg l] _typ + | isSmallSinkableLit l + , isLocal b + , isUnboxableCon dc + -> [(b,StgConApp dc cnum as [])] + _ -> [] + +isSmallSinkableLit :: Literal -> Bool +isSmallSinkableLit (LitChar c) = ord c < 100000 +isSmallSinkableLit (LitNumber _ i) = abs i < 100000 +isSmallSinkableLit _ = False + + +-- | once sinkable: may be sunk, but duplication is not ok +onceSinkable :: Module -> CgStgBinding -> [(Id, CgStgExpr)] +onceSinkable _m (StgNonRec b rhs) + | Just e <- getSinkable rhs + , isLocal b = [(b,e)] + where + getSinkable = \case + StgRhsCon _ccs dc cnum _ticks args _typ -> Just (StgConApp dc cnum args []) + StgRhsClosure _ _ _ _ e@(StgLit{}) _typ -> Just e + _ -> Nothing +onceSinkable _ _ = [] + +-- | collect all idents used only once in an argument at the top level +-- and never anywhere else +collectTopLevelUsedOnce :: IdSet -> [CgStgBinding] -> IdSet +collectTopLevelUsedOnce usedOnceIds binds = intersectUniqSets usedOnceIds (selectUsedOnce top_args) + where + top_args = concatMap collectArgsTop binds + +isLocal :: Id -> Bool +isLocal i = isNothing (nameModule_maybe . idName $ i) && not (isExportedId i) + +-- | since we have sequential initialization, topsort the non-recursive +-- constructor bindings +topSortDecls :: Module -> [CgStgBinding] -> [CgStgBinding] +topSortDecls _m binds = rest ++ nr' + where + (nr, rest) = partition isNonRec binds + isNonRec StgNonRec{} = True + isNonRec _ = False + vs = map getV nr + keys = mkUniqSet (map node_key vs) + getV e@(StgNonRec b _) = DigraphNode e b [] + getV _ = error "topSortDecls: getV, unexpected binding" + collectDeps (StgNonRec b (StgRhsCon _cc _dc _cnum _ticks args _typ)) = + [ (i, b) | StgVarArg i <- args, i `elementOfUniqSet` keys ] + collectDeps _ = [] + g = graphFromVerticesAndAdjacency vs (concatMap collectDeps nr) + nr' | (not . null) [()| CyclicSCC _ <- stronglyConnCompG g] + = error "topSortDecls: unexpected cycle" + | otherwise = map node_payload (topologicalSortG g) diff --git a/GHC/StgToJS/Sinker/StringsUnfloat.hs b/GHC/StgToJS/Sinker/StringsUnfloat.hs new file mode 100644 --- /dev/null +++ b/GHC/StgToJS/Sinker/StringsUnfloat.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} + +module GHC.StgToJS.Sinker.StringsUnfloat + ( unfloatStringLits + ) + where + +import GHC.Prelude +import GHC.Types.Unique.Set +import GHC.Types.Unique.FM +import GHC.Stg.Syntax +import GHC.Types.Id +import GHC.Types.Name +import GHC.Types.Literal +import GHC.Utils.Misc (partitionWith) + +import Data.ByteString qualified as BS +import Data.ByteString (ByteString) +import Data.Bifunctor (Bifunctor (..)) + +-- | We suppose that every string shorter than 80 symbols is safe for sink. +-- Sinker is working on per module. It means that ALL locally defined strings +-- in a module shorter 80 symbols will be unfloated back. +pattern STRING_LIT_MAX_LENGTH :: Int +pattern STRING_LIT_MAX_LENGTH = 80 + +unfloatStringLits + :: UniqSet Name + -> UniqFM Name ByteString + -> [CgStgBinding] + -> ([CgStgBinding], UniqSet Name) +unfloatStringLits usedOnceStringLits stringLits = + unfloatStringLits' (selectStringLitsForUnfloat usedOnceStringLits stringLits) + +-- | We are doing attempts to unfloat string literals back to +-- the call site. Further special JS optimizations +-- can generate more performant operations over them. +unfloatStringLits' :: UniqFM Name ByteString -> [CgStgBinding] -> ([CgStgBinding], UniqSet Name) +unfloatStringLits' stringLits allBindings = (binderWithoutChanges ++ binderWithUnfloatedStringLit, actuallyUsedStringLitNames) + where + (binderWithoutChanges, binderWithUnfloatedStringLitPairs) = partitionWith substituteStringLit allBindings + + binderWithUnfloatedStringLit = fst <$> binderWithUnfloatedStringLitPairs + actuallyUsedStringLitNames = unionManyUniqSets (snd <$> binderWithUnfloatedStringLitPairs) + + substituteStringLit :: CgStgBinding -> Either CgStgBinding (CgStgBinding, UniqSet Name) + substituteStringLit x@(StgRec bnds) + | isEmptyUniqSet names = Left x + | otherwise = Right (StgRec bnds', names) + where + (bnds', names) = extractNames id $ do + (i, rhs) <- bnds + pure $ case processStgRhs rhs of + Nothing -> Left (i, rhs) + Just (rhs', names) -> Right ((i, rhs'), names) + substituteStringLit x@(StgNonRec binder rhs) + = maybe (Left x) + (\(body', names) -> Right (StgNonRec binder body', names)) + (processStgRhs rhs) + + processStgRhs :: CgStgRhs -> Maybe (CgStgRhs, UniqSet Name) + processStgRhs (StgRhsCon ccs dataCon mu ticks args typ) + | isEmptyUniqSet names = Nothing + | otherwise = Just (StgRhsCon ccs dataCon mu ticks unified typ, names) + where + (unified, names) = substituteArgWithNames args + processStgRhs (StgRhsClosure fvs ccs upd bndrs body typ) + = (\(body', names) -> (StgRhsClosure fvs ccs upd bndrs body' typ, names)) <$> + processStgExpr body + + -- Recursive expressions + processStgExpr :: CgStgExpr -> Maybe (CgStgExpr, UniqSet Name) + processStgExpr (StgLit _) = Nothing + processStgExpr (StgTick _ _) = Nothing + processStgExpr (StgLet n b e) = + case (substituteStringLit b, processStgExpr e) of + (Left _, Nothing) -> Nothing + (Right (b', names), Nothing) -> Just (StgLet n b' e, names) + (Left _, Just (e', names)) -> Just (StgLet n b e', names) + (Right (b', names), Just (e', names')) -> Just (StgLet n b' e', names `unionUniqSets` names') + processStgExpr (StgLetNoEscape n b e) = + case (substituteStringLit b, processStgExpr e) of + (Left _, Nothing) -> Nothing + (Right (b', names), Nothing) -> Just (StgLetNoEscape n b' e, names) + (Left _, Just (e', names)) -> Just (StgLetNoEscape n b e', names) + (Right (b', names), Just (e', names')) -> Just (StgLetNoEscape n b' e', names `unionUniqSets` names') + -- We should keep the order: See Note [Case expression invariants] + processStgExpr (StgCase e bndr alt_type alts) = + case (isEmptyUniqSet names, processStgExpr e) of + (True, Nothing) -> Nothing + (True, Just (e', names')) -> Just (StgCase e' bndr alt_type alts, names') + (False, Nothing) -> Just (StgCase e bndr alt_type unified, names) + (False, Just (e', names')) -> Just (StgCase e' bndr alt_type unified, names `unionUniqSets` names') + where + (unified, names) = extractNames splitAlts alts + + splitAlts :: CgStgAlt -> Either CgStgAlt (CgStgAlt, UniqSet Name) + splitAlts alt@(GenStgAlt con bndrs rhs) = + case processStgExpr rhs of + Nothing -> Left alt + Just (alt', names) -> Right (GenStgAlt con bndrs alt', names) + + -- No args + processStgExpr (StgApp _ []) = Nothing + processStgExpr (StgConApp _ _ [] _) = Nothing + processStgExpr (StgOpApp _ [] _) = Nothing + + -- Main targets. Preserving the order of args is important + processStgExpr (StgApp fn args@(_:_)) + | isEmptyUniqSet names = Nothing + | otherwise = Just (StgApp fn unified, names) + where + (unified, names) = substituteArgWithNames args + processStgExpr (StgConApp dc n args@(_:_) tys) + | isEmptyUniqSet names = Nothing + | otherwise = Just (StgConApp dc n unified tys, names) + where + (unified, names) = substituteArgWithNames args + processStgExpr (StgOpApp op args@(_:_) tys) + | isEmptyUniqSet names = Nothing + | otherwise = Just (StgOpApp op unified tys, names) + where + (unified, names) = substituteArgWithNames args + + substituteArg :: StgArg -> Either StgArg (StgArg, Name) + substituteArg a@(StgLitArg _) = Left a + substituteArg a@(StgVarArg i) = + let name = idName i + in case lookupUFM stringLits name of + Nothing -> Left a + Just b -> Right (StgLitArg $ LitString b, name) + + substituteArgWithNames = extractNames (second (second unitUniqSet) . substituteArg) + + extractNames :: (a -> Either x (x, UniqSet Name)) -> [a] -> ([x], UniqSet Name) + extractNames splitter target = + let + splitted = splitter <$> target + combined = either (, emptyUniqSet) id <$> splitted + unified = fst <$> combined + names = unionManyUniqSets (snd <$> combined) + in (unified, names) + +selectStringLitsForUnfloat :: UniqSet Name -> UniqFM Name ByteString -> UniqFM Name ByteString +selectStringLitsForUnfloat usedOnceStringLits stringLits = alwaysUnfloat `plusUFM` usedOnceUnfloat + where + alwaysUnfloat = alwaysUnfloatStringLits stringLits + usedOnceUnfloat = selectUsedOnceStringLits usedOnceStringLits stringLits + + alwaysUnfloatStringLits :: UniqFM Name ByteString -> UniqFM Name ByteString + alwaysUnfloatStringLits = filterUFM $ \b -> BS.length b < STRING_LIT_MAX_LENGTH + + selectUsedOnceStringLits :: UniqSet Name -> UniqFM Name ByteString -> UniqFM Name ByteString + selectUsedOnceStringLits usedOnceStringLits stringLits = + stringLits `intersectUFM` getUniqSet usedOnceStringLits diff --git a/GHC/StgToJS/Symbols.hs b/GHC/StgToJS/Symbols.hs --- a/GHC/StgToJS/Symbols.hs +++ b/GHC/StgToJS/Symbols.hs @@ -849,9 +849,6 @@ typeof :: FastString typeof = fsLit "typeof" -hdRawStr :: FastString -hdRawStr = fsLit "h$rstr" - throwStr :: FastString throwStr = fsLit "throw" @@ -1213,5 +1210,7 @@ hdStiStr :: FastString hdStiStr = fsLit "h$sti" -hdStrStr :: FastString -hdStrStr = fsLit "h$str" +------------------------------ Pack/Unpack -------------------------------------------- + +hdDecodeUtf8Z :: FastString +hdDecodeUtf8Z = fsLit "h$decodeUtf8z" diff --git a/GHC/StgToJS/Types.hs b/GHC/StgToJS/Types.hs --- a/GHC/StgToJS/Types.hs +++ b/GHC/StgToJS/Types.hs @@ -231,18 +231,22 @@ , siCC :: !(Maybe Ident) -- ^ optional CCS name } deriving stock (Eq, Show) +data StaticAppKind + = SAKFun + -- ^ heap object for function + | SAKThunk + -- ^ heap object for CAF + | SAKData + -- ^ regular datacon app + deriving stock (Eq, Show) + data StaticVal - = StaticFun !FastString [StaticArg] - -- ^ heap object for function - | StaticThunk !(Maybe (FastString,[StaticArg])) - -- ^ heap object for CAF (field is Nothing when thunk is initialized in an - -- alternative way, like string thunks through h$str) - | StaticUnboxed !StaticUnboxed + = StaticUnboxed !StaticUnboxed -- ^ unboxed constructor (Bool, Int, Double etc) - | StaticData !FastString [StaticArg] - -- ^ regular datacon app | StaticList [StaticArg] (Maybe FastString) -- ^ list initializer (with optional tail) + | StaticApp StaticAppKind !FastString [StaticArg] + -- ^ static application of static args. Can be a CAF, a FUN, or a CON app. deriving stock (Eq, Show) data StaticUnboxed @@ -284,8 +288,8 @@ toJExpr (IntLit i) = toJExpr i toJExpr NullLit = null_ toJExpr (DoubleLit d) = toJExpr (unSaneDouble d) - toJExpr (StringLit t) = app hdStrStr [toJExpr t] - toJExpr (BinLit b) = app hdRawStr [toJExpr (map toInteger (BS.unpack b))] + toJExpr (StringLit t) = app hdEncodeModifiedUtf8Str [toJExpr t] + toJExpr (BinLit b) = app hdRawStringDataStr [toJExpr (map toInteger (BS.unpack b))] toJExpr (LabelLit _isFun lbl) = global lbl -- | A foreign reference to some JS code @@ -297,6 +301,7 @@ , foreignRefArgs :: ![FastString] , foreignRefResult :: !FastString } + deriving (Show) -- | data used to generate one ObjBlock in our object file data LinkableUnit = LinkableUnit @@ -312,13 +317,13 @@ -- | one toplevel block in the object file data ObjBlock = ObjBlock - { oiSymbols :: ![FastString] -- ^ toplevel symbols (stored in index) - , oiClInfo :: ![ClosureInfo] -- ^ closure information of all closures in block - , oiStatic :: ![StaticInfo] -- ^ static closure data + { oiSymbols :: [FastString] -- ^ toplevel symbols (stored in index) + , oiClInfo :: [ClosureInfo] -- ^ closure information of all closures in block + , oiStatic :: [StaticInfo] -- ^ static closure data , oiStat :: Sat.JStat -- ^ the code - , oiRaw :: !BS.ByteString -- ^ raw JS code - , oiFExports :: ![ExpFun] - , oiFImports :: ![ForeignJSRef] + , oiRaw :: BS.ByteString -- ^ raw JS code + , oiFExports :: [ExpFun] + , oiFImports :: [ForeignJSRef] } data ExpFun = ExpFun diff --git a/GHC/SysTools/Cpp.hs b/GHC/SysTools/Cpp.hs --- a/GHC/SysTools/Cpp.hs +++ b/GHC/SysTools/Cpp.hs @@ -7,6 +7,7 @@ ( doCpp , CppOpts(..) , getGhcVersionPathName + , getGhcVersionIncludeFlags , applyCDefs , offsetIncludePaths ) @@ -21,7 +22,7 @@ import GHC.SysTools -import GHC.Unit.Env +import GHC.Unit.Env as UnitEnv import GHC.Unit.Info import GHC.Unit.State import GHC.Unit.Types @@ -31,7 +32,6 @@ import GHC.Utils.Panic import Data.Version -import Data.List (intercalate) import Data.Maybe import Control.Monad @@ -113,7 +113,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let hscpp_opts = picPOpts dflags let cmdline_include_paths = offsetIncludePaths dflags (includePaths dflags) - let unit_state = ue_units unit_env + let unit_state = ue_homeUnitState unit_env pkg_include_dirs <- mayThrowUnitErr (collectIncludeDirs <$> preloadUnitsInfo unit_env) -- MP: This is not quite right, the headers which are supposed to be installed in @@ -124,10 +124,10 @@ [homeUnitEnv_dflags . ue_findHomeUnitEnv uid $ unit_env | uid <- ue_transitiveHomeDeps (ue_currentUnit unit_env) unit_env] dep_pkg_extra_inputs = [offsetIncludePaths fs (includePaths fs) | fs <- home_pkg_deps] - let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] + let include_paths_global = map ("-I" ++) (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs ++ concatMap includePathsGlobal dep_pkg_extra_inputs) - let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] + let include_paths_quote = map ("-iquote" ++) (includePathsQuote cmdline_include_paths ++ includePathsQuoteImplicit cmdline_include_paths) let include_paths = include_paths_quote ++ include_paths_global @@ -155,6 +155,9 @@ let sse_defs = [ "-D__SSE__" | isSseEnabled platform ] ++ [ "-D__SSE2__" | isSse2Enabled platform ] ++ + [ "-D__SSE3__" | isSse3Enabled dflags ] ++ + [ "-D__SSSE3__" | isSsse3Enabled dflags ] ++ + [ "-D__SSE4_1__" | isSse4_1Enabled dflags ] ++ [ "-D__SSE4_2__" | isSse4_2Enabled dflags ] let fma_def = @@ -175,8 +178,7 @@ let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags] -- Default CPP defines in Haskell source - ghcVersionH <- getGhcVersionPathName dflags unit_env - let hsSourceCppOpts = [ "-include", ghcVersionH ] + ghcVersionH <- getGhcVersionIncludeFlags dflags unit_env -- MIN_VERSION macros let uids = explicitUnits unit_state @@ -199,7 +201,7 @@ cpp_prog ( map GHC.SysTools.Option verbFlags ++ map GHC.SysTools.Option include_paths - ++ map GHC.SysTools.Option hsSourceCppOpts + ++ map GHC.SysTools.Option ghcVersionH ++ map GHC.SysTools.Option target_defs ++ map GHC.SysTools.Option backend_defs ++ map GHC.SysTools.Option th_defs @@ -262,28 +264,32 @@ _ -> error "take3" (major1,major2,minor) = take3 $ map show (versionBranch version) ++ repeat "0" +getGhcVersionIncludeFlags :: DynFlags -> UnitEnv -> IO [String] +getGhcVersionIncludeFlags dflags unit_env = + getGhcVersionPathName dflags unit_env >>= \case + Nothing -> pure [] + Just path -> pure [ "-include", path ] -- | Find out path to @ghcversion.h@ file -getGhcVersionPathName :: DynFlags -> UnitEnv -> IO FilePath -getGhcVersionPathName dflags unit_env = do - let candidates = case ghcVersionFile dflags of - -- the user has provided an explicit `ghcversion.h` file to use. - Just path -> [path] - -- otherwise, try to find it in the rts' include-dirs. - -- Note: only in the RTS include-dirs! not all preload units less we may - -- use a wrong file. See #25106 where a globally installed - -- /usr/include/ghcversion.h file was used instead of the one provided - -- by the rts. - Nothing -> case lookupUnitId (ue_units unit_env) rtsUnitId of - Nothing -> [] - Just info -> ( "ghcversion.h") <$> collectIncludeDirs [info] - - found <- filterM doesFileExist candidates - case found of - [] -> throwGhcExceptionIO (InstallationError - ("ghcversion.h missing; tried: " - ++ intercalate ", " candidates)) - (x:_) -> return x +getGhcVersionPathName :: DynFlags -> UnitEnv -> IO (Maybe FilePath) +getGhcVersionPathName dflags unit_env = case ghcVersionFile dflags of + -- the user has provided an explicit `ghcversion.h` file to use. + Just path -> doesFileExist path >>= \case + True -> return (Just path) + False -> throwGhcExceptionIO (InstallationError ("ghcversion.h not found in: " ++ path)) + -- otherwise, try to find it in the rts' include-dirs. + -- Note: only in the RTS include-dirs! not all preload units less we may + -- use a wrong file. See #25106 where a globally installed + -- /usr/include/ghcversion.h file was used instead of the one provided + -- by the rts. + Nothing -> case lookupUnitId (ue_homeUnitState unit_env) rtsUnitId of + Nothing -> pure Nothing + Just info -> do + let candidates = ( "ghcversion.h") <$> collectIncludeDirs [info] + found <- filterM doesFileExist candidates + case found of + [] -> pure Nothing + (x:_) -> pure (Just x) applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String] applyCDefs NoCDefs _ _ = return [] diff --git a/GHC/SysTools/Process.hs b/GHC/SysTools/Process.hs --- a/GHC/SysTools/Process.hs +++ b/GHC/SysTools/Process.hs @@ -6,7 +6,14 @@ -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- -module GHC.SysTools.Process where +module GHC.SysTools.Process + ( readCreateProcessWithExitCode' + , getGccEnv + , runSomething + , runSomethingResponseFile + , runSomethingFiltered + , runSomethingWith + ) where import GHC.Prelude @@ -22,6 +29,14 @@ import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, mkSrcSpan ) import GHC.Data.FastString +import GHC.IO.Encoding + +#if defined(__IO_MANAGER_WINIO__) +import GHC.IO.SubSystem (()) +import GHC.IO.Handle.Windows (handleToHANDLE) +import GHC.Event.Windows (associateHandle') +#endif + import Control.Concurrent import Data.Char @@ -36,20 +51,8 @@ -- | Enable process jobs support on Windows if it can be expected to work (e.g. -- @process >= 1.6.9.0@). enableProcessJobs :: CreateProcess -> CreateProcess -#if defined(MIN_VERSION_process) enableProcessJobs opts = opts { use_process_jobs = True } -#else -enableProcessJobs opts = opts -#endif -#if !MIN_VERSION_base(4,15,0) --- TODO: This can be dropped with GHC 8.16 -hGetContents' :: Handle -> IO String -hGetContents' hdl = do - output <- hGetContents hdl - _ <- evaluate $ length output - return output -#endif -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is -- inherited from the parent process, and output to stderr is not captured. @@ -80,26 +83,6 @@ return (ex, output) -replaceVar :: (String, String) -> [(String, String)] -> [(String, String)] -replaceVar (var, value) env = - (var, value) : filter (\(var',_) -> var /= var') env - --- | Version of @System.Process.readProcessWithExitCode@ that takes a --- key-value tuple to insert into the environment. -readProcessEnvWithExitCode - :: String -- ^ program path - -> [String] -- ^ program args - -> (String, String) -- ^ addition to the environment - -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr) -readProcessEnvWithExitCode prog args env_update = do - current_env <- getEnvironment - readCreateProcessWithExitCode (proc prog args) { - env = Just (replaceVar env_update current_env) } "" - --- Don't let gcc localize version info string, #8825 -c_locale_env :: (String, String) -c_locale_env = ("LANGUAGE", "C") - -- If the -B option is set, add to PATH. This works around -- a bug in gcc on Windows Vista where it can't find its auxiliary -- binaries (see bug #1110). @@ -153,7 +136,7 @@ :: Logger -> TmpFs -> TempDir - -> (String->String) + -> ([String] -> [String]) -> String -> String -> [Option] @@ -199,7 +182,7 @@ ] runSomethingFiltered - :: Logger -> (String->String) -> String -> String -> [Option] + :: Logger -> ([String] -> [String]) -> String -> String -> [Option] -> Maybe FilePath -> Maybe [(String,String)] -> IO () runSomethingFiltered logger filter_fn phase_name pgm args mb_cwd mb_env = @@ -236,18 +219,26 @@ throwGhcExceptionIO $ InstallationError (phase_name ++ ": could not execute: " ++ pgm) +withPipe :: ((Handle, Handle) -> IO a) -> IO a +withPipe = bracket createPipe $ \ (readEnd, writeEnd) -> do + hClose readEnd + hClose writeEnd -builderMainLoop :: Logger -> (String -> String) -> FilePath +builderMainLoop :: Logger -> ([String] -> [String]) -> FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> IO ExitCode -builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env = do - chan <- newChan +builderMainLoop logger filter_fn pgm real_args mb_cwd mb_env = withPipe $ \ (readEnd, writeEnd) -> do +#if defined(__IO_MANAGER_WINIO__) + return () do + associateHandle' =<< handleToHANDLE readEnd +#endif + -- We use a mask here rather than a bracket because we want -- to distinguish between cleaning up with and without an -- exception. This is to avoid calling terminateProcess -- unless an exception was raised. - let safely inner = mask $ \restore -> do + mask $ \restore -> do -- acquire -- On Windows due to how exec is emulated the old process will exit and -- a new process will be created. This means waiting for termination of @@ -257,105 +248,86 @@ -- finish. let procdata = enableProcessJobs - $ (proc pgm real_args) { cwd = mb_cwd - , env = mb_env - , std_in = CreatePipe - , std_out = CreatePipe - , std_err = CreatePipe - } - (Just hStdIn, Just hStdOut, Just hStdErr, hProcess) <- restore $ + $ (proc pgm real_args) { + cwd = mb_cwd + , env = mb_env + , std_in = CreatePipe + + -- We used to treat stdout/stderr as separate streams, but this + -- was racy (see #25517). We now treat them as one stream and + -- that is fine for our use-case. We rely on upstream programs + -- to serialize writes to the two streams appropriately (note + -- that they already need to do that to produce deterministic + -- output when used interactively / on the command-line). + , std_out = UseHandle writeEnd + , std_err = UseHandle writeEnd + } + (Just hStdIn, Nothing, Nothing, hProcess) <- restore $ createProcess_ "builderMainLoop" procdata - let cleanup_handles = do - hClose hStdIn - hClose hStdOut - hClose hStdErr + hClose writeEnd r <- try $ restore $ do - hSetBuffering hStdOut LineBuffering - hSetBuffering hStdErr LineBuffering - let make_reader_proc h = forkIO $ readerProc chan h filter_fn - bracketOnError (make_reader_proc hStdOut) killThread $ \_ -> - bracketOnError (make_reader_proc hStdErr) killThread $ \_ -> - inner hProcess + getLocaleEncoding >>= hSetEncoding readEnd + hSetNewlineMode readEnd nativeNewlineMode + hSetBuffering readEnd LineBuffering + messages <- parseBuildMessages . filter_fn . lines <$> hGetContents readEnd + mapM_ processBuildMessage messages + waitForProcess hProcess + hClose hStdIn case r of - -- onException Left (SomeException e) -> do terminateProcess hProcess - cleanup_handles throw e - -- cleanup when there was no exception Right s -> do - cleanup_handles return s - safely $ \h -> do - -- we don't want to finish until 2 streams have been complete - -- (stdout and stderr) - log_loop chan (2 :: Integer) - -- after that, we wait for the process to finish and return the exit code. - waitForProcess h where - -- t starts at the number of streams we're listening to (2) decrements each - -- time a reader process sends EOF. We are safe from looping forever if a - -- reader thread dies, because they send EOF in a finally handler. - log_loop _ 0 = return () - log_loop chan t = do - msg <- readChan chan + processBuildMessage :: BuildMessage -> IO () + processBuildMessage msg = do case msg of BuildMsg msg -> do logInfo logger $ withPprStyle defaultUserStyle msg - log_loop chan t BuildError loc msg -> do logMsg logger errorDiagnostic (mkSrcSpan loc loc) $ withPprStyle defaultUserStyle msg - log_loop chan t - EOF -> - log_loop chan (t-1) -readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO () -readerProc chan hdl filter_fn = - (do str <- hGetContents hdl - loop (linesPlatform (filter_fn str)) Nothing) - `finally` - writeChan chan EOF - -- ToDo: check errors more carefully - -- ToDo: in the future, the filter should be implemented as - -- a stream transformer. +parseBuildMessages :: [String] -> [BuildMessage] +parseBuildMessages str = loop str Nothing where - loop [] Nothing = return () - loop [] (Just err) = writeChan chan err + loop :: [String] -> Maybe BuildMessage -> [BuildMessage] + loop [] Nothing = [] + loop [] (Just err) = [err] loop (l:ls) in_err = case in_err of Just err@(BuildError srcLoc msg) | leading_whitespace l -> loop ls (Just (BuildError srcLoc (msg $$ text l))) - | otherwise -> do - writeChan chan err - checkError l ls + | otherwise -> + err : checkError l ls Nothing -> checkError l ls - _ -> panic "readerProc/loop" + _ -> panic "parseBuildMessages/loop" + checkError :: String -> [String] -> [BuildMessage] checkError l ls = case parseError l of - Nothing -> do - writeChan chan (BuildMsg (text l)) - loop ls Nothing - Just (file, lineNum, colNum, msg) -> do - let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum + Nothing -> + BuildMsg (text l) : loop ls Nothing + Just (srcLoc, msg) -> do loop ls (Just (BuildError srcLoc (text msg))) + leading_whitespace :: String -> Bool leading_whitespace [] = False leading_whitespace (x:_) = isSpace x -parseError :: String -> Maybe (String, Int, Int, String) +parseError :: String -> Maybe (SrcLoc, String) parseError s0 = case breakColon s0 of Just (filename, s1) -> case breakIntColon s1 of Just (lineNum, s2) -> case breakIntColon s2 of Just (columnNum, s3) -> - Just (filename, lineNum, columnNum, s3) + Just (mkSrcLoc (mkFastString filename) lineNum columnNum, s3) Nothing -> - Just (filename, lineNum, 0, s2) + Just (mkSrcLoc (mkFastString filename) lineNum 0, s2) Nothing -> Nothing Nothing -> Nothing @@ -385,22 +357,3 @@ data BuildMessage = BuildMsg !SDoc | BuildError !SrcLoc !SDoc - | EOF - --- Divvy up text stream into lines, taking platform dependent --- line termination into account. -linesPlatform :: String -> [String] -#if !defined(mingw32_HOST_OS) -linesPlatform ls = lines ls -#else -linesPlatform "" = [] -linesPlatform xs = - case lineBreak xs of - (as,xs1) -> as : linesPlatform xs1 - where - lineBreak "" = ("","") - lineBreak ('\r':'\n':xs) = ([],xs) - lineBreak ('\n':xs) = ([],xs) - lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs) - -#endif diff --git a/GHC/SysTools/Tasks.hs b/GHC/SysTools/Tasks.hs --- a/GHC/SysTools/Tasks.hs +++ b/GHC/SysTools/Tasks.hs @@ -7,7 +7,26 @@ -- (c) The GHC Team 2017 -- ----------------------------------------------------------------------------- -module GHC.SysTools.Tasks where +module GHC.SysTools.Tasks + ( runUnlit + , SourceCodePreprocessor(..) + , runSourceCodePreprocessor + , runPp + , runCc + , askLd + , runAs + , runLlvmOpt + , runLlvmLlc + , runLlvmAs + , runEmscripten + , figureLlvmVersion + , runMergeObjects + , runAr + , askOtool + , runInstallNameTool + , runRanlib + , runWindres + ) where import GHC.Prelude import GHC.ForeignSrcLang @@ -63,8 +82,8 @@ augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -- | Discard some harmless warnings from gcc that we can't turn off -cc_filter :: String -> String -cc_filter = unlines . doFilter . lines where +cc_filter :: [String] -> [String] +cc_filter = doFilter where {- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, diff --git a/GHC/Tc/Deriv.hs b/GHC/Tc/Deriv.hs --- a/GHC/Tc/Deriv.hs +++ b/GHC/Tc/Deriv.hs @@ -20,52 +20,56 @@ import GHC.Driver.Session import GHC.Tc.Errors.Types -import GHC.Tc.Utils.Monad import GHC.Tc.Instance.Family import GHC.Tc.Types.Origin import GHC.Tc.Deriv.Infer import GHC.Tc.Deriv.Utils -import GHC.Tc.TyCl.Class( instDeclCtxt3, tcATDefault ) -import GHC.Tc.Utils.Env import GHC.Tc.Deriv.Generate +import GHC.Tc.TyCl.Class( instDeclCtxt3, tcATDefault ) import GHC.Tc.Validity( checkValidInstHead ) -import GHC.Core.InstEnv -import GHC.Tc.Utils.Instantiate -import GHC.Core.FamInstEnv import GHC.Tc.Gen.HsType -import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.Ppr ( pprTyVars ) -import GHC.Unit.Module.Warnings +import GHC.Tc.Utils.Monad +import GHC.Tc.Utils.Instantiate +import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.Env import GHC.Rename.Bind import GHC.Rename.Env import GHC.Rename.Module ( addTcgDUs ) import GHC.Rename.Utils +import GHC.Core.TyCo.Ppr ( pprTyVars ) +import GHC.Core.FamInstEnv +import GHC.Core.InstEnv import GHC.Core.Unify( tcUnifyTy ) import GHC.Core.Class import GHC.Core.Type -import GHC.Utils.Error import GHC.Core.DataCon -import GHC.Data.Maybe +import GHC.Core.TyCon +import GHC.Core.Predicate( tyCoVarsOfTypesWellScoped ) + import GHC.Types.Hint (AssumedDerivingStrategy(..)) import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.Name.Set as NameSet -import GHC.Core.TyCon -import GHC.Tc.Utils.TcType import GHC.Types.Var as Var import GHC.Types.Var.Env import GHC.Types.Var.Set -import GHC.Builtin.Names import GHC.Types.SrcLoc + +import GHC.Unit.Module.Warnings +import GHC.Builtin.Names + +import GHC.Utils.Error import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Logger -import GHC.Data.Bag import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs) import qualified GHC.LanguageExtensions as LangExt + +import GHC.Data.Bag +import GHC.Data.Maybe import GHC.Data.BooleanFormula ( isUnsatisfied ) import Control.Monad @@ -177,7 +181,7 @@ -- See @Note [Scoped tyvars in a TcTyCon]@ in -- "GHC.Core.TyCon". , di_clauses :: [LHsDerivingClause GhcRn] - , di_ctxt :: SDoc -- ^ error context + , di_ctxt :: ErrCtxtMsg -- ^ error context } {- @@ -520,7 +524,7 @@ -> Maybe (LDerivStrategy GhcRn) -> LocatedC [LHsSigType GhcRn] -- ^ The location refers to the @(Show, Eq)@ part of @deriving (Show, Eq)@. - -> SDoc + -> ErrCtxtMsg -> TcM [EarlyDerivSpec] deriveClause rep_tc scoped_tvs mb_lderiv_strat (L loc deriv_preds) err_ctxt = setSrcSpanA loc $ @@ -691,7 +695,7 @@ -- a no-op nowadays. deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mode)) = setSrcSpanA loc $ - addErrCtxt (standaloneCtxt deriv_ty) $ + addErrCtxt (StandaloneDerivCtxt deriv_ty) $ do { traceTc "Standalone deriving decl for" (ppr deriv_ty) ; let ctxt = GHC.Tc.Types.Origin.InstDeclCtxt True ; traceTc "Deriving strategy (standalone deriving)" $ @@ -722,12 +726,12 @@ inst_ty_kind = typeKind inst_ty mb_match = tcUnifyTy inst_ty_kind via_kind - checkTc (isJust mb_match) - (TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $ - DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind) + kind_subst <- checkJustTc + ( TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $ + DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind ) + mb_match - let Just kind_subst = mb_match - ki_subst_range = getSubstRangeTyCoFVs kind_subst + let ki_subst_range = getSubstRangeTyCoFVs kind_subst -- See Note [Unification of two kind variables in deriving] unmapped_tkvs = filter (\v -> v `notElemSubst` kind_subst && not (v `elemVarSet` ki_subst_range)) @@ -852,9 +856,10 @@ , text "tycon:" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc) , text "cls_arg:" <+> ppr (mkTyConApp tc tc_args_to_keep) <+> dcolon <+> ppr inst_ty_kind , text "cls_arg_kind:" <+> ppr cls_arg_kind ] - ; checkTc (enough_args && isJust mb_match) - (TcRnCannotDeriveInstance cls cls_tys Nothing NoGeneralizedNewtypeDeriving $ - DerivErrNotWellKinded tc cls_arg_kind n_args_to_keep) + ; kind_subst <- checkJustTc + ( TcRnCannotDeriveInstance cls cls_tys Nothing NoGeneralizedNewtypeDeriving $ + DerivErrNotWellKinded tc cls_arg_kind n_args_to_keep ) + ( guard enough_args *> mb_match ) ; let -- Returns a singleton-element list if using ViaStrategy and an -- empty list otherwise. Useful for free-variable calculations. @@ -882,7 +887,6 @@ ; let tkvs = scopedSort $ fvVarList $ unionFV (tyCoFVsOfTypes tc_args_to_keep) (FV.mkFVs deriv_tvs) - Just kind_subst = mb_match (tkvs', cls_tys', tc_args', mb_deriv_strat') = propagate_subst kind_subst tkvs cls_tys tc_args_to_keep mb_deriv_strat @@ -898,11 +902,11 @@ = typeKind (mkTyConApp tc tc_args') via_match = tcUnifyTy inst_ty_kind via_kind - checkTc (isJust via_match) - (TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $ - DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind) + via_subst <- checkJustTc + ( TcRnCannotDeriveInstance cls mempty Nothing NoGeneralizedNewtypeDeriving $ + DerivErrDerivingViaWrongKind inst_ty_kind via_ty via_kind ) + via_match - let Just via_subst = via_match pure $ propagate_subst via_subst tkvs' cls_tys' tc_args' mb_deriv_strat' @@ -1428,13 +1432,13 @@ -- EarlyDerivSpec from it. mk_eqn_from_mechanism :: DerivSpecMechanism -> DerivM EarlyDerivSpec mk_eqn_from_mechanism mechanism - = do DerivEnv { denv_overlap_mode = overlap_mode - , denv_tvs = tvs - , denv_cls = cls - , denv_inst_tys = inst_tys - , denv_ctxt = deriv_ctxt - , denv_skol_info = skol_info - , denv_warn = warn } <- ask + = do env@(DerivEnv { denv_overlap_mode = overlap_mode + , denv_tvs = tvs + , denv_cls = cls + , denv_inst_tys = inst_tys + , denv_ctxt = deriv_ctxt + , denv_skol_info = skol_info + , denv_warn = warn }) <- ask user_ctxt <- askDerivUserTypeCtxt doDerivInstErrorChecks1 mechanism loc <- lift getSrcSpanM @@ -1442,7 +1446,7 @@ case deriv_ctxt of InferContext wildcard -> do { (inferred_constraints, tvs', inst_tys', mechanism') - <- inferConstraints mechanism + <- inferConstraints mechanism env ; return $ InferTheta $ DS { ds_loc = loc , ds_name = dfun_name, ds_tvs = tvs' @@ -2349,6 +2353,3 @@ = if isDerivSpecNewtype mechanism then YesGeneralizedNewtypeDeriving else NoGeneralizedNewtypeDeriving -standaloneCtxt :: LHsSigWcType GhcRn -> SDoc -standaloneCtxt ty = hang (text "In the stand-alone deriving instance for") - 2 (quotes (ppr ty)) diff --git a/GHC/Tc/Deriv/Functor.hs b/GHC/Tc/Deriv/Functor.hs --- a/GHC/Tc/Deriv/Functor.hs +++ b/GHC/Tc/Deriv/Functor.hs @@ -8,6 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MonadComprehensions #-} -- | The deriving code for the Functor, Foldable, and Traversable classes module GHC.Tc.Deriv.Functor @@ -43,7 +44,10 @@ import GHC.Types.Var.Set import GHC.Types.Id.Make (coerceId) import GHC.Builtin.Types (true_RDR, false_RDR) +import GHC.Data.List.Infinite (Infinite (..)) +import qualified GHC.Data.List.Infinite as Inf +import Data.Foldable import Data.Maybe (catMaybes, isJust) {- @@ -181,7 +185,7 @@ fmap_eqns = map fmap_eqn data_cons - ft_fmap :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)) + ft_fmap :: FFoldType (LHsExpr GhcPs -> State (Infinite RdrName) (LHsExpr GhcPs)) ft_fmap = FT { ft_triv = \x -> pure x -- fmap f x = x , ft_var = \x -> pure $ nlHsApp f_Expr x @@ -220,7 +224,7 @@ replace_eqns = map replace_eqn data_cons - ft_replace :: FFoldType (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)) + ft_replace :: FFoldType (LHsExpr GhcPs -> State (Infinite RdrName) (LHsExpr GhcPs)) ft_replace = FT { ft_triv = \x -> pure x -- p <$ x = x , ft_var = \_ -> pure z_Expr @@ -600,27 +604,23 @@ -- The kind checks have ensured the last type parameter is of kind *. -- Make a HsLam using a fresh variable from a State monad -mkSimpleLam :: (LHsExpr GhcPs -> State [RdrName] (LHsExpr GhcPs)) - -> State [RdrName] (LHsExpr GhcPs) +mkSimpleLam :: (LHsExpr GhcPs -> State (Infinite RdrName) (LHsExpr GhcPs)) + -> State (Infinite RdrName) (LHsExpr GhcPs) -- (mkSimpleLam fn) returns (\x. fn(x)) mkSimpleLam lam = - get >>= \case - n:names -> do + get >>= \ (Inf n names) -> do put names body <- lam (nlHsVar n) return (mkHsLam (noLocA [nlVarPat n]) body) - _ -> panic "mkSimpleLam" mkSimpleLam2 :: (LHsExpr GhcPs -> LHsExpr GhcPs - -> State [RdrName] (LHsExpr GhcPs)) - -> State [RdrName] (LHsExpr GhcPs) + -> State (Infinite RdrName) (LHsExpr GhcPs)) + -> State (Infinite RdrName) (LHsExpr GhcPs) mkSimpleLam2 lam = - get >>= \case - n1:n2:names -> do + get >>= \ (n1 `Inf` n2 `Inf` names) -> do put names body <- lam (nlHsVar n1) (nlHsVar n2) return (mkHsLam (noLocA [nlVarPat n1,nlVarPat n2]) body) - _ -> panic "mkSimpleLam2" -- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]" -- @@ -637,7 +637,7 @@ -> m (LMatch GhcPs (LHsExpr GhcPs)) mkSimpleConMatch ctxt fold extra_pats con insides = do let con_name = getRdrName con - let vars_needed = takeList insides as_RDRs + let vars_needed = takeList insides as_RDRList let bare_pat = nlConVarPat con_name vars_needed let pat = if null vars_needed then bare_pat @@ -673,7 +673,7 @@ -> m (LMatch GhcPs (LHsExpr GhcPs)) mkSimpleConMatch2 ctxt fold extra_pats con insides = do let con_name = getRdrName con - vars_needed = takeList insides as_RDRs + vars_needed = takeList insides (toList as_RDRs) pat = nlConVarPat con_name vars_needed -- Make sure to zip BEFORE invoking catMaybes. We want the variable -- indices in each expression to match up with the argument indices @@ -684,13 +684,13 @@ -- with the same index has a type which mentions the last type -- variable. argTysTyVarInfo = map isJust insides - (asWithTyVar, asWithoutTyVar) = partitionByList argTysTyVarInfo as_Vars + (asWithTyVar, asWithoutTyVar) = partitionByList argTysTyVarInfo (toList as_Vars) con_expr | null asWithTyVar = nlHsApps con_name asWithoutTyVar | otherwise = - let bs = filterByList argTysTyVarInfo bs_RDRs - vars = filterByLists argTysTyVarInfo bs_Vars as_Vars + let bs = filterByList argTysTyVarInfo bs_RDRList + vars = filterByLists argTysTyVarInfo bs_VarList as_VarList in mkHsLam (noLocA (map nlVarPat bs)) (nlHsApps con_name vars) rhs <- fold con_expr exps @@ -887,7 +887,7 @@ -- Yields 'Just' an expression if we're folding over a type that mentions -- the last type parameter of the datatype. Otherwise, yields 'Nothing'. -- See Note [FFoldType and functorLikeTraverse] - ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs))) + ft_foldr :: FFoldType (State (Infinite RdrName) (Maybe (LHsExpr GhcPs))) ft_foldr = FT { ft_triv = return Nothing -- foldr f = \x z -> z @@ -922,7 +922,7 @@ mkFoldr = foldr nlHsApp z -- See Note [FFoldType and functorLikeTraverse] - ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs))) + ft_foldMap :: FFoldType (State (Infinite RdrName) (Maybe (LHsExpr GhcPs))) ft_foldMap = FT { ft_triv = return Nothing -- foldMap f = \x -> mempty @@ -949,15 +949,14 @@ where -- mappend v1 (mappend v2 ..) mkFoldMap :: [LHsExpr GhcPs] -> LHsExpr GhcPs - mkFoldMap [] = mempty_Expr - mkFoldMap xs = foldr1 (\x y -> nlHsApps mappend_RDR [x,y]) xs + mkFoldMap = foldr1WithDefault mempty_Expr (\x y -> nlHsApps mappend_RDR [x,y]) -- See Note [FFoldType and functorLikeTraverse] -- Yields NullM an expression if we're folding over an expression -- that may or may not be null. Yields IsNull if it's certainly -- null, and yields NotNull if it's certainly not null. -- See Note [Deriving null] - ft_null :: FFoldType (State [RdrName] (NullM (LHsExpr GhcPs))) + ft_null :: FFoldType (State (Infinite RdrName) (NullM (LHsExpr GhcPs))) ft_null = FT { ft_triv = return IsNull -- null = \_ -> True @@ -998,8 +997,7 @@ where -- v1 && v2 && .. mkNull :: [LHsExpr GhcPs] -> LHsExpr GhcPs - mkNull [] = true_Expr - mkNull xs = foldr1 (\x y -> nlHsApps and_RDR [x,y]) xs + mkNull = foldr1WithDefault true_Expr (\x y -> nlHsApps and_RDR [x,y]) data NullM a = IsNull -- Definitely null @@ -1082,7 +1080,7 @@ -- Yields 'Just' an expression if we're folding over a type that mentions -- the last type parameter of the datatype. Otherwise, yields 'Nothing'. -- See Note [FFoldType and functorLikeTraverse] - ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr GhcPs))) + ft_trav :: FFoldType (State (Infinite RdrName) (Maybe (LHsExpr GhcPs))) ft_trav = FT { ft_triv = return Nothing -- traverse f = pure x @@ -1140,13 +1138,21 @@ f_RDR = mkVarUnqual (fsLit "f") z_RDR = mkVarUnqual (fsLit "z") -as_RDRs, bs_RDRs :: [RdrName] -as_RDRs = [ mkVarUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) .. ] ] -bs_RDRs = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ] +as_RDRs, bs_RDRs :: Infinite RdrName +as_RDRs = [ mkVarUnqual (mkFastString ("a"++show i)) | i <- Inf.enumFrom (1::Int) ] +bs_RDRs = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- Inf.enumFrom (1::Int) ] -as_Vars, bs_Vars :: [LHsExpr GhcPs] -as_Vars = map nlHsVar as_RDRs -bs_Vars = map nlHsVar bs_RDRs +as_Vars, bs_Vars :: Infinite (LHsExpr GhcPs) +as_Vars = fmap nlHsVar as_RDRs +bs_Vars = fmap nlHsVar bs_RDRs + +as_RDRList, bs_RDRList :: [RdrName] +as_RDRList = Inf.toList as_RDRs +bs_RDRList = Inf.toList bs_RDRs + +as_VarList, bs_VarList :: [LHsExpr GhcPs] +as_VarList = Inf.toList as_Vars +bs_VarList = Inf.toList bs_Vars f_Pat, z_Pat :: LPat GhcPs f_Pat = nlVarPat f_RDR diff --git a/GHC/Tc/Deriv/Generate.hs b/GHC/Tc/Deriv/Generate.hs --- a/GHC/Tc/Deriv/Generate.hs +++ b/GHC/Tc/Deriv/Generate.hs @@ -263,7 +263,7 @@ ------------------------------------------------------------------ nested_eq_expr [] [] [] = true_Expr nested_eq_expr tys as bs - = foldr1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs) + = foldr1 and_Expr $ expectNonEmpty $ zipWith3Equal nested_eq tys as bs -- Using 'foldr1' here ensures that the derived code is correctly -- associated. See #10859. where @@ -914,7 +914,7 @@ (noLocA [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed]) $ noLocA (mkHsComp ListComp stmts con_expr) where - stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed + stmts = zipWith3Equal mk_qual as_needed bs_needed cs_needed mk_qual a b c = noLocA $ mkPsBindStmt noAnn (nlVarPat c) (nlHsApp (nlHsVar range_RDR) @@ -955,8 +955,8 @@ -- If the product type has no fields, inRange is trivially true -- (see #12853). then true_Expr - else foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range - as_needed bs_needed cs_needed) + else foldl1 and_Expr $ expectNonEmpty $ + zipWith3Equal in_range as_needed bs_needed cs_needed where in_range a b c = nlHsApps inRange_RDR [mkLHsVarTuple [a,b] noAnn, nlHsVar c] @@ -1055,9 +1055,9 @@ rhs | null data_cons -- See Note [Read for empty data types] = nlHsVar pfail_RDR | otherwise - = nlHsApp (nlHsVar parens_RDR) - (foldr1 mk_alt (read_nullary_cons ++ - read_non_nullary_cons)) + = nlHsApp (nlHsVar parens_RDR) $ + foldr1 mk_alt $ expectNonEmpty $ + read_nullary_cons ++ read_non_nullary_cons read_non_nullary_cons = map read_non_nullary_con non_nullary_cons @@ -1117,7 +1117,7 @@ ++ concat (intersperse [read_punc ","] field_stmts) ++ [read_punc "}"] - field_stmts = zipWithEqual "lbl_stmts" read_field labels as_needed + field_stmts = zipWithEqual read_field labels as_needed con_arity = dataConSourceArity data_con labels = map (field_label . flLabel) $ dataConFieldLabels data_con @@ -1125,7 +1125,7 @@ is_infix = dataConIsInfix data_con is_record = labels `lengthExceeds` 0 as_needed = take con_arity as_RDRs - read_args = zipWithEqual "gen_Read_binds" read_arg as_needed (derivDataConInstArgTys data_con dit) + read_args = zipWithEqual read_arg as_needed (derivDataConInstArgTys data_con dit) (read_a1:read_a2:_) = read_args prefix_prec = appPrecedence @@ -1269,7 +1269,7 @@ where nm = wrapOpParens (unpackFS l) - show_args = zipWithEqual "gen_Show_binds" show_arg bs_needed arg_tys + show_args = zipWithEqual show_arg bs_needed arg_tys (show_arg1:show_arg2:_) = show_args show_prefix_args = intersperse (nlHsVar showSpace_RDR) show_args @@ -1278,8 +1278,7 @@ show_record_args = concat $ intersperse [comma_space] $ [ [show_label lbl, arg] - | (lbl,arg) <- zipEqual "gen_Show_binds" - labels show_args ] + | (lbl,arg) <- zipEqual labels show_args ] show_arg :: RdrName -> Type -> LHsExpr GhcPs show_arg b arg_ty @@ -1407,7 +1406,7 @@ gfoldl_eqn con = ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed], - foldl' mk_k_app (z_Expr `nlHsApp` (eta_expand_data_con con)) as_needed) + foldl' mk_k_app (z_Expr `nlHsApp` (nlHsVar (getRdrName con))) as_needed) where con_name :: RdrName con_name = getRdrName con @@ -1427,18 +1426,9 @@ gunfold_alt dc = mkHsCaseAlt (mk_unfold_pat dc) (mk_unfold_rhs dc) mk_unfold_rhs dc = foldr nlHsApp - (z_Expr `nlHsApp` (eta_expand_data_con dc)) + (z_Expr `nlHsApp` (nlHsVar (getRdrName dc))) (replicate (dataConSourceArity dc) (nlHsVar k_RDR)) - eta_expand_data_con dc = - mkHsLam (noLocA eta_expand_pats) - (foldl nlHsApp (nlHsVar (getRdrName dc)) eta_expand_hsvars) - where - eta_expand_pats = map nlVarPat eta_expand_vars - eta_expand_hsvars = map nlHsVar eta_expand_vars - eta_expand_vars = take (dataConSourceArity dc) as_RDRs - - mk_unfold_pat dc -- Last one is a wild-pat, to avoid -- redundant test, and annoying warning | tag-fIRST_TAG == n_cons-1 = nlWildPat -- Last constructor @@ -1634,14 +1624,14 @@ ==> instance (Lift a) => Lift (Foo a) where - lift (Foo a) = [| Foo $(lift a) |] - lift ((:^:) u v) = [| (:^:) $(lift u) $(lift v) |] + lift (Foo a) = ConE 'Foo `appE` (lift a) + lift ((:^:) u v) = ConE '(:^:) `appE` (lift u) `appE` (lift v) - liftTyped (Foo a) = [|| Foo $$(liftTyped a) ||] - liftTyped ((:^:) u v) = [|| (:^:) $$(liftTyped u) $$(liftTyped v) ||] + liftTyped (Foo a) = unsafeCodeCoerce (ConE 'Foo `appE` (lift a)) + liftTyped ((:^:) u v) = unsafeCodeCoerce (ConE '(:^:) `appE` (lift u) `appE` (lift v)) -Note that we use explicit splices here in order to not trigger the implicit -lifting warning in derived code. (See #20688) +Note that we use variable quotes, in order to avoid the constructor being +lifted by implicit cross-stage lifting when `-XNoImplicitStagePersistence` is enabled. -} @@ -1651,33 +1641,37 @@ ([lift_bind, liftTyped_bind], emptyBag) where lift_bind = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr) - (map (pats_etc mk_untyped_bracket mk_usplice liftName) data_cons) + (map (pats_etc mk_untyped_bracket ) data_cons) liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp unsafeCodeCoerce_Expr . nlHsApp pure_Expr) - (map (pats_etc mk_typed_bracket mk_tsplice liftTypedName) data_cons) + (map (pats_etc mk_typed_bracket ) data_cons) - mk_untyped_bracket = HsUntypedBracket noExtField . ExpBr noAnn - mk_typed_bracket = HsTypedBracket noAnn + mk_untyped_bracket = id + mk_typed_bracket = nlHsApp unsafeCodeCoerce_Expr - mk_tsplice = HsTypedSplice noAnn - mk_usplice = HsUntypedSplice noExtField . HsUntypedSpliceExpr noAnn data_cons = getPossibleDataCons tycon tycon_args - pats_etc mk_bracket mk_splice lift_name data_con + + pats_etc :: (LHsExpr GhcPs -> LHsExpr GhcPs) -> DataCon -> ([LPat GhcPs], LHsExpr GhcPs) + pats_etc mk_bracket data_con = ([con_pat], lift_Expr) where con_pat = nlConVarPat data_con_RDR as_needed data_con_RDR = getRdrName data_con con_arity = dataConSourceArity data_con as_needed = take con_arity as_RDRs - lift_Expr = noLocA (mk_bracket br_body) - br_body = nlHsApps (Exact (dataConName data_con)) - (map lift_var as_needed) + lift_Expr = mk_bracket finish + con_brack :: LHsExpr GhcPs + con_brack = nlHsApps (Exact conEName) + [noLocA $ HsUntypedBracket noExtField + $ VarBr noSrcSpanA True (noLocA (Exact (dataConName data_con)))] + finish = foldl' (\b1 b2 -> nlHsApps (Exact appEName) [b1, b2]) con_brack (map lift_var as_needed) + lift_var :: RdrName -> LHsExpr (GhcPass 'Parsed) - lift_var x = noLocA (mk_splice (nlHsPar (mk_lift_expr x))) + lift_var x = nlHsPar (mk_lift_expr x) mk_lift_expr :: RdrName -> LHsExpr (GhcPass 'Parsed) - mk_lift_expr x = nlHsApps (Exact lift_name) [nlHsVar x] + mk_lift_expr x = nlHsApps (Exact liftName) [nlHsVar x] {- ************************************************************************ @@ -2136,7 +2130,7 @@ hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec $ nlHsCoreTy s nlHsCoreTy :: HsCoreTy -> LHsType GhcPs -nlHsCoreTy = noLocA . XHsType +nlHsCoreTy = noLocA . XHsType . HsCoreTy mkCoerceClassMethEqn :: Class -- the class being derived -> [TyVar] -- the tvs in the instance head (this includes @@ -2209,7 +2203,7 @@ where tc_name = tyConName tycon tc_name_string = occNameFS (getOccName tc_name) - definition_mod_name = moduleNameFS (moduleName (expectJust "gen_bind DerivDataDataType" $ nameModule_maybe tc_name)) + definition_mod_name = moduleNameFS (moduleName (expectJust $ nameModule_maybe tc_name)) rhs = nlHsVar mkDataType_RDR `nlHsApp` nlHsLit (mkHsStringFS (concatFS [definition_mod_name, fsLit ".", tc_name_string])) `nlHsApp` nlList (map nlHsVar dataC_RDRs) @@ -2253,10 +2247,10 @@ genAuxBindSpecSig loc spec = case spec of DerivTag2Con tycon _ -> mk_sig $ L (noAnnSrcSpan loc) $ - XHsType $ mkSpecForAllTys (tyConTyVars tycon) $ + XHsType $ HsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $ intTy `mkVisFunTyMany` mkParentType tycon DerivMaxTag _ _ - -> mk_sig (L (noAnnSrcSpan loc) (XHsType intTy)) + -> mk_sig (L (noAnnSrcSpan loc) (XHsType (HsCoreTy intTy))) DerivDataDataType _ _ _ -> mk_sig (nlHsTyVar NotPromoted dataType_RDR) DerivDataConstr _ _ _ @@ -2528,20 +2522,21 @@ showParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2 nested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs - -nested_compose_Expr [] = panic "nested_compose_expr" -- Arg is always non-empty -nested_compose_Expr [e] = parenify e -nested_compose_Expr (e:es) - = nlHsApp (nlHsApp (nlHsVar compose_RDR) (parenify e)) (nested_compose_Expr es) +nested_compose_Expr = + nlHsLam . mkSimpleMatch (LamAlt LamSingle) (noLocA [z_Pat]) . go + where + -- Previously we used (`.`), but inlining its definition improves compiler + -- performance significantly since we no longer need to typecheck lots of + -- (.) applications (each which needed three type applications, all @String) + -- (See #25453 for why this is especially slow currently) + go [] = panic "nested_compose_expr" -- Arg is always non-empty + go [e] = nlHsApp e z_Expr + go (e:es) = nlHsApp e (go es) -- impossible_Expr is used in case RHSs that should never happen. -- We generate these to keep the desugarer from complaining that they *might* happen! error_Expr :: FastString -> LHsExpr GhcPs error_Expr string = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsStringFS string)) - -parenify :: LHsExpr GhcPs -> LHsExpr GhcPs -parenify e@(L _ (HsVar _ _)) = e -parenify e = mkHsPar e -- genOpApp wraps brackets round the operator application, so that the -- renamer won't subsequently try to re-associate it. diff --git a/GHC/Tc/Deriv/Generics.hs b/GHC/Tc/Deriv/Generics.hs --- a/GHC/Tc/Deriv/Generics.hs +++ b/GHC/Tc/Deriv/Generics.hs @@ -67,8 +67,7 @@ import Control.Monad (mplus) import Data.List (zip4, partition) -import qualified Data.List as Partial (last) -import Data.List.NonEmpty (nonEmpty) +import Data.List.NonEmpty (NonEmpty (..), last, nonEmpty) import qualified Data.List.NonEmpty as NE import Data.Maybe (isJust) @@ -351,8 +350,7 @@ $ getTyVar last_dc_inst_univ where dc_inst_univs = dataConInstUnivs dc tc_args - last_dc_inst_univ = assert (not (null dc_inst_univs)) $ - Partial.last dc_inst_univs + last_dc_inst_univ = last $ expectNonEmpty dc_inst_univs -- Bindings for the Generic instance @@ -378,7 +376,7 @@ | otherwise = False where cons = length datacons - max_fields = maximum $ map dataConSourceArity datacons + max_fields = maximum $ 0 :| map dataConSourceArity datacons inline1 f = L loc'' . InlineSig noAnn (L loc' f) $ alwaysInlinePragma { inl_act = ActiveAfter NoSourceText 1 } @@ -612,7 +610,7 @@ | (t,sb',ib',j) <- zip4 l sb ib [0..] ] arg :: GenericKind_DC -> Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type - arg gk_ t (HsSrcBang _ (HsBang su ss)) ib fl = mkS fl su ss ib $ case gk_ of + arg gk_ t (HsSrcBang _ su ss) ib fl = mkS fl su ss ib $ case gk_ of -- Here we previously used Par0 if t was a type variable, but we -- realized that we can't always guarantee that we are wrapping-up -- all type variables in Par0. So we decided to stop using Par0 diff --git a/GHC/Tc/Deriv/Infer.hs b/GHC/Tc/Deriv/Infer.hs --- a/GHC/Tc/Deriv/Infer.hs +++ b/GHC/Tc/Deriv/Infer.hs @@ -17,6 +17,7 @@ import GHC.Prelude import GHC.Tc.Deriv.Utils +import GHC.Tc.Errors.Types ( ErrCtxtMsg(..) ) import GHC.Tc.Utils.Env import GHC.Tc.Deriv.Generate import GHC.Tc.Deriv.Functor @@ -26,7 +27,8 @@ import GHC.Tc.Types.Origin import GHC.Tc.Types.Constraint import GHC.Tc.Utils.TcType -import GHC.Tc.Solver +import GHC.Tc.Solver( simplifyTopImplic ) +import GHC.Tc.Solver.Solve( solveWanteds ) import GHC.Tc.Solver.Monad ( runTcS ) import GHC.Tc.Validity (validDerivPred) import GHC.Tc.Utils.Unify (buildImplicationFor) @@ -43,9 +45,8 @@ import GHC.Data.Pair import GHC.Builtin.Names -import GHC.Builtin.Types (typeToTypeKind) +import GHC.Builtin.Types (mkConstraintTupleTy, typeToTypeKind) -import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Misc @@ -65,7 +66,7 @@ ---------------------- -inferConstraints :: DerivSpecMechanism +inferConstraints :: DerivSpecMechanism -> DerivEnv -> DerivM (ThetaSpec, [TyVar], [TcType], DerivSpecMechanism) -- inferConstraints figures out the constraints needed for the -- instance declaration generated by a 'deriving' clause on a @@ -82,12 +83,12 @@ -- Generate a sufficiently large set of constraints that typechecking the -- generated method definitions should succeed. This set will be simplified -- before being used in the instance declaration -inferConstraints mechanism - = do { DerivEnv { denv_tvs = tvs - , denv_cls = main_cls - , denv_inst_tys = inst_tys } <- ask - ; wildcard <- isStandaloneWildcardDeriv - ; let infer_constraints :: DerivM (ThetaSpec, [TyVar], [TcType], DerivSpecMechanism) +inferConstraints mechanism (DerivEnv { denv_ctxt = ctxt + , denv_tvs = tvs + , denv_cls = main_cls + , denv_inst_tys = inst_tys }) + = do { let wildcard = isStandaloneWildcardDeriv ctxt + infer_constraints :: DerivM (ThetaSpec, [TyVar], [TcType], DerivSpecMechanism) infer_constraints = case mechanism of DerivSpecStock{dsm_stock_dit = dit} @@ -168,12 +169,12 @@ , dit_tc_args = tc_args , dit_rep_tc = rep_tc , dit_rep_tc_args = rep_tc_args }) - = do DerivEnv { denv_tvs = tvs + = do DerivEnv { denv_ctxt = ctxt + , denv_tvs = tvs , denv_cls = main_cls , denv_inst_tys = inst_tys } <- ask - wildcard <- isStandaloneWildcardDeriv - - let inst_ty = mkTyConApp tc tc_args + let wildcard = isStandaloneWildcardDeriv ctxt + inst_ty = mkTyConApp tc tc_args tc_binders = tyConBinders rep_tc choose_level bndr | isNamedTyConBinder bndr = KindLevel @@ -296,7 +297,7 @@ = map $ \ty -> let ki = typeKind ty in ( [ mk_cls_pred orig t_or_k cls ty , SimplePredSpec - { sps_pred = mkPrimEqPred ki typeToTypeKind + { sps_pred = mkNomEqPred ki typeToTypeKind , sps_origin = orig , sps_type_or_kind = KindLevel } @@ -369,13 +370,14 @@ -- derived instance context. inferConstraintsAnyclass :: DerivM ThetaSpec inferConstraintsAnyclass - = do { DerivEnv { denv_cls = cls + = do { DerivEnv { denv_ctxt = ctxt + , denv_cls = cls , denv_inst_tys = inst_tys } <- ask ; let gen_dms = [ (sel_id, dm_ty) | (sel_id, Just (_, GenericDM dm_ty)) <- classOpItems cls ] - ; wildcard <- isStandaloneWildcardDeriv - ; let meth_pred :: (Id, Type) -> PredSpec + ; let wildcard = isStandaloneWildcardDeriv ctxt + meth_pred :: (Id, Type) -> PredSpec -- (Id,Type) are the selector Id and the generic default method type -- NB: the latter is /not/ quantified over the class variables -- See Note [Gathering and simplifying constraints for DeriveAnyClass] @@ -407,46 +409,64 @@ inferConstraintsCoerceBased :: [Type] -> Type -> DerivM ThetaSpec inferConstraintsCoerceBased cls_tys rep_ty = do - DerivEnv { denv_tvs = tvs + DerivEnv { denv_ctxt = ctxt + , denv_tvs = tvs , denv_cls = cls , denv_inst_tys = inst_tys } <- ask - sa_wildcard <- isStandaloneWildcardDeriv - let -- The following functions are polymorphic over the representation - -- type, since we might either give it the underlying type of a - -- newtype (for GeneralizedNewtypeDeriving) or a @via@ type - -- (for DerivingVia). - rep_tys ty = cls_tys ++ [ty] - rep_pred ty = mkClassPred cls (rep_tys ty) - rep_pred_o ty = SimplePredSpec { sps_pred = rep_pred ty - , sps_origin = deriv_origin - , sps_type_or_kind = TypeLevel - } + let -- rep_ty might come from: + -- GeneralizedNewtypeDeriving / DerivSpecNewtype: + -- the underlying type of the newtype () + -- DerivingVia / DerivSpecVia + -- the `via` type + + rep_pred_o = SimplePredSpec { sps_pred = mkClassPred cls (cls_tys ++ [rep_ty]) + , sps_origin = deriv_origin + , sps_type_or_kind = TypeLevel + } -- rep_pred is the representation dictionary, from where -- we are going to get all the methods for the final -- dictionary deriv_origin = mkDerivOrigin sa_wildcard + sa_wildcard = isStandaloneWildcardDeriv ctxt -- Next we collect constraints for the class methods -- If there are no methods, we don't need any constraints -- Otherwise we need (C rep_ty), for the representation methods, -- and constraints to coerce each individual method - meth_preds :: Type -> ThetaSpec - meth_preds ty - | null meths = [] -- No methods => no constraints - -- (#12814) - | otherwise = rep_pred_o ty : coercible_constraints ty + meth_preds :: ThetaSpec + meth_preds | null meths = [] -- No methods => no constraints (#12814) + | otherwise = rep_pred_o : coercible_constraints meths = classMethods cls - coercible_constraints ty + + coercible_constraints = [ SimplePredSpec - { sps_pred = mkReprPrimEqPred t1 t2 + { sps_pred = + assertPpr (tvs1 == tvs2) (ppr t1 $$ ppr t2) $ + -- assert: mkCoerceClassMethEqn returns two + -- foralls with the very same forall-binders + tcMkDFunSigmaTy tvs2 theta2 $ + mkConstraintTupleTy $ mkReprEqPred tau1 tau2 : theta1 + -- The two method types (tau1, tau2) must be coercible. + -- Also, if there are constraints, the constraints + -- provided to the derived method (theta2) must be + -- sufficient to solve the constraints required by the + -- method being coerced (theta1). + -- See Note [Inferred contexts from method constraints] , sps_origin = DerivOriginCoerce meth t1 t2 sa_wildcard , sps_type_or_kind = TypeLevel } | meth <- meths , let (Pair t1 t2) = mkCoerceClassMethEqn cls tvs - inst_tys ty meth ] + inst_tys rep_ty meth + -- If we have class C a b c where { op :: op_ty } + -- and inst_tys = [t1, t2, t3] + -- then t1 = op_ty{t1,t2,rep_ty/a,b,c] + -- t2 = op_ty{t1,t2,t3/a,b,c] + , let (tvs1, theta1, tau1) = tcSplitSigmaTy t1 + , let (tvs2, theta2, tau2) = tcSplitSigmaTy t2 + ] - pure (meth_preds rep_ty) + pure meth_preds {- Note [Inferring the instance context] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -550,7 +570,72 @@ a context for the Data instances: instance Typeable a => Data (T a) where ... +Note [Inferred contexts from method constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the `deriving Alt` part of this example (from the passing part of +T20815a): + class Alt f where + some :: forall a. Applicative f => f a -> f [a] + + newtype T f a = T (f a) deriving Alt + +We will produce this derived instance declaration: + + instance (Alt f, ???) => Alt (T f) where + some :: forall a. Applicative (T f) => T f a -> T f [a] + some @a (d1 :: Applicative (T f)) + = coerce @(f a -> f [a]) + @(T f a -> T f [a]) + (d2 :: Coercible (f a -> f [a]) (T f a -> T f [a])) + (some @f (d3 :: Alt f) @a (d4 :: Applicative f)) + +(Dictionary abstractions and applications are added here even though they are +not usually visible, or even emitted in the code generated by `deriving`.) + +The task of `inferConstraints` is to determine the `???` such that it will be +sufficient to solve the constraints arising from that definition of `some`. We +can write out what the type checker sees as follows: + + forall f + [G] Alt f -- Given + [G] ??? -- Given + => + forall a. + [G] Applicative (T f) -- Also given (as d1) + => + [W] Coercible (f a -> f [a]) (T f a -> T f [a]) -- Wanted (as d2) + [W] Alt f -- Wanted (as d3) + [W] Applicative f -- Wanted (as d4) + +`d3` is trivially provided by the given `Alt f`. The simplest way to ensure that +`d4` and `d2` can be solved is to: + +* Generate this "target constraint" (in `inferConstraintsCoerceBased`): + + forall a. Applicative (T f) + => ( Coercible (f a -> f [a]) (T f a -> T f [a]) + , Applicative f + ) + +* Simplify the target constraint (in `simplifyInstanceContexts`, which in turn + calls `simplifyDeriv`). This solves the `Coercible` constraint outright, but + cannot solve the `Applicative f` constraint. + See Note [Simplifying the instance context] + +* The leftover, unsolved constraint (here `Applicative f`) becomes the `???` in + the derived instance decl. + +The target constraint for GND is created in `inferConstraintsCoerceBased`. + +In general, the point here is that the inferred context for a derived instance +must include, for each class method with constraints, a quantified constraint +mapping the provided context for the derived method to both: + - the `Coercible` corresponding to the monotypes of the base and derived + methods, and + - the needed context for the base method. + + ************************************************************************ * * Finding the fixed point of deriving equations @@ -714,10 +799,6 @@ -- See Note [Deterministic simplifyInstanceContexts] canSolution = map (sortBy nonDetCmpType) -derivInstCtxt :: PredType -> SDoc -derivInstCtxt pred - = text "When deriving the instance for" <+> parens (ppr pred) - {- *********************************************************************************** * * @@ -736,7 +817,7 @@ , ds_cls = clas, ds_tys = inst_tys, ds_theta = deriv_rhs , ds_skol_info = skol_info, ds_user_ctxt = user_ctxt }) = setSrcSpan loc $ - addErrCtxt (derivInstCtxt (mkClassPred clas inst_tys)) $ + addErrCtxt (DerivInstCtxt (mkClassPred clas inst_tys)) $ do { -- See [STEP DAC BUILD] -- Generate the implication constraints, one for each method, to solve @@ -762,9 +843,11 @@ -- See [STEP DAC HOIST] -- From the simplified constraints extract a subset 'good' that will -- become the context 'min_theta' for the derived instance. - ; let residual_simple = approximateWC True solved_wanteds - head_size = pSizeClassPred clas inst_tys - good = mapMaybeBag get_good residual_simple + ; let residual_simple = approximateWC False solved_wanteds + -- False: ignore any non-quantifiable constraints, + -- including equalities hidden under Given equalities + head_size = pSizeClassPred clas inst_tys + good = mapMaybeBag get_good residual_simple -- Returns @Just p@ (where @p@ is the type of the Ct) if a Ct is -- suitable to be inferred in the context of a derived instance. diff --git a/GHC/Tc/Deriv/Utils.hs b/GHC/Tc/Deriv/Utils.hs --- a/GHC/Tc/Deriv/Utils.hs +++ b/GHC/Tc/Deriv/Utils.hs @@ -55,23 +55,23 @@ import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface (mi_fix) -import GHC.Types.Fixity.Env (lookupFixity) import GHC.Iface.Load (loadInterfaceForName) + +import GHC.Types.Fixity.Env (lookupFixity) import GHC.Types.Name import GHC.Types.SrcLoc -import GHC.Utils.Misc import GHC.Types.Var.Set import GHC.Builtin.Names import GHC.Builtin.Names.TH (liftClassKey) +import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Error import GHC.Utils.Unique (sameUnique) import Control.Monad.Trans.Reader -import Data.Foldable (traverse_) import Data.Maybe import qualified GHC.LanguageExtensions as LangExt import GHC.Data.List.SetOps (assocMaybe) @@ -92,12 +92,9 @@ -- | Is GHC processing a standalone deriving declaration with an -- extra-constraints wildcard as the context? -- (e.g., @deriving instance _ => Eq (Foo a)@) -isStandaloneWildcardDeriv :: DerivM Bool -isStandaloneWildcardDeriv = asks (go . denv_ctxt) - where - go :: DerivContext -> Bool - go (InferContext wildcard) = isJust wildcard - go (SupplyContext {}) = False +isStandaloneWildcardDeriv :: DerivContext -> Bool +isStandaloneWildcardDeriv (InferContext wildcard) = isJust wildcard +isStandaloneWildcardDeriv (SupplyContext {}) = False -- | Return 'InstDeclCtxt' if processing with a standalone @deriving@ -- declaration or 'DerivClauseCtxt' if processing a @deriving@ clause. @@ -109,12 +106,8 @@ go (InferContext Just{}) = InstDeclCtxt True go (InferContext Nothing) = DerivClauseCtxt --- | @'mkDerivOrigin' wc@ returns 'StandAloneDerivOrigin' if @wc@ is 'True', --- and 'DerivClauseOrigin' if @wc@ is 'False'. Useful for error-reporting. mkDerivOrigin :: Bool -> CtOrigin -mkDerivOrigin standalone_wildcard - | standalone_wildcard = StandAloneDerivOrigin - | otherwise = DerivClauseOrigin +mkDerivOrigin standalone = DerivOrigin standalone -- | Contains all of the information known about a derived instance when -- determining what its @EarlyDerivSpec@ should be. @@ -563,11 +556,19 @@ SimplePredSpec { sps_pred :: TcPredType -- ^ The constraint to emit as a wanted + -- Usually just a simple predicate like (Eq a) or (ki ~# Type), + -- but can be a forall-constraint: + -- * in the case of GHC.Tc.Deriv.Infer.inferConstraintsCoerceBased + -- * if a class has quantified-constraint superclasses, + -- via `mkDirectThetaSpec` in `inferConstraints` + , sps_origin :: CtOrigin -- ^ The origin of the constraint + , sps_type_or_kind :: TypeOrKind -- ^ Whether the constraint is a type or kind } + | -- | A special 'PredSpec' that is only used by @DeriveAnyClass@. This -- will check if @stps_ty_actual@ is a subtype of (i.e., more polymorphic -- than) @stps_ty_expected@ in the constraint solving machinery, emitting an @@ -677,8 +678,8 @@ -- @deriving@ declaration -> ThetaSpec -- ^ The specs from which constraints will be created -> TcM (TcLevel, WantedConstraints) -captureThetaSpecConstraints user_ctxt theta = - pushTcLevelM $ mk_wanteds theta +captureThetaSpecConstraints user_ctxt theta + = pushTcLevelM $ mk_wanteds theta where -- Create the constraints we need to solve. For stock and newtype -- deriving, these constraints will be simple wanted constraints @@ -689,34 +690,28 @@ mk_wanteds :: ThetaSpec -> TcM WantedConstraints mk_wanteds preds = do { (_, wanteds) <- captureConstraints $ - traverse_ emit_constraints preds + mapM_ (emitPredSpecConstraints user_ctxt) preds ; pure wanteds } - -- Emit the appropriate constraints depending on what sort of - -- PredSpec we are dealing with. - emit_constraints :: PredSpec -> TcM () - emit_constraints ps = - case ps of - -- For constraints like (C a, Ord b), emit the - -- constraints directly as simple wanted constraints. - SimplePredSpec { sps_pred = wanted - , sps_origin = orig - , sps_type_or_kind = t_or_k - } -> do - ev <- newWanted orig (Just t_or_k) wanted - emitSimple (mkNonCanonical ev) +emitPredSpecConstraints :: UserTypeCtxt -> PredSpec -> TcM () +--- Emit the appropriate constraints depending on what sort of +-- PredSpec we are dealing with. +emitPredSpecConstraints _ (SimplePredSpec { sps_pred = wanted_pred + , sps_origin = orig + , sps_type_or_kind = t_or_k }) + = do { ev <- newWanted orig (Just t_or_k) wanted_pred + ; emitSimple (mkNonCanonical ev) } - -- For DeriveAnyClass, check if ty_actual is a subtype of - -- ty_expected, which emits an implication constraint as a - -- side effect. See - -- Note [Gathering and simplifying constraints for DeriveAnyClass]. - -- in GHC.Tc.Deriv.Infer. - SubTypePredSpec { stps_ty_actual = ty_actual - , stps_ty_expected = ty_expected - , stps_origin = orig - } -> do - _ <- tcSubTypeSigma orig user_ctxt ty_actual ty_expected - return () +emitPredSpecConstraints user_ctxt + (SubTypePredSpec { stps_ty_actual = ty_actual + , stps_ty_expected = ty_expected + , stps_origin = orig }) +-- For DeriveAnyClass, check if ty_actual is a subtype of ty_expected, +-- which emits an implication constraint as a side effect. See +-- Note [Gathering and simplifying constraints for DeriveAnyClass] +-- in GHC.Tc.Deriv.Infer. + = do { _ <- tcSubTypeSigma orig user_ctxt ty_actual ty_expected + ; return () } {- ************************************************************************ @@ -927,6 +922,7 @@ cond_vanilla `andCond` cond_Representable1Ok) | sameUnique cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` + checkFlag LangExt.ImplicitStagePersistence `andCond` cond_vanilla `andCond` cond_args cls) | otherwise = Nothing diff --git a/GHC/Tc/Errors.hs b/GHC/Tc/Errors.hs --- a/GHC/Tc/Errors.hs +++ b/GHC/Tc/Errors.hs @@ -1,12 +1,11 @@ - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ParallelListComp #-} -{-# LANGUAGE ScopedTypeVariables #-} - -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ParallelListComp #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} module GHC.Tc.Errors( reportUnsolved, reportAllUnsolved, warnAllUnsolved, @@ -37,10 +36,9 @@ import GHC.Tc.Zonk.TcType import GHC.Tc.Types.Origin import GHC.Tc.Types.Evidence -import GHC.Tc.Types.EvTerm import GHC.Tc.Instance.Family import GHC.Tc.Utils.Instantiate -import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits, getHoleFitDispConfig, pprHoleFit ) +import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits, getHoleFitDispConfig ) import GHC.Types.Name import GHC.Types.Name.Reader @@ -61,7 +59,7 @@ import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Ppr ( pprTyVars ) -import GHC.Core.TyCo.Tidy ( tidyAvoiding ) +import GHC.Core.TyCo.Tidy import GHC.Core.InstEnv import GHC.Core.TyCon import GHC.Core.DataCon @@ -267,7 +265,9 @@ important :: SolverReportErrCtxt -> TcSolverReportMsg -> SolverReport important ctxt doc = SolverReport { sr_important_msg = SolverReportWithCtxt ctxt doc - , sr_supplementary = [] } + , sr_supplementary = [] + , sr_hints = noHints + } add_relevant_bindings :: RelevantBindings -> SolverReport -> SolverReport add_relevant_bindings binds report@(SolverReport { sr_supplementary = supp }) @@ -398,13 +398,6 @@ | null redundant_evs = return () - -- Do not report redundant constraints for quantified constraints - -- See (RC4) in Note [Tracking redundant constraints] - -- Fortunately it is easy to spot implications constraints that arise - -- from quantified constraints, from their SkolInfo - | InstSkol (IsQC {}) _ <- info - = return () - | SigSkol user_ctxt _ _ <- info -- When dealing with a user-written type signature, -- we want to add "In the type signature for f". @@ -423,20 +416,16 @@ -> TcRn () report_redundant_msg show_info lcl_env = do { msg <- - mkErrorReport - lcl_env + mkErrorReport lcl_env (TcRnRedundantConstraints redundant_evs (info, show_info)) - (Just ctxt) - [] + (Just ctxt) [] [] ; reportDiagnostic msg } reportBadTelescope :: SolverReportErrCtxt -> CtLocEnv -> SkolemInfoAnon -> [TcTyVar] -> TcM () reportBadTelescope ctxt env (ForAllSkol telescope) skols - = do { msg <- mkErrorReport - env + = do { msg <- mkErrorReport env (TcRnSolverReport report ErrorWithoutFlag) - (Just ctxt) - [] + (Just ctxt) [] [] ; reportDiagnostic msg } where report = SolverReportWithCtxt ctxt $ BadTelescope telescope skols @@ -450,10 +439,9 @@ -- See Note [Constraints to ignore]. ignoreConstraint :: Ct -> Bool ignoreConstraint ct - | AssocFamPatOrigin <- ctOrigin ct - = True - | otherwise - = False + = case ctOrigin ct of + AssocFamPatOrigin -> True -- See (CIG1) + _ -> False -- | Makes an error item from a constraint, calculating whether or not -- the item should be suppressed. See Note [Wanteds rewrite Wanteds] @@ -469,13 +457,12 @@ = do { let loc = ctLoc ct flav = ctFlavour ct - ; (suppress, m_evdest) <- case ctEvidence ct of - -- For this `suppress` stuff - -- see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint - CtGiven {} -> return (False, Nothing) - CtWanted { ctev_rewriters = rewriters, ctev_dest = dest } - -> do { rewriters' <- zonkRewriterSet rewriters - ; return (not (isEmptyRewriterSet rewriters'), Just dest) } + (suppress, m_evdest) = case ctEvidence ct of + -- For this `suppress` stuff + -- see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint + CtGiven {} -> (False, Nothing) + CtWanted (WantedCt { ctev_rewriters = rws, ctev_dest = dest }) + -> (not (isEmptyRewriterSet rws), Just dest) ; let m_reason = case ct of CIrredCan (IrredCt { ir_reason = reason }) -> Just reason @@ -506,7 +493,7 @@ , text "tidy_errs =" <+> ppr tidy_errs ]) -- Catch an awkward (and probably rare) case in which /all/ errors are - -- suppressed: see Wrinkle (WRW2) in Note [Prioritise Wanteds with empty + -- suppressed: see Wrinkle (PER2) in Note [Prioritise Wanteds with empty -- RewriterSet] in GHC.Tc.Types.Constraint. -- -- Unless we are sure that an error will be reported some other way @@ -525,7 +512,7 @@ = tidy_items1 -- First, deal with any out-of-scope errors: - ; let (out_of_scope, other_holes, not_conc_errs) = partition_errors tidy_errs + ; let (out_of_scope, other_holes, not_conc_errs, mult_co_errs) = partition_errors tidy_errs -- don't suppress out-of-scope errors ctxt_for_scope_errs = ctxt { cec_suppress = False } ; (_, no_out_of_scope) <- askNoErrs $ @@ -542,16 +529,23 @@ ; reportNotConcreteErrs ctxt_for_insols not_conc_errs + -- We only want to report multiplicity coercion errors for multiplicity + -- constraints which are /solved/ with a non-reflexivity coercion. We + -- over approximate here: we only report multiplicity coercion errors + -- when /all/ constraints are solved. + -- See wrinkle (DME1) in Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify. + ; when (null simples) $ reportMultiplicityCoercionErrs ctxt_for_insols mult_co_errs + -- See Note [Suppressing confusing errors] - ; let (suppressed_items, items0) = partition suppress tidy_items + ; let (suppressed_items, reportable_items) = partition suppressItem tidy_items ; traceTc "reportWanteds suppressed:" (ppr suppressed_items) - ; (ctxt1, items1) <- tryReporters ctxt_for_insols report1 items0 + ; (ctxt1, items1) <- tryReporters ctxt_for_insols report1 reportable_items -- Now all the other constraints. We suppress errors here if -- any of the first batch failed, or if the enclosing context -- says to suppress ; let ctxt2 = ctxt1 { cec_suppress = cec_suppress ctxt || cec_suppress ctxt1 } - ; (ctxt3, leftovers) <- tryReporters ctxt2 report2 items1 + ; (_, leftovers) <- tryReporters ctxt2 report2 items1 ; massertPpr (null leftovers) (text "The following unsolved Wanted constraints \ \have not been reported to the user:" @@ -562,41 +556,37 @@ -- wanted insoluble here; but do suppress inner insolubles -- if there's a *given* insoluble here (= inaccessible code) - -- Only now, if there are no errors, do we report suppressed ones - -- See Note [Suppressing confusing errors] - -- We don't need to update the context further because of the - -- whenNoErrs guard - ; whenNoErrs $ - do { (_, more_leftovers) <- tryReporters ctxt3 report3 suppressed_items + -- If there are no other errors to report, report suppressed errors. + -- See Note [Suppressing confusing errors]. NB: with -fdefer-type-errors + -- we might have reported warnings only from `reportable_items`, but we + -- still want to suppress the `suppressed_items`. + ; when (null reportable_items) $ + do { (_, more_leftovers) <- tryReporters ctxt_for_insols (report1++report2) + suppressed_items + -- ctxt_for_insols: the suppressed errors can be Int~Bool, which + -- will have made the incoming `ctxt` be True; don't make that + -- suppress the Int~Bool error! ; massertPpr (null more_leftovers) (ppr more_leftovers) } } where env = cec_tidy ctxt tidy_cts = bagToList (mapBag (tidyCt env) simples) tidy_errs = bagToList (mapBag (tidyDelayedError env) errs) - partition_errors :: [DelayedError] -> ([Hole], [Hole], [NotConcreteError]) - partition_errors = go [] [] [] - where - go out_of_scope other_holes syn_eqs [] - = (out_of_scope, other_holes, syn_eqs) - go es1 es2 es3 (err:errs) - | (es1, es2, es3) <- go es1 es2 es3 errs - = case err of - DE_Hole hole - | isOutOfScopeHole hole - -> (hole : es1, es2, es3) - | otherwise - -> (es1, hole : es2, es3) - DE_NotConcrete err - -> (es1, es2, err : es3) - - -- See Note [Suppressing confusing errors] - suppress :: ErrorItem -> Bool - suppress item - | Wanted <- ei_flavour item - = is_ww_fundep_item item - | otherwise - = False + partition_errors :: [DelayedError] -> ([Hole], [Hole], [NotConcreteError], [(TcCoercion, CtLoc)]) + partition_errors [] + = ([], [], [], []) + partition_errors (err:errs) + | (es1, es2, es3, es4) <- partition_errors errs + = case err of + DE_Hole hole + | isOutOfScopeHole hole + -> (hole : es1, es2, es3, es4) + | otherwise + -> (es1, hole : es2, es3, es4) + DE_NotConcrete err + -> (es1, es2, err : es3, es4) + DE_Multiplicity mult_co loc + -> (es1, es2, es3, (mult_co, loc):es4) -- report1: ones that should *not* be suppressed by -- an insoluble somewhere else in the tree @@ -604,34 +594,53 @@ -- (see GHC.Tc.Utils.insolublWantedCt) is caught here, otherwise -- we might suppress its error message, and proceed on past -- type checking to get a Lint error later - report1 = [ ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) - -- (Handles TypeError and Unsatisfiable) + report1 = [ -- We put implicit lifting errors first, because are solid errors + -- See "Implicit lifting" in GHC.Tc.Gen.Splice + -- Note [Lifecycle of an untyped splice, and PendingRnSplice] + ("implicit lifting", is_implicit_lifting, True, mkImplicitLiftingReporter) + -- Next, solid equality errors , given_eq_spec , ("insoluble2", utterly_wrong, True, mkGroupReporter mkEqErr) , ("skolem eq1", very_wrong, True, mkSkolReporter) , ("FixedRuntimeRep", is_FRR, True, mkGroupReporter mkFRRErr) , ("skolem eq2", skolem_eq, True, mkSkolReporter) + + -- Next, custom type errors + -- See Note [Custom type errors in constraints] in GHC.Tc.Types.Constraint + -- + -- Put custom type errors /after/ solid equality errors. In #26255 we + -- had a custom error (T <= F alpha) which was suppressing a far more + -- informative (K Int ~ [K alpha]). That mismatch between K and [] is + -- definitely wrong; and if it was fixed we'd know alpha:=Int, and hence + -- perhaps be able to solve T <= F alpha, by reducing F Int. + -- + -- But put custom type errors /before/ "non-tv eq", because if we have + -- () ~ TypeError blah + -- we want to report it as a custom error, /not/ as a mis-match + -- between TypeError and ()! Also see the Assert example + -- in Note [Custom type errors in constraints] + , ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) + -- (Handles TypeError and Unsatisfiable) + + -- "non-tv-eq": equalities (ty1 ~ ty2) where ty1 is not a tyvar , ("non-tv eq", non_tv_eq, True, mkSkolReporter) -- The only remaining equalities are alpha ~ ty, -- where alpha is untouchable; and representational equalities -- Prefer homogeneous equalities over hetero, because the -- former might be holding up the latter. - -- See Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality + -- See Note [Equalities with heterogeneous kinds] in GHC.Tc.Solver.Equality , ("Homo eqs", is_homo_equality, True, mkGroupReporter mkEqErr) , ("Other eqs", is_equality, True, mkGroupReporter mkEqErr) + ] -- report2: we suppress these if there are insolubles elsewhere in the tree report2 = [ ("Implicit params", is_ip, False, mkGroupReporter mkIPErr) , ("Irreds", is_irred, False, mkGroupReporter mkIrredErr) - , ("Dicts", is_dict, False, mkGroupReporter mkDictErr) ] - - -- report3: suppressed errors should be reported as categorized by either report1 - -- or report2. Keep this in sync with the suppress function above - report3 = [ ("wanted/wanted fundeps", is_ww_fundep, True, mkGroupReporter mkEqErr) - ] + , ("Dicts", is_dict, False, mkGroupReporter mkDictErr) + , ("Quantified", is_qc, False, mkGroupReporter mkQCErr) ] -- rigid_nom_eq, rigid_nom_tv_eq, is_dict, is_equality, is_ip, is_FRR, is_irred :: ErrorItem -> Pred -> Bool @@ -668,6 +677,11 @@ -- See also Note [Implementation of Unsatisfiable constraints], point (F). is_user_type_error item _ = containsUserTypeError (errorItemPred item) + is_implicit_lifting item _ = + case (errorItemOrigin item) of + ImplicitLiftOrigin {} -> True + _ -> False + is_homo_equality _ (EqPred _ ty1 ty2) = typeKind ty1 `tcEqType` typeKind ty2 is_homo_equality _ _ @@ -685,9 +699,8 @@ is_irred _ (IrredPred {}) = True is_irred _ _ = False - -- See situation (1) of Note [Suppressing confusing errors] - is_ww_fundep item _ = is_ww_fundep_item item - is_ww_fundep_item = isWantedWantedFunDepOrigin . errorItemOrigin + is_qc _ (ForAllPred {}) = True + is_qc _ _ = False given_eq_spec -- See Note [Given errors] | has_gadt_match_here @@ -714,6 +727,16 @@ = has_gadt_match implics --------------- +suppressItem :: ErrorItem -> Bool + -- See Note [Suppressing confusing errors] +suppressItem item + | Wanted <- ei_flavour item + , let orig = errorItemOrigin item + = isWantedSuperclassOrigin orig -- See (SCE1) + || isWantedWantedFunDepOrigin orig -- See (SCE2) + | otherwise + = False + isSkolemTy :: TcLevel -> Type -> Bool -- The type is a skolem tyvar isSkolemTy tc_lvl ty @@ -736,9 +759,25 @@ Certain errors we might encounter are potentially confusing to users. If there are any other errors to report, at all, we want to suppress these. -Which errors (only 1 case right now): +Which errors are suppressed? -1) Errors which arise from the interaction of two Wanted fun-dep constraints. +(SCE1) Superclasses of Wanteds. These are generated only in case they trigger functional + dependencies. If such a constraint is unsolved, then its "parent" constraint must + also be unsolved, and is much more informative to the user. Example (#26255): + class (MinVersion <= F era) => Era era where { ... } + f :: forall era. EraFamily era -> IO () + f = ..blah... -- [W] Era era + Here we have simply omitted "Era era =>" from f's type. But we'll end up with + /two/ Wanted constraints: + [W] d1 : Era era + [W] d2 : MinVersion <= F era -- Superclass of d1 + We definitely want to report d1 and not d2! Happily it's easy to filter out those + superclass-Wanteds, becuase their Origin betrays them. + + See test T18851 for an example of how it is (just, barely) possible for the /only/ + errors to be superclass-of-Wanted constraints. + +(SCE2) Errors which arise from the interaction of two Wanted fun-dep constraints. Example: class C a b | a -> b where @@ -781,7 +820,7 @@ Currently, the constraints to ignore are: -1) Constraints generated in order to unify associated type instance parameters +(CIG1) Constraints generated in order to unify associated type instance parameters with class parameters. Here are two illustrative examples: class C (a :: k) where @@ -809,6 +848,9 @@ If there is any trouble, checkValidFamInst bleats, aborting compilation. +(Note: Aug 25: this seems a rather tricky corner; + c.f. Note [Suppressing confusing errors]) + Note [Implementation of Unsatisfiable constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Unsatisfiable constraint was introduced in GHC proposal #433 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-unsatisfiable.rst). @@ -954,7 +996,7 @@ -- Suppress duplicates with either the same LHS, or same location -- Pre-condition: all items are equalities mkSkolReporter ctxt items - = mapM_ (reportGroup mkEqErr ctxt) (group (toList items)) + = mapM_ (reportGroup (mkEqErr ctxt) ctxt) (group (toList items)) where group [] = [] group (item:items) = (item :| yeses) : group noes @@ -1025,7 +1067,7 @@ reportNotConcreteErrs :: SolverReportErrCtxt -> [NotConcreteError] -> TcM () reportNotConcreteErrs _ [] = return () reportNotConcreteErrs ctxt errs@(err0:_) - = do { msg <- mkErrorReport (ctLocEnv (nce_loc err0)) diag (Just ctxt) [] + = do { msg <- mkErrorReport (ctLocEnv (nce_loc err0)) diag (Just ctxt) [] [] ; reportDiagnostic msg } where @@ -1044,13 +1086,25 @@ | frr_errs <- go frr_errs errs = case err of NCE_FRR - { nce_frr_origin = frr_orig - , nce_reasons = _not_conc } -> + { nce_frr_origin = frr_orig } -> FRR_Info { frr_info_origin = frr_orig - , frr_info_not_concrete = Nothing } + , frr_info_not_concrete = Nothing + , frr_info_other_origin = Nothing } : frr_errs +reportMultiplicityCoercionErrs :: SolverReportErrCtxt -> [(TcCoercion, CtLoc)] -> TcM () +reportMultiplicityCoercionErrs ctxt errs = mapM_ reportOne errs + where + reportOne :: (TcCoercion, CtLoc) -> TcM () + reportOne (_co, loc) + = do { msg <- mkErrorReport (ctLocEnv loc) diag (Just ctxt) [] [] + ; reportDiagnostic msg } + + diag = TcRnSolverReport + (SolverReportWithCtxt ctxt MultiplicityCoercionsNotSupported) + ErrorWithoutFlag + {- Note [Skip type holes rapidly] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have module with a /lot/ of partial type signatures, and we @@ -1068,7 +1122,7 @@ mkUserTypeErrorReporter ctxt = mapM_ $ \item -> do { let err = important ctxt $ mkUserTypeError item ; maybeReportError ctxt (item :| []) err - ; addDeferredBinding ctxt err item } + ; addSolverDeferredBinding err item } mkUserTypeError :: ErrorItem -> TcSolverReportMsg mkUserTypeError item @@ -1081,21 +1135,41 @@ where pty = errorItemPred item +mkImplicitLiftingReporter :: Reporter +mkImplicitLiftingReporter ctxt + = mapM_ $ \item -> do { let err = mkImplicitLiftingError item + ; msg <- mkErrorReport (ctLocEnv (errorItemCtLoc item)) err (Just ctxt) [] [] + ; reportDiagnostic msg + ; addDeferredBinding ctxt [] [] err item + } + + where + mkImplicitLiftingError :: ErrorItem -> TcRnMessage + mkImplicitLiftingError item = + case errorItemOrigin item of + ImplicitLiftOrigin (HsImplicitLiftSplice bound used gre name) -> + TcRnBadlyLevelled (LevelCheckSplice (getName name) gre) bound used (Just item) (cec_defer_type_errors ctxt) + _ -> pprPanic "mkImplicitLiftingError" (ppr item) + mkGivenErrorReporter :: Reporter -- See Note [Given errors] mkGivenErrorReporter ctxt (item:|_) = do { (ctxt, relevant_binds, item) <- relevantBindings True ctxt item - ; let (implic:_) = cec_encl ctxt - -- Always non-empty when mkGivenErrorReporter is called + ; let implic = + case cec_encl ctxt of + -- cec_encl is always non-empty when mkGivenErrorReporter is called + outer_implic:_ -> outer_implic + _ -> pprPanic "mkGivenErrorReporter" (ppr item) + loc' = setCtLocEnv (ei_loc item) (ic_env implic) item' = item { ei_loc = loc' } -- For given constraints we overwrite the env (and hence src-loc) -- with one from the immediately-enclosing implication. -- See Note [Inaccessible code] + ; eq_err_msg <- mkEqErr_help ctxt item' ty1 ty2 - ; let supplementary = [ SupplementaryBindings relevant_binds ] - msg = TcRnInaccessibleCode implic (SolverReportWithCtxt ctxt eq_err_msg) - ; msg <- mkErrorReport (ctLocEnv loc') msg (Just ctxt) supplementary + ; let msg = TcRnInaccessibleCode implic (SolverReportWithCtxt ctxt eq_err_msg) + ; msg <- mkErrorReport (ctLocEnv loc') msg (Just ctxt) [SupplementaryBindings relevant_binds] [] ; reportDiagnostic msg } where (ty1, ty2) = getEqPredTys (errorItemPred item) @@ -1148,7 +1222,7 @@ -- Group together errors from same location, -- and report only the first (to avoid a cascade) mkGroupReporter mk_err ctxt items - = mapM_ (reportGroup mk_err ctxt) (equivClasses cmp_loc (toList items)) + = mapM_ (reportGroup (mk_err ctxt) ctxt) (equivClasses cmp_loc (toList items)) eq_lhs_type :: ErrorItem -> ErrorItem -> Bool eq_lhs_type item1 item2 @@ -1164,9 +1238,9 @@ -- Reduce duplication by reporting only one error from each -- /starting/ location even if the end location differs -reportGroup :: (SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport) -> Reporter +reportGroup :: (NonEmpty ErrorItem -> TcM SolverReport) -> Reporter reportGroup mk_err ctxt items - = do { err <- mk_err ctxt items + = do { err <- mk_err items ; traceTc "About to maybeReportErr" $ vcat [ text "Constraint:" <+> ppr items , text "cec_suppress =" <+> ppr (cec_suppress ctxt) @@ -1174,7 +1248,7 @@ ; maybeReportError ctxt items err -- But see Note [Always warn with -fdefer-type-errors] ; traceTc "reportGroup" (ppr items) - ; mapM_ (addDeferredBinding ctxt err) items } + ; mapM_ (addSolverDeferredBinding err) items } -- Add deferred bindings for all -- Redundant if we are going to abort compilation, -- but that's hard to know for sure, and if we don't @@ -1192,7 +1266,8 @@ -> NonEmpty ErrorItem -- items covered by the Report -> SolverReport -> TcM () maybeReportError ctxt items@(item1:|_) (SolverReport { sr_important_msg = important - , sr_supplementary = supp }) + , sr_supplementary = supp + , sr_hints = hints }) = unless (cec_suppress ctxt -- Some worse error has occurred, so suppress this diagnostic || all ei_suppress items) $ -- if they're all to be suppressed, report nothing @@ -1203,16 +1278,26 @@ | otherwise = cec_defer_type_errors ctxt -- See Note [No deferring for multiplicity errors] diag = TcRnSolverReport important reason - msg <- mkErrorReport (ctLocEnv (errorItemCtLoc item1)) diag (Just ctxt) supp + msg <- mkErrorReport (ctLocEnv (errorItemCtLoc item1)) diag (Just ctxt) supp hints reportDiagnostic msg -addDeferredBinding :: SolverReportErrCtxt -> SolverReport -> ErrorItem -> TcM () +addSolverDeferredBinding :: SolverReport -> ErrorItem -> TcM () +addSolverDeferredBinding err item = + let ctxt = reportContext . sr_important_msg $ err + supp = sr_supplementary err + hints = sr_hints err + important = sr_important_msg err + in addDeferredBinding ctxt supp hints (TcRnSolverReport important ErrorWithoutFlag) item + + +addDeferredBinding :: SolverReportErrCtxt -> [SupplementaryInfo] -> [GhcHint] -> TcRnMessage -> ErrorItem -> TcM () -- See Note [Deferring coercion errors to runtime] -addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty - , ei_loc = loc }) - -- if evdest is Just, then the constraint was from a wanted +addDeferredBinding ctxt supp hints msg (EI { ei_evdest = Just dest + , ei_pred = item_ty + , ei_loc = loc }) + -- if evdest is Just, then the constraint was from a wanted | deferringAnyBindings ctxt - = do { err_tm <- mkErrorTerm ctxt loc item_ty err + = do { err_tm <- mkErrorTerm loc item_ty ctxt msg supp hints ; let ev_binds_var = cec_binds ctxt ; case dest of @@ -1223,14 +1308,26 @@ let co_var = coHoleCoVar hole ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var EvNonCanonical err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } -addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given +addDeferredBinding _ _ _ _ _ = return () -- Do not set any evidence for Given -mkErrorTerm :: SolverReportErrCtxt -> CtLoc -> Type -- of the error term - -> SolverReport -> TcM EvTerm -mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msg = important, sr_supplementary = supp }) +mkSolverErrorTerm :: CtLoc -> Type -- of the error term + -> SolverReport -> TcM EvTerm +mkSolverErrorTerm ct_loc ty err + = mkErrorTerm ct_loc ty (reportContext . sr_important_msg $ err) + (TcRnSolverReport (sr_important_msg err) ErrorWithoutFlag) + (sr_supplementary err) + (sr_hints err) + +mkErrorTerm :: CtLoc -> Type -- of the error term + -> SolverReportErrCtxt -> TcRnMessage + -> [SupplementaryInfo] -> [GhcHint] -> TcM EvTerm +mkErrorTerm ct_loc ty ctxt msg supp hints = do { msg <- mkErrorReport (ctLocEnv ct_loc) - (TcRnSolverReport important ErrorWithoutFlag) (Just ctxt) supp + msg + (Just $ ctxt) + supp + hints -- This will be reported at runtime, so we always want "error:" in the report, never "warning:" ; dflags <- getDynFlags ; let err_msg = pprLocMsgEnvelope (initTcMessageOpts dflags) msg @@ -1286,74 +1383,22 @@ -- ^ The context to add, after the main diagnostic -- but before the supplementary information. -- Nothing <=> don't add any context. - -> [SolverReportSupplementary] + -> [SupplementaryInfo] -- ^ Supplementary information, to be added at the end of the message. + -> [GhcHint] + -- ^ Suggested fixes -> TcM (MsgEnvelope TcRnMessage) -mkErrorReport tcl_env msg mb_ctxt supplementary - = do { mb_context <- traverse (\ ctxt -> mkErrInfo (cec_tidy ctxt) (ctl_ctxt tcl_env)) mb_ctxt +mkErrorReport tcl_env msg mb_ctxt supp hints + = do { mb_context <- traverse (\ ctxt -> mkErrCtxt (cec_tidy ctxt) (ctl_ctxt tcl_env)) mb_ctxt ; unit_state <- hsc_units <$> getTopEnv ; hfdc <- getHoleFitDispConfig ; let - err_info = - ErrInfo - (fromMaybe empty mb_context) - (vcat $ map (pprSolverReportSupplementary hfdc) supplementary) - ; let detailed_msg = mkDetailedMessage err_info msg + err_info = ErrInfo (fromMaybe [] mb_context) (Just (hfdc, supp)) hints + detailed_msg = mkDetailedMessage err_info msg ; mkTcRnMessage (RealSrcSpan (ctl_loc tcl_env) Strict.Nothing) (TcRnMessageWithInfo unit_state $ detailed_msg) } - - --- | Pretty-print supplementary information, to add to an error report. -pprSolverReportSupplementary :: HoleFitDispConfig -> SolverReportSupplementary -> SDoc --- This function should be in "GHC.Tc.Errors.Ppr", --- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. -pprSolverReportSupplementary hfdc = \case - SupplementaryBindings binds -> pprRelevantBindings binds - SupplementaryHoleFits fits -> pprValidHoleFits hfdc fits - SupplementaryCts cts -> pprConstraintsInclude cts - --- | Display a collection of valid hole fits. -pprValidHoleFits :: HoleFitDispConfig -> ValidHoleFits -> SDoc --- This function should be in "GHC.Tc.Errors.Ppr", --- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. -pprValidHoleFits hfdc (ValidHoleFits (Fits fits discarded_fits) (Fits refs discarded_refs)) - = fits_msg $$ refs_msg - - where - fits_msg, refs_msg, fits_discard_msg, refs_discard_msg :: SDoc - fits_msg = ppUnless (null fits) $ - hang (text "Valid hole fits include") 2 $ - vcat (map (pprHoleFit hfdc) fits) - $$ ppWhen discarded_fits fits_discard_msg - refs_msg = ppUnless (null refs) $ - hang (text "Valid refinement hole fits include") 2 $ - vcat (map (pprHoleFit hfdc) refs) - $$ ppWhen discarded_refs refs_discard_msg - fits_discard_msg = - text "(Some hole fits suppressed;" <+> - text "use -fmax-valid-hole-fits=N" <+> - text "or -fno-max-valid-hole-fits)" - refs_discard_msg = - text "(Some refinement hole fits suppressed;" <+> - text "use -fmax-refinement-hole-fits=N" <+> - text "or -fno-max-refinement-hole-fits)" - --- | Add a "Constraints include..." message. --- --- See Note [Constraints include ...] -pprConstraintsInclude :: [(PredType, RealSrcSpan)] -> SDoc --- This function should be in "GHC.Tc.Errors.Ppr", --- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. -pprConstraintsInclude cts - = ppUnless (null cts) $ - hang (text "Constraints include") - 2 (vcat $ map pprConstraint cts) - where - pprConstraint (constraint, loc) = - ppr constraint <+> nest 2 (parens (text "from" <+> ppr loc)) - {- Note [Always warn with -fdefer-type-errors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When -fdefer-type-errors is on we warn about *all* type errors, even @@ -1370,22 +1415,22 @@ Note [No deferring for multiplicity errors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As explained in Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify, +As explained in Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify, linear types do not support casts and any nontrivial coercion will raise -an error during desugaring. +an error at the end of typechecking (a delayed error). This means that even if we defer a multiplicity mismatch during typechecking, -the desugarer will refuse to compile anyway. Worse: the error raised -by the desugarer would shadow the type mismatch warnings (#20083). -As a solution, we refuse to defer submultiplicity constraints. Test: T20083. +the desugarer will refuse to compile anyway. Worse: the delayed error would +shadow the type mismatch warnings (#20083). As a solution, we refuse to defer +submultiplicity constraints. Test: T20083. To determine whether a constraint arose from a submultiplicity check, we look at the CtOrigin. All calls to tcSubMult use origins which are not used outside of linear types. -In the future, we should compile 'WpMultCoercion' to a runtime error with --fdefer-type-errors, but the current implementation does not always -place the wrapper in the right place and the resulting program can fail Lint. +In the future, we should compile unsolved multiplicity constraints to a runtime error with +-fdefer-type-errors, but there's currently no good way to insert this type error +in the desugared program. Especially in a way that would pass the linter. This plan is tracked in #20083. Note [Deferred errors for coercion holes] @@ -1450,23 +1495,28 @@ ---------------- -- | Constructs a new hole error, unless this is deferred. See Note [Constructing Hole Errors]. mkHoleError :: NameEnv Type -> [ErrorItem] -> SolverReportErrCtxt -> Hole -> TcM (MsgEnvelope TcRnMessage) -mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc }) +mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_sort = sort, hole_occ = occ, hole_loc = ct_loc }) | isOutOfScopeHole hole = do { (imp_errs, hints) - <- unknownNameSuggestions (ctl_rdr lcl_env) WL_Anything occ + <- unknownNameSuggestions (ctl_rdr lcl_env) what_look occ ; let err = SolverReportWithCtxt ctxt - $ ReportHoleError hole - $ OutOfScopeHole imp_errs hints - report = SolverReport err [] + $ ReportHoleError hole OutOfScopeHole + supp = [ SupplementaryImportErrors imps | imps <- maybeToList (NE.nonEmpty imp_errs) ] - ; maybeAddDeferredBindings ctxt hole report - ; mkErrorReport lcl_env (TcRnSolverReport err (cec_out_of_scope_holes ctxt)) - Nothing [] - -- Pass the value 'Nothing' for the context, as it's generally not helpful - -- to include the context here. + ; maybeAddDeferredBindings hole $ SolverReport err supp hints + ; mkErrorReport lcl_env + ( TcRnSolverReport err (cec_out_of_scope_holes ctxt) + ) + Nothing supp hints + -- Pass the value 'Nothing' for the context, as it's generally not helpful + -- to include the context here. } where + what_look = case sort of + ExprHole {} -> WL_Term + TypeHole {} -> WL_Type + ConstraintHole {} -> WL_Type lcl_env = ctLocEnv ct_loc -- general case: not an out-of-scope error @@ -1495,13 +1545,13 @@ err = SolverReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort other_tvs grouped_skvs - supp = [ SupplementaryBindings rel_binds - , SupplementaryCts relevant_cts - , SupplementaryHoleFits hole_fits ] - - ; maybeAddDeferredBindings ctxt hole (SolverReport err supp) + supp = [ SupplementaryBindings rel_binds ] + ++ [ SupplementaryCts cts | cts <- maybeToList (NE.nonEmpty relevant_cts) ] + ++ [ SupplementaryHoleFits hole_fits ] - ; mkErrorReport lcl_env (TcRnSolverReport err reason) (Just ctxt) supp + ; maybeAddDeferredBindings hole (SolverReport err supp noHints) + ; let msg = TcRnSolverReport err reason + ; mkErrorReport lcl_env msg (Just ctxt) supp noHints } where @@ -1539,22 +1589,23 @@ -- | Adds deferred bindings (as errors). -- See Note [Adding deferred bindings]. -maybeAddDeferredBindings :: SolverReportErrCtxt - -> Hole +maybeAddDeferredBindings :: Hole -> SolverReport -> TcM () -maybeAddDeferredBindings ctxt hole report = do +maybeAddDeferredBindings hole report = do case hole_sort hole of ExprHole (HER ref ref_ty _) -> do -- Only add bindings for holes in expressions -- not for holes in partial type signatures -- cf. addDeferredBinding when (deferringAnyBindings ctxt) $ do - err_tm <- mkErrorTerm ctxt (hole_loc hole) ref_ty report + err_tm <- mkSolverErrorTerm (hole_loc hole) ref_ty report -- NB: ref_ty, not hole_ty. hole_ty might be rewritten. - -- See Note [Holes] in GHC.Tc.Types.Constraint + -- See Note [Holes in expressions] in GHC.Hs.Expr writeMutVar ref err_tm _ -> pure () + where + ctxt = reportContext $ sr_important_msg $ report -- We unwrap the SolverReportErrCtxt here, to avoid introducing a loop in module -- imports @@ -1575,10 +1626,11 @@ mk_wanted :: ErrorItem -> Maybe CtEvidence mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) | Just dest <- m_dest - = Just (CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet }) + = Just $ CtWanted $ + WantedCt { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet } | otherwise = Nothing -- The ErrorItem was a Given @@ -1616,7 +1668,7 @@ -- Zonk/tidy to show useful variable names. nubOrdBy (nonDetCmpType `on` (frr_type . frr_info_origin)) $ -- Remove duplicates: only one representation-polymorphism error per type. - map (expectJust "mkFRRErr" . fixedRuntimeRepOrigin_maybe) $ + map (expectJust . fixedRuntimeRepOrigin_maybe) $ toList items ; return $ important ctxt $ FixedRuntimeRepError frr_infos } @@ -1624,21 +1676,25 @@ fixedRuntimeRepOrigin_maybe :: HasDebugCallStack => ErrorItem -> Maybe FixedRuntimeRepErrorInfo fixedRuntimeRepOrigin_maybe item -- An error that arose directly from a representation-polymorphism check. - | FRROrigin frr_orig <- errorItemOrigin item + | FRROrigin frr_orig <- orig = Just $ FRR_Info { frr_info_origin = frr_orig - , frr_info_not_concrete = Nothing } + , frr_info_not_concrete = Nothing + , frr_info_other_origin = Nothing + } -- A nominal equality involving a concrete type variable, -- such as @alpha[conc] ~# rr[sk]@ or @beta[conc] ~# RR@ for a -- type family application @RR@. | EqPred NomEq ty1 ty2 <- classifyPredType (errorItemPred item) = if | Just (tv1, ConcreteFRR frr1) <- isConcreteTyVarTy_maybe ty1 - -> Just $ FRR_Info frr1 (Just (tv1, ty2)) + -> Just $ FRR_Info frr1 (Just (tv1, ty2)) (Just orig) | Just (tv2, ConcreteFRR frr2) <- isConcreteTyVarTy_maybe ty2 - -> Just $ FRR_Info frr2 (Just (tv2, ty1)) + -> Just $ FRR_Info frr2 (Just (tv2, ty1)) (Just orig) | otherwise -> Nothing | otherwise = Nothing + where + orig = errorItemOrigin item {- Note [Constraints include ...] @@ -1762,12 +1818,12 @@ -> ErrorItem -> TcType -> TcType -> TcM TcSolverReportMsg mkEqErr_help ctxt item ty1 ty2 - | Just casted_tv1 <- getCastedTyVar_maybe ty1 - = mkTyVarEqErr ctxt item casted_tv1 ty2 + | Just (tv1, _co) <- getCastedTyVar_maybe ty1 + = mkTyVarEqErr ctxt item tv1 ty2 -- ToDo: explain.. Cf T2627b Dual (Dual a) ~ a - | Just casted_tv2 <- getCastedTyVar_maybe ty2 - = mkTyVarEqErr ctxt item casted_tv2 ty1 + | Just (tv2, _co) <- getCastedTyVar_maybe ty2 + = mkTyVarEqErr ctxt item tv2 ty1 | otherwise = reportEqErr ctxt item ty1 ty2 @@ -1800,15 +1856,15 @@ return $ mkCoercibleExplanation rdr_env fam_envs ty1 ty2 mkTyVarEqErr :: SolverReportErrCtxt -> ErrorItem - -> (TcTyVar, TcCoercionN) -> TcType -> TcM TcSolverReportMsg + -> TcTyVar -> TcType -> TcM TcSolverReportMsg -- tv1 and ty2 are already tidied -mkTyVarEqErr ctxt item casted_tv1 ty2 - = do { traceTc "mkTyVarEqErr" (ppr item $$ ppr casted_tv1 $$ ppr ty2) - ; mkTyVarEqErr' ctxt item casted_tv1 ty2 } +mkTyVarEqErr ctxt item tv1 ty2 + = do { traceTc "mkTyVarEqErr" (ppr item $$ ppr tv1 $$ ppr ty2) + ; mkTyVarEqErr' ctxt item tv1 ty2 } mkTyVarEqErr' :: SolverReportErrCtxt -> ErrorItem - -> (TcTyVar, TcCoercionN) -> TcType -> TcM TcSolverReportMsg -mkTyVarEqErr' ctxt item (tv1, co1) ty2 + -> TcTyVar -> TcType -> TcM TcSolverReportMsg +mkTyVarEqErr' ctxt item tv1 ty2 -- Is this a representation-polymorphism error, e.g. -- alpha[conc] ~# rr[sk] ? If so, handle that first. @@ -1838,12 +1894,6 @@ -- to be helpful since this is just an unimplemented feature. return main_msg - -- Incompatible kinds - -- This is wrinkle (EIK2) in Note [Equalities with incompatible kinds] - -- in GHC.Tc.Solver.Equality - | hasCoercionHoleCo co1 || hasCoercionHoleTy ty2 - = return $ mkBlockedEqErr item - | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Equality.canEqTyVarHomo || isTyVarTyVar tv1 && not (isTyVarTy ty2) @@ -1919,8 +1969,10 @@ -- See Note [Error messages for untouchables] | (implic:_) <- cec_encl ctxt -- Get the innermost context , Implic { ic_tclvl = lvl } <- implic - = assertPpr (not (isTouchableMetaTyVar lvl tv1)) + = assertPpr (not (isTouchableMetaTyVar lvl tv1) || hasCoercionHole ty2) (ppr tv1 $$ ppr lvl) $ do -- See Note [Error messages for untouchables] + -- We can still get touchable meta-tyvars on the LHS if there is an + -- unsolved coercion hole, e.g. (alpha::Type) ~ Int# |> co_hole tv_extra <- extraTyVarEqInfo (tv1, Just implic) ty2 let tv_extra' = tv_extra { thisTyVarIsUntouchable = Just implic } msg = Mismatch @@ -1956,7 +2008,8 @@ = Nothing frr_reason (ConcreteFRR frr_orig) conc_tv not_conc = FRR_Info { frr_info_origin = frr_orig - , frr_info_not_concrete = Just (conc_tv, not_conc) } + , frr_info_not_concrete = Just (conc_tv, not_conc) + , frr_info_other_origin = Just (errorItemOrigin item) } ty1 = mkTyVarTy tv1 @@ -2027,14 +2080,6 @@ -- Keep only UserGivens that have some equalities. -- See Note [Suppress redundant givens during error reporting] --- These are for the "blocked" equalities, as described in GHC.Tc.Solver.Equality --- Note [Equalities with incompatible kinds], wrinkle (EIK2). There should --- always be another unsolved wanted around, which will ordinarily suppress --- this message. But this can still be printed out with -fdefer-type-errors --- (sigh), so we must produce a message. -mkBlockedEqErr :: ErrorItem -> TcSolverReportMsg -mkBlockedEqErr item = BlockedEquality item - {- Note [Suppress redundant givens during error reporting] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2209,6 +2254,15 @@ ************************************************************************ -} +mkQCErr :: HasDebugCallStack => SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport +mkQCErr ctxt items + | item1 :| _ <- tryFilter (not . ei_suppress) items + -- Ignore multiple qc-errors on the same line + = do { let msg = mkPlainMismatchMsg $ + CouldNotDeduce (getUserGivens ctxt) (item1 :| []) Nothing + ; return $ important ctxt msg } + + mkDictErr :: HasDebugCallStack => SolverReportErrCtxt -> NonEmpty ErrorItem -> TcM SolverReport mkDictErr ctxt orig_items = do { inst_envs <- tcGetInstEnvs @@ -2221,8 +2275,16 @@ -- But we report only one of them (hence 'head') because they all -- have the same source-location origin, to try avoid a cascade -- of error from one location - ; err <- mk_dict_err ctxt (head (no_inst_items ++ overlap_items)) - ; return $ important ctxt err } + ; ( err, (imp_errs, hints) ) <- + mk_dict_err ctxt (head (no_inst_items ++ overlap_items)) + ; return $ + SolverReport + { sr_important_msg = SolverReportWithCtxt ctxt err + , sr_supplementary = [ SupplementaryImportErrors imps + | imps <- maybeToList (NE.nonEmpty imp_errs) ] + , sr_hints = hints + } + } where items = tryFilter (not . ei_suppress) orig_items @@ -2256,25 +2318,31 @@ -- matching and unifying instances, and say "The choice depends on the instantion of ..., -- and the result of evaluating ...". mk_dict_err :: HasCallStack => SolverReportErrCtxt -> (ErrorItem, ClsInstLookupResult) - -> TcM TcSolverReportMsg -mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEmpty matches, NE.nonEmpty unsafe_overlapped) of + -> TcM ( TcSolverReportMsg, ([ImportError], [GhcHint]) ) +mk_dict_err ctxt (item, (matches, pot_unifiers, unsafe_overlapped)) + = case (NE.nonEmpty matches, NE.nonEmpty unsafe_overlapped) of (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances ; (imp_errs, field_suggestions) <- record_field_suggestions item - ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } + ; return (CannotResolveInstance item unifiers candidate_insts rel_binds, (imp_errs, field_suggestions)) } -- Some matches => overlap errors (Just matchesNE, Nothing) -> return $ - OverlappingInstances item (NE.map fst matchesNE) (getCoherentUnifiers unifiers) + ( OverlappingInstances item (NE.map fst matchesNE) unifiers, ([], [])) (Just (match :| []), Just unsafe_overlappedNE) -> return $ - UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE) - (Just matches@(_ :| _), Just overlaps) -> pprPanic "mk_dict_err: multiple matches with overlap" $ vcat [ text "matches:" <+> ppr matches, text "overlaps:" <+> ppr overlaps ] + ( UnsafeOverlap item (fst match) (NE.map fst unsafe_overlappedNE), ([], [])) + (Just matches@(_ :| _), Just overlaps) -> + pprPanic "mk_dict_err: multiple matches with overlap" $ + vcat [ text "matches:" <+> ppr matches + , text "overlaps:" <+> ppr overlaps + ] where - orig = errorItemOrigin item - pred = errorItemPred item - (clas, tys) = getClassPredTys pred + orig = errorItemOrigin item + pred = errorItemPred item + (clas, tys) = getClassPredTys pred + unifiers = getCoherentUnifiers pot_unifiers get_candidate_instances :: TcM [ClsInst] -- See Note [Report candidate instances] @@ -2315,7 +2383,7 @@ report_no_fieldnames item | Just (EvVarDest evvar) <- ei_evdest item -- we can assume that here we have a `HasField @Symbol x r a` instance - -- because of HasFieldOrigin in record_field + -- because of GetFieldOrigin in record_field , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) , Just (r_tycon, _) <- tcSplitTyConApp_maybe r , Just x_name <- isStrLitTy x @@ -2330,13 +2398,8 @@ isNothing (lookupLocalRdrOcc lcl_env occ_name) record_field = case orig of - HasFieldOrigin name -> Just (mkVarOccFS name) + GetFieldOrigin name -> Just (mkVarOccFS name) _ -> Nothing - - cannot_resolve_msg :: ErrorItem -> [ClsInst] -> RelevantBindings - -> [ImportError] -> [GhcHint] -> TcSolverReportMsg - cannot_resolve_msg item candidate_insts binds imp_errs field_suggestions - = CannotResolveInstance item (getCoherentUnifiers unifiers) candidate_insts imp_errs field_suggestions binds {- Note [Report candidate instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/Tc/Errors/Hole.hs b/GHC/Tc/Errors/Hole.hs --- a/GHC/Tc/Errors/Hole.hs +++ b/GHC/Tc/Errors/Hole.hs @@ -11,7 +11,6 @@ , isFlexiTyVar , tcFilterHoleFits , getLocalBindings - , pprHoleFit , addHoleFitDocs , getHoleFitSortingAlg , getHoleFitDispConfig @@ -42,14 +41,15 @@ import GHC.Tc.Types.CtLoc import GHC.Tc.Utils.TcType import GHC.Tc.Zonk.TcType -import GHC.Core.Type import GHC.Core.TyCon( TyCon, isGenerativeTyCon ) import GHC.Core.TyCo.Rep( Type(..) ) import GHC.Core.DataCon import GHC.Core.Predicate( Pred(..), classifyPredType, eqRelRole ) +import GHC.Types.Basic import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Builtin.Names ( gHC_INTERNAL_ERR, gHC_INTERNAL_UNSAFE_COERCE ) +import GHC.Builtin.Types ( tupleDataConName, unboxedSumDataConName ) import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Var.Env @@ -57,7 +57,6 @@ import GHC.Data.Bag import GHC.Core.ConLike ( ConLike(..) ) import GHC.Utils.Misc -import GHC.Utils.Panic import GHC.Tc.Utils.Env (tcLookup) import GHC.Utils.Outputable import GHC.Driver.DynFlags @@ -89,7 +88,11 @@ import GHC.Data.FastString (NonDetFastString(..)) import GHC.Types.Unique.Map +import GHC.Data.EnumSet (EnumSet) +import qualified GHC.Data.EnumSet as EnumSet +import qualified GHC.LanguageExtensions as LangExt + {- Note [Valid hole fits include ...] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -471,17 +474,17 @@ else return fits } where msg = text "GHC.Tc.Errors.Hole addHoleFitDocs" - upd mb_local_docs mods_without_docs fit@(HoleFit {hfCand = cand}) = + upd mb_local_docs mods_without_docs (TcHoleFit fit@(HoleFit {hfCand = cand})) = let name = getName cand in do { mb_docs <- if hfIsLcl fit then pure mb_local_docs else mi_docs <$> loadInterfaceForName msg name ; case mb_docs of - { Nothing -> return (Set.insert (nameOrigin name) mods_without_docs, fit) + { Nothing -> return (Set.insert (nameOrigin name) mods_without_docs, TcHoleFit fit) ; Just docs -> do { let doc = lookupUniqMap (docs_decls docs) name - ; return $ (mods_without_docs, fit {hfDoc = map hsDocString <$> doc}) }}} - upd _ mods_without_docs fit = pure (mods_without_docs, fit) + ; return $ (mods_without_docs, TcHoleFit (fit {hfDoc = map hsDocString <$> doc})) }}} + upd _ mods_without_docs fit@(RawHoleFit {}) = pure (mods_without_docs, fit) nameOrigin name = case nameModule_maybe name of Just m -> Right m Nothing -> @@ -498,63 +501,6 @@ ; warnPprTrace (not $ Set.null mods) "addHoleFitDocs" warning (pure ()) } --- For pretty printing hole fits, we display the name and type of the fit, --- with added '_' to represent any extra arguments in case of a non-zero --- refinement level. -pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc -pprHoleFit _ (RawHoleFit sd) = sd -pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (HoleFit {..}) = - hang display 2 provenance - where tyApp = sep $ zipWithEqual "pprHoleFit" pprArg vars hfWrap - where pprArg b arg = case binderFlag b of - Specified -> text "@" <> pprParendType arg - -- Do not print type application for inferred - -- variables (#16456) - Inferred -> empty - Required -> pprPanic "pprHoleFit: bad Required" - (ppr b <+> ppr arg) - tyAppVars = sep $ punctuate comma $ - zipWithEqual "pprHoleFit" (\v t -> ppr (binderVar v) <+> - text "~" <+> pprParendType t) - vars hfWrap - - vars = unwrapTypeVars hfType - where - -- Attempts to get all the quantified type variables in a type, - -- e.g. - -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a) - -- into [m, a] - unwrapTypeVars :: Type -> [ForAllTyBinder] - unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of - Just (_, _, _, unfunned) -> unwrapTypeVars unfunned - _ -> [] - where (vars, unforalled) = splitForAllForAllTyBinders t - holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches - holeDisp = if sMs then holeVs - else sep $ replicate (length hfMatches) $ text "_" - occDisp = case hfCand of - GreHFCand gre -> pprPrefixOcc (greName gre) - NameHFCand name -> pprPrefixOcc name - IdHFCand id_ -> pprPrefixOcc id_ - tyDisp = ppWhen sTy $ dcolon <+> ppr hfType - has = not . null - wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars)) - $ text "with" <+> if sWrp || not sTy - then occDisp <+> tyApp - else tyAppVars - docs = case hfDoc of - Just d -> pprHsDocStrings d - _ -> empty - funcInfo = ppWhen (has hfMatches && sTy) $ - text "where" <+> occDisp <+> tyDisp - subDisp = occDisp <+> if has hfMatches then holeDisp else tyDisp - display = subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp) - provenance = ppWhen sProv $ parens $ - case hfCand of - GreHFCand gre -> pprNameProvenance gre - NameHFCand name -> text "bound at" <+> ppr (getSrcLoc name) - IdHFCand id_ -> text "bound at" <+> ppr (getSrcLoc id_) - getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id] getLocalBindings tidy_orig ct_loc = do { (env1, _) <- liftZonkM $ zonkTidyOrigin tidy_orig (ctLocOrigin ct_loc) @@ -590,6 +536,7 @@ ; maxVSubs <- maxValidHoleFits <$> getDynFlags ; sortingAlg <- getHoleFitSortingAlg ; dflags <- getDynFlags + ; let exts = extensionFlags dflags ; hfPlugs <- tcg_hf_plugins <$> getGblEnv ; let findVLimit = if sortingAlg > HFSNoSorting then Nothing else maxVSubs refLevel = refLevelHoleFits dflags @@ -611,7 +558,7 @@ locals = removeBindingShadowing $ map IdHFCand lclBinds ++ map GreHFCand lcl globals = map GreHFCand gbl - syntax = map NameHFCand builtIns + syntax = map NameHFCand (builtIns exts) -- If the hole is a rigid type-variable, then we only check the -- locals, since only they can match the type (in a meaningful way). only_locals = any isImmutableTyVar $ getTyVar_maybe hole_ty @@ -623,7 +570,9 @@ tcFilterHoleFits findVLimit hole (hole_ty, []) cands ; (tidy_env, tidy_subs) <- liftZonkM $ zonkSubs tidy_env subs ; tidy_sorted_subs <- sortFits sortingAlg tidy_subs - ; plugin_handled_subs <- foldM (flip ($)) tidy_sorted_subs fitPlugins + ; let apply_plugin :: [HoleFit] -> ([HoleFit] -> TcM [HoleFit]) -> TcM [HoleFit] + apply_plugin fits plug = plug fits + ; plugin_handled_subs <- foldM apply_plugin (map TcHoleFit tidy_sorted_subs) fitPlugins ; let (pVDisc, limited_subs) = possiblyDiscard maxVSubs plugin_handled_subs vDiscards = pVDisc || searchDiscards ; subs_with_docs <- addHoleFitDocs limited_subs @@ -642,19 +591,21 @@ ; traceTc "ref_tys are" $ ppr ref_tys ; let findRLimit = if sortingAlg > HFSNoSorting then Nothing else maxRSubs - ; refDs <- mapM (flip (tcFilterHoleFits findRLimit hole) - cands) ref_tys - ; (tidy_env, tidy_rsubs) <- liftZonkM $ zonkSubs tidy_env $ concatMap snd refDs - ; tidy_sorted_rsubs <- sortFits sortingAlg tidy_rsubs + ; refDs :: [(Bool, [TcHoleFit])] + <- mapM (flip (tcFilterHoleFits findRLimit hole) cands) ref_tys + ; (tidy_env, tidy_rsubs :: [TcHoleFit]) + <- liftZonkM $ zonkSubs tidy_env $ concatMap snd refDs + ; tidy_sorted_rsubs :: [TcHoleFit] <- sortFits sortingAlg tidy_rsubs -- For refinement substitutions we want matches -- like id (_ :: t), head (_ :: [t]), asTypeOf (_ :: t), -- and others in that vein to appear last, since these are -- unlikely to be the most relevant fits. ; (tidy_env, tidy_hole_ty) <- liftZonkM $ zonkTidyTcType tidy_env hole_ty ; let hasExactApp = any (tcEqType tidy_hole_ty) . hfWrap + exact, not_exact :: [TcHoleFit] (exact, not_exact) = partition hasExactApp tidy_sorted_rsubs - ; plugin_handled_rsubs <- foldM (flip ($)) - (not_exact ++ exact) fitPlugins + fits :: [HoleFit] = map TcHoleFit (not_exact ++ exact) + ; plugin_handled_rsubs <- foldM apply_plugin fits fitPlugins ; let (pRDisc, exact_last_rfits) = possiblyDiscard maxRSubs $ plugin_handled_rsubs rDiscards = pRDisc || any fst refDs @@ -669,9 +620,29 @@ hole_lvl = ctLocLevel ct_loc -- BuiltInSyntax names like (:) and [] - builtIns :: [Name] - builtIns = filter isBuiltInSyntax knownKeyNames + builtIns :: EnumSet LangExt.Extension -> [Name] + builtIns exts = filter isBuiltInSyntax (knownKeyNames ++ infFamNames) + where + -- Tuples and sums of are not included in knownKeyName as there are infinitely many of them. + -- See Note [Infinite families of known-key names] in GHC.Builtin.Names. + infFamNames = + [tupleDataConName Boxed n | n <- [0..max_tup]] + ++ [tupleDataConName Unboxed n | unboxedTuples, n <- [0..max_tup]] + ++ [unboxedSumDataConName k n | unboxedSums, n <- [2..max_sum], k <- [1..n]] + -- The upper limits on arity are small to avoid bloating the list with + -- too many names, which would incur a performance cost. + -- Users are unlikely to care about larger tuples/sums anyway. + max_tup = 7 + -- Tuples up to (,,,,,,). Common limit, e.g. this is the highest tuple + -- arity that has a Functor instance. + max_sum = 7 + -- Sums up to (#||||||#). Results in 27 sum constructors because there + -- are [1..n] data constructors at each arity. + + unboxedTuples = EnumSet.member LangExt.UnboxedTuples exts + unboxedSums = EnumSet.member LangExt.UnboxedSums exts + -- We make a refinement type by adding a new type variable in front -- of the type of t h hole, going from e.g. [Integer] -> Integer -- to t_a1/m[tau:1] -> [Integer] -> Integer. This allows the simplifier @@ -685,8 +656,8 @@ wrapWithVars vars = mkVisFunTysMany (map mkTyVarTy vars) hole_ty sortFits :: HoleFitSortingAlg -- How we should sort the hole fits - -> [HoleFit] -- The subs to sort - -> TcM [HoleFit] + -> [TcHoleFit] -- The subs to sort + -> TcM [TcHoleFit] sortFits HFSNoSorting subs = return subs sortFits HFSBySize subs = (++) <$> sortHoleFitsBySize (sort lclFits) @@ -731,14 +702,13 @@ -- We zonk the hole fits so that the output aligns with the rest -- of the typed hole error message output. -zonkSubs :: TidyEnv -> [HoleFit] -> ZonkM (TidyEnv, [HoleFit]) +zonkSubs :: TidyEnv -> [TcHoleFit] -> ZonkM (TidyEnv, [TcHoleFit]) zonkSubs = zonkSubs' [] where zonkSubs' zs env [] = return (env, reverse zs) zonkSubs' zs env (hf:hfs) = do { (env', z) <- zonkSub env hf ; zonkSubs' (z:zs) env' hfs } - zonkSub :: TidyEnv -> HoleFit -> ZonkM (TidyEnv, HoleFit) - zonkSub env hf@RawHoleFit{} = return (env, hf) + zonkSub :: TidyEnv -> TcHoleFit -> ZonkM (TidyEnv, TcHoleFit) zonkSub env hf@HoleFit{hfType = ty, hfMatches = m, hfWrap = wrp} = do { (env, ty') <- zonkTidyTcType env ty ; (env, m') <- zonkTidyTcTypes env m @@ -750,9 +720,9 @@ -- types needed to instantiate the fit to the type of the hole. -- This is much quicker than sorting by subsumption, and gives reasonable -- results in most cases. -sortHoleFitsBySize :: [HoleFit] -> TcM [HoleFit] +sortHoleFitsBySize :: [TcHoleFit] -> TcM [TcHoleFit] sortHoleFitsBySize = return . sortOn sizeOfFit - where sizeOfFit :: HoleFit -> TypeSize + where sizeOfFit :: TcHoleFit -> TypeSize sizeOfFit = sizeTypes . nubBy tcEqType . hfWrap -- Based on a suggestion by phadej on #ghc, we can sort the found fits @@ -761,12 +731,12 @@ -- probably those most relevant. This takes a lot of work (but results in -- much more useful output), and can be disabled by -- '-fno-sort-valid-hole-fits'. -sortHoleFitsByGraph :: [HoleFit] -> TcM [HoleFit] +sortHoleFitsByGraph :: [TcHoleFit] -> TcM [TcHoleFit] sortHoleFitsByGraph fits = go [] fits where tcSubsumesWCloning :: TcType -> TcType -> TcM Bool tcSubsumesWCloning ht ty = withoutUnification fvs (tcSubsumes ht ty) where fvs = tyCoFVsOfTypes [ht,ty] - go :: [(HoleFit, [HoleFit])] -> [HoleFit] -> TcM [HoleFit] + go :: [(TcHoleFit, [TcHoleFit])] -> [TcHoleFit] -> TcM [TcHoleFit] go sofar [] = do { traceTc "subsumptionGraph was" $ ppr sofar ; return $ uncurry (++) $ partition hfIsLcl topSorted } where toV (hf, adjs) = (hf, hfId hf, map hfId adjs) @@ -788,7 +758,7 @@ -- additional holes. -> [HoleFitCandidate] -- ^ The candidates to check whether fit. - -> TcM (Bool, [HoleFit]) + -> TcM (Bool, [TcHoleFit]) -- ^ We return whether or not we stopped due to hitting the limit -- and the fits we found. tcFilterHoleFits (Just 0) _ _ _ = return (False, []) -- Stop right away on 0 @@ -803,12 +773,12 @@ -- Kickoff the checking of the elements. -- We iterate over the elements, checking each one in turn for whether -- it fits, and adding it to the results if it does. - go :: [HoleFit] -- What we've found so far. + go :: [TcHoleFit] -- What we've found so far. -> VarSet -- Ids we've already checked -> Maybe Int -- How many we're allowed to find, if limited -> (TcType, [TcTyVar]) -- The type, and its refinement variables. -> [HoleFitCandidate] -- The elements we've yet to check. - -> TcM (Bool, [HoleFit]) + -> TcM (Bool, [TcHoleFit]) go subs _ _ _ [] = return (False, reverse subs) go subs _ (Just 0) _ _ = return (True, reverse subs) go subs seen maxleft ty (el:elts) = diff --git a/GHC/Tc/Errors/Hole.hs-boot b/GHC/Tc/Errors/Hole.hs-boot --- a/GHC/Tc/Errors/Hole.hs-boot +++ b/GHC/Tc/Errors/Hole.hs-boot @@ -4,41 +4,13 @@ -- + which calls 'GHC.Tc.Solver.simpl_top' module GHC.Tc.Errors.Hole where -import GHC.Types.Var ( Id ) import GHC.Tc.Errors.Types ( HoleFitDispConfig, ValidHoleFits ) import GHC.Tc.Types ( TcM ) import GHC.Tc.Types.Constraint ( CtEvidence, Hole, Implication ) -import GHC.Tc.Types.CtLoc( CtLoc ) -import GHC.Utils.Outputable ( SDoc ) import GHC.Types.Var.Env ( TidyEnv ) -import GHC.Tc.Errors.Hole.FitTypes ( HoleFit, TypedHole, HoleFitCandidate ) -import GHC.Tc.Utils.TcType ( TcType, TcSigmaType, TcTyVar ) -import GHC.Tc.Zonk.Monad ( ZonkM ) -import GHC.Tc.Types.Evidence ( HsWrapper ) -import GHC.Utils.FV ( FV ) -import Data.Bool ( Bool ) -import Data.Maybe ( Maybe ) -import Data.Int ( Int ) findValidHoleFits :: TidyEnv -> [Implication] -> [CtEvidence] -> Hole -> TcM (TidyEnv, ValidHoleFits) -tcCheckHoleFit :: TypedHole -> TcSigmaType -> TcSigmaType - -> TcM (Bool, HsWrapper) - -withoutUnification :: FV -> TcM a -> TcM a -tcSubsumes :: TcSigmaType -> TcSigmaType -> TcM Bool -tcFilterHoleFits :: Maybe Int -> TypedHole -> (TcType, [TcTyVar]) - -> [HoleFitCandidate] -> TcM (Bool, [HoleFit]) -getLocalBindings :: TidyEnv -> CtLoc -> TcM [Id] -addHoleFitDocs :: [HoleFit] -> TcM [HoleFit] - -data HoleFitSortingAlg - -pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc -getHoleFitSortingAlg :: TcM HoleFitSortingAlg getHoleFitDispConfig :: TcM HoleFitDispConfig -zonkSubs :: TidyEnv -> [HoleFit] -> ZonkM (TidyEnv, [HoleFit]) -sortHoleFitsBySize :: [HoleFit] -> TcM [HoleFit] -sortHoleFitsByGraph :: [HoleFit] -> TcM [HoleFit] diff --git a/GHC/Tc/Errors/Hole/FitTypes.hs b/GHC/Tc/Errors/Hole/FitTypes.hs --- a/GHC/Tc/Errors/Hole/FitTypes.hs +++ b/GHC/Tc/Errors/Hole/FitTypes.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} module GHC.Tc.Errors.Hole.FitTypes ( - TypedHole (..), HoleFit (..), HoleFitCandidate (..), + TypedHole (..), HoleFit (..), TcHoleFit(..), HoleFitCandidate (..), hfIsLcl, pprHoleFitCand ) where @@ -77,7 +77,7 @@ -- element that was checked, the Id of that element as found by `tcLookup`, -- and the refinement level of the fit, which is the number of extra argument -- holes that this fit uses (e.g. if hfRefLvl is 2, the fit is for `Id _ _`). -data HoleFit = +data TcHoleFit = HoleFit { hfId :: Id -- ^ The elements id in the TcM , hfCand :: HoleFitCandidate -- ^ The candidate that was checked. , hfType :: TcType -- ^ The type of the id, possibly zonked. @@ -88,16 +88,22 @@ , hfDoc :: Maybe [HsDocString] -- ^ Documentation of this HoleFit, if available. } - | RawHoleFit SDoc - -- ^ A fit that is just displayed as is. Here so thatHoleFitPlugins + +data HoleFit + = TcHoleFit TcHoleFit + | RawHoleFit SDoc + -- ^ A fit that is just displayed as is. Here so that HoleFitPlugins -- can inject any fit they want. -- We define an Eq and Ord instance to be able to build a graph. -instance Eq HoleFit where +instance Eq TcHoleFit where (==) = (==) `on` hfId instance Outputable HoleFit where + ppr (TcHoleFit hf) = ppr hf ppr (RawHoleFit sd) = sd + +instance Outputable TcHoleFit where ppr (HoleFit _ cand ty _ _ mtchs _) = hang (name <+> holes) 2 (text "where" <+> name <+> dcolon <+> (ppr ty)) where name = ppr $ getName cand @@ -107,20 +113,18 @@ -- want our tests to be affected by the non-determinism of `nonDetCmpVar`, -- which is used to compare Ids. When comparing, we want HoleFits with a lower -- refinement level to come first. -instance Ord HoleFit where - compare (RawHoleFit _) (RawHoleFit _) = EQ - compare (RawHoleFit _) _ = LT - compare _ (RawHoleFit _) = GT +instance Ord TcHoleFit where +-- compare (RawHoleFit _) (RawHoleFit _) = EQ +-- compare (RawHoleFit _) _ = LT +-- compare _ (RawHoleFit _) = GT compare a@(HoleFit {}) b@(HoleFit {}) = cmp a b where cmp = if hfRefLvl a == hfRefLvl b then compare `on` (getName . hfCand) else compare `on` hfRefLvl -hfIsLcl :: HoleFit -> Bool +hfIsLcl :: TcHoleFit -> Bool hfIsLcl hf@(HoleFit {}) = case hfCand hf of IdHFCand _ -> True NameHFCand _ -> False GreHFCand gre -> gre_lcl gre -hfIsLcl _ = False - diff --git a/GHC/Tc/Errors/Hole/Plugin.hs b/GHC/Tc/Errors/Hole/Plugin.hs --- a/GHC/Tc/Errors/Hole/Plugin.hs +++ b/GHC/Tc/Errors/Hole/Plugin.hs diff --git a/GHC/Tc/Errors/Ppr.hs b/GHC/Tc/Errors/Ppr.hs --- a/GHC/Tc/Errors/Ppr.hs +++ b/GHC/Tc/Errors/Ppr.hs @@ -15,6988 +15,7537 @@ module GHC.Tc.Errors.Ppr ( pprTypeDoesNotHaveFixedRuntimeRep , pprScopeError - -- - , tidySkolemInfo - , tidySkolemInfoAnon - -- - , pprHsDocContext - , inHsDocContext - , TcRnMessageOpts(..) - , pprTyThingUsedWrong - , pprUntouchableVariable - - -- - , mismatchMsg_ExpectedActuals - - -- | Useful when overriding message printing. - , messageWithInfoDiagnosticMessage - , messageWithHsDocContext - ) - where - -import GHC.Prelude - -import qualified GHC.Boot.TH.Syntax as TH --- In stage1: import "ghc-boot-th-next" qualified GHC.Boot.TH.Syntax as TH --- In stage2: import "ghc-boot-th" qualified GHC.Boot.TH.Syntax as TH --- which is a rexport of --- import "ghc-internal" qualified GHC.Internal.TH.Syntax as TH -import qualified GHC.Boot.TH.Ppr as TH - -import GHC.Builtin.Names -import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, filterCTuple, pretendNameIsInScope ) - -import GHC.Types.Name.Reader -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.Warnings - -import GHC.Core.Coercion -import GHC.Core.Unify ( tcMatchTys ) -import GHC.Core.TyCon -import GHC.Core.Class -import GHC.Core.DataCon -import GHC.Core.Coercion.Axiom (CoAxBranch, coAxiomTyCon, coAxiomSingleBranch) -import GHC.Core.ConLike -import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) -import GHC.Core.InstEnv -import GHC.Core.TyCo.Rep (Type(..)) -import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon, - pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll) -import GHC.Core.PatSyn ( patSynName, pprPatSynType ) -import GHC.Core.Predicate -import GHC.Core.Type -import GHC.Core.FVs( orphNamesOfTypes ) -import GHC.CoreToIface - -import GHC.Driver.Flags -import GHC.Driver.Backend -import GHC.Hs - -import GHC.Tc.Errors.Types -import GHC.Tc.Types.BasicTypes -import GHC.Tc.Types.Constraint -import GHC.Tc.Types.Origin hiding ( Position(..) ) -import GHC.Tc.Types.CtLoc -import GHC.Tc.Types.Rank (Rank(..)) -import GHC.Tc.Types.TH -import GHC.Tc.Utils.TcType - -import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_module)) -import GHC.Types.Error -import GHC.Types.Error.Codes -import GHC.Types.Hint -import GHC.Types.Hint.Ppr () -- Outputable GhcHint -import GHC.Types.Basic -import GHC.Types.Id -import GHC.Types.Id.Info ( RecSelParent(..) ) -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Name.Set -import GHC.Types.SourceFile -import GHC.Types.SrcLoc -import GHC.Types.TyThing -import GHC.Types.TyThing.Ppr ( pprTyThingInContext ) -import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) -import GHC.Types.Var -import GHC.Types.Var.Set -import GHC.Types.Var.Env -import GHC.Types.Fixity (defaultFixity) - -import GHC.Iface.Errors.Types -import GHC.Iface.Errors.Ppr -import GHC.Iface.Syntax - -import GHC.Unit.State -import GHC.Unit.Module - -import GHC.Data.Bag -import GHC.Data.FastString -import GHC.Data.List.SetOps ( nubOrdBy ) -import GHC.Data.Maybe -import GHC.Data.Pair -import GHC.Settings.Constants (mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE) -import GHC.Utils.Misc -import GHC.Utils.Outputable -import GHC.Utils.Panic - -import qualified GHC.LanguageExtensions as LangExt - -import GHC.Data.BooleanFormula (pprBooleanFormulaNice) - -import Data.List.NonEmpty (NonEmpty(..)) -import qualified Data.List.NonEmpty as NE -import Data.Foldable ( fold ) -import Data.Function (on) -import Data.List ( groupBy, sortBy, tails - , partition, unfoldr ) -import Data.Ord ( comparing ) -import Data.Bifunctor - - -defaultTcRnMessageOpts :: TcRnMessageOpts -defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True - , tcOptsIfaceOpts = defaultDiagnosticOpts @IfaceMessage } - -instance HasDefaultDiagnosticOpts TcRnMessageOpts where - defaultOpts = defaultTcRnMessageOpts - -instance Diagnostic TcRnMessage where - type DiagnosticOpts TcRnMessage = TcRnMessageOpts - diagnosticMessage opts = \case - TcRnUnknownMessage (UnknownDiagnostic f m) - -> diagnosticMessage (f opts) m - TcRnMessageWithInfo unit_state msg_with_info - -> case msg_with_info of - TcRnMessageDetailed err_info msg - -> messageWithInfoDiagnosticMessage unit_state err_info - (tcOptsShowContext opts) - (diagnosticMessage opts msg) - TcRnWithHsDocContext ctxt msg - -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) - TcRnSolverReport msg _ - -> mkSimpleDecorated $ pprSolverReportWithCtxt msg - TcRnSolverDepthError ty depth -> mkSimpleDecorated msg - where - msg = - vcat [ text "Reduction stack overflow; size =" <+> ppr depth - , hang (text "When simplifying the following type:") - 2 (ppr ty) ] - TcRnRedundantConstraints redundants (info, show_info) - -> mkSimpleDecorated $ - text "Redundant constraint" <> plural redundants <> colon - <+> pprEvVarTheta redundants - $$ if show_info then text "In" <+> ppr info else empty - TcRnInaccessibleCode implic contra - -> mkSimpleDecorated $ - hang (text "Inaccessible code in") - 2 (ppr (ic_info implic)) - $$ pprSolverReportWithCtxt contra - TcRnInaccessibleCoAxBranch fam_tc cur_branch - -> mkSimpleDecorated $ - text "Type family instance equation is overlapped:" $$ - nest 2 (pprCoAxBranchUser fam_tc cur_branch) - TcRnTypeDoesNotHaveFixedRuntimeRep ty prov (ErrInfo extra supplementary) - -> mkDecorated [pprTypeDoesNotHaveFixedRuntimeRep ty prov, extra, supplementary] - TcRnImplicitLift id_or_name ErrInfo{..} - -> mkDecorated $ - ( text "The variable" <+> quotes (ppr id_or_name) <+> - text "is implicitly lifted in the TH quotation" - ) : [errInfoContext, errInfoSupplementary] - TcRnUnusedPatternBinds bind - -> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)] - TcRnDodgyImports (DodgyImportsEmptyParent gre) - -> mkDecorated [dodgy_msg (text "import") gre (dodgy_msg_insert gre)] - TcRnDodgyImports (DodgyImportsHiding reason) - -> mkSimpleDecorated $ - pprImportLookup reason - TcRnDodgyExports gre - -> mkDecorated [dodgy_msg (text "export") gre (dodgy_msg_insert gre)] - TcRnMissingImportList ie - -> mkDecorated [ text "The import item" <+> quotes (ppr ie) <+> - text "does not have an explicit import list" - ] - TcRnUnsafeDueToPlugin - -> mkDecorated [text "Use of plugins makes the module unsafe"] - TcRnModMissingRealSrcSpan mod - -> mkDecorated [text "Module does not have a RealSrcSpan:" <+> ppr mod] - TcRnIdNotExportedFromModuleSig name mod - -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+> - text "does not exist in the signature for" <+> ppr mod - ] - TcRnIdNotExportedFromLocalSig name - -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+> - text "does not exist in the local signature." - ] - TcRnShadowedName occ provenance - -> let shadowed_locs = case provenance of - ShadowedNameProvenanceLocal n -> [text "bound at" <+> ppr n] - ShadowedNameProvenanceGlobal gres -> map pprNameProvenance gres - in mkSimpleDecorated $ - sep [text "This binding for" <+> quotes (ppr occ) - <+> text "shadows the existing binding" <> plural shadowed_locs, - nest 2 (vcat shadowed_locs)] - TcRnInvalidWarningCategory cat - -> mkSimpleDecorated $ - vcat [text "Warning category" <+> quotes (ppr cat) <+> text "is not valid", - text "(user-defined category names must begin with" <+> quotes (text "x-"), - text "and contain only letters, numbers, apostrophes and dashes)" ] - TcRnDuplicateWarningDecls d rdr_name - -> mkSimpleDecorated $ - vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name), - text "also at " <+> ppr (getLocA d)] - TcRnSimplifierTooManyIterations simples limit wc - -> mkSimpleDecorated $ - hang (text "solveWanteds: too many iterations" - <+> parens (text "limit =" <+> ppr limit)) - 2 (vcat [ text "Unsolved:" <+> ppr wc - , text "Simples:" <+> ppr simples - ]) - TcRnIllegalPatSynDecl rdrname - -> mkSimpleDecorated $ - hang (text "Illegal pattern synonym declaration for" <+> quotes (ppr rdrname)) - 2 (text "Pattern synonym declarations are only valid at top level") - TcRnLinearPatSyn ty - -> mkSimpleDecorated $ - hang (text "Pattern synonyms do not support linear fields (GHC #18806):") 2 (ppr ty) - TcRnEmptyRecordUpdate - -> mkSimpleDecorated $ text "Empty record update" - TcRnIllegalFieldPunning fld - -> mkSimpleDecorated $ text "Illegal use of punning for field" <+> quotes (ppr fld) - TcRnIllegalWildcardsInRecord fld_part - -> mkSimpleDecorated $ text "Illegal `..' in record" <+> pprRecordFieldPart fld_part - TcRnIllegalWildcardInType mb_name bad - -> mkSimpleDecorated $ case bad of - WildcardNotLastInConstraint -> - hang notAllowed 2 constraint_hint_msg - ExtraConstraintWildcardNotAllowed allow_sole -> - case allow_sole of - SoleExtraConstraintWildcardNotAllowed -> - notAllowed - SoleExtraConstraintWildcardAllowed -> - hang notAllowed 2 sole_msg - WildcardsNotAllowedAtAll -> - notAllowed - WildcardBndrInForallTelescope -> - notAllowed - WildcardBndrInTyFamResultVar -> - notAllowed - where - notAllowed, what, wildcard, how :: SDoc - notAllowed = what <+> quotes wildcard <+> how - wildcard = case mb_name of - Nothing -> pprAnonWildCard - Just name -> ppr name - what - | Just _ <- mb_name - = text "Named wildcard" - | ExtraConstraintWildcardNotAllowed {} <- bad - = text "Extra-constraint wildcard" - | WildcardBndrInForallTelescope {} <- bad - = text "Wildcard binder" - | WildcardBndrInTyFamResultVar {} <- bad - = text "Wildcard binder" - | otherwise - = text "Wildcard" - how = case bad of - WildcardNotLastInConstraint - -> text "not allowed in a constraint" - WildcardBndrInForallTelescope - -> text "not allowed in a forall telescope" - WildcardBndrInTyFamResultVar - -> text "not allowed in a type family result" - _ -> text "not allowed" - constraint_hint_msg :: SDoc - constraint_hint_msg - | Just _ <- mb_name - = vcat [ text "Extra-constraint wildcards must be anonymous" - , nest 2 (text "e.g f :: (Eq a, _) => blah") ] - | otherwise - = vcat [ text "except as the last top-level constraint of a type signature" - , nest 2 (text "e.g f :: (Eq a, _) => blah") ] - sole_msg :: SDoc - sole_msg = - vcat [ text "except as the sole constraint" - , nest 2 (text "e.g., deriving instance _ => Eq (Foo a)") ] - TcRnIllegalNamedWildcardInTypeArgument rdr - -> mkSimpleDecorated $ - hang (text "Illegal named wildcard in a required type argument:") - 2 (quotes (ppr rdr)) - TcRnIllegalImplicitTyVarInTypeArgument rdr - -> mkSimpleDecorated $ - hang (text "Illegal implicitly quantified type variable in a required type argument:") - 2 (quotes (ppr rdr)) - TcRnDuplicateFieldName fld_part dups - -> mkSimpleDecorated $ - hsep [ text "Duplicate field name" - , quotes (ppr (rdrNameOcc $ NE.head dups)) - , text "in record", pprRecordFieldPart fld_part ] - TcRnIllegalViewPattern pat - -> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat] - TcRnCharLiteralOutOfRange c - -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\'' - TcRnIllegalWildcardsInConstructor con - -> mkSimpleDecorated $ - vcat [ text "Illegal `{..}' notation for constructor" <+> quotes (ppr con) - , nest 2 (text "Record wildcards may not be used for constructors with unlabelled fields.") - , nest 2 (text "Possible fix: Remove the `{..}' and add a match for each field of the constructor.") - ] - TcRnIgnoringAnnotations anns - -> mkSimpleDecorated $ - text "Ignoring ANN annotation" <> plural anns <> comma - <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi" - TcRnAnnotationInSafeHaskell - -> mkSimpleDecorated $ - vcat [ text "Annotations are not compatible with Safe Haskell." - , text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ] - TcRnInvalidTypeApplication fun_ty hs_ty - -> mkSimpleDecorated $ - text "Cannot apply expression of type" <+> quotes (ppr fun_ty) $$ - text "to a visible type argument" <+> quotes (ppr hs_ty) - TcRnTagToEnumMissingValArg - -> mkSimpleDecorated $ - text "tagToEnum# must appear applied to one value argument" - TcRnTagToEnumUnspecifiedResTy ty - -> mkSimpleDecorated $ - hang (text "Bad call to tagToEnum# at type" <+> ppr ty) - 2 (vcat [ text "Specify the type by giving a type signature" - , text "e.g. (tagToEnum# x) :: Bool" ]) - TcRnTagToEnumResTyNotAnEnum ty - -> mkSimpleDecorated $ - hang (text "Bad call to tagToEnum# at type" <+> ppr ty) - 2 (text "Result type must be an enumeration type") - TcRnTagToEnumResTyTypeData ty - -> mkSimpleDecorated $ - hang (text "Bad call to tagToEnum# at type" <+> ppr ty) - 2 (text "Result type cannot be headed by a `type data` type") - TcRnArrowIfThenElsePredDependsOnResultTy - -> mkSimpleDecorated $ - text "Predicate type of `ifThenElse' depends on result type" - TcRnIllegalHsBootOrSigDecl boot_or_sig decls - -> mkSimpleDecorated $ - text "Illegal" <+> what <+> text "in" <+> whr <> dot - where - what = case decls of - BootBindsPs {} -> text "binding" - BootBindsRn {} -> text "binding" - BootInstanceSigs {} -> text "instance body" - BootFamInst {} -> text "family instance" - BootSpliceDecls {} -> text "splice" - BootForeignDecls {} -> text "foreign declaration" - BootDefaultDecls {} -> text "default declaration" - BootRuleDecls {} -> text "RULE pragma" - whr = case boot_or_sig of - HsBoot -> text "an hs-boot file" - Hsig -> text "a backpack signature file" - TcRnBootMismatch boot_or_sig err -> - mkSimpleDecorated $ pprBootMismatch boot_or_sig err - TcRnRecursivePatternSynonym binds - -> mkSimpleDecorated $ - hang (text "Recursive pattern synonym definition with following bindings:") - 2 (vcat $ map pprLBind binds) - where - pprLoc loc = parens (text "defined at" <+> ppr loc) - pprLBind :: CollectPass GhcRn => GenLocated (EpAnn a) (HsBindLR GhcRn idR) -> SDoc - pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders CollNoDictBinders bind) - <+> pprLoc (locA loc) - TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty - -> mkSimpleDecorated $ - hang (text "Couldn't match" <+> quotes (ppr n1) - <+> text "with" <+> quotes (ppr n2)) - 2 (hang (text "both bound by the partial type signature:") - 2 (ppr fn_name <+> dcolon <+> ppr hs_ty)) - TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty - -> mkSimpleDecorated $ - hang (text "Can't quantify over" <+> quotes (ppr n)) - 2 (vcat [ hang (text "bound by the partial type signature:") - 2 (ppr fn_name <+> dcolon <+> ppr hs_ty) - , extra ]) - where - extra | Just rhs_ty <- m_unif_ty - = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ] - | otherwise - = empty - TcRnMissingSignature what _ -> - mkSimpleDecorated $ - case what of - MissingPatSynSig p -> - hang (text "Pattern synonym with no type signature:") - 2 (text "pattern" <+> pprPrefixName (patSynName p) <+> dcolon <+> pprPatSynType p) - MissingTopLevelBindingSig name ty -> - hang (text "Top-level binding with no type signature:") - 2 (pprPrefixName name <+> dcolon <+> pprSigmaType ty) - MissingTyConKindSig tc cusks_enabled -> - hang msg - 2 (text "type" <+> pprPrefixName (tyConName tc) <+> dcolon <+> pprKind (tyConKind tc)) - where - msg | cusks_enabled - = text "Top-level type constructor with no standalone kind signature or CUSK:" - | otherwise - = text "Top-level type constructor with no standalone kind signature:" - - TcRnPolymorphicBinderMissingSig n ty - -> mkSimpleDecorated $ - sep [ text "Polymorphic local binding with no type signature:" - , nest 2 $ pprPrefixName n <+> dcolon <+> ppr ty ] - TcRnOverloadedSig sig - -> mkSimpleDecorated $ - hang (text "Overloaded signature conflicts with monomorphism restriction") - 2 (ppr sig) - TcRnTupleConstraintInst _ - -> mkSimpleDecorated $ text "You can't specify an instance for a tuple constraint" - TcRnUserTypeError ty - -> mkSimpleDecorated (pprUserTypeErrorTy ty) - TcRnConstraintInKind ty - -> mkSimpleDecorated $ - text "Illegal constraint in a kind:" <+> pprType ty - TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum ty - -> mkSimpleDecorated $ - sep [ text "Illegal unboxed" <+> what <+> text "type as function argument:" - , pprType ty ] - where - what = case tuple_or_sum of - UnboxedTupleType -> text "tuple" - UnboxedSumType -> text "sum" - TcRnLinearFuncInKind ty - -> mkSimpleDecorated $ - text "Illegal linear function in a kind:" <+> pprType ty - TcRnForAllEscapeError ty kind - -> mkSimpleDecorated $ vcat - [ hang (text "Quantified type's kind mentions quantified type variable") - 2 (text "type:" <+> quotes (ppr ty)) - , hang (text "where the body of the forall has this kind:") - 2 (quotes (pprKind kind)) ] - TcRnSimplifiableConstraint pred what - -> mkSimpleDecorated $ vcat - [ hang (text "The constraint" <+> quotes (pprType pred) <+> text "matches") - 2 (ppr what) - , hang (text "This makes type inference for inner bindings fragile;") - 2 (text "either use MonoLocalBinds, or simplify it using the instance") ] - TcRnArityMismatch thing thing_arity nb_args - -> mkSimpleDecorated $ - hsep [ text "The" <+> what, quotes (ppr $ getName thing), text "should have" - , n_arguments <> comma, text "but has been given" - , if nb_args == 0 then text "none" else int nb_args - ] - where - what = case thing of - ATyCon tc -> ppr (tyConFlavour tc) - _ -> text (tyThingCategory thing) - n_arguments | thing_arity == 0 = text "no arguments" - | thing_arity == 1 = text "1 argument" - | True = hsep [int thing_arity, text "arguments"] - TcRnIllegalInstance reason -> - mkSimpleDecorated $ pprIllegalInstance reason - TcRnVDQInTermType mb_ty - -> mkSimpleDecorated $ - case mb_ty of - Nothing -> main_msg - Just ty -> hang (main_msg <> char ':') 2 (pprType ty) - where - main_msg = - text "Illegal visible, dependent quantification" <+> - text "in the type of a term" - TcRnBadQuantPredHead ty - -> mkSimpleDecorated $ - hang (text "Quantified predicate must have a class or type variable head:") - 2 (pprType ty) - TcRnIllegalTupleConstraint ty - -> mkSimpleDecorated $ - text "Illegal tuple constraint:" <+> pprType ty - TcRnNonTypeVarArgInConstraint ty - -> mkSimpleDecorated $ - hang (text "Non type-variable argument") - 2 (text "in the constraint:" <+> pprType ty) - TcRnIllegalImplicitParam ty - -> mkSimpleDecorated $ - text "Illegal implicit parameter" <+> quotes (pprType ty) - TcRnIllegalConstraintSynonymOfKind kind - -> mkSimpleDecorated $ - text "Illegal constraint synonym of kind:" <+> quotes (pprKind kind) - TcRnOversaturatedVisibleKindArg ty - -> mkSimpleDecorated $ - text "Illegal oversaturated visible kind argument:" <+> - quotes (char '@' <> pprParendType ty) - TcRnForAllRankErr rank ty - -> let herald = case tcSplitForAllTyVars ty of - ([], _) -> text "Illegal qualified type:" - _ -> text "Illegal polymorphic type:" - extra = case rank of - MonoTypeConstraint -> text "A constraint must be a monotype" - _ -> empty - in mkSimpleDecorated $ vcat [hang herald 2 (pprType ty), extra] - TcRnMonomorphicBindings bindings - -> let pp_bndrs = pprBindings bindings - in mkSimpleDecorated $ - sep [ text "The Monomorphism Restriction applies to the binding" - <> plural bindings - , text "for" <+> pp_bndrs ] - TcRnOrphanInstance (Left cls_inst) - -> mkSimpleDecorated $ - hang (text "Orphan class instance:") - 2 (pprInstanceHdr cls_inst) - TcRnOrphanInstance (Right fam_inst) - -> mkSimpleDecorated $ - hang (text "Orphan family instance:") - 2 (pprFamInst fam_inst) - TcRnFunDepConflict unit_state sorted - -> let herald = text "Functional dependencies conflict between instance declarations:" - in mkSimpleDecorated $ - pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted)) - TcRnDupInstanceDecls unit_state sorted - -> let herald = text "Duplicate instance declarations:" - in mkSimpleDecorated $ - pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted)) - TcRnConflictingFamInstDecls sortedNE - -> let sorted = NE.toList sortedNE - in mkSimpleDecorated $ - hang (text "Conflicting family instance declarations:") - 2 (vcat [ pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax) - | fi <- sorted - , let ax = famInstAxiom fi ]) - TcRnFamInstNotInjective rea fam_tc (eqn1 NE.:| rest_eqns) - -> let (herald, show_kinds) = case rea of - InjErrRhsBareTyVar tys -> - (injectivityErrorHerald $$ - text "RHS of injective type family equation is a bare" <+> - text "type variable" $$ - text "but these LHS type and kind patterns are not bare" <+> - text "variables:" <+> pprQuotedList tys, False) - InjErrRhsCannotBeATypeFam -> - (injectivityErrorHerald $$ - text "RHS of injective type family equation cannot" <+> - text "be a type family:", False) - InjErrRhsOverlap -> - (text "Type family equation right-hand sides overlap; this violates" $$ - text "the family's injectivity annotation:", False) - InjErrCannotInferFromRhs tvs has_kinds _ -> - let show_kinds = has_kinds == YesHasKinds - what = if show_kinds then text "Type/kind" else text "Type" - body = sep [ what <+> text "variable" <> - pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . scopedSort) - , text "cannot be inferred from the right-hand side." ] - in (injectivityErrorHerald $$ body $$ text "In the type family equation:", show_kinds) - - in mkSimpleDecorated $ pprWithInvisibleBitsWhen show_kinds $ - hang herald - 2 (vcat (map (pprCoAxBranchUser fam_tc) (eqn1 : rest_eqns))) - TcRnBangOnUnliftedType ty - -> mkSimpleDecorated $ - text "Strictness flag has no effect on unlifted type" <+> quotes (ppr ty) - TcRnLazyBangOnUnliftedType ty - -> mkSimpleDecorated $ - text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty) - TcRnMultipleDefaultDeclarations cls dup_things - -> mkSimpleDecorated $ - hang (text "Multiple default declarations for class" <+> quotes (ppr cls)) - 2 (vcat (map pp dup_things)) - where - pp :: LDefaultDecl GhcRn -> SDoc - pp (L locn DefaultDecl {}) - = text "here was another default declaration" <+> ppr (locA locn) - TcRnBadDefaultType ty deflt_clss - -> mkSimpleDecorated $ - hang (text "The default type" <+> quotes (ppr ty) <+> text "is not an instance of") - 2 (foldr1 (\a b -> a <+> text "or" <+> b) (NE.map (quotes. ppr) deflt_clss)) - TcRnPatSynBundledWithNonDataCon - -> mkSimpleDecorated $ - text "Pattern synonyms can be bundled only with datatypes." - TcRnPatSynBundledWithWrongType expected_res_ty res_ty - -> mkSimpleDecorated $ - text "Pattern synonyms can only be bundled with matching type constructors" - $$ text "Couldn't match expected type of" - <+> quotes (ppr expected_res_ty) - <+> text "with actual type of" - <+> quotes (ppr res_ty) - TcRnDupeModuleExport mod - -> mkSimpleDecorated $ - hsep [ text "Duplicate" - , quotes (text "Module" <+> ppr mod) - , text "in export list" ] - TcRnExportedModNotImported mod - -> mkSimpleDecorated - $ formatExportItemError - (text "module" <+> ppr mod) - "is not imported" - TcRnNullExportedModule mod - -> mkSimpleDecorated - $ formatExportItemError - (text "module" <+> ppr mod) - "exports nothing" - TcRnMissingExportList mod - -> mkSimpleDecorated - $ formatExportItemError - (text "module" <+> ppr mod) - "is missing an export list" - TcRnExportHiddenComponents export_item - -> mkSimpleDecorated - $ formatExportItemError - (ppr export_item) - "attempts to export constructors or class methods that are not visible here" - TcRnExportHiddenDefault export_item - -> mkSimpleDecorated - $ formatExportItemError - (ppr export_item) - "attempts to export a default class declaration that is not visible here" - TcRnDuplicateExport gre ie1 ie2 - -> mkSimpleDecorated $ - hsep [ quotes (ppr $ greName gre) - , text "is exported by", quotes (ppr ie1) - , text "and", quotes (ppr ie2) ] - TcRnExportedParentChildMismatch parent_name ty_thing child parent_names - -> mkSimpleDecorated $ - text "The type constructor" <+> quotes (ppr parent_name) - <+> text "is not the parent of the" <+> text what_is - <+> quotes thing <> char '.' - $$ text (capitalise what_is) - <> text "s can only be exported with their parent type constructor." - $$ (case parents of - [] -> empty - [_] -> text "Parent:" - _ -> text "Parents:") <+> fsep (punctuate comma parents) - where - pp_category :: TyThing -> String - pp_category (AnId i) - | isRecordSelector i = "record selector" - pp_category i = tyThingCategory i - what_is = pp_category ty_thing - thing = ppr $ nameOccName child - parents = map ppr parent_names - TcRnConflictingExports occ child_gre1 ie1 child_gre2 ie2 - -> mkSimpleDecorated $ - vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon - , ppr_export child_gre1 ie1 - , ppr_export child_gre2 ie2 - ] - where - ppr_export gre ie = - nest 3 $ - hang (quotes (ppr ie) <+> text "exports" <+> quotes (ppr $ greName gre)) - 2 (pprNameProvenance gre) - TcRnDuplicateFieldExport (gre, ie1) gres_ies -> - mkSimpleDecorated $ - vcat ( hsep [ text "Duplicate record field" - , quotes (ppr $ greOccName gre) - , text "in export list" <> colon ] - : map ppr_export ((gre,ie1) : NE.toList gres_ies) - ) - where - ppr_export (gre,ie) = - nest 3 $ - hang (sep [ quotes (ppr ie) <+> text "exports the field" <+> quotes (ppr $ greName gre) - , text "belonging to the constructor" <> plural fld_cons <+> pprQuotedList fld_cons ]) - 2 (pprNameProvenance gre) - where - fld_cons :: [ConLikeName] - fld_cons = nonDetEltsUniqSet $ recFieldCons $ fieldGREInfo gre - TcRnAmbiguousFieldInUpdate (gre1, gre2, gres) - -> mkSimpleDecorated $ - vcat [ text "Ambiguous record field" <+> fld <> dot - , hang (text "It could refer to any of the following:") - 2 $ vcat (map pprSugg (gre1 : gre2 : gres)) - ] - where - fld = quotes $ ppr (occNameFS $ greOccName gre1) - pprSugg gre = vcat [ bullet <+> pprGRE gre <> comma - , nest 2 (pprNameProvenance gre) ] - pprGRE gre = case greInfo gre of - IAmRecField {} - -> let parent = par_is $ greParent gre - in text "record field" <+> fld <+> text "of" <+> quotes (ppr parent) - _ -> text "variable" <+> fld - TcRnAmbiguousRecordUpdate _rupd tc - -> mkSimpleDecorated $ - vcat [ text "Ambiguous record update with parent" <+> what <> dot - , hsep [ text "This type-directed disambiguation mechanism" - , text "will not be supported by -XDuplicateRecordFields in future releases of GHC." ] - , text "Consider disambiguating using module qualification instead." - ] - where - what :: SDoc - what = text "type constructor" <+> quotes (ppr $ RecSelData tc) - TcRnMissingFields con fields - -> mkSimpleDecorated $ vcat [header, nest 2 rest] - where - rest | null fields = empty - | otherwise = vcat (fmap pprField fields) - header = text "Fields of" <+> quotes (ppr con) <+> - text "not initialised" <> - if null fields then empty else colon - TcRnFieldUpdateInvalidType prs - -> mkSimpleDecorated $ - hang (text "Record update for insufficiently polymorphic field" - <> plural prs <> colon) - 2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ]) - TcRnMissingStrictFields con fields - -> mkSimpleDecorated $ vcat [header, nest 2 rest] - where - rest | null fields = empty -- Happens for non-record constructors - -- with strict fields - | otherwise = vcat (fmap pprField fields) - - header = text "Constructor" <+> quotes (ppr con) <+> - text "does not have the required strict field(s)" <> - if null fields then empty else colon - TcRnBadRecordUpdate upd_flds reason - -> case reason of - NoConstructorHasAllFields { conflictingFields = conflicts } - | [fld] <- conflicts - -> mkSimpleDecorated $ - vcat [ header - , text "No constructor in scope has the field" <+> quotes (ppr fld) ] - | otherwise - -> - mkSimpleDecorated $ - vcat [ header - , hang (text "No constructor in scope has all of the following fields:") - 2 (pprQuotedList conflicts) ] - where - header :: SDoc - header = text "Invalid record update." - MultiplePossibleParents (par1, par2, pars) -> - mkSimpleDecorated $ - vcat [ hang (text "Ambiguous record update with field" <> plural upd_flds) - 2 ppr_flds - , hang (thisOrThese upd_flds <+> text "field" <> plural upd_flds <+> what_parent) - 2 (quotedListWithAnd (map ppr (par1:par2:pars))) ] - where - ppr_flds, what_parent, which :: SDoc - ppr_flds = quotedListWithAnd $ map ppr upd_flds - what_parent = case par1 of - RecSelData {} -> text "appear" <> singular upd_flds - <+> text "in" <+> which <+> text "datatypes" - RecSelPatSyn {} -> isOrAre upd_flds <+> text "associated with" - <+> which <+> text "pattern synonyms" - which = case pars of - [] -> text "both" - _ -> text "all of the" - InvalidTyConParent tc pars -> - mkSimpleDecorated $ - vcat [ hang (text "No data constructor of" <+> what $$ text "has all of the fields:") - 2 (pprQuotedList upd_flds) - , pat_syn_msg ] - where - what = text "type constructor" <+> quotes (ppr (RecSelData tc)) - pat_syn_msg - | any (\case { RecSelPatSyn {} -> True; _ -> False}) pars - = note "Type-directed disambiguation is not supported for pattern synonym record fields" - | otherwise - = empty - TcRnStaticFormNotClosed name reason - -> mkSimpleDecorated $ - quotes (ppr name) - <+> text "is used in a static form but it is not closed" - <+> text "because it" - $$ sep (causes reason) - where - causes :: NotClosedReason -> [SDoc] - causes NotLetBoundReason = [text "is not let-bound."] - causes (NotTypeClosed vs) = - [ text "has a non-closed type because it contains the" - , text "type variables:" <+> - pprVarSet vs (hsep . punctuate comma . map (quotes . ppr)) - ] - causes (NotClosed n reason) = - let msg = text "uses" <+> quotes (ppr n) <+> text "which" - in case reason of - NotClosed _ _ -> msg : causes reason - _ -> let (xs0, xs1) = splitAt 1 $ causes reason - in fmap (msg <+>) xs0 ++ xs1 - TcRnUselessTypeable - -> mkSimpleDecorated $ - text "Deriving" <+> quotes (ppr typeableClassName) <+> - text "has no effect: all types now auto-derive Typeable" - TcRnDerivingDefaults cls - -> mkSimpleDecorated $ sep - [ text "Both DeriveAnyClass and" - <+> text "GeneralizedNewtypeDeriving are enabled" - , text "Defaulting to the DeriveAnyClass strategy" - <+> text "for instantiating" <+> ppr cls - ] - TcRnNonUnaryTypeclassConstraint ctxt ct - -> mkSimpleDecorated $ - quotes (ppr ct) - <+> text "is not a unary constraint, as expected by" - <+> pprUserTypeCtxt ctxt - TcRnPartialTypeSignatures _ theta - -> mkSimpleDecorated $ - text "Found type wildcard" <+> quotes (char '_') - <+> text "standing for" <+> quotes (pprTheta theta) - TcRnCannotDeriveInstance cls cls_tys mb_strat newtype_deriving reason - -> mkSimpleDecorated $ - derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving True reason - TcRnLookupInstance cls tys reason - -> mkSimpleDecorated $ - text "Couldn't match instance:" <+> - lookupInstanceErrDiagnosticMessage cls tys reason - TcRnLazyGADTPattern - -> mkSimpleDecorated $ - hang (text "An existential or GADT data constructor cannot be used") - 2 (text "inside a lazy (~) pattern") - TcRnArrowProcGADTPattern - -> mkSimpleDecorated $ - text "Proc patterns cannot use existential or GADT data constructors" - TcRnTypeEqualityOutOfScope - -> mkDecorated - [ text "The" <+> quotes (text "~") <+> text "operator is out of scope." $$ - text "Assuming it to stand for an equality constraint." - , note $ quotes "~" <+> "used to be built-in syntax but now is a regular type operator" $$ - "exported from Data.Type.Equality and Prelude." $$ - "If you are using a custom Prelude, consider re-exporting it" - , text "This will become an error in a future GHC release." ] - TcRnTypeEqualityRequiresOperators - -> mkSimpleDecorated $ - fsep [ text "The use of" <+> quotes (text "~") - <+> text "without TypeOperators", - text "will become an error in a future GHC release." ] - TcRnIllegalTypeOperator overall_ty op - -> mkSimpleDecorated $ - text "Illegal operator" <+> quotes (ppr op) <+> - text "in type" <+> quotes (ppr overall_ty) - TcRnIllegalTypeOperatorDecl name - -> mkSimpleDecorated $ - text "Illegal declaration of a type or class operator" <+> quotes (ppr name) - TcRnGADTMonoLocalBinds - -> mkSimpleDecorated $ - fsep [ text "Pattern matching on GADTs without MonoLocalBinds" - , text "is fragile." ] - TcRnIncorrectNameSpace name _ - -> mkSimpleDecorated $ - text "The" <+> what <+> text "does not live in" <+> other_ns - where - -- the other (opposite) namespace - other_ns | isValNameSpace ns = text "the type-level namespace" - | otherwise = text "the term-level namespace" - ns = nameNameSpace name - what = pprNameSpace ns <+> quotes (ppr name) - TcRnNotInScope err name imp_errs _ - -> mkSimpleDecorated $ - pprScopeError name err $$ vcat (map ppr imp_errs) - TcRnTermNameInType name _ - -> mkSimpleDecorated $ - quotes (ppr name) <+> - (text "is a term-level binding") $+$ - (text " and can not be used at the type level.") - TcRnUntickedPromotedThing thing - -> mkSimpleDecorated $ - text "Unticked promoted" <+> what - where - what :: SDoc - what = case thing of - UntickedExplicitList -> text "list" <> dot - UntickedConstructor fixity nm -> - let con = pprUntickedConstructor fixity nm - bare_sym = isBareSymbol fixity nm - in text "constructor:" <+> con <> if bare_sym then empty else dot - TcRnIllegalBuiltinSyntax what rdr_name - -> mkSimpleDecorated $ - hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr_name] - TcRnWarnDefaulting tidy_wanteds tidy_tv default_ty - -> mkSimpleDecorated $ - hang (hsep $ [ text "Defaulting" ] - ++ - (case tidy_tv of - Nothing -> [] - Just tv -> [text "the type variable" - , quotes (ppr tv)]) - ++ - [ text "to type" - , quotes (ppr default_ty) - , text "in the following constraint" <> plural tidy_wanteds ]) - 2 - (pprWithArising tidy_wanteds) - TcRnWarnClashingDefaultImports cls Nothing imports - -> mkSimpleDecorated $ - hang (text "Clashing imported defaults for class" <+> quotes (ppr cls) <> colon) - 2 (vcat $ defaultTypesAndImport <$> NE.toList imports) - TcRnWarnClashingDefaultImports cls (Just local) imports - -> mkSimpleDecorated $ - sep [ hang (text "Imported defaults for class" <+> quotes (ppr cls) <> colon) - 2 (vcat $ defaultTypesAndImport <$> NE.toList imports) - , hang (text "are not subsumed by the local `default` declaration") - 2 (parens $ pprWithCommas ppr local) - ] - - TcRnForeignImportPrimExtNotSet _decl - -> mkSimpleDecorated $ - text "`foreign import prim' requires GHCForeignImportPrim." - - TcRnForeignImportPrimSafeAnn _decl - -> mkSimpleDecorated $ - text "The safe/unsafe annotation should not be used with `foreign import prim'." - - TcRnForeignFunctionImportAsValue _decl - -> mkSimpleDecorated $ - text "`value' imports cannot have function types" - - TcRnFunPtrImportWithoutAmpersand _decl - -> mkSimpleDecorated $ - text "possible missing & in foreign import of FunPtr" - - TcRnIllegalForeignDeclBackend _decl _backend expectedBknds - -> mkSimpleDecorated $ - fsep (text "Illegal foreign declaration: requires one of these back ends:" : - commafyWith (text "or") (map (text . backendDescription) expectedBknds)) - - TcRnUnsupportedCallConv _decl unsupportedCC - -> mkSimpleDecorated $ - case unsupportedCC of - StdCallConvUnsupported -> - text "the 'stdcall' calling convention is unsupported on this platform," - $$ text "treating as ccall" - PrimCallConvUnsupported -> - text "The `prim' calling convention can only be used with `foreign import'" - JavaScriptCallConvUnsupported -> - text "The `javascript' calling convention is unsupported on this platform" - - TcRnIllegalForeignType mArgOrResult reason - -> mkSimpleDecorated $ hang msg 2 extra - where - arg_or_res = case mArgOrResult of - Nothing -> empty - Just Arg -> text "argument" - Just Result -> text "result" - msg = hsep [ text "Unacceptable", arg_or_res - , text "type in foreign declaration:"] - extra = - case reason of - TypeCannotBeMarshaled ty why -> - let innerMsg = quotes (ppr ty) <+> text "cannot be marshalled in a foreign call" - in case why of - NotADataType -> - quotes (ppr ty) <+> text "is not a data type" - NewtypeDataConNotInScope _ [] -> - hang innerMsg 2 $ text "because its data constructor is not in scope" - NewtypeDataConNotInScope tc _ -> - hang innerMsg 2 $ - text "because the data constructor for" - <+> quotes (ppr tc) <+> text "is not in scope" - UnliftedFFITypesNeeded -> - innerMsg $$ text "UnliftedFFITypes is required to marshal unlifted types" - NotABoxedMarshalableTyCon -> innerMsg - ForeignLabelNotAPtr -> - innerMsg $$ text "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)" - NotSimpleUnliftedType -> - innerMsg $$ text "foreign import prim only accepts simple unlifted types" - NotBoxedKindAny -> - text "Expected kind" <+> quotes (text "Type") <+> text "or" <+> quotes (text "UnliftedType") <> comma $$ - text "but" <+> quotes (ppr ty) <+> text "has kind" <+> quotes (ppr (typeKind ty)) - ForeignDynNotPtr expected ty -> - vcat [ text "Expected: Ptr/FunPtr" <+> pprParendType expected <> comma, text " Actual:" <+> ppr ty ] - SafeHaskellMustBeInIO -> - text "Safe Haskell is on, all FFI imports must be in the IO monad" - IOResultExpected -> - text "IO result type expected" - UnexpectedNestedForall -> - text "Unexpected nested forall" - LinearTypesNotAllowed -> - text "Linear types are not supported in FFI declarations, see #18472" - OneArgExpected -> - text "One argument expected" - AtLeastOneArgExpected -> - text "At least one argument expected" - TcRnInvalidCIdentifier target - -> mkSimpleDecorated $ - sep [quotes (ppr target) <+> text "is not a valid C identifier"] - TcRnExpectedValueId thing - -> mkSimpleDecorated $ - ppr thing <+> text "used where a value identifier was expected" - TcRnRecSelectorEscapedTyVar lbl - -> mkSimpleDecorated $ - text "Cannot use record selector" <+> quotes (ppr lbl) <+> - text "as a function due to escaped type variables" - TcRnPatSynNotBidirectional name - -> mkSimpleDecorated $ - text "non-bidirectional pattern synonym" - <+> quotes (ppr name) <+> text "used in an expression" - TcRnIllegalDerivingItem hs_ty - -> mkSimpleDecorated $ - text "Illegal deriving item" <+> quotes (ppr hs_ty) - TcRnIllegalDefaultClass nm - -> mkSimpleDecorated $ - text "Illegal named default declaration for non-class" <+> quotes (ppr nm) - TcRnIllegalNamedDefault hs_decl - -> mkSimpleDecorated $ text "Illegal named default declaration" <+> quotes (ppr hs_decl) - TcRnUnexpectedAnnotation ty bang - -> mkSimpleDecorated $ - let err = case bang of - HsBang SrcUnpack _ -> "UNPACK" - HsBang SrcNoUnpack _ -> "NOUNPACK" - HsBang NoSrcUnpack SrcLazy -> "laziness" - HsBang _ _ -> "strictness" - in text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$ - text err <+> text "annotation cannot appear nested inside a type" - TcRnIllegalRecordSyntax either_ty_ty - -> mkSimpleDecorated $ - text "Record syntax is illegal here:" <+> either ppr ppr either_ty_ty - - TcRnInvalidVisibleKindArgument arg ty - -> mkSimpleDecorated $ - text "Cannot apply function of kind" <+> quotes (ppr ty) - $$ text "to visible kind argument" <+> quotes (ppr arg) - TcRnTooManyBinders ki bndrs - -> mkSimpleDecorated $ - hang (text "Not a function kind:") - 4 (ppr ki) $$ - hang (text "but extra binders found:") - 4 (fsep (map ppr bndrs)) - TcRnDifferentNamesForTyVar n1 n2 - -> mkSimpleDecorated $ - hang (text "Different names for the same type variable:") 2 info - where - info | nameOccName n1 /= nameOccName n2 - = quotes (ppr n1) <+> text "and" <+> quotes (ppr n2) - | otherwise -- Same OccNames! See C2 in - -- Note [Swizzling the tyvars before generaliseTcTyCon] - = vcat [ quotes (ppr n1) <+> text "bound at" <+> ppr (getSrcLoc n1) - , quotes (ppr n2) <+> text "bound at" <+> ppr (getSrcLoc n2) ] - - TcRnDisconnectedTyVar n - -> mkSimpleDecorated $ - hang (text "Scoped type variable only appears non-injectively in declaration header:") - 2 (quotes (ppr n) <+> text "bound at" <+> ppr (getSrcLoc n)) - - TcRnInvalidReturnKind data_sort allowed_kind kind _suggested_ext - -> mkSimpleDecorated $ - sep [ ppDataSort data_sort <+> - text "has non-" <> - allowed_kind_tycon - , (if is_data_family then text "and non-variable" else empty) <+> - text "return kind" <+> quotes (ppr kind) - ] - where - is_data_family = - case data_sort of - DataDeclSort{} -> False - DataInstanceSort{} -> False - DataFamilySort -> True - allowed_kind_tycon = - case allowed_kind of - AnyTYPEKind -> ppr tYPETyCon - AnyBoxedKind -> ppr boxedRepDataConTyCon - LiftedKind -> ppr liftedTypeKind - TcRnClassKindNotConstraint _kind - -> mkSimpleDecorated $ - text "Kind signature on a class must end with" <+> ppr constraintKind $$ - text "unobscured by type families" - TcRnUnpromotableThing name err - -> mkSimpleDecorated $ - (hang (pprPECategory err <+> quotes (ppr name) <+> text "cannot be used here") - 2 (parens reason)) - where - reason = case err of - ConstrainedDataConPE theta - -> text "it has an unpromotable context" - <+> quotes (pprTheta theta) - - FamDataConPE -> text "it comes from a data family instance" - PatSynPE -> text "pattern synonyms cannot be promoted" - RecDataConPE -> same_rec_group_msg - ClassPE -> same_rec_group_msg - TyConPE -> same_rec_group_msg - TermVariablePE -> text "term variables cannot be promoted" - TypeVariablePE -> text "type variables bound in a kind signature cannot be used in the type" - same_rec_group_msg = text "it is defined and used in the same recursive group" - TcRnIllegalTermLevelUse name err - -> mkSimpleDecorated $ - text "Illegal term-level use of the" <+> - text (teCategory err) <+> quotes (ppr name) - TcRnMatchesHaveDiffNumArgs argsContext (MatchArgMatches match1 bad_matches) - -> mkSimpleDecorated $ - (vcat [ pprMatchContextNouns argsContext <+> - text "have different numbers of arguments" - , nest 2 (ppr (getLocA match1)) - , nest 2 (ppr (getLocA (NE.head bad_matches)))]) - TcRnCannotBindScopedTyVarInPatSig sig_tvs - -> mkSimpleDecorated $ - hang (text "You cannot bind scoped type variable" - <> plural (NE.toList sig_tvs) - <+> pprQuotedList (map fst $ NE.toList sig_tvs)) - 2 (text "in a pattern binding signature") - TcRnCannotBindTyVarsInPatBind _offenders - -> mkSimpleDecorated $ - text "Binding type variables is not allowed in pattern bindings" - TcRnTooManyTyArgsInConPattern con_like expected_number actual_number - -> mkSimpleDecorated $ - text "Too many type arguments in constructor pattern for" <+> quotes (ppr con_like) $$ - text "Expected no more than" <+> ppr expected_number <> semi <+> text "got" <+> ppr actual_number - TcRnMultipleInlinePragmas poly_id fst_inl_prag inl_prags - -> mkSimpleDecorated $ - hang (text "Multiple INLINE pragmas for" <+> ppr poly_id) - 2 (vcat (text "Ignoring all but the first" - : map pp_inl (fst_inl_prag : NE.toList inl_prags))) - where - pp_inl (L loc prag) = ppr prag <+> parens (ppr loc) - TcRnUnexpectedPragmas poly_id bad_sigs - -> mkSimpleDecorated $ - hang (text "Discarding unexpected pragmas for" <+> ppr poly_id) - 2 (vcat (map (ppr . getLoc) $ NE.toList bad_sigs)) - TcRnNonOverloadedSpecialisePragma fun_name - -> mkSimpleDecorated $ - text "SPECIALISE pragma for non-overloaded function" - <+> quotes (ppr fun_name) - TcRnSpecialiseNotVisible name - -> mkSimpleDecorated $ - text "You cannot SPECIALISE" <+> quotes (ppr name) - <+> text "because its definition is not visible in this module" - TcRnPragmaWarning - { pragma_warning_info = PragmaWarningInstance{pwarn_dfunid, pwarn_ctorig} - , pragma_warning_msg } - -> mkSimpleDecorated $ - sep [ hang (text "In the use of") - 2 (pprDFunId pwarn_dfunid) - , ppr pwarn_ctorig - , pprWarningTxtForMsg pragma_warning_msg - ] - TcRnPragmaWarning - { pragma_warning_info = PragmaWarningDefault{pwarn_class, pwarn_impmod} - , pragma_warning_msg } - -> mkSimpleDecorated $ - sep [ sep [ text "In the use of class" - <+> ppr pwarn_class - <+> text "defaults imported from" - <+> ppr pwarn_impmod <> colon ] - , pprWarningTxtForMsg pragma_warning_msg - ] - TcRnPragmaWarning {pragma_warning_info, pragma_warning_msg} - -> mkSimpleDecorated $ - sep [ sep [ text "In the use of" - <+> pprNonVarNameSpace (occNameSpace occ_name) - <+> quotes (ppr occ_name) - , parens imp_msg <> colon ] - , pprWarningTxtForMsg pragma_warning_msg ] - where - occ_name = pwarn_occname pragma_warning_info - imp_mod = pwarn_impmod pragma_warning_info - imp_msg = text "imported from" <+> ppr imp_mod <> extra - extra | PragmaWarningName {pwarn_declmod = decl_mod} <- pragma_warning_info - , imp_mod /= decl_mod = text ", but defined in" <+> ppr decl_mod - | otherwise = empty - TcRnDifferentExportWarnings name locs - -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages", - text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] - TcRnIncompleteExportWarnings name locs - -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "will not have its export warned about", - text "missing export warning at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] - TcRnIllegalHsigDefaultMethods name meths - -> mkSimpleDecorated $ - text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" - TcRnHsigFixityMismatch real_thing real_fixity sig_fixity - -> - let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty - in mkSimpleDecorated $ - vcat [ppr real_thing <+> text "has conflicting fixities in the module", - text "and its hsig file", - text "Main module:" <+> ppr_fix real_fixity, - text "Hsig file:" <+> ppr_fix sig_fixity] - TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2) - -> mkSimpleDecorated $ - text "While merging export lists, could not combine" - <+> ppr info1 <+> text "with" <+> ppr info2 - <+> parens (text "one is a type, the other is a plain identifier") - TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere) - -> - let extra = if notHere - then text "Neither name variable originates from the current signature." - else empty - in mkSimpleDecorated $ - text "While merging export lists, could not unify" - <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra - TcRnHsigMissingModuleExport occ unit_state impl_mod - -> mkSimpleDecorated $ - quotes (ppr occ) - <+> text "is exported by the hsig file, but not exported by the implementing module" - <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) - TcRnBadGenericMethod clas op - -> mkSimpleDecorated $ - hsep [text "Class", quotes (ppr clas), - text "has a generic-default signature without a binding", quotes (ppr op)] - TcRnWarningMinimalDefIncomplete mindef - -> mkSimpleDecorated $ - vcat [ text "The MINIMAL pragma does not require:" - , nest 2 (pprBooleanFormulaNice mindef) - , text "but there is no default implementation." ] - TcRnDefaultMethodForPragmaLacksBinding sel_id prag - -> mkSimpleDecorated $ - text "The" <+> hsSigDoc prag <+> text "for default method" - <+> quotes (ppr sel_id) - <+> text "lacks an accompanying binding" - TcRnIgnoreSpecialisePragmaOnDefMethod sel_name - -> mkSimpleDecorated $ - text "Ignoring SPECIALISE pragmas on default method" - <+> quotes (ppr sel_name) - TcRnBadMethodErr{badMethodErrClassName, badMethodErrMethodName} - -> mkSimpleDecorated $ - hsep [text "Class", quotes (ppr badMethodErrClassName), - text "does not have a method", quotes (ppr badMethodErrMethodName)] - TcRnIllegalTypeData - -> mkSimpleDecorated $ - text "Illegal type-level data declaration" - TcRnTypeDataForbids feature - -> mkSimpleDecorated $ - ppr feature <+> text "are not allowed in type data declarations." - - TcRnIllegalNewtype con show_linear_types reason - -> mkSimpleDecorated $ - vcat [msg, additional] - where - (msg,additional) = - case reason of - DoesNotHaveSingleField n_flds -> - (sep [ - text "A newtype constructor must have exactly one field", - nest 2 $ - text "but" <+> quotes (ppr con) <+> text "has" <+> speakN n_flds - ], - ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) - IsNonLinear -> - (text "A newtype constructor must be linear", - ppr con <+> dcolon <+> ppr (dataConDisplayType True con)) - IsGADT -> - (text "A newtype must not be a GADT", - ppr con <+> dcolon <+> pprWithInvisibleBitsWhen sneaky_eq_spec - (ppr $ dataConDisplayType show_linear_types con)) - HasConstructorContext -> - (text "A newtype constructor must not have a context in its type", - ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) - HasExistentialTyVar -> - (text "A newtype constructor must not have existential type variables", - ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) - HasStrictnessAnnotation -> - (text "A newtype constructor must not have a strictness annotation", empty) - - -- Is the data con a "covert" GADT? See Note [isCovertGadtDataCon] - -- in GHC.Core.DataCon - sneaky_eq_spec = isCovertGadtDataCon con - TcRnOrPatBindsVariables bndrs -> mkSimpleDecorated $ - text "An or-pattern may not bind term or type variables such as" - <+> quotedListWithOr (map ppr (NE.toList bndrs)) - TcRnUnsatisfiedMinimalDef mindef - -> mkSimpleDecorated $ - vcat [text "No explicit implementation for" - ,nest 2 $ pprBooleanFormulaNice mindef - ] - TcRnMisplacedInstSig name hs_ty - -> mkSimpleDecorated $ - vcat [ hang (text "Illegal type signature in instance declaration:") - 2 (hang (pprPrefixName name) - 2 (dcolon <+> ppr hs_ty)) - ] - TcRnNoRebindableSyntaxRecordDot -> mkSimpleDecorated $ - text "RebindableSyntax is required if OverloadedRecordUpdate is enabled." - TcRnNoFieldPunsRecordDot -> mkSimpleDecorated $ - text "For this to work enable NamedFieldPuns" - TcRnIllegalStaticExpression e -> mkSimpleDecorated $ - text "Illegal static expression:" <+> ppr e - TcRnListComprehensionDuplicateBinding n -> mkSimpleDecorated $ - (text "Duplicate binding in parallel list comprehension for:" - <+> quotes (ppr n)) - TcRnEmptyStmtsGroup cause -> mkSimpleDecorated $ case cause of - EmptyStmtsGroupInParallelComp -> - text "Empty statement group in parallel comprehension" - EmptyStmtsGroupInTransformListComp -> - text "Empty statement group preceding 'group' or 'then'" - EmptyStmtsGroupInDoNotation ctxt -> - text "Empty" <+> pprHsDoFlavour ctxt - EmptyStmtsGroupInArrowNotation -> - text "Empty 'do' block in an arrow command" - TcRnLastStmtNotExpr ctxt (UnexpectedStatement stmt) -> - mkSimpleDecorated $ hang last_error 2 (ppr stmt) - where - last_error = - text "The last statement in" <+> pprAStmtContext ctxt - <+> text "must be an expression" - TcRnUnexpectedStatementInContext ctxt (UnexpectedStatement stmt) _ -> mkSimpleDecorated $ - sep [ text "Unexpected" <+> pprStmtCat stmt <+> text "statement" - , text "in" <+> pprAStmtContext ctxt ] - TcRnIllegalTupleSection -> mkSimpleDecorated $ - text "Illegal tuple section" - TcRnIllegalImplicitParameterBindings eBinds -> mkSimpleDecorated $ - either msg msg eBinds - where - msg binds = hang - (text "Implicit-parameter bindings illegal in an mdo expression") - 2 (ppr binds) - TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ - hang (text "A section must be enclosed in parentheses") - 2 (text "thus:" <+> (parens (ppr expr))) - TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $ - hang (text "Missing role annotation" <> colon) - 2 (text "type role" <+> ppr name <+> hsep (map ppr roles)) - - TcRnIllformedTypePattern p - -> mkSimpleDecorated $ - hang (text "Ill-formed type pattern:") 2 (ppr p) - TcRnIllegalTypePattern - -> mkSimpleDecorated $ - text "Illegal type pattern." $$ - text "A type pattern must be checked against a visible forall." - TcRnIllformedTypeArgument e - -> mkSimpleDecorated $ - hang (text "Ill-formed type argument:") 2 (ppr e) - TcRnIllegalTypeExpr syntax -> mkSimpleDecorated $ - vcat [ text "Illegal" <+> pprTypeSyntaxName syntax - , text "Type syntax may only be used in a required type argument," - , text "i.e. to instantiate a visible forall." ] - - TcRnCapturedTermName tv_name shadowed_term_names - -> mkSimpleDecorated $ - text "The type variable" <+> quotes (ppr tv_name) <+> - text "is implicitly quantified," $+$ - text "even though another variable of the same name is in scope:" $+$ - nest 2 var_names $+$ - text "This is not compatible with the RequiredTypeArguments extension." - where - var_names = case shadowed_term_names of - Left gbl_names -> vcat (map (\name -> quotes (ppr $ greName name) <+> pprNameProvenance name) gbl_names) - Right lcl_name -> quotes (ppr lcl_name) <+> text "defined at" - <+> ppr (nameSrcLoc lcl_name) - TcRnBindingOfExistingName name -> mkSimpleDecorated $ - text "Illegal binding of an existing name:" <+> ppr (filterCTuple name) - TcRnMultipleFixityDecls loc rdr_name -> mkSimpleDecorated $ - vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name), - text "also at " <+> ppr loc] - TcRnIllegalPatternSynonymDecl -> mkSimpleDecorated $ - text "Illegal pattern synonym declaration" - TcRnIllegalClassBinding dsort bind -> mkSimpleDecorated $ - vcat [ what <+> text "not allowed in" <+> decl_sort - , nest 2 (ppr bind) ] - where - decl_sort = case dsort of - ClassDeclSort -> text "class declaration:" - InstanceDeclSort -> text "instance declaration:" - what = case bind of - PatBind {} -> text "Pattern bindings (except simple variables)" - PatSynBind {} -> text "Pattern synonyms" - -- Associated pattern synonyms are not implemented yet - _ -> pprPanic "rnMethodBind" (ppr bind) - TcRnOrphanCompletePragma -> mkSimpleDecorated $ - text "Orphan COMPLETE pragmas not supported" $$ - text "A COMPLETE pragma must mention at least one data constructor" $$ - text "or pattern synonym defined in the same module." - TcRnEmptyCase ctxt reason -> mkSimpleDecorated $ - case reason of - EmptyCaseWithoutFlag -> - text "Empty list of alternatives in" <+> pp_ctxt - EmptyCaseDisallowedCtxt -> - text "Empty list of alternatives is not allowed in" <+> pp_ctxt - EmptyCaseForall tvb -> - vcat [ text "Empty list of alternatives in" <+> pp_ctxt - , hang (text "checked against a forall-type:") - 2 (pprForAll [tvb] <+> text "...") - ] - where - pp_ctxt = case ctxt of - CaseAlt -> text "case expression" - LamAlt LamCase -> text "\\case expression" - LamAlt LamCases -> text "\\cases expression" - ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction" - ArrowMatchCtxt (ArrowLamAlt LamCase) -> text "\\case command" - ArrowMatchCtxt (ArrowLamAlt LamCases) -> text "\\cases command" - ArrowMatchCtxt ArrowCaseAlt -> text "case command" - ctxt -> text "(unexpected)" <+> pprMatchContextNoun ctxt - TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $ - text "accepting non-standard pattern guards" $$ - nest 4 (interpp'SP guards) - TcRnDuplicateSigDecl pairs@((L _ name, sig) :| _) -> mkSimpleDecorated $ - vcat [ text "Duplicate" <+> what_it_is - <> text "s for" <+> quotes (ppr name) - , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest - $ map (getLocA . fst) - $ NE.toList pairs) - ] - where - what_it_is = hsSigDoc sig - TcRnMisplacedSigDecl sig -> mkSimpleDecorated $ - sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig] - TcRnUnexpectedDefaultSig sig -> mkSimpleDecorated $ - hang (text "Unexpected default signature:") - 2 (ppr sig) - TcRnDuplicateMinimalSig sig1 sig2 otherSigs -> mkSimpleDecorated $ - vcat [ text "Multiple minimal complete definitions" - , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ map getLocA sigs) - , text "Combine alternative minimal complete definitions with `|'" ] - where - sigs = sig1 : sig2 : otherSigs - TcRnUnexpectedStandaloneDerivingDecl -> mkSimpleDecorated $ - text "Illegal standalone deriving declaration" - TcRnUnusedVariableInRuleDecl name var -> mkSimpleDecorated $ - sep [text "Rule" <+> doubleQuotes (ftext name) <> colon, - text "Forall'd variable" <+> quotes (ppr var) <+> - text "does not appear on left hand side"] - TcRnUnexpectedStandaloneKindSig -> mkSimpleDecorated $ - text "Illegal standalone kind signature" - TcRnIllegalRuleLhs errReason name lhs bad_e -> mkSimpleDecorated $ - sep [text "Rule" <+> pprRuleName name <> colon, - nest 2 (vcat [err, - text "in left-hand side:" <+> ppr lhs])] - $$ - text "LHS must be of form (f e1 .. en) where f is not forall'd" - where - err = case errReason of - UnboundVariable uv nis -> pprScopeError uv nis - IllegalExpression -> text "Illegal expression:" <+> ppr bad_e - TcRnDuplicateRoleAnnot list -> mkSimpleDecorated $ - hang (text "Duplicate role annotations for" <+> - quotes (ppr $ roleAnnotDeclName first_decl) <> colon) - 2 (vcat $ map pp_role_annot $ NE.toList sorted_list) - where - sorted_list = NE.sortBy cmp_loc list - ((L _ first_decl) :| _) = sorted_list - - pp_role_annot (L loc decl) = hang (ppr decl) - 4 (text "-- written at" <+> ppr (locA loc)) - - cmp_loc = leftmost_smallest `on` getLocA - TcRnDuplicateKindSig list -> mkSimpleDecorated $ - hang (text "Duplicate standalone kind signatures for" <+> - quotes (ppr $ standaloneKindSigName first_decl) <> colon) - 2 (vcat $ map pp_kisig $ NE.toList sorted_list) - where - sorted_list = NE.sortBy cmp_loc list - ((L _ first_decl) :| _) = sorted_list - - pp_kisig (L loc decl) = - hang (ppr decl) 4 (text "-- written at" <+> ppr (locA loc)) - - cmp_loc = leftmost_smallest `on` getLocA - TcRnIllegalDerivStrategy ds -> mkSimpleDecorated $ - text "Illegal deriving strategy" <> colon <+> derivStrategyName ds - TcRnIllegalMultipleDerivClauses -> mkSimpleDecorated $ - text "Illegal use of multiple, consecutive deriving clauses" - TcRnNoDerivStratSpecified{} -> mkSimpleDecorated $ text - "No deriving strategy specified. Did you want stock, newtype, or anyclass?" - TcRnStupidThetaInGadt{} -> mkSimpleDecorated $ - vcat [text "No context is allowed on a GADT-style data declaration", - text "(You can put a context on each constructor, though.)"] - TcRnShadowedTyVarNameInFamResult resName -> mkSimpleDecorated $ - hsep [ text "Type variable", quotes (ppr resName) <> comma - , text "naming a type family result," - ] $$ - text "shadows an already bound type variable" - TcRnIncorrectTyVarOnLhsOfInjCond resName injFrom -> mkSimpleDecorated $ - vcat [ text $ "Incorrect type variable on the LHS of " - ++ "injectivity condition" - , nest 5 - ( vcat [ text "Expected :" <+> ppr resName - , text "Actual :" <+> ppr injFrom ])] - TcRnUnknownTyVarsOnRhsOfInjCond errorVars -> mkSimpleDecorated $ - hsep [ text "Unknown type variable" <> plural errorVars - , text "on the RHS of injectivity condition:" - , interpp'SP errorVars ] - TcRnBadlyStaged reason bind_lvl use_lvl - -> mkSimpleDecorated $ - vcat $ - [ text "Stage error:" <+> pprStageCheckReason reason <+> - hsep [text "is bound at stage" <+> ppr bind_lvl, - text "but used at stage" <+> ppr use_lvl] - ] ++ - [ hsep [ text "Hint: quoting" <+> thBrackets (ppUnless (isValName n) "t") (ppr n) - , text "or an enclosing expression would allow the quotation to be used in an earlier stage" - ] - | StageCheckSplice n <- [reason] - ] - TcRnBadlyStagedType name bind_lvl use_lvl - -> mkSimpleDecorated $ - text "Badly staged type:" <+> ppr name <+> - hsep [text "is bound at stage" <+> ppr bind_lvl, - text "but used at stage" <+> ppr use_lvl] - TcRnStageRestriction reason - -> mkSimpleDecorated $ - sep [ text "GHC stage restriction:" - , nest 2 (vcat [ pprStageCheckReason reason <+> - text "is used in a top-level splice, quasi-quote, or annotation," - , text "and must be imported, not defined locally"])] - TcRnTyThingUsedWrong sort thing name - -> mkSimpleDecorated $ - pprTyThingUsedWrong sort thing name - TcRnCannotDefaultKindVar var knd -> - mkSimpleDecorated $ - (vcat [ text "Cannot default kind variable" <+> quotes (ppr var) - , text "of kind:" <+> ppr knd - , text "Perhaps enable PolyKinds or add a kind signature" ]) - TcRnUninferrableTyVar tidied_tvs context -> - mkSimpleDecorated $ - pprWithInvisibleBitsWhen True $ - vcat [ text "Uninferrable type variable" - <> plural tidied_tvs - <+> pprWithCommas pprTyVar tidied_tvs - <+> text "in" - , pprUninferrableTyVarCtx context ] - TcRnSkolemEscape escapees tv orig_ty -> - mkSimpleDecorated $ - pprWithInvisibleBitsWhen True $ - vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees - , quotes $ pprTyVars escapees - , text "would escape" <+> itsOrTheir escapees <+> text "scope" - ] - , sep [ text "if I tried to quantify" - , pprTyVar tv - , text "in this type:" - ] - , nest 2 (pprTidiedType orig_ty) - , text "(Indeed, I sometimes struggle even printing this correctly," - , text " due to its ill-scoped nature.)" - ] - TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ - vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" - , hang (text "Pattern-bound variable") - 2 (ppr arg <+> dcolon <+> ppr (idType arg)) - , nest 2 $ - hang (text "has a type that mentions pattern-bound coercion" - <> plural bad_co_list <> colon) - 2 (pprWithCommas ppr bad_co_list) - , text "Hint: use -fprint-explicit-coercions to see the coercions" - , text "Probable fix: add a pattern signature" ] - where - bad_co_list = NE.toList bad_co_ne - TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ - hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma - , text "namely" <+> quotes (ppr pat_ty) ]) - 2 (text "mentions existential type variable" <> plural bad_tvs - <+> pprQuotedList bad_tvs) - TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ - hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" - <+> speakNOf decl_arity (text "argument")) - 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") - TcRnPatSynInvalidRhs ps_name lpat _ reason -> mkSimpleDecorated $ - vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" - <+> quotes (ppr ps_name) <> colon) - 2 (pprPatSynInvalidRhsReason reason) - , text "RHS pattern:" <+> ppr lpat ] - TcRnTyFamDepsDisabled -> mkSimpleDecorated $ - text "Illegal injectivity annotation" - TcRnAbstractClosedTyFamDecl -> mkSimpleDecorated $ - text "You may define an abstract closed type family" $$ - text "only in a .hs-boot file" - TcRnPartialFieldSelector fld -> mkSimpleDecorated $ - vcat [ sep [ text "Definition of partial record field" <> colon - , nest 2 $ quotes (ppr (occName fld)) ] - , text "Record selection and update using this field will be partial." ] - TcRnHasFieldResolvedIncomplete name -> mkSimpleDecorated $ - text "The invocation of `getField` on the record field" <+> quotes (ppr name) - <+> text "may produce an error since it is not defined for all data constructors" - TcRnBadFieldAnnotation n con reason -> mkSimpleDecorated $ - hang (pprBadFieldAnnotationReason reason) - 2 (text "on the" <+> speakNth n - <+> text "argument of" <+> quotes (ppr con)) - TcRnSuperclassCycle (MkSuperclassCycle cls definite details) -> - let herald | definite = text "Superclass cycle for" - | otherwise = text "Potential superclass cycle for" - in mkSimpleDecorated $ - vcat [ herald <+> quotes (ppr cls), nest 2 (vcat (pprSuperclassCycleDetail <$> details))] - TcRnDefaultSigMismatch sel_id dm_ty -> mkSimpleDecorated $ - hang (text "The default type signature for" - <+> ppr sel_id <> colon) - 2 (ppr dm_ty) - $$ (text "does not match its corresponding" - <+> text "non-default type signature") - TcRnTyFamsDisabled reason -> mkSimpleDecorated $ - text "Illegal family" <+> text sort <+> text "for" <+> quotes name - where - (sort, name) = case reason of - TyFamsDisabledFamily n -> ("declaration", ppr n) - TyFamsDisabledInstance n -> ("instance", ppr n) - TcRnBadTyConTelescope tc -> mkSimpleDecorated $ - vcat [ hang (text "The kind of" <+> quotes (ppr tc) <+> text "is ill-scoped") - 2 pp_tc_kind - , extra - , hang (text "Perhaps try this order instead:") - 2 (pprTyVars sorted_tvs) ] - where - pp_tc_kind = text "Inferred kind:" <+> ppr tc <+> dcolon <+> ppr_untidy (tyConKind tc) - ppr_untidy ty = pprIfaceType (toIfaceType ty) - -- We need ppr_untidy here because pprType will tidy the type, which - -- will turn the bogus kind we are trying to report - -- T :: forall (a::k) k (b::k) -> blah - -- into a misleadingly sanitised version - -- T :: forall (a::k) k1 (b::k1) -> blah - - tcbs = tyConBinders tc - tvs = binderVars tcbs - sorted_tvs = scopedSort tvs - - inferred_tvs = [ binderVar tcb - | tcb <- tcbs, Inferred == tyConBinderForAllTyFlag tcb ] - specified_tvs = [ binderVar tcb - | tcb <- tcbs, Specified == tyConBinderForAllTyFlag tcb ] - - extra - | null inferred_tvs && null specified_tvs - = empty - | null inferred_tvs - = note $ "Specified variables" <+> pp_spec <+> "always come first" - | null specified_tvs - = note inf_always_first - | otherwise - = note $ inf_always_first $$ - "then specified variables" <+> pp_spec - - inf_always_first = "Inferred variables" <+> pp_inf $$ "always come first" - - pp_inf = parens (text "namely:" <+> pprTyVars inferred_tvs) - pp_spec = parens (text "namely:" <+> pprTyVars specified_tvs) - TcRnTyFamResultDisabled tc_name tvb -> mkSimpleDecorated $ - text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name) - TcRnRoleValidationFailed role reason -> mkSimpleDecorated $ - vcat [text "Internal error in role inference:", - pprRoleValidationFailedReason role reason, - text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"] - TcRnCommonFieldResultTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ - vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, - text "have a common field" <+> quotes (ppr field_name) <> comma], - nest 2 $ text "but have different result types"] - TcRnCommonFieldTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ - sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, - text "give different types for field", quotes (ppr field_name)] - TcRnClassExtensionDisabled cls reason -> mkSimpleDecorated $ - pprDisabledClassExtension cls reason - TcRnDataConParentTypeMismatch data_con res_ty_tmpl -> mkSimpleDecorated $ - hang (text "Data constructor" <+> quotes (ppr data_con) <+> - text "returns type" <+> quotes (ppr actual_res_ty)) - 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl)) - where - actual_res_ty = dataConOrigResTy data_con - TcRnGADTsDisabled tc_name -> mkSimpleDecorated $ - text "Illegal generalised algebraic data declaration for" <+> quotes (ppr tc_name) - TcRnExistentialQuantificationDisabled con -> mkSimpleDecorated $ - sdocOption sdocLinearTypes (\show_linear_types -> - hang (text "Data constructor" <+> quotes (ppr con) <+> - text "has existential type variables, a context, or a specialised result type") - 2 (ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con))) - TcRnGADTDataContext tc_name -> mkSimpleDecorated $ - text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) - TcRnMultipleConForNewtype tycon n -> mkSimpleDecorated $ - sep [text "A newtype must have exactly one constructor,", - nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n] - TcRnKindSignaturesDisabled thing -> mkSimpleDecorated $ - text "Illegal kind signature" <+> quotes (either ppr with_sig thing) - where - with_sig (tc_name, ksig) = ppr tc_name <+> dcolon <+> ppr ksig - TcRnEmptyDataDeclsDisabled tycon -> mkSimpleDecorated $ - quotes (ppr tycon) <+> text "has no constructors" - TcRnRoleMismatch var annot inferred -> mkSimpleDecorated $ - hang (text "Role mismatch on variable" <+> ppr var <> colon) - 2 (sep [ text "Annotation says", ppr annot - , text "but role", ppr inferred - , text "is required" ]) - TcRnRoleCountMismatch tyvars d@(L _ (RoleAnnotDecl _ _ annots)) -> mkSimpleDecorated $ - hang (text "Wrong number of roles listed in role annotation;" $$ - text "Expected" <+> (ppr tyvars) <> comma <+> - text "got" <+> (ppr $ length annots) <> colon) - 2 (ppr d) - TcRnIllegalRoleAnnotation (RoleAnnotDecl _ tycon _) -> mkSimpleDecorated $ - (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ - text "they are allowed only for datatypes and classes.") - TcRnRoleAnnotationsDisabled tc -> mkSimpleDecorated $ - text "Illegal role annotation for" <+> ppr tc - TcRnIncoherentRoles _ -> mkSimpleDecorated $ - (text "Roles other than" <+> quotes (text "nominal") <+> - text "for class parameters can lead to incoherence.") - TcRnUnexpectedKindVar tv_name - -> mkSimpleDecorated $ text "Unexpected kind variable" <+> quotes (ppr tv_name) - - TcRnNegativeNumTypeLiteral tyLit - -> mkSimpleDecorated $ text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit - - TcRnIllegalKind ty_thing _ - -> mkSimpleDecorated $ text "Illegal kind:" <+> (ppr ty_thing) - - TcRnPrecedenceParsingError op1 op2 - -> mkSimpleDecorated $ - hang (text "Precedence parsing error") - 4 (hsep [text "cannot mix", ppr_opfix op1, text "and", - ppr_opfix op2, - text "in the same infix expression"]) - - TcRnSectionPrecedenceError op arg_op section - -> mkSimpleDecorated $ - vcat [text "The operator" <+> ppr_opfix op <+> text "of a section", - nest 4 (sep [text "must have lower precedence than that of the operand,", - nest 2 (text "namely" <+> ppr_opfix arg_op)]), - nest 4 (text "in the section:" <+> quotes (ppr section))] - - TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") - - TcRnIllegalKindSignature ty - -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) - - TcRnUnusedQuantifiedTypeVar doc tyVar - -> mkSimpleDecorated $ - vcat [ text "Unused quantified type variable" <+> quotes (ppr tyVar) - , inHsDocContext doc ] - - TcRnDataKindsError typeOrKind thing - -- See Note [Checking for DataKinds] (Wrinkle: Migration story for - -- DataKinds typechecker errors) in GHC.Tc.Validity for why we give - -- different diagnostic messages below. - -> case thing of - Left renamer_thing -> - mkSimpleDecorated $ - text "Illegal" <+> ppr_level <> colon <+> quotes (ppr renamer_thing) - Right typechecker_thing -> - mkSimpleDecorated $ vcat - [ text "An occurrence of" <+> quotes (ppr typechecker_thing) <+> - text "in a" <+> ppr_level <+> text "requires DataKinds." - , text "Future versions of GHC will turn this warning into an error." - ] - where - ppr_level = text $ levelString typeOrKind - - TcRnTypeSynonymCycle decl_or_tcs - -> mkSimpleDecorated $ - sep [ text "Cycle in type synonym declarations:" - , nest 2 (vcat (map ppr_decl decl_or_tcs)) ] - where - ppr_decl = \case - Right (L loc decl) -> ppr (locA loc) <> colon <+> ppr decl - Left tc -> - let n = tyConName tc - in ppr (getSrcSpan n) <> colon <+> ppr (tyConName tc) - <+> text "from external module" - TcRnZonkerMessage err - -> mkSimpleDecorated $ pprZonkerMessage err - TcRnInterfaceError reason - -> diagnosticMessage (tcOptsIfaceOpts opts) reason - TcRnSelfImport imp_mod_name - -> mkSimpleDecorated $ - text "A module cannot import itself:" <+> ppr imp_mod_name - TcRnNoExplicitImportList mod - -> mkSimpleDecorated $ - text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" - TcRnSafeImportsDisabled _ - -> mkSimpleDecorated $ - text "safe import can't be used as Safe Haskell isn't on!" - TcRnDeprecatedModule mod txt - -> mkSimpleDecorated $ - sep [ text "Module" <+> quotes (ppr mod) <> text extra <> colon, - nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ] - where - (extra, msg) = case txt of - WarningTxt _ _ msg -> ("", msg) - DeprecatedTxt _ msg -> (" is deprecated", msg) - TcRnRedundantSourceImport mod_name - -> mkSimpleDecorated $ - text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) - TcRnImportLookup reason - -> mkSimpleDecorated $ - pprImportLookup reason - TcRnUnusedImport decl reason - -> mkSimpleDecorated $ - pprUnusedImport decl reason - TcRnDuplicateDecls name sorted_names - -> mkSimpleDecorated $ - vcat [text "Multiple declarations of" <+> - quotes (ppr name), - -- NB. print the OccName, not the Name, because the - -- latter might not be in scope in the RdrEnv and so will - -- be printed qualified. - text "Declared at:" <+> - vcat (NE.toList $ ppr . nameSrcLoc <$> sorted_names)] - TcRnPackageImportsDisabled - -> mkSimpleDecorated $ - text "Package-qualified imports are not enabled" - TcRnIllegalDataCon name - -> mkSimpleDecorated $ - hsep [text "Illegal data constructor name", quotes (ppr name)] - TcRnNestedForallsContexts entity - -> mkSimpleDecorated $ - what <+> text "cannot contain nested" - <+> quotes forAllLit <> text "s or contexts" - where - what = case entity of - NFC_Specialize -> text "SPECIALISE instance type" - NFC_ViaType -> quotes (text "via") <+> text "type" - NFC_GadtConSig -> text "GADT constructor type signature" - NFC_InstanceHead -> text "Instance head" - NFC_StandaloneDerivedInstanceHead -> text "Standalone-derived instance head" - NFC_DerivedClassType -> text "Derived class type" - TcRnRedundantRecordWildcard - -> mkSimpleDecorated $ - text "Record wildcard does not bind any new variables" - TcRnUnusedRecordWildcard _ - -> mkSimpleDecorated $ - text "No variables bound in the record wildcard match are used" - TcRnUnusedName name reason - -> mkSimpleDecorated $ - pprUnusedName name reason - TcRnQualifiedBinder rdr_name - -> mkSimpleDecorated $ - text "Qualified name in binding position:" <+> ppr rdr_name - TcRnTypeApplicationsDisabled ty_app - -> mkSimpleDecorated $ - text "Illegal visible" <+> what <+> text "application" <+> ctx <> colon - <+> ppr arg - where - arg = case ty_app of - TypeApplication ty _ -> char '@' <> ppr ty - TypeApplicationInPattern ty_app -> ppr ty_app - what = case ty_app of - TypeApplication _ ty_or_ki -> - case ty_or_ki of - TypeLevel -> text "type" - KindLevel -> text "kind" - TypeApplicationInPattern _ -> text "type" - ctx = case ty_app of - TypeApplicationInPattern _ -> text "in a pattern" - _ -> empty - TcRnInvalidRecordField con field - -> mkSimpleDecorated $ - hsep [text "Constructor" <+> quotes (ppr con), - text "does not have field", quotes (ppr field)] - TcRnTupleTooLarge tup_size - -> mkSimpleDecorated $ - sep [text "A" <+> int tup_size <> text "-tuple is too large for GHC", - nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), - nest 2 (text "Workaround: use nested tuples or define a data type")] - TcRnCTupleTooLarge tup_size - -> mkSimpleDecorated $ - hang (text "Constraint tuple arity too large:" <+> int tup_size - <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) - 2 (text "Instead, use a nested tuple") - TcRnIllegalInferredTyVars _ - -> mkSimpleDecorated $ - text "Inferred type variables are not allowed" - TcRnAmbiguousName gre_env name gres - -> mkSimpleDecorated $ - vcat [ text "Ambiguous occurrence" <+> quotes (ppr name) <> dot - , text "It could refer to" - , nest 3 (vcat msgs) ] - where - np1 NE.:| nps = gres - msgs = punctuateFinal comma dot $ - text "either" <+> ppr_gre np1 - : [text " or" <+> ppr_gre np | np <- nps] - - ppr_gre gre = pprAmbiguousGreName gre_env gre - - TcRnBindingNameConflict name locs - -> mkSimpleDecorated $ - vcat [text "Conflicting definitions for" <+> quotes (ppr name), - locations] - where - locations = - text "Bound at:" - <+> vcat (map ppr (sortBy leftmost_smallest (NE.toList locs))) - TcRnNonCanonicalDefinition reason inst_ty - -> mkSimpleDecorated $ - pprNonCanonicalDefinition inst_ty reason - TcRnDefaultedExceptionContext ct_loc -> - mkSimpleDecorated $ vcat [ header, warning, proposal ] - where - header, warning, proposal :: SDoc - header - = vcat [ text "Solving for an implicit ExceptionContext constraint" - , nest 2 $ pprCtOrigin (ctLocOrigin ct_loc) <> text "." ] - warning - = vcat [ text "Future versions of GHC will turn this warning into an error." ] - proposal - = vcat [ text "See GHC Proposal #330." ] - TcRnImplicitImportOfPrelude - -> mkSimpleDecorated $ - text "Module" <+> quotes (text "Prelude") <+> text "implicitly imported." - TcRnMissingMain explicit_export_list main_mod main_occ - -> mkSimpleDecorated $ - text "The" <+> ppMainFn main_occ - <+> text "is not" <+> defOrExp <+> text "module" - <+> quotes (ppr main_mod) - where - defOrExp :: SDoc - defOrExp | explicit_export_list = text "exported by" - | otherwise = text "defined in" - TcRnGhciUnliftedBind id - -> mkSimpleDecorated $ - sep [ text "GHCi can't bind a variable of unlifted type:" - , nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id)) ] - TcRnGhciMonadLookupFail ty lookups - -> mkSimpleDecorated $ - hang (text "Can't find type" <+> pp_ty <> dot $$ ambig_msg) - 2 (text "When checking that" <+> pp_ty <> - text "is a monad that can execute GHCi statements.") - where - pp_ty = quotes (text ty) - ambig_msg = case lookups of - Just (_:_:_) -> text "The type is ambiguous." - _ -> empty - TcRnIllegalQuasiQuotes -> mkSimpleDecorated $ - text "Quasi-quotes are not permitted without QuasiQuotes" - TcRnTHError err -> pprTHError err - TcRnPatersonCondFailure reason ctxt lhs rhs -> - mkSimpleDecorated $ pprPatersonCondFailure reason ctxt lhs rhs - TcRnIllegalInvisTyVarBndr bndr -> - mkSimpleDecorated $ - hang (text "Illegal invisible type variable binder:") - 2 (ppr bndr) - TcRnIllegalWildcardTyVarBndr bndr -> - mkSimpleDecorated $ - hang (text "Illegal wildcard binder:") - 2 (ppr bndr) - - TcRnInvalidInvisTyVarBndr name hs_bndr -> - mkSimpleDecorated $ - vcat [ hang (text "Invalid invisible type variable binder:") - 2 (ppr hs_bndr) - , text "There is no matching forall-bound variable" - , text "in the standalone kind signature for" <+> quotes (ppr name) <> dot - , note $ vcat [ - "Only" <+> quotes "forall a." <+> "-quantification matches invisible binders,", - "whereas" <+> quotes "forall {a}." <+> "and" <+> quotes "forall a ->" <+> "do not" - ]] - - TcRnDeprecatedInvisTyArgInConPat -> - mkSimpleDecorated $ - cat [ text "Type applications in constructor patterns will require" - , text "the TypeAbstractions extension starting from GHC 9.14." ] - - TcRnInvisBndrWithoutSig _ hs_bndr -> - mkSimpleDecorated $ - vcat [ hang (text "Invalid invisible type variable binder:") - 2 (ppr hs_bndr) - , text "Either a standalone kind signature (SAKS)" - , text "or a complete user-supplied kind (CUSK, legacy feature)" - , text "is required to use invisible binders." ] - - TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ - vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" - , text "In the future GHC will no longer implicitly quantify over such variables" - ] - - TcRnInvalidDefaultedTyVar wanteds proposal bad_tvs -> - mkSimpleDecorated $ - pprWithInvisibleBitsWhen True $ - vcat [ text "Invalid defaulting proposal." - , hang (text "The following type variable" <> plural (NE.toList bad_tvs) <+> text "cannot be defaulted, as" <+> why <> colon) - 2 (pprQuotedList (NE.toList bad_tvs)) - , hang (text "Defaulting proposal:") - 2 (ppr proposal) - , hang (text "Wanted constraints:") - 2 (pprQuotedList (map ctPred wanteds)) - ] - where - why - | _ :| [] <- bad_tvs - = text "it is not an unfilled metavariable" - | otherwise - = text "they are not unfilled metavariables" - - TcRnNamespacedWarningPragmaWithoutFlag warning@(Warning (kw, _) _ txt) -> mkSimpleDecorated $ - vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:" - , nest 2 (ppr warning) - , text "in a" <+> pragma_type <+> text "pragma" - ] - where - pragma_type = case txt of - WarningTxt{} -> text "WARNING" - DeprecatedTxt{} -> text "DEPRECATED" - - TcRnIllegalInvisibleTypePattern tp -> mkSimpleDecorated $ - text "Illegal invisible type pattern:" <+> ppr tp - - TcRnInvisPatWithNoForAll tp -> mkSimpleDecorated $ - text "Invisible type pattern" <+> ppr tp <+> text "has no associated forall" - - TcRnNamespacedFixitySigWithoutFlag sig@(FixitySig kw _ _) -> mkSimpleDecorated $ - vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:" - , nest 2 (ppr sig) - , text "in a fixity signature" - ] - - TcRnOutOfArityTyVar ts_name tv_name -> mkDecorated - [ vcat [ text "The arity of" <+> quotes (ppr ts_name) <+> text "is insufficiently high to accommodate" - , text "an implicit binding for the" <+> quotes (ppr tv_name) <+> text "type variable." ] - , suggestion ] - where - suggestion = - text "Use" <+> quotes at_bndr <+> text "on the LHS" <+> - text "or" <+> quotes forall_bndr <+> text "on the RHS" <+> - text "to bring it into scope." - at_bndr = char '@' <> ppr tv_name - forall_bndr = text "forall" <+> ppr tv_name <> text "." - - TcRnMisplacedInvisPat tp -> mkSimpleDecorated $ - text "Invisible type pattern" <+> ppr tp <+> text "is not allowed here" - - TcRnUnexpectedTypeSyntaxInTerms syntax -> mkSimpleDecorated $ - text "Unexpected" <+> pprTypeSyntaxName syntax - - diagnosticReason :: TcRnMessage -> DiagnosticReason - diagnosticReason = \case - TcRnUnknownMessage m - -> diagnosticReason m - TcRnMessageWithInfo _ msg_with_info - -> case msg_with_info of - TcRnMessageDetailed _ m -> diagnosticReason m - TcRnWithHsDocContext _ msg - -> diagnosticReason msg - TcRnSolverReport _ reason - -> reason -- Error, or a Warning if we are deferring type errors - TcRnSolverDepthError {} - -> ErrorWithoutFlag - TcRnRedundantConstraints {} - -> WarningWithFlag Opt_WarnRedundantConstraints - TcRnInaccessibleCode {} - -> WarningWithFlag Opt_WarnInaccessibleCode - TcRnInaccessibleCoAxBranch {} - -> WarningWithFlag Opt_WarnInaccessibleCode - TcRnTypeDoesNotHaveFixedRuntimeRep{} - -> ErrorWithoutFlag - TcRnImplicitLift{} - -> WarningWithFlag Opt_WarnImplicitLift - TcRnUnusedPatternBinds{} - -> WarningWithFlag Opt_WarnUnusedPatternBinds - TcRnDodgyImports{} - -> WarningWithFlag Opt_WarnDodgyImports - TcRnDodgyExports{} - -> WarningWithFlag Opt_WarnDodgyExports - TcRnMissingImportList{} - -> WarningWithFlag Opt_WarnMissingImportList - TcRnUnsafeDueToPlugin{} - -> WarningWithoutFlag - TcRnModMissingRealSrcSpan{} - -> ErrorWithoutFlag - TcRnIdNotExportedFromModuleSig{} - -> ErrorWithoutFlag - TcRnIdNotExportedFromLocalSig{} - -> ErrorWithoutFlag - TcRnShadowedName{} - -> WarningWithFlag Opt_WarnNameShadowing - TcRnInvalidWarningCategory{} - -> ErrorWithoutFlag - TcRnDuplicateWarningDecls{} - -> ErrorWithoutFlag - TcRnSimplifierTooManyIterations{} - -> ErrorWithoutFlag - TcRnIllegalPatSynDecl{} - -> ErrorWithoutFlag - TcRnLinearPatSyn{} - -> ErrorWithoutFlag - TcRnEmptyRecordUpdate - -> ErrorWithoutFlag - TcRnIllegalFieldPunning{} - -> ErrorWithoutFlag - TcRnIllegalWildcardsInRecord{} - -> ErrorWithoutFlag - TcRnIllegalWildcardInType{} - -> ErrorWithoutFlag - TcRnIllegalNamedWildcardInTypeArgument{} - -> ErrorWithoutFlag - TcRnIllegalImplicitTyVarInTypeArgument{} - -> ErrorWithoutFlag - TcRnDuplicateFieldName{} - -> ErrorWithoutFlag - TcRnIllegalViewPattern{} - -> ErrorWithoutFlag - TcRnCharLiteralOutOfRange{} - -> ErrorWithoutFlag - TcRnIllegalWildcardsInConstructor{} - -> ErrorWithoutFlag - TcRnIgnoringAnnotations{} - -> WarningWithoutFlag - TcRnAnnotationInSafeHaskell - -> ErrorWithoutFlag - TcRnInvalidTypeApplication{} - -> ErrorWithoutFlag - TcRnTagToEnumMissingValArg - -> ErrorWithoutFlag - TcRnTagToEnumUnspecifiedResTy{} - -> ErrorWithoutFlag - TcRnTagToEnumResTyNotAnEnum{} - -> ErrorWithoutFlag - TcRnTagToEnumResTyTypeData{} - -> ErrorWithoutFlag - TcRnArrowIfThenElsePredDependsOnResultTy - -> ErrorWithoutFlag - TcRnIllegalHsBootOrSigDecl {} - -> ErrorWithoutFlag - TcRnBootMismatch {} - -> ErrorWithoutFlag - TcRnRecursivePatternSynonym{} - -> ErrorWithoutFlag - TcRnPartialTypeSigTyVarMismatch{} - -> ErrorWithoutFlag - TcRnPartialTypeSigBadQuantifier{} - -> ErrorWithoutFlag - TcRnMissingSignature what exported - -> WarningWithFlags $ missingSignatureWarningFlags what exported - TcRnPolymorphicBinderMissingSig{} - -> WarningWithFlag Opt_WarnMissingLocalSignatures - TcRnOverloadedSig{} - -> ErrorWithoutFlag - TcRnTupleConstraintInst{} - -> ErrorWithoutFlag - TcRnUserTypeError{} - -> ErrorWithoutFlag - TcRnConstraintInKind{} - -> ErrorWithoutFlag - TcRnUnboxedTupleOrSumTypeFuncArg{} - -> ErrorWithoutFlag - TcRnLinearFuncInKind{} - -> ErrorWithoutFlag - TcRnForAllEscapeError{} - -> ErrorWithoutFlag - TcRnSimplifiableConstraint{} - -> WarningWithFlag Opt_WarnSimplifiableClassConstraints - TcRnArityMismatch{} - -> ErrorWithoutFlag - TcRnIllegalInstance rea - -> illegalInstanceReason rea - TcRnVDQInTermType{} - -> ErrorWithoutFlag - TcRnBadQuantPredHead{} - -> ErrorWithoutFlag - TcRnIllegalTupleConstraint{} - -> ErrorWithoutFlag - TcRnNonTypeVarArgInConstraint{} - -> ErrorWithoutFlag - TcRnIllegalImplicitParam{} - -> ErrorWithoutFlag - TcRnIllegalConstraintSynonymOfKind{} - -> ErrorWithoutFlag - TcRnOversaturatedVisibleKindArg{} - -> ErrorWithoutFlag - TcRnForAllRankErr{} - -> ErrorWithoutFlag - TcRnMonomorphicBindings{} - -> WarningWithFlag Opt_WarnMonomorphism - TcRnOrphanInstance{} - -> WarningWithFlag Opt_WarnOrphans - TcRnFunDepConflict{} - -> ErrorWithoutFlag - TcRnDupInstanceDecls{} - -> ErrorWithoutFlag - TcRnConflictingFamInstDecls{} - -> ErrorWithoutFlag - TcRnFamInstNotInjective{} - -> ErrorWithoutFlag - TcRnBangOnUnliftedType{} - -> WarningWithFlag Opt_WarnRedundantStrictnessFlags - TcRnLazyBangOnUnliftedType{} - -> WarningWithFlag Opt_WarnRedundantStrictnessFlags - TcRnMultipleDefaultDeclarations{} - -> ErrorWithoutFlag - TcRnBadDefaultType{} - -> ErrorWithoutFlag - TcRnPatSynBundledWithNonDataCon{} - -> ErrorWithoutFlag - TcRnPatSynBundledWithWrongType{} - -> ErrorWithoutFlag - TcRnDupeModuleExport{} - -> WarningWithFlag Opt_WarnDuplicateExports - TcRnExportedModNotImported{} - -> ErrorWithoutFlag - TcRnNullExportedModule{} - -> WarningWithFlag Opt_WarnDodgyExports - TcRnMissingExportList{} - -> WarningWithFlag Opt_WarnMissingExportList - TcRnExportHiddenComponents{} - -> ErrorWithoutFlag - TcRnExportHiddenDefault{} - -> ErrorWithoutFlag - TcRnDuplicateExport{} - -> WarningWithFlag Opt_WarnDuplicateExports - TcRnExportedParentChildMismatch{} - -> ErrorWithoutFlag - TcRnConflictingExports{} - -> ErrorWithoutFlag - TcRnDuplicateFieldExport {} - -> ErrorWithoutFlag - TcRnAmbiguousFieldInUpdate {} - -> ErrorWithoutFlag - TcRnAmbiguousRecordUpdate{} - -> WarningWithFlag Opt_WarnAmbiguousFields - TcRnMissingFields{} - -> WarningWithFlag Opt_WarnMissingFields - TcRnFieldUpdateInvalidType{} - -> ErrorWithoutFlag - TcRnMissingStrictFields{} - -> ErrorWithoutFlag - TcRnBadRecordUpdate{} - -> ErrorWithoutFlag - TcRnIllegalStaticExpression {} - -> ErrorWithoutFlag - TcRnStaticFormNotClosed{} - -> ErrorWithoutFlag - TcRnUselessTypeable - -> WarningWithFlag Opt_WarnDerivingTypeable - TcRnDerivingDefaults{} - -> WarningWithFlag Opt_WarnDerivingDefaults - TcRnNonUnaryTypeclassConstraint{} - -> ErrorWithoutFlag - TcRnPartialTypeSignatures{} - -> WarningWithFlag Opt_WarnPartialTypeSignatures - TcRnCannotDeriveInstance _ _ _ _ rea - -> case rea of - DerivErrNotWellKinded{} -> ErrorWithoutFlag - DerivErrSafeHaskellGenericInst -> ErrorWithoutFlag - DerivErrDerivingViaWrongKind{} -> ErrorWithoutFlag - DerivErrNoEtaReduce{} -> ErrorWithoutFlag - DerivErrBootFileFound -> ErrorWithoutFlag - DerivErrDataConsNotAllInScope{} -> ErrorWithoutFlag - DerivErrGNDUsedOnData -> ErrorWithoutFlag - DerivErrNullaryClasses -> ErrorWithoutFlag - DerivErrLastArgMustBeApp -> ErrorWithoutFlag - DerivErrNoFamilyInstance{} -> ErrorWithoutFlag - DerivErrNotStockDeriveable{} -> ErrorWithoutFlag - DerivErrHasAssociatedDatatypes{} -> ErrorWithoutFlag - DerivErrNewtypeNonDeriveableClass -> ErrorWithoutFlag - DerivErrCannotEtaReduceEnough{} -> ErrorWithoutFlag - DerivErrOnlyAnyClassDeriveable{} -> ErrorWithoutFlag - DerivErrNotDeriveable{} -> ErrorWithoutFlag - DerivErrNotAClass{} -> ErrorWithoutFlag - DerivErrNoConstructors{} -> ErrorWithoutFlag - DerivErrLangExtRequired{} -> ErrorWithoutFlag - DerivErrDunnoHowToDeriveForType{} -> ErrorWithoutFlag - DerivErrMustBeEnumType{} -> ErrorWithoutFlag - DerivErrMustHaveExactlyOneConstructor{} -> ErrorWithoutFlag - DerivErrMustHaveSomeParameters{} -> ErrorWithoutFlag - DerivErrMustNotHaveClassContext{} -> ErrorWithoutFlag - DerivErrBadConstructor{} -> ErrorWithoutFlag - DerivErrGenerics{} -> ErrorWithoutFlag - DerivErrEnumOrProduct{} -> ErrorWithoutFlag - TcRnLookupInstance _ _ _ - -> ErrorWithoutFlag - TcRnLazyGADTPattern - -> ErrorWithoutFlag - TcRnArrowProcGADTPattern - -> ErrorWithoutFlag - TcRnTypeEqualityOutOfScope - -> WarningWithFlag Opt_WarnTypeEqualityOutOfScope - TcRnTypeEqualityRequiresOperators - -> WarningWithFlag Opt_WarnTypeEqualityRequiresOperators - TcRnIllegalTypeOperator {} - -> ErrorWithoutFlag - TcRnIllegalTypeOperatorDecl {} - -> ErrorWithoutFlag - TcRnGADTMonoLocalBinds {} - -> WarningWithFlag Opt_WarnGADTMonoLocalBinds - TcRnIncorrectNameSpace {} - -> ErrorWithoutFlag - TcRnNotInScope {} - -> ErrorWithoutFlag - TcRnTermNameInType {} - -> ErrorWithoutFlag - TcRnUntickedPromotedThing {} - -> WarningWithFlag Opt_WarnUntickedPromotedConstructors - TcRnIllegalBuiltinSyntax {} - -> ErrorWithoutFlag - TcRnWarnDefaulting {} - -> WarningWithFlag Opt_WarnTypeDefaults - TcRnWarnClashingDefaultImports {} - -> WarningWithFlag Opt_WarnTypeDefaults - TcRnForeignImportPrimExtNotSet{} - -> ErrorWithoutFlag - TcRnForeignImportPrimSafeAnn{} - -> ErrorWithoutFlag - TcRnForeignFunctionImportAsValue{} - -> ErrorWithoutFlag - TcRnFunPtrImportWithoutAmpersand{} - -> WarningWithFlag Opt_WarnDodgyForeignImports - TcRnIllegalForeignDeclBackend{} - -> ErrorWithoutFlag - TcRnUnsupportedCallConv _ unsupportedCC - -> case unsupportedCC of - StdCallConvUnsupported -> WarningWithFlag Opt_WarnUnsupportedCallingConventions - _ -> ErrorWithoutFlag - TcRnIllegalForeignType{} - -> ErrorWithoutFlag - TcRnInvalidCIdentifier{} - -> ErrorWithoutFlag - TcRnExpectedValueId{} - -> ErrorWithoutFlag - TcRnRecSelectorEscapedTyVar{} - -> ErrorWithoutFlag - TcRnPatSynNotBidirectional{} - -> ErrorWithoutFlag - TcRnIllegalDerivingItem{} - -> ErrorWithoutFlag - TcRnIllegalDefaultClass{} - -> ErrorWithoutFlag - TcRnIllegalNamedDefault{} - -> ErrorWithoutFlag - TcRnUnexpectedAnnotation{} - -> ErrorWithoutFlag - TcRnIllegalRecordSyntax{} - -> ErrorWithoutFlag - TcRnInvalidVisibleKindArgument{} - -> ErrorWithoutFlag - TcRnTooManyBinders{} - -> ErrorWithoutFlag - TcRnDifferentNamesForTyVar{} - -> ErrorWithoutFlag - TcRnDisconnectedTyVar{} - -> ErrorWithoutFlag - TcRnInvalidReturnKind{} - -> ErrorWithoutFlag - TcRnClassKindNotConstraint{} - -> ErrorWithoutFlag - TcRnUnpromotableThing{} - -> ErrorWithoutFlag - TcRnIllegalTermLevelUse{} - -> ErrorWithoutFlag - TcRnMatchesHaveDiffNumArgs{} - -> ErrorWithoutFlag - TcRnCannotBindScopedTyVarInPatSig{} - -> ErrorWithoutFlag - TcRnCannotBindTyVarsInPatBind{} - -> ErrorWithoutFlag - TcRnTooManyTyArgsInConPattern{} - -> ErrorWithoutFlag - TcRnMultipleInlinePragmas{} - -> WarningWithoutFlag - TcRnUnexpectedPragmas{} - -> WarningWithoutFlag - TcRnNonOverloadedSpecialisePragma{} - -> WarningWithoutFlag - TcRnSpecialiseNotVisible{} - -> WarningWithoutFlag - TcRnPragmaWarning{pragma_warning_msg} - -> WarningWithCategory (warningTxtCategory pragma_warning_msg) - TcRnDifferentExportWarnings _ _ - -> ErrorWithoutFlag - TcRnIncompleteExportWarnings _ _ - -> WarningWithFlag Opt_WarnIncompleteExportWarnings - TcRnIllegalHsigDefaultMethods{} - -> ErrorWithoutFlag - TcRnHsigFixityMismatch{} - -> ErrorWithoutFlag - TcRnHsigShapeMismatch{} - -> ErrorWithoutFlag - TcRnHsigMissingModuleExport{} - -> ErrorWithoutFlag - TcRnBadGenericMethod{} - -> ErrorWithoutFlag - TcRnWarningMinimalDefIncomplete{} - -> WarningWithoutFlag - TcRnDefaultMethodForPragmaLacksBinding{} - -> ErrorWithoutFlag - TcRnIgnoreSpecialisePragmaOnDefMethod{} - -> WarningWithoutFlag - TcRnBadMethodErr{} - -> ErrorWithoutFlag - TcRnIllegalTypeData - -> ErrorWithoutFlag - TcRnIllegalQuasiQuotes{} - -> ErrorWithoutFlag - TcRnTHError err - -> thErrorReason err - TcRnTypeDataForbids{} - -> ErrorWithoutFlag - TcRnIllegalNewtype{} - -> ErrorWithoutFlag - TcRnOrPatBindsVariables{} - -> ErrorWithoutFlag - TcRnUnsatisfiedMinimalDef{} - -> WarningWithFlag (Opt_WarnMissingMethods) - TcRnMisplacedInstSig{} - -> ErrorWithoutFlag - TcRnNoRebindableSyntaxRecordDot{} - -> ErrorWithoutFlag - TcRnNoFieldPunsRecordDot{} - -> ErrorWithoutFlag - TcRnListComprehensionDuplicateBinding{} - -> ErrorWithoutFlag - TcRnEmptyStmtsGroup{} - -> ErrorWithoutFlag - TcRnLastStmtNotExpr{} - -> ErrorWithoutFlag - TcRnUnexpectedStatementInContext{} - -> ErrorWithoutFlag - TcRnSectionWithoutParentheses{} - -> ErrorWithoutFlag - TcRnIllegalImplicitParameterBindings{} - -> ErrorWithoutFlag - TcRnIllegalTupleSection{} - -> ErrorWithoutFlag - TcRnCapturedTermName{} - -> WarningWithFlag Opt_WarnTermVariableCapture - TcRnBindingOfExistingName{} - -> ErrorWithoutFlag - TcRnMultipleFixityDecls{} - -> ErrorWithoutFlag - TcRnIllegalPatternSynonymDecl{} - -> ErrorWithoutFlag - TcRnIllegalClassBinding{} - -> ErrorWithoutFlag - TcRnOrphanCompletePragma{} - -> ErrorWithoutFlag - TcRnEmptyCase{} - -> ErrorWithoutFlag - TcRnNonStdGuards{} - -> WarningWithoutFlag - TcRnDuplicateSigDecl{} - -> ErrorWithoutFlag - TcRnMisplacedSigDecl{} - -> ErrorWithoutFlag - TcRnUnexpectedDefaultSig{} - -> ErrorWithoutFlag - TcRnDuplicateMinimalSig{} - -> ErrorWithoutFlag - TcRnUnexpectedStandaloneDerivingDecl{} - -> ErrorWithoutFlag - TcRnUnusedVariableInRuleDecl{} - -> ErrorWithoutFlag - TcRnUnexpectedStandaloneKindSig{} - -> ErrorWithoutFlag - TcRnIllegalRuleLhs{} - -> ErrorWithoutFlag - TcRnDuplicateRoleAnnot{} - -> ErrorWithoutFlag - TcRnDuplicateKindSig{} - -> ErrorWithoutFlag - TcRnIllegalDerivStrategy{} - -> ErrorWithoutFlag - TcRnIllegalMultipleDerivClauses{} - -> ErrorWithoutFlag - TcRnNoDerivStratSpecified{} - -> WarningWithFlag Opt_WarnMissingDerivingStrategies - TcRnStupidThetaInGadt{} - -> ErrorWithoutFlag - TcRnShadowedTyVarNameInFamResult{} - -> ErrorWithoutFlag - TcRnIncorrectTyVarOnLhsOfInjCond{} - -> ErrorWithoutFlag - TcRnUnknownTyVarsOnRhsOfInjCond{} - -> ErrorWithoutFlag - TcRnBadlyStaged{} - -> ErrorWithoutFlag - TcRnBadlyStagedType{} - -> WarningWithFlag Opt_WarnBadlyStagedTypes - TcRnStageRestriction{} - -> ErrorWithoutFlag - TcRnTyThingUsedWrong{} - -> ErrorWithoutFlag - TcRnCannotDefaultKindVar{} - -> ErrorWithoutFlag - TcRnUninferrableTyVar{} - -> ErrorWithoutFlag - TcRnSkolemEscape{} - -> ErrorWithoutFlag - TcRnPatSynEscapedCoercion{} - -> ErrorWithoutFlag - TcRnPatSynExistentialInResult{} - -> ErrorWithoutFlag - TcRnPatSynArityMismatch{} - -> ErrorWithoutFlag - TcRnPatSynInvalidRhs{} - -> ErrorWithoutFlag - TcRnTyFamDepsDisabled{} - -> ErrorWithoutFlag - TcRnAbstractClosedTyFamDecl{} - -> ErrorWithoutFlag - TcRnPartialFieldSelector{} - -> WarningWithFlag Opt_WarnPartialFields - TcRnHasFieldResolvedIncomplete{} - -> WarningWithFlag Opt_WarnIncompleteRecordSelectors - TcRnBadFieldAnnotation _ _ LazyFieldsDisabled - -> ErrorWithoutFlag - TcRnBadFieldAnnotation{} - -> WarningWithoutFlag - TcRnSuperclassCycle{} - -> ErrorWithoutFlag - TcRnDefaultSigMismatch{} - -> ErrorWithoutFlag - TcRnTyFamsDisabled{} - -> ErrorWithoutFlag - TcRnBadTyConTelescope {} - -> ErrorWithoutFlag - TcRnTyFamResultDisabled{} - -> ErrorWithoutFlag - TcRnRoleValidationFailed{} - -> ErrorWithoutFlag - TcRnCommonFieldResultTypeMismatch{} - -> ErrorWithoutFlag - TcRnCommonFieldTypeMismatch{} - -> ErrorWithoutFlag - TcRnClassExtensionDisabled{} - -> ErrorWithoutFlag - TcRnDataConParentTypeMismatch{} - -> ErrorWithoutFlag - TcRnGADTsDisabled{} - -> ErrorWithoutFlag - TcRnExistentialQuantificationDisabled{} - -> ErrorWithoutFlag - TcRnGADTDataContext{} - -> ErrorWithoutFlag - TcRnMultipleConForNewtype{} - -> ErrorWithoutFlag - TcRnKindSignaturesDisabled{} - -> ErrorWithoutFlag - TcRnEmptyDataDeclsDisabled{} - -> ErrorWithoutFlag - TcRnRoleMismatch{} - -> ErrorWithoutFlag - TcRnRoleCountMismatch{} - -> ErrorWithoutFlag - TcRnIllegalRoleAnnotation{} - -> ErrorWithoutFlag - TcRnRoleAnnotationsDisabled{} - -> ErrorWithoutFlag - TcRnIncoherentRoles{} - -> ErrorWithoutFlag - TcRnUnexpectedKindVar{} - -> ErrorWithoutFlag - TcRnNegativeNumTypeLiteral{} - -> ErrorWithoutFlag - TcRnIllegalKind{} - -> ErrorWithoutFlag - TcRnPrecedenceParsingError{} - -> ErrorWithoutFlag - TcRnSectionPrecedenceError{} - -> ErrorWithoutFlag - TcRnUnexpectedPatSigType{} - -> ErrorWithoutFlag - TcRnIllegalKindSignature{} - -> ErrorWithoutFlag - TcRnUnusedQuantifiedTypeVar{} - -> WarningWithFlag Opt_WarnUnusedForalls - TcRnDataKindsError _ thing - -- DataKinds errors can arise from either the renamer (Left) or the - -- typechecker (Right). The latter category of DataKinds errors are a - -- fairly recent addition to GHC (introduced in GHC 9.10), and in order - -- to prevent these new errors from breaking users' code, we temporarily - -- downgrade these errors to warnings. See Note [Checking for DataKinds] - -- (Wrinkle: Migration story for DataKinds typechecker errors) - -- in GHC.Tc.Validity. - -> case thing of - Left _ -> ErrorWithoutFlag - Right _ -> WarningWithFlag Opt_WarnDataKindsTC - TcRnTypeSynonymCycle{} - -> ErrorWithoutFlag - TcRnZonkerMessage msg - -> zonkerMessageReason msg - TcRnInterfaceError err - -> interfaceErrorReason err - TcRnSelfImport{} - -> ErrorWithoutFlag - TcRnNoExplicitImportList{} - -> WarningWithFlag Opt_WarnMissingImportList - TcRnSafeImportsDisabled{} - -> ErrorWithoutFlag - TcRnDeprecatedModule _ txt - -> WarningWithCategory (warningTxtCategory txt) - TcRnRedundantSourceImport{} - -> WarningWithoutFlag - TcRnImportLookup{} - -> ErrorWithoutFlag - TcRnUnusedImport{} - -> WarningWithFlag Opt_WarnUnusedImports - TcRnDuplicateDecls{} - -> ErrorWithoutFlag - TcRnPackageImportsDisabled - -> ErrorWithoutFlag - TcRnIllegalDataCon{} - -> ErrorWithoutFlag - TcRnNestedForallsContexts{} - -> ErrorWithoutFlag - TcRnRedundantRecordWildcard - -> WarningWithFlag Opt_WarnRedundantRecordWildcards - TcRnUnusedRecordWildcard{} - -> WarningWithFlag Opt_WarnUnusedRecordWildcards - TcRnUnusedName _ prov - -> WarningWithFlag $ case prov of - UnusedNameTopDecl -> Opt_WarnUnusedTopBinds - UnusedNameImported _ -> Opt_WarnUnusedTopBinds - UnusedNameTypePattern -> Opt_WarnUnusedTypePatterns - UnusedNameMatch -> Opt_WarnUnusedMatches - UnusedNameLocalBind -> Opt_WarnUnusedLocalBinds - TcRnQualifiedBinder{} - -> ErrorWithoutFlag - TcRnTypeApplicationsDisabled{} - -> ErrorWithoutFlag - TcRnInvalidRecordField{} - -> ErrorWithoutFlag - TcRnTupleTooLarge{} - -> ErrorWithoutFlag - TcRnCTupleTooLarge{} - -> ErrorWithoutFlag - TcRnIllegalInferredTyVars{} - -> ErrorWithoutFlag - TcRnAmbiguousName{} - -> ErrorWithoutFlag - TcRnBindingNameConflict{} - -> ErrorWithoutFlag - TcRnNonCanonicalDefinition (NonCanonicalMonoid _) _ - -> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances - TcRnNonCanonicalDefinition (NonCanonicalMonad _) _ - -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances - TcRnDefaultedExceptionContext{} - -> WarningWithFlag Opt_WarnDefaultedExceptionContext - TcRnImplicitImportOfPrelude {} - -> WarningWithFlag Opt_WarnImplicitPrelude - TcRnMissingMain {} - -> ErrorWithoutFlag - TcRnGhciUnliftedBind {} - -> ErrorWithoutFlag - TcRnGhciMonadLookupFail {} - -> ErrorWithoutFlag - TcRnMissingRoleAnnotation{} - -> WarningWithFlag Opt_WarnMissingRoleAnnotations - TcRnIllegalInvisTyVarBndr{} - -> ErrorWithoutFlag - TcRnIllegalWildcardTyVarBndr{} - -> ErrorWithoutFlag - TcRnDeprecatedInvisTyArgInConPat {} - -> WarningWithFlag Opt_WarnDeprecatedTypeAbstractions - TcRnInvalidInvisTyVarBndr{} - -> ErrorWithoutFlag - TcRnInvisBndrWithoutSig{} - -> ErrorWithoutFlag - TcRnImplicitRhsQuantification{} - -> WarningWithFlag Opt_WarnImplicitRhsQuantification - TcRnPatersonCondFailure{} - -> ErrorWithoutFlag - TcRnIllformedTypePattern{} - -> ErrorWithoutFlag - TcRnIllegalTypePattern{} - -> ErrorWithoutFlag - TcRnIllformedTypeArgument{} - -> ErrorWithoutFlag - TcRnIllegalTypeExpr{} - -> ErrorWithoutFlag - TcRnInvalidDefaultedTyVar{} - -> ErrorWithoutFlag - TcRnNamespacedWarningPragmaWithoutFlag{} - -> ErrorWithoutFlag - TcRnIllegalInvisibleTypePattern{} - -> ErrorWithoutFlag - TcRnInvisPatWithNoForAll{} - -> ErrorWithoutFlag - TcRnNamespacedFixitySigWithoutFlag{} - -> ErrorWithoutFlag - TcRnOutOfArityTyVar{} - -> ErrorWithoutFlag - TcRnMisplacedInvisPat{} - -> ErrorWithoutFlag - TcRnUnexpectedTypeSyntaxInTerms{} - -> ErrorWithoutFlag - - diagnosticHints = \case - TcRnUnknownMessage m - -> diagnosticHints m - TcRnMessageWithInfo _ msg_with_info - -> case msg_with_info of - TcRnMessageDetailed _ m -> diagnosticHints m - TcRnWithHsDocContext _ msg - -> diagnosticHints msg - TcRnSolverReport (SolverReportWithCtxt ctxt msg) _ - -> tcSolverReportMsgHints ctxt msg - TcRnSolverDepthError {} - -> [SuggestIncreaseReductionDepth] - TcRnRedundantConstraints{} - -> noHints - TcRnInaccessibleCode{} - -> noHints - TcRnInaccessibleCoAxBranch{} - -> noHints - TcRnTypeDoesNotHaveFixedRuntimeRep{} - -> noHints - TcRnImplicitLift{} - -> noHints - TcRnUnusedPatternBinds{} - -> noHints - TcRnDodgyImports{} - -> noHints - TcRnDodgyExports{} - -> noHints - TcRnMissingImportList{} - -> noHints - TcRnUnsafeDueToPlugin{} - -> noHints - TcRnModMissingRealSrcSpan{} - -> noHints - TcRnIdNotExportedFromModuleSig name mod - -> [SuggestAddToHSigExportList name $ Just mod] - TcRnIdNotExportedFromLocalSig name - -> [SuggestAddToHSigExportList name Nothing] - TcRnShadowedName{} - -> noHints - TcRnInvalidWarningCategory{} - -> noHints - TcRnDuplicateWarningDecls{} - -> noHints - TcRnSimplifierTooManyIterations{} - -> [SuggestIncreaseSimplifierIterations] - TcRnIllegalPatSynDecl{} - -> noHints - TcRnLinearPatSyn{} - -> noHints - TcRnEmptyRecordUpdate{} - -> noHints - TcRnIllegalFieldPunning{} - -> [suggestExtension LangExt.NamedFieldPuns] - TcRnIllegalWildcardsInRecord{} - -> [suggestExtension LangExt.RecordWildCards] - TcRnIllegalWildcardInType{} - -> noHints - TcRnIllegalNamedWildcardInTypeArgument{} - -> [SuggestAnonymousWildcard] - TcRnIllegalImplicitTyVarInTypeArgument tv - -> [SuggestExplicitQuantification tv] - TcRnDuplicateFieldName{} - -> noHints - TcRnIllegalViewPattern{} - -> [suggestExtension LangExt.ViewPatterns] - TcRnCharLiteralOutOfRange{} - -> noHints - TcRnIllegalWildcardsInConstructor{} - -> noHints - TcRnIgnoringAnnotations{} - -> noHints - TcRnAnnotationInSafeHaskell - -> noHints - TcRnInvalidTypeApplication{} - -> noHints - TcRnTagToEnumMissingValArg - -> noHints - TcRnTagToEnumUnspecifiedResTy{} - -> noHints - TcRnTagToEnumResTyNotAnEnum{} - -> noHints - TcRnTagToEnumResTyTypeData{} - -> noHints - TcRnArrowIfThenElsePredDependsOnResultTy - -> noHints - TcRnIllegalHsBootOrSigDecl {} - -> noHints - TcRnBootMismatch boot_or_sig err - | Hsig <- boot_or_sig - , BootMismatch _ _ (BootMismatchedTyCons _boot_tc real_tc tc_errs) <- err - , any is_synAbsData_etaReduce (NE.toList tc_errs) - -> [SuggestEtaReduceAbsDataTySyn real_tc] - | otherwise - -> noHints - where - is_synAbsData_etaReduce (SynAbstractData SynAbsDataTySynNotNullary) = True - is_synAbsData_etaReduce _ = False - TcRnRecursivePatternSynonym{} - -> noHints - TcRnPartialTypeSigTyVarMismatch{} - -> noHints - TcRnPartialTypeSigBadQuantifier{} - -> noHints - TcRnMissingSignature {} - -> noHints - TcRnPolymorphicBinderMissingSig{} - -> noHints - TcRnOverloadedSig{} - -> noHints - TcRnTupleConstraintInst{} - -> noHints - TcRnUserTypeError{} - -> noHints - TcRnConstraintInKind{} - -> noHints - TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum _ - -> [suggestExtension $ unboxedTupleOrSumExtension tuple_or_sum] - TcRnLinearFuncInKind{} - -> noHints - TcRnForAllEscapeError{} - -> noHints - TcRnVDQInTermType mb_ty - | isJust mb_ty -> [suggestExtension LangExt.RequiredTypeArguments] - | otherwise -> [] - TcRnBadQuantPredHead{} - -> noHints - TcRnIllegalTupleConstraint{} - -> [suggestExtension LangExt.ConstraintKinds] - TcRnNonTypeVarArgInConstraint{} - -> [suggestExtension LangExt.FlexibleContexts] - TcRnIllegalImplicitParam{} - -> noHints - TcRnIllegalConstraintSynonymOfKind{} - -> [suggestExtension LangExt.ConstraintKinds] - TcRnOversaturatedVisibleKindArg{} - -> noHints - TcRnForAllRankErr rank _ - -> case rank of - LimitedRank{} -> [suggestExtension LangExt.RankNTypes] - MonoTypeRankZero -> [suggestExtension LangExt.RankNTypes] - MonoTypeTyConArg -> [suggestExtension LangExt.ImpredicativeTypes] - MonoTypeSynArg -> [suggestExtension LangExt.LiberalTypeSynonyms] - MonoTypeConstraint -> [suggestExtension LangExt.QuantifiedConstraints] - _ -> noHints - TcRnSimplifiableConstraint{} - -> noHints - TcRnArityMismatch{} - -> noHints - TcRnIllegalInstance rea - -> illegalInstanceHints rea - TcRnMonomorphicBindings bindings - -> case bindings of - [] -> noHints - (x:xs) -> [SuggestAddTypeSignatures $ NamedBindings (x NE.:| xs)] - TcRnOrphanInstance clsOrFamInst - -> [SuggestFixOrphanInst { isFamilyInstance = isFam }] - where - isFam = case clsOrFamInst :: Either ClsInst FamInst of - Left _clsInst -> Nothing - Right famInst -> Just $ fi_flavor famInst - TcRnFunDepConflict{} - -> noHints - TcRnDupInstanceDecls{} - -> noHints - TcRnConflictingFamInstDecls{} - -> noHints - TcRnFamInstNotInjective rea _ _ - -> case rea of - InjErrRhsBareTyVar{} -> noHints - InjErrRhsCannotBeATypeFam -> noHints - InjErrRhsOverlap -> noHints - InjErrCannotInferFromRhs _ _ suggestUndInst - | YesSuggestUndecidableInstaces <- suggestUndInst - -> [suggestExtension LangExt.UndecidableInstances] - | otherwise - -> noHints - TcRnBangOnUnliftedType{} - -> noHints - TcRnLazyBangOnUnliftedType{} - -> noHints - TcRnMultipleDefaultDeclarations{} - -> noHints - TcRnBadDefaultType{} - -> noHints - TcRnPatSynBundledWithNonDataCon{} - -> noHints - TcRnPatSynBundledWithWrongType{} - -> noHints - TcRnDupeModuleExport{} - -> noHints - TcRnExportedModNotImported{} - -> noHints - TcRnNullExportedModule{} - -> noHints - TcRnMissingExportList{} - -> noHints - TcRnExportHiddenComponents{} - -> noHints - TcRnExportHiddenDefault{} - -> noHints - TcRnDuplicateExport{} - -> noHints - TcRnExportedParentChildMismatch{} - -> noHints - TcRnConflictingExports{} - -> noHints - TcRnDuplicateFieldExport {} - -> [suggestExtension LangExt.DuplicateRecordFields] - TcRnAmbiguousFieldInUpdate {} - -> [suggestExtension LangExt.DisambiguateRecordFields] - TcRnAmbiguousRecordUpdate{} - -> noHints - TcRnMissingFields{} - -> noHints - TcRnFieldUpdateInvalidType{} - -> noHints - TcRnMissingStrictFields{} - -> noHints - TcRnBadRecordUpdate{} - -> noHints - TcRnIllegalStaticExpression {} - -> [suggestExtension LangExt.StaticPointers] - TcRnStaticFormNotClosed{} - -> noHints - TcRnUselessTypeable - -> noHints - TcRnDerivingDefaults{} - -> [useDerivingStrategies] - TcRnNonUnaryTypeclassConstraint{} - -> noHints - TcRnPartialTypeSignatures suggestParSig _ - -> case suggestParSig of - YesSuggestPartialTypeSignatures - -> let info = text "to use the inferred type" - in [suggestExtensionWithInfo info LangExt.PartialTypeSignatures] - NoSuggestPartialTypeSignatures - -> noHints - TcRnCannotDeriveInstance cls _ _ newtype_deriving rea - -> deriveInstanceErrReasonHints cls newtype_deriving rea - TcRnLookupInstance _ _ _ - -> noHints - TcRnLazyGADTPattern - -> noHints - TcRnArrowProcGADTPattern - -> noHints - TcRnTypeEqualityOutOfScope - -> noHints - TcRnTypeEqualityRequiresOperators - -> [suggestExtension LangExt.TypeOperators] - TcRnIllegalTypeOperator {} - -> [suggestExtension LangExt.TypeOperators] - TcRnIllegalTypeOperatorDecl {} - -> [suggestExtension LangExt.TypeOperators] - TcRnGADTMonoLocalBinds {} - -> [suggestAnyExtension [LangExt.GADTs, LangExt.TypeFamilies]] - TcRnIncorrectNameSpace nm is_th_use - | is_th_use - -> [SuggestAppropriateTHTick $ nameNameSpace nm] - | otherwise - -> noHints - TcRnNotInScope err _ _ hints - -> scopeErrorHints err ++ hints - TcRnTermNameInType _ hints - -> hints - TcRnUntickedPromotedThing thing - -> [SuggestAddTick thing] - TcRnIllegalBuiltinSyntax {} - -> noHints - TcRnWarnDefaulting {} - -> noHints - TcRnWarnClashingDefaultImports cls local imports - -> suggestDefaultDeclaration cls (fold local) (cd_types <$> NE.toList imports) - TcRnForeignImportPrimExtNotSet{} - -> [suggestExtension LangExt.GHCForeignImportPrim] - TcRnForeignImportPrimSafeAnn{} - -> noHints - TcRnForeignFunctionImportAsValue{} - -> noHints - TcRnFunPtrImportWithoutAmpersand{} - -> noHints - TcRnIllegalForeignDeclBackend{} - -> noHints - TcRnUnsupportedCallConv{} - -> noHints - TcRnIllegalForeignType _ reason - -> case reason of - TypeCannotBeMarshaled _ why - | NewtypeDataConNotInScope tc _ <- why - -> let tc_nm = tyConName tc - dc = dataConName $ head $ tyConDataCons tc - in [ ImportSuggestion (occName dc) - $ ImportDataCon Nothing (nameOccName tc_nm) ] - | UnliftedFFITypesNeeded <- why - -> [suggestExtension LangExt.UnliftedFFITypes] - _ -> noHints - TcRnInvalidCIdentifier{} - -> noHints - TcRnExpectedValueId{} - -> noHints - TcRnRecSelectorEscapedTyVar{} - -> [SuggestPatternMatchingSyntax] - TcRnPatSynNotBidirectional{} - -> noHints - TcRnIllegalDerivingItem{} - -> noHints - TcRnIllegalDefaultClass{} - -> noHints - TcRnIllegalNamedDefault{} - -> [suggestExtension LangExt.NamedDefaults] - TcRnUnexpectedAnnotation{} - -> noHints - TcRnIllegalRecordSyntax{} - -> noHints - TcRnInvalidVisibleKindArgument{} - -> noHints - TcRnTooManyBinders{} - -> noHints - TcRnDifferentNamesForTyVar{} - -> noHints - TcRnDisconnectedTyVar n - -> [SuggestBindTyVarExplicitly n] - TcRnInvalidReturnKind _ _ _ mb_suggest_unlifted_ext - -> case mb_suggest_unlifted_ext of - Nothing -> noHints - Just SuggestUnliftedNewtypes -> [suggestExtension LangExt.UnliftedNewtypes] - Just SuggestUnliftedDatatypes -> [suggestExtension LangExt.UnliftedDatatypes] - TcRnClassKindNotConstraint{} - -> noHints - TcRnUnpromotableThing{} - -> noHints - TcRnIllegalTermLevelUse{} - -> noHints - TcRnMatchesHaveDiffNumArgs{} - -> noHints - TcRnCannotBindScopedTyVarInPatSig{} - -> noHints - TcRnCannotBindTyVarsInPatBind{} - -> noHints - TcRnTooManyTyArgsInConPattern{} - -> noHints - TcRnMultipleInlinePragmas{} - -> noHints - TcRnUnexpectedPragmas{} - -> noHints - TcRnNonOverloadedSpecialisePragma{} - -> noHints - TcRnSpecialiseNotVisible name - -> [SuggestSpecialiseVisibilityHints name] - TcRnPragmaWarning{} - -> noHints - TcRnDifferentExportWarnings _ _ - -> noHints - TcRnIncompleteExportWarnings _ _ - -> noHints - TcRnIllegalHsigDefaultMethods{} - -> noHints - TcRnIllegalQuasiQuotes{} - -> [suggestExtension LangExt.QuasiQuotes] - TcRnTHError err - -> thErrorHints err - TcRnHsigFixityMismatch{} - -> noHints - TcRnHsigShapeMismatch{} - -> noHints - TcRnHsigMissingModuleExport{} - -> noHints - TcRnBadGenericMethod{} - -> noHints - TcRnWarningMinimalDefIncomplete{} - -> noHints - TcRnDefaultMethodForPragmaLacksBinding{} - -> noHints - TcRnIgnoreSpecialisePragmaOnDefMethod{} - -> noHints - TcRnBadMethodErr{} - -> noHints - TcRnIllegalTypeData - -> [suggestExtension LangExt.TypeData] - TcRnTypeDataForbids{} - -> noHints - TcRnIllegalNewtype{} - -> noHints - TcRnOrPatBindsVariables{} - -> noHints - TcRnUnsatisfiedMinimalDef{} - -> noHints - TcRnMisplacedInstSig{} - -> [suggestExtension LangExt.InstanceSigs] - TcRnNoRebindableSyntaxRecordDot{} - -> noHints - TcRnNoFieldPunsRecordDot{} - -> noHints - TcRnListComprehensionDuplicateBinding{} - -> noHints - TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{} - -> [suggestExtension LangExt.NondecreasingIndentation] - TcRnEmptyStmtsGroup{} - -> noHints - TcRnLastStmtNotExpr{} - -> noHints - TcRnUnexpectedStatementInContext _ _ mExt - | Nothing <- mExt -> noHints - | Just ext <- mExt -> [suggestExtension ext] - TcRnSectionWithoutParentheses{} - -> noHints - TcRnIllegalImplicitParameterBindings{} - -> noHints - TcRnIllegalTupleSection{} - -> [suggestExtension LangExt.TupleSections] - TcRnCapturedTermName{} - -> [SuggestRenameTypeVariable] - TcRnBindingOfExistingName{} - -> noHints - TcRnMultipleFixityDecls{} - -> noHints - TcRnIllegalPatternSynonymDecl{} - -> [suggestExtension LangExt.PatternSynonyms] - TcRnIllegalClassBinding{} - -> noHints - TcRnOrphanCompletePragma{} - -> noHints - TcRnEmptyCase _ reason -> - case reason of - EmptyCaseWithoutFlag{} -> [suggestExtension LangExt.EmptyCase] - EmptyCaseDisallowedCtxt{} -> noHints - EmptyCaseForall{} -> noHints - TcRnNonStdGuards{} - -> [suggestExtension LangExt.PatternGuards] - TcRnDuplicateSigDecl{} - -> noHints - TcRnMisplacedSigDecl{} - -> noHints - TcRnUnexpectedDefaultSig{} - -> [suggestExtension LangExt.DefaultSignatures] - TcRnDuplicateMinimalSig{} - -> noHints - TcRnUnexpectedStandaloneDerivingDecl{} - -> [suggestExtension LangExt.StandaloneDeriving] - TcRnUnusedVariableInRuleDecl{} - -> noHints - TcRnUnexpectedStandaloneKindSig{} - -> [suggestExtension LangExt.StandaloneKindSignatures] - TcRnIllegalRuleLhs{} - -> noHints - TcRnDuplicateRoleAnnot{} - -> noHints - TcRnDuplicateKindSig{} - -> noHints - TcRnIllegalDerivStrategy ds -> case ds of - ViaStrategy{} -> [suggestExtension LangExt.DerivingVia] - _ -> [suggestExtension LangExt.DerivingStrategies] - TcRnIllegalMultipleDerivClauses{} - -> [suggestExtension LangExt.DerivingStrategies] - TcRnNoDerivStratSpecified is_ds_enabled info -> do - let explicit_strategy_hint = case info of - TcRnNoDerivingClauseStrategySpecified assumed_derivings -> - SuggestExplicitDerivingClauseStrategies assumed_derivings - TcRnNoStandaloneDerivingStrategySpecified assumed_strategy deriv_sig -> - SuggestExplicitStandaloneDerivingStrategy assumed_strategy deriv_sig - explicit_strategy_hint : [suggestExtension LangExt.DerivingStrategies | not is_ds_enabled] - TcRnStupidThetaInGadt{} - -> noHints - TcRnShadowedTyVarNameInFamResult{} - -> noHints - TcRnIncorrectTyVarOnLhsOfInjCond{} - -> noHints - TcRnUnknownTyVarsOnRhsOfInjCond{} - -> noHints - TcRnBadlyStaged{} - -> noHints - TcRnBadlyStagedType{} - -> noHints - TcRnStageRestriction{} - -> noHints - TcRnTyThingUsedWrong{} - -> noHints - TcRnCannotDefaultKindVar{} - -> noHints - TcRnUninferrableTyVar{} - -> noHints - TcRnSkolemEscape{} - -> noHints - TcRnPatSynEscapedCoercion{} - -> noHints - TcRnPatSynExistentialInResult{} - -> noHints - TcRnPatSynArityMismatch{} - -> noHints - TcRnPatSynInvalidRhs name pat args (PatSynNotInvertible _) - -> [SuggestExplicitBidiPatSyn name pat args] - TcRnPatSynInvalidRhs{} - -> noHints - TcRnTyFamDepsDisabled{} - -> [suggestExtension LangExt.TypeFamilyDependencies] - TcRnAbstractClosedTyFamDecl{} - -> noHints - TcRnPartialFieldSelector{} - -> noHints - TcRnHasFieldResolvedIncomplete{} - -> noHints - TcRnBadFieldAnnotation _ _ LazyFieldsDisabled - -> [suggestExtension LangExt.StrictData] - TcRnBadFieldAnnotation{} - -> noHints - TcRnSuperclassCycle{} - -> [suggestExtension LangExt.UndecidableSuperClasses] - TcRnDefaultSigMismatch{} - -> noHints - TcRnTyFamsDisabled{} - -> [suggestExtension LangExt.TypeFamilies] - TcRnBadTyConTelescope{} - -> noHints - TcRnTyFamResultDisabled{} - -> [suggestExtension LangExt.TypeFamilyDependencies] - TcRnRoleValidationFailed{} - -> noHints - TcRnCommonFieldResultTypeMismatch{} - -> noHints - TcRnCommonFieldTypeMismatch{} - -> noHints - TcRnClassExtensionDisabled _ MultiParamDisabled{} - -> [suggestExtension LangExt.MultiParamTypeClasses] - TcRnClassExtensionDisabled _ FunDepsDisabled{} - -> [suggestExtension LangExt.FunctionalDependencies] - TcRnClassExtensionDisabled _ ConstrainedClassMethodsDisabled{} - -> [suggestExtension LangExt.ConstrainedClassMethods] - TcRnDataConParentTypeMismatch{} - -> noHints - TcRnGADTsDisabled{} - -> [suggestExtension LangExt.GADTs] - TcRnExistentialQuantificationDisabled{} - -> [suggestAnyExtension [LangExt.ExistentialQuantification, LangExt.GADTs]] - TcRnGADTDataContext{} - -> noHints - TcRnMultipleConForNewtype{} - -> noHints - TcRnKindSignaturesDisabled{} - -> [suggestExtension LangExt.KindSignatures] - TcRnEmptyDataDeclsDisabled{} - -> [suggestExtension LangExt.EmptyDataDecls] - TcRnRoleMismatch{} - -> noHints - TcRnRoleCountMismatch{} - -> noHints - TcRnIllegalRoleAnnotation{} - -> noHints - TcRnRoleAnnotationsDisabled{} - -> [suggestExtension LangExt.RoleAnnotations] - TcRnIncoherentRoles{} - -> [suggestExtension LangExt.IncoherentInstances] - TcRnUnexpectedKindVar{} - -> [suggestExtension LangExt.PolyKinds] - TcRnNegativeNumTypeLiteral{} - -> noHints - TcRnIllegalKind _ suggest_polyKinds - -> if suggest_polyKinds - then [suggestExtension LangExt.PolyKinds] - else noHints - TcRnPrecedenceParsingError{} - -> noHints - TcRnSectionPrecedenceError{} - -> noHints - TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] - TcRnIllegalKindSignature{} - -> [suggestExtension LangExt.KindSignatures] - TcRnUnusedQuantifiedTypeVar{} - -> noHints - TcRnDataKindsError{} - -> [suggestExtension LangExt.DataKinds] - TcRnTypeSynonymCycle{} - -> noHints - TcRnZonkerMessage msg - -> zonkerMessageHints msg - TcRnInterfaceError reason - -> interfaceErrorHints reason - TcRnSelfImport{} - -> noHints - TcRnNoExplicitImportList{} - -> noHints - TcRnSafeImportsDisabled{} - -> [SuggestSafeHaskell] - TcRnDeprecatedModule{} - -> noHints - TcRnRedundantSourceImport{} - -> noHints - TcRnImportLookup (ImportLookupBad k _ is ie patsyns_enabled) -> - let mod_name = moduleName $ is_mod is - occ = rdrNameOcc $ ieName ie - in case k of - BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] - BadImportNotExported suggs -> suggs - BadImportAvailTyCon ex_ns -> - [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] - ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] - BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] - BadImportNotExportedSubordinates{} -> noHints - TcRnImportLookup{} - -> noHints - TcRnUnusedImport{} - -> noHints - TcRnDuplicateDecls{} - -> noHints - TcRnPackageImportsDisabled - -> [suggestExtension LangExt.PackageImports] - TcRnIllegalDataCon{} - -> noHints - TcRnNestedForallsContexts{} - -> noHints - TcRnRedundantRecordWildcard - -> [SuggestRemoveRecordWildcard] - TcRnUnusedRecordWildcard{} - -> [SuggestRemoveRecordWildcard] - TcRnUnusedName{} - -> noHints - TcRnQualifiedBinder{} - -> noHints - TcRnTypeApplicationsDisabled ty_app - -> case ty_app of - TypeApplication {} - -> [suggestExtension LangExt.TypeApplications] - TypeApplicationInPattern {} - -> [suggestExtension LangExt.TypeAbstractions] - TcRnInvalidRecordField{} - -> noHints - TcRnTupleTooLarge{} - -> noHints - TcRnCTupleTooLarge{} - -> noHints - TcRnIllegalInferredTyVars{} - -> noHints - TcRnAmbiguousName{} - -> noHints - TcRnBindingNameConflict{} - -> noHints - TcRnNonCanonicalDefinition reason _ - -> suggestNonCanonicalDefinition reason - TcRnDefaultedExceptionContext _ - -> noHints - TcRnImplicitImportOfPrelude {} - -> noHints - TcRnMissingMain {} - -> noHints - TcRnGhciUnliftedBind {} - -> noHints - TcRnGhciMonadLookupFail {} - -> noHints - TcRnMissingRoleAnnotation{} - -> noHints - TcRnIllegalInvisTyVarBndr{} - -> [suggestExtension LangExt.TypeAbstractions] - TcRnIllegalWildcardTyVarBndr{} - -> [suggestExtension LangExt.TypeAbstractions] - TcRnDeprecatedInvisTyArgInConPat{} - -> [suggestExtension LangExt.TypeAbstractions] - TcRnInvalidInvisTyVarBndr{} - -> noHints - TcRnInvisBndrWithoutSig name _ - -> [SuggestAddStandaloneKindSignature name] - TcRnImplicitRhsQuantification kv - -> [SuggestBindTyVarOnLhs (unLoc kv)] - TcRnPatersonCondFailure{} - -> [suggestExtension LangExt.UndecidableInstances] - TcRnIllformedTypePattern{} - -> noHints - TcRnIllegalTypePattern{} - -> noHints - TcRnIllformedTypeArgument{} - -> noHints - TcRnIllegalTypeExpr{} - -> noHints - TcRnInvalidDefaultedTyVar{} - -> noHints - TcRnNamespacedWarningPragmaWithoutFlag{} - -> [suggestExtension LangExt.ExplicitNamespaces] - TcRnIllegalInvisibleTypePattern{} - -> [suggestExtension LangExt.TypeAbstractions] - TcRnInvisPatWithNoForAll{} - -> noHints - TcRnNamespacedFixitySigWithoutFlag{} - -> [suggestExtension LangExt.ExplicitNamespaces] - TcRnOutOfArityTyVar{} - -> noHints - TcRnMisplacedInvisPat{} - -> noHints - TcRnUnexpectedTypeSyntaxInTerms syntax - -> [suggestExtension (typeSyntaxExtension syntax)] - - diagnosticCode = constructorCode - - -note :: SDoc -> SDoc -note note = "Note" <> colon <+> note <> dot - --- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", --- and so on. The `and` stands for any `conjunction`, which is passed in. -commafyWith :: SDoc -> [SDoc] -> [SDoc] -commafyWith _ [] = [] -commafyWith _ [x] = [x] -commafyWith conjunction [x, y] = [x <+> conjunction <+> y] -commafyWith conjunction xs = addConjunction $ punctuate comma xs - where addConjunction [x, y] = [x, conjunction, y] - addConjunction (x : xs) = x : addConjunction xs - addConjunction _ = panic "commafyWith expected 2 or more elements" - -deriveInstanceErrReasonHints :: Class - -> UsingGeneralizedNewtypeDeriving - -> DeriveInstanceErrReason - -> [GhcHint] -deriveInstanceErrReasonHints cls newtype_deriving = \case - DerivErrNotWellKinded _ _ n_args_to_keep - | cls `hasKey` gen1ClassKey && n_args_to_keep >= 0 - -> [suggestExtension LangExt.PolyKinds] - | otherwise - -> noHints - DerivErrSafeHaskellGenericInst -> noHints - DerivErrDerivingViaWrongKind{} -> noHints - DerivErrNoEtaReduce{} -> noHints - DerivErrBootFileFound -> noHints - DerivErrDataConsNotAllInScope{} -> noHints - DerivErrGNDUsedOnData -> noHints - DerivErrNullaryClasses -> noHints - DerivErrLastArgMustBeApp -> noHints - DerivErrNoFamilyInstance{} -> noHints - DerivErrNotStockDeriveable deriveAnyClassEnabled - | deriveAnyClassEnabled == NoDeriveAnyClassEnabled - -> [suggestExtension LangExt.DeriveAnyClass] - | otherwise - -> noHints - DerivErrHasAssociatedDatatypes{} - -> noHints - DerivErrNewtypeNonDeriveableClass - | newtype_deriving == NoGeneralizedNewtypeDeriving - -> [useGND] - | otherwise - -> noHints - DerivErrCannotEtaReduceEnough{} - | newtype_deriving == NoGeneralizedNewtypeDeriving - -> [useGND] - | otherwise - -> noHints - DerivErrOnlyAnyClassDeriveable _ deriveAnyClassEnabled - | deriveAnyClassEnabled == NoDeriveAnyClassEnabled - -> [suggestExtension LangExt.DeriveAnyClass] - | otherwise - -> noHints - DerivErrNotDeriveable deriveAnyClassEnabled - | deriveAnyClassEnabled == NoDeriveAnyClassEnabled - -> [suggestExtension LangExt.DeriveAnyClass] - | otherwise - -> noHints - DerivErrNotAClass{} - -> noHints - DerivErrNoConstructors{} - -> let info = text "to enable deriving for empty data types" - in [useExtensionInOrderTo info LangExt.EmptyDataDeriving] - DerivErrLangExtRequired{} - -- This is a slightly weird corner case of GHC: we are failing - -- to derive a typeclass instance because a particular 'Extension' - -- is not enabled (and so we report in the main error), but here - -- we don't want to /repeat/ to enable the extension in the hint. - -> noHints - DerivErrDunnoHowToDeriveForType{} - -> noHints - DerivErrMustBeEnumType rep_tc - -- We want to suggest GND only if this /is/ a newtype. - | newtype_deriving == NoGeneralizedNewtypeDeriving && isNewTyCon rep_tc - -> [useGND] - | otherwise - -> noHints - DerivErrMustHaveExactlyOneConstructor{} - -> noHints - DerivErrMustHaveSomeParameters{} - -> noHints - DerivErrMustNotHaveClassContext{} - -> noHints - DerivErrBadConstructor wcard _ - -> case wcard of - Nothing -> noHints - Just YesHasWildcard -> [SuggestFillInWildcardConstraint] - Just NoHasWildcard -> [SuggestAddStandaloneDerivation] - DerivErrGenerics{} - -> noHints - DerivErrEnumOrProduct{} - -> noHints - -messageWithInfoDiagnosticMessage :: UnitState - -> ErrInfo - -> Bool - -> DecoratedSDoc - -> DecoratedSDoc -messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = - let err_info' = map (pprWithUnitState unit_state) ([errInfoContext | show_ctxt] ++ [errInfoSupplementary]) - in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` - mkDecorated err_info' - -messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc -messageWithHsDocContext opts ctxt main_msg = do - if tcOptsShowContext opts - then main_msg `unionDecoratedSDoc` ctxt_msg - else main_msg - where - ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) - -dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc -dodgy_msg kind tc ie - = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" - , quotes (ppr $ greName tc) <+> text "has" <+> sep rest ] - where - rest :: [SDoc] - rest = - case greInfo tc of - IAmTyCon ClassFlavour - -> [ text "(in-scope) class methods or associated types" <> comma - , text "but it has none" ] - IAmTyCon _ - -> [ text "(in-scope) constructors or record fields" <> comma - , text "but it has none" ] - _ -> [ text "children" <> comma - , text "but it is not a type constructor or a class" ] - -dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn -dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii Nothing - where - ii = noLocA (IEName noExtField $ noLocA $ greName tc_gre) - -pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc -pprTypeDoesNotHaveFixedRuntimeRep ty prov = - let what = pprFixedRuntimeRepProvenance prov - in text "The" <+> what <+> text "does not have a fixed runtime representation:" - $$ format_frr_err ty - -format_frr_err :: Type -- ^ the type which doesn't have a fixed runtime representation - -> SDoc -format_frr_err ty - = (bullet <+> ppr tidy_ty <+> dcolon <+> ppr tidy_ki) - where - (tidy_env, tidy_ty) = tidyOpenTypeX emptyTidyEnv ty - tidy_ki = tidyType tidy_env (typeKind ty) - -pprField :: (FieldLabelString, TcType) -> SDoc -pprField (f,ty) = ppr f <+> dcolon <+> ppr ty - -pprRecordFieldPart :: RecordFieldPart -> SDoc -pprRecordFieldPart = \case - RecordFieldDecl {} -> text "declaration" - RecordFieldConstructor{} -> text "construction" - RecordFieldPattern{} -> text "pattern" - RecordFieldUpdate -> text "update" - -ppr_opfix :: (OpName, Fixity) -> SDoc -ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) - where - pp_op | NegateOp <- op = text "prefix `-'" - | otherwise = quotes (ppr op) - -pprBindings :: [Name] -> SDoc -pprBindings = pprWithCommas (quotes . ppr) - - -injectivityErrorHerald :: SDoc -injectivityErrorHerald = - text "Type family equation violates the family's injectivity annotation." - -formatExportItemError :: SDoc -> String -> SDoc -formatExportItemError exportedThing reason = - hsep [ text "The export item" - , quotes exportedThing - , text reason ] - --- | What warning flags are associated with the given missing signature? -missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag -missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported - -- We prefer "bigger" warnings first: #14794 - -- - -- See Note [Warnings controlled by multiple flags] - = Opt_WarnMissingSignatures :| - [ Opt_WarnMissingExportedSignatures | IsExported == exported ] -missingSignatureWarningFlags (MissingPatSynSig {}) exported - = Opt_WarnMissingPatternSynonymSignatures :| - [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ] -missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _ - = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ] - -useDerivingStrategies :: GhcHint -useDerivingStrategies = - useExtensionInOrderTo (text "to pick a different strategy") LangExt.DerivingStrategies - -useGND :: GhcHint -useGND = let info = text "for GHC's" <+> text "newtype-deriving extension" - in suggestExtensionWithInfo info LangExt.GeneralizedNewtypeDeriving - -cannotMakeDerivedInstanceHerald :: Class - -> [Type] - -> Maybe (DerivStrategy GhcTc) - -> UsingGeneralizedNewtypeDeriving - -> Bool -- ^ If False, only prints the why. - -> SDoc - -> SDoc -cannotMakeDerivedInstanceHerald cls cls_args mb_strat newtype_deriving pprHerald why = - if pprHerald - then sep [(hang (text "Can't make a derived instance of") - 2 (quotes (ppr pred) <+> via_mechanism) - $$ nest 2 extra) <> colon, - nest 2 why] - else why - where - strat_used = isJust mb_strat - extra | not strat_used, (newtype_deriving == YesGeneralizedNewtypeDeriving) - = text "(even with cunning GeneralizedNewtypeDeriving)" - | otherwise = empty - pred = mkClassPred cls cls_args - via_mechanism | strat_used - , Just strat <- mb_strat - = text "with the" <+> (derivStrategyName strat) <+> text "strategy" - | otherwise - = empty - -badCon :: DataCon -> SDoc -> SDoc -badCon con msg = text "Constructor" <+> quotes (ppr con) <+> msg - -derivErrDiagnosticMessage :: Class - -> [Type] - -> Maybe (DerivStrategy GhcTc) - -> UsingGeneralizedNewtypeDeriving - -> Bool -- If True, includes the herald \"can't make a derived..\" - -> DeriveInstanceErrReason - -> SDoc -derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \case - DerivErrNotWellKinded tc cls_kind _ - -> sep [ hang (text "Cannot derive well-kinded instance of form" - <+> quotes (pprClassPred cls cls_tys - <+> parens (ppr tc <+> text "..."))) - 2 empty - , nest 2 (text "Class" <+> quotes (ppr cls) - <+> text "expects an argument of kind" - <+> quotes (pprKind cls_kind)) - ] - DerivErrSafeHaskellGenericInst - -> text "Generic instances can only be derived in" - <+> text "Safe Haskell using the stock strategy." - DerivErrDerivingViaWrongKind cls_kind via_ty via_kind - -> hang (text "Cannot derive instance via" <+> quotes (pprType via_ty)) - 2 (text "Class" <+> quotes (ppr cls) - <+> text "expects an argument of kind" - <+> quotes (pprKind cls_kind) <> char ',' - $+$ text "but" <+> quotes (pprType via_ty) - <+> text "has kind" <+> quotes (pprKind via_kind)) - DerivErrNoEtaReduce inst_ty - -> sep [text "Cannot eta-reduce to an instance of form", - nest 2 (text "instance (...) =>" - <+> pprClassPred cls (cls_tys ++ [inst_ty]))] - DerivErrBootFileFound - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "Cannot derive instances in hs-boot files" - $+$ text "Write an instance declaration instead") - DerivErrDataConsNotAllInScope tc - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (hang (text "The data constructors of" <+> quotes (ppr tc) <+> text "are not all in scope") - 2 (text "so you cannot derive an instance for it")) - DerivErrGNDUsedOnData - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "GeneralizedNewtypeDeriving cannot be used on non-newtypes") - DerivErrNullaryClasses - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "Cannot derive instances for nullary classes") - DerivErrLastArgMustBeApp - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - ( text "The last argument of the instance must be a" - <+> text "data or newtype application") - DerivErrNoFamilyInstance tc tc_args - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "No family instance for" <+> quotes (pprTypeApp tc tc_args)) - DerivErrNotStockDeriveable _ - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (quotes (ppr cls) <+> text "is not a stock derivable class (Eq, Show, etc.)") - DerivErrHasAssociatedDatatypes hasAdfs at_last_cls_tv_in_kinds at_without_last_cls_tv - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - $ vcat [ ppWhen (hasAdfs == YesHasAdfs) adfs_msg - , case at_without_last_cls_tv of - YesAssociatedTyNotParamOverLastTyVar tc -> at_without_last_cls_tv_msg tc - NoAssociatedTyNotParamOverLastTyVar -> empty - , case at_last_cls_tv_in_kinds of - YesAssocTyLastVarInKind tc -> at_last_cls_tv_in_kinds_msg tc - NoAssocTyLastVarInKind -> empty - ] - where - - adfs_msg = text "the class has associated data types" - - at_without_last_cls_tv_msg at_tc = hang - (text "the associated type" <+> quotes (ppr at_tc) - <+> text "is not parameterized over the last type variable") - 2 (text "of the class" <+> quotes (ppr cls)) - - at_last_cls_tv_in_kinds_msg at_tc = hang - (text "the associated type" <+> quotes (ppr at_tc) - <+> text "contains the last type variable") - 2 (text "of the class" <+> quotes (ppr cls) - <+> text "in a kind, which is not (yet) allowed") - DerivErrNewtypeNonDeriveableClass - -> derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald (DerivErrNotStockDeriveable NoDeriveAnyClassEnabled) - DerivErrCannotEtaReduceEnough eta_ok - -> let cant_derive_err = ppUnless eta_ok eta_msg - eta_msg = text "cannot eta-reduce the representation type enough" - in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - cant_derive_err - DerivErrOnlyAnyClassDeriveable tc _ - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (quotes (ppr tc) <+> text "is a type class," - <+> text "and can only have a derived instance" - $+$ text "if DeriveAnyClass is enabled") - DerivErrNotDeriveable _ - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald empty - DerivErrNotAClass predType - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (quotes (ppr predType) <+> text "is not a class") - DerivErrNoConstructors rep_tc - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (quotes (pprSourceTyCon rep_tc) <+> text "must have at least one data constructor") - DerivErrLangExtRequired ext - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "You need " <> ppr ext - <+> text "to derive an instance for this class") - DerivErrDunnoHowToDeriveForType ty - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (hang (text "Don't know how to derive" <+> quotes (ppr cls)) - 2 (text "for type" <+> quotes (ppr ty))) - DerivErrMustBeEnumType rep_tc - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (sep [ quotes (pprSourceTyCon rep_tc) <+> - text "must be an enumeration type" - , text "(an enumeration consists of one or more nullary, non-GADT constructors)" ]) - - DerivErrMustHaveExactlyOneConstructor rep_tc - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor") - DerivErrMustHaveSomeParameters rep_tc - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "Data type" <+> quotes (ppr rep_tc) <+> text "must have some type parameters") - DerivErrMustNotHaveClassContext rep_tc bad_stupid_theta - -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (text "Data type" <+> quotes (ppr rep_tc) - <+> text "must not have a class context:" <+> pprTheta bad_stupid_theta) - DerivErrBadConstructor _ reasons - -> let why = vcat $ map renderReason reasons - in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why - where - renderReason = \case - DerivErrBadConExistential con - -> badCon con $ text "must be truly polymorphic in the last argument of the data type" - DerivErrBadConCovariant con - -> badCon con $ text "must not use the type variable in a function argument" - DerivErrBadConFunTypes con - -> badCon con $ text "must not contain function types" - DerivErrBadConWrongArg con - -> badCon con $ text "must use the type variable only as the last argument of a data type" - DerivErrBadConIsGADT con - -> badCon con $ text "is a GADT" - DerivErrBadConHasExistentials con - -> badCon con $ text "has existential type variables in its type" - DerivErrBadConHasConstraints con - -> badCon con $ text "has constraints in its type" - DerivErrBadConHasHigherRankType con - -> badCon con $ text "has a higher-rank type" - DerivErrGenerics reasons - -> let why = vcat $ map renderReason reasons - in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why - where - renderReason = \case - DerivErrGenericsMustNotHaveDatatypeContext tc_name - -> ppr tc_name <+> text "must not have a datatype context" - DerivErrGenericsMustNotHaveExoticArgs dc - -> ppr dc <+> text "must not have exotic unlifted or polymorphic arguments" - DerivErrGenericsMustBeVanillaDataCon dc - -> ppr dc <+> text "must be a vanilla data constructor" - DerivErrGenericsMustHaveSomeTypeParams rep_tc - -> text "Data type" <+> quotes (ppr rep_tc) - <+> text "must have some type parameters" - DerivErrGenericsMustNotHaveExistentials con - -> badCon con $ text "must not have existential arguments" - DerivErrGenericsWrongArgKind con - -> badCon con $ - text "applies a type to an argument involving the last parameter" - $$ text "but the applied type is not of kind * -> *" - DerivErrEnumOrProduct this that - -> let ppr1 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False this - ppr2 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False that - in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald - (ppr1 $$ text " or" $$ ppr2) - -lookupInstanceErrDiagnosticMessage :: Class - -> [Type] - -> LookupInstanceErrReason - -> SDoc -lookupInstanceErrDiagnosticMessage cls tys = \case - LookupInstErrNotExact - -> text "Not an exact match (i.e., some variables get instantiated)" - LookupInstErrFlexiVar - -> text "flexible type variable:" <+> (ppr $ mkTyConApp (classTyCon cls) tys) - LookupInstErrNotFound - -> text "instance not found" <+> (ppr $ mkTyConApp (classTyCon cls) tys) - -{- ********************************************************************* -* * - Outputable SolverReportErrCtxt (for debugging) -* * -**********************************************************************-} - -instance Outputable SolverReportErrCtxt where - ppr (CEC { cec_binds = bvar - , cec_defer_type_errors = dte - , cec_expr_holes = eh - , cec_type_holes = th - , cec_out_of_scope_holes = osh - , cec_warn_redundant = wr - , cec_expand_syns = es - , cec_suppress = sup }) - = text "CEC" <+> braces (vcat - [ text "cec_binds" <+> equals <+> ppr bvar - , text "cec_defer_type_errors" <+> equals <+> ppr dte - , text "cec_expr_holes" <+> equals <+> ppr eh - , text "cec_type_holes" <+> equals <+> ppr th - , text "cec_out_of_scope_holes" <+> equals <+> ppr osh - , text "cec_warn_redundant" <+> equals <+> ppr wr - , text "cec_expand_syns" <+> equals <+> ppr es - , text "cec_suppress" <+> equals <+> ppr sup ]) - -{- ********************************************************************* -* * - Outputting TcSolverReportMsg errors -* * -**********************************************************************-} - --- | Pretty-print a 'SolverReportWithCtxt', containing a 'TcSolverReportMsg' --- with its enclosing 'SolverReportErrCtxt'. -pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc -pprSolverReportWithCtxt (SolverReportWithCtxt { reportContext = ctxt, reportContent = msg }) - = pprTcSolverReportMsg ctxt msg - --- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'. -pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc -pprTcSolverReportMsg _ (BadTelescope telescope skols) = - hang (text "These kind and type variables:" <+> ppr telescope $$ - text "are out of dependency order. Perhaps try this ordering:") - 2 (pprTyVars sorted_tvs) - where - sorted_tvs = scopedSort skols -pprTcSolverReportMsg _ (UserTypeError ty) = - pprUserTypeErrorTy ty -pprTcSolverReportMsg _ (UnsatisfiableError ty) = - pprUserTypeErrorTy ty -pprTcSolverReportMsg ctxt (ReportHoleError hole err) = - pprHoleError ctxt hole err -pprTcSolverReportMsg ctxt - (CannotUnifyVariable - { mismatchMsg = msg - , cannotUnifyReason = reason }) - = pprMismatchMsg ctxt msg - $$ pprCannotUnifyVariableReason ctxt reason -pprTcSolverReportMsg ctxt - (Mismatch - { mismatchMsg = mismatch_msg - , mismatchTyVarInfo = tv_info - , mismatchAmbiguityInfo = ambig_infos - , mismatchCoercibleInfo = coercible_info }) - = vcat ([ pprMismatchMsg ctxt mismatch_msg - , maybe empty (pprTyVarInfo ctxt) tv_info - , maybe empty pprCoercibleMsg coercible_info ] - ++ (map pprAmbiguityInfo ambig_infos)) -pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = - vcat (map make_msg frr_origs) - where - -- Assemble the error message: pair up each origin with the corresponding type, e.g. - -- • FixedRuntimeRep origin msg 1 ... - -- a :: TYPE r1 - -- • FixedRuntimeRep origin msg 2 ... - -- b :: TYPE r2 - make_msg :: FixedRuntimeRepErrorInfo -> SDoc - make_msg (FRR_Info { frr_info_origin = - FixedRuntimeRepOrigin - { frr_type = ty - , frr_context = frr_ctxt } - , frr_info_not_concrete = - mb_not_conc }) = - -- Add bullet points if there is more than one error. - (if length frr_origs > 1 then (bullet <+>) else id) $ - vcat [ sep [ pprFixedRuntimeRepContext frr_ctxt - , text "does not have a fixed runtime representation." ] - , type_printout ty - , case mb_not_conc of - Nothing -> empty - Just (conc_tv, not_conc) -> - unsolved_concrete_eq_explanation conc_tv not_conc ] - - -- Don't print out the type (only the kind), if the type includes - -- a confusing cast, unless the user passed -fprint-explicit-coercions. - -- - -- Example: - -- - -- In T20363, we have a representation-polymorphism error with a type - -- of the form - -- - -- ( (# #) |> co ) :: TYPE NilRep - -- - -- where NilRep is a nullary type family application which reduces to TupleRep '[]. - -- We prefer avoiding showing the cast to the user, but we also don't want to - -- print the confusing: - -- - -- (# #) :: TYPE NilRep - -- - -- So in this case we simply don't print the type, only the kind. - confusing_cast :: Type -> Bool - confusing_cast ty = - case ty of - CastTy inner_ty _ - -- A confusing cast is one that is responsible - -- for a representation-polymorphism error. - -> isConcreteType (typeKind inner_ty) - _ -> False - - type_printout :: Type -> SDoc - type_printout ty = - sdocOption sdocPrintExplicitCoercions $ \ show_coercions -> - if confusing_cast ty && not show_coercions - then vcat [ text "Its kind is:" - , nest 2 $ pprWithTYPE (typeKind ty) - , text "(Use -fprint-explicit-coercions to see the full type.)" ] - else vcat [ text "Its type is:" - , nest 2 $ ppr ty <+> dcolon <+> pprWithTYPE (typeKind ty) ] - - unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc - unsolved_concrete_eq_explanation tv not_conc = - text "Cannot unify" <+> quotes (ppr not_conc) - <+> text "with the type variable" <+> quotes (ppr tv) - $$ text "because the former is not a concrete" <+> what <> dot - where - ki = tyVarKind tv - what :: SDoc - what - | isRuntimeRepTy ki - = quotes (text "RuntimeRep") - | isLevityTy ki - = quotes (text "Levity") - | otherwise - = text "type" -pprTcSolverReportMsg _ (BlockedEquality item) = - vcat [ hang (text "Cannot use equality for substitution:") - 2 (ppr (errorItemPred item)) - , text "Doing so would be ill-kinded." ] -pprTcSolverReportMsg _ (ExpectingMoreArguments n thing) = - text "Expecting" <+> speakN (abs n) <+> - more <+> quotes (ppr thing) - where - more - | n == 1 = text "more argument to" - | otherwise = text "more arguments to" -- n > 1 -pprTcSolverReportMsg ctxt (UnboundImplicitParams (item :| items)) = - let givens = getUserGivens ctxt - in if null givens - then addArising (errorItemCtLoc item) $ - sep [ text "Unbound implicit parameter" <> plural preds - , nest 2 (pprParendTheta preds) ] - else pprMismatchMsg ctxt (CouldNotDeduce givens (item :| items) Nothing) - where - preds = map errorItemPred (item : items) -pprTcSolverReportMsg _ (AmbiguityPreventsSolvingCt item ambigs) = - pprAmbiguityInfo (Ambiguity True ambigs) <+> - pprArising (errorItemCtLoc item) $$ - text "prevents the constraint" <+> quotes (pprParendType $ errorItemPred item) - <+> text "from being solved." -pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) - (CannotResolveInstance item unifiers candidates imp_errs suggs binds) - = - vcat - [ no_inst_msg - , nest 2 extra_note - , mb_patsyn_prov `orElse` empty - , ppWhen (has_ambigs && not (null unifiers && null useful_givens)) - (vcat [ ppUnless lead_with_ambig $ - pprAmbiguityInfo (Ambiguity False (ambig_kvs, ambig_tvs)) - , pprRelevantBindings binds - , potential_msg ]) - , ppWhen (isNothing mb_patsyn_prov) $ - -- Don't suggest fixes for the provided context of a pattern - -- synonym; the right fix is to bind more in the pattern - show_fixes (ctxtFixes has_ambigs pred implics - ++ drv_fixes ++ naked_sc_fixes) - , ppWhen (not (null candidates)) - (hang (text "There are instances for similar types:") - 2 (vcat (map ppr candidates))) - -- See Note [Report candidate instances] - , vcat $ map ppr imp_errs - , vcat $ map ppr suggs ] - where - orig = errorItemOrigin item - pred = errorItemPred item - (clas, tys) = getClassPredTys pred - -- See Note [Highlighting ambiguous type variables] in GHC.Tc.Errors - (ambig_kvs, ambig_tvs) = ambigTkvsOfTy pred - ambigs = ambig_kvs ++ ambig_tvs - has_ambigs = not (null ambigs) - useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics) - -- useful_givens are the enclosing implications with non-empty givens, - -- modulo the horrid discardProvCtxtGivens - lead_with_ambig = not (null ambigs) - && not (any isRuntimeUnkSkol ambigs) - && not (null unifiers) - && null useful_givens - - no_inst_msg :: SDoc - no_inst_msg - | lead_with_ambig - = pprTcSolverReportMsg ctxt $ AmbiguityPreventsSolvingCt item (ambig_kvs, ambig_tvs) - | otherwise - = pprMismatchMsg ctxt $ CouldNotDeduce useful_givens (item :| []) Nothing - - -- Report "potential instances" only when the constraint arises - -- directly from the user's use of an overloaded function - want_potential (TypeEqOrigin {}) = False - want_potential _ = True - - potential_msg - = ppWhen (not (null unifiers) && want_potential orig) $ - potential_hdr $$ - potentialInstancesErrMsg (PotentialInstances { matches = [], unifiers }) - - potential_hdr - = ppWhen lead_with_ambig $ - text "Probable fix: use a type annotation to specify what" - <+> pprQuotedList ambig_tvs <+> text "should be." - - mb_patsyn_prov :: Maybe SDoc - mb_patsyn_prov - | not lead_with_ambig - , ProvCtxtOrigin PSB{ psb_def = L _ pat } <- orig - = Just (vcat [ text "In other words, a successful match on the pattern" - , nest 2 $ ppr pat - , text "does not provide the constraint" <+> pprParendType pred ]) - | otherwise = Nothing - - extra_note | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys) - = text "(maybe you haven't applied a function to enough arguments?)" - | className clas == typeableClassName -- Avoid mysterious "No instance for (Typeable T) - , [_,ty] <- tys -- Look for (Typeable (k->*) (T k)) - , Just (tc,_) <- tcSplitTyConApp_maybe ty - , not (isTypeFamilyTyCon tc) - = hang (text "GHC can't yet do polykinded") - 2 (text "Typeable" <+> - parens (ppr ty <+> dcolon <+> ppr (typeKind ty))) - | otherwise - = empty - - drv_fixes = case orig of - DerivClauseOrigin -> [drv_fix False] - StandAloneDerivOrigin -> [drv_fix True] - DerivOriginDC _ _ standalone -> [drv_fix standalone] - DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone] - _ -> [] - - drv_fix standalone_wildcard - | standalone_wildcard - = text "fill in the wildcard constraint yourself" - | otherwise - = hang (text "use a standalone 'deriving instance' declaration,") - 2 (text "so you can specify the instance context yourself") - - -- naked_sc_fix: try to produce a helpful error message for - -- superclass constraints caught by the subtleties described by - -- Note [Recursive superclasses] in GHC.TyCl.Instance - naked_sc_fixes - | ScOrigin _ NakedSc <- orig -- A superclass wanted with no instance decls used yet - , any non_tyvar_preds useful_givens -- Some non-tyvar givens - = [vcat [ text "If the constraint looks soluble from a superclass of the instance context," - , text "read 'Undecidable instances and loopy superclasses' in the user manual" ]] - | otherwise = [] - - non_tyvar_preds :: UserGiven -> Bool - non_tyvar_preds = any non_tyvar_pred . ic_given - - non_tyvar_pred :: EvVar -> Bool - -- Tells if the Given is of form (C ty1 .. tyn), where the tys are not all tyvars - non_tyvar_pred given = case getClassPredTys_maybe (idType given) of - Just (_, tys) -> not (all isTyVarTy tys) - Nothing -> False - -pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item matches unifiers) = - vcat - [ addArising ct_loc $ - (text "Overlapping instances for" - <+> pprType (mkClassPred clas tys)) - , ppUnless (null matching_givens) $ - sep [text "Matching givens (or their superclasses):" - , nest 2 (vcat matching_givens)] - , potentialInstancesErrMsg - (PotentialInstances { matches = NE.toList matches, unifiers }) - , ppWhen (null matching_givens && null (NE.tail matches) && null unifiers) $ - -- Intuitively, some given matched the wanted in their - -- flattened or rewritten (from given equalities) form - -- but the matcher can't figure that out because the - -- constraints are non-flat and non-rewritten so we - -- simply report back the whole given - -- context. Accelerate Smart.hs showed this problem. - sep [ text "There exists a (perhaps superclass) match:" - , nest 2 (vcat (pp_givens useful_givens))] - - , ppWhen (null $ NE.tail matches) $ - parens (vcat [ ppUnless (null tyCoVars) $ - text "The choice depends on the instantiation of" <+> - quotes (pprWithCommas ppr tyCoVars) - , ppUnless (null famTyCons) $ - if (null tyCoVars) - then - text "The choice depends on the result of evaluating" <+> - quotes (pprWithCommas ppr famTyCons) - else - text "and the result of evaluating" <+> - quotes (pprWithCommas ppr famTyCons) - , ppWhen (null (matching_givens)) $ - vcat [ text "To pick the first instance above, use IncoherentInstances" - , text "when compiling the other instance declarations"] - ])] - where - ct_loc = errorItemCtLoc item - orig = ctLocOrigin ct_loc - pred = errorItemPred item - (clas, tys) = getClassPredTys pred - tyCoVars = tyCoVarsOfTypesList tys - famTyCons = filter isFamilyTyCon $ concatMap (nonDetEltsUniqSet . tyConsOfType) tys - useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics) - matching_givens = mapMaybe matchable useful_givens - matchable implic@(Implic { ic_given = evvars, ic_info = skol_info }) - = case ev_vars_matching of - [] -> Nothing - _ -> Just $ hang (pprTheta ev_vars_matching) - 2 (sep [ text "bound by" <+> ppr skol_info - , text "at" <+> - ppr (getCtLocEnvLoc (ic_env implic)) ]) - where ev_vars_matching = [ pred - | ev_var <- evvars - , let pred = evVarPred ev_var - , any can_match (pred : transSuperClasses pred) ] - can_match pred - = case getClassPredTys_maybe pred of - Just (clas', tys') -> clas' == clas - && isJust (tcMatchTys tys tys') - Nothing -> False -pprTcSolverReportMsg _ (UnsafeOverlap item match unsafe_overlapped) = - vcat [ addArising ct_loc (text "Unsafe overlapping instances for" - <+> pprType (mkClassPred clas tys)) - , sep [text "The matching instance is:", - nest 2 (pprInstance match)] - , vcat [ text "It is compiled in a Safe module and as such can only" - , text "overlap instances from the same module, however it" - , text "overlaps the following instances from different" <+> - text "modules:" - , nest 2 (vcat [pprInstances $ NE.toList unsafe_overlapped]) - ] - ] - where - ct_loc = errorItemCtLoc item - pred = errorItemPred item - (clas, tys) = getClassPredTys pred - -pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc -pprCannotUnifyVariableReason ctxt (CannotUnifyWithPolytype item tv1 ty2 mb_tv_info) = - vcat [ (if isSkolemTyVar tv1 - then text "Cannot equate type variable" - else text "Cannot instantiate unification variable") - <+> quotes (ppr tv1) - , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) - , maybe empty (pprTyVarInfo ctxt) mb_tv_info ] - where - what = text $ levelString $ - ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel - -pprCannotUnifyVariableReason _ (SkolemEscape item implic esc_skols) = - let - esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols - <+> pprQuotedList esc_skols - , text "would escape" <+> - if isSingleton esc_skols then text "its scope" - else text "their scope" ] - in - vcat [ nest 2 $ esc_doc - , sep [ (if isSingleton esc_skols - then text "This (rigid, skolem)" <+> - what <+> text "variable is" - else text "These (rigid, skolem)" <+> - what <+> text "variables are") - <+> text "bound by" - , nest 2 $ ppr (ic_info implic) - , nest 2 $ text "at" <+> - ppr (getCtLocEnvLoc (ic_env implic)) ] ] - where - what = text $ levelString $ - ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel - -pprCannotUnifyVariableReason ctxt - (OccursCheck - { occursCheckInterestingTyVars = interesting_tvs - , occursCheckAmbiguityInfos = ambig_infos }) - = ppr_interesting_tyVars interesting_tvs - $$ vcat (map pprAmbiguityInfo ambig_infos) - where - ppr_interesting_tyVars [] = empty - ppr_interesting_tyVars (tv:tvs) = - hang (text "Type variable kinds:") 2 $ - vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt)) - (tv:tvs)) - tyvar_binding tyvar = ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar) -pprCannotUnifyVariableReason ctxt (DifferentTyVars tv_info) - = pprTyVarInfo ctxt tv_info -pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) - = pprTyVarInfo ctxt tv_info - $$ maybe empty pprCoercibleMsg mb_coercible_msg - -pprUntouchableVariable :: TcTyVar -> Implication -> SDoc -pprUntouchableVariable tv (Implic { ic_given = given, ic_info = skol_info, ic_env = env }) - = sep [ quotes (ppr tv) <+> text "is untouchable" - , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given - , nest 2 $ text "bound by" <+> ppr skol_info - , nest 2 $ text "at" <+> ppr (getCtLocEnvLoc env) ] - -pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc -pprMismatchMsg ctxt - (BasicMismatch { mismatch_ea = ea - , mismatch_item = item - , mismatch_ty1 = ty1 -- Expected - , mismatch_ty2 = ty2 -- Actual - , mismatch_whenMatching = mb_match_txt - , mismatch_mb_same_occ = same_occ_info }) - = vcat [ addArising (errorItemCtLoc item) msg - , ea_extra - , maybe empty (pprWhenMatching ctxt) mb_match_txt - , maybe empty pprSameOccInfo same_occ_info ] - where - msg - | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) || - (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) || - (isLiftedLevity ty1 && isUnliftedLevity ty2) || - (isLiftedLevity ty2 && isUnliftedLevity ty1) - = text "Couldn't match a lifted type with an unlifted type" - - | isAtomicTy ty1 || isAtomicTy ty2 - = -- Print with quotes - sep [ text herald1 <+> quotes (ppr ty1) - , nest padding $ - text herald2 <+> quotes (ppr ty2) ] - - | otherwise - = -- Print with vertical layout - vcat [ text herald1 <> colon <+> ppr ty1 - , nest padding $ - text herald2 <> colon <+> ppr ty2 ] - - herald1 = conc [ "Couldn't match" - , if is_repr then "representation of" else "" - , if want_ea then "expected" else "" - , what ] - herald2 = conc [ "with" - , if is_repr then "that of" else "" - , if want_ea then ("actual " ++ what) else "" ] - - padding = length herald1 - length herald2 - - (want_ea, ea_extra) - = case ea of - NoEA -> (False, empty) - EA mb_extra -> (True , maybe empty (pprExpectedActualInfo ctxt) mb_extra) - is_repr = case errorItemEqRel item of { ReprEq -> True; NomEq -> False } - - what = levelString (ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel) - - conc :: [String] -> String - conc = foldr1 add_space - - add_space :: String -> String -> String - add_space s1 s2 | null s1 = s2 - | null s2 = s1 - | otherwise = s1 ++ (' ' : s2) -pprMismatchMsg _ - (KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act }) - = hang (text "Expected" <+> kind_desc <> comma) - 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> - quotes (ppr act)) - where - kind_desc | isConstraintLikeKind exp = text "a constraint" - | Just arg <- kindRep_maybe exp -- TYPE t0 - , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case - True -> text "kind" <+> quotes (ppr exp) - False -> text "a type" - | otherwise = text "kind" <+> quotes (ppr exp) - -pprMismatchMsg ctxt - (TypeEqMismatch { teq_mismatch_item = item - , teq_mismatch_ty1 = ty1 -- These types are the actual types - , teq_mismatch_ty2 = ty2 -- that don't match; may be swapped - , teq_mismatch_expected = exp -- These are the context of - , teq_mismatch_actual = act -- the mis-match - , teq_mismatch_what = mb_thing - , teq_mb_same_occ = mb_same_occ }) - = addArising ct_loc $ - pprWithInvisibleBitsWhen ppr_invis_bits msg - $$ maybe empty pprSameOccInfo mb_same_occ - where - - msg | Just (torc, rep) <- sORTKind_maybe exp - = msg_for_exp_sort torc rep - - | Just nargs_msg <- num_args_msg - , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = nargs_msg $$ pprMismatchMsg ctxt ea_msg - - | ea_looks_same ty1 ty2 exp act - , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig - = pprMismatchMsg ctxt ea_msg - - | otherwise - = bale_out_msg - - -- bale_out_msg: the mismatched types are /inside/ exp and act - bale_out_msg = vcat errs - where - errs = case mk_ea_msg ctxt Nothing level orig of - Left ea_info -> pprMismatchMsg ctxt mismatch_err - : map (pprExpectedActualInfo ctxt) ea_info - Right ea_err -> [ pprMismatchMsg ctxt mismatch_err - , pprMismatchMsg ctxt ea_err ] - mismatch_err = mkBasicMismatchMsg NoEA item ty1 ty2 - - -- 'expected' is (TYPE rep) or (CONSTRAINT rep) - msg_for_exp_sort exp_torc exp_rep - | Just (act_torc, act_rep) <- sORTKind_maybe act - = -- (TYPE exp_rep) ~ (CONSTRAINT act_rep) etc - msg_torc_torc act_torc act_rep - | otherwise - = -- (TYPE _) ~ Bool, etc - maybe_num_args_msg $$ - sep [ text "Expected a" <+> ppr_torc exp_torc <> comma - , text "but" <+> case mb_thing of - Nothing -> text "found something with kind" - Just thing -> quotes (ppr thing) <+> text "has kind" - , quotes (pprWithTYPE act) ] - - where - msg_torc_torc act_torc act_rep - | exp_torc == act_torc - = msg_same_torc act_torc act_rep - | otherwise - = sep [ text "Expected a" <+> ppr_torc exp_torc <> comma - , text "but" <+> case mb_thing of - Nothing -> text "found a" - Just thing -> quotes (ppr thing) <+> text "is a" - <+> ppr_torc act_torc ] - - msg_same_torc act_torc act_rep - | Just exp_doc <- describe_rep exp_rep - , Just act_doc <- describe_rep act_rep - = sep [ text "Expected" <+> exp_doc <+> ppr_torc exp_torc <> comma - , text "but" <+> case mb_thing of - Just thing -> quotes (ppr thing) <+> text "is" - Nothing -> text "got" - <+> act_doc <+> ppr_torc act_torc ] - msg_same_torc _ _ = bale_out_msg - - ct_loc = errorItemCtLoc item - orig = errorItemOrigin item - level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel - ppr_invis_bits = shouldPprWithInvisibleBits ty1 ty2 orig - - num_args_msg = case level of - KindLevel - | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act) - -- if one is a meta-tyvar, then it's possible that the user - -- has asked for something impredicative, and we couldn't unify. - -- Don't bother with counting arguments. - -> let n_act = count_args act - n_exp = count_args exp in - case n_act - n_exp of - n | n > 0 -- we don't know how many args there are, so don't - -- recommend removing args that aren't - , Just thing <- mb_thing - -> Just $ pprTcSolverReportMsg ctxt (ExpectingMoreArguments n thing) - _ -> Nothing - - _ -> Nothing - - maybe_num_args_msg = num_args_msg `orElse` empty - - count_args ty = count isVisiblePiTyBinder $ fst $ splitPiTys ty - - ppr_torc TypeLike = text "type"; - ppr_torc ConstraintLike = text "constraint" - - describe_rep :: RuntimeRepType -> Maybe SDoc - -- describe_rep IntRep = Just "an IntRep" - -- describe_rep (BoxedRep Lifted) = Just "a lifted" - -- etc - describe_rep rep - | Just (rr_tc, rr_args) <- splitRuntimeRep_maybe rep - = case rr_args of - [lev_ty] | rr_tc `hasKey` boxedRepDataConKey - , Just lev <- levityType_maybe lev_ty - -> case lev of - Lifted -> Just (text "a lifted") - Unlifted -> Just (text "a boxed unlifted") - [] | rr_tc `hasKey` tupleRepDataConTyConKey -> Just (text "a zero-bit") - | starts_with_vowel rr_occ -> Just (text "an" <+> text rr_occ) - | otherwise -> Just (text "a" <+> text rr_occ) - where - rr_occ = occNameString (getOccName rr_tc) - - _ -> Nothing -- Must be TupleRep [r1..rn] - | otherwise = Nothing - - starts_with_vowel (c:_) = c `elem` ("AEIOU" :: String) - starts_with_vowel [] = False - -pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) - = main_msg $$ - case supplementary of - Left infos - -> vcat (map (pprExpectedActualInfo ctxt) infos) - Right other_msg - -> pprMismatchMsg ctxt other_msg - where - main_msg - | null useful_givens - = addArising ct_loc (no_instance_msg <+> missing) - | otherwise - = vcat (addArising ct_loc (no_deduce_msg <+> missing) - : pp_givens useful_givens) - - supplementary = case mb_extra of - Nothing - -> Left [] - Just (CND_Extra level ty1 ty2) - -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig - ct_loc = errorItemCtLoc item - orig = ctLocOrigin ct_loc - wanteds = map errorItemPred (item:others) - - no_instance_msg = - case wanteds of - [wanted] | Just (tc, _) <- splitTyConApp_maybe wanted - -- Don't say "no instance" for a constraint such as "c" for a type variable c. - , isClassTyCon tc -> text "No instance for" - _ -> text "Could not solve:" - - no_deduce_msg = - case wanteds of - [_wanted] -> text "Could not deduce" - _ -> text "Could not deduce:" - - missing = - case wanteds of - [wanted] -> quotes (ppr wanted) - _ -> pprTheta wanteds - - --- | Whether to print explicit kinds (with @-fprint-explicit-kinds@) --- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types. --- See Note [Showing invisible bits of types in error messages] --- --- This function first checks to see if the 'CtOrigin' argument is a --- 'TypeEqOrigin'. If so, it first checks whether the equality is a visible --- equality; if it's not, definitely print the kinds. Even if the equality is --- a visible equality, check the expected/actual types to see if the types --- have equal visible components. If the 'CtOrigin' is --- not a 'TypeEqOrigin', fall back on the actual mismatched types themselves. -shouldPprWithInvisibleBits :: Type -> Type -> CtOrigin -> Bool -shouldPprWithInvisibleBits _ty1 _ty2 (TypeEqOrigin { uo_actual = act - , uo_expected = exp - , uo_visible = vis }) - | not vis = True -- See tests T15870, T16204c - | otherwise = mayLookIdentical act exp -- See tests T9171, T9144. -shouldPprWithInvisibleBits ty1 ty2 _ct - = mayLookIdentical ty1 ty2 - -{- Note [Showing invisible bits of types in error messages] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It can be terribly confusing to get an error message like (#9171) - - Couldn't match expected type ‘GetParam Base (GetParam Base Int)’ - with actual type ‘GetParam Base (GetParam Base Int)’ - -The reason may be that the kinds don't match up. Typically you'll get -more useful information, but not when it's as a result of ambiguity. - -To mitigate this, when we find a type or kind mis-match: - -* See if normally-visible parts of the type would make the two types - look different. This check is made by - `GHC.Core.TyCo.Compare.mayLookIdentical` - -* If not, display the types with their normally-visible parts made visible, - by setting flags in the `SDocContext": - Specifically: - - Display kind arguments: sdocPrintExplicitKinds - - Don't default away runtime-reps: sdocPrintExplicitRuntimeReps, - which controls `GHC.Iface.Type.hideNonStandardTypes` - (NB: foralls are always printed by pprType, it turns out.) - -As a result the above error message would instead be displayed as: - - Couldn't match expected type - ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’ - with actual type - ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’ - -Which makes it clearer that the culprit is the mismatch between `k2` and `k20`. - -Another example of what goes wrong without this: #24553. --} - -{- ********************************************************************* -* * - Displaying potential instances -* * -**********************************************************************-} - --- | Directly display the given matching and unifying instances, --- with a header for each: `Matching instances`/`Potentially matching instances`. -pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc -pprPotentialInstances ppr_inst (PotentialInstances { matches, unifiers }) = - vcat - [ ppWhen (not $ null matches) $ - text "Matching instance" <> plural matches <> colon $$ - nest 2 (vcat (map ppr_inst matches)) - , ppWhen (not $ null unifiers) $ - (text "Potentially matching instance" <> plural unifiers <> colon) $$ - nest 2 (vcat (map ppr_inst unifiers)) - ] - --- | Display a summary of available instances, omitting those involving --- out-of-scope types, in order to explain why we couldn't solve a particular --- constraint, e.g. due to instance overlap or out-of-scope types. --- --- To directly display a collection of matching/unifying instances, --- use 'pprPotentialInstances'. -potentialInstancesErrMsg :: PotentialInstances -> SDoc --- See Note [Displaying potential instances] -potentialInstancesErrMsg potentials = - sdocOption sdocPrintPotentialInstances $ \print_insts -> - getPprStyle $ \sty -> - potentials_msg_with_options potentials print_insts sty - --- | Display a summary of available instances, omitting out-of-scope ones. --- --- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing --- options. -potentials_msg_with_options :: PotentialInstances - -> Bool -- ^ Whether to print /all/ potential instances - -> PprStyle - -> SDoc -potentials_msg_with_options - (PotentialInstances { matches, unifiers }) - show_all_potentials sty - | null matches && null unifiers - = empty - - | null show_these_matches && null show_these_unifiers - = vcat [ not_in_scope_msg empty - , flag_hint ] - - | otherwise - = vcat [ pprPotentialInstances - pprInstance -- print instance + location info - (PotentialInstances - { matches = show_these_matches - , unifiers = show_these_unifiers }) - , overlapping_but_not_more_specific_msg sorted_matches - , nest 2 $ vcat - [ ppWhen (n_in_scope_hidden > 0) $ - text "...plus" - <+> speakNOf n_in_scope_hidden (text "other") - , ppWhen (not_in_scopes > 0) $ - not_in_scope_msg (text "...plus") - , flag_hint ] ] - where - n_show_matches, n_show_unifiers :: Int - n_show_matches = 3 - n_show_unifiers = 2 - - (in_scope_matches, not_in_scope_matches) = partition inst_in_scope matches - (in_scope_unifiers, not_in_scope_unifiers) = partition inst_in_scope unifiers - sorted_matches = sortBy fuzzyClsInstCmp in_scope_matches - sorted_unifiers = sortBy fuzzyClsInstCmp in_scope_unifiers - (show_these_matches, show_these_unifiers) - | show_all_potentials = (sorted_matches, sorted_unifiers) - | otherwise = (take n_show_matches sorted_matches - ,take n_show_unifiers sorted_unifiers) - n_in_scope_hidden - = length sorted_matches + length sorted_unifiers - - length show_these_matches - length show_these_unifiers - - -- "in scope" means that all the type constructors - -- are lexically in scope; these instances are likely - -- to be more useful - inst_in_scope :: ClsInst -> Bool - inst_in_scope cls_inst = nameSetAll name_in_scope $ - orphNamesOfTypes (is_tys cls_inst) - - name_in_scope name - | pretendNameIsInScope name - = True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names - | Just mod <- nameModule_maybe name - = qual_in_scope (qualName sty mod (nameOccName name)) - | otherwise - = True - - qual_in_scope :: QualifyName -> Bool - qual_in_scope NameUnqual = True - qual_in_scope (NameQual {}) = True - qual_in_scope _ = False - - not_in_scopes :: Int - not_in_scopes = length not_in_scope_matches + length not_in_scope_unifiers - - not_in_scope_msg herald = - hang (herald <+> speakNOf not_in_scopes (text "instance") - <+> text "involving out-of-scope types") - 2 (ppWhen show_all_potentials $ - pprPotentialInstances - pprInstanceHdr -- only print the header, not the instance location info - (PotentialInstances - { matches = not_in_scope_matches - , unifiers = not_in_scope_unifiers - })) - - flag_hint = ppUnless (show_all_potentials - || (equalLength show_these_matches matches - && equalLength show_these_unifiers unifiers)) $ - text "(use -fprint-potential-instances to see them all)" - --- | Compute a message informing the user of any instances that are overlapped --- but were not discarded because the instance overlapping them wasn't --- strictly more specific. -overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc -overlapping_but_not_more_specific_msg insts - -- Only print one example of "overlapping but not strictly more specific", - -- to avoid information overload. - | overlap : _ <- overlapping_but_not_more_specific - = overlap_header $$ ppr_overlapping overlap - | otherwise - = empty - where - overlap_header :: SDoc - overlap_header - | [_] <- overlapping_but_not_more_specific - = text "An overlapping instance can only be chosen when it is strictly more specific." - | otherwise - = text "Overlapping instances can only be chosen when they are strictly more specific." - overlapping_but_not_more_specific :: [(ClsInst, ClsInst)] - overlapping_but_not_more_specific - = nubOrdBy (comparing (is_dfun . fst)) - [ (overlapper, overlappee) - | these <- groupBy ((==) `on` is_cls_nm) insts - -- Take all pairs of distinct instances... - , one:others <- tails these -- if `these = [inst_1, inst_2, ...]` - , other <- others -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j` - -- ... such that one instance in the pair overlaps the other... - , let mb_overlapping - | hasOverlappingFlag (overlapMode $ is_flag one) - || hasOverlappableFlag (overlapMode $ is_flag other) - = [(one, other)] - | hasOverlappingFlag (overlapMode $ is_flag other) - || hasOverlappableFlag (overlapMode $ is_flag one) - = [(other, one)] - | otherwise - = [] - , (overlapper, overlappee) <- mb_overlapping - -- ... but the overlapper is not more specific than the overlappee. - , not (overlapper `more_specific_than` overlappee) - ] - more_specific_than :: ClsInst -> ClsInst -> Bool - is1 `more_specific_than` is2 - = isJust (tcMatchTys (is_tys is1) (is_tys is2)) - ppr_overlapping :: (ClsInst, ClsInst) -> SDoc - ppr_overlapping (overlapper, overlappee) - = text "The first instance that follows overlaps the second, but is not more specific than it:" - $$ nest 2 (vcat $ map pprInstanceHdr [overlapper, overlappee]) - -{- Note [Displaying potential instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When showing a list of instances for - - overlapping instances (show ones that match) - - no such instance (show ones that could match) -we want to give it a bit of structure. Here's the plan - -* Say that an instance is "in scope" if all of the - type constructors it mentions are lexically in scope. - These are the ones most likely to be useful to the programmer. - -* Show at most n_show in-scope instances, - and summarise the rest ("plus N others") - -* Summarise the not-in-scope instances ("plus 4 not in scope") - -* Add the flag -fshow-potential-instances which replaces the - summary with the full list --} - -{- ********************************************************************* -* * - Outputting additional solver report information -* * -**********************************************************************-} - --- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'. -pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc -pprExpectedActualInfo _ (ExpectedActual { ea_expected = exp, ea_actual = act }) = - vcat - [ text "Expected:" <+> ppr exp - , text " Actual:" <+> ppr act ] -pprExpectedActualInfo _ - (ExpectedActualAfterTySynExpansion - { ea_expanded_expected = exp - , ea_expanded_actual = act } ) - = vcat - [ text "Type synonyms expanded:" - , text "Expected type:" <+> ppr exp - , text " Actual type:" <+> ppr act ] - -pprCoercibleMsg :: CoercibleMsg -> SDoc -pprCoercibleMsg (UnknownRoles ty) = - note $ "We cannot know what roles the parameters to" <+> quotes (ppr ty) <+> "have;" $$ - "we must assume that the role is nominal" -pprCoercibleMsg (TyConIsAbstract tc) = - note $ "The type constructor" <+> quotes (pprSourceTyCon tc) <+> "is abstract" -pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) = - hang (text "The data constructor" <+> quotes (ppr $ dataConName dc)) - 2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc) - , text "is not in scope" ]) - -pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc -pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = - sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions -> - if printExplicitCoercions - || not (cty1 `pickyEqType` cty2) - then vcat [ hang (text "When matching" <+> sub_whats) - 2 (vcat [ ppr cty1 <+> dcolon <+> - ppr (typeKind cty1) - , ppr cty2 <+> dcolon <+> - ppr (typeKind cty2) ]) - , supplementary ] - else text "When matching the kind of" <+> quotes (ppr cty1) - where - sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel - sub_whats = text (levelString sub_t_or_k) <> char 's' - supplementary = - case mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o of - Left infos -> vcat $ map (pprExpectedActualInfo ctxt) infos - Right msg -> pprMismatchMsg ctxt msg - -pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc -pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2, thisTyVarIsUntouchable = mb_implic }) - = vcat [ mk_msg tv1 - , maybe empty (pprUntouchableVariable tv1) mb_implic - , case mb_tv2 of { Nothing -> empty; Just tv2 -> mk_msg tv2 } ] - where - mk_msg tv = case tcTyVarDetails tv of - SkolemTv sk_info _ _ -> pprSkols ctxt [(getSkolemInfo sk_info, [tv])] - RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem" - MetaTv {} -> empty - -pprAmbiguityInfo :: AmbiguityInfo -> SDoc -pprAmbiguityInfo (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg - where - - msg | any isRuntimeUnkSkol ambig_kvs -- See Note [Runtime skolems] - || any isRuntimeUnkSkol ambig_tvs - = vcat [ text "Cannot resolve unknown runtime type" - <> plural ambig_tvs <+> pprQuotedList ambig_tvs - , text "Use :print or :force to determine these types"] - - | not (null ambig_tvs) - = pp_ambig (text "type") ambig_tvs - - | otherwise - = pp_ambig (text "kind") ambig_kvs - - pp_ambig what tkvs - | prepend_msg -- "Ambiguous type variable 't0'" - = text "Ambiguous" <+> what <+> text "variable" - <> plural tkvs <+> pprQuotedList tkvs - - | otherwise -- "The type variable 't0' is ambiguous" - = text "The" <+> what <+> text "variable" <> plural tkvs - <+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous" -pprAmbiguityInfo (NonInjectiveTyFam tc) = - note $ quotes (ppr tc) <+> text "is a non-injective type family" - -pprSameOccInfo :: SameOccInfo -> SDoc -pprSameOccInfo (SameOcc same_pkg n1 n2) = - note (ppr_from same_pkg n1 $$ ppr_from same_pkg n2) - where - ppr_from same_pkg nm - | isGoodSrcSpan loc - = hang (quotes (ppr nm) <+> text "is defined at") - 2 (ppr loc) - | otherwise -- Imported things have an UnhelpfulSrcSpan - = hang (quotes (ppr nm)) - 2 (sep [ text "is defined in" <+> quotes (ppr (moduleName mod)) - , ppUnless (same_pkg || pkg == mainUnit) $ - nest 4 $ text "in package" <+> quotes (ppr pkg) ]) - where - pkg = moduleUnit mod - mod = nameModule nm - loc = nameSrcSpan nm - -{- ********************************************************************* -* * - Outputting HoleError messages -* * -**********************************************************************-} - -pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc -pprHoleError _ (Hole { hole_ty, hole_occ = rdr }) (OutOfScopeHole imp_errs _hints) - = out_of_scope_msg $$ vcat (map ppr imp_errs) - where - herald | isDataOcc (rdrNameOcc rdr) = text "Data constructor not in scope:" - | otherwise = text "Variable not in scope:" - out_of_scope_msg -- Print v :: ty only if the type has structure - | boring_type = hang herald 2 (ppr rdr) - | otherwise = hang herald 2 (pp_rdr_with_type rdr hole_ty) - boring_type = isTyVarTy hole_ty -pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_skol_info) = - vcat [ hole_msg - , tyvars_msg - , case sort of { ExprHole {} -> expr_hole_hint; _ -> type_hole_hint } ] - - where - - hole_msg = case sort of - ExprHole {} -> - hang (text "Found hole:") - 2 (pp_rdr_with_type hole_occ hole_ty) - TypeHole -> - hang (text "Found type wildcard" <+> quotes (ppr hole_occ)) - 2 (text "standing for" <+> quotes pp_hole_type_with_kind) - ConstraintHole -> - hang (text "Found extra-constraints wildcard standing for") - 2 (quotes $ pprType hole_ty) -- always kind Constraint - - hole_kind = typeKind hole_ty - - pp_hole_type_with_kind - | isLiftedTypeKind hole_kind - || isCoVarType hole_ty -- Don't print the kind of unlifted - -- equalities (#15039) - = pprType hole_ty - | otherwise - = pprType hole_ty <+> dcolon <+> pprKind hole_kind - - tyvars = tyCoVarsOfTypeList hole_ty - tyvars_msg = ppUnless (null tyvars) $ - text "Where:" <+> (vcat (map loc_msg other_tvs) - $$ pprSkols ctxt hole_skol_info) - -- Coercion variables can be free in the - -- hole, via kind casts - expr_hole_hint -- Give hint for, say, f x = _x - | lengthFS (occNameFS (rdrNameOcc hole_occ)) > 1 -- Don't give this hint for plain "_" - = text "Or perhaps" <+> quotes (ppr hole_occ) - <+> text "is mis-spelled, or not in scope" - | otherwise - = empty - - type_hole_hint - | ErrorWithoutFlag <- cec_type_holes ctxt - = text "To use the inferred type, enable PartialTypeSignatures" - | otherwise - = empty - - loc_msg tv - | isTyVar tv - = case tcTyVarDetails tv of - MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable" - _ -> empty -- Skolems dealt with already - | otherwise -- A coercion variable can be free in the hole type - = ppWhenOption sdocPrintExplicitCoercions $ - quotes (ppr tv) <+> text "is a coercion variable" - -pp_rdr_with_type :: RdrName -> Type -> SDoc -pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty) - -{- ********************************************************************* -* * - Outputting ScopeError messages -* * -**********************************************************************-} - -pprScopeError :: RdrName -> NotInScopeError -> SDoc -pprScopeError rdr_name scope_err = - case scope_err of - NotInScope -> - hang (text "Not in scope:") - 2 (what <+> quotes (ppr rdr_name)) - NotARecordField -> - hang (text "Not in scope:") - 2 (text "record field" <+> quotes (ppr rdr_name)) - NoExactName name -> - text "The Name" <+> quotes (ppr name) <+> text "is not in scope." - SameName gres -> - assertPpr (length gres >= 2) (text "pprScopeError SameName: fewer than 2 elements" $$ nest 2 (ppr gres)) - $ hang (text "Same Name in multiple name-spaces:") - 2 (vcat (map pp_one sorted_names)) - where - sorted_names = sortBy (leftmost_smallest `on` nameSrcSpan) - $ map greName gres - pp_one name - = hang (pprNameSpace (occNameSpace (getOccName name)) - <+> quotes (ppr name) <> comma) - 2 (text "declared at:" <+> ppr (nameSrcLoc name)) - MissingBinding thing _ -> - sep [ text "The" <+> thing - <+> text "for" <+> quotes (ppr rdr_name) - , nest 2 $ text "lacks an accompanying binding" ] - NoTopLevelBinding -> - hang (text "No top-level binding for") - 2 (what <+> quotes (ppr rdr_name) <+> text "in this module") - UnknownSubordinate doc -> - quotes (ppr rdr_name) <+> text "is not a (visible)" <+> doc - NotInScopeTc env -> - vcat[text "GHC internal error:" <+> quotes (ppr rdr_name) <+> - text "is not in scope during type checking, but it passed the renamer", - text "tcl_env of environment:" <+> ppr env] - where - what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) - -scopeErrorHints :: NotInScopeError -> [GhcHint] -scopeErrorHints scope_err = - case scope_err of - NotInScope -> noHints - NotARecordField -> noHints - NoExactName {} -> [SuggestDumpSlices] - SameName {} -> [SuggestDumpSlices] - MissingBinding _ hints -> hints - NoTopLevelBinding -> noHints - UnknownSubordinate {} -> noHints - NotInScopeTc _ -> noHints - -tcSolverReportMsgHints :: SolverReportErrCtxt -> TcSolverReportMsg -> [GhcHint] -tcSolverReportMsgHints ctxt = \case - BadTelescope {} - -> noHints - UserTypeError {} - -> noHints - UnsatisfiableError {} - -> noHints - ReportHoleError hole err - -> holeErrorHints hole err - CannotUnifyVariable mismatch_msg rea - -> mismatchMsgHints ctxt mismatch_msg ++ cannotUnifyVariableHints rea - Mismatch { mismatchMsg = mismatch_msg } - -> mismatchMsgHints ctxt mismatch_msg - FixedRuntimeRepError {} - -> noHints - BlockedEquality {} - -> noHints - ExpectingMoreArguments {} - -> noHints - UnboundImplicitParams {} - -> noHints - AmbiguityPreventsSolvingCt {} - -> noHints - CannotResolveInstance {} - -> noHints - OverlappingInstances {} - -> noHints - UnsafeOverlap {} - -> noHints - -mismatchMsgHints :: SolverReportErrCtxt -> MismatchMsg -> [GhcHint] -mismatchMsgHints ctxt msg = - maybeToList [ hint | (exp,act) <- mismatchMsg_ExpectedActuals msg - , hint <- suggestAddSig ctxt exp act ] - -mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type) -mismatchMsg_ExpectedActuals = \case - BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } -> - Just (exp, act) - KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } -> - Just (exp, act) - TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } -> - Just (exp,act) - CouldNotDeduce { cnd_extra = cnd_extra } - | Just (CND_Extra _ exp act) <- cnd_extra - -> Just (exp, act) - | otherwise - -> Nothing - -holeErrorHints :: Hole -> HoleError -> [GhcHint] -holeErrorHints _hole = \case - OutOfScopeHole _ hints - -> hints - HoleError {} - -> noHints - -cannotUnifyVariableHints :: CannotUnifyVariableReason -> [GhcHint] -cannotUnifyVariableHints = \case - CannotUnifyWithPolytype {} - -> noHints - OccursCheck {} - -> noHints - SkolemEscape {} - -> noHints - DifferentTyVars {} - -> noHints - RepresentationalEq {} - -> noHints - -suggestAddSig :: SolverReportErrCtxt -> TcType -> TcType -> Maybe GhcHint --- See Note [Suggest adding a type signature] -suggestAddSig ctxt ty1 _ty2 - | bndr : bndrs <- inferred_bndrs - = Just $ SuggestAddTypeSignatures $ NamedBindings (bndr :| bndrs) - | otherwise - = Nothing - where - inferred_bndrs = - case getTyVar_maybe ty1 of - Just tv | isSkolemTyVar tv -> find (cec_encl ctxt) False tv - _ -> [] - - -- 'find' returns the binders of an InferSkol for 'tv', - -- provided there is an intervening implication with - -- ic_given_eqs /= NoGivenEqs (i.e. a GADT match) - find [] _ _ = [] - find (implic:implics) seen_eqs tv - | tv `elem` ic_skols implic - , InferSkol prs <- ic_info implic - , seen_eqs - = map fst prs - | otherwise - = find implics (seen_eqs || ic_given_eqs implic /= NoGivenEqs) tv - -{- Note [Suggest adding a type signature] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The OutsideIn algorithm rejects GADT programs that don't have a principal -type, and indeed some that do. Example: - data T a where - MkT :: Int -> T Int - - f (MkT n) = n - -Does this have type f :: T a -> a, or f :: T a -> Int? -The error that shows up tends to be an attempt to unify an -untouchable type variable. So suggestAddSig sees if the offending -type variable is bound by an *inferred* signature, and suggests -adding a declared signature instead. - -More specifically, we suggest adding a type sig if we have p ~ ty, and -p is a skolem bound by an InferSkol. Those skolems were created from -unification variables in simplifyInfer. Why didn't we unify? It must -have been because of an intervening GADT or existential, making it -untouchable. Either way, a type signature would help. For GADTs, it -might make it typeable; for existentials the attempt to write a -signature will fail -- or at least will produce a better error message -next time - -This initially came up in #8968, concerning pattern synonyms. --} - -{- ********************************************************************* -* * - Outputting ImportError messages -* * -**********************************************************************-} - -instance Outputable ImportError where - ppr err = note $ case err of - MissingModule mod_name -> "No module named" <+> quoted mod_name <+> "is imported" - ModulesDoNotExport mods occ_name - | mod NE.:| [] <- mods -> "The module" <+> quoted mod <+> "does not export" <+> quoted occ_name - | otherwise -> "Neither" <+> quotedListWithNor (map ppr $ NE.toList mods) <+> "export" <+> quoted occ_name - where - quoted :: Outputable a => a -> SDoc - quoted = quotes . ppr - -{- ********************************************************************* -* * - Suggested fixes for implication constraints -* * -**********************************************************************-} - --- TODO: these functions should use GhcHint instead. - -show_fixes :: [SDoc] -> SDoc -show_fixes [] = empty -show_fixes (f:fs) = sep [ text "Possible fix:" - , nest 2 (vcat (f : map (text "or" <+>) fs))] - -ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc] -ctxtFixes has_ambig_tvs pred implics - | not has_ambig_tvs - , isTyVarClassPred pred -- Don't suggest adding (Eq T) to the context, say - , (skol:skols) <- usefulContext implics pred - , let what | null skols - , SigSkol (PatSynCtxt {}) _ _ <- skol - = text "\"required\"" - | otherwise - = empty - = [sep [ text "add" <+> pprParendType pred - <+> text "to the" <+> what <+> text "context of" - , nest 2 $ ppr_skol skol $$ - vcat [ text "or" <+> ppr_skol skol - | skol <- skols ] ] ] - | otherwise = [] - where - ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc) - ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps) - ppr_skol skol_info = ppr skol_info - -usefulContext :: [Implication] -> PredType -> [SkolemInfoAnon] --- usefulContext picks out the implications whose context --- the programmer might plausibly augment to solve 'pred' -usefulContext implics pred - = go implics - where - pred_tvs = tyCoVarsOfType pred - go [] = [] - go (ic : ics) - | implausible ic = rest - | otherwise = ic_info ic : rest - where - -- Stop when the context binds a variable free in the predicate - rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = [] - | otherwise = go ics - - implausible ic - | null (ic_skols ic) = True - | implausible_info (ic_info ic) = True - | otherwise = False - - implausible_info (SigSkol (InfSigCtxt {}) _ _) = True - implausible_info _ = False - -- Do not suggest adding constraints to an *inferred* type signature - -pp_givens :: [Implication] -> [SDoc] -pp_givens givens - = case givens of - [] -> [] - (g:gs) -> ppr_given (text "from the context:") g - : map (ppr_given (text "or from:")) gs - where - ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info }) - = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs)) - -- See Note [Suppress redundant givens during error reporting] - -- for why we use mkMinimalBySCs above. - 2 (sep [ text "bound by" <+> ppr skol_info - , text "at" <+> ppr (getCtLocEnvLoc (ic_env implic)) ]) - -{- ********************************************************************* -* * - CtOrigin information -* * -**********************************************************************-} - -levelString :: TypeOrKind -> String -levelString TypeLevel = "type" -levelString KindLevel = "kind" - -pprArising :: CtLoc -> SDoc --- Used for the main, top-level error message --- We've done special processing for TypeEq, KindEq, givens -pprArising ct_loc - | in_generated_code = empty -- See Note ["Arising from" messages in generated code] - | suppress_origin = empty - | otherwise = pprCtOrigin orig - where - orig = ctLocOrigin ct_loc - in_generated_code = ctLocEnvInGeneratedCode (ctLocEnv ct_loc) - suppress_origin - | isGivenOrigin orig = True - | otherwise = case orig of - TypeEqOrigin {} -> True -- We've done special processing - KindEqOrigin {} -> True -- for TypeEq, KindEq, givens - AmbiguityCheckOrigin {} -> True -- The "In the ambiguity check" context - -- is sufficient; more would be repetitive - _ -> False - --- Add the "arising from..." part to a message -addArising :: CtLoc -> SDoc -> SDoc -addArising ct_loc msg = hang msg 2 (pprArising ct_loc) - -pprWithArising :: [Ct] -> SDoc --- Print something like --- (Eq a) arising from a use of x at y --- (Show a) arising from a use of p at q --- Also return a location for the error message --- Works for Wanted/Derived only -pprWithArising [] - = panic "pprWithArising" -pprWithArising (ct:cts) - | null cts - = addArising loc (pprTheta [ctPred ct]) - | otherwise - = vcat (map ppr_one (ct:cts)) - where - loc = ctLoc ct - ppr_one ct' = hang (parens (pprType (ctPred ct'))) - 2 (pprCtLoc (ctLoc ct')) - -{- Note ["Arising from" messages in generated code] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider code generated when we desugar code before typechecking; -see Note [Rebindable syntax and XXExprGhcRn]. - -In this code, constraints may be generated, but we don't want to -say "arising from a call of foo" if 'foo' doesn't appear in the -users code. We leave the actual CtOrigin untouched (partly because -it is generated in many, many places), but suppress the "Arising from" -message for constraints that originate in generated code. --} - - -{- ********************************************************************* -* * - SkolemInfo -* * -**********************************************************************-} - - -tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo -tidySkolemInfo env (SkolemInfo u sk_anon) = SkolemInfo u (tidySkolemInfoAnon env sk_anon) - ----------------- -tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon -tidySkolemInfoAnon env (DerivSkol ty) = DerivSkol (tidyType env ty) -tidySkolemInfoAnon env (SigSkol cx ty tv_prs) = tidySigSkol env cx ty tv_prs -tidySkolemInfoAnon env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids) -tidySkolemInfoAnon env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty) -tidySkolemInfoAnon _ info = info - -tidySigSkol :: TidyEnv -> UserTypeCtxt - -> TcType -> [(Name,TcTyVar)] -> SkolemInfoAnon --- We need to take special care when tidying SigSkol --- See Note [SigSkol SkolemInfo] in "GHC.Tc.Types.Origin" -tidySigSkol env cx ty tv_prs - = SigSkol cx (tidy_ty env ty) tv_prs' - where - tv_prs' = mapSnd (tidyTyCoVarOcc env) tv_prs - inst_env = mkNameEnv tv_prs' - - tidy_ty env (ForAllTy (Bndr tv vis) ty) - = ForAllTy (Bndr tv' vis) (tidy_ty env' ty) - where - (env', tv') = tidy_tv_bndr env tv - - tidy_ty env ty@(FunTy { ft_mult = w, ft_arg = arg, ft_res = res }) - = -- Look under c => t and t1 -> t2 - ty { ft_mult = tidy_ty env w - , ft_arg = tidyType env arg - , ft_res = tidy_ty env res } - - tidy_ty env ty = tidyType env ty - - tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar) - tidy_tv_bndr env@(occ_env, subst) tv - | Just tv' <- lookupNameEnv inst_env (tyVarName tv) - = ((occ_env, extendVarEnv subst tv tv'), tv') - - | otherwise - = tidyVarBndr env tv - -pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc -pprSkols ctxt zonked_ty_vars - = - let tidy_ty_vars = map (bimap (tidySkolemInfoAnon (cec_tidy ctxt)) id) zonked_ty_vars - in vcat (map pp_one tidy_ty_vars) - where - - no_msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr zonked_ty_vars - $$ text "This should not happen, please report it as a bug following the instructions at:" - $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug" - - - pp_one (UnkSkol cs, tvs) - = vcat [ hang (pprQuotedList tvs) - 2 (is_or_are tvs "a" "(rigid, skolem)") - , nest 2 (text "of unknown origin") - , nest 2 (text "bound at" <+> ppr (skolsSpan tvs)) - , no_msg - , prettyCallStackDoc cs - ] - pp_one (RuntimeUnkSkol, tvs) - = hang (pprQuotedList tvs) - 2 (is_or_are tvs "an" "unknown runtime") - pp_one (skol_info, tvs) - = vcat [ hang (pprQuotedList tvs) - 2 (is_or_are tvs "a" "rigid" <+> text "bound by") - , nest 2 (pprSkolInfo skol_info) - , nest 2 (text "at" <+> ppr (skolsSpan tvs)) ] - - is_or_are [_] article adjective = text "is" <+> text article <+> text adjective - <+> text "type variable" - is_or_are _ _ adjective = text "are" <+> text adjective - <+> text "type variables" - -skolsSpan :: [TcTyVar] -> SrcSpan -skolsSpan skol_tvs = foldr1 combineSrcSpans (map getSrcSpan skol_tvs) - -{- ********************************************************************* -* * - Utilities for expected/actual messages -* * -**********************************************************************-} - -mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind - -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg -mk_supplementary_ea_msg ctxt level ty1 ty2 orig - | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig - , not (ea_looks_same ty1 ty2 exp act) - = mk_ea_msg ctxt Nothing level orig - | otherwise - = Left [] - -ea_looks_same :: Type -> Type -> Type -> Type -> Bool --- True if the faulting types (ty1, ty2) look the same as --- the expected/actual types (exp, act). --- If so, we don't want to redundantly report the latter -ea_looks_same ty1 ty2 exp act - = (act `looks_same` ty1 && exp `looks_same` ty2) || - (exp `looks_same` ty1 && act `looks_same` ty2) - where - looks_same t1 t2 = t1 `pickyEqType` t2 - || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind - -- pickyEqType is sensitive to synonyms, so only replies True - -- when the types really look the same. However, - -- (TYPE 'LiftedRep) and Type both print the same way. - -mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind - -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg --- Constructs a "Couldn't match" message --- The (Maybe ErrorItem) says whether this is the main top-level message (Just) --- or a supplementary message (Nothing) -mk_ea_msg ctxt at_top level - (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing }) - | Just thing <- mb_thing - , KindLevel <- level - = Right $ KindMismatch { kmismatch_what = thing - , kmismatch_expected = exp - , kmismatch_actual = act } - | Just item <- at_top - , let ea = EA $ if expanded_syns then Just ea_expanded else Nothing - mismatch = mkBasicMismatchMsg ea item exp act - = Right mismatch - | otherwise - = Left $ - if expanded_syns - then [ea,ea_expanded] - else [ea] - - where - ea = ExpectedActual { ea_expected = exp, ea_actual = act } - ea_expanded = - ExpectedActualAfterTySynExpansion - { ea_expanded_expected = expTy1 - , ea_expanded_actual = expTy2 } - - expanded_syns = cec_expand_syns ctxt - && not (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) - (expTy1, expTy2) = expandSynonymsToMatch exp act -mk_ea_msg _ _ _ _ = Left [] - -{- Note [Expanding type synonyms to make types similar] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -In type error messages, if -fprint-expanded-types is used, we want to expand -type synonyms to make expected and found types as similar as possible, but we -shouldn't expand types too much to make type messages even more verbose and -harder to understand. The whole point here is to make the difference in expected -and found types clearer. - -`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms -only as much as necessary. Given two types t1 and t2: - - * If they're already same, it just returns the types. - - * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are - type constructors), it expands C1 and C2 if they're different type synonyms. - Then it recursively does the same thing on expanded types. If C1 and C2 are - same, then it applies the same procedure to arguments of C1 and arguments of - C2 to make them as similar as possible. - - Most important thing here is to keep number of synonym expansions at - minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3, - Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and - `T (T3, T3, Bool)`. - - * Otherwise types don't have same shapes and so the difference is clearly - visible. It doesn't do any expansions and show these types. - -Note that we only expand top-layer type synonyms. Only when top-layer -constructors are the same we start expanding inner type synonyms. - -Suppose top-layer type synonyms of t1 and t2 can expand N and M times, -respectively. If their type-synonym-expanded forms will meet at some point (i.e. -will have same shapes according to `sameShapes` function), it's possible to find -where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M)) -comparisons. We first collect all the top-layer expansions of t1 and t2 in two -lists, then drop the prefix of the longer list so that they have same lengths. -Then we search through both lists in parallel, and return the first pair of -types that have same shapes. Inner types of these two types with same shapes -are then expanded using the same algorithm. - -In case they don't meet, we return the last pair of types in the lists, which -has top-layer type synonyms completely expanded. (in this case the inner types -are not expanded at all, as the current form already shows the type error) --} - --- | Expand type synonyms in given types only enough to make them as similar as --- possible. Returned types are the same in terms of used type synonyms. --- --- To expand all synonyms, see 'Type.expandTypeSynonyms'. --- --- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for --- some examples of how this should work. -expandSynonymsToMatch :: Type -> Type -> (Type, Type) -expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret) - where - (ty1_ret, ty2_ret) = go ty1 ty2 - - -- Returns (type synonym expanded version of first type, - -- type synonym expanded version of second type) - go :: Type -> Type -> (Type, Type) - go t1 t2 - | t1 `pickyEqType` t2 = - -- Types are same, nothing to do - (t1, t2) - - go (TyConApp tc1 tys1) (TyConApp tc2 tys2) - | tc1 == tc2 - , tys1 `equalLength` tys2 = - -- Type constructors are same. They may be synonyms, but we don't - -- expand further. The lengths of tys1 and tys2 must be equal; - -- for example, with type S a = a, we don't want - -- to zip (S Monad Int) and (S Bool). - let (tys1', tys2') = - unzip (zipWithEqual "expandSynonymsToMatch" go tys1 tys2) - in (TyConApp tc1 tys1', TyConApp tc2 tys2') - - go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) = - let (t1_1', t2_1') = go t1_1 t2_1 - (t1_2', t2_2') = go t1_2 t2_2 - in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2') - - go ty1@(FunTy _ w1 t1_1 t1_2) ty2@(FunTy _ w2 t2_1 t2_2) | w1 `eqType` w2 = - let (t1_1', t2_1') = go t1_1 t2_1 - (t1_2', t2_2') = go t1_2 t2_2 - in ( ty1 { ft_arg = t1_1', ft_res = t1_2' } - , ty2 { ft_arg = t2_1', ft_res = t2_2' }) - - go (ForAllTy b1 t1) (ForAllTy b2 t2) = - -- NOTE: We may have a bug here, but we just can't reproduce it easily. - -- See D1016 comments for details and our attempts at producing a test - -- case. Short version: We probably need RnEnv2 to really get this right. - let (t1', t2') = go t1 t2 - in (ForAllTy b1 t1', ForAllTy b2 t2') - - go (CastTy ty1 _) ty2 = go ty1 ty2 - go ty1 (CastTy ty2 _) = go ty1 ty2 - - go t1 t2 = - -- See Note [Expanding type synonyms to make types similar] for how this - -- works - let - t1_exp_tys = t1 : tyExpansions t1 - t2_exp_tys = t2 : tyExpansions t2 - t1_exps = length t1_exp_tys - t2_exps = length t2_exp_tys - dif = abs (t1_exps - t2_exps) - in - followExpansions $ - zipEqual "expandSynonymsToMatch.go" - (if t1_exps > t2_exps then drop dif t1_exp_tys else t1_exp_tys) - (if t2_exps > t1_exps then drop dif t2_exp_tys else t2_exp_tys) - - -- Expand the top layer type synonyms repeatedly, collect expansions in a - -- list. The list does not include the original type. - -- - -- Example, if you have: - -- - -- type T10 = T9 - -- type T9 = T8 - -- ... - -- type T0 = Int - -- - -- `tyExpansions T10` returns [T9, T8, T7, ..., Int] - -- - -- This only expands the top layer, so if you have: - -- - -- type M a = Maybe a - -- - -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded) - tyExpansions :: Type -> [Type] - tyExpansions = unfoldr (\t -> (\x -> (x, x)) `fmap` coreView t) - - -- Drop the type pairs until types in a pair look alike (i.e. the outer - -- constructors are the same). - followExpansions :: [(Type, Type)] -> (Type, Type) - followExpansions [] = pprPanic "followExpansions" empty - followExpansions [(t1, t2)] - | sameShapes t1 t2 = go t1 t2 -- expand subtrees - | otherwise = (t1, t2) -- the difference is already visible - followExpansions ((t1, t2) : tss) - -- Traverse subtrees when the outer shapes are the same - | sameShapes t1 t2 = go t1 t2 - -- Otherwise follow the expansions until they look alike - | otherwise = followExpansions tss - - sameShapes :: Type -> Type -> Bool - sameShapes AppTy{} AppTy{} = True - sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2 - sameShapes (FunTy {}) (FunTy {}) = True - sameShapes (ForAllTy {}) (ForAllTy {}) = True - sameShapes (CastTy ty1 _) ty2 = sameShapes ty1 ty2 - sameShapes ty1 (CastTy ty2 _) = sameShapes ty1 ty2 - sameShapes _ _ = False - -{- -************************************************************************ -* * -\subsection{Contexts for renaming errors} -* * -************************************************************************ --} - -inHsDocContext :: HsDocContext -> SDoc -inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt - -pprHsDocContext :: HsDocContext -> SDoc -pprHsDocContext (GenericCtx doc) = doc -pprHsDocContext (TypeSigCtx doc) = text "the type signature for" <+> doc -pprHsDocContext (StandaloneKindSigCtx doc) = text "the standalone kind signature for" <+> doc -pprHsDocContext PatCtx = text "a pattern type-signature" -pprHsDocContext SpecInstSigCtx = text "a SPECIALISE instance pragma" -pprHsDocContext DefaultDeclCtx = text "a `default' declaration" -pprHsDocContext DerivDeclCtx = text "a deriving declaration" -pprHsDocContext (RuleCtx name) = text "the rewrite rule" <+> doubleQuotes (ftext name) -pprHsDocContext (TyDataCtx tycon) = text "the data type declaration for" <+> quotes (ppr tycon) -pprHsDocContext (FamPatCtx tycon) = text "a type pattern of family instance for" <+> quotes (ppr tycon) -pprHsDocContext (TySynCtx name) = text "the declaration for type synonym" <+> quotes (ppr name) -pprHsDocContext (TyFamilyCtx name) = text "the declaration for type family" <+> quotes (ppr name) -pprHsDocContext (ClassDeclCtx name) = text "the declaration for class" <+> quotes (ppr name) -pprHsDocContext ExprWithTySigCtx = text "an expression type signature" -pprHsDocContext TypBrCtx = text "a Template-Haskell quoted type" -pprHsDocContext HsTypeCtx = text "a type argument" -pprHsDocContext HsTypePatCtx = text "a type argument in a pattern" -pprHsDocContext GHCiCtx = text "GHCi input" -pprHsDocContext (SpliceTypeCtx hs_ty) = text "the spliced type" <+> quotes (ppr hs_ty) -pprHsDocContext ClassInstanceCtx = text "GHC.Tc.Gen.Splice.reifyInstances" - -pprHsDocContext (ForeignDeclCtx name) - = text "the foreign declaration for" <+> quotes (ppr name) -pprHsDocContext (ConDeclCtx [name]) - = text "the definition of data constructor" <+> quotes (ppr name) -pprHsDocContext (ConDeclCtx names) - = text "the definition of data constructors" <+> interpp'SP names - -pprConversionFailReason :: ConversionFailReason -> SDoc -pprConversionFailReason = \case - IllegalOccName ctxt_ns occ -> - text "Illegal" <+> pprNameSpace ctxt_ns - <+> text "name:" <+> quotes (text occ) - SumAltArityExceeded alt arity -> - text "Sum alternative" <+> int alt - <+> text "exceeds its arity," <+> int arity - IllegalSumAlt alt -> - vcat [ text "Illegal sum alternative:" <+> int alt - , nest 2 $ text "Sum alternatives must start from 1" ] - IllegalSumArity arity -> - vcat [ text "Illegal sum arity:" <+> int arity - , nest 2 $ text "Sums must have an arity of at least 2" ] - MalformedType typeOrKind ty -> - text "Malformed " <> text ty_str <+> text (show ty) - where ty_str = case typeOrKind of - TypeLevel -> "type" - KindLevel -> "kind" - IllegalLastStatement do_or_lc stmt -> - vcat [ text "Illegal last statement of" <+> pprAHsDoFlavour do_or_lc <> colon - , nest 2 $ ppr stmt - , text "(It should be an expression.)" ] - KindSigsOnlyAllowedOnGADTs -> - text "Kind signatures are only allowed on GADTs" - IllegalDeclaration declDescr bad_decls -> - sep [ text "Illegal" <+> what <+> text "in" <+> descrDoc <> colon - , nest 2 bads ] - where - (what, bads) = case bad_decls of - IllegalDecls (NE.toList -> decls) -> - (text "declaration" <> plural decls, vcat $ map ppr decls) - IllegalFamDecls (NE.toList -> decls) -> - ( text "family declaration" <> plural decls, vcat $ map ppr decls) - descrDoc = text $ case declDescr of - InstanceDecl -> "an instance declaration" - WhereClause -> "a where clause" - LetBinding -> "a let expression" - LetExpression -> "a let expression" - ClssDecl -> "a class declaration" - CannotMixGADTConsWith98Cons -> - text "Cannot mix GADT constructors with Haskell 98" - <+> text "constructors" - EmptyStmtListInDoBlock -> - text "Empty stmt list in do-block" - NonVarInInfixExpr -> - text "Non-variable expression is not allowed in an infix expression" - MultiWayIfWithoutAlts -> - text "Multi-way if-expression with no alternatives" - CasesExprWithoutAlts -> - text "\\cases expression with no alternatives" - ImplicitParamsWithOtherBinds -> - text "Implicit parameters mixed with other bindings" - InvalidCCallImpent from -> - text (show from) <+> text "is not a valid ccall impent" - RecGadtNoCons -> - quotes (text "RecGadtC") <+> text "must have at least one constructor name" - GadtNoCons -> - quotes (text "GadtC") <+> text "must have at least one constructor name" - InvalidTypeInstanceHeader tys -> - text "Invalid type instance header:" - <+> text (show tys) - InvalidTyFamInstLHS lhs -> - text "Invalid type family instance LHS:" - <+> text (show lhs) - InvalidImplicitParamBinding -> - text "Implicit parameter binding only allowed in let or where" - DefaultDataInstDecl adts -> - (text "Default data instance declarations" - <+> text "are not allowed:") - $$ ppr adts - FunBindLacksEquations nm -> - text "Function binding for" - <+> quotes (text (TH.pprint nm)) - <+> text "has no equations" - -pprTyThingUsedWrong :: WrongThingSort -> TcTyThing -> Name -> SDoc -pprTyThingUsedWrong sort thing name = - pprTcTyThingCategory thing <+> quotes (ppr name) <+> - text "used as a" <+> pprWrongThingSort sort - -pprWrongThingSort :: WrongThingSort -> SDoc -pprWrongThingSort = - text . \case - WrongThingType -> "type" - WrongThingDataCon -> "data constructor" - WrongThingPatSyn -> "pattern synonym" - WrongThingConLike -> "constructor-like thing" - WrongThingClass -> "class" - WrongThingTyCon -> "type constructor" - WrongThingAxiom -> "axiom" - -pprStageCheckReason :: StageCheckReason -> SDoc -pprStageCheckReason = \case - StageCheckInstance _ t -> - text "instance for" <+> quotes (ppr t) - StageCheckSplice t -> - quotes (ppr t) - -pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc -pprUninferrableTyVarCtx = \case - UninfTyCtx_ClassContext theta -> - sep [ text "the class context:", pprTheta theta ] - UninfTyCtx_DataContext theta -> - sep [ text "the datatype context:", pprTheta theta ] - UninfTyCtx_ProvidedContext theta -> - sep [ text "the provided context:" , pprTheta theta ] - UninfTyCtx_TyFamRhs rhs_ty -> - sep [ text "the type family equation right-hand side:" , ppr rhs_ty ] - UninfTyCtx_TySynRhs rhs_ty -> - sep [ text "the type synonym right-hand side:" , ppr rhs_ty ] - UninfTyCtx_Sig exp_kind full_hs_ty -> - hang (text "the kind" <+> ppr exp_kind) 2 - (text "of the type signature:" <+> ppr full_hs_ty) - -pprPatSynInvalidRhsReason :: PatSynInvalidRhsReason -> SDoc -pprPatSynInvalidRhsReason = \case - PatSynNotInvertible p -> - text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" - PatSynUnboundVar var -> - quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" - -pprBadFieldAnnotationReason :: BadFieldAnnotationReason -> SDoc -pprBadFieldAnnotationReason = \case - LazyFieldsDisabled -> - text "Lazy field annotations (~) are disabled" - UnpackWithoutStrictness -> - text "UNPACK pragma lacks '!'" - BackpackUnpackAbstractType -> - text "Ignoring unusable UNPACK pragma" - -pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc -pprSuperclassCycleDetail = \case - SCD_HeadTyVar pred -> - hang (text "one of whose superclass constraints is headed by a type variable:") - 2 (quotes (ppr pred)) - SCD_HeadTyFam pred -> - hang (text "one of whose superclass constraints is headed by a type family:") - 2 (quotes (ppr pred)) - SCD_Superclass cls -> - text "one of whose superclasses is" <+> quotes (ppr cls) - -pprRoleValidationFailedReason :: Role -> RoleValidationFailedReason -> SDoc -pprRoleValidationFailedReason role = \case - TyVarRoleMismatch tv role' -> - text "type variable" <+> quotes (ppr tv) <+> - text "cannot have role" <+> ppr role <+> - text "because it was assigned role" <+> ppr role' - TyVarMissingInEnv tv -> - text "type variable" <+> quotes (ppr tv) <+> text "missing in environment" - BadCoercionRole co -> - text "coercion" <+> ppr co <+> text "has bad role" <+> ppr role - -pprDisabledClassExtension :: Class -> DisabledClassExtension -> SDoc -pprDisabledClassExtension cls = \case - MultiParamDisabled n -> - text howMany <+> text "parameters for class" <+> quotes (ppr cls) - where - howMany | n == 0 = "No" - | otherwise = "Too many" - FunDepsDisabled -> - text "Fundeps in class" <+> quotes (ppr cls) - ConstrainedClassMethodsDisabled sel_id pred -> - vcat [ hang (text "Constraint" <+> quotes (ppr pred) - <+> text "in the type of" <+> quotes (ppr sel_id)) - 2 (text "constrains only the class type variables")] - -pprImportLookup :: ImportLookupReason -> SDoc -pprImportLookup = \case - ImportLookupBad k iface decl_spec ie _ps -> - let - pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc - pprImpDeclSpec iface decl_spec = - quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of - IsBoot -> text "(hi-boot interface)" - NotBoot -> empty - withContext msgs = - hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) - 2 (vcat msgs) - in case k of - BadImportNotExported _ -> - vcat - [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> - text "does not export" <+> quotes (ppr ie) <> dot - ] - BadImportAvailVar -> - withContext - [ text "an item called" - <+> quotes val <+> text "is exported, but it is not a type." - ] - where - val_occ = rdrNameOcc $ ieName ie - val = parenSymOcc val_occ (ppr val_occ) - BadImportAvailTyCon {} -> - withContext - [ text "an item called" - <+> quotes tycon <+> text "is exported, but it is a type." - ] - where - tycon_occ = rdrNameOcc $ ieName ie - tycon = parenSymOcc tycon_occ (ppr tycon_occ) - BadImportNotExportedSubordinates ns -> - withContext - [ text "an item called" <+> quotes sub <+> text "is exported, but it does not export any children" - , text "(constructors, class methods or field names) called" - <+> pprWithCommas (quotes . ppr) ns <> dot - ] - where - sub_occ = rdrNameOcc $ ieName ie - sub = parenSymOcc sub_occ (ppr sub_occ) - BadImportAvailDataCon dataType_occ -> - withContext - [ text "an item called" <+> quotes datacon - , text "is exported, but it is a data constructor of" - , quotes dataType <> dot - ] - where - datacon_occ = rdrNameOcc $ ieName ie - datacon = parenSymOcc datacon_occ (ppr datacon_occ) - dataType = parenSymOcc dataType_occ (ppr dataType_occ) - ImportLookupQualified rdr -> - hang (text "Illegal qualified name in import item:") - 2 (ppr rdr) - ImportLookupIllegal -> - text "Illegal import item" - ImportLookupAmbiguous rdr gres -> - hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") - 2 (vcat (map (ppr . greOccName) gres)) - -pprUnusedImport :: ImportDecl GhcRn -> UnusedImportReason -> SDoc -pprUnusedImport decl = \case - UnusedImportNone -> - vcat [ pp_herald <+> quotes pp_mod <+> text "is redundant" - , nest 2 (text "except perhaps to import instances from" - <+> quotes pp_mod) - , text "To import instances alone, use:" - <+> text "import" <+> pp_mod <> parens empty ] - UnusedImportSome sort_unused -> - sep [ pp_herald <+> quotes (pprWithCommas pp_unused sort_unused) - , text "from module" <+> quotes pp_mod <+> text "is redundant"] - where - pp_mod = ppr (unLoc (ideclName decl)) - pp_herald = text "The" <+> pp_qual <+> text "import of" - pp_qual - | isImportDeclQualified (ideclQualified decl) = text "qualified" - | otherwise = empty - pp_unused = \case - UnusedImportNameRegular n -> - pprNameUnqualified n - UnusedImportNameRecField par fld_occ -> - case par of - ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) - NoParent -> ppr fld_occ - -pprUnusedName :: OccName -> UnusedNameProv -> SDoc -pprUnusedName name reason = - sep [ msg <> colon - , nest 2 $ pprNonVarNameSpace (occNameSpace name) - <+> quotes (ppr name)] - where - msg = case reason of - UnusedNameTopDecl -> - defined - UnusedNameImported mod -> - text "Imported from" <+> quotes (ppr mod) <+> text "but not used" - UnusedNameTypePattern -> - defined <+> text "on the right hand side" - UnusedNameMatch -> - defined - UnusedNameLocalBind -> - defined - defined = text "Defined but not used" - --- When printing the name, take care to qualify it in the same --- way as the provenance reported by pprNameProvenance, namely --- the head of 'gre_imp'. Otherwise we get confusing reports like --- Ambiguous occurrence ‘null’ --- It could refer to either ‘T15487a.null’, --- imported from ‘Prelude’ at T15487.hs:1:8-13 --- or ... --- See #15487 -pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc -pprAmbiguousGreName gre_env gre - | IAmRecField fld_info <- greInfo gre - = sep [ text "the field" <+> quotes (ppr occ) <+> parent_info fld_info <> comma - , pprNameProvenance gre ] - | otherwise - = sep [ quotes (pp_qual <> dot <> ppr occ) <> comma - , pprNameProvenance gre ] - - where - occ = greOccName gre - parent_info fld_info = - case first_con of - PatSynName ps -> text "of pattern synonym" <+> quotes (ppr ps) - DataConName {} -> - case greParent gre of - ParentIs par - -- For a data family, only reporting the family TyCon can be - -- unhelpful (see T23301). So we give a bit of additional - -- info in that case. - | Just par_gre <- lookupGRE_Name gre_env par - , IAmTyCon tc_flav <- greInfo par_gre - , OpenFamilyFlavour IAmData _ <- tc_flav - -> vcat [ ppr_cons - , text "in a data family instance of" <+> quotes (ppr par) ] - | otherwise - -> text "of record" <+> quotes (ppr par) - NoParent -> ppr_cons - where - cons :: [ConLikeName] - cons = nonDetEltsUniqSet $ recFieldCons fld_info - first_con :: ConLikeName - first_con = head cons - ppr_cons :: SDoc - ppr_cons = hsep [ text "belonging to data constructor" - , quotes (ppr $ nameOccName $ conLikeName_Name first_con) - , if length cons > 1 then parens (text "among others") else empty - ] - pp_qual - | gre_lcl gre - = ppr (nameModule $ greName gre) - | Just imp <- headMaybe $ gre_imp gre - -- This 'imp' is the one that - -- pprNameProvenance chooses - , ImpDeclSpec { is_as = mod } <- is_decl imp - = ppr mod - | otherwise - = pprPanic "addNameClassErrRn" (ppr gre) - -- Invariant: either 'lcl' is True or 'iss' is non-empty - -pprNonCanonicalDefinition :: LHsSigType GhcRn - -> NonCanonicalDefinition - -> SDoc -pprNonCanonicalDefinition inst_ty = \case - NonCanonicalMonoid sub -> case sub of - NonCanonical_Sappend -> - msg1 "(<>)" "mappend" - NonCanonical_Mappend -> - msg2 "mappend" "(<>)" - NonCanonicalMonad sub -> case sub of - NonCanonical_Pure -> - msg1 "pure" "return" - NonCanonical_ThenA -> - msg1 "(*>)" "(>>)" - NonCanonical_Return -> - msg2 "return" "pure" - NonCanonical_ThenM -> - msg2 "(>>)" "(*>)" - where - msg1 :: String -> String -> SDoc - msg1 lhs rhs = - vcat [ text "Noncanonical" <+> - quotes (text (lhs ++ " = " ++ rhs)) <+> - text "definition detected" - , inst - ] - - msg2 :: String -> String -> SDoc - msg2 lhs rhs = - vcat [ text "Noncanonical" <+> - quotes (text lhs) <+> - text "definition detected" - , inst - , quotes (text lhs) <+> - text "will eventually be removed in favour of" <+> - quotes (text rhs) - ] - - inst = instDeclCtxt1 inst_ty - - -- stolen from GHC.Tc.TyCl.Instance - instDeclCtxt1 :: LHsSigType GhcRn -> SDoc - instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) - - inst_decl_ctxt :: SDoc -> SDoc - inst_decl_ctxt doc = hang (text "in the instance declaration for") - 2 (quotes doc <> text ".") - -suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint] -suggestNonCanonicalDefinition reason = - [action doc] - where - action = case reason of - NonCanonicalMonoid sub -> case sub of - NonCanonical_Sappend -> move sappendName mappendName - NonCanonical_Mappend -> remove mappendName sappendName - NonCanonicalMonad sub -> case sub of - NonCanonical_Pure -> move pureAName returnMName - NonCanonical_ThenA -> move thenAName thenMName - NonCanonical_Return -> remove returnMName pureAName - NonCanonical_ThenM -> remove thenMName thenAName - - move = SuggestMoveNonCanonicalDefinition - remove = SuggestRemoveNonCanonicalDefinition - - doc = case reason of - NonCanonicalMonoid _ -> doc_monoid - NonCanonicalMonad _ -> doc_monad - - doc_monoid = - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" - doc_monad = - "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" - -suggestDefaultDeclaration :: Class-> [Type] -> [[Type]] -> [GhcHint] -suggestDefaultDeclaration cls prefix seqs = - [SuggestDefaultDeclaration cls $ supersequence (prefix : seqs)] - where - -- Not exactly the shortest possible supersequence, but it preserves - -- the head sequence as the prefix of the result which is a requirement. - supersequence :: [[Type]] -> [Type] - supersequence [] = [] - supersequence ([] : seqs) = supersequence seqs - supersequence ((x : xs) : seqs) = - x : supersequence (xs : (dropHead x <$> seqs)) - dropHead x ys@(y : ys') - | tcEqType x y = ys' - | otherwise = ys - dropHead _ [] = [] - --------------------------------------------------------------------------------- --- hs-boot mismatch errors - -pprBootMismatch :: HsBootOrSig -> BootMismatch -> SDoc -pprBootMismatch boot_or_sig = \case - MissingBootThing nm err -> - let def_or_exp = case err of - MissingBootDefinition -> text "defined in" - MissingBootExport -> text "exported by" - in quotes (ppr nm) <+> text "is exported by the" - <+> ppr_boot_or_sig <> comma - <+> text "but not" - <+> def_or_exp <+> text "the implementing module." - MissingBootInstance boot_dfun -> - hang (text "instance" <+> ppr (idType boot_dfun)) - 2 (text "is defined in the" <+> ppr ppr_boot_or_sig <> comma <+> - text "but not in the implementing module.") - BadReexportedBootThing name name' -> - withUserStyle alwaysQualify AllTheWay $ vcat - [ text "The" <+> ppr_boot_or_sig - <+> text "(re)exports" <+> quotes (ppr name) - , text "but the implementing module exports a different identifier" <+> quotes (ppr name') - ] - BootMismatch boot_thing real_thing err -> - vcat - [ ppr real_thing <+> - text "has conflicting definitions in the module" - , text "and its" <+> ppr_boot_or_sig <> dot, - text "Main module:" <+> real_doc - , (case boot_or_sig of - HsBoot -> text " Boot file:" - Hsig -> text " Hsig file:") <+> boot_doc - , pprBootMismatchWhat boot_or_sig err - ] - where - to_doc - = pprTyThingInContext $ - showToHeader - { ss_forall = - case boot_or_sig of - HsBoot -> ShowForAllMust - Hsig -> ShowForAllWhen } - - real_doc = to_doc real_thing - boot_doc = to_doc boot_thing - - where - ppr_boot_or_sig = case boot_or_sig of - HsBoot -> text "hs-boot file" - Hsig -> text "hsig file" - - -pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc -pprBootMismatchWhat boot_or_sig = \case - BootMismatchedIdTypes {} -> - text "The two types are different." - BootMismatchedTyCons tc1 tc2 errs -> - vcat $ map (pprBootTyConMismatch boot_or_sig tc1 tc2) (NE.toList errs) - -pprBootTyConMismatch :: HsBootOrSig -> TyCon -> TyCon - -> BootTyConMismatch -> SDoc -pprBootTyConMismatch boot_or_sig tc1 tc2 = \case - TyConKindMismatch -> - text "The types have different kinds." - TyConRoleMismatch sub_type -> - if sub_type - then - text "The roles are not compatible:" $$ - text "Main module:" <+> ppr (tyConRoles tc1) $$ - text " Hsig file:" <+> ppr (tyConRoles tc2) - else - text "The roles do not match." $$ - if boot_or_sig == HsBoot - then note $ "Roles on abstract types default to" <+> quotes "representational" <+> "in hs-boot files" - else empty - TyConSynonymMismatch {} -> empty -- nothing interesting to say - TyConFlavourMismatch fam_flav1 fam_flav2 -> - whenPprDebug $ - text "Family flavours" <+> ppr fam_flav1 <+> text "and" <+> ppr fam_flav2 <+> - text "do not match" - TyConAxiomMismatch ax_errs -> - pprBootListMismatches (text "Type family equations do not match:") - pprTyConAxiomMismatch ax_errs - TyConInjectivityMismatch {} -> - text "Injectivity annotations do not match" - TyConMismatchedClasses _ _ err -> - pprBootClassMismatch boot_or_sig err - TyConMismatchedData _rhs1 _rhs2 err -> - pprBootDataMismatch err - SynAbstractData err -> - pprSynAbstractDataError err - TyConsVeryDifferent -> - empty -- should be obvious to the user what the problem is - -pprSynAbstractDataError :: SynAbstractDataError -> SDoc -pprSynAbstractDataError = \case - SynAbsDataTySynNotNullary -> - text "Illegal parameterized type synonym in implementation of abstract data." - SynAbstractDataInvalidRHS bad_sub_tys -> - let msgs = mapMaybe pprInvalidAbstractSubTy (NE.toList bad_sub_tys) - in case msgs of - [] -> herald <> dot - msg:[] -> hang (herald <> colon) - 2 msg - _ -> hang (herald <> colon) - 2 (vcat $ map (<+> bullet) msgs) - - where - herald = text "Illegal implementation of abstract data" - pprInvalidAbstractSubTy = \case - TyConApp tc _ - -> assertPpr (isTypeFamilyTyCon tc) (ppr tc) $ - Just $ text "Invalid type family" <+> quotes (ppr tc) <> dot - ty@(ForAllTy {}) - -> Just $ text "Invalid polymorphic type" <> colon <+> ppr ty <> dot - ty@(FunTy af _ _ _) - | not (af == FTF_T_T) - -> Just $ text "Invalid qualified type" <> colon <+> ppr ty <> dot - _ -> Nothing - -pprTyConAxiomMismatch :: BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc -pprTyConAxiomMismatch = \case - MismatchedLength -> - text "The number of equations differs." - MismatchedThing i br1 br2 err -> - hang (text "The" <+> speakNth (i+1) <+> text "equations do not match.") - 2 (pprCoAxBranchMismatch br1 br2 err) - -pprCoAxBranchMismatch :: CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc -pprCoAxBranchMismatch _br1 _br2 err = - text "The" <+> what <+> text "don't match." - where - what = case err of - MismatchedAxiomBinders -> text "variables bound in the equation" - MismatchedAxiomLHS -> text "equation left-hand sides" - MismatchedAxiomRHS -> text "equation right-hand sides" - -pprBootListMismatches :: SDoc -- ^ herald - -> (BootListMismatch item err -> SDoc) - -> BootListMismatches item err -> SDoc -pprBootListMismatches herald ppr_one errs = - hang herald 2 msgs - where - msgs = case errs of - err :| [] -> ppr_one err - _ -> vcat $ map ((bullet <+>) . ppr_one) $ NE.toList errs - -pprBootClassMismatch :: HsBootOrSig -> BootClassMismatch -> SDoc -pprBootClassMismatch boot_or_sig = \case - MismatchedMethods errs -> - pprBootListMismatches (text "The class methods do not match:") - pprBootClassMethodListMismatch errs - MismatchedATs at_errs -> - pprBootListMismatches (text "The associated types do not match:") - (pprATMismatch boot_or_sig) at_errs - MismatchedFunDeps -> - text "The functional dependencies do not match." - MismatchedSuperclasses -> - text "The superclass constraints do not match." - MismatchedMinimalPragmas -> - text "The MINIMAL pragmas are not compatible." - -pprATMismatch :: HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc -pprATMismatch boot_or_sig = \case - MismatchedLength -> - text "The number of associated type defaults differs." - MismatchedThing i at1 at2 err -> - pprATMismatchErr boot_or_sig i at1 at2 err - -pprATMismatchErr :: HsBootOrSig -> Int -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc -pprATMismatchErr boot_or_sig i (ATI tc1 _) (ATI tc2 _) = \case - MismatchedTyConAT err -> - hang (text "The associated types differ:") - 2 $ pprBootTyConMismatch boot_or_sig tc1 tc2 err - MismatchedATDefaultType -> - text "The types of the" <+> speakNth (i+1) <+> - text "associated type default differ." - -pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc -pprBootClassMethodListMismatch = \case - MismatchedLength -> - text "The number of class methods differs." - MismatchedThing _ op1 op2 err -> - pprBootClassMethodMismatch op1 op2 err - -pprBootClassMethodMismatch :: ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc -pprBootClassMethodMismatch (op1, _) (op2, _) = \case - MismatchedMethodNames -> - text "The method names" <+> quotes pname1 <+> text "and" - <+> quotes pname2 <+> text "differ." - MismatchedMethodTypes {} -> - text "The types of" <+> pname1 <+> text "are different." - MismatchedDefaultMethods subtype_check -> - if subtype_check - then - text "The default methods associated with" <+> pname1 <+> - text "are not compatible." - else - text "The default methods associated with" <+> pname1 <+> - text "are different." - where - nm1 = idName op1 - nm2 = idName op2 - pname1 = quotes (ppr nm1) - pname2 = quotes (ppr nm2) - -pprBootDataMismatch :: BootDataMismatch -> SDoc -pprBootDataMismatch = \case - MismatchedNewtypeVsData -> - text "Cannot match a" <+> quotes (text "data") <+> - text "definition with a" <+> quotes (text "newtype") <+> - text "definition." - MismatchedConstructors dc_errs -> - pprBootListMismatches (text "The constructors do not match:") - pprBootDataConMismatch dc_errs - MismatchedDatatypeContexts {} -> - text "The datatype contexts do not match." - -pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch - -> SDoc -pprBootDataConMismatch = \case - MismatchedLength -> - text "The number of constructors differs." - MismatchedThing _ dc1 dc2 err -> - pprBootDataConMismatchErr dc1 dc2 err - -pprBootDataConMismatchErr :: DataCon -> DataCon -> BootDataConMismatch -> SDoc -pprBootDataConMismatchErr dc1 dc2 = \case - MismatchedDataConNames -> - text "The names" <+> pname1 <+> text "and" <+> pname2 <+> text "differ." - MismatchedDataConFixities -> - text "The fixities of" <+> pname1 <+> text "differ." - MismatchedDataConBangs -> - text "The strictness annotations for" <+> pname1 <+> text "differ." - MismatchedDataConFieldLabels -> - text "The record label lists for" <+> pname1 <+> text "differ." - MismatchedDataConTypes -> - text "The types for" <+> pname1 <+> text "differ." - where - name1 = dataConName dc1 - name2 = dataConName dc2 - pname1 = quotes (ppr name1) - pname2 = quotes (ppr name2) - --------------------------------------------------------------------------------- --- Illegal instance errors - -pprIllegalInstance :: IllegalInstanceReason -> SDoc -pprIllegalInstance = \case - IllegalClassInstance head_ty reason -> - pprIllegalClassInstanceReason head_ty reason - IllegalFamilyInstance reason -> - pprIllegalFamilyInstance reason - IllegalFamilyApplicationInInstance inst_ty invis_arg tf_tc tf_args -> - pprWithInvisibleBitsWhen invis_arg $ - hang (text "Illegal type synonym family application" - <+> quotes (ppr tf_ty) <+> text "in instance" <> colon) - 2 (ppr inst_ty) - where - tf_ty = mkTyConApp tf_tc tf_args - -pprIllegalClassInstanceReason :: TypedThing -> IllegalClassInstanceReason -> SDoc -pprIllegalClassInstanceReason head_ty = \case - IllegalInstanceHead reason -> - pprIllegalInstanceHeadReason head_ty reason - IllegalHasFieldInstance has_field_err -> - with_illegal_instance_header head_ty $ - pprIllegalHasFieldInstance has_field_err - IllegalSpecialClassInstance cls because_safeHaskell -> - text "Class" <+> quotes (ppr $ className cls) - <+> text "does not support user-specified instances" - <> safeHaskell_msg - where - safeHaskell_msg - | because_safeHaskell - = text " when Safe Haskell is enabled." - | otherwise - = dot - IllegalInstanceFailsCoverageCondition cls coverage_failure -> - with_illegal_instance_header head_ty $ - pprNotCovered cls coverage_failure - -pprIllegalInstanceHeadReason :: TypedThing - -> IllegalInstanceHeadReason -> SDoc -pprIllegalInstanceHeadReason head_ty = \case - InstHeadTySynArgs -> with_illegal_instance_header head_ty $ - text "All instance types must be of the form (T t1 ... tn)" $$ - text "where T is not a synonym." - InstHeadNonTyVarArgs -> with_illegal_instance_header head_ty $ vcat [ - text "All instance types must be of the form (T a1 ... an)", - text "where a1 ... an are *distinct type variables*,", - text "and each type variable appears at most once in the instance head."] - InstHeadMultiParam -> with_illegal_instance_header head_ty $ parens $ - text "Only one type can be given in an instance head." - InstHeadAbstractClass clas -> - text "Cannot define instance for abstract class" <+> - quotes (ppr (className clas)) - InstHeadNonClass bad_head -> - vcat [ text "Illegal" <+> what_illegal <> dot - , text "Instance heads must be of the form" - , nest 2 $ text "C ty_1 ... ty_n" - , text "where" <+> quotes (char 'C') <+> text "is a class." - ] - where - what_illegal = case bad_head of - Just tc -> - text "instance for" <+> ppr (tyConFlavour tc) <+> quotes (ppr $ tyConName tc) - Nothing -> - text "head of an instance declaration:" <+> quotes (ppr head_ty) - -with_illegal_instance_header :: TypedThing -> SDoc -> SDoc -with_illegal_instance_header head_ty msg = - hang (hang (text "Illegal instance declaration for") - 2 (quotes (ppr head_ty)) <> colon) - 2 msg - -pprIllegalHasFieldInstance :: IllegalHasFieldInstance -> SDoc -pprIllegalHasFieldInstance = \case - IllegalHasFieldInstanceNotATyCon - -> text "Record data type must be specified." - IllegalHasFieldInstanceFamilyTyCon - -> text "Record data type may not be a data family." - IllegalHasFieldInstanceTyConHasField tc lbl - -> quotes (ppr tc) <+> text "already has a field" <+> quotes (ppr lbl) <> dot - IllegalHasFieldInstanceTyConHasFields tc lbl - -> sep [ ppr_tc <+> text "has fields, and the type" <+> quotes (ppr lbl) - , text "could unify with one of the field labels of" <+> ppr_tc <> dot ] - where ppr_tc = quotes (ppr tc) - -pprNotCovered :: Class -> CoverageProblem -> SDoc -pprNotCovered clas - CoverageProblem - { not_covered_fundep = fd - , not_covered_fundep_inst = (ls, rs) - , not_covered_invis_vis_tvs = undetermined_tvs - , not_covered_liberal = which_cc_failed - } = - pprWithInvisibleBitsWhen (isEmptyVarSet $ pSnd undetermined_tvs) $ - vcat [ sep [ text "The" - <+> ppWhen liberal (text "liberal") - <+> text "coverage condition fails in class" - <+> quotes (ppr clas) - , nest 2 $ text "for functional dependency:" - <+> quotes (pprFunDep fd) ] - , sep [ text "Reason: lhs type" <> plural ls <+> pprQuotedList ls - , nest 2 $ - (if isSingleton ls - then text "does not" - else text "do not jointly") - <+> text "determine rhs type" <> plural rs - <+> pprQuotedList rs ] - , text "Un-determined variable" <> pluralVarSet undet_set <> colon - <+> pprVarSet undet_set (pprWithCommas ppr) - ] - where - liberal = case which_cc_failed of - FailedLICC -> True - FailedICC {} -> False - undet_set = fold undetermined_tvs - -illegalInstanceHints :: IllegalInstanceReason -> [GhcHint] -illegalInstanceHints = \case - IllegalClassInstance _ reason -> - illegalClassInstanceHints reason - IllegalFamilyInstance reason -> - illegalFamilyInstanceHints reason - IllegalFamilyApplicationInInstance {} -> - noHints - -illegalInstanceReason :: IllegalInstanceReason -> DiagnosticReason -illegalInstanceReason = \case - IllegalClassInstance _ reason -> - illegalClassInstanceReason reason - IllegalFamilyInstance reason -> - illegalFamilyInstanceReason reason - IllegalFamilyApplicationInInstance {} -> - ErrorWithoutFlag - -illegalClassInstanceHints :: IllegalClassInstanceReason -> [GhcHint] -illegalClassInstanceHints = \case - IllegalInstanceHead reason -> - illegalInstanceHeadHints reason - IllegalHasFieldInstance has_field_err -> - illegalHasFieldInstanceHints has_field_err - IllegalSpecialClassInstance {} -> noHints - IllegalInstanceFailsCoverageCondition _ coverage_failure -> - failedCoverageConditionHints coverage_failure - - -illegalClassInstanceReason :: IllegalClassInstanceReason -> DiagnosticReason -illegalClassInstanceReason = \case - IllegalInstanceHead reason -> - illegalInstanceHeadReason reason - IllegalHasFieldInstance has_field_err -> - illegalHasFieldInstanceReason has_field_err - IllegalSpecialClassInstance {} -> ErrorWithoutFlag - IllegalInstanceFailsCoverageCondition _ coverage_failure -> - failedCoverageConditionReason coverage_failure - -illegalInstanceHeadHints :: IllegalInstanceHeadReason -> [GhcHint] -illegalInstanceHeadHints = \case - InstHeadTySynArgs -> - [suggestExtension LangExt.TypeSynonymInstances] - InstHeadNonTyVarArgs -> - [suggestExtension LangExt.FlexibleInstances] - InstHeadMultiParam -> - [suggestExtension LangExt.MultiParamTypeClasses] - InstHeadAbstractClass {} -> - noHints - InstHeadNonClass {} -> - noHints - -illegalInstanceHeadReason :: IllegalInstanceHeadReason -> DiagnosticReason -illegalInstanceHeadReason = \case - -- These are serious - InstHeadAbstractClass {} -> - ErrorWithoutFlag - InstHeadNonClass {} -> - ErrorWithoutFlag - - -- These are less serious (enable an extension) - InstHeadTySynArgs -> - ErrorWithoutFlag - InstHeadNonTyVarArgs -> - ErrorWithoutFlag - InstHeadMultiParam -> - ErrorWithoutFlag - -illegalHasFieldInstanceHints :: IllegalHasFieldInstance -> [GhcHint] -illegalHasFieldInstanceHints = \case - IllegalHasFieldInstanceNotATyCon - -> noHints - IllegalHasFieldInstanceFamilyTyCon - -> noHints - IllegalHasFieldInstanceTyConHasField {} - -> noHints - IllegalHasFieldInstanceTyConHasFields {} - -> noHints - -illegalHasFieldInstanceReason :: IllegalHasFieldInstance -> DiagnosticReason -illegalHasFieldInstanceReason = \case - IllegalHasFieldInstanceNotATyCon - -> ErrorWithoutFlag - IllegalHasFieldInstanceFamilyTyCon - -> ErrorWithoutFlag - IllegalHasFieldInstanceTyConHasField {} - -> ErrorWithoutFlag - IllegalHasFieldInstanceTyConHasFields {} - -> ErrorWithoutFlag - -failedCoverageConditionHints :: CoverageProblem -> [GhcHint] -failedCoverageConditionHints (CoverageProblem { not_covered_liberal = failed_cc }) - = case failed_cc of - FailedLICC -> noHints - FailedICC { alsoFailedLICC = failed_licc } -> - -- Turning on UndecidableInstances makes the check liberal, - -- so if the liberal check passes, suggest enabling UndecidableInstances. - if failed_licc - then noHints - else [suggestExtension LangExt.UndecidableInstances] - -failedCoverageConditionReason :: CoverageProblem -> DiagnosticReason -failedCoverageConditionReason _ = ErrorWithoutFlag - -pprIllegalFamilyInstance :: IllegalFamilyInstanceReason -> SDoc -pprIllegalFamilyInstance = \case - InvalidAssoc reason -> pprInvalidAssoc reason - NotAFamilyTyCon ty_or_data tc -> - vcat [ text "Illegal family instance for" <+> quotes (ppr tc) - , nest 2 $ parens (quotes (ppr tc) <+> text "is not a" <+> what) ] - where - what = ppr ty_or_data <+> text "family" - NotAnOpenFamilyTyCon tc -> - text "Illegal instance for closed family" <+> quotes (ppr tc) - FamilyCategoryMismatch tc -> - text "Wrong category of family instance; declaration was for a" <+> what <> dot - where - what = case tyConFlavour tc of - OpenFamilyFlavour IAmData _ -> text "data family" - _ -> text "type family" - FamilyArityMismatch _ max_args -> - text "Number of parameters must match family declaration; expected" - <+> ppr max_args <> dot - TyFamNameMismatch fam_tc_name eqn_tc_name -> - hang (text "Mismatched type name in type family instance.") - 2 (vcat [ text "Expected:" <+> ppr fam_tc_name - , text " Actual:" <+> ppr eqn_tc_name ]) - FamInstRHSOutOfScopeTyVars mb_dodgy (NE.toList -> tvs) -> - hang (text "Out of scope type variable" <> plural tvs - <+> pprWithCommas (quotes . ppr) tvs - <+> text "in the RHS of a family instance.") - 2 (text "All such variables must be bound on the LHS.") - $$ mk_extra - where - -- mk_extra: #7536: give a decent error message for - -- type T a = Int - -- type instance F (T a) = a - mk_extra = case mb_dodgy of - Nothing -> empty - Just (fam_tc, pats, dodgy_tvs) -> - ppWhen (any (`elemVarSetByKey` dodgy_tvs) (fmap nameUnique tvs)) $ - hang (text "The real LHS (expanding synonyms) is:") - 2 (pprTypeApp fam_tc (map expandTypeSynonyms pats)) - FamInstLHSUnusedBoundTyVars (NE.toList -> bad_qtvs) -> - vcat [ not_bound_msg, not_used_msg, dodgy_msg ] - where - - -- Filter to only keep user-written variables, - -- unless none were user-written in which case we report all of them - -- (as we need to report an error). - filter_user tvs - = map ifiqtv - $ case filter ifiqtv_user_written tvs of { [] -> tvs ; qvs -> qvs } - - (not_bound, not_used, dodgy) - = case foldr acc_tv ([], [], []) bad_qtvs of - (nb, nu, d) -> (filter_user nb, filter_user nu, filter_user d) - - acc_tv tv (nb, nu, d) = case ifiqtv_reason tv of - InvalidFamInstQTvNotUsedInRHS -> (nb, tv : nu, d) - InvalidFamInstQTvNotBoundInPats -> (tv : nb, nu, d) - InvalidFamInstQTvDodgy -> (nb, nu, tv : d) - - -- Error message for type variables not bound in LHS patterns. - not_bound_msg - | null not_bound - = empty - | otherwise - = vcat [ text "The type variable" <> plural not_bound <+> pprQuotedList not_bound - <+> isOrAre not_bound <+> text "bound by a forall," - , text "but" <+> doOrDoes not_bound <+> text "not appear in any of the LHS patterns of the family instance." ] - - -- Error message for type variables bound by a forall but not used - -- in the RHS. - not_used_msg = - if null not_used - then empty - else text "The type variable" <> plural not_used <+> pprQuotedList not_used - <+> isOrAre not_used <+> text "bound by a forall," $$ - text "but" <+> itOrThey not_used <+> - isOrAre not_used <> text "n't used in the family instance." - - -- Error message for dodgy type variables. - -- See Note [Dodgy binding sites in type family instances] in GHC.Tc.Validity. - dodgy_msg - | null dodgy - = empty - | otherwise - = hang (text "Dodgy type variable" <> plural dodgy <+> pprQuotedList dodgy - <+> text "in the LHS of a family instance:") - 2 (text "the type variable" <> plural dodgy <+> pprQuotedList dodgy - <+> text "syntactically appear" <> singular dodgy <+> text "in LHS patterns," - $$ text "but" <+> itOrThey dodgy <+> doOrDoes dodgy <> text "n't appear in an injective position.") - - -illegalFamilyInstanceHints :: IllegalFamilyInstanceReason -> [GhcHint] -illegalFamilyInstanceHints = \case - InvalidAssoc rea -> invalidAssocHints rea - NotAFamilyTyCon {} -> noHints - NotAnOpenFamilyTyCon {} -> noHints - FamilyCategoryMismatch {} -> noHints - FamilyArityMismatch {} -> noHints - TyFamNameMismatch {} -> noHints - FamInstRHSOutOfScopeTyVars {} -> noHints - FamInstLHSUnusedBoundTyVars {} -> noHints - -illegalFamilyInstanceReason :: IllegalFamilyInstanceReason -> DiagnosticReason -illegalFamilyInstanceReason = \case - InvalidAssoc rea -> invalidAssocReason rea - NotAFamilyTyCon {} -> ErrorWithoutFlag - NotAnOpenFamilyTyCon {} -> ErrorWithoutFlag - FamilyCategoryMismatch {} -> ErrorWithoutFlag - FamilyArityMismatch {} -> ErrorWithoutFlag - TyFamNameMismatch {} -> ErrorWithoutFlag - FamInstRHSOutOfScopeTyVars {} -> ErrorWithoutFlag - FamInstLHSUnusedBoundTyVars {} -> ErrorWithoutFlag - -pprInvalidAssoc :: InvalidAssoc -> SDoc -pprInvalidAssoc = \case - InvalidAssocInstance rea -> pprInvalidAssocInstance rea - InvalidAssocDefault rea -> pprInvalidAssocDefault rea - -pprInvalidAssocInstance :: InvalidAssocInstance -> SDoc -pprInvalidAssocInstance = \case - AssocInstanceMissing name -> - text "No explicit" <+> text "associated type" - <+> text "or default declaration for" - <+> quotes (ppr name) - AssocInstanceNotInAClass fam_tc -> - text "Associated type" <+> quotes (ppr fam_tc) <+> - text "must be inside a class instance" - AssocNotInThisClass cls fam_tc -> - hsep [ text "Class", quotes (ppr cls) - , text "does not have an associated type", quotes (ppr fam_tc) ] - AssocNoClassTyVar cls fam_tc -> - sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc))) - , text "mentions none of the type or kind variables of the class" <+> - quotes (ppr cls <+> hsep (map ppr (classTyVars cls)))] - AssocTyVarsDontMatch vis fam_tc exp_tys act_tys -> - pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag vis) $ - vcat [ text "Type indexes must match class instance head" - , text "Expected:" <+> pp exp_tys - , text " Actual:" <+> pp act_tys ] - where - pp tys = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc) $ - toIfaceTcArgs fam_tc tys - -pprInvalidAssocDefault :: InvalidAssocDefault -> SDoc -pprInvalidAssocDefault = \case - AssocDefaultNotAssoc cls tc -> - hsep [ text "Class", quotes (ppr cls) - , text "does not have an associated type", quotes (ppr tc) ] - AssocMultipleDefaults name -> - text "More than one default declaration for" <+> quotes (ppr name) - AssocDefaultBadArgs fam_tc pat_tys bad_arg -> - let (pat_vis, main_msg) = case bad_arg of - AssocDefaultNonTyVarArg (pat_ty, pat_vis) -> - (pat_vis, - text "Illegal argument" <+> quotes (ppr pat_ty) <+> text "in:") - AssocDefaultDuplicateTyVars dups -> - let (pat_tv, pat_vis) = NE.head dups - in (pat_vis, - text "Illegal duplicate variable" <+> quotes (ppr pat_tv) <+> text "in:") - in pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag pat_vis) $ - hang main_msg - 2 (vcat [ppr_eqn, suggestion]) - where - ppr_eqn :: SDoc - ppr_eqn = - quotes (text "type" <+> ppr (mkTyConApp fam_tc pat_tys) - <+> equals <+> text "...") - - suggestion :: SDoc - suggestion = text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be distinct type variables." - -invalidAssocHints :: InvalidAssoc -> [GhcHint] -invalidAssocHints = \case - InvalidAssocInstance rea -> invalidAssocInstanceHints rea - InvalidAssocDefault rea -> invalidAssocDefaultHints rea - -invalidAssocInstanceHints :: InvalidAssocInstance -> [GhcHint] -invalidAssocInstanceHints = \case - AssocInstanceMissing {} -> noHints - AssocInstanceNotInAClass {} -> noHints - AssocNotInThisClass {} -> noHints - AssocNoClassTyVar {} -> noHints - AssocTyVarsDontMatch {} -> noHints - -invalidAssocDefaultHints :: InvalidAssocDefault -> [GhcHint] -invalidAssocDefaultHints = \case - AssocDefaultNotAssoc {} -> noHints - AssocMultipleDefaults {} -> noHints - AssocDefaultBadArgs _ _ bad -> - assocDefaultBadArgHints bad - -assocDefaultBadArgHints :: AssocDefaultBadArgs -> [GhcHint] -assocDefaultBadArgHints = \case - AssocDefaultNonTyVarArg {} -> noHints - AssocDefaultDuplicateTyVars {} -> noHints - -invalidAssocReason :: InvalidAssoc -> DiagnosticReason -invalidAssocReason = \case - InvalidAssocInstance rea -> invalidAssocInstanceReason rea - InvalidAssocDefault rea -> invalidAssocDefaultReason rea - -invalidAssocInstanceReason :: InvalidAssocInstance -> DiagnosticReason -invalidAssocInstanceReason = \case - AssocInstanceMissing {} -> WarningWithFlag (Opt_WarnMissingMethods) - AssocInstanceNotInAClass {} -> ErrorWithoutFlag - AssocNotInThisClass {} -> ErrorWithoutFlag - AssocNoClassTyVar {} -> ErrorWithoutFlag - AssocTyVarsDontMatch {} -> ErrorWithoutFlag - -invalidAssocDefaultReason :: InvalidAssocDefault -> DiagnosticReason -invalidAssocDefaultReason = \case - AssocDefaultNotAssoc {} -> ErrorWithoutFlag - AssocMultipleDefaults {} -> ErrorWithoutFlag - AssocDefaultBadArgs _ _ rea -> - assocDefaultBadArgReason rea - -assocDefaultBadArgReason :: AssocDefaultBadArgs -> DiagnosticReason -assocDefaultBadArgReason = \case - AssocDefaultNonTyVarArg {} -> ErrorWithoutFlag - AssocDefaultDuplicateTyVars {} -> ErrorWithoutFlag - --------------------------------------------------------------------------------- --- Template Haskell quotes and splices - -pprTHError :: THError -> DecoratedSDoc -pprTHError = \case - THSyntaxError err -> pprTHSyntaxError err - THNameError err -> pprTHNameError err - THReifyError err -> pprTHReifyError err - TypedTHError err -> pprTypedTHError err - THSpliceFailed rea -> pprSpliceFailReason rea - AddTopDeclsError err -> pprAddTopDeclsError err - - IllegalStaticFormInSplice e -> - mkSimpleDecorated $ - sep [ text "static forms cannot be used in splices:" - , nest 2 $ ppr e - ] - - FailedToLookupThInstName th_type reason -> - mkSimpleDecorated $ - case reason of - NoMatchesFound -> - text "Couldn't find any instances of" - <+> text (TH.pprint th_type) - <+> text "to add documentation to" - CouldNotDetermineInstance -> - text "Couldn't work out what instance" - <+> text (TH.pprint th_type) - <+> text "is supposed to be" - - AddInvalidCorePlugin plugin -> - mkSimpleDecorated $ - hang (text "addCorePlugin: invalid plugin module" <+> quotes (text plugin) ) - 2 (text "Plugins in the current package can't be specified.") - - AddDocToNonLocalDefn doc_loc -> - mkSimpleDecorated $ - text "Can't add documentation to" <+> ppr_loc doc_loc <> comma <+> - text "as it isn't inside the current module." - where - ppr_loc (TH.DeclDoc n) = text $ TH.pprint n - ppr_loc (TH.ArgDoc n _) = text $ TH.pprint n - ppr_loc (TH.InstDoc t) = text $ TH.pprint t - ppr_loc TH.ModuleDoc = text "the module header" - - ReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg - -pprTHSyntaxError :: THSyntaxError -> DecoratedSDoc -pprTHSyntaxError = mkSimpleDecorated . \case - IllegalTHQuotes expr -> - text "Syntax error on" <+> ppr expr - -- The error message context will say - -- "In the Template Haskell quotation", so no need to repeat that here. - BadImplicitSplice -> - sep [ text "Parse error: module header, import declaration" - , text "or top-level declaration expected." ] - -- The compiler should not mention TemplateHaskell, as the common case - -- is that this is a simple beginner error, for example: - -- - -- module M where - -- f :: Int -> Int; f x = x - -- xyzzy - -- g y = f y + 1 - -- - -- It's unlikely that 'xyzzy' above was intended to be a Template Haskell - -- splice; instead it's probably something mistakenly left in the code. - -- See #12146 for discussion. - - IllegalTHSplice -> - text "Unexpected top-level splice." - MismatchedSpliceType splice_type inner_splice_or_bracket -> - inner <+> text "may not appear in" <+> outer <> dot - where - (inner, outer) = case inner_splice_or_bracket of - IsSplice -> case splice_type of - Typed -> (text "Typed splices" , text "untyped brackets") - Untyped -> (text "Untyped splices", text "typed brackets") - IsBracket -> - case splice_type of - Typed -> (text "Untyped brackets", text "typed splices") - Untyped -> (text "Typed brackets" , text "untyped splices") - NestedTHBrackets -> - text "Template Haskell brackets cannot be nested" <+> - text "(without intervening splices)" - -pprTHNameError :: THNameError -> DecoratedSDoc -pprTHNameError = \case - NonExactName name -> - mkSimpleDecorated $ - hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.") - 2 (text "Probable cause: you used mkName instead of newName to generate a binding.") - QuotedNameWrongStage quote -> - mkSimpleDecorated $ - sep [ text "Stage error: the non-top-level quoted name" <+> ppr quote - , text "must be used at the same stage at which it is bound." ] - -pprTHReifyError :: THReifyError -> DecoratedSDoc -pprTHReifyError = \case - CannotReifyInstance ty - -> mkSimpleDecorated $ - hang (text "reifyInstances:" <+> quotes (ppr ty)) - 2 (text "is not a class constraint or type family application") - CannotReifyOutOfScopeThing th_name - -> mkSimpleDecorated $ - quotes (text (TH.pprint th_name)) <+> - text "is not in scope at a reify" - -- Ugh! Rather an indirect way to display the name - CannotReifyThingNotInTypeEnv name - -> mkSimpleDecorated $ - quotes (ppr name) <+> text "is not in the type environment at a reify" - NoRolesAssociatedWithThing thing - -> mkSimpleDecorated $ - text "No roles associated with" <+> (ppr thing) - CannotRepresentType sort ty - -> mkSimpleDecorated $ - hsep [text "Can't represent" <+> sort_doc <+> - text "in Template Haskell:", - nest 2 (ppr ty)] - where - sort_doc = text $ - case sort of - LinearInvisibleArgument -> "linear invisible argument" - CoercionsInTypes -> "coercions in types" - -pprTypedTHError :: TypedTHError -> DecoratedSDoc -pprTypedTHError = \case - SplicePolymorphicLocalVar ident - -> mkSimpleDecorated $ - text "Can't splice the polymorphic local variable" <+> quotes (ppr ident) - TypedTHWithPolyType ty - -> mkSimpleDecorated $ - vcat [ text "Illegal polytype:" <+> ppr ty - , text "The type of a Typed Template Haskell expression must" <+> - text "not have any quantification." ] - -pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc -pprSpliceFailReason = \case - SpliceThrewException phase _exn exn_msg expr show_code -> - mkSimpleDecorated $ - vcat [ text "Exception when trying to" <+> text phaseStr <+> text "compile-time code:" - , nest 2 (text exn_msg) - , if show_code then text "Code:" <+> ppr expr else empty] - where phaseStr = - case phase of - SplicePhase_Run -> "run" - SplicePhase_CompileAndLink -> "compile and link" - RunSpliceFailure err -> pprRunSpliceFailure Nothing err - -pprAddTopDeclsError :: AddTopDeclsError -> DecoratedSDoc -pprAddTopDeclsError = \case - InvalidTopDecl _decl -> - mkSimpleDecorated $ - sep [ text "Only function, value, annotation, and foreign import declarations" - , text "may be added with" <+> quotes (text "addTopDecls") <> dot ] - AddTopDeclsUnexpectedDeclarationSplice {} -> - mkSimpleDecorated $ - text "Declaration splices are not permitted" <+> - text "inside top-level declarations added with" <+> - quotes (text "addTopDecls") <> dot - AddTopDeclsRunSpliceFailure err -> - pprRunSpliceFailure (Just "addTopDecls") err - -pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc -pprRunSpliceFailure mb_calling_fn (ConversionFail what reason) = - mkSimpleDecorated . add_calling_fn . addSpliceInfo $ - pprConversionFailReason reason - where - add_calling_fn rest = - case mb_calling_fn of - Just calling_fn -> - hang (text "Error in a declaration passed to" <+> quotes (text calling_fn) <> colon) - 2 rest - Nothing -> rest - addSpliceInfo = case what of - ConvDec d -> addSliceInfo' "declaration" d - ConvExp e -> addSliceInfo' "expression" e - ConvPat p -> addSliceInfo' "pattern" p - ConvType t -> addSliceInfo' "type" t - addSliceInfo' what item reasonErr = reasonErr $$ descr - where - -- Show the item in pretty syntax normally, - -- but with all its constructors if you say -dppr-debug - descr = hang (text "When splicing a TH" <+> text what <> colon) - 2 (getPprDebug $ \case - True -> text (show item) - False -> text (TH.pprint item)) - -thErrorReason :: THError -> DiagnosticReason -thErrorReason = \case - THSyntaxError err -> thSyntaxErrorReason err - THNameError err -> thNameErrorReason err - THReifyError err -> thReifyErrorReason err - TypedTHError err -> typedTHErrorReason err - THSpliceFailed rea -> spliceFailedReason rea - AddTopDeclsError err -> addTopDeclsErrorReason err - - IllegalStaticFormInSplice {} -> ErrorWithoutFlag - FailedToLookupThInstName {} -> ErrorWithoutFlag - AddInvalidCorePlugin {} -> ErrorWithoutFlag - AddDocToNonLocalDefn {} -> ErrorWithoutFlag - ReportCustomQuasiError is_error _ -> - if is_error - then ErrorWithoutFlag - else WarningWithoutFlag - -thSyntaxErrorReason :: THSyntaxError -> DiagnosticReason -thSyntaxErrorReason = \case - IllegalTHQuotes{} -> ErrorWithoutFlag - BadImplicitSplice -> ErrorWithoutFlag - IllegalTHSplice{} -> ErrorWithoutFlag - NestedTHBrackets{} -> ErrorWithoutFlag - MismatchedSpliceType{} -> ErrorWithoutFlag - -thNameErrorReason :: THNameError -> DiagnosticReason -thNameErrorReason = \case - NonExactName {} -> ErrorWithoutFlag - QuotedNameWrongStage {} -> ErrorWithoutFlag - -thReifyErrorReason :: THReifyError -> DiagnosticReason -thReifyErrorReason = \case - CannotReifyInstance {} -> ErrorWithoutFlag - CannotReifyOutOfScopeThing {} -> ErrorWithoutFlag - CannotReifyThingNotInTypeEnv {} -> ErrorWithoutFlag - NoRolesAssociatedWithThing {} -> ErrorWithoutFlag - CannotRepresentType {} -> ErrorWithoutFlag - -typedTHErrorReason :: TypedTHError -> DiagnosticReason -typedTHErrorReason = \case - SplicePolymorphicLocalVar {} -> ErrorWithoutFlag - TypedTHWithPolyType {} -> ErrorWithoutFlag - -spliceFailedReason :: SpliceFailReason -> DiagnosticReason -spliceFailedReason = \case - SpliceThrewException {} -> ErrorWithoutFlag - RunSpliceFailure {} -> ErrorWithoutFlag - -addTopDeclsErrorReason :: AddTopDeclsError -> DiagnosticReason -addTopDeclsErrorReason = \case - InvalidTopDecl {} - -> ErrorWithoutFlag - AddTopDeclsUnexpectedDeclarationSplice {} - -> ErrorWithoutFlag - AddTopDeclsRunSpliceFailure {} - -> ErrorWithoutFlag - -thErrorHints :: THError -> [GhcHint] -thErrorHints = \case - THSyntaxError err -> thSyntaxErrorHints err - THNameError err -> thNameErrorHints err - THReifyError err -> thReifyErrorHints err - TypedTHError err -> typedTHErrorHints err - THSpliceFailed rea -> spliceFailedHints rea - AddTopDeclsError err -> addTopDeclsErrorHints err - - IllegalStaticFormInSplice {} -> noHints - FailedToLookupThInstName {} -> noHints - AddInvalidCorePlugin {} -> noHints - AddDocToNonLocalDefn {} -> noHints - ReportCustomQuasiError {} -> noHints - -thSyntaxErrorHints :: THSyntaxError -> [GhcHint] -thSyntaxErrorHints = \case - IllegalTHQuotes{} - -> [suggestExtension LangExt.TemplateHaskellQuotes] - BadImplicitSplice {} - -> noHints -- NB: don't suggest TemplateHaskell - -- see comments on BadImplicitSplice in pprTHSyntaxError - IllegalTHSplice{} - -> [suggestExtension LangExt.TemplateHaskell] - NestedTHBrackets{} - -> noHints - MismatchedSpliceType{} - -> noHints - -thNameErrorHints :: THNameError -> [GhcHint] -thNameErrorHints = \case - NonExactName {} -> noHints - QuotedNameWrongStage {} -> noHints - -thReifyErrorHints :: THReifyError -> [GhcHint] -thReifyErrorHints = \case - CannotReifyInstance {} -> noHints - CannotReifyOutOfScopeThing {} -> noHints - CannotReifyThingNotInTypeEnv {} -> noHints - NoRolesAssociatedWithThing {} -> noHints - CannotRepresentType {} -> noHints - -typedTHErrorHints :: TypedTHError -> [GhcHint] -typedTHErrorHints = \case - SplicePolymorphicLocalVar {} -> noHints - TypedTHWithPolyType {} -> noHints - -spliceFailedHints :: SpliceFailReason -> [GhcHint] -spliceFailedHints = \case - SpliceThrewException {} -> noHints - RunSpliceFailure {} -> noHints - -addTopDeclsErrorHints :: AddTopDeclsError -> [GhcHint] -addTopDeclsErrorHints = \case - InvalidTopDecl {} - -> noHints - AddTopDeclsUnexpectedDeclarationSplice {} - -> noHints - AddTopDeclsRunSpliceFailure {} - -> noHints - --------------------------------------------------------------------------------- - -pprPatersonCondFailure :: - PatersonCondFailure -> PatersonCondFailureContext -> Type -> Type -> SDoc -pprPatersonCondFailure (PCF_TyVar tvs) InInstanceDecl lhs rhs = - hang (occMsg tvs) - 2 (sep [ text "in the constraint" <+> quotes (ppr lhs) - , text "than in the instance head" <+> quotes (ppr rhs) ]) - where - occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) - <+> pp_occurs <+> text "more often" - pp_occurs | isSingleton tvs = text "occurs" - | otherwise = text "occur" -pprPatersonCondFailure (PCF_TyVar tvs) InTyFamEquation lhs rhs = - hang (occMsg tvs) - 2 (sep [ text "in the type-family application" <+> quotes (ppr rhs) - , text "than in the LHS of the family instance" <+> quotes (ppr lhs) ]) - where - occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) - <+> pp_occurs <+> text "more often" - pp_occurs | isSingleton tvs = text "occurs" - | otherwise = text "occur" -pprPatersonCondFailure PCF_Size InInstanceDecl lhs rhs = - hang (text "The constraint" <+> quotes (ppr lhs)) - 2 (sep [ text "is no smaller than", pp_rhs ]) - where pp_rhs = text "the instance head" <+> quotes (ppr rhs) -pprPatersonCondFailure PCF_Size InTyFamEquation lhs rhs = - hang (text "The type-family application" <+> quotes (ppr rhs)) - 2 (sep [ text "is no smaller than", pp_lhs ]) - where pp_lhs = text "the LHS of the family instance" <+> quotes (ppr lhs) -pprPatersonCondFailure (PCF_TyFam tc) InInstanceDecl lhs _rhs = - hang (text "Illegal use of type family" <+> quotes (ppr tc)) - 2 (text "in the constraint" <+> quotes (ppr lhs)) -pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs = - hang (text "Illegal nested use of type family" <+> quotes (ppr tc)) - 2 (text "in the arguments of the type-family application" <+> quotes (ppr rhs)) - --------------------------------------------------------------------------------- - -defaultTypesAndImport :: ClassDefaults -> SDoc -defaultTypesAndImport ClassDefaults{cd_types, cd_module = Just cdm} = - hang (parens $ pprWithCommas ppr cd_types) - 2 (text "imported from" <+> ppr cdm) -defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types) - --------------------------------------------------------------------------------- - -pprZonkerMessage :: ZonkerMessage -> SDoc -pprZonkerMessage = \case - ZonkerCannotDefaultConcrete frr -> - ppr (frr_context frr) $$ - text "cannot be assigned a fixed runtime representation," <+> - text "not even by defaulting." - -zonkerMessageHints :: ZonkerMessage -> [GhcHint] -zonkerMessageHints = \case - ZonkerCannotDefaultConcrete {} -> [SuggestAddTypeSignatures UnnamedBinding] - -zonkerMessageReason :: ZonkerMessage -> DiagnosticReason -zonkerMessageReason = \case - ZonkerCannotDefaultConcrete {} -> ErrorWithoutFlag - --------------------------------------------------------------------------------- - -pprTypeSyntaxName :: TypeSyntax -> SDoc -pprTypeSyntaxName TypeKeywordSyntax = "keyword" <+> quotes "type" -pprTypeSyntaxName ForallTelescopeSyntax = "forall telescope" -pprTypeSyntaxName ContextArrowSyntax = "context arrow (=>)" -pprTypeSyntaxName FunctionArrowSyntax = "function type arrow (->)" + , pprErrCtxtMsg + -- + , tidySkolemInfo + , tidySkolemInfoAnon + -- + , pprHsDocContext + , inHsDocContext + , TcRnMessageOpts(..) + , pprTyThingUsedWrong + , pprUntouchableVariable + + -- + , mismatchMsg_ExpectedActuals + + -- | Useful when overriding message printing. + , messageWithInfoDiagnosticMessage + , messageWithHsDocContext + ) + where + +import GHC.Prelude + +import qualified GHC.Boot.TH.Syntax as TH +-- In stage1: import "ghc-boot-th-next" qualified GHC.Boot.TH.Syntax as TH +-- In stage2: import "ghc-boot-th" qualified GHC.Boot.TH.Syntax as TH +-- which is a rexport of +-- import "ghc-internal" qualified GHC.Internal.TH.Syntax as TH +import qualified GHC.Boot.TH.Ppr as TH + +import GHC.Builtin.Names +import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon, pretendNameIsInScope ) + +import GHC.Types.Name.Reader +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.Warnings + +import GHC.Core.Coercion +import GHC.Core.Unify ( tcMatchTys ) +import GHC.Core.TyCon +import GHC.Core.Class +import GHC.Core.DataCon +import GHC.Core.Coercion.Axiom (CoAxBranch, coAxiomTyCon, coAxiomSingleBranch) +import GHC.Core.ConLike +import GHC.Core.FamInstEnv ( FamInst(..), famInstAxiom, pprFamInst ) +import GHC.Core.InstEnv +import GHC.Core.TyCo.Rep (Type(..)) +import GHC.Core.TyCo.Ppr (pprWithInvisibleBitsWhen, pprSourceTyCon, + pprTyVars, pprWithTYPE, pprTyVar, pprTidiedType, pprForAll) +import GHC.Core.PatSyn ( patSynName, pprPatSynType ) +import GHC.Core.TyCo.Tidy +import GHC.Core.Predicate +import GHC.Core.Type +import GHC.Core.FVs( orphNamesOfTypes ) +import GHC.CoreToIface + +import GHC.Driver.Flags +import GHC.Driver.Backend +import GHC.Hs hiding (HoleError) + +import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Hole.FitTypes +import GHC.Tc.Types.BasicTypes +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.ErrCtxt +import GHC.Tc.Types.Origin hiding ( Position(..) ) +import GHC.Tc.Types.CtLoc +import GHC.Tc.Types.Rank (Rank(..)) +import GHC.Tc.Types.TH +import GHC.Tc.Utils.TcType + +import GHC.Types.DefaultEnv (ClassDefaults(ClassDefaults, cd_types, cd_provenance), DefaultProvenance (..)) +import GHC.Types.Error +import GHC.Types.Error.Codes +import GHC.Types.Hint +import GHC.Types.Hint.Ppr ( pprSigLike ) -- & Outputable GhcHint +import GHC.Types.Basic +import GHC.Types.Id +import GHC.Types.Id.Info ( RecSelParent(..) ) +import GHC.Types.Name +import GHC.Types.Name.Env +import GHC.Types.Name.Set +import GHC.Types.SourceFile +import GHC.Types.SrcLoc +import GHC.Types.TyThing +import GHC.Types.TyThing.Ppr ( pprTyThingInContext ) +import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Var.Env +import GHC.Types.Fixity (defaultFixity) + +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr +import GHC.Iface.Syntax + +import GHC.Unit.State +import GHC.Unit.Module + +import GHC.Data.Bag +import GHC.Data.FastString +import GHC.Data.List.SetOps ( nubOrdBy ) +import GHC.Data.Maybe +import GHC.Data.Pair +import GHC.Settings.Constants (mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE) +import GHC.Utils.Lexeme +import GHC.Utils.Misc +import GHC.Utils.Outputable +import GHC.Utils.Panic + +import qualified GHC.LanguageExtensions as LangExt + +import GHC.Data.BooleanFormula (pprBooleanFormulaNice) + +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NE +import qualified Data.Set as Set +import Data.Foldable ( fold ) +import Data.Function (on) +import Data.List ( groupBy, sortBy, tails + , partition, unfoldr ) +import Data.Ord ( comparing ) +import Data.Bifunctor +import GHC.Tc.Errors.Types.PromotionErr (pprTermLevelUseCtxt) + + +defaultTcRnMessageOpts :: TcRnMessageOpts +defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True + , tcOptsIfaceOpts = defaultDiagnosticOpts @IfaceMessage } + +instance HasDefaultDiagnosticOpts TcRnMessageOpts where + defaultOpts = defaultTcRnMessageOpts + +instance Diagnostic TcRnMessage where + type DiagnosticOpts TcRnMessage = TcRnMessageOpts + diagnosticMessage opts = \case + TcRnUnknownMessage (UnknownDiagnostic f _ m) + -> diagnosticMessage (f opts) m + TcRnMessageWithInfo unit_state msg_with_info + -> case msg_with_info of + TcRnMessageDetailed err_info msg + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext opts) + (diagnosticMessage opts msg) + TcRnWithHsDocContext ctxt msg + -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg) + TcRnSolverReport msg _reason + -> mkSimpleDecorated $ pprSolverReportWithCtxt msg + TcRnSolverDepthError ty depth -> mkSimpleDecorated msg + where + msg = + vcat [ text "Reduction stack overflow; size =" <+> ppr depth + , hang (text "When simplifying the following type:") + 2 (ppr ty) ] + TcRnRedundantConstraints redundants (info, show_info) + -> mkSimpleDecorated $ + text "Redundant constraint" <> plural redundants <> colon + <+> pprEvVarTheta redundants + $$ if show_info then text "In" <+> ppr info else empty + TcRnInaccessibleCode implic contra + -> mkSimpleDecorated $ + hang (text "Inaccessible code in") + 2 (ppr (ic_info implic)) + $$ pprSolverReportWithCtxt contra + TcRnInaccessibleCoAxBranch fam_tc cur_branch + -> mkSimpleDecorated $ + text "Type family instance equation is overlapped:" $$ + nest 2 (pprCoAxBranchUser fam_tc cur_branch) + TcRnTypeDoesNotHaveFixedRuntimeRep ty prov err_ctxt + -> mkDecorated $ + (pprTypeDoesNotHaveFixedRuntimeRep ty prov) + : map pprErrCtxtMsg err_ctxt + TcRnImplicitLift id_or_name err_ctxt + -> mkDecorated $ + ( text "The variable" <+> quotes (ppr id_or_name) <+> + text "is implicitly lifted in the TH quotation" + ) : map pprErrCtxtMsg err_ctxt + TcRnUnusedPatternBinds bind + -> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)] + TcRnDodgyImports (DodgyImportsEmptyParent gre) + -> mkDecorated [dodgy_msg (text "import") gre (dodgy_msg_insert gre)] + TcRnDodgyImports (DodgyImportsHiding reason) + -> mkSimpleDecorated $ + pprImportLookup reason + TcRnDodgyExports gre + -> mkDecorated [dodgy_msg (text "export") gre (dodgy_msg_insert gre)] + TcRnMissingImportList ie + -> mkDecorated [ text "The import item" <+> quotes (ppr ie) <+> + text "does not have an explicit import list" + ] + TcRnUnsafeDueToPlugin + -> mkDecorated [text "Use of plugins makes the module unsafe"] + TcRnModMissingRealSrcSpan mod + -> mkDecorated [text "Module does not have a RealSrcSpan:" <+> ppr mod] + TcRnIdNotExportedFromModuleSig name mod + -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+> + text "does not exist in the signature for" <+> ppr mod + ] + TcRnIdNotExportedFromLocalSig name + -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+> + text "does not exist in the local signature." + ] + TcRnShadowedName occ provenance + -> let shadowed_locs = case provenance of + ShadowedNameProvenanceLocal n -> [text "bound at" <+> ppr n] + ShadowedNameProvenanceGlobal gres -> map pprNameProvenance gres + in mkSimpleDecorated $ + sep [text "This binding for" <+> quotes (ppr occ) + <+> text "shadows the existing binding" <> plural shadowed_locs, + nest 2 (vcat shadowed_locs)] + TcRnInvalidWarningCategory cat + -> mkSimpleDecorated $ + vcat [text "Warning category" <+> quotes (ppr cat) <+> text "is not valid", + text "(user-defined category names must begin with" <+> quotes (text "x-"), + text "and contain only letters, numbers, apostrophes and dashes)" ] + TcRnDuplicateWarningDecls d rdr_name + -> mkSimpleDecorated $ + vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name), + text "also at " <+> ppr (getLocA d)] + TcRnSimplifierTooManyIterations simples limit wc + -> mkSimpleDecorated $ + hang (text "solveWanteds: too many iterations" + <+> parens (text "limit =" <+> ppr limit)) + 2 (vcat [ text "Unsolved:" <+> ppr wc + , text "Simples:" <+> ppr simples + ]) + TcRnIllegalPatSynDecl rdrname + -> mkSimpleDecorated $ + hang (text "Illegal pattern synonym declaration for" <+> quotes (ppr rdrname)) + 2 (text "Pattern synonym declarations are only valid at top level") + TcRnLinearPatSyn ty + -> mkSimpleDecorated $ + hang (text "Pattern synonyms do not support linear fields (GHC #18806):") 2 (ppr ty) + TcRnEmptyRecordUpdate + -> mkSimpleDecorated $ text "Empty record update" + TcRnIllegalFieldPunning fld + -> mkSimpleDecorated $ text "Illegal use of punning for field" <+> quotes (ppr fld) + TcRnIllegalWildcardsInRecord fld_part + -> mkSimpleDecorated $ text "Illegal `..' in record" <+> pprRecordFieldPart fld_part + TcRnIllegalWildcardInType mb_name bad + -> mkSimpleDecorated $ case bad of + WildcardNotLastInConstraint -> + hang notAllowed 2 constraint_hint_msg + ExtraConstraintWildcardNotAllowed allow_sole -> + case allow_sole of + SoleExtraConstraintWildcardNotAllowed -> + notAllowed + SoleExtraConstraintWildcardAllowed -> + hang notAllowed 2 sole_msg + WildcardsNotAllowedAtAll -> + notAllowed + WildcardBndrInForallTelescope -> + notAllowed + WildcardBndrInTyFamResultVar -> + notAllowed + where + notAllowed, what, wildcard, how :: SDoc + notAllowed = what <+> quotes wildcard <+> how + wildcard = case mb_name of + Nothing -> pprAnonWildCard + Just name -> ppr name + what + | Just _ <- mb_name + = text "Named wildcard" + | ExtraConstraintWildcardNotAllowed {} <- bad + = text "Extra-constraint wildcard" + | WildcardBndrInForallTelescope {} <- bad + = text "Wildcard binder" + | WildcardBndrInTyFamResultVar {} <- bad + = text "Wildcard binder" + | otherwise + = text "Wildcard" + how = case bad of + WildcardNotLastInConstraint + -> text "not allowed in a constraint" + WildcardBndrInForallTelescope + -> text "not allowed in a forall telescope" + WildcardBndrInTyFamResultVar + -> text "not allowed in a type family result" + _ -> text "not allowed" + constraint_hint_msg :: SDoc + constraint_hint_msg + | Just _ <- mb_name + = vcat [ text "Extra-constraint wildcards must be anonymous" + , nest 2 (text "e.g f :: (Eq a, _) => blah") ] + | otherwise + = vcat [ text "except as the last top-level constraint of a type signature" + , nest 2 (text "e.g f :: (Eq a, _) => blah") ] + sole_msg :: SDoc + sole_msg = + vcat [ text "except as the sole constraint" + , nest 2 (text "e.g., deriving instance _ => Eq (Foo a)") ] + TcRnIllegalNamedWildcardInTypeArgument rdr + -> mkSimpleDecorated $ + hang (text "Illegal named wildcard in a required type argument:") + 2 (quotes (ppr rdr)) + TcRnIllegalImplicitTyVarInTypeArgument rdr + -> mkSimpleDecorated $ + hang (text "Illegal implicitly quantified type variable in a required type argument:") + 2 (quotes (ppr rdr)) + TcRnIllegalPunnedVarOccInTypeArgument n1 n2 + -> mkSimpleDecorated $ hang msg 2 info + where + msg = vcat [ text "Illegal punned variable occurrence in a required type argument." + , text "The name" <+> quotes (ppr n1) <+> text "could refer to:" ] + info = vcat [ quotes (ppr n1) <+> pprResolvedNameProvenance n1 + , quotes (ppr n2) <+> pprResolvedNameProvenance n2 ] + TcRnDuplicateFieldName fld_part dups + -> mkSimpleDecorated $ + hsep [ text "Duplicate field name" + , quotes (ppr (rdrNameOcc $ NE.head dups)) + , text "in record", pprRecordFieldPart fld_part ] + TcRnIllegalViewPattern pat + -> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat] + TcRnCharLiteralOutOfRange c + -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\'' + TcRnIllegalWildcardsInConstructor con + -> mkSimpleDecorated $ + vcat [ text "Illegal `{..}' notation for constructor" <+> quotes (ppr con) + , nest 2 (text "Record wildcards may not be used for constructors with unlabelled fields.") + , nest 2 (text "Possible fix: Remove the `{..}' and add a match for each field of the constructor.") + ] + TcRnIgnoringAnnotations anns + -> mkSimpleDecorated $ + text "Ignoring ANN annotation" <> plural anns <> comma + <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi" + TcRnAnnotationInSafeHaskell + -> mkSimpleDecorated $ + vcat [ text "Annotations are not compatible with Safe Haskell." + , text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ] + TcRnInvalidTypeApplication fun_ty hs_ty + -> mkSimpleDecorated $ + text "Cannot apply expression of type" <+> quotes (ppr fun_ty) $$ + text "to a visible type argument" <+> quotes (ppr hs_ty) + TcRnTagToEnumMissingValArg + -> mkSimpleDecorated $ + text "tagToEnum# must appear applied to one value argument" + TcRnTagToEnumUnspecifiedResTy ty + -> mkSimpleDecorated $ + hang (text "Bad call to tagToEnum# at type" <+> ppr ty) + 2 (vcat [ text "Specify the type by giving a type signature" + , text "e.g. (tagToEnum# x) :: Bool" ]) + TcRnTagToEnumResTyNotAnEnum ty + -> mkSimpleDecorated $ + hang (text "Bad call to tagToEnum# at type" <+> ppr ty) + 2 (text "Result type must be an enumeration type") + TcRnTagToEnumResTyTypeData ty + -> mkSimpleDecorated $ + hang (text "Bad call to tagToEnum# at type" <+> ppr ty) + 2 (text "Result type cannot be headed by a `type data` type") + TcRnArrowIfThenElsePredDependsOnResultTy + -> mkSimpleDecorated $ + text "Predicate type of `ifThenElse' depends on result type" + TcRnIllegalHsBootOrSigDecl boot_or_sig decls + -> mkSimpleDecorated $ + text "Illegal" <+> what <+> text "in" <+> whr <> dot + where + what = case decls of + BootBindsPs {} -> text "binding" + BootBindsRn {} -> text "binding" + BootInstanceSigs {} -> text "instance body" + BootFamInst {} -> text "family instance" + BootSpliceDecls {} -> text "splice" + BootForeignDecls {} -> text "foreign declaration" + BootDefaultDecls {} -> text "default declaration" + BootRuleDecls {} -> text "RULE pragma" + whr = case boot_or_sig of + HsBoot -> text "an hs-boot file" + Hsig -> text "a backpack signature file" + TcRnBootMismatch boot_or_sig err -> + mkSimpleDecorated $ pprBootMismatch boot_or_sig err + TcRnRecursivePatternSynonym binds + -> mkSimpleDecorated $ + hang (text "Recursive pattern synonym definition with following bindings:") + 2 (vcat $ map pprLBind binds) + where + pprLoc loc = parens (text "defined at" <+> ppr loc) + pprLBind :: CollectPass GhcRn => GenLocated (EpAnn a) (HsBindLR GhcRn idR) -> SDoc + pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders CollNoDictBinders bind) + <+> pprLoc (locA loc) + TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty + -> mkSimpleDecorated $ + hang (text "Couldn't match" <+> quotes (ppr n1) + <+> text "with" <+> quotes (ppr n2)) + 2 (hang (text "both bound by the partial type signature:") + 2 (ppr fn_name <+> dcolon <+> ppr hs_ty)) + TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty + -> mkSimpleDecorated $ + hang (text "Can't quantify over" <+> quotes (ppr n)) + 2 (vcat [ hang (text "bound by the partial type signature:") + 2 (ppr fn_name <+> dcolon <+> ppr hs_ty) + , extra ]) + where + extra | Just rhs_ty <- m_unif_ty + = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ] + | otherwise + = empty + TcRnMissingSignature what _ -> + mkSimpleDecorated $ + case what of + MissingPatSynSig p -> + hang (text "Pattern synonym with no type signature:") + 2 (text "pattern" <+> pprPrefixName (patSynName p) <+> dcolon <+> pprPatSynType p) + MissingTopLevelBindingSig name ty -> + hang (text "Top-level binding with no type signature:") + 2 (pprPrefixName name <+> dcolon <+> pprSigmaType ty) + MissingTyConKindSig tc cusks_enabled -> + hang msg + 2 (text "type" <+> pprPrefixName (tyConName tc) <+> dcolon <+> pprKind (tyConKind tc)) + where + msg | cusks_enabled + = text "Top-level type constructor with no standalone kind signature or CUSK:" + | otherwise + = text "Top-level type constructor with no standalone kind signature:" + + TcRnPolymorphicBinderMissingSig n ty + -> mkSimpleDecorated $ + sep [ text "Polymorphic local binding with no type signature:" + , nest 2 $ pprPrefixName n <+> dcolon <+> ppr ty ] + TcRnOverloadedSig sig + -> mkSimpleDecorated $ + hang (text "Overloaded signature conflicts with monomorphism restriction") + 2 (ppr sig) + TcRnTupleConstraintInst _ + -> mkSimpleDecorated $ text "You can't specify an instance for a tuple constraint" + TcRnUserTypeError ty + -> mkSimpleDecorated (pprUserTypeErrorTy ty) + TcRnConstraintInKind ty + -> mkSimpleDecorated $ + text "Illegal constraint in a kind:" <+> pprType ty + TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum ty + -> mkSimpleDecorated $ + sep [ text "Illegal unboxed" <+> what <+> text "type as function argument:" + , pprType ty ] + where + what = case tuple_or_sum of + UnboxedTupleType -> text "tuple" + UnboxedSumType -> text "sum" + TcRnLinearFuncInKind ty + -> mkSimpleDecorated $ + text "Illegal linear function in a kind:" <+> pprType ty + TcRnForAllEscapeError ty kind + -> mkSimpleDecorated $ vcat + [ hang (text "Quantified type's kind mentions quantified type variable") + 2 (text "type:" <+> quotes (ppr ty)) + , hang (text "where the body of the forall has this kind:") + 2 (quotes (pprKind kind)) ] + TcRnSimplifiableConstraint pred what + -> mkSimpleDecorated $ vcat + [ hang (text "The constraint" <+> quotes (pprType pred) <+> text "matches") + 2 (ppr what) + , hang (text "This makes type inference for inner bindings fragile;") + 2 (text "either use MonoLocalBinds, or simplify it using the instance") ] + TcRnArityMismatch thing thing_arity nb_args + -> mkSimpleDecorated $ + hsep [ text "The" <+> what, quotes (ppr $ getName thing), text "should have" + , n_arguments <> comma, text "but has been given" + , if nb_args == 0 then text "none" else int nb_args + ] + where + what = case thing of + ATyCon tc -> ppr (tyConFlavour tc) + _ -> text (tyThingCategory thing) + n_arguments | thing_arity == 0 = text "no arguments" + | thing_arity == 1 = text "1 argument" + | True = hsep [int thing_arity, text "arguments"] + TcRnIllegalInstance reason -> + mkSimpleDecorated $ pprIllegalInstance reason + TcRnVDQInTermType mb_ty + -> mkSimpleDecorated $ + case mb_ty of + Nothing -> main_msg + Just ty -> hang (main_msg <> char ':') 2 (pprType ty) + where + main_msg = + text "Illegal visible, dependent quantification" <+> + text "in the type of a term" + TcRnBadQuantPredHead ty + -> mkSimpleDecorated $ + hang (text "Quantified predicate must have a class or type variable head:") + 2 (pprType ty) + TcRnIllegalTupleConstraint ty + -> mkSimpleDecorated $ + text "Illegal tuple constraint:" <+> pprType ty + TcRnNonTypeVarArgInConstraint ty + -> mkSimpleDecorated $ + hang (text "Non type-variable argument") + 2 (text "in the constraint:" <+> pprType ty) + TcRnIllegalImplicitParam ty + -> mkSimpleDecorated $ + text "Illegal implicit parameter" <+> quotes (pprType ty) + TcRnIllegalConstraintSynonymOfKind kind + -> mkSimpleDecorated $ + text "Illegal constraint synonym of kind:" <+> quotes (pprKind kind) + TcRnOversaturatedVisibleKindArg ty + -> mkSimpleDecorated $ + text "Illegal oversaturated visible kind argument:" <+> + quotes (char '@' <> pprParendType ty) + TcRnForAllRankErr rank ty + -> let herald = case tcSplitForAllTyVars ty of + ([], _) -> text "Illegal qualified type:" + _ -> text "Illegal polymorphic type:" + extra = case rank of + MonoTypeConstraint -> text "A constraint must be a monotype" + _ -> empty + in mkSimpleDecorated $ vcat [hang herald 2 (pprType ty), extra] + TcRnMonomorphicBindings bindings + -> let pp_bndrs = pprBindings bindings + in mkSimpleDecorated $ + sep [ text "The Monomorphism Restriction applies to the binding" + <> plural bindings + , text "for" <+> pp_bndrs ] + TcRnOrphanInstance (Left cls_inst) + -> mkSimpleDecorated $ + hang (text "Orphan class instance:") + 2 (pprInstanceHdr cls_inst) + TcRnOrphanInstance (Right fam_inst) + -> mkSimpleDecorated $ + hang (text "Orphan family instance:") + 2 (pprFamInst fam_inst) + TcRnFunDepConflict unit_state sorted + -> let herald = text "Functional dependencies conflict between instance declarations:" + in mkSimpleDecorated $ + pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted)) + TcRnDupInstanceDecls unit_state sorted + -> let herald = text "Duplicate instance declarations:" + in mkSimpleDecorated $ + pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted)) + TcRnConflictingFamInstDecls sortedNE + -> let sorted = NE.toList sortedNE + in mkSimpleDecorated $ + hang (text "Conflicting family instance declarations:") + 2 (vcat [ pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax) + | fi <- sorted + , let ax = famInstAxiom fi ]) + TcRnFamInstNotInjective rea fam_tc (eqn1 NE.:| rest_eqns) + -> let (herald, show_kinds) = case rea of + InjErrRhsBareTyVar tys -> + (injectivityErrorHerald $$ + text "RHS of injective type family equation is a bare" <+> + text "type variable" $$ + text "but these LHS type and kind patterns are not bare" <+> + text "variables:" <+> pprQuotedList tys, False) + InjErrRhsCannotBeATypeFam -> + (injectivityErrorHerald $$ + text "RHS of injective type family equation cannot" <+> + text "be a type family:", False) + InjErrRhsOverlap -> + (text "Type family equation right-hand sides overlap; this violates" $$ + text "the family's injectivity annotation:", False) + InjErrCannotInferFromRhs tvs has_kinds _ -> + let show_kinds = has_kinds == YesHasKinds + what = if show_kinds then text "Type/kind" else text "Type" + body = sep [ what <+> text "variable" <> + pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . scopedSort) + , text "cannot be inferred from the right-hand side." ] + in (injectivityErrorHerald $$ body $$ text "In the type family equation:", show_kinds) + + in mkSimpleDecorated $ pprWithInvisibleBitsWhen show_kinds $ + hang herald + 2 (vcat (map (pprCoAxBranchUser fam_tc) (eqn1 : rest_eqns))) + TcRnBangOnUnliftedType ty + -> mkSimpleDecorated $ + text "Strictness flag has no effect on unlifted type" <+> quotes (ppr ty) + TcRnLazyBangOnUnliftedType ty + -> mkSimpleDecorated $ + text "Lazy flag has no effect on unlifted type" <+> quotes (ppr ty) + TcRnMultipleDefaultDeclarations cls dup_things + -> mkSimpleDecorated $ + hang (text "Multiple default declarations for class" <+> quotes (ppr cls)) + 2 (pp dup_things) + where + pp :: ClassDefaults -> SDoc + pp (ClassDefaults { cd_provenance = prov }) + = case prov of + DP_Local { defaultDeclLoc = loc, defaultDeclH98 = isH98 } + -> let + what = + if isH98 + then text "default declaration" + else text "named default declaration" + in text "conflicting" <+> what <+> text "at:" <+> ppr loc + _ -> empty -- doesn't happen, as local defaults override imported and built-in defaults + TcRnBadDefaultType ty deflt_clss + -> mkSimpleDecorated $ + hang (text "The default type" <+> quotes (ppr ty) <+> text "is not an instance of") + 2 (foldr1 (\a b -> a <+> text "or" <+> b) (NE.map (quotes. ppr) deflt_clss)) + TcRnPatSynBundledWithNonDataCon + -> mkSimpleDecorated $ + text "Pattern synonyms can be bundled only with datatypes." + TcRnPatSynBundledWithWrongType expected_res_ty res_ty + -> mkSimpleDecorated $ + text "Pattern synonyms can only be bundled with matching type constructors" + $$ text "Couldn't match expected type of" + <+> quotes (ppr expected_res_ty) + <+> text "with actual type of" + <+> quotes (ppr res_ty) + TcRnDupeModuleExport mod + -> mkSimpleDecorated $ + hsep [ text "Duplicate" + , quotes (text "Module" <+> ppr mod) + , text "in export list" ] + TcRnExportedModNotImported mod + -> mkSimpleDecorated + $ formatExportItemError + (text "module" <+> ppr mod) + "is not imported" + TcRnNullExportedModule mod + -> mkSimpleDecorated + $ formatExportItemError + (text "module" <+> ppr mod) + "exports nothing" + TcRnMissingExportList mod + -> mkSimpleDecorated + $ formatExportItemError + (text "module" <+> ppr mod) + "is missing an export list" + TcRnExportHiddenComponents export_item + -> mkSimpleDecorated + $ formatExportItemError + (ppr export_item) + "attempts to export constructors or class methods that are not visible here" + TcRnExportHiddenDefault export_item + -> mkSimpleDecorated + $ formatExportItemError + (ppr export_item) + "attempts to export a default class declaration that is not visible here" + TcRnDuplicateExport gre ie1 ie2 + -> mkSimpleDecorated $ + hsep [ quotes (ppr $ greName gre) + , text "is exported by", quotes (ppr ie1) + , text "and", quotes (ppr ie2) ] + TcRnDuplicateNamedDefaultExport nm ie1 ie2 + -> mkSimpleDecorated $ + hsep [ text "The named default declaration for" <+> quotes (ppr nm) + , text "is exported by", quotes (ppr ie1) + , text "and", quotes (ppr ie2) ] + TcRnExportedParentChildMismatch parent_name ty_thing child parent_names + -> mkSimpleDecorated $ + text "The type constructor" <+> quotes (ppr parent_name) + <+> text "is not the parent of the" <+> text what_is + <+> quotes thing <> char '.' + $$ text (capitalise what_is) + <> text "s can only be exported with their parent type constructor." + $$ (case parents of + [] -> empty + [_] -> text "Parent:" + _ -> text "Parents:") <+> fsep (punctuate comma parents) + where + pp_category :: TyThing -> String + pp_category (AnId i) + | isRecordSelector i = "record selector" + pp_category i = tyThingCategory i + what_is = pp_category ty_thing + thing = ppr $ nameOccName child + parents = map ppr parent_names + TcRnConflictingExports occ child_gre1 ie1 child_gre2 ie2 + -> mkSimpleDecorated $ + vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon + , ppr_export child_gre1 ie1 + , ppr_export child_gre2 ie2 + ] + where + ppr_export gre ie = + nest 3 $ + hang (quotes (ppr ie) <+> text "exports" <+> quotes (ppr $ greName gre)) + 2 (pprNameProvenance gre) + TcRnDuplicateFieldExport (gre, ie1) gres_ies -> + mkSimpleDecorated $ + vcat ( hsep [ text "Duplicate record field" + , quotes (ppr $ greOccName gre) + , text "in export list" <> colon ] + : map ppr_export ((gre,ie1) : NE.toList gres_ies) + ) + where + ppr_export (gre,ie) = + nest 3 $ + hang (sep [ quotes (ppr ie) <+> text "exports the field" <+> quotes (ppr $ greName gre) + , text "belonging to the constructor" <> plural fld_cons <+> pprQuotedList fld_cons ]) + 2 (pprNameProvenance gre) + where + fld_cons :: [ConLikeName] + fld_cons = nonDetEltsUniqSet $ recFieldCons $ fieldGREInfo gre + TcRnAmbiguousFieldInUpdate (gre1, gre2, gres) + -> mkSimpleDecorated $ + vcat [ text "Ambiguous record field" <+> fld <> dot + , hang (text "It could refer to any of the following:") + 2 $ vcat (map pprSugg (gre1 : gre2 : gres)) + ] + where + fld = quotes $ ppr (occNameFS $ greOccName gre1) + pprSugg gre = vcat [ bullet <+> pprGRE gre <> comma + , nest 2 (pprNameProvenance gre) ] + pprGRE gre = case greInfo gre of + IAmRecField {} + | ParentIs { par_is = parent } <- greParent gre + -> text "record field" <+> fld <+> text "of" <+> quotes (ppr parent) + _ -> text "variable" <+> fld + TcRnAmbiguousRecordUpdate _rupd tc + -> mkSimpleDecorated $ + vcat [ text "Ambiguous record update with parent" <+> what <> dot + , hsep [ text "This type-directed disambiguation mechanism" + , text "will not be supported by -XDuplicateRecordFields in future releases of GHC." ] + , text "Consider disambiguating using module qualification instead." + ] + where + what :: SDoc + what = text "type constructor" <+> quotes (ppr $ RecSelData tc) + TcRnMissingFields con fields + -> mkSimpleDecorated $ vcat [header, nest 2 rest] + where + rest | null fields = empty + | otherwise = vcat (fmap pprField fields) + header = text "Fields of" <+> quotes (ppr con) <+> + text "not initialised" <> + if null fields then empty else colon + TcRnFieldUpdateInvalidType prs + -> mkSimpleDecorated $ + hang (text "Record update for insufficiently polymorphic field" + <> plural prs <> colon) + 2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ]) + TcRnMissingStrictFields con fields + -> mkSimpleDecorated $ vcat [header, nest 2 rest] + where + rest | null fields = empty -- Happens for non-record constructors + -- with strict fields + | otherwise = vcat (fmap pprField fields) + + header = text "Constructor" <+> quotes (ppr con) <+> + text "does not have the required strict field(s)" <> + if null fields then empty else colon + TcRnBadRecordUpdate upd_flds reason + -> case reason of + NoConstructorHasAllFields { conflictingFields = conflicts } + | [fld] <- conflicts + -> mkSimpleDecorated $ + vcat [ header + , text "No constructor in scope has the field" <+> quotes (ppr fld) ] + | otherwise + -> + mkSimpleDecorated $ + vcat [ header + , hang (text "No constructor in scope has all of the following fields:") + 2 (pprQuotedList conflicts) ] + where + header :: SDoc + header = text "Invalid record update." + MultiplePossibleParents (par1, par2, pars) -> + mkSimpleDecorated $ + vcat [ hang (text "Ambiguous record update with field" <> plural upd_flds) + 2 ppr_flds + , hang (thisOrThese upd_flds <+> text "field" <> plural upd_flds <+> what_parent) + 2 (quotedListWithAnd (map ppr (par1:par2:pars))) ] + where + ppr_flds, what_parent, which :: SDoc + ppr_flds = quotedListWithAnd $ map ppr upd_flds + what_parent = case par1 of + RecSelData {} -> text "appear" <> singular upd_flds + <+> text "in" <+> which <+> text "datatypes" + RecSelPatSyn {} -> isOrAre upd_flds <+> text "associated with" + <+> which <+> text "pattern synonyms" + which = case pars of + [] -> text "both" + _ -> text "all of the" + InvalidTyConParent tc pars -> + mkSimpleDecorated $ + vcat [ hang (text "No data constructor of" <+> what $$ text "has all of the fields:") + 2 (pprQuotedList upd_flds) + , pat_syn_msg ] + where + what = text "type constructor" <+> quotes (ppr (RecSelData tc)) + pat_syn_msg + | any (\case { RecSelPatSyn {} -> True; _ -> False}) pars + = note "Type-directed disambiguation is not supported for pattern synonym record fields" + | otherwise + = empty + TcRnStaticFormNotClosed name reason + -> mkSimpleDecorated $ + quotes (ppr name) + <+> text "is used in a static form but it is not closed" + <+> text "because it" + $$ sep (causes reason) + where + causes :: NotClosedReason -> [SDoc] + causes NotLetBoundReason = [text "is not let-bound."] + causes (NotTypeClosed vs) = + [ text "has a non-closed type because it contains the" + , text "type variables:" <+> + pprVarSet vs (hsep . punctuate comma . map (quotes . ppr)) + ] + causes (NotClosed n reason) = + let msg = text "uses" <+> quotes (ppr n) <+> text "which" + in case reason of + NotClosed _ _ -> msg : causes reason + _ -> let (xs0, xs1) = splitAt 1 $ causes reason + in fmap (msg <+>) xs0 ++ xs1 + TcRnUselessTypeable + -> mkSimpleDecorated $ + text "Deriving" <+> quotes (ppr typeableClassName) <+> + text "has no effect: all types now auto-derive Typeable" + TcRnDerivingDefaults cls + -> mkSimpleDecorated $ sep + [ text "Both DeriveAnyClass and" + <+> text "GeneralizedNewtypeDeriving are enabled" + , text "Defaulting to the DeriveAnyClass strategy" + <+> text "for instantiating" <+> ppr cls + ] + TcRnNonUnaryTypeclassConstraint ctxt ct + -> mkSimpleDecorated $ + quotes (ppr ct) + <+> text "is not a unary constraint, as expected by" + <+> pprUserTypeCtxt ctxt + TcRnPartialTypeSignatures _ theta + -> mkSimpleDecorated $ + text "Found type wildcard" <+> quotes (char '_') + <+> text "standing for" <+> quotes (pprTheta theta) + TcRnCannotDeriveInstance cls cls_tys mb_strat newtype_deriving reason + -> mkSimpleDecorated $ + derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving True reason + TcRnLookupInstance cls tys reason + -> mkSimpleDecorated $ + text "Couldn't match instance:" <+> + lookupInstanceErrDiagnosticMessage cls tys reason + TcRnLazyGADTPattern + -> mkSimpleDecorated $ + hang (text "An existential or GADT data constructor cannot be used") + 2 (text "inside a lazy (~) pattern") + TcRnArrowProcGADTPattern + -> mkSimpleDecorated $ + text "Proc patterns cannot use existential or GADT data constructors" + TcRnTypeEqualityOutOfScope + -> mkDecorated + [ text "The" <+> quotes (text "~") <+> text "operator is out of scope." $$ + text "Assuming it to stand for an equality constraint." + , note $ quotes "~" <+> "used to be built-in syntax but now is a regular type operator" $$ + "exported from Data.Type.Equality and Prelude." $$ + "If you are using a custom Prelude, consider re-exporting it" + , text "This will become an error in a future GHC release." ] + TcRnTypeEqualityRequiresOperators + -> mkSimpleDecorated $ + fsep [ text "The use of" <+> quotes (text "~") + <+> text "without TypeOperators", + text "will become an error in a future GHC release." ] + TcRnIllegalTypeOperator overall_ty op + -> mkSimpleDecorated $ + text "Illegal operator" <+> quotes (ppr op) <+> + text "in type" <+> quotes (ppr overall_ty) + TcRnIllegalTypeOperatorDecl name + -> mkSimpleDecorated $ + text "Illegal declaration of a type or class operator" <+> quotes (ppr name) + TcRnGADTMonoLocalBinds + -> mkSimpleDecorated $ + fsep [ text "Pattern matching on GADTs without MonoLocalBinds" + , text "is fragile." ] + TcRnIncorrectNameSpace name _in_th_tick + -> mkSimpleDecorated $ + text "The" <+> what <+> text "does not live in" <+> other_ns + where + -- the other (opposite) namespace + other_ns | isValNameSpace ns = text "the type-level namespace" + | otherwise = text "the term-level namespace" + ns = nameNameSpace name + what = pprNameSpace ns <+> quotes (ppr name) + TcRnNotInScope err name + -> mkSimpleDecorated $ pprScopeError name err + TcRnTermNameInType name + -> mkSimpleDecorated $ + quotes (ppr name) <+> + (text "is a term-level binding") $+$ + (text " and can not be used at the type level.") + TcRnUntickedPromotedThing thing + -> mkSimpleDecorated $ + text "Unticked promoted" <+> what + where + what :: SDoc + what = case thing of + UntickedExplicitList -> text "list" <> dot + UntickedConstructor fixity nm -> + let con = pprUntickedConstructor fixity nm + bare_sym = isBareSymbol fixity nm + in text "constructor:" <+> con <> if bare_sym then empty else dot + TcRnIllegalBuiltinSyntax sig rdr_name + -> mkSimpleDecorated $ + hsep [text "Illegal", pprSigLike sig, text "of built-in syntax:", ppr rdr_name] + TcRnWarnDefaulting tidy_wanteds tidy_tv default_ty + -> mkSimpleDecorated $ + hang (hsep $ [ text "Defaulting" ] + ++ + (case tidy_tv of + Nothing -> [] + Just tv -> [text "the type variable" + , quotes (ppr tv)]) + ++ + [ text "to type" + , quotes (ppr default_ty) + , text "in the following constraint" <> plural tidy_wanteds ]) + 2 + (pprWithArising tidy_wanteds) + TcRnWarnClashingDefaultImports cls Nothing imports + -> mkSimpleDecorated $ + hang (text "Clashing imported defaults for class" <+> quotes (ppr cls) <> colon) + 2 (vcat $ defaultTypesAndImport <$> NE.toList imports) + TcRnWarnClashingDefaultImports cls (Just local) imports + -> mkSimpleDecorated $ + sep [ hang (text "Imported defaults for class" <+> quotes (ppr cls) <> colon) + 2 (vcat $ defaultTypesAndImport <$> NE.toList imports) + , hang (text "are not subsumed by the local `default` declaration") + 2 (parens $ pprWithCommas ppr local) + ] + + TcRnForeignImportPrimExtNotSet _decl + -> mkSimpleDecorated $ + text "`foreign import prim' requires GHCForeignImportPrim." + + TcRnForeignImportPrimSafeAnn _decl + -> mkSimpleDecorated $ + text "The safe/unsafe annotation should not be used with `foreign import prim'." + + TcRnForeignFunctionImportAsValue _decl + -> mkSimpleDecorated $ + text "`value' imports cannot have function types" + + TcRnFunPtrImportWithoutAmpersand _decl + -> mkSimpleDecorated $ + text "possible missing & in foreign import of FunPtr" + + TcRnIllegalForeignDeclBackend _decl _backend expectedBknds + -> mkSimpleDecorated $ + fsep (text "Illegal foreign declaration: requires one of these back ends:" : + commafyWith (text "or") (map (text . backendDescription) expectedBknds)) + + TcRnUnsupportedCallConv _decl unsupportedCC + -> mkSimpleDecorated $ + case unsupportedCC of + StdCallConvUnsupported -> + text "the 'stdcall' calling convention is unsupported on this platform," + $$ text "treating as ccall" + PrimCallConvUnsupported -> + text "The `prim' calling convention can only be used with `foreign import'" + JavaScriptCallConvUnsupported -> + text "The `javascript' calling convention is unsupported on this platform" + + TcRnIllegalForeignType mArgOrResult reason + -> mkSimpleDecorated $ hang msg 2 extra + where + arg_or_res = case mArgOrResult of + Nothing -> empty + Just Arg -> text "argument" + Just Result -> text "result" + msg = hsep [ text "Unacceptable", arg_or_res + , text "type in foreign declaration:"] + extra = + case reason of + TypeCannotBeMarshaled ty why -> + let innerMsg = quotes (ppr ty) <+> text "cannot be marshalled in a foreign call" + in case why of + NotADataType -> + quotes (ppr ty) <+> text "is not a data type" + NewtypeDataConNotInScope _ [] -> + hang innerMsg 2 $ text "because its data constructor is not in scope" + NewtypeDataConNotInScope tc _ -> + hang innerMsg 2 $ + text "because the data constructor for" + <+> quotes (ppr tc) <+> text "is not in scope" + UnliftedFFITypesNeeded -> + innerMsg $$ text "UnliftedFFITypes is required to marshal unlifted types" + NotABoxedMarshalableTyCon -> innerMsg + ForeignLabelNotAPtr -> + innerMsg $$ text "A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)" + NotSimpleUnliftedType -> + innerMsg $$ text "foreign import prim only accepts simple unlifted types" + NotBoxedKindAny -> + text "Expected kind" <+> quotes (text "Type") <+> text "or" <+> quotes (text "UnliftedType") <> comma $$ + text "but" <+> quotes (ppr ty) <+> text "has kind" <+> quotes (ppr (typeKind ty)) + ForeignDynNotPtr expected ty -> + vcat [ text "Expected: Ptr/FunPtr" <+> pprParendType expected <> comma, text " Actual:" <+> ppr ty ] + SafeHaskellMustBeInIO -> + text "Safe Haskell is on, all FFI imports must be in the IO monad" + IOResultExpected -> + text "IO result type expected" + UnexpectedNestedForall -> + text "Unexpected nested forall" + LinearTypesNotAllowed -> + text "Linear types are not supported in FFI declarations, see #18472" + OneArgExpected -> + text "One argument expected" + AtLeastOneArgExpected -> + text "At least one argument expected" + TcRnInvalidCIdentifier target + -> mkSimpleDecorated $ + sep [quotes (ppr target) <+> text "is not a valid C identifier"] + TcRnExpectedValueId thing + -> mkSimpleDecorated $ + ppr thing <+> text "used where a value identifier was expected" + TcRnRecSelectorEscapedTyVar lbl + -> mkSimpleDecorated $ + text "Cannot use record selector" <+> quotes (ppr lbl) <+> + text "as a function due to escaped type variables" + TcRnPatSynNotBidirectional name + -> mkSimpleDecorated $ + text "non-bidirectional pattern synonym" + <+> quotes (ppr name) <+> text "used in an expression" + TcRnIllegalDerivingItem hs_ty + -> mkSimpleDecorated $ + text "Illegal deriving item" <+> quotes (ppr hs_ty) + TcRnIllegalDefaultClass nm + -> mkSimpleDecorated $ + text "Illegal named default declaration for non-class" <+> quotes (ppr nm) + TcRnIllegalNamedDefault hs_decl + -> mkSimpleDecorated $ text "Illegal named default declaration" <+> quotes (ppr hs_decl) + TcRnUnexpectedAnnotation ty bang + -> mkSimpleDecorated $ + let err = case bang of + HsSrcBang _ SrcUnpack _ -> "UNPACK" + HsSrcBang _ SrcNoUnpack _ -> "NOUNPACK" + HsSrcBang _ NoSrcUnpack SrcLazy -> "laziness (~)" + HsSrcBang _ _ _ -> "strictness (!)" + in text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$ + text err <+> text "annotation can only appear on the arguments of a data constructor type" + TcRnIllegalRecordSyntax ty + -> mkSimpleDecorated $ + text "Record syntax is illegal here:" <+> ppr ty + + TcRnInvalidVisibleKindArgument arg ty + -> mkSimpleDecorated $ + text "Cannot apply function of kind" <+> quotes (ppr ty) + $$ text "to visible kind argument" <+> quotes (ppr arg) + TcRnTooManyBinders ki bndrs + -> mkSimpleDecorated $ + hang (text "Not a function kind:") + 4 (ppr ki) $$ + hang (text "but extra binders found:") + 4 (fsep (map ppr bndrs)) + TcRnDifferentNamesForTyVar n1 n2 + -> mkSimpleDecorated $ + hang (text "Different names for the same type variable:") 2 info + where + info | nameOccName n1 /= nameOccName n2 + = quotes (ppr n1) <+> text "and" <+> quotes (ppr n2) + | otherwise -- Same OccNames! See C2 in + -- Note [Swizzling the tyvars before generaliseTcTyCon] + = vcat [ quotes (ppr n1) <+> text "bound at" <+> ppr (getSrcLoc n1) + , quotes (ppr n2) <+> text "bound at" <+> ppr (getSrcLoc n2) ] + + TcRnDisconnectedTyVar n + -> mkSimpleDecorated $ + hang (text "Scoped type variable only appears non-injectively in declaration header:") + 2 (quotes (ppr n) <+> text "bound at" <+> ppr (getSrcLoc n)) + + TcRnInvalidReturnKind data_sort allowed_kind kind _suggested_ext + -> mkSimpleDecorated $ + sep [ ppDataSort data_sort <+> + text "has non-" <> + allowed_kind_tycon + , (if is_data_family then text "and non-variable" else empty) <+> + text "return kind" <+> quotes (ppr kind) + ] + where + is_data_family = + case data_sort of + DataDeclSort{} -> False + DataInstanceSort{} -> False + DataFamilySort -> True + allowed_kind_tycon = + case allowed_kind of + AnyTYPEKind -> ppr tYPETyCon + AnyBoxedKind -> ppr boxedRepDataConTyCon + LiftedKind -> ppr liftedTypeKind + TcRnClassKindNotConstraint _kind + -> mkSimpleDecorated $ + text "Kind signature on a class must end with" <+> ppr constraintKind $$ + text "unobscured by type families" + TcRnUnpromotableThing name err + -> mkSimpleDecorated $ + (hang (pprPECategory err <+> quotes (ppr name) <+> text "cannot be used here") + 2 (parens reason)) + where + reason = case err of + ConstrainedDataConPE theta + -> text "it has an unpromotable context" + <+> quotes (pprTheta theta) + + FamDataConPE -> text "it comes from a data family instance" + PatSynPE -> text "pattern synonyms cannot be promoted" + RecDataConPE -> same_rec_group_msg + ClassPE -> same_rec_group_msg + TyConPE -> same_rec_group_msg + TermVariablePE -> text "term variables cannot be promoted" + TypeVariablePE -> text "type variables bound in a kind signature cannot be used in the type" + same_rec_group_msg = text "it is defined and used in the same recursive group" + TcRnIllegalTermLevelUse simple_msg rdr name err + -> mkSimpleDecorated $ + if simple_msg + then + vcat [ expecting_what <+> text "out of scope:" <+> quotes (ppr rdr) <> dot + , "NB: the" <+> text (teCategory err) <+> quotes (ppr qnm) <+> "cannot appear in this position." + ] + else + text "Illegal term-level use of the" <+> + text (teCategory err) <+> quotes (ppr qnm) + where + expecting_what = case err of + TyVarTE -> "Term variable" + ClassTE -> "Data constructor" + TyConTE -> "Data constructor" + qnm = WithUserRdr rdr name + TcRnMatchesHaveDiffNumArgs argsContext (MatchArgMatches match1 bad_matches) + -> mkSimpleDecorated $ + (vcat [ pprMatchContextNouns argsContext <+> + text "have different numbers of arguments" + , nest 2 (ppr (getLocA match1)) + , nest 2 (ppr (getLocA (NE.head bad_matches)))]) + TcRnCannotBindScopedTyVarInPatSig sig_tvs + -> mkSimpleDecorated $ + hang (text "You cannot bind scoped type variable" + <> plural (NE.toList sig_tvs) + <+> pprQuotedList (map fst $ NE.toList sig_tvs)) + 2 (text "in a pattern binding signature") + TcRnCannotBindTyVarsInPatBind _offenders + -> mkSimpleDecorated $ + text "Binding type variables is not allowed in pattern bindings" + TcRnMultipleInlinePragmas poly_id fst_inl_prag inl_prags + -> mkSimpleDecorated $ + hang (text "Multiple INLINE pragmas for" <+> ppr poly_id) + 2 (vcat (text "Ignoring all but the first" + : map pp_inl (fst_inl_prag : NE.toList inl_prags))) + where + pp_inl (L loc prag) = ppr prag <+> parens (ppr loc) + TcRnUnexpectedPragmas poly_id bad_sigs + -> mkSimpleDecorated $ + hang (text "Discarding unexpected pragmas for" <+> ppr poly_id) + 2 (vcat (map (ppr . getLoc) $ NE.toList bad_sigs)) + TcRnNonOverloadedSpecialisePragma fun_name + -> mkSimpleDecorated $ + text "SPECIALISE pragma for non-overloaded function" + <+> quotes (ppr fun_name) + TcRnSpecialiseNotVisible name + -> mkSimpleDecorated $ + text "You cannot SPECIALISE" <+> quotes (ppr name) + <+> text "because its definition is not visible in this module" + TcRnPragmaWarning + { pragma_warning_info = PragmaWarningInstance{pwarn_dfunid, pwarn_ctorig} + , pragma_warning_msg } + -> mkSimpleDecorated $ + sep [ hang (text "In the use of") + 2 (pprDFunId pwarn_dfunid) + , ppr pwarn_ctorig + , pprWarningTxtForMsg pragma_warning_msg + ] + TcRnPragmaWarning + { pragma_warning_info = PragmaWarningDefault{pwarn_class, pwarn_impmod} + , pragma_warning_msg } + -> mkSimpleDecorated $ + sep [ sep [ text "In the use of class" + <+> ppr pwarn_class + <+> text "defaults imported from" + <+> ppr pwarn_impmod <> colon ] + , pprWarningTxtForMsg pragma_warning_msg + ] + TcRnPragmaWarning {pragma_warning_info, pragma_warning_msg} + -> mkSimpleDecorated $ + sep [ sep [ text "In the use of" + <+> pprNonVarNameSpace (occNameSpace occ_name) + <+> quotes (ppr occ_name) + , parens imp_msg <> colon ] + , pprWarningTxtForMsg pragma_warning_msg ] + where + occ_name = pwarn_occname pragma_warning_info + imp_mod = pwarn_impmod pragma_warning_info + imp_msg = text "imported from" <+> ppr imp_mod <> extra + extra | PragmaWarningName {pwarn_declmod = decl_mod} <- pragma_warning_info + , imp_mod /= decl_mod = text ", but defined in" <+> ppr decl_mod + | otherwise = empty + TcRnDifferentExportWarnings name locs + -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages", + text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] + TcRnIncompleteExportWarnings name locs + -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "will not have its export warned about", + text "missing export warning at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] + TcRnIllegalHsigDefaultMethods name meths + -> mkSimpleDecorated $ + text "Illegal default method" <> plural (NE.toList meths) <+> text "in class definition of" <+> ppr name <+> text "in hsig file" + TcRnHsigFixityMismatch real_thing real_fixity sig_fixity + -> + let ppr_fix f = ppr f <+> if f == defaultFixity then parens (text "default") else empty + in mkSimpleDecorated $ + vcat [ppr real_thing <+> text "has conflicting fixities in the module", + text "and its hsig file", + text "Main module:" <+> ppr_fix real_fixity, + text "Hsig file:" <+> ppr_fix sig_fixity] + TcRnHsigShapeMismatch (HsigShapeSortMismatch info1 info2) + -> mkSimpleDecorated $ + text "While merging export lists, could not combine" + <+> ppr info1 <+> text "with" <+> ppr info2 + <+> parens (text "one is a type, the other is a plain identifier") + TcRnHsigShapeMismatch (HsigShapeNotUnifiable name1 name2 notHere) + -> + let extra = if notHere + then text "Neither name variable originates from the current signature." + else empty + in mkSimpleDecorated $ + text "While merging export lists, could not unify" + <+> ppr name1 <+> text "with" <+> ppr name2 $$ extra + TcRnHsigMissingModuleExport occ unit_state impl_mod + -> mkSimpleDecorated $ + quotes (ppr occ) + <+> text "is exported by the hsig file, but not exported by the implementing module" + <+> quotes (pprWithUnitState unit_state $ ppr impl_mod) + TcRnBadGenericMethod clas op + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr clas), + text "has a generic-default signature without a binding", quotes (ppr op)] + TcRnWarningMinimalDefIncomplete mindef + -> mkSimpleDecorated $ + vcat [ text "The MINIMAL pragma does not require:" + , nest 2 (pprBooleanFormulaNice mindef) + , text "but there is no default implementation." ] + TcRnDefaultMethodForPragmaLacksBinding sel_id prag + -> mkSimpleDecorated $ + text "The" <+> hsSigDoc prag <+> text "for default method" + <+> quotes (ppr sel_id) + <+> text "lacks an accompanying binding" + TcRnIgnoreSpecialisePragmaOnDefMethod sel_name + -> mkSimpleDecorated $ + text "Ignoring SPECIALISE pragmas on default method" + <+> quotes (ppr sel_name) + TcRnBadMethodErr{badMethodErrClassName, badMethodErrMethodName} + -> mkSimpleDecorated $ + hsep [text "Class", quotes (ppr badMethodErrClassName), + text "does not have a method", quotes (ppr badMethodErrMethodName)] + TcRnIllegalTypeData + -> mkSimpleDecorated $ + text "Illegal type-level data declaration" + TcRnTypeDataForbids feature + -> mkSimpleDecorated $ + ppr feature <+> text "are not allowed in type data declarations." + + TcRnIllegalNewtype con show_linear_types reason + -> mkSimpleDecorated $ + vcat [msg, additional] + where + (msg,additional) = + case reason of + DoesNotHaveSingleField n_flds -> + (sep [ + text "A newtype constructor must have exactly one field", + nest 2 $ + text "but" <+> quotes (ppr con) <+> text "has" <+> speakN n_flds + ], + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + IsNonLinear -> + (text "A newtype constructor must be linear", + ppr con <+> dcolon <+> ppr (dataConDisplayType True con)) + IsGADT -> + (text "A newtype must not be a GADT", + ppr con <+> dcolon <+> pprWithInvisibleBitsWhen sneaky_eq_spec + (ppr $ dataConDisplayType show_linear_types con)) + HasConstructorContext -> + (text "A newtype constructor must not have a context in its type", + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + HasExistentialTyVar -> + (text "A newtype constructor must not have existential type variables", + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + HasStrictnessAnnotation -> + (text "A newtype constructor must not have a strictness annotation", empty) + + -- Is the data con a "covert" GADT? See Note [isCovertGadtDataCon] + -- in GHC.Core.DataCon + sneaky_eq_spec = isCovertGadtDataCon con + TcRnOrPatBindsVariables bndrs -> mkSimpleDecorated $ + text "An or-pattern may not bind term or type variables such as" + <+> quotedListWithOr (map ppr (NE.toList bndrs)) + TcRnUnsatisfiedMinimalDef mindef + -> mkSimpleDecorated $ + vcat [text "No explicit implementation for" + ,nest 2 $ pprBooleanFormulaNice mindef + ] + TcRnMisplacedInstSig name hs_ty + -> mkSimpleDecorated $ + vcat [ hang (text "Illegal type signature in instance declaration:") + 2 (hang (pprPrefixName name) + 2 (dcolon <+> ppr hs_ty)) + ] + TcRnNoRebindableSyntaxRecordDot -> mkSimpleDecorated $ + text "RebindableSyntax is required if OverloadedRecordUpdate is enabled." + TcRnNoFieldPunsRecordDot -> mkSimpleDecorated $ + text "For this to work enable NamedFieldPuns" + TcRnIllegalStaticExpression e -> mkSimpleDecorated $ + text "Illegal static expression:" <+> ppr e + TcRnListComprehensionDuplicateBinding n -> mkSimpleDecorated $ + (text "Duplicate binding in parallel list comprehension for:" + <+> quotes (ppr n)) + TcRnEmptyStmtsGroup cause -> mkSimpleDecorated $ case cause of + EmptyStmtsGroupInParallelComp -> + text "Empty statement group in parallel comprehension" + EmptyStmtsGroupInTransformListComp -> + text "Empty statement group preceding 'group' or 'then'" + EmptyStmtsGroupInDoNotation ctxt -> + text "Empty" <+> pprHsDoFlavour ctxt + EmptyStmtsGroupInArrowNotation -> + text "Empty 'do' block in an arrow command" + TcRnLastStmtNotExpr ctxt (UnexpectedStatement stmt) -> + mkSimpleDecorated $ hang last_error 2 (ppr stmt) + where + last_error = + text "The last statement in" <+> pprAStmtContext ctxt + <+> text "must be an expression" + TcRnUnexpectedStatementInContext ctxt (UnexpectedStatement stmt) _ -> mkSimpleDecorated $ + sep [ text "Unexpected" <+> pprStmtCat stmt <+> text "statement" + , text "in" <+> pprAStmtContext ctxt ] + TcRnIllegalTupleSection -> mkSimpleDecorated $ + text "Illegal tuple section" + TcRnIllegalImplicitParameterBindings eBinds -> mkSimpleDecorated $ + either msg msg eBinds + where + msg binds = hang + (text "Implicit-parameter bindings illegal in an mdo expression") + 2 (ppr binds) + TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ + hang (text "A section must be enclosed in parentheses") + 2 (text "thus:" <+> (parens (ppr expr))) + TcRnMissingRoleAnnotation name roles -> mkSimpleDecorated $ + hang (text "Missing role annotation" <> colon) + 2 (text "type role" <+> ppr name <+> hsep (map ppr roles)) + + TcRnIllformedTypePattern p + -> mkSimpleDecorated $ + hang (text "Ill-formed type pattern:") 2 (ppr p) + TcRnIllegalTypePattern + -> mkSimpleDecorated $ + text "Illegal type pattern." $$ + text "A type pattern must be checked against a visible forall." + TcRnIllformedTypeArgument e + -> mkSimpleDecorated $ + hang (text "Ill-formed type argument:") 2 (ppr e) + TcRnIllegalTypeExpr syntax -> mkSimpleDecorated $ + vcat [ text "Illegal" <+> pprTypeSyntaxName syntax + , text "Type syntax may only be used in a required type argument," + , text "i.e. to instantiate a visible forall." ] + + TcRnCapturedTermName tv_name shadowed_term_names + -> mkSimpleDecorated $ + text "The type variable" <+> quotes (ppr tv_name) <+> + text "is implicitly quantified," $+$ + text "even though another variable of the same name is in scope:" $+$ + nest 2 var_names $+$ + text "This is not compatible with the RequiredTypeArguments extension." + where + var_names = case shadowed_term_names of + Left gbl_names -> vcat (map (\name -> quotes (ppr $ greName name) <+> pprNameProvenance name) gbl_names) + Right lcl_name -> quotes (ppr lcl_name) <+> text "defined at" + <+> ppr (nameSrcLoc lcl_name) + TcRnBindingOfExistingName name -> mkSimpleDecorated $ + text "Illegal binding of an existing name:" <+> ppr name + TcRnMultipleFixityDecls loc rdr_name -> mkSimpleDecorated $ + vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name), + text "also at " <+> ppr loc] + TcRnIllegalPatternSynonymDecl -> mkSimpleDecorated $ + text "Illegal pattern synonym declaration" + TcRnIllegalClassBinding dsort bind -> mkSimpleDecorated $ + vcat [ what <+> text "not allowed in" <+> decl_sort + , nest 2 (ppr bind) ] + where + decl_sort = case dsort of + ClassDeclSort -> text "class declaration:" + InstanceDeclSort -> text "instance declaration:" + what = case bind of + PatBind {} -> text "Pattern bindings (except simple variables)" + PatSynBind {} -> text "Pattern synonyms" + -- Associated pattern synonyms are not implemented yet + _ -> pprPanic "rnMethodBind" (ppr bind) + + TcRnOrphanCompletePragma -> mkSimpleDecorated $ + text "Orphan COMPLETE pragmas not supported" $$ + text "A COMPLETE pragma must mention at least one data constructor" $$ + text "or pattern synonym defined in the same module." + TcRnEmptyCase ctxt reason -> mkSimpleDecorated $ + case reason of + EmptyCaseWithoutFlag -> + text "Empty list of alternatives in" <+> pp_ctxt + EmptyCaseDisallowedCtxt -> + text "Empty list of alternatives is not allowed in" <+> pp_ctxt + EmptyCaseForall tvb -> + vcat [ text "Empty list of alternatives in" <+> pp_ctxt + , hang (text "checked against a forall-type:") + 2 (pprForAll [tvb] <+> text "...") + ] + where + pp_ctxt = case ctxt of + CaseAlt -> text "case expression" + LamAlt LamCase -> text "\\case expression" + LamAlt LamCases -> text "\\cases expression" + ArrowMatchCtxt (ArrowLamAlt LamSingle) -> text "kappa abstraction" + ArrowMatchCtxt (ArrowLamAlt LamCase) -> text "\\case command" + ArrowMatchCtxt (ArrowLamAlt LamCases) -> text "\\cases command" + ArrowMatchCtxt ArrowCaseAlt -> text "case command" + ctxt -> text "(unexpected)" <+> pprMatchContextNoun ctxt + TcRnNonStdGuards (NonStandardGuards guards) -> mkSimpleDecorated $ + text "accepting non-standard pattern guards" $$ + nest 4 (interpp'SP guards) + TcRnDuplicateSigDecl pairs@((L _ name, sig) :| _) -> mkSimpleDecorated $ + vcat [ text "Duplicate" <+> what_it_is + <> text "s for" <+> quotes (ppr name) + , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest + $ map (getLocA . fst) + $ NE.toList pairs) + ] + where + what_it_is = hsSigDoc sig + TcRnMisplacedSigDecl sig -> mkSimpleDecorated $ + sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig] + TcRnUnexpectedDefaultSig sig -> mkSimpleDecorated $ + hang (text "Unexpected default signature:") + 2 (ppr sig) + TcRnDuplicateMinimalSig sig1 sig2 otherSigs -> mkSimpleDecorated $ + vcat [ text "Multiple minimal complete definitions" + , text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ map getLocA sigs) + , text "Combine alternative minimal complete definitions with `|'" ] + where + sigs = sig1 : sig2 : otherSigs + TcRnSpecSigShape spec_e -> mkSimpleDecorated $ + hang (text "Illegal form of SPECIALISE pragma:") + 2 (ppr spec_e) + TcRnUnexpectedStandaloneDerivingDecl -> mkSimpleDecorated $ + text "Illegal standalone deriving declaration" + TcRnUnusedVariableInRuleDecl name var -> mkSimpleDecorated $ + sep [text "Rule" <+> doubleQuotes (ftext name) <> colon, + text "Forall'd variable" <+> quotes (ppr var) <+> + text "does not appear on left hand side"] + TcRnUnexpectedStandaloneKindSig -> mkSimpleDecorated $ + text "Illegal standalone kind signature" + TcRnIllegalRuleLhs errReason name lhs bad_e -> mkSimpleDecorated $ + sep [text "Rule" <+> pprRuleName name <> colon, + nest 2 (vcat [err, + text "in left-hand side:" <+> ppr lhs])] + $$ + text "LHS must be of form (f e1 .. en) where f is not forall'd" + where + err = case errReason of + UnboundVariable uv nis -> pprScopeError uv nis + IllegalExpression -> text "Illegal expression:" <+> ppr bad_e + TcRnRuleLhsEqualities ruleName _lhs cts -> mkSimpleDecorated $ + text "Discarding RULE" <+> doubleQuotes (ftext ruleName) <> dot + $$ + hang + (sep [ text "The LHS of this rule gave rise to equality constraints" + , text "that GHC was unable to quantify over:" ] + ) + 4 (pprWithArising $ NE.toList cts) + $$ + text "NB: this warning will become an error starting from GHC 9.18" + TcRnDuplicateRoleAnnot list -> mkSimpleDecorated $ + hang (text "Duplicate role annotations for" <+> + quotes (ppr $ roleAnnotDeclName first_decl) <> colon) + 2 (vcat $ map pp_role_annot $ NE.toList sorted_list) + where + sorted_list = NE.sortBy cmp_loc list + ((L _ first_decl) :| _) = sorted_list + + pp_role_annot (L loc decl) = hang (ppr decl) + 4 (text "-- written at" <+> ppr (locA loc)) + + cmp_loc = leftmost_smallest `on` getLocA + TcRnDuplicateKindSig list -> mkSimpleDecorated $ + hang (text "Duplicate standalone kind signatures for" <+> + quotes (ppr $ standaloneKindSigName first_decl) <> colon) + 2 (vcat $ map pp_kisig $ NE.toList sorted_list) + where + sorted_list = NE.sortBy cmp_loc list + ((L _ first_decl) :| _) = sorted_list + + pp_kisig (L loc decl) = + hang (ppr decl) 4 (text "-- written at" <+> ppr (locA loc)) + + cmp_loc = leftmost_smallest `on` getLocA + TcRnIllegalDerivStrategy ds -> mkSimpleDecorated $ + text "Illegal deriving strategy" <> colon <+> derivStrategyName ds + TcRnIllegalMultipleDerivClauses -> mkSimpleDecorated $ + text "Illegal use of multiple, consecutive deriving clauses" + TcRnNoDerivStratSpecified{} -> mkSimpleDecorated $ text + "No deriving strategy specified. Did you want stock, newtype, or anyclass?" + TcRnStupidThetaInGadt{} -> mkSimpleDecorated $ + vcat [text "No context is allowed on a GADT-style data declaration", + text "(You can put a context on each constructor, though.)"] + TcRnShadowedTyVarNameInFamResult resName -> mkSimpleDecorated $ + hsep [ text "Type variable", quotes (ppr resName) <> comma + , text "naming a type family result," + ] $$ + text "shadows an already bound type variable" + TcRnIncorrectTyVarOnLhsOfInjCond resName injFrom -> mkSimpleDecorated $ + vcat [ text $ "Incorrect type variable on the LHS of " + ++ "injectivity condition" + , nest 5 + ( vcat [ text "Expected :" <+> ppr resName + , text "Actual :" <+> ppr injFrom ])] + TcRnUnknownTyVarsOnRhsOfInjCond errorVars -> mkSimpleDecorated $ + hsep [ text "Unknown type variable" <> plural errorVars + , text "on the RHS of injectivity condition:" + , interpp'SP errorVars ] + TcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt _reason + -> pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt + TcRnBadlyLevelledType name bind_lvls use_lvl + -> mkSimpleDecorated $ + text "Badly levelled type:" <+> ppr name <+> + fsep [text "is bound at" <+> pprThBindLevel bind_lvls, + text "but used at level" <+> ppr use_lvl] + TcRnTyThingUsedWrong sort thing name + -> mkSimpleDecorated $ + pprTyThingUsedWrong sort thing name + TcRnCannotDefaultKindVar var knd -> + mkSimpleDecorated $ + (vcat [ text "Cannot default kind variable" <+> quotes (ppr var) + , text "of kind:" <+> ppr knd + , text "Perhaps enable PolyKinds or add a kind signature" ]) + TcRnUninferrableTyVar tidied_tvs context -> + mkSimpleDecorated $ + pprWithInvisibleBitsWhen True $ + vcat [ text "Uninferrable type variable" + <> plural tidied_tvs + <+> pprWithCommas pprTyVar tidied_tvs + <+> text "in" + , pprUninferrableTyVarCtx context ] + TcRnSkolemEscape escapees tv orig_ty -> + mkSimpleDecorated $ + pprWithInvisibleBitsWhen True $ + vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees + , quotes $ pprTyVars escapees + , text "would escape" <+> itsOrTheir escapees <+> text "scope" + ] + , sep [ text "if I tried to quantify" + , pprTyVar tv + , text "in this type:" + ] + , nest 2 (pprTidiedType orig_ty) + , text "(Indeed, I sometimes struggle even printing this correctly," + , text " due to its ill-scoped nature.)" + ] + TcRnPatSynEscapedCoercion arg bad_co_ne -> mkSimpleDecorated $ + vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" + , hang (text "Pattern-bound variable") + 2 (ppr arg <+> dcolon <+> ppr (idType arg)) + , nest 2 $ + hang (text "has a type that mentions pattern-bound coercion" + <> plural bad_co_list <> colon) + 2 (pprWithCommas ppr bad_co_list) + , text "Hint: use -fprint-explicit-coercions to see the coercions" + , text "Probable fix: add a pattern signature" ] + where + bad_co_list = NE.toList bad_co_ne + TcRnPatSynExistentialInResult name pat_ty bad_tvs -> mkSimpleDecorated $ + hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma + , text "namely" <+> quotes (ppr pat_ty) ]) + 2 (text "mentions existential type variable" <> plural bad_tvs + <+> pprQuotedList bad_tvs) + TcRnPatSynArityMismatch name decl_arity missing -> mkSimpleDecorated $ + hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" + <+> speakNOf decl_arity (text "argument")) + 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows") + TcRnPatSynInvalidRhs ps_name lpat _ reason -> mkSimpleDecorated $ + vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" + <+> quotes (ppr ps_name) <> colon) + 2 (pprPatSynInvalidRhsReason reason) + , text "RHS pattern:" <+> ppr lpat ] + TcRnTyFamDepsDisabled -> mkSimpleDecorated $ + text "Illegal injectivity annotation" + TcRnAbstractClosedTyFamDecl -> mkSimpleDecorated $ + text "You may define an abstract closed type family" $$ + text "only in a .hs-boot file" + TcRnPartialFieldSelector fld -> mkSimpleDecorated $ + vcat [ sep [ text "Definition of partial record field" <> colon + , nest 2 $ quotes (ppr (occName fld)) ] + , text "Record selection and update using this field will be partial." ] + TcRnHasFieldResolvedIncomplete name cons maxCons -> mkSimpleDecorated $ + hang (text "Selecting the record field" <+> quotes (ppr name) + <+> text "may fail for the following constructors:") + 2 + (hsep $ punctuate comma $ + map ppr (take maxCons cons) ++ [ text "..." | lengthExceeds cons maxCons ]) + TcRnBadFieldAnnotation n con reason -> mkSimpleDecorated $ + hang (pprBadFieldAnnotationReason reason) + 2 (text "on the" <+> speakNth n + <+> text "argument of" <+> quotes (ppr con)) + TcRnSuperclassCycle (MkSuperclassCycle cls definite details) -> + let herald | definite = text "Superclass cycle for" + | otherwise = text "Potential superclass cycle for" + in mkSimpleDecorated $ + vcat [ herald <+> quotes (ppr cls), nest 2 (vcat (pprSuperclassCycleDetail <$> details))] + TcRnDefaultSigMismatch sel_id dm_ty -> mkSimpleDecorated $ + hang (text "The default type signature for" + <+> ppr sel_id <> colon) + 2 (ppr dm_ty) + $$ (text "does not match its corresponding" + <+> text "non-default type signature") + TcRnTyFamsDisabled reason -> mkSimpleDecorated $ + text "Illegal family" <+> text sort <+> text "for" <+> quotes name + where + (sort, name) = case reason of + TyFamsDisabledFamily n -> ("declaration", ppr n) + TyFamsDisabledInstance n -> ("instance", ppr n) + TcRnBadTyConTelescope tc -> mkSimpleDecorated $ + vcat [ hang (text "The kind of" <+> quotes (ppr tc) <+> text "is ill-scoped") + 2 pp_tc_kind + , extra + , hang (text "Perhaps try this order instead:") + 2 (pprTyVars sorted_tvs) ] + where + pp_tc_kind = text "Inferred kind:" <+> ppr tc <+> dcolon <+> ppr_untidy (tyConKind tc) + ppr_untidy ty = pprIfaceType (toIfaceType ty) + -- We need ppr_untidy here because pprType will tidy the type, which + -- will turn the bogus kind we are trying to report + -- T :: forall (a::k) k (b::k) -> blah + -- into a misleadingly sanitised version + -- T :: forall (a::k) k1 (b::k1) -> blah + + tcbs = tyConBinders tc + tvs = binderVars tcbs + sorted_tvs = scopedSort tvs + + inferred_tvs = [ binderVar tcb + | tcb <- tcbs, Inferred == tyConBinderForAllTyFlag tcb ] + specified_tvs = [ binderVar tcb + | tcb <- tcbs, Specified == tyConBinderForAllTyFlag tcb ] + + extra + | null inferred_tvs && null specified_tvs + = empty + | null inferred_tvs + = note $ "Specified variables" <+> pp_spec <+> "always come first" + | null specified_tvs + = note inf_always_first + | otherwise + = note $ inf_always_first $$ + "then specified variables" <+> pp_spec + + inf_always_first = "Inferred variables" <+> pp_inf $$ "always come first" + + pp_inf = parens (text "namely:" <+> pprTyVars inferred_tvs) + pp_spec = parens (text "namely:" <+> pprTyVars specified_tvs) + TcRnTyFamResultDisabled tc_name tvb -> mkSimpleDecorated $ + text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name) + TcRnRoleValidationFailed role reason -> mkSimpleDecorated $ + vcat [text "Internal error in role inference:", + pprRoleValidationFailedReason role reason, + text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"] + TcRnCommonFieldResultTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ + vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, + text "have a common field" <+> quotes (ppr field_name) <> comma], + nest 2 $ text "but have different result types"] + TcRnCommonFieldTypeMismatch con1 con2 field_name -> mkSimpleDecorated $ + sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, + text "give different types for field", quotes (ppr field_name)] + TcRnClassExtensionDisabled cls reason -> mkSimpleDecorated $ + pprDisabledClassExtension cls reason + TcRnDataConParentTypeMismatch data_con res_ty_tmpl -> mkSimpleDecorated $ + hang (text "Data constructor" <+> quotes (ppr data_con) <+> + text "returns type" <+> quotes (ppr actual_res_ty)) + 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl)) + where + actual_res_ty = dataConOrigResTy data_con + TcRnGADTsDisabled tc_name -> mkSimpleDecorated $ + text "Illegal generalised algebraic data declaration for" <+> quotes (ppr tc_name) + TcRnExistentialQuantificationDisabled con -> mkSimpleDecorated $ + sdocOption sdocLinearTypes (\show_linear_types -> + hang (text "Data constructor" <+> quotes (ppr con) <+> + text "has existential type variables, a context, or a specialised result type") + 2 (ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con))) + TcRnGADTDataContext tc_name -> mkSimpleDecorated $ + text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) + TcRnMultipleConForNewtype tycon n -> mkSimpleDecorated $ + sep [text "A newtype must have exactly one constructor,", + nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n] + TcRnKindSignaturesDisabled thing -> mkSimpleDecorated $ + text "Illegal kind signature" <+> quotes (either ppr with_sig thing) + where + with_sig (tc_name, ksig) = ppr tc_name <+> dcolon <+> ppr ksig + TcRnEmptyDataDeclsDisabled tycon -> mkSimpleDecorated $ + quotes (ppr tycon) <+> text "has no constructors" + TcRnRoleMismatch var annot inferred -> mkSimpleDecorated $ + hang (text "Role mismatch on variable" <+> ppr var <> colon) + 2 (sep [ text "Annotation says", ppr annot + , text "but role", ppr inferred + , text "is required" ]) + TcRnRoleCountMismatch tyvars d@(L _ (RoleAnnotDecl _ _ annots)) -> mkSimpleDecorated $ + hang (text "Wrong number of roles listed in role annotation;" $$ + text "Expected" <+> (ppr tyvars) <> comma <+> + text "got" <+> (ppr $ length annots) <> colon) + 2 (ppr d) + TcRnIllegalRoleAnnotation (RoleAnnotDecl _ tycon _) -> mkSimpleDecorated $ + (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ + text "they are allowed only for datatypes and classes.") + TcRnRoleAnnotationsDisabled tc -> mkSimpleDecorated $ + text "Illegal role annotation for" <+> ppr tc + TcRnIncoherentRoles _ -> mkSimpleDecorated $ + (text "Roles other than" <+> quotes (text "nominal") <+> + text "for class parameters can lead to incoherence.") + TcRnUnexpectedKindVar tv_name + -> mkSimpleDecorated $ text "Unexpected kind variable" <+> quotes (ppr tv_name) + + TcRnNegativeNumTypeLiteral tyLit + -> mkSimpleDecorated $ text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit + + TcRnIllegalKind ty_thing _ + -> mkSimpleDecorated $ text "Illegal kind:" <+> (ppr ty_thing) + + TcRnPrecedenceParsingError op1 op2 + -> mkSimpleDecorated $ + hang (text "Precedence parsing error") + 4 (hsep [text "cannot mix", ppr_opfix op1, text "and", + ppr_opfix op2, + text "in the same infix expression"]) + + TcRnSectionPrecedenceError op arg_op section + -> mkSimpleDecorated $ + vcat [text "The operator" <+> ppr_opfix op <+> text "of a section", + nest 4 (sep [text "must have lower precedence than that of the operand,", + nest 2 (text "namely" <+> ppr_opfix arg_op)]), + nest 4 (text "in the section:" <+> quotes (ppr section))] + + TcRnUnexpectedPatSigType ty + -> mkSimpleDecorated $ + hang (text "Illegal type signature:" <+> quotes (ppr ty)) + 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + + TcRnIllegalKindSignature ty + -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) + + TcRnUnusedQuantifiedTypeVar doc tyVar + -> mkSimpleDecorated $ + vcat [ text "Unused quantified type variable" <+> quotes (ppr tyVar) + , inHsDocContext doc ] + + TcRnDataKindsError typeOrKind thing + -> case thing of + Left renamer_thing -> + mkSimpleDecorated $ msg renamer_thing + Right typechecker_thing -> + mkSimpleDecorated $ msg typechecker_thing + where + msg :: Outputable a => a -> SDoc + msg thing = text "Illegal" <+> text (levelString typeOrKind) <> + colon <+> quotes (ppr thing) + + TcRnTypeSynonymCycle decl_or_tcs + -> mkSimpleDecorated $ + sep [ text "Cycle in type synonym declarations:" + , nest 2 (vcat (map ppr_decl decl_or_tcs)) ] + where + ppr_decl = \case + Right (L loc decl) -> ppr (locA loc) <> colon <+> ppr decl + Left tc -> + let n = tyConName tc + in ppr (getSrcSpan n) <> colon <+> ppr (tyConName tc) + <+> text "from external module" + TcRnZonkerMessage err + -> mkSimpleDecorated $ pprZonkerMessage err + TcRnInterfaceError reason + -> diagnosticMessage (tcOptsIfaceOpts opts) reason + TcRnSelfImport imp_mod_name + -> mkSimpleDecorated $ + text "A module cannot import itself:" <+> ppr imp_mod_name + TcRnNoExplicitImportList mod + -> mkSimpleDecorated $ + text "The module" <+> quotes (ppr mod) <+> text "does not have an explicit import list" + TcRnSafeImportsDisabled _ + -> mkSimpleDecorated $ + text "safe import can't be used as Safe Haskell isn't on!" + TcRnDeprecatedModule mod txt + -> mkSimpleDecorated $ + sep [ text "Module" <+> quotes (ppr mod) <> text extra <> colon, + nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ] + where + (extra, msg) = case txt of + WarningTxt _ _ msg -> ("", msg) + DeprecatedTxt _ msg -> (" is deprecated", msg) + TcRnRedundantSourceImport mod_name + -> mkSimpleDecorated $ + text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) + TcRnImportLookup reason + -> mkSimpleDecorated $ + pprImportLookup reason + TcRnUnusedImport decl reason + -> mkSimpleDecorated $ + pprUnusedImport decl reason + TcRnDuplicateDecls name sorted_names + -> mkSimpleDecorated $ + vcat [text "Multiple declarations of" <+> + quotes (ppr name), + -- NB. print the OccName, not the Name, because the + -- latter might not be in scope in the RdrEnv and so will + -- be printed qualified. + text "Declared at:" <+> + vcat (NE.toList $ ppr . nameSrcLoc <$> sorted_names)] + TcRnPackageImportsDisabled + -> mkSimpleDecorated $ + text "Package-qualified imports are not enabled" + TcRnIllegalDataCon name + -> mkSimpleDecorated $ + hsep [text "Illegal data constructor name", quotes (ppr name)] + TcRnNestedForallsContexts entity + -> mkSimpleDecorated $ + what <+> text "cannot contain nested" + <+> quotes forAllLit <> text "s or contexts" + where + what = case entity of + NFC_Specialize -> text "SPECIALISE instance type" + NFC_ViaType -> quotes (text "via") <+> text "type" + NFC_GadtConSig -> text "GADT constructor type signature" + NFC_InstanceHead -> text "Instance head" + NFC_StandaloneDerivedInstanceHead -> text "Standalone-derived instance head" + NFC_DerivedClassType -> text "Derived class type" + TcRnRedundantRecordWildcard + -> mkSimpleDecorated $ + text "Record wildcard does not bind any new variables" + TcRnUnusedRecordWildcard _ + -> mkSimpleDecorated $ + text "No variables bound in the record wildcard match are used" + TcRnUnusedName name reason + -> mkSimpleDecorated $ + pprUnusedName name reason + TcRnQualifiedBinder rdr_name + -> mkSimpleDecorated $ + text "Qualified name in binding position:" <+> ppr rdr_name + TcRnTypeApplicationsDisabled ty ty_or_ki + -> mkSimpleDecorated $ + text "Illegal visible" <+> what <+> text "application" <> colon + <+> ppr arg + where + arg = char '@' <> ppr ty + what = case ty_or_ki of + TypeLevel -> text "type" + KindLevel -> text "kind" + TcRnInvalidRecordField con field + -> mkSimpleDecorated $ + hsep [text "Constructor" <+> quotes (ppr con), + text "does not have field", quotes (ppr field)] + TcRnTupleTooLarge tup_size + -> mkSimpleDecorated $ + sep [text "A" <+> int tup_size <> text "-tuple is too large for GHC", + nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), + nest 2 (text "Workaround: use nested tuples or define a data type")] + TcRnCTupleTooLarge tup_size + -> mkSimpleDecorated $ + hang (text "Constraint tuple arity too large:" <+> int tup_size + <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) + 2 (text "Instead, use a nested tuple") + TcRnIllegalInferredTyVars _ + -> mkSimpleDecorated $ + text "Inferred type variables are not allowed" + TcRnAmbiguousName gre_env name gres + -> mkSimpleDecorated $ + vcat [ text "Ambiguous occurrence" <+> quotes (ppr name) <> dot + , text "It could refer to" + , nest 3 (vcat msgs) ] + where + np1 NE.:| nps = gres + msgs = punctuateFinal comma dot $ + text "either" <+> ppr_gre np1 + : [text " or" <+> ppr_gre np | np <- nps] + + ppr_gre gre = pprAmbiguousGreName gre_env gre + + TcRnBindingNameConflict name locs + -> mkSimpleDecorated $ + vcat [text "Conflicting definitions for" <+> quotes (ppr name), + locations] + where + locations = + text "Bound at:" + <+> vcat (map ppr (sortBy leftmost_smallest (NE.toList locs))) + TcRnNonCanonicalDefinition reason inst_ty + -> mkSimpleDecorated $ + pprNonCanonicalDefinition inst_ty reason + TcRnDefaultedExceptionContext ct_loc -> + mkSimpleDecorated $ vcat [ header, warning, proposal ] + where + header, warning, proposal :: SDoc + header + = vcat [ text "Solving for an implicit ExceptionContext constraint" + , nest 2 $ pprCtOrigin (ctLocOrigin ct_loc) <> text "." ] + warning + = vcat [ text "Future versions of GHC will turn this warning into an error." ] + proposal + = vcat [ text "See GHC Proposal #330." ] + TcRnImplicitImportOfPrelude + -> mkSimpleDecorated $ + text "Module" <+> quotes (text "Prelude") <+> text "implicitly imported." + TcRnMissingMain explicit_export_list main_mod main_occ + -> mkSimpleDecorated $ + text "The" <+> ppMainFn main_occ + <+> text "is not" <+> defOrExp <+> text "module" + <+> quotes (ppr main_mod) + where + defOrExp :: SDoc + defOrExp | explicit_export_list = text "exported by" + | otherwise = text "defined in" + TcRnGhciUnliftedBind id + -> mkSimpleDecorated $ + sep [ text "GHCi can't bind a variable of unlifted type:" + , nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id)) ] + TcRnGhciMonadLookupFail ty lookups + -> mkSimpleDecorated $ + hang (text "Can't find type" <+> pp_ty <> dot $$ ambig_msg) + 2 (text "When checking that" <+> pp_ty <> + text "is a monad that can execute GHCi statements.") + where + pp_ty = quotes (text ty) + ambig_msg = case lookups of + Just (_:_:_) -> text "The type is ambiguous." + _ -> empty + TcRnIllegalQuasiQuotes -> mkSimpleDecorated $ + text "Quasi-quotes are not permitted without QuasiQuotes" + TcRnTHError err -> pprTHError err + TcRnPatersonCondFailure reason ctxt lhs rhs -> + mkSimpleDecorated $ pprPatersonCondFailure reason ctxt lhs rhs + TcRnIllegalInvisTyVarBndr bndr -> + mkSimpleDecorated $ + hang (text "Illegal invisible type variable binder:") + 2 (ppr bndr) + TcRnIllegalWildcardTyVarBndr bndr -> + mkSimpleDecorated $ + hang (text "Illegal wildcard binder:") + 2 (ppr bndr) + + TcRnInvalidInvisTyVarBndr name hs_bndr -> + mkSimpleDecorated $ + vcat [ hang (text "Invalid invisible type variable binder:") + 2 (ppr hs_bndr) + , text "There is no matching forall-bound variable" + , text "in the standalone kind signature for" <+> quotes (ppr name) <> dot + , note $ vcat [ + "Only" <+> quotes "forall a." <+> "-quantification matches invisible binders,", + "whereas" <+> quotes "forall {a}." <+> "and" <+> quotes "forall a ->" <+> "do not" + ]] + + TcRnInvisBndrWithoutSig _ hs_bndr -> + mkSimpleDecorated $ + vcat [ hang (text "Invalid invisible type variable binder:") + 2 (ppr hs_bndr) + , text "Either a standalone kind signature (SAKS)" + , text "or a complete user-supplied kind (CUSK, legacy feature)" + , text "is required to use invisible binders." ] + + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "The next version of GHC will reject this program, no longer implicitly quantify over" <+> quotes (ppr kv) + ] + + TcRnInvalidDefaultedTyVar wanteds proposal bad_tvs -> + mkSimpleDecorated $ + pprWithInvisibleBitsWhen True $ + vcat [ text "Invalid defaulting proposal." + , hang (text "The following type variable" <> plural (NE.toList bad_tvs) <+> text "cannot be defaulted, as" <+> why <> colon) + 2 (pprQuotedList (NE.toList bad_tvs)) + , hang (text "Defaulting proposal:") + 2 (ppr proposal) + , hang (text "Wanted constraints:") + 2 (pprQuotedList (map ctPred wanteds)) + ] + where + why + | _ :| [] <- bad_tvs + = text "it is not an unfilled metavariable" + | otherwise + = text "they are not unfilled metavariables" + + TcRnNamespacedWarningPragmaWithoutFlag warning@(Warning (kw, _) _ txt) -> mkSimpleDecorated $ + vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:" + , nest 2 (ppr warning) + , text "in a" <+> pragma_type <+> text "pragma" + ] + where + pragma_type = case txt of + WarningTxt{} -> text "WARNING" + DeprecatedTxt{} -> text "DEPRECATED" + + TcRnIllegalInvisibleTypePattern tp reason -> mkSimpleDecorated $ + vcat [ hang (text "Illegal invisible type pattern:") + 2 (char '@' <> ppr tp) + , case reason of + InvisPatWithoutFlag -> empty + InvisPatNoForall -> text "An invisible type pattern must be checked against a forall." + InvisPatMisplaced -> text "An invisible type pattern must occur in an argument position." + ] + + TcRnNamespacedFixitySigWithoutFlag sig@(FixitySig kw _ _) -> mkSimpleDecorated $ + vcat [ text "Illegal use of the" <+> quotes (ppr kw) <+> text "keyword:" + , nest 2 (ppr sig) + , text "in a fixity signature" + ] + + TcRnOutOfArityTyVar ts_name tv_name -> mkDecorated + [ vcat [ text "The arity of" <+> quotes (ppr ts_name) <+> text "is insufficiently high to accommodate" + , text "an implicit binding for the" <+> quotes (ppr tv_name) <+> text "type variable." ] + , suggestion ] + where + suggestion = + text "Use" <+> quotes at_bndr <+> text "on the LHS" <+> + text "or" <+> quotes forall_bndr <+> text "on the RHS" <+> + text "to bring it into scope." + at_bndr = char '@' <> ppr tv_name + forall_bndr = text "forall" <+> ppr tv_name <> text "." + + TcRnUnexpectedTypeSyntaxInTerms syntax -> mkSimpleDecorated $ + text "Unexpected" <+> pprTypeSyntaxName syntax + + diagnosticReason :: TcRnMessage -> DiagnosticReason + diagnosticReason = \case + TcRnUnknownMessage m + -> diagnosticReason m + TcRnMessageWithInfo _ msg_with_info + -> case msg_with_info of + TcRnMessageDetailed _ m -> diagnosticReason m + TcRnWithHsDocContext _ msg + -> diagnosticReason msg + TcRnSolverReport _report reason + -> reason -- Error, or a Warning if we are deferring type errors + TcRnSolverDepthError {} + -> ErrorWithoutFlag + TcRnRedundantConstraints {} + -> WarningWithFlag Opt_WarnRedundantConstraints + TcRnInaccessibleCode {} + -> WarningWithFlag Opt_WarnInaccessibleCode + TcRnInaccessibleCoAxBranch {} + -> WarningWithFlag Opt_WarnInaccessibleCode + TcRnTypeDoesNotHaveFixedRuntimeRep{} + -> ErrorWithoutFlag + TcRnImplicitLift{} + -> WarningWithFlag Opt_WarnImplicitLift + TcRnUnusedPatternBinds{} + -> WarningWithFlag Opt_WarnUnusedPatternBinds + TcRnDodgyImports{} + -> WarningWithFlag Opt_WarnDodgyImports + TcRnDodgyExports{} + -> WarningWithFlag Opt_WarnDodgyExports + TcRnMissingImportList{} + -> WarningWithFlag Opt_WarnMissingImportList + TcRnUnsafeDueToPlugin{} + -> WarningWithoutFlag + TcRnModMissingRealSrcSpan{} + -> ErrorWithoutFlag + TcRnIdNotExportedFromModuleSig{} + -> ErrorWithoutFlag + TcRnIdNotExportedFromLocalSig{} + -> ErrorWithoutFlag + TcRnShadowedName{} + -> WarningWithFlag Opt_WarnNameShadowing + TcRnInvalidWarningCategory{} + -> ErrorWithoutFlag + TcRnDuplicateWarningDecls{} + -> ErrorWithoutFlag + TcRnSimplifierTooManyIterations{} + -> ErrorWithoutFlag + TcRnIllegalPatSynDecl{} + -> ErrorWithoutFlag + TcRnLinearPatSyn{} + -> ErrorWithoutFlag + TcRnEmptyRecordUpdate + -> ErrorWithoutFlag + TcRnIllegalFieldPunning{} + -> ErrorWithoutFlag + TcRnIllegalWildcardsInRecord{} + -> ErrorWithoutFlag + TcRnIllegalWildcardInType{} + -> ErrorWithoutFlag + TcRnIllegalNamedWildcardInTypeArgument{} + -> ErrorWithoutFlag + TcRnIllegalImplicitTyVarInTypeArgument{} + -> ErrorWithoutFlag + TcRnIllegalPunnedVarOccInTypeArgument{} + -> ErrorWithoutFlag + TcRnDuplicateFieldName{} + -> ErrorWithoutFlag + TcRnIllegalViewPattern{} + -> ErrorWithoutFlag + TcRnCharLiteralOutOfRange{} + -> ErrorWithoutFlag + TcRnIllegalWildcardsInConstructor{} + -> ErrorWithoutFlag + TcRnIgnoringAnnotations{} + -> WarningWithoutFlag + TcRnAnnotationInSafeHaskell + -> ErrorWithoutFlag + TcRnInvalidTypeApplication{} + -> ErrorWithoutFlag + TcRnTagToEnumMissingValArg + -> ErrorWithoutFlag + TcRnTagToEnumUnspecifiedResTy{} + -> ErrorWithoutFlag + TcRnTagToEnumResTyNotAnEnum{} + -> ErrorWithoutFlag + TcRnTagToEnumResTyTypeData{} + -> ErrorWithoutFlag + TcRnArrowIfThenElsePredDependsOnResultTy + -> ErrorWithoutFlag + TcRnIllegalHsBootOrSigDecl {} + -> ErrorWithoutFlag + TcRnBootMismatch {} + -> ErrorWithoutFlag + TcRnRecursivePatternSynonym{} + -> ErrorWithoutFlag + TcRnPartialTypeSigTyVarMismatch{} + -> ErrorWithoutFlag + TcRnPartialTypeSigBadQuantifier{} + -> ErrorWithoutFlag + TcRnMissingSignature what exported + -> WarningWithFlags $ missingSignatureWarningFlags what exported + TcRnPolymorphicBinderMissingSig{} + -> WarningWithFlag Opt_WarnMissingLocalSignatures + TcRnOverloadedSig{} + -> ErrorWithoutFlag + TcRnTupleConstraintInst{} + -> ErrorWithoutFlag + TcRnUserTypeError{} + -> ErrorWithoutFlag + TcRnConstraintInKind{} + -> ErrorWithoutFlag + TcRnUnboxedTupleOrSumTypeFuncArg{} + -> ErrorWithoutFlag + TcRnLinearFuncInKind{} + -> ErrorWithoutFlag + TcRnForAllEscapeError{} + -> ErrorWithoutFlag + TcRnSimplifiableConstraint{} + -> WarningWithFlag Opt_WarnSimplifiableClassConstraints + TcRnArityMismatch{} + -> ErrorWithoutFlag + TcRnIllegalInstance rea + -> illegalInstanceReason rea + TcRnVDQInTermType{} + -> ErrorWithoutFlag + TcRnBadQuantPredHead{} + -> ErrorWithoutFlag + TcRnIllegalTupleConstraint{} + -> ErrorWithoutFlag + TcRnNonTypeVarArgInConstraint{} + -> ErrorWithoutFlag + TcRnIllegalImplicitParam{} + -> ErrorWithoutFlag + TcRnIllegalConstraintSynonymOfKind{} + -> ErrorWithoutFlag + TcRnOversaturatedVisibleKindArg{} + -> ErrorWithoutFlag + TcRnForAllRankErr{} + -> ErrorWithoutFlag + TcRnMonomorphicBindings{} + -> WarningWithFlag Opt_WarnMonomorphism + TcRnOrphanInstance{} + -> WarningWithFlag Opt_WarnOrphans + TcRnFunDepConflict{} + -> ErrorWithoutFlag + TcRnDupInstanceDecls{} + -> ErrorWithoutFlag + TcRnConflictingFamInstDecls{} + -> ErrorWithoutFlag + TcRnFamInstNotInjective{} + -> ErrorWithoutFlag + TcRnBangOnUnliftedType{} + -> WarningWithFlag Opt_WarnRedundantStrictnessFlags + TcRnLazyBangOnUnliftedType{} + -> WarningWithFlag Opt_WarnRedundantStrictnessFlags + TcRnMultipleDefaultDeclarations{} + -> ErrorWithoutFlag + TcRnBadDefaultType{} + -> ErrorWithoutFlag + TcRnPatSynBundledWithNonDataCon{} + -> ErrorWithoutFlag + TcRnPatSynBundledWithWrongType{} + -> ErrorWithoutFlag + TcRnDupeModuleExport{} + -> WarningWithFlag Opt_WarnDuplicateExports + TcRnExportedModNotImported{} + -> ErrorWithoutFlag + TcRnNullExportedModule{} + -> WarningWithFlag Opt_WarnDodgyExports + TcRnMissingExportList{} + -> WarningWithFlag Opt_WarnMissingExportList + TcRnExportHiddenComponents{} + -> ErrorWithoutFlag + TcRnExportHiddenDefault{} + -> ErrorWithoutFlag + TcRnDuplicateExport{} + -> WarningWithFlag Opt_WarnDuplicateExports + TcRnDuplicateNamedDefaultExport{} + -> WarningWithFlag Opt_WarnDuplicateExports + TcRnExportedParentChildMismatch{} + -> ErrorWithoutFlag + TcRnConflictingExports{} + -> ErrorWithoutFlag + TcRnDuplicateFieldExport {} + -> ErrorWithoutFlag + TcRnAmbiguousFieldInUpdate {} + -> ErrorWithoutFlag + TcRnAmbiguousRecordUpdate{} + -> WarningWithFlag Opt_WarnAmbiguousFields + TcRnMissingFields{} + -> WarningWithFlag Opt_WarnMissingFields + TcRnFieldUpdateInvalidType{} + -> ErrorWithoutFlag + TcRnMissingStrictFields{} + -> ErrorWithoutFlag + TcRnBadRecordUpdate{} + -> ErrorWithoutFlag + TcRnIllegalStaticExpression {} + -> ErrorWithoutFlag + TcRnStaticFormNotClosed{} + -> ErrorWithoutFlag + TcRnUselessTypeable + -> WarningWithFlag Opt_WarnDerivingTypeable + TcRnDerivingDefaults{} + -> WarningWithFlag Opt_WarnDerivingDefaults + TcRnNonUnaryTypeclassConstraint{} + -> ErrorWithoutFlag + TcRnPartialTypeSignatures{} + -> WarningWithFlag Opt_WarnPartialTypeSignatures + TcRnCannotDeriveInstance _ _ _ _ rea + -> case rea of + DerivErrNotWellKinded{} -> ErrorWithoutFlag + DerivErrSafeHaskellGenericInst -> ErrorWithoutFlag + DerivErrDerivingViaWrongKind{} -> ErrorWithoutFlag + DerivErrNoEtaReduce{} -> ErrorWithoutFlag + DerivErrBootFileFound -> ErrorWithoutFlag + DerivErrDataConsNotAllInScope{} -> ErrorWithoutFlag + DerivErrGNDUsedOnData -> ErrorWithoutFlag + DerivErrNullaryClasses -> ErrorWithoutFlag + DerivErrLastArgMustBeApp -> ErrorWithoutFlag + DerivErrNoFamilyInstance{} -> ErrorWithoutFlag + DerivErrNotStockDeriveable{} -> ErrorWithoutFlag + DerivErrHasAssociatedDatatypes{} -> ErrorWithoutFlag + DerivErrNewtypeNonDeriveableClass -> ErrorWithoutFlag + DerivErrCannotEtaReduceEnough{} -> ErrorWithoutFlag + DerivErrOnlyAnyClassDeriveable{} -> ErrorWithoutFlag + DerivErrNotDeriveable{} -> ErrorWithoutFlag + DerivErrNotAClass{} -> ErrorWithoutFlag + DerivErrNoConstructors{} -> ErrorWithoutFlag + DerivErrLangExtRequired{} -> ErrorWithoutFlag + DerivErrDunnoHowToDeriveForType{} -> ErrorWithoutFlag + DerivErrMustBeEnumType{} -> ErrorWithoutFlag + DerivErrMustHaveExactlyOneConstructor{} -> ErrorWithoutFlag + DerivErrMustHaveSomeParameters{} -> ErrorWithoutFlag + DerivErrMustNotHaveClassContext{} -> ErrorWithoutFlag + DerivErrBadConstructor{} -> ErrorWithoutFlag + DerivErrGenerics{} -> ErrorWithoutFlag + DerivErrEnumOrProduct{} -> ErrorWithoutFlag + TcRnLookupInstance _ _ _ + -> ErrorWithoutFlag + TcRnLazyGADTPattern + -> ErrorWithoutFlag + TcRnArrowProcGADTPattern + -> ErrorWithoutFlag + TcRnTypeEqualityOutOfScope + -> WarningWithFlag Opt_WarnTypeEqualityOutOfScope + TcRnTypeEqualityRequiresOperators + -> WarningWithFlag Opt_WarnTypeEqualityRequiresOperators + TcRnIllegalTypeOperator {} + -> ErrorWithoutFlag + TcRnIllegalTypeOperatorDecl {} + -> ErrorWithoutFlag + TcRnGADTMonoLocalBinds {} + -> WarningWithFlag Opt_WarnGADTMonoLocalBinds + TcRnIncorrectNameSpace {} + -> ErrorWithoutFlag + TcRnNotInScope {} + -> ErrorWithoutFlag + TcRnTermNameInType {} + -> ErrorWithoutFlag + TcRnUntickedPromotedThing {} + -> WarningWithFlag Opt_WarnUntickedPromotedConstructors + TcRnIllegalBuiltinSyntax {} + -> ErrorWithoutFlag + TcRnWarnDefaulting {} + -> WarningWithFlag Opt_WarnTypeDefaults + TcRnWarnClashingDefaultImports {} + -> WarningWithFlag Opt_WarnTypeDefaults + TcRnForeignImportPrimExtNotSet{} + -> ErrorWithoutFlag + TcRnForeignImportPrimSafeAnn{} + -> ErrorWithoutFlag + TcRnForeignFunctionImportAsValue{} + -> ErrorWithoutFlag + TcRnFunPtrImportWithoutAmpersand{} + -> WarningWithFlag Opt_WarnDodgyForeignImports + TcRnIllegalForeignDeclBackend{} + -> ErrorWithoutFlag + TcRnUnsupportedCallConv _ unsupportedCC + -> case unsupportedCC of + StdCallConvUnsupported -> WarningWithFlag Opt_WarnUnsupportedCallingConventions + _ -> ErrorWithoutFlag + TcRnIllegalForeignType{} + -> ErrorWithoutFlag + TcRnInvalidCIdentifier{} + -> ErrorWithoutFlag + TcRnExpectedValueId{} + -> ErrorWithoutFlag + TcRnRecSelectorEscapedTyVar{} + -> ErrorWithoutFlag + TcRnPatSynNotBidirectional{} + -> ErrorWithoutFlag + TcRnIllegalDerivingItem{} + -> ErrorWithoutFlag + TcRnIllegalDefaultClass{} + -> ErrorWithoutFlag + TcRnIllegalNamedDefault{} + -> ErrorWithoutFlag + TcRnUnexpectedAnnotation{} + -> ErrorWithoutFlag + TcRnIllegalRecordSyntax{} + -> ErrorWithoutFlag + TcRnInvalidVisibleKindArgument{} + -> ErrorWithoutFlag + TcRnTooManyBinders{} + -> ErrorWithoutFlag + TcRnDifferentNamesForTyVar{} + -> ErrorWithoutFlag + TcRnDisconnectedTyVar{} + -> ErrorWithoutFlag + TcRnInvalidReturnKind{} + -> ErrorWithoutFlag + TcRnClassKindNotConstraint{} + -> ErrorWithoutFlag + TcRnUnpromotableThing{} + -> ErrorWithoutFlag + TcRnIllegalTermLevelUse{} + -> ErrorWithoutFlag + TcRnMatchesHaveDiffNumArgs{} + -> ErrorWithoutFlag + TcRnCannotBindScopedTyVarInPatSig{} + -> ErrorWithoutFlag + TcRnCannotBindTyVarsInPatBind{} + -> ErrorWithoutFlag + TcRnMultipleInlinePragmas{} + -> WarningWithoutFlag + TcRnUnexpectedPragmas{} + -> WarningWithoutFlag + TcRnNonOverloadedSpecialisePragma{} + -> WarningWithoutFlag + TcRnSpecialiseNotVisible{} + -> WarningWithoutFlag + TcRnPragmaWarning{pragma_warning_msg} + -> WarningWithCategory (warningTxtCategory pragma_warning_msg) + TcRnDifferentExportWarnings _ _ + -> ErrorWithoutFlag + TcRnIncompleteExportWarnings _ _ + -> WarningWithFlag Opt_WarnIncompleteExportWarnings + TcRnIllegalHsigDefaultMethods{} + -> ErrorWithoutFlag + TcRnHsigFixityMismatch{} + -> ErrorWithoutFlag + TcRnHsigShapeMismatch{} + -> ErrorWithoutFlag + TcRnHsigMissingModuleExport{} + -> ErrorWithoutFlag + TcRnBadGenericMethod{} + -> ErrorWithoutFlag + TcRnWarningMinimalDefIncomplete{} + -> WarningWithoutFlag + TcRnDefaultMethodForPragmaLacksBinding{} + -> ErrorWithoutFlag + TcRnIgnoreSpecialisePragmaOnDefMethod{} + -> WarningWithoutFlag + TcRnBadMethodErr{} + -> ErrorWithoutFlag + TcRnIllegalTypeData + -> ErrorWithoutFlag + TcRnIllegalQuasiQuotes{} + -> ErrorWithoutFlag + TcRnTHError err + -> thErrorReason err + TcRnTypeDataForbids{} + -> ErrorWithoutFlag + TcRnIllegalNewtype{} + -> ErrorWithoutFlag + TcRnOrPatBindsVariables{} + -> ErrorWithoutFlag + TcRnUnsatisfiedMinimalDef{} + -> WarningWithFlag (Opt_WarnMissingMethods) + TcRnMisplacedInstSig{} + -> ErrorWithoutFlag + TcRnNoRebindableSyntaxRecordDot{} + -> ErrorWithoutFlag + TcRnNoFieldPunsRecordDot{} + -> ErrorWithoutFlag + TcRnListComprehensionDuplicateBinding{} + -> ErrorWithoutFlag + TcRnEmptyStmtsGroup{} + -> ErrorWithoutFlag + TcRnLastStmtNotExpr{} + -> ErrorWithoutFlag + TcRnUnexpectedStatementInContext{} + -> ErrorWithoutFlag + TcRnSectionWithoutParentheses{} + -> ErrorWithoutFlag + TcRnIllegalImplicitParameterBindings{} + -> ErrorWithoutFlag + TcRnIllegalTupleSection{} + -> ErrorWithoutFlag + TcRnCapturedTermName{} + -> WarningWithFlag Opt_WarnTermVariableCapture + TcRnBindingOfExistingName{} + -> ErrorWithoutFlag + TcRnMultipleFixityDecls{} + -> ErrorWithoutFlag + TcRnIllegalPatternSynonymDecl{} + -> ErrorWithoutFlag + TcRnIllegalClassBinding{} + -> ErrorWithoutFlag + TcRnOrphanCompletePragma{} + -> ErrorWithoutFlag + TcRnSpecSigShape{} + -> ErrorWithoutFlag + TcRnEmptyCase{} + -> ErrorWithoutFlag + TcRnNonStdGuards{} + -> WarningWithoutFlag + TcRnDuplicateSigDecl{} + -> ErrorWithoutFlag + TcRnMisplacedSigDecl{} + -> ErrorWithoutFlag + TcRnUnexpectedDefaultSig{} + -> ErrorWithoutFlag + TcRnDuplicateMinimalSig{} + -> ErrorWithoutFlag + TcRnUnexpectedStandaloneDerivingDecl{} + -> ErrorWithoutFlag + TcRnUnusedVariableInRuleDecl{} + -> ErrorWithoutFlag + TcRnUnexpectedStandaloneKindSig{} + -> ErrorWithoutFlag + TcRnIllegalRuleLhs{} + -> ErrorWithoutFlag + TcRnRuleLhsEqualities{} + -> WarningWithFlag Opt_WarnRuleLhsEqualities + TcRnDuplicateRoleAnnot{} + -> ErrorWithoutFlag + TcRnDuplicateKindSig{} + -> ErrorWithoutFlag + TcRnIllegalDerivStrategy{} + -> ErrorWithoutFlag + TcRnIllegalMultipleDerivClauses{} + -> ErrorWithoutFlag + TcRnNoDerivStratSpecified{} + -> WarningWithFlag Opt_WarnMissingDerivingStrategies + TcRnStupidThetaInGadt{} + -> ErrorWithoutFlag + TcRnShadowedTyVarNameInFamResult{} + -> ErrorWithoutFlag + TcRnIncorrectTyVarOnLhsOfInjCond{} + -> ErrorWithoutFlag + TcRnUnknownTyVarsOnRhsOfInjCond{} + -> ErrorWithoutFlag + TcRnBadlyLevelled _ _ _ _ reason + -> reason + TcRnBadlyLevelledType{} + -> WarningWithFlag Opt_WarnBadlyLevelledTypes + TcRnTyThingUsedWrong{} + -> ErrorWithoutFlag + TcRnCannotDefaultKindVar{} + -> ErrorWithoutFlag + TcRnUninferrableTyVar{} + -> ErrorWithoutFlag + TcRnSkolemEscape{} + -> ErrorWithoutFlag + TcRnPatSynEscapedCoercion{} + -> ErrorWithoutFlag + TcRnPatSynExistentialInResult{} + -> ErrorWithoutFlag + TcRnPatSynArityMismatch{} + -> ErrorWithoutFlag + TcRnPatSynInvalidRhs{} + -> ErrorWithoutFlag + TcRnTyFamDepsDisabled{} + -> ErrorWithoutFlag + TcRnAbstractClosedTyFamDecl{} + -> ErrorWithoutFlag + TcRnPartialFieldSelector{} + -> WarningWithFlag Opt_WarnPartialFields + TcRnHasFieldResolvedIncomplete{} + -> WarningWithFlag Opt_WarnIncompleteRecordSelectors + TcRnBadFieldAnnotation _ _ LazyFieldsDisabled + -> ErrorWithoutFlag + TcRnBadFieldAnnotation _ _ UnusableUnpackPragma + -> WarningWithFlag Opt_WarnUnusableUnpackPragmas + TcRnBadFieldAnnotation{} + -> WarningWithoutFlag + TcRnSuperclassCycle{} + -> ErrorWithoutFlag + TcRnDefaultSigMismatch{} + -> ErrorWithoutFlag + TcRnTyFamsDisabled{} + -> ErrorWithoutFlag + TcRnBadTyConTelescope {} + -> ErrorWithoutFlag + TcRnTyFamResultDisabled{} + -> ErrorWithoutFlag + TcRnRoleValidationFailed{} + -> ErrorWithoutFlag + TcRnCommonFieldResultTypeMismatch{} + -> ErrorWithoutFlag + TcRnCommonFieldTypeMismatch{} + -> ErrorWithoutFlag + TcRnClassExtensionDisabled{} + -> ErrorWithoutFlag + TcRnDataConParentTypeMismatch{} + -> ErrorWithoutFlag + TcRnGADTsDisabled{} + -> ErrorWithoutFlag + TcRnExistentialQuantificationDisabled{} + -> ErrorWithoutFlag + TcRnGADTDataContext{} + -> ErrorWithoutFlag + TcRnMultipleConForNewtype{} + -> ErrorWithoutFlag + TcRnKindSignaturesDisabled{} + -> ErrorWithoutFlag + TcRnEmptyDataDeclsDisabled{} + -> ErrorWithoutFlag + TcRnRoleMismatch{} + -> ErrorWithoutFlag + TcRnRoleCountMismatch{} + -> ErrorWithoutFlag + TcRnIllegalRoleAnnotation{} + -> ErrorWithoutFlag + TcRnRoleAnnotationsDisabled{} + -> ErrorWithoutFlag + TcRnIncoherentRoles{} + -> ErrorWithoutFlag + TcRnUnexpectedKindVar{} + -> ErrorWithoutFlag + TcRnNegativeNumTypeLiteral{} + -> ErrorWithoutFlag + TcRnIllegalKind{} + -> ErrorWithoutFlag + TcRnPrecedenceParsingError{} + -> ErrorWithoutFlag + TcRnSectionPrecedenceError{} + -> ErrorWithoutFlag + TcRnUnexpectedPatSigType{} + -> ErrorWithoutFlag + TcRnIllegalKindSignature{} + -> ErrorWithoutFlag + TcRnUnusedQuantifiedTypeVar{} + -> WarningWithFlag Opt_WarnUnusedForalls + TcRnDataKindsError{} + -> ErrorWithoutFlag + TcRnTypeSynonymCycle{} + -> ErrorWithoutFlag + TcRnZonkerMessage msg + -> zonkerMessageReason msg + TcRnInterfaceError err + -> interfaceErrorReason err + TcRnSelfImport{} + -> ErrorWithoutFlag + TcRnNoExplicitImportList{} + -> WarningWithFlag Opt_WarnMissingImportList + TcRnSafeImportsDisabled{} + -> ErrorWithoutFlag + TcRnDeprecatedModule _ txt + -> WarningWithCategory (warningTxtCategory txt) + TcRnRedundantSourceImport{} + -> WarningWithoutFlag + TcRnImportLookup{} + -> ErrorWithoutFlag + TcRnUnusedImport{} + -> WarningWithFlag Opt_WarnUnusedImports + TcRnDuplicateDecls{} + -> ErrorWithoutFlag + TcRnPackageImportsDisabled + -> ErrorWithoutFlag + TcRnIllegalDataCon{} + -> ErrorWithoutFlag + TcRnNestedForallsContexts{} + -> ErrorWithoutFlag + TcRnRedundantRecordWildcard + -> WarningWithFlag Opt_WarnRedundantRecordWildcards + TcRnUnusedRecordWildcard{} + -> WarningWithFlag Opt_WarnUnusedRecordWildcards + TcRnUnusedName _ prov + -> WarningWithFlag $ case prov of + UnusedNameTopDecl -> Opt_WarnUnusedTopBinds + UnusedNameImported _ -> Opt_WarnUnusedTopBinds + UnusedNameTypePattern -> Opt_WarnUnusedTypePatterns + UnusedNameMatch -> Opt_WarnUnusedMatches + UnusedNameLocalBind -> Opt_WarnUnusedLocalBinds + TcRnQualifiedBinder{} + -> ErrorWithoutFlag + TcRnTypeApplicationsDisabled{} + -> ErrorWithoutFlag + TcRnInvalidRecordField{} + -> ErrorWithoutFlag + TcRnTupleTooLarge{} + -> ErrorWithoutFlag + TcRnCTupleTooLarge{} + -> ErrorWithoutFlag + TcRnIllegalInferredTyVars{} + -> ErrorWithoutFlag + TcRnAmbiguousName{} + -> ErrorWithoutFlag + TcRnBindingNameConflict{} + -> ErrorWithoutFlag + TcRnNonCanonicalDefinition (NonCanonicalMonoid _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances + TcRnNonCanonicalDefinition (NonCanonicalMonad _) _ + -> WarningWithFlag Opt_WarnNonCanonicalMonadInstances + TcRnDefaultedExceptionContext{} + -> WarningWithFlag Opt_WarnDefaultedExceptionContext + TcRnImplicitImportOfPrelude {} + -> WarningWithFlag Opt_WarnImplicitPrelude + TcRnMissingMain {} + -> ErrorWithoutFlag + TcRnGhciUnliftedBind {} + -> ErrorWithoutFlag + TcRnGhciMonadLookupFail {} + -> ErrorWithoutFlag + TcRnMissingRoleAnnotation{} + -> WarningWithFlag Opt_WarnMissingRoleAnnotations + TcRnIllegalInvisTyVarBndr{} + -> ErrorWithoutFlag + TcRnIllegalWildcardTyVarBndr{} + -> ErrorWithoutFlag + TcRnInvalidInvisTyVarBndr{} + -> ErrorWithoutFlag + TcRnInvisBndrWithoutSig{} + -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification + TcRnPatersonCondFailure{} + -> ErrorWithoutFlag + TcRnIllformedTypePattern{} + -> ErrorWithoutFlag + TcRnIllegalTypePattern{} + -> ErrorWithoutFlag + TcRnIllformedTypeArgument{} + -> ErrorWithoutFlag + TcRnIllegalTypeExpr{} + -> ErrorWithoutFlag + TcRnInvalidDefaultedTyVar{} + -> ErrorWithoutFlag + TcRnNamespacedWarningPragmaWithoutFlag{} + -> ErrorWithoutFlag + TcRnIllegalInvisibleTypePattern{} + -> ErrorWithoutFlag + TcRnNamespacedFixitySigWithoutFlag{} + -> ErrorWithoutFlag + TcRnOutOfArityTyVar{} + -> ErrorWithoutFlag + TcRnUnexpectedTypeSyntaxInTerms{} + -> ErrorWithoutFlag + + diagnosticHints = \case + TcRnUnknownMessage m + -> diagnosticHints m + TcRnMessageWithInfo _ msg_with_info + -> case msg_with_info of + TcRnMessageDetailed info m -> + errInfoHints info ++ diagnosticHints m + TcRnWithHsDocContext _ msg + -> diagnosticHints msg + TcRnSolverReport (SolverReportWithCtxt ctxt msg) _ + -> tcSolverReportMsgHints ctxt msg + TcRnSolverDepthError {} + -> [SuggestIncreaseReductionDepth] + TcRnRedundantConstraints{} + -> noHints + TcRnInaccessibleCode{} + -> noHints + TcRnInaccessibleCoAxBranch{} + -> noHints + TcRnTypeDoesNotHaveFixedRuntimeRep{} + -> noHints + TcRnImplicitLift{} + -> noHints + TcRnUnusedPatternBinds{} + -> noHints + TcRnDodgyImports{} + -> noHints + TcRnDodgyExports{} + -> noHints + TcRnMissingImportList{} + -> noHints + TcRnUnsafeDueToPlugin{} + -> noHints + TcRnModMissingRealSrcSpan{} + -> noHints + TcRnIdNotExportedFromModuleSig name mod + -> [SuggestAddToHSigExportList name $ Just mod] + TcRnIdNotExportedFromLocalSig name + -> [SuggestAddToHSigExportList name Nothing] + TcRnShadowedName{} + -> noHints + TcRnInvalidWarningCategory{} + -> noHints + TcRnDuplicateWarningDecls{} + -> noHints + TcRnSimplifierTooManyIterations{} + -> [SuggestIncreaseSimplifierIterations] + TcRnIllegalPatSynDecl{} + -> noHints + TcRnLinearPatSyn{} + -> noHints + TcRnEmptyRecordUpdate{} + -> noHints + TcRnIllegalFieldPunning{} + -> [suggestExtension LangExt.NamedFieldPuns] + TcRnIllegalWildcardsInRecord{} + -> [suggestExtension LangExt.RecordWildCards] + TcRnIllegalWildcardInType{} + -> noHints + TcRnIllegalNamedWildcardInTypeArgument{} + -> [SuggestAnonymousWildcard] + TcRnIllegalImplicitTyVarInTypeArgument tv + -> [SuggestExplicitQuantification tv] + TcRnIllegalPunnedVarOccInTypeArgument{} + -> [] + TcRnDuplicateFieldName{} + -> noHints + TcRnIllegalViewPattern{} + -> [suggestExtension LangExt.ViewPatterns] + TcRnCharLiteralOutOfRange{} + -> noHints + TcRnIllegalWildcardsInConstructor{} + -> noHints + TcRnIgnoringAnnotations{} + -> noHints + TcRnAnnotationInSafeHaskell + -> noHints + TcRnInvalidTypeApplication{} + -> noHints + TcRnTagToEnumMissingValArg + -> noHints + TcRnTagToEnumUnspecifiedResTy{} + -> noHints + TcRnTagToEnumResTyNotAnEnum{} + -> noHints + TcRnTagToEnumResTyTypeData{} + -> noHints + TcRnArrowIfThenElsePredDependsOnResultTy + -> noHints + TcRnIllegalHsBootOrSigDecl {} + -> noHints + TcRnBootMismatch boot_or_sig err + | Hsig <- boot_or_sig + , BootMismatch _ _ (BootMismatchedTyCons _boot_tc real_tc tc_errs) <- err + , any is_synAbsData_etaReduce (NE.toList tc_errs) + -> [SuggestEtaReduceAbsDataTySyn real_tc] + | otherwise + -> noHints + where + is_synAbsData_etaReduce (SynAbstractData SynAbsDataTySynNotNullary) = True + is_synAbsData_etaReduce _ = False + TcRnRecursivePatternSynonym{} + -> noHints + TcRnPartialTypeSigTyVarMismatch{} + -> noHints + TcRnPartialTypeSigBadQuantifier{} + -> noHints + TcRnMissingSignature {} + -> noHints + TcRnPolymorphicBinderMissingSig{} + -> noHints + TcRnOverloadedSig{} + -> noHints + TcRnTupleConstraintInst{} + -> noHints + TcRnUserTypeError{} + -> noHints + TcRnConstraintInKind{} + -> noHints + TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum _ + -> [suggestExtension $ unboxedTupleOrSumExtension tuple_or_sum] + TcRnLinearFuncInKind{} + -> noHints + TcRnForAllEscapeError{} + -> noHints + TcRnVDQInTermType mb_ty + | isJust mb_ty -> [suggestExtension LangExt.RequiredTypeArguments] + | otherwise -> [] + TcRnBadQuantPredHead{} + -> noHints + TcRnIllegalTupleConstraint{} + -> [suggestExtension LangExt.ConstraintKinds] + TcRnNonTypeVarArgInConstraint{} + -> [suggestExtension LangExt.FlexibleContexts] + TcRnIllegalImplicitParam{} + -> noHints + TcRnIllegalConstraintSynonymOfKind{} + -> [suggestExtension LangExt.ConstraintKinds] + TcRnOversaturatedVisibleKindArg{} + -> noHints + TcRnForAllRankErr rank _ + -> case rank of + LimitedRank{} -> [suggestExtension LangExt.RankNTypes] + MonoTypeRankZero -> [suggestExtension LangExt.RankNTypes] + MonoTypeTyConArg -> [suggestExtension LangExt.ImpredicativeTypes] + MonoTypeSynArg -> [suggestExtension LangExt.LiberalTypeSynonyms] + MonoTypeConstraint -> [suggestExtension LangExt.QuantifiedConstraints] + _ -> noHints + TcRnSimplifiableConstraint{} + -> noHints + TcRnArityMismatch{} + -> noHints + TcRnIllegalInstance rea + -> illegalInstanceHints rea + TcRnMonomorphicBindings bindings + -> case bindings of + [] -> noHints + (x:xs) -> [SuggestAddTypeSignatures $ NamedBindings (x NE.:| xs)] + TcRnOrphanInstance clsOrFamInst + -> [SuggestFixOrphanInst { isFamilyInstance = isFam }] + where + isFam = case clsOrFamInst :: Either ClsInst FamInst of + Left _clsInst -> Nothing + Right famInst -> Just $ fi_flavor famInst + TcRnFunDepConflict{} + -> noHints + TcRnDupInstanceDecls{} + -> noHints + TcRnConflictingFamInstDecls{} + -> noHints + TcRnFamInstNotInjective rea _ _ + -> case rea of + InjErrRhsBareTyVar{} -> noHints + InjErrRhsCannotBeATypeFam -> noHints + InjErrRhsOverlap -> noHints + InjErrCannotInferFromRhs _ _ suggestUndInst + | YesSuggestUndecidableInstaces <- suggestUndInst + -> [suggestExtension LangExt.UndecidableInstances] + | otherwise + -> noHints + TcRnBangOnUnliftedType{} + -> noHints + TcRnLazyBangOnUnliftedType{} + -> noHints + TcRnMultipleDefaultDeclarations{} + -> noHints + TcRnBadDefaultType{} + -> noHints + TcRnPatSynBundledWithNonDataCon{} + -> noHints + TcRnPatSynBundledWithWrongType{} + -> noHints + TcRnDupeModuleExport{} + -> noHints + TcRnExportedModNotImported{} + -> noHints + TcRnNullExportedModule{} + -> noHints + TcRnMissingExportList{} + -> noHints + TcRnExportHiddenComponents{} + -> noHints + TcRnExportHiddenDefault{} + -> noHints + TcRnDuplicateExport{} + -> noHints + TcRnDuplicateNamedDefaultExport{} + -> noHints + TcRnExportedParentChildMismatch{} + -> noHints + TcRnConflictingExports{} + -> noHints + TcRnDuplicateFieldExport {} + -> [suggestExtension LangExt.DuplicateRecordFields] + TcRnAmbiguousFieldInUpdate {} + -> [suggestExtension LangExt.DisambiguateRecordFields] + TcRnAmbiguousRecordUpdate{} + -> noHints + TcRnMissingFields{} + -> noHints + TcRnFieldUpdateInvalidType{} + -> noHints + TcRnMissingStrictFields{} + -> noHints + TcRnBadRecordUpdate{} + -> noHints + TcRnIllegalStaticExpression {} + -> [suggestExtension LangExt.StaticPointers] + TcRnStaticFormNotClosed{} + -> noHints + TcRnUselessTypeable + -> noHints + TcRnDerivingDefaults{} + -> [useDerivingStrategies] + TcRnNonUnaryTypeclassConstraint{} + -> noHints + TcRnPartialTypeSignatures suggestParSig _ + -> case suggestParSig of + YesSuggestPartialTypeSignatures + -> let info = text "to use the inferred type" + in [suggestExtensionWithInfo info LangExt.PartialTypeSignatures] + NoSuggestPartialTypeSignatures + -> noHints + TcRnCannotDeriveInstance cls _ _ newtype_deriving rea + -> deriveInstanceErrReasonHints cls newtype_deriving rea + TcRnLookupInstance _ _ _ + -> noHints + TcRnLazyGADTPattern + -> noHints + TcRnArrowProcGADTPattern + -> noHints + TcRnTypeEqualityOutOfScope + -> noHints + TcRnTypeEqualityRequiresOperators + -> [suggestExtension LangExt.TypeOperators] + TcRnIllegalTypeOperator {} + -> [suggestExtension LangExt.TypeOperators] + TcRnIllegalTypeOperatorDecl {} + -> [suggestExtension LangExt.TypeOperators] + TcRnGADTMonoLocalBinds {} + -> [suggestAnyExtension [LangExt.GADTs, LangExt.TypeFamilies]] + TcRnIncorrectNameSpace nm is_th_use + | is_th_use + -> [SuggestAppropriateTHTick (nameNameSpace nm)] + | otherwise + -> noHints + TcRnNotInScope err _nm + -> scopeErrorHints err + TcRnTermNameInType {} + -> noHints + TcRnUntickedPromotedThing thing + -> [SuggestAddTick thing] + TcRnIllegalBuiltinSyntax {} + -> noHints + TcRnWarnDefaulting {} + -> noHints + TcRnWarnClashingDefaultImports cls local imports + -> suggestDefaultDeclaration cls (fold local) (cd_types <$> NE.toList imports) + TcRnForeignImportPrimExtNotSet{} + -> [suggestExtension LangExt.GHCForeignImportPrim] + TcRnForeignImportPrimSafeAnn{} + -> noHints + TcRnForeignFunctionImportAsValue{} + -> noHints + TcRnFunPtrImportWithoutAmpersand{} + -> noHints + TcRnIllegalForeignDeclBackend{} + -> noHints + TcRnUnsupportedCallConv{} + -> noHints + TcRnIllegalForeignType _ reason + -> case reason of + TypeCannotBeMarshaled _ why + | NewtypeDataConNotInScope tc _ <- why + -> let tc_nm = tyConName tc + dc = dataConName $ head $ tyConDataCons tc + in [ ImportSuggestion (occName dc) + $ ImportDataCon Nothing False False (nameOccName tc_nm) ] + | UnliftedFFITypesNeeded <- why + -> [suggestExtension LangExt.UnliftedFFITypes] + _ -> noHints + TcRnInvalidCIdentifier{} + -> noHints + TcRnExpectedValueId{} + -> noHints + TcRnRecSelectorEscapedTyVar{} + -> [SuggestPatternMatchingSyntax] + TcRnPatSynNotBidirectional{} + -> noHints + TcRnIllegalDerivingItem{} + -> noHints + TcRnIllegalDefaultClass{} + -> noHints + TcRnIllegalNamedDefault{} + -> [suggestExtension LangExt.NamedDefaults] + TcRnUnexpectedAnnotation{} + -> noHints + TcRnIllegalRecordSyntax{} + -> noHints + TcRnInvalidVisibleKindArgument{} + -> noHints + TcRnTooManyBinders{} + -> noHints + TcRnDifferentNamesForTyVar{} + -> noHints + TcRnDisconnectedTyVar n + -> [SuggestBindTyVarExplicitly n] + TcRnInvalidReturnKind _ _ _ mb_suggest_unlifted_ext + -> case mb_suggest_unlifted_ext of + Nothing -> noHints + Just SuggestUnliftedNewtypes -> [suggestExtension LangExt.UnliftedNewtypes] + Just SuggestUnliftedDatatypes -> [suggestExtension LangExt.UnliftedDatatypes] + TcRnClassKindNotConstraint{} + -> noHints + TcRnUnpromotableThing{} + -> noHints + TcRnIllegalTermLevelUse {} + -> noHints + TcRnMatchesHaveDiffNumArgs{} + -> noHints + TcRnCannotBindScopedTyVarInPatSig{} + -> noHints + TcRnCannotBindTyVarsInPatBind{} + -> noHints + TcRnMultipleInlinePragmas{} + -> noHints + TcRnUnexpectedPragmas{} + -> noHints + TcRnNonOverloadedSpecialisePragma{} + -> noHints + TcRnSpecialiseNotVisible name + -> [SuggestSpecialiseVisibilityHints name] + TcRnPragmaWarning{} + -> noHints + TcRnDifferentExportWarnings _ _ + -> noHints + TcRnIncompleteExportWarnings _ _ + -> noHints + TcRnIllegalHsigDefaultMethods{} + -> noHints + TcRnIllegalQuasiQuotes{} + -> [suggestExtension LangExt.QuasiQuotes] + TcRnTHError err + -> thErrorHints err + TcRnHsigFixityMismatch{} + -> noHints + TcRnHsigShapeMismatch{} + -> noHints + TcRnHsigMissingModuleExport{} + -> noHints + TcRnBadGenericMethod{} + -> noHints + TcRnWarningMinimalDefIncomplete{} + -> noHints + TcRnDefaultMethodForPragmaLacksBinding{} + -> noHints + TcRnIgnoreSpecialisePragmaOnDefMethod{} + -> noHints + TcRnBadMethodErr{} + -> noHints + TcRnIllegalTypeData + -> [suggestExtension LangExt.TypeData] + TcRnTypeDataForbids{} + -> noHints + TcRnIllegalNewtype{} + -> noHints + TcRnOrPatBindsVariables{} + -> noHints + TcRnUnsatisfiedMinimalDef{} + -> noHints + TcRnMisplacedInstSig{} + -> [suggestExtension LangExt.InstanceSigs] + TcRnNoRebindableSyntaxRecordDot{} + -> noHints + TcRnNoFieldPunsRecordDot{} + -> noHints + TcRnListComprehensionDuplicateBinding{} + -> noHints + TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{} + -> [suggestExtension LangExt.NondecreasingIndentation] + TcRnEmptyStmtsGroup{} + -> noHints + TcRnLastStmtNotExpr{} + -> noHints + TcRnUnexpectedStatementInContext _ _ mExt + | Nothing <- mExt -> noHints + | Just ext <- mExt -> [suggestExtension ext] + TcRnSectionWithoutParentheses{} + -> noHints + TcRnIllegalImplicitParameterBindings{} + -> noHints + TcRnIllegalTupleSection{} + -> [suggestExtension LangExt.TupleSections] + TcRnCapturedTermName{} + -> [SuggestRenameTypeVariable] + TcRnBindingOfExistingName{} + -> noHints + TcRnMultipleFixityDecls{} + -> noHints + TcRnIllegalPatternSynonymDecl{} + -> [suggestExtension LangExt.PatternSynonyms] + TcRnIllegalClassBinding{} + -> noHints + TcRnOrphanCompletePragma{} + -> noHints + TcRnEmptyCase _ reason -> + case reason of + EmptyCaseWithoutFlag{} -> [suggestExtension LangExt.EmptyCase] + EmptyCaseDisallowedCtxt{} -> noHints + EmptyCaseForall{} -> noHints + TcRnSpecSigShape{} + -> noHints + TcRnNonStdGuards{} + -> [suggestExtension LangExt.PatternGuards] + TcRnDuplicateSigDecl{} + -> noHints + TcRnMisplacedSigDecl{} + -> noHints + TcRnUnexpectedDefaultSig{} + -> [suggestExtension LangExt.DefaultSignatures] + TcRnDuplicateMinimalSig{} + -> noHints + TcRnUnexpectedStandaloneDerivingDecl{} + -> [suggestExtension LangExt.StandaloneDeriving] + TcRnUnusedVariableInRuleDecl{} + -> noHints + TcRnUnexpectedStandaloneKindSig{} + -> [suggestExtension LangExt.StandaloneKindSignatures] + TcRnIllegalRuleLhs{} + -> noHints + TcRnRuleLhsEqualities{} + -> noHints + TcRnDuplicateRoleAnnot{} + -> noHints + TcRnDuplicateKindSig{} + -> noHints + TcRnIllegalDerivStrategy ds -> case ds of + ViaStrategy{} -> [suggestExtension LangExt.DerivingVia] + _ -> [suggestExtension LangExt.DerivingStrategies] + TcRnIllegalMultipleDerivClauses{} + -> [suggestExtension LangExt.DerivingStrategies] + TcRnNoDerivStratSpecified is_ds_enabled info -> do + let explicit_strategy_hint = case info of + TcRnNoDerivingClauseStrategySpecified assumed_derivings -> + SuggestExplicitDerivingClauseStrategies assumed_derivings + TcRnNoStandaloneDerivingStrategySpecified assumed_strategy deriv_sig -> + SuggestExplicitStandaloneDerivingStrategy assumed_strategy deriv_sig + explicit_strategy_hint : [suggestExtension LangExt.DerivingStrategies | not is_ds_enabled] + TcRnStupidThetaInGadt{} + -> noHints + TcRnShadowedTyVarNameInFamResult{} + -> noHints + TcRnIncorrectTyVarOnLhsOfInjCond{} + -> noHints + TcRnUnknownTyVarsOnRhsOfInjCond{} + -> noHints + TcRnBadlyLevelled{} + -> noHints + TcRnBadlyLevelledType{} + -> noHints + TcRnTyThingUsedWrong{} + -> noHints + TcRnCannotDefaultKindVar{} + -> noHints + TcRnUninferrableTyVar{} + -> noHints + TcRnSkolemEscape{} + -> noHints + TcRnPatSynEscapedCoercion{} + -> noHints + TcRnPatSynExistentialInResult{} + -> noHints + TcRnPatSynArityMismatch{} + -> noHints + TcRnPatSynInvalidRhs name pat args (PatSynNotInvertible _) + -> [SuggestExplicitBidiPatSyn name pat args] + TcRnPatSynInvalidRhs{} + -> noHints + TcRnTyFamDepsDisabled{} + -> [suggestExtension LangExt.TypeFamilyDependencies] + TcRnAbstractClosedTyFamDecl{} + -> noHints + TcRnPartialFieldSelector{} + -> noHints + TcRnHasFieldResolvedIncomplete{} + -> noHints + TcRnBadFieldAnnotation _ _ LazyFieldsDisabled + -> [suggestExtension LangExt.StrictData] + TcRnBadFieldAnnotation{} + -> noHints + TcRnSuperclassCycle{} + -> [suggestExtension LangExt.UndecidableSuperClasses] + TcRnDefaultSigMismatch{} + -> noHints + TcRnTyFamsDisabled{} + -> [suggestExtension LangExt.TypeFamilies] + TcRnBadTyConTelescope{} + -> noHints + TcRnTyFamResultDisabled{} + -> [suggestExtension LangExt.TypeFamilyDependencies] + TcRnRoleValidationFailed{} + -> noHints + TcRnCommonFieldResultTypeMismatch{} + -> noHints + TcRnCommonFieldTypeMismatch{} + -> noHints + TcRnClassExtensionDisabled _ MultiParamDisabled{} + -> [suggestExtension LangExt.MultiParamTypeClasses] + TcRnClassExtensionDisabled _ FunDepsDisabled{} + -> [suggestExtension LangExt.FunctionalDependencies] + TcRnClassExtensionDisabled _ ConstrainedClassMethodsDisabled{} + -> [suggestExtension LangExt.ConstrainedClassMethods] + TcRnDataConParentTypeMismatch{} + -> noHints + TcRnGADTsDisabled{} + -> [suggestExtension LangExt.GADTs] + TcRnExistentialQuantificationDisabled{} + -> [suggestAnyExtension [LangExt.ExistentialQuantification, LangExt.GADTs]] + TcRnGADTDataContext{} + -> noHints + TcRnMultipleConForNewtype{} + -> noHints + TcRnKindSignaturesDisabled{} + -> [suggestExtension LangExt.KindSignatures] + TcRnEmptyDataDeclsDisabled{} + -> [suggestExtension LangExt.EmptyDataDecls] + TcRnRoleMismatch{} + -> noHints + TcRnRoleCountMismatch{} + -> noHints + TcRnIllegalRoleAnnotation{} + -> noHints + TcRnRoleAnnotationsDisabled{} + -> [suggestExtension LangExt.RoleAnnotations] + TcRnIncoherentRoles{} + -> [suggestExtension LangExt.IncoherentInstances] + TcRnUnexpectedKindVar{} + -> [suggestExtension LangExt.PolyKinds] + TcRnNegativeNumTypeLiteral{} + -> noHints + TcRnIllegalKind _ suggest_polyKinds + -> if suggest_polyKinds + then [suggestExtension LangExt.PolyKinds] + else noHints + TcRnPrecedenceParsingError{} + -> noHints + TcRnSectionPrecedenceError{} + -> noHints + TcRnUnexpectedPatSigType{} + -> [suggestExtension LangExt.ScopedTypeVariables] + TcRnIllegalKindSignature{} + -> [suggestExtension LangExt.KindSignatures] + TcRnUnusedQuantifiedTypeVar{} + -> noHints + TcRnDataKindsError{} + -> [suggestExtension LangExt.DataKinds] + TcRnTypeSynonymCycle{} + -> noHints + TcRnZonkerMessage msg + -> zonkerMessageHints msg + TcRnInterfaceError reason + -> interfaceErrorHints reason + TcRnSelfImport{} + -> noHints + TcRnNoExplicitImportList{} + -> noHints + TcRnSafeImportsDisabled{} + -> [SuggestSafeHaskell] + TcRnDeprecatedModule{} + -> noHints + TcRnRedundantSourceImport{} + -> noHints + TcRnImportLookup (ImportLookupBad k _ is ie exts) -> + let mod_name = moduleName $ is_mod is + occ = rdrNameOcc $ ieName ie + could_change_item item_suggestion = + [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | suggest_ext] ++ + [ ImportSuggestion occ $ + CouldChangeImportItem mod_name item_suggestion ] + where + suggest_ext + | ile_explicit_namespaces exts = False -- extension already on + | otherwise = + case item_suggestion of + -- ImportItemRemove* -> False + ImportItemRemoveType{} -> False + ImportItemRemoveData{} -> False + ImportItemRemovePattern{} -> False + ImportItemRemoveSubordinateType{} -> False + ImportItemRemoveSubordinateData{} -> False + -- ImportItemAdd* -> True + ImportItemAddType{} -> True + in case k of + BadImportAvailVar -> could_change_item ImportItemRemoveType + BadImportNotExported suggs -> suggs + BadImportAvailTyCon + -- The three cases (TyOp, DataKw, PatternKw) are laid out + -- in Note [Reasons for BadImportAvailTyCon] in GHC.Tc.Errors.Types + | isSymOcc occ -> could_change_item ImportItemAddType -- Case (TyOp) + | otherwise -> -- Non-operator cases + case unLoc (ieLIEWrappedName ie) of + IEData{} -> could_change_item ImportItemRemoveData -- Case (DataKw) + IEPattern{} -> could_change_item ImportItemRemovePattern -- Case (PatternKw) + _ -> panic "diagnosticHints: unexpected BadImportAvailTyCon" + + BadImportAvailDataCon par -> + [ ImportSuggestion occ $ + ImportDataCon { ies_suggest_import_from = Just mod_name + , ies_suggest_pattern_keyword = ile_pattern_synonyms exts + && not (ile_explicit_namespaces exts) -- do not suggest 'pattern' when we can suggest 'data' + , ies_suggest_data_keyword = ile_explicit_namespaces exts + , ies_parent = par } ] + BadImportNotExportedSubordinates{} -> noHints + BadImportNonTypeSubordinates _ nontype1 -> + could_change_item (ImportItemRemoveSubordinateType (nameOccName . greName <$> nontype1)) + BadImportNonDataSubordinates _ nondata1 -> + could_change_item (ImportItemRemoveSubordinateData (nameOccName . greName <$> nondata1)) + TcRnImportLookup{} + -> noHints + TcRnUnusedImport{} + -> noHints + TcRnDuplicateDecls _ fs + -> [suggestExtension LangExt.DuplicateRecordFields | all isFieldName fs] + TcRnPackageImportsDisabled + -> [suggestExtension LangExt.PackageImports] + TcRnIllegalDataCon{} + -> noHints + TcRnNestedForallsContexts{} + -> noHints + TcRnRedundantRecordWildcard + -> [SuggestRemoveRecordWildcard] + TcRnUnusedRecordWildcard{} + -> [SuggestRemoveRecordWildcard] + TcRnUnusedName{} + -> noHints + TcRnQualifiedBinder{} + -> noHints + TcRnTypeApplicationsDisabled{} + -> [suggestExtension LangExt.TypeApplications] + TcRnInvalidRecordField{} + -> noHints + TcRnTupleTooLarge{} + -> noHints + TcRnCTupleTooLarge{} + -> noHints + TcRnIllegalInferredTyVars{} + -> noHints + TcRnAmbiguousName{} + -> noHints + TcRnBindingNameConflict{} + -> noHints + TcRnNonCanonicalDefinition reason _ + -> suggestNonCanonicalDefinition reason + TcRnDefaultedExceptionContext _ + -> noHints + TcRnImplicitImportOfPrelude {} + -> noHints + TcRnMissingMain {} + -> noHints + TcRnGhciUnliftedBind {} + -> noHints + TcRnGhciMonadLookupFail {} + -> noHints + TcRnMissingRoleAnnotation{} + -> noHints + TcRnIllegalInvisTyVarBndr{} + -> [suggestExtension LangExt.TypeAbstractions] + TcRnIllegalWildcardTyVarBndr{} + -> [suggestExtension LangExt.TypeAbstractions] + TcRnInvalidInvisTyVarBndr{} + -> noHints + TcRnInvisBndrWithoutSig name _ + -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] + TcRnPatersonCondFailure{} + -> [suggestExtension LangExt.UndecidableInstances] + TcRnIllformedTypePattern{} + -> noHints + TcRnIllegalTypePattern{} + -> noHints + TcRnIllformedTypeArgument{} + -> noHints + TcRnIllegalTypeExpr{} + -> noHints + TcRnInvalidDefaultedTyVar{} + -> noHints + TcRnNamespacedWarningPragmaWithoutFlag{} + -> [suggestExtension LangExt.ExplicitNamespaces] + TcRnIllegalInvisibleTypePattern _ reason + -> case reason of + InvisPatWithoutFlag -> [suggestExtension LangExt.TypeAbstractions] + InvisPatNoForall -> noHints + InvisPatMisplaced -> noHints + TcRnNamespacedFixitySigWithoutFlag{} + -> [suggestExtension LangExt.ExplicitNamespaces] + TcRnOutOfArityTyVar{} + -> noHints + TcRnUnexpectedTypeSyntaxInTerms syntax + -> [suggestExtension (typeSyntaxExtension syntax)] + + diagnosticCode = constructorCode @GHC + +pprTcRnBadlyLevelled :: LevelCheckReason -> Set.Set ThLevelIndex -> ThLevelIndex -> Maybe ErrorItem -> DecoratedSDoc +pprTcRnBadlyLevelled reason bind_lvls use_lvl lift_attempt = mkDecorated $ + [ fsep [ text "Level error:", pprLevelCheckReason reason + , text "is bound at" <+> pprThBindLevel bind_lvls + , text "but used at level" <+> ppr use_lvl] + ] ++ + [hang (text "Could not be resolved by implicit lifting due to the following error:") 2 + (text "No instance for:" <+> quotes (ppr (errorItemPred item))) + | Just item <- [lift_attempt] + ] ++ + [ vcat (text "Available from the imports:" : ppr_imports (gre_imp gre)) + | LevelCheckSplice _ (Just gre) <- [reason] + , not (isEmptyBag (gre_imp gre)) ] + where + ppr_imports :: Bag ImportSpec -> [SDoc] + ppr_imports = map ((bullet <+>) . ppr ) . bagToList + +note :: SDoc -> SDoc +note note = "Note" <> colon <+> note <> dot + +-- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", +-- and so on. The `and` stands for any `conjunction`, which is passed in. +commafyWith :: SDoc -> [SDoc] -> [SDoc] +commafyWith _ [] = [] +commafyWith _ [x] = [x] +commafyWith conjunction [x, y] = [x <+> conjunction <+> y] +commafyWith conjunction xs = addConjunction $ punctuate comma xs + where addConjunction [x, y] = [x, conjunction, y] + addConjunction (x : xs) = x : addConjunction xs + addConjunction _ = panic "commafyWith expected 2 or more elements" + +deriveInstanceErrReasonHints :: Class + -> UsingGeneralizedNewtypeDeriving + -> DeriveInstanceErrReason + -> [GhcHint] +deriveInstanceErrReasonHints cls newtype_deriving = \case + DerivErrNotWellKinded _ _ n_args_to_keep + | cls `hasKey` gen1ClassKey && n_args_to_keep >= 0 + -> [suggestExtension LangExt.PolyKinds] + | otherwise + -> noHints + DerivErrSafeHaskellGenericInst -> noHints + DerivErrDerivingViaWrongKind{} -> noHints + DerivErrNoEtaReduce{} -> noHints + DerivErrBootFileFound -> noHints + DerivErrDataConsNotAllInScope{} -> noHints + DerivErrGNDUsedOnData -> noHints + DerivErrNullaryClasses -> noHints + DerivErrLastArgMustBeApp -> noHints + DerivErrNoFamilyInstance{} -> noHints + DerivErrNotStockDeriveable deriveAnyClassEnabled + | deriveAnyClassEnabled == NoDeriveAnyClassEnabled + -> [suggestExtension LangExt.DeriveAnyClass] + | otherwise + -> noHints + DerivErrHasAssociatedDatatypes{} + -> noHints + DerivErrNewtypeNonDeriveableClass + | newtype_deriving == NoGeneralizedNewtypeDeriving + -> [useGND] + | otherwise + -> noHints + DerivErrCannotEtaReduceEnough{} + | newtype_deriving == NoGeneralizedNewtypeDeriving + -> [useGND] + | otherwise + -> noHints + DerivErrOnlyAnyClassDeriveable _ deriveAnyClassEnabled + | deriveAnyClassEnabled == NoDeriveAnyClassEnabled + -> [suggestExtension LangExt.DeriveAnyClass] + | otherwise + -> noHints + DerivErrNotDeriveable deriveAnyClassEnabled + | deriveAnyClassEnabled == NoDeriveAnyClassEnabled + -> [suggestExtension LangExt.DeriveAnyClass] + | otherwise + -> noHints + DerivErrNotAClass{} + -> noHints + DerivErrNoConstructors{} + -> let info = text "to enable deriving for empty data types" + in [useExtensionInOrderTo info LangExt.EmptyDataDeriving] + DerivErrLangExtRequired{} + -- This is a slightly weird corner case of GHC: we are failing + -- to derive a typeclass instance because a particular 'Extension' + -- is not enabled (and so we report in the main error), but here + -- we don't want to /repeat/ to enable the extension in the hint. + -> noHints + DerivErrDunnoHowToDeriveForType{} + -> noHints + DerivErrMustBeEnumType rep_tc + -- We want to suggest GND only if this /is/ a newtype. + | newtype_deriving == NoGeneralizedNewtypeDeriving && isNewTyCon rep_tc + -> [useGND] + | otherwise + -> noHints + DerivErrMustHaveExactlyOneConstructor{} + -> noHints + DerivErrMustHaveSomeParameters{} + -> noHints + DerivErrMustNotHaveClassContext{} + -> noHints + DerivErrBadConstructor wcard _ + -> case wcard of + Nothing -> noHints + Just YesHasWildcard -> [SuggestFillInWildcardConstraint] + Just NoHasWildcard -> [SuggestAddStandaloneDerivation] + DerivErrGenerics{} + -> noHints + DerivErrEnumOrProduct{} + -> noHints + +-------------------------------------------------------------------------------- + +-- | Pretty-print supplementary information, to add to an error report. +pprSolverReportSupplementary :: HoleFitDispConfig -> SupplementaryInfo -> SDoc +-- This function should be in "GHC.Tc.Errors.Ppr", +-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. +pprSolverReportSupplementary hfdc = \case + SupplementaryBindings binds -> pprRelevantBindings binds + SupplementaryHoleFits fits -> pprValidHoleFits hfdc fits + SupplementaryCts cts -> pprConstraintsInclude cts + SupplementaryImportErrors errs -> vcat (map ppr $ NE.toList errs) + +-- | Display a collection of valid hole fits. +pprValidHoleFits :: HoleFitDispConfig -> ValidHoleFits -> SDoc +-- This function should be in "GHC.Tc.Errors.Ppr", +-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. +pprValidHoleFits hfdc (ValidHoleFits (Fits fits discarded_fits) (Fits refs discarded_refs)) + = fits_msg $$ refs_msg + + where + fits_msg, refs_msg, fits_discard_msg, refs_discard_msg :: SDoc + fits_msg = ppUnless (null fits) $ + hang (text "Valid hole fits include") 2 $ + vcat (map (pprHoleFit hfdc) fits) + $$ ppWhen discarded_fits fits_discard_msg + refs_msg = ppUnless (null refs) $ + hang (text "Valid refinement hole fits include") 2 $ + vcat (map (pprHoleFit hfdc) refs) + $$ ppWhen discarded_refs refs_discard_msg + fits_discard_msg = + text "(Some hole fits suppressed;" <+> + text "use -fmax-valid-hole-fits=N" <+> + text "or -fno-max-valid-hole-fits)" + refs_discard_msg = + text "(Some refinement hole fits suppressed;" <+> + text "use -fmax-refinement-hole-fits=N" <+> + text "or -fno-max-refinement-hole-fits)" + +-- For pretty printing hole fits, we display the name and type of the fit, +-- with added '_' to represent any extra arguments in case of a non-zero +-- refinement level. +pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc +pprHoleFit _ (RawHoleFit sd) = sd +pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) = + hang display 2 provenance + where tyApp = sep $ zipWithEqual pprArg vars hfWrap + where pprArg b arg = case binderFlag b of + Specified -> text "@" <> pprParendType arg + -- Do not print type application for inferred + -- variables (#16456) + Inferred -> empty + Required -> pprPanic "pprHoleFit: bad Required" + (ppr b <+> ppr arg) + tyAppVars = sep $ punctuate comma $ + zipWithEqual (\v t -> ppr (binderVar v) <+> text "~" <+> pprParendType t) + vars hfWrap + + vars = unwrapTypeVars hfType + where + -- Attempts to get all the quantified type variables in a type, + -- e.g. + -- return :: forall (m :: * -> *) Monad m => (forall a . a -> m a) + -- into [m, a] + unwrapTypeVars :: Type -> [ForAllTyBinder] + unwrapTypeVars t = vars ++ case splitFunTy_maybe unforalled of + Just (_, _, _, unfunned) -> unwrapTypeVars unfunned + _ -> [] + where (vars, unforalled) = splitForAllForAllTyBinders t + holeVs = sep $ map (parens . (text "_" <+> dcolon <+>) . ppr) hfMatches + holeDisp = if sMs then holeVs + else sep $ replicate (length hfMatches) $ text "_" + occDisp = case hfCand of + GreHFCand gre -> pprPrefixOcc (greName gre) + NameHFCand name -> pprPrefixOcc name + IdHFCand id_ -> pprPrefixOcc id_ + tyDisp = ppWhen sTy $ dcolon <+> ppr hfType + has = not . null + wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars)) + $ text "with" <+> if sWrp || not sTy + then occDisp <+> tyApp + else tyAppVars + docs = case hfDoc of + Just d -> pprHsDocStrings d + _ -> empty + funcInfo = ppWhen (has hfMatches && sTy) $ + text "where" <+> occDisp <+> tyDisp + subDisp = occDisp <+> if has hfMatches then holeDisp else tyDisp + display = subDisp $$ nest 2 (funcInfo $+$ docs $+$ wrapDisp) + provenance = ppWhen sProv $ parens $ + case hfCand of + GreHFCand gre -> pprNameProvenance gre + NameHFCand name -> text "bound at" <+> ppr (getSrcLoc name) + IdHFCand id_ -> text "bound at" <+> ppr (getSrcLoc id_) + +-- | Add a "Constraints include..." message. +-- +-- See Note [Constraints include ...] +pprConstraintsInclude :: NE.NonEmpty (PredType, RealSrcSpan) -> SDoc +-- This function should be in "GHC.Tc.Errors.Ppr", +-- but we need it here because 'TcRnMessageDetails' needs an 'SDoc'. +pprConstraintsInclude cts + = hang (text "Constraints include") + 2 (vcat $ map pprConstraint $ NE.toList cts) + where + pprConstraint (constraint, loc) = + ppr constraint <+> nest 2 (parens (text "from" <+> ppr loc)) + +messageWithInfoDiagnosticMessage :: UnitState + -> ErrInfo + -> Bool + -> DecoratedSDoc + -> DecoratedSDoc +messageWithInfoDiagnosticMessage unit_state (ErrInfo {..}) show_ctxt important = + let ctxt = pprWithUnitState unit_state + $ vcat $ map pprErrCtxtMsg [ ctx | ctx <- errInfoContext, show_ctxt ] + + supp = case errInfoSupplementary of + Nothing -> empty + Just (hfdc, supp_msgs) -> + pprWithUnitState unit_state $ + vcat $ map (pprSolverReportSupplementary hfdc) supp_msgs + in mapDecoratedSDoc (pprWithUnitState unit_state) important + `unionDecoratedSDoc` + mkDecorated [ctxt, supp] + +messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc +messageWithHsDocContext opts ctxt main_msg = do + if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) + +-------------------------------------------------------------------------------- + +dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc +dodgy_msg kind tc ie + = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that" + , quotes (ppr $ greName tc) <+> text "has" <+> sep rest ] + where + rest :: [SDoc] + rest = + case greInfo tc of + IAmTyCon ClassFlavour + -> [ text "(in-scope) class methods or associated types" <> comma + , text "but it has none" ] + IAmTyCon _ + -> [ text "(in-scope) constructors or record fields" <> comma + , text "but it has none" ] + _ -> [ text "children" <> comma + , text "but it is not a type constructor or a class" ] + +dodgy_msg_insert :: GlobalRdrElt -> IE GhcRn +dodgy_msg_insert tc_gre = IEThingAll (Nothing, noAnn) ii Nothing + where + ii = noLocA (IEName noExtField $ noLocA $ greName tc_gre) + +pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc +pprTypeDoesNotHaveFixedRuntimeRep ty prov = + let what = pprFixedRuntimeRepProvenance prov + in text "The" <+> what <+> text "does not have a fixed runtime representation:" + $$ format_frr_err ty + +format_frr_err :: Type -- ^ the type which doesn't have a fixed runtime representation + -> SDoc +format_frr_err ty + = (bullet <+> ppr tidy_ty <+> dcolon <+> ppr tidy_ki) + where + (tidy_env, tidy_ty) = tidyOpenTypeX emptyTidyEnv ty + tidy_ki = tidyType tidy_env (typeKind ty) + +pprField :: (FieldLabelString, TcType) -> SDoc +pprField (f,ty) = ppr f <+> dcolon <+> ppr ty + +pprRecordFieldPart :: RecordFieldPart -> SDoc +pprRecordFieldPart = \case + RecordFieldDecl {} -> text "declaration" + RecordFieldConstructor{} -> text "construction" + RecordFieldPattern{} -> text "pattern" + RecordFieldUpdate -> text "update" + +ppr_opfix :: (OpName, Fixity) -> SDoc +ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) + where + pp_op | NegateOp <- op = text "prefix `-'" + | otherwise = quotes (ppr op) + +pprBindings :: [Name] -> SDoc +pprBindings = pprWithCommas (quotes . ppr) + + +injectivityErrorHerald :: SDoc +injectivityErrorHerald = + text "Type family equation violates the family's injectivity annotation." + +formatExportItemError :: SDoc -> String -> SDoc +formatExportItemError exportedThing reason = + hsep [ text "The export item" + , quotes exportedThing + , text reason ] + +-- | What warning flags are associated with the given missing signature? +missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag +missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported + -- We prefer "bigger" warnings first: #14794 + -- + -- See Note [Warnings controlled by multiple flags] + = Opt_WarnMissingSignatures :| + [ Opt_WarnMissingExportedSignatures | IsExported == exported ] +missingSignatureWarningFlags (MissingPatSynSig {}) exported + = Opt_WarnMissingPatternSynonymSignatures :| + [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ] +missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _ + = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ] + +useDerivingStrategies :: GhcHint +useDerivingStrategies = + useExtensionInOrderTo (text "to pick a different strategy") LangExt.DerivingStrategies + +useGND :: GhcHint +useGND = let info = text "for GHC's" <+> text "newtype-deriving extension" + in suggestExtensionWithInfo info LangExt.GeneralizedNewtypeDeriving + +cannotMakeDerivedInstanceHerald :: Class + -> [Type] + -> Maybe (DerivStrategy GhcTc) + -> UsingGeneralizedNewtypeDeriving + -> Bool -- ^ If False, only prints the why. + -> SDoc + -> SDoc +cannotMakeDerivedInstanceHerald cls cls_args mb_strat newtype_deriving pprHerald why = + if pprHerald + then sep [(hang (text "Can't make a derived instance of") + 2 (quotes (ppr pred) <+> via_mechanism) + $$ nest 2 extra) <> colon, + nest 2 why] + else why + where + strat_used = isJust mb_strat + extra | not strat_used, (newtype_deriving == YesGeneralizedNewtypeDeriving) + = text "(even with cunning GeneralizedNewtypeDeriving)" + | otherwise = empty + pred = mkClassPred cls cls_args + via_mechanism | strat_used + , Just strat <- mb_strat + = text "with the" <+> (derivStrategyName strat) <+> text "strategy" + | otherwise + = empty + +badCon :: DataCon -> SDoc -> SDoc +badCon con msg = text "Constructor" <+> quotes (ppr con) <+> msg + +derivErrDiagnosticMessage :: Class + -> [Type] + -> Maybe (DerivStrategy GhcTc) + -> UsingGeneralizedNewtypeDeriving + -> Bool -- If True, includes the herald \"can't make a derived..\" + -> DeriveInstanceErrReason + -> SDoc +derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \case + DerivErrNotWellKinded tc cls_kind _ + -> sep [ hang (text "Cannot derive well-kinded instance of form" + <+> quotes (pprClassPred cls cls_tys + <+> parens (ppr tc <+> text "..."))) + 2 empty + , nest 2 (text "Class" <+> quotes (ppr cls) + <+> text "expects an argument of kind" + <+> quotes (pprKind cls_kind)) + ] + DerivErrSafeHaskellGenericInst + -> text "Generic instances can only be derived in" + <+> text "Safe Haskell using the stock strategy." + DerivErrDerivingViaWrongKind cls_kind via_ty via_kind + -> hang (text "Cannot derive instance via" <+> quotes (pprType via_ty)) + 2 (text "Class" <+> quotes (ppr cls) + <+> text "expects an argument of kind" + <+> quotes (pprKind cls_kind) <> char ',' + $+$ text "but" <+> quotes (pprType via_ty) + <+> text "has kind" <+> quotes (pprKind via_kind)) + DerivErrNoEtaReduce inst_ty + -> sep [text "Cannot eta-reduce to an instance of form", + nest 2 (text "instance (...) =>" + <+> pprClassPred cls (cls_tys ++ [inst_ty]))] + DerivErrBootFileFound + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "Cannot derive instances in hs-boot files" + $+$ text "Write an instance declaration instead") + DerivErrDataConsNotAllInScope tc + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (hang (text "The data constructors of" <+> quotes (ppr tc) <+> text "are not all in scope") + 2 (text "so you cannot derive an instance for it")) + DerivErrGNDUsedOnData + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "GeneralizedNewtypeDeriving cannot be used on non-newtypes") + DerivErrNullaryClasses + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "Cannot derive instances for nullary classes") + DerivErrLastArgMustBeApp + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + ( text "The last argument of the instance must be a" + <+> text "data or newtype application") + DerivErrNoFamilyInstance tc tc_args + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "No family instance for" <+> quotes (pprTypeApp tc tc_args)) + DerivErrNotStockDeriveable _ + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (quotes (ppr cls) <+> text "is not a stock derivable class (Eq, Show, etc.)") + DerivErrHasAssociatedDatatypes hasAdfs at_last_cls_tv_in_kinds at_without_last_cls_tv + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + $ vcat [ ppWhen (hasAdfs == YesHasAdfs) adfs_msg + , case at_without_last_cls_tv of + YesAssociatedTyNotParamOverLastTyVar tc -> at_without_last_cls_tv_msg tc + NoAssociatedTyNotParamOverLastTyVar -> empty + , case at_last_cls_tv_in_kinds of + YesAssocTyLastVarInKind tc -> at_last_cls_tv_in_kinds_msg tc + NoAssocTyLastVarInKind -> empty + ] + where + + adfs_msg = text "the class has associated data types" + + at_without_last_cls_tv_msg at_tc = hang + (text "the associated type" <+> quotes (ppr at_tc) + <+> text "is not parameterized over the last type variable") + 2 (text "of the class" <+> quotes (ppr cls)) + + at_last_cls_tv_in_kinds_msg at_tc = hang + (text "the associated type" <+> quotes (ppr at_tc) + <+> text "contains the last type variable") + 2 (text "of the class" <+> quotes (ppr cls) + <+> text "in a kind, which is not (yet) allowed") + DerivErrNewtypeNonDeriveableClass + -> derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald (DerivErrNotStockDeriveable NoDeriveAnyClassEnabled) + DerivErrCannotEtaReduceEnough eta_ok + -> let cant_derive_err = ppUnless eta_ok eta_msg + eta_msg = text "cannot eta-reduce the representation type enough" + in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + cant_derive_err + DerivErrOnlyAnyClassDeriveable tc _ + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (quotes (ppr tc) <+> text "is a type class," + <+> text "and can only have a derived instance" + $+$ text "if DeriveAnyClass is enabled") + DerivErrNotDeriveable _ + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald empty + DerivErrNotAClass predType + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (quotes (ppr predType) <+> text "is not a class") + DerivErrNoConstructors rep_tc + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (quotes (pprSourceTyCon rep_tc) <+> text "must have at least one data constructor") + DerivErrLangExtRequired ext + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "You need " <> ppr ext + <+> text "to derive an instance for this class") + DerivErrDunnoHowToDeriveForType ty + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (hang (text "Don't know how to derive" <+> quotes (ppr cls)) + 2 (text "for type" <+> quotes (ppr ty))) + DerivErrMustBeEnumType rep_tc + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (sep [ quotes (pprSourceTyCon rep_tc) <+> + text "must be an enumeration type" + , text "(an enumeration consists of one or more nullary, non-GADT constructors)" ]) + + DerivErrMustHaveExactlyOneConstructor rep_tc + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor") + DerivErrMustHaveSomeParameters rep_tc + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "Data type" <+> quotes (ppr rep_tc) <+> text "must have some type parameters") + DerivErrMustNotHaveClassContext rep_tc bad_stupid_theta + -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (text "Data type" <+> quotes (ppr rep_tc) + <+> text "must not have a class context:" <+> pprTheta bad_stupid_theta) + DerivErrBadConstructor _ reasons + -> let why = vcat $ map renderReason reasons + in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why + where + renderReason = \case + DerivErrBadConExistential con + -> badCon con $ text "must be truly polymorphic in the last argument of the data type" + DerivErrBadConCovariant con + -> badCon con $ text "must not use the type variable in a function argument" + DerivErrBadConFunTypes con + -> badCon con $ text "must not contain function types" + DerivErrBadConWrongArg con + -> badCon con $ text "must use the type variable only as the last argument of a data type" + DerivErrBadConIsGADT con + -> badCon con $ text "is a GADT" + DerivErrBadConHasExistentials con + -> badCon con $ text "has existential type variables in its type" + DerivErrBadConHasConstraints con + -> badCon con $ text "has constraints in its type" + DerivErrBadConHasHigherRankType con + -> badCon con $ text "has a higher-rank type" + DerivErrGenerics reasons + -> let why = vcat $ map renderReason reasons + in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why + where + renderReason = \case + DerivErrGenericsMustNotHaveDatatypeContext tc_name + -> ppr tc_name <+> text "must not have a datatype context" + DerivErrGenericsMustNotHaveExoticArgs dc + -> ppr dc <+> text "must not have exotic unlifted or polymorphic arguments" + DerivErrGenericsMustBeVanillaDataCon dc + -> ppr dc <+> text "must be a vanilla data constructor" + DerivErrGenericsMustHaveSomeTypeParams rep_tc + -> text "Data type" <+> quotes (ppr rep_tc) + <+> text "must have some type parameters" + DerivErrGenericsMustNotHaveExistentials con + -> badCon con $ text "must not have existential arguments" + DerivErrGenericsWrongArgKind con + -> badCon con $ + text "applies a type to an argument involving the last parameter" + $$ text "but the applied type is not of kind * -> *" + DerivErrEnumOrProduct this that + -> let ppr1 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False this + ppr2 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False that + in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald + (ppr1 $$ text " or" $$ ppr2) + +lookupInstanceErrDiagnosticMessage :: Class + -> [Type] + -> LookupInstanceErrReason + -> SDoc +lookupInstanceErrDiagnosticMessage cls tys = \case + LookupInstErrNotExact + -> text "Not an exact match (i.e., some variables get instantiated)" + LookupInstErrFlexiVar + -> text "flexible type variable:" <+> (ppr $ mkTyConApp (classTyCon cls) tys) + LookupInstErrNotFound + -> text "instance not found" <+> (ppr $ mkTyConApp (classTyCon cls) tys) + +{- ********************************************************************* +* * + Outputable SolverReportErrCtxt (for debugging) +* * +**********************************************************************-} + +instance Outputable SolverReportErrCtxt where + ppr (CEC { cec_binds = bvar + , cec_defer_type_errors = dte + , cec_expr_holes = eh + , cec_type_holes = th + , cec_out_of_scope_holes = osh + , cec_warn_redundant = wr + , cec_expand_syns = es + , cec_suppress = sup }) + = text "CEC" <+> braces (vcat + [ text "cec_binds" <+> equals <+> ppr bvar + , text "cec_defer_type_errors" <+> equals <+> ppr dte + , text "cec_expr_holes" <+> equals <+> ppr eh + , text "cec_type_holes" <+> equals <+> ppr th + , text "cec_out_of_scope_holes" <+> equals <+> ppr osh + , text "cec_warn_redundant" <+> equals <+> ppr wr + , text "cec_expand_syns" <+> equals <+> ppr es + , text "cec_suppress" <+> equals <+> ppr sup ]) + +{- ********************************************************************* +* * + Outputting TcSolverReportMsg errors +* * +**********************************************************************-} + +-- | Pretty-print a 'SolverReportWithCtxt', containing a 'TcSolverReportMsg' +-- with its enclosing 'SolverReportErrCtxt'. +pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc +pprSolverReportWithCtxt (SolverReportWithCtxt { reportContext = ctxt, reportContent = msg }) + = pprTcSolverReportMsg ctxt msg + +-- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'. +pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc +pprTcSolverReportMsg _ (BadTelescope telescope skols) = + hang (text "These kind and type variables:" <+> ppr telescope $$ + text "are out of dependency order. Perhaps try this ordering:") + 2 (pprTyVars sorted_tvs) + where + sorted_tvs = scopedSort skols +pprTcSolverReportMsg _ (UserTypeError ty) = + pprUserTypeErrorTy ty +pprTcSolverReportMsg _ (UnsatisfiableError ty) = + pprUserTypeErrorTy ty +pprTcSolverReportMsg ctxt (ReportHoleError hole err) = + pprHoleError ctxt hole err +pprTcSolverReportMsg ctxt + (CannotUnifyVariable + { mismatchMsg = msg + , cannotUnifyReason = reason }) + = pprMismatchMsg ctxt msg + $$ pprCannotUnifyVariableReason ctxt reason +pprTcSolverReportMsg ctxt + (Mismatch + { mismatchMsg = mismatch_msg + , mismatchTyVarInfo = tv_info + , mismatchAmbiguityInfo = ambig_infos + , mismatchCoercibleInfo = coercible_info }) + = vcat ([ pprMismatchMsg ctxt mismatch_msg + , maybe empty (pprTyVarInfo ctxt) tv_info + , maybe empty pprCoercibleMsg coercible_info ] + ++ (map pprAmbiguityInfo ambig_infos)) +pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = + vcat (map make_msg frr_origs) + where + -- Assemble the error message: pair up each origin with the corresponding type, e.g. + -- • FixedRuntimeRep origin msg 1 ... + -- a :: TYPE r1 + -- • FixedRuntimeRep origin msg 2 ... + -- b :: TYPE r2 + make_msg :: FixedRuntimeRepErrorInfo -> SDoc + make_msg (FRR_Info { frr_info_origin = + FixedRuntimeRepOrigin + { frr_type = ty + , frr_context = frr_ctxt } + , frr_info_not_concrete = mb_not_conc + , frr_info_other_origin = mb_other_orig }) = + -- Add bullet points if there is more than one error. + (if length frr_origs > 1 then (bullet <+>) else id) $ + vcat [ sep [ pprFixedRuntimeRepContext frr_ctxt + , text "does not have a fixed runtime representation." ] + , type_printout ty + , case mb_other_orig of + Nothing -> empty + Just o -> other_context o + , case mb_not_conc of + Just (conc_tv, not_conc) + | conc_tv `elemVarSet` tyCoVarsOfType ty + -- Only show this message if 'conc_tv' appears somewhere + -- in the type, otherwise it's not helpful. + -> unsolved_concrete_eq_explanation conc_tv not_conc + _ -> empty + ] + + -- Don't print out the type (only the kind), if the type includes + -- a confusing cast, unless the user passed -fprint-explicit-coercions. + -- + -- Example: + -- + -- In T20363, we have a representation-polymorphism error with a type + -- of the form + -- + -- ( (# #) |> co ) :: TYPE NilRep + -- + -- where NilRep is a nullary type family application which reduces to TupleRep '[]. + -- We prefer avoiding showing the cast to the user, but we also don't want to + -- print the confusing: + -- + -- (# #) :: TYPE NilRep + -- + -- So in this case we simply don't print the type, only the kind. + confusing_cast :: Type -> Bool + confusing_cast ty = + case ty of + CastTy inner_ty _ + -- A confusing cast is one that is responsible + -- for a representation-polymorphism error. + -> isConcreteType (typeKind inner_ty) + _ -> False + + type_printout :: Type -> SDoc + type_printout ty = + sdocOption sdocPrintExplicitCoercions $ \ show_coercions -> + if confusing_cast ty && not show_coercions + then vcat [ text "Its kind is:" + , nest 2 $ pprWithTYPE (typeKind ty) + , text "(Use -fprint-explicit-coercions to see the full type.)" ] + else vcat [ text "Its type is:" + , nest 2 $ ppr ty <+> dcolon <+> pprWithTYPE (typeKind ty) ] + + other_context :: CtOrigin -> SDoc + other_context = \case + TypeEqOrigin { uo_actual = actual_ty, uo_expected = exp_ty } -> + -- TODO: use uo_thing in the error message as well? + hang (text "When unifying:") 2 $ + vcat [ bullet <+> ppr actual_ty + , bullet <+> ppr exp_ty + ] + KindEqOrigin _ _ orig' _ + -> other_context orig' + _ -> empty -- Don't think this ever happens + + unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc + unsolved_concrete_eq_explanation tv not_conc = + text "Cannot unify" <+> quotes (ppr not_conc) + <+> text "with the type variable" <+> quotes (ppr tv) + $$ text "because the former is not a concrete" <+> what <> dot + where + ki = tyVarKind tv + what :: SDoc + what + | isRuntimeRepTy ki + = quotes (text "RuntimeRep") + | isLevityTy ki + = quotes (text "Levity") + | otherwise + = text "type" +pprTcSolverReportMsg _ (ExpectingMoreArguments n thing) = + text "Expecting" <+> speakN (abs n) <+> + more <+> quotes (ppr thing) + where + more + | n == 1 = text "more argument to" + | otherwise = text "more arguments to" -- n > 1 +pprTcSolverReportMsg ctxt (UnboundImplicitParams (item :| items)) = + let givens = getUserGivens ctxt + in if null givens + then addArising (errorItemCtLoc item) $ + sep [ text "Unbound implicit parameter" <> plural preds + , nest 2 (pprParendTheta preds) ] + else pprMismatchMsg ctxt (CouldNotDeduce givens (item :| items) Nothing) + where + preds = map errorItemPred (item : items) +pprTcSolverReportMsg _ (AmbiguityPreventsSolvingCt item ambigs) = + pprAmbiguityInfo (Ambiguity True ambigs) <+> + pprArising (errorItemCtLoc item) $$ + text "prevents the constraint" <+> quotes (pprParendType $ errorItemPred item) + <+> text "from being solved." +pprTcSolverReportMsg ctxt@(CEC {cec_encl = implics}) + (CannotResolveInstance item unifiers candidates rel_binds) + = + vcat + [ no_inst_msg + , extra_note + , mb_patsyn_prov `orElse` empty + , ppWhen (has_ambigs && not (null unifiers && null useful_givens)) + (vcat [ ppUnless lead_with_ambig $ + pprAmbiguityInfo (Ambiguity False (ambig_kvs, ambig_tvs)) + , pprRelevantBindings rel_binds + -- "Relevant bindings" can help explain to the user where an + -- ambiguous type variable comes from. + , potential_msg ]) + , ppWhen (isNothing mb_patsyn_prov) $ + -- Don't suggest fixes for the provided context of a pattern + -- synonym; the right fix is to bind more in the pattern + show_fixes (ctxt_fixes ++ drv_fixes ++ naked_sc_fixes) + , ppWhen (not (null candidates)) + (hang (text "There are instances for similar types:") + 2 (vcat (map ppr candidates))) + -- See Note [Report candidate instances] + ] + where + orig = errorItemOrigin item + pred = errorItemPred item + (clas, tys) = getClassPredTys pred + -- See Note [Highlighting ambiguous type variables] in GHC.Tc.Errors + (ambig_kvs, ambig_tvs) = ambigTkvsOfTy pred + ambigs = ambig_kvs ++ ambig_tvs + has_ambigs = not (null ambigs) + useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics) + -- useful_givens are the enclosing implications with non-empty givens, + -- modulo the horrid discardProvCtxtGivens + lead_with_ambig = not (null ambigs) + && not (any isRuntimeUnkSkol ambigs) + && not (null unifiers) + && null useful_givens + + no_inst_msg :: SDoc + no_inst_msg + | lead_with_ambig + = pprTcSolverReportMsg ctxt $ AmbiguityPreventsSolvingCt item (ambig_kvs, ambig_tvs) + | otherwise + = pprMismatchMsg ctxt $ CouldNotDeduce useful_givens (item :| []) Nothing + + -- Report "potential instances" only when the constraint arises + -- directly from the user's use of an overloaded function + want_potential (TypeEqOrigin {}) = False + want_potential _ = True + + potential_msg + = ppWhen (not (null unifiers) && want_potential orig) $ + potential_hdr $$ + potentialInstancesErrMsg (PotentialInstances { matches = [], unifiers }) + + potential_hdr + = ppWhen lead_with_ambig $ + text "Probable fix: use a type annotation to specify what" + <+> pprQuotedList ambig_tvs <+> text "should be." + + mb_patsyn_prov :: Maybe SDoc + mb_patsyn_prov + | not lead_with_ambig + , ProvCtxtOrigin PSB{ psb_def = L _ pat } <- orig + = Just (vcat [ text "In other words, a successful match on the pattern" + , nest 2 $ ppr pat + , text "does not provide the constraint" <+> pprParendType pred ]) + | otherwise = Nothing + + extra_note + -- Flag up partially applied uses of (->) + | any isFunTy (filterOutInvisibleTypes (classTyCon clas) tys) + = text "(maybe you haven't applied a function to enough arguments?)" + + -- Clarify the mysterious "No instance for (Typeable T) + | className clas == typeableClassName + , [_,ty] <- tys -- Look for (Typeable (k->*) (T k)) + , Just (tc,_) <- tcSplitTyConApp_maybe ty + , not (isTypeFamilyTyCon tc) + = hang (text "GHC can't yet do polykinded") + 2 (text "Typeable" <+> + parens (ppr ty <+> dcolon <+> ppr (typeKind ty))) + + | otherwise + = empty + + ----------- Possible fixes ---------------- + ctxt_fixes = ctxtFixes has_ambigs pred implics + + drv_fixes = case orig of + DerivOrigin standalone -> [drv_fix standalone] + DerivOriginDC _ _ standalone -> [drv_fix standalone] + DerivOriginCoerce _ _ _ standalone -> [drv_fix standalone] + _ -> [] + + drv_fix standalone_wildcard + | standalone_wildcard + = text "fill in the wildcard constraint yourself" + | otherwise + = hang (text "use a standalone 'deriving instance' declaration,") + 2 (text "so you can specify the instance context yourself") + + -- naked_sc_fix: try to produce a helpful error message for + -- superclass constraints caught by the subtleties described by + -- Note [Recursive superclasses] in GHC.TyCl.Instance + naked_sc_fixes + | ScOrigin IsClsInst NakedSc <- orig -- A superclass wanted with no instance decls used yet + , any non_tyvar_preds useful_givens -- Some non-tyvar givens + = [vcat [ text "if the constraint looks soluble from a superclass of the instance context," + , text "read 'Undecidable instances and loopy superclasses' in the user manual" ]] + | otherwise = [] + + non_tyvar_preds :: UserGiven -> Bool + non_tyvar_preds = any non_tyvar_pred . ic_given + + non_tyvar_pred :: EvVar -> Bool + -- Tells if the Given is of form (C ty1 .. tyn), where the tys are not all tyvars + non_tyvar_pred given = case getClassPredTys_maybe (idType given) of + Just (_, tys) -> not (all isTyVarTy tys) + Nothing -> False + +pprTcSolverReportMsg (CEC {cec_encl = implics}) (OverlappingInstances item matches unifiers) = + vcat + [ addArising ct_loc $ + (text "Overlapping instances for" + <+> pprType (mkClassPred clas tys)) + , ppUnless (null matching_givens) $ + sep [text "Matching givens (or their superclasses):" + , nest 2 (vcat matching_givens)] + , potentialInstancesErrMsg + (PotentialInstances { matches = NE.toList matches, unifiers }) + , ppWhen (null matching_givens && null (NE.tail matches) && null unifiers) $ + -- Intuitively, some given matched the wanted in their + -- flattened or rewritten (from given equalities) form + -- but the matcher can't figure that out because the + -- constraints are non-flat and non-rewritten so we + -- simply report back the whole given + -- context. Accelerate Smart.hs showed this problem. + sep [ text "There exists a (perhaps superclass) match:" + , nest 2 (vcat (pp_from_givens useful_givens))] + + , ppWhen (null $ NE.tail matches) $ + parens (vcat [ ppUnless (null tyCoVars) $ + text "The choice depends on the instantiation of" <+> + quotes (pprWithCommas ppr tyCoVars) + , ppUnless (null famTyCons) $ + if (null tyCoVars) + then + text "The choice depends on the result of evaluating" <+> + quotes (pprWithCommas ppr famTyCons) + else + text "and the result of evaluating" <+> + quotes (pprWithCommas ppr famTyCons) + , ppWhen (null (matching_givens)) $ + vcat [ text "To pick the first instance above, use IncoherentInstances" + , text "when compiling the other instance declarations"] + ])] + where + ct_loc = errorItemCtLoc item + orig = ctLocOrigin ct_loc + pred = errorItemPred item + (clas, tys) = getClassPredTys pred + tyCoVars = tyCoVarsOfTypesList tys + famTyCons = filter isFamilyTyCon $ concatMap (nonDetEltsUniqSet . tyConsOfType) tys + useful_givens = discardProvCtxtGivens orig (getUserGivensFromImplics implics) + matching_givens = mapMaybe matchable useful_givens + matchable implic@(Implic { ic_given = evvars, ic_info = skol_info }) + = case ev_vars_matching of + [] -> Nothing + _ -> Just $ hang (pprTheta ev_vars_matching) + 2 (sep [ text "bound by" <+> ppr skol_info + , text "at" <+> + ppr (getCtLocEnvLoc (ic_env implic)) ]) + where ev_vars_matching = [ pred + | ev_var <- evvars + , let pred = evVarPred ev_var + , any can_match (pred : transSuperClasses pred) ] + can_match pred + = case getClassPredTys_maybe pred of + Just (clas', tys') -> clas' == clas + && isJust (tcMatchTys tys tys') + Nothing -> False +pprTcSolverReportMsg _ (UnsafeOverlap item match unsafe_overlapped) = + vcat [ addArising ct_loc (text "Unsafe overlapping instances for" + <+> pprType (mkClassPred clas tys)) + , sep [text "The matching instance is:", + nest 2 (pprInstance match)] + , vcat [ text "It is compiled in a Safe module and as such can only" + , text "overlap instances from the same module, however it" + , text "overlaps the following instances from different" <+> + text "modules:" + , nest 2 (vcat [pprInstances $ NE.toList unsafe_overlapped]) + ] + ] + where + ct_loc = errorItemCtLoc item + pred = errorItemPred item + (clas, tys) = getClassPredTys pred + +pprTcSolverReportMsg _ MultiplicityCoercionsNotSupported = text "GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities" + +pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc +pprCannotUnifyVariableReason ctxt (CannotUnifyWithPolytype item tv1 ty2 mb_tv_info) = + vcat [ (if isSkolemTyVar tv1 + then text "Cannot equate type variable" + else text "Cannot instantiate unification variable") + <+> quotes (ppr tv1) + , hang (text "with a" <+> what <+> text "involving polytypes:") 2 (ppr ty2) + , maybe empty (pprTyVarInfo ctxt) mb_tv_info ] + where + what = text $ levelString $ + ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel + +pprCannotUnifyVariableReason _ (SkolemEscape item implic esc_skols) = + let + esc_doc = sep [ text "because" <+> what <+> text "variable" <> plural esc_skols + <+> pprQuotedList esc_skols + , text "would escape" <+> + if isSingleton esc_skols then text "its scope" + else text "their scope" ] + in + vcat [ nest 2 $ esc_doc + , sep [ (if isSingleton esc_skols + then text "This (rigid, skolem)" <+> + what <+> text "variable is" + else text "These (rigid, skolem)" <+> + what <+> text "variables are") + <+> text "bound by" + , nest 2 $ ppr (ic_info implic) + , nest 2 $ text "at" <+> + ppr (getCtLocEnvLoc (ic_env implic)) ] ] + where + what = text $ levelString $ + ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel + +pprCannotUnifyVariableReason ctxt + (OccursCheck + { occursCheckInterestingTyVars = interesting_tvs + , occursCheckAmbiguityInfos = ambig_infos }) + = ppr_interesting_tyVars interesting_tvs + $$ vcat (map pprAmbiguityInfo ambig_infos) + where + ppr_interesting_tyVars [] = empty + ppr_interesting_tyVars (tv:tvs) = + hang (text "Type variable kinds:") 2 $ + vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt)) + (tv:tvs)) + tyvar_binding tyvar = ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar) +pprCannotUnifyVariableReason ctxt (DifferentTyVars tv_info) + = pprTyVarInfo ctxt tv_info +pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) + = pprTyVarInfo ctxt tv_info + $$ maybe empty pprCoercibleMsg mb_coercible_msg + +pprUntouchableVariable :: TcTyVar -> Implication -> SDoc +pprUntouchableVariable tv (Implic { ic_given = given, ic_info = skol_info, ic_env = env }) + = sep [ quotes (ppr tv) <+> text "is untouchable" + , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given + , nest 2 $ text "bound by" <+> ppr skol_info + , nest 2 $ text "at" <+> ppr (getCtLocEnvLoc env) ] + +pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc +pprMismatchMsg ctxt + (BasicMismatch { mismatch_ea = ea + , mismatch_item = item + , mismatch_ty1 = ty1 -- Expected + , mismatch_ty2 = ty2 -- Actual + , mismatch_whenMatching = mb_match_txt + , mismatch_mb_same_occ = same_occ_info }) + = vcat [ addArising (errorItemCtLoc item) msg + , pprQCOriginExtra item + , ea_extra + , maybe empty (pprWhenMatching ctxt) mb_match_txt + , maybe empty pprSameOccInfo same_occ_info ] + where + msg + | (isLiftedRuntimeRep ty1 && isUnliftedRuntimeRep ty2) || + (isLiftedRuntimeRep ty2 && isUnliftedRuntimeRep ty1) || + (isLiftedLevity ty1 && isUnliftedLevity ty2) || + (isLiftedLevity ty2 && isUnliftedLevity ty1) + = text "Couldn't match a lifted type with an unlifted type" + + | isAtomicTy ty1 || isAtomicTy ty2 + = -- Print with quotes + sep [ text herald1 <+> quotes (ppr ty1) + , nest padding $ + text herald2 <+> quotes (ppr ty2) ] + + | otherwise + = -- Print with vertical layout + vcat [ text herald1 <> colon <+> ppr ty1 + , nest padding $ + text herald2 <> colon <+> ppr ty2 ] + + herald1 = conc [ "Couldn't match" + , if is_repr then "representation of" else "" + , if want_ea then "expected" else "" + , what ] + herald2 = conc [ "with" + , if is_repr then "that of" else "" + , if want_ea then ("actual " ++ what) else "" ] + + padding = length herald1 - length herald2 + + (want_ea, ea_extra) + = case ea of + NoEA -> (False, empty) + EA mb_extra -> (True , maybe empty (pprExpectedActualInfo ctxt) mb_extra) + is_repr = case errorItemEqRel item of { ReprEq -> True; NomEq -> False } + + what = levelString (ctLocTypeOrKind_maybe (errorItemCtLoc item) `orElse` TypeLevel) + + conc :: [String] -> String + conc = unwords . filter (not . null) + +pprMismatchMsg ctxt + (TypeEqMismatch { teq_mismatch_item = item + , teq_mismatch_ty1 = ty1 -- These types are the actual types + , teq_mismatch_ty2 = ty2 -- that don't match; may be swapped + , teq_mismatch_expected = exp -- These are the context of + , teq_mismatch_actual = act -- the mis-match + , teq_mismatch_what = mb_thing + , teq_mb_same_occ = mb_same_occ }) + = vcat [ addArising ct_loc $ + pprWithInvisibleBitsWhen ppr_invis_bits msg + $$ maybe empty pprSameOccInfo mb_same_occ + , pprQCOriginExtra item ] + where + + msg | Just (torc, rep) <- sORTKind_maybe exp + = msg_for_exp_sort torc rep + + | Just nargs_msg <- num_args_msg + , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig + = nargs_msg $$ ea_msg + + | ea_looks_same ty1 ty2 exp act + , Right ea_msg <- mk_ea_msg ctxt (Just item) level orig + = ea_msg + + | otherwise + = bale_out_msg + + -- bale_out_msg: the mismatched types are /inside/ exp and act + bale_out_msg = vcat errs + where + errs = case mk_ea_msg ctxt Nothing level orig of + Left ea_info -> pprMismatchMsg ctxt mismatch_err + : map (pprExpectedActualInfo ctxt) ea_info + Right ea_err -> [ pprMismatchMsg ctxt mismatch_err + , ea_err ] + mismatch_err = mkBasicMismatchMsg NoEA item ty1 ty2 + + -- 'expected' is (TYPE rep) or (CONSTRAINT rep) + msg_for_exp_sort exp_torc exp_rep + | Just (act_torc, act_rep) <- sORTKind_maybe act + = -- (TYPE exp_rep) ~ (CONSTRAINT act_rep) etc + msg_torc_torc act_torc act_rep + | otherwise + = -- (TYPE _) ~ Bool, etc + maybe_num_args_msg $$ + sep [ text "Expected a" <+> ppr_torc exp_torc <> comma + , text "but" <+> case mb_thing of + Nothing -> text "found something with kind" + Just thing -> quotes (ppr thing) <+> text "has kind" + , quotes (pprWithTYPE act) ] + + where + msg_torc_torc act_torc act_rep + | exp_torc == act_torc + = msg_same_torc act_torc act_rep + | otherwise + = sep [ text "Expected a" <+> ppr_torc exp_torc <> comma + , text "but" <+> case mb_thing of + Nothing -> text "found a" + Just thing -> quotes (ppr thing) <+> text "is a" + <+> ppr_torc act_torc ] + + msg_same_torc act_torc act_rep + | Just exp_doc <- describe_rep exp_rep + , Just act_doc <- describe_rep act_rep + = sep [ text "Expected" <+> exp_doc <+> ppr_torc exp_torc <> comma + , text "but" <+> case mb_thing of + Just thing -> quotes (ppr thing) <+> text "is" + Nothing -> text "got" + <+> act_doc <+> ppr_torc act_torc ] + msg_same_torc _ _ = bale_out_msg + + ct_loc = errorItemCtLoc item + orig = errorItemOrigin item + level = ctLocTypeOrKind_maybe ct_loc `orElse` TypeLevel + ppr_invis_bits = shouldPprWithInvisibleBits ty1 ty2 orig + + num_args_msg = case level of + KindLevel + | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act) + -- if one is a meta-tyvar, then it's possible that the user + -- has asked for something impredicative, and we couldn't unify. + -- Don't bother with counting arguments. + -> let n_act = count_args act + n_exp = count_args exp in + case n_act - n_exp of + n | n > 0 -- we don't know how many args there are, so don't + -- recommend removing args that aren't + , Just thing <- mb_thing + -> Just $ pprTcSolverReportMsg ctxt (ExpectingMoreArguments n thing) + _ -> Nothing + + _ -> Nothing + + maybe_num_args_msg = num_args_msg `orElse` empty + + count_args ty = count isVisiblePiTyBinder $ fst $ splitPiTys ty + + ppr_torc TypeLike = text "type"; + ppr_torc ConstraintLike = text "constraint" + + describe_rep :: RuntimeRepType -> Maybe SDoc + -- describe_rep IntRep = Just "an IntRep" + -- describe_rep (BoxedRep Lifted) = Just "a lifted" + -- etc + describe_rep rep + | Just (rr_tc, rr_args) <- splitRuntimeRep_maybe rep + = case rr_args of + [lev_ty] | rr_tc `hasKey` boxedRepDataConKey + , Just lev <- levityType_maybe lev_ty + -> case lev of + Lifted -> Just (text "a lifted") + Unlifted -> Just (text "a boxed unlifted") + [] | rr_tc `hasKey` tupleRepDataConTyConKey -> Just (text "a zero-bit") + | starts_with_vowel rr_occ -> Just (text "an" <+> text rr_occ) + | otherwise -> Just (text "a" <+> text rr_occ) + where + rr_occ = occNameString (getOccName rr_tc) + + _ -> Nothing -- Must be TupleRep [r1..rn] + | otherwise = Nothing + + starts_with_vowel (c:_) = c `elem` ("AEIOU" :: String) + starts_with_vowel [] = False + +pprMismatchMsg ctxt (CouldNotDeduce useful_givens (item :| others) mb_extra) + = vcat [ main_msg + , pprQCOriginExtra item + , ea_supplementary ] + where + main_msg + | null useful_givens = addArising ct_loc no_instance_msg + | otherwise = vcat ( addArising ct_loc no_deduce_msg + : pp_from_givens useful_givens) + + ea_supplementary = case mb_extra of + Nothing -> empty + Just (CND_Extra level ty1 ty2) -> mk_supplementary_ea_msg ctxt level ty1 ty2 orig + + ct_loc = errorItemCtLoc item + orig = ctLocOrigin ct_loc + wanteds = map errorItemPred (item:others) + + no_instance_msg = + case wanteds of + [wanted] | -- Guard: don't say "no instance" for a constraint + -- such as "c" for a type variable c. + Just (tc, _) <- splitTyConApp_maybe wanted + , isClassTyCon tc + -> text "No instance for" <+> quotes (ppr wanted) + _ -> text "Could not solve:" <+> pprTheta wanteds + + no_deduce_msg = + case wanteds of + [wanted] -> text "Could not deduce" <+> quotes (ppr wanted) + _ -> text "Could not deduce:" <+> pprTheta wanteds + +pprQCOriginExtra :: ErrorItem -> SDoc +-- When we were originally trying to solve a quantified constraint like +-- (forall a. Eq a => Eq (c a)) +-- add a note to say so, so the overall error looks like +-- Cannot deduce Eq (c a) +-- from (Eq a) +-- when trying to solve (forall a. Eq a => Eq (c a)) +-- Without this, the error is very inscrutable +-- See (WFA3) in Note [Solving a Wanted forall-constraint], +-- in GHC.Tc.Solver.Solve +pprQCOriginExtra item + | ScOrigin (IsQC pred orig) _ <- orig + = hang (text "When trying to solve the quantified constraint") + 2 (vcat [ ppr pred + , text "arising from" <+> pprCtOriginBriefly orig ]) + | otherwise + = empty + where + orig = ctLocOrigin (errorItemCtLoc item) + +pprKindMismatchMsg :: TypedThing -> Type -> Type -> SDoc +pprKindMismatchMsg thing exp act + = hang (text "Expected" <+> kind_desc <> comma) + 2 (text "but" <+> quotes (ppr thing) <+> text "has kind" <+> + quotes (ppr act)) + where + kind_desc | isConstraintLikeKind exp = text "a constraint" + | Just arg <- kindRep_maybe exp -- TYPE t0 + , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case + True -> text "kind" <+> quotes (ppr exp) + False -> text "a type" + | otherwise = text "kind" <+> quotes (ppr exp) + +-- | Whether to print explicit kinds (with @-fprint-explicit-kinds@) +-- in an 'SDoc' when a type mismatch occurs to due invisible parts of the types. +-- See Note [Showing invisible bits of types in error messages] +-- +-- This function first checks to see if the 'CtOrigin' argument is a +-- 'TypeEqOrigin'. If so, it first checks whether the equality is a visible +-- equality; if it's not, definitely print the kinds. Even if the equality is +-- a visible equality, check the expected/actual types to see if the types +-- have equal visible components. If the 'CtOrigin' is +-- not a 'TypeEqOrigin', fall back on the actual mismatched types themselves. +shouldPprWithInvisibleBits :: Type -> Type -> CtOrigin -> Bool +shouldPprWithInvisibleBits _ty1 _ty2 (TypeEqOrigin { uo_actual = act + , uo_expected = exp + , uo_visible = vis }) + | not vis = True -- See tests T15870, T16204c + | otherwise = mayLookIdentical act exp -- See tests T9171, T9144. +shouldPprWithInvisibleBits ty1 ty2 _ct + = mayLookIdentical ty1 ty2 + +{- Note [Showing invisible bits of types in error messages] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It can be terribly confusing to get an error message like (#9171) + + Couldn't match expected type ‘GetParam Base (GetParam Base Int)’ + with actual type ‘GetParam Base (GetParam Base Int)’ + +The reason may be that the kinds don't match up. Typically you'll get +more useful information, but not when it's as a result of ambiguity. + +To mitigate this, when we find a type or kind mis-match: + +* See if normally-visible parts of the type would make the two types + look different. This check is made by + `GHC.Core.TyCo.Compare.mayLookIdentical` + +* If not, display the types with their normally-visible parts made visible, + by setting flags in the `SDocContext": + Specifically: + - Display kind arguments: sdocPrintExplicitKinds + - Don't default away runtime-reps: sdocPrintExplicitRuntimeReps, + which controls `GHC.Iface.Type.hideNonStandardTypes` + (NB: foralls are always printed by pprType, it turns out.) + +As a result the above error message would instead be displayed as: + + Couldn't match expected type + ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’ + with actual type + ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’ + +Which makes it clearer that the culprit is the mismatch between `k2` and `k20`. + +Another example of what goes wrong without this: #24553. +-} + +{- ********************************************************************* +* * + Displaying potential instances +* * +**********************************************************************-} + +-- | Directly display the given matching and unifying instances, +-- with a header for each: `Matching instances`/`Potentially matching instances`. +pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc +pprPotentialInstances ppr_inst (PotentialInstances { matches, unifiers }) = + vcat + [ ppWhen (not $ null matches) $ + text "Matching instance" <> plural matches <> colon $$ + nest 2 (vcat (map ppr_inst matches)) + , ppWhen (not $ null unifiers) $ + (text "Potentially matching instance" <> plural unifiers <> colon) $$ + nest 2 (vcat (map ppr_inst unifiers)) + ] + +-- | Display a summary of available instances, omitting those involving +-- out-of-scope types, in order to explain why we couldn't solve a particular +-- constraint, e.g. due to instance overlap or out-of-scope types. +-- +-- To directly display a collection of matching/unifying instances, +-- use 'pprPotentialInstances'. +potentialInstancesErrMsg :: PotentialInstances -> SDoc +-- See Note [Displaying potential instances] +potentialInstancesErrMsg potentials = + sdocOption sdocPrintPotentialInstances $ \print_insts -> + getPprStyle $ \sty -> + potentials_msg_with_options potentials print_insts sty + +-- | Display a summary of available instances, omitting out-of-scope ones. +-- +-- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing +-- options. +potentials_msg_with_options :: PotentialInstances + -> Bool -- ^ Whether to print /all/ potential instances + -> PprStyle + -> SDoc +potentials_msg_with_options + (PotentialInstances { matches, unifiers }) + show_all_potentials sty + | null matches && null unifiers + = empty + + | null show_these_matches && null show_these_unifiers + = vcat [ not_in_scope_msg empty + , flag_hint ] + + | otherwise + = vcat [ pprPotentialInstances + pprInstance -- print instance + location info + (PotentialInstances + { matches = show_these_matches + , unifiers = show_these_unifiers }) + , overlapping_but_not_more_specific_msg sorted_matches + , nest 2 $ vcat + [ ppWhen (n_in_scope_hidden > 0) $ + text "...plus" + <+> speakNOf n_in_scope_hidden (text "other") + , ppWhen (not_in_scopes > 0) $ + not_in_scope_msg (text "...plus") + , flag_hint ] ] + where + n_show_matches, n_show_unifiers :: Int + n_show_matches = 3 + n_show_unifiers = 2 + + (in_scope_matches, not_in_scope_matches) = partition inst_in_scope matches + (in_scope_unifiers, not_in_scope_unifiers) = partition inst_in_scope unifiers + sorted_matches = sortBy fuzzyClsInstCmp in_scope_matches + sorted_unifiers = sortBy fuzzyClsInstCmp in_scope_unifiers + (show_these_matches, show_these_unifiers) + | show_all_potentials = (sorted_matches, sorted_unifiers) + | otherwise = (take n_show_matches sorted_matches + ,take n_show_unifiers sorted_unifiers) + n_in_scope_hidden + = length sorted_matches + length sorted_unifiers + - length show_these_matches - length show_these_unifiers + + -- "in scope" means that all the type constructors + -- are lexically in scope; these instances are likely + -- to be more useful + inst_in_scope :: ClsInst -> Bool + inst_in_scope cls_inst = nameSetAll name_in_scope $ + orphNamesOfTypes (is_tys cls_inst) + + name_in_scope name + | pretendNameIsInScope name + = True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names + | Just mod <- nameModule_maybe name + = qual_in_scope (qualName sty mod Nothing (nameOccName name)) + | otherwise + = True + + qual_in_scope :: QualifyName -> Bool + qual_in_scope NameUnqual = True + qual_in_scope (NameQual {}) = True + qual_in_scope _ = False + + not_in_scopes :: Int + not_in_scopes = length not_in_scope_matches + length not_in_scope_unifiers + + not_in_scope_msg herald = + hang (herald <+> speakNOf not_in_scopes (text "instance") + <+> text "involving out-of-scope types") + 2 (ppWhen show_all_potentials $ + pprPotentialInstances + pprInstanceHdr -- only print the header, not the instance location info + (PotentialInstances + { matches = not_in_scope_matches + , unifiers = not_in_scope_unifiers + })) + + flag_hint = ppUnless (show_all_potentials + || (equalLength show_these_matches matches + && equalLength show_these_unifiers unifiers)) $ + text "(use -fprint-potential-instances to see them all)" + +-- | Compute a message informing the user of any instances that are overlapped +-- but were not discarded because the instance overlapping them wasn't +-- strictly more specific. +overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc +overlapping_but_not_more_specific_msg insts + -- Only print one example of "overlapping but not strictly more specific", + -- to avoid information overload. + | overlap : _ <- overlapping_but_not_more_specific + = overlap_header $$ ppr_overlapping overlap + | otherwise + = empty + where + overlap_header :: SDoc + overlap_header + | [_] <- overlapping_but_not_more_specific + = text "An overlapping instance can only be chosen when it is strictly more specific." + | otherwise + = text "Overlapping instances can only be chosen when they are strictly more specific." + overlapping_but_not_more_specific :: [(ClsInst, ClsInst)] + overlapping_but_not_more_specific + = nubOrdBy (comparing (is_dfun . fst)) + [ (overlapper, overlappee) + | these <- groupBy ((==) `on` is_cls_nm) insts + -- Take all pairs of distinct instances... + , one:others <- tails these -- if `these = [inst_1, inst_2, ...]` + , other <- others -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j` + -- ... such that one instance in the pair overlaps the other... + , let mb_overlapping + | hasOverlappingFlag (overlapMode $ is_flag one) + || hasOverlappableFlag (overlapMode $ is_flag other) + = [(one, other)] + | hasOverlappingFlag (overlapMode $ is_flag other) + || hasOverlappableFlag (overlapMode $ is_flag one) + = [(other, one)] + | otherwise + = [] + , (overlapper, overlappee) <- mb_overlapping + -- ... but the overlapper is not more specific than the overlappee. + , not (overlapper `more_specific_than` overlappee) + ] + more_specific_than :: ClsInst -> ClsInst -> Bool + is1 `more_specific_than` is2 + = isJust (tcMatchTys (is_tys is1) (is_tys is2)) + ppr_overlapping :: (ClsInst, ClsInst) -> SDoc + ppr_overlapping (overlapper, overlappee) + = text "The first instance that follows overlaps the second, but is not more specific than it:" + $$ nest 2 (vcat $ map pprInstanceHdr [overlapper, overlappee]) + +{- Note [Displaying potential instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When showing a list of instances for + - overlapping instances (show ones that match) + - no such instance (show ones that could match) +we want to give it a bit of structure. Here's the plan + +* Say that an instance is "in scope" if all of the + type constructors it mentions are lexically in scope. + These are the ones most likely to be useful to the programmer. + +* Show at most n_show in-scope instances, + and summarise the rest ("plus N others") + +* Summarise the not-in-scope instances ("plus 4 not in scope") + +* Add the flag -fshow-potential-instances which replaces the + summary with the full list +-} + +{- ********************************************************************* +* * + Outputting additional solver report information +* * +**********************************************************************-} + +-- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'. +pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc +pprExpectedActualInfo _ (ExpectedActual { ea_expected = exp, ea_actual = act }) = + vcat + [ text "Expected:" <+> ppr exp + , text " Actual:" <+> ppr act ] +pprExpectedActualInfo _ + (ExpectedActualAfterTySynExpansion + { ea_expanded_expected = exp + , ea_expanded_actual = act } ) + = vcat + [ text "Type synonyms expanded:" + , text "Expected type:" <+> ppr exp + , text " Actual type:" <+> ppr act ] + +pprCoercibleMsg :: CoercibleMsg -> SDoc +pprCoercibleMsg (UnknownRoles ty) = + note $ "We cannot know what roles the parameters to" <+> quotes (ppr ty) <+> "have;" $$ + "we must assume that the role is nominal" +pprCoercibleMsg (TyConIsAbstract tc) = + note $ "The type constructor" <+> quotes (pprSourceTyCon tc) <+> "is abstract" +pprCoercibleMsg (OutOfScopeNewtypeConstructor tc dc) = + hang (text "The data constructor" <+> quotes (ppr $ dataConName dc)) + 2 (sep [ text "of newtype" <+> quotes (pprSourceTyCon tc) + , text "is not in scope" ]) + +pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc +pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = + sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions -> + if printExplicitCoercions + || not (cty1 `pickyEqType` cty2) + then vcat [ hang (text "When matching" <+> sub_whats) + 2 (vcat [ ppr cty1 <+> dcolon <+> + ppr (typeKind cty1) + , ppr cty2 <+> dcolon <+> + ppr (typeKind cty2) ]) + , supplementary ] + else text "When matching the kind of" <+> quotes (ppr cty1) + where + sub_t_or_k = mb_sub_t_or_k `orElse` TypeLevel + sub_whats = text (levelString sub_t_or_k) <> char 's' + supplementary = mk_supplementary_ea_msg ctxt sub_t_or_k cty1 cty2 sub_o + +pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc +pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2, thisTyVarIsUntouchable = mb_implic }) + = vcat [ mk_msg tv1 + , maybe empty (pprUntouchableVariable tv1) mb_implic + , case mb_tv2 of { Nothing -> empty; Just tv2 -> mk_msg tv2 } ] + where + mk_msg tv = case tcTyVarDetails tv of + SkolemTv sk_info _ _ -> pprSkols ctxt [(getSkolemInfo sk_info, [tv])] + RuntimeUnk {} -> quotes (ppr tv) <+> text "is an interactive-debugger skolem" + MetaTv {} -> empty + +pprAmbiguityInfo :: AmbiguityInfo -> SDoc +pprAmbiguityInfo (Ambiguity prepend_msg (ambig_kvs, ambig_tvs)) = msg + where + + msg | any isRuntimeUnkSkol ambig_kvs -- See Note [Runtime skolems] + || any isRuntimeUnkSkol ambig_tvs + = vcat [ text "Cannot resolve unknown runtime type" + <> plural ambig_tvs <+> pprQuotedList ambig_tvs + , text "Use :print or :force to determine these types"] + + | not (null ambig_tvs) + = pp_ambig (text "type") ambig_tvs + + | otherwise + = pp_ambig (text "kind") ambig_kvs + + pp_ambig what tkvs + | prepend_msg -- "Ambiguous type variable 't0'" + = text "Ambiguous" <+> what <+> text "variable" + <> plural tkvs <+> pprQuotedList tkvs + + | otherwise -- "The type variable 't0' is ambiguous" + = text "The" <+> what <+> text "variable" <> plural tkvs + <+> pprQuotedList tkvs <+> isOrAre tkvs <+> text "ambiguous" +pprAmbiguityInfo (NonInjectiveTyFam tc) = + note $ quotes (ppr tc) <+> text "is a non-injective type family" + +pprSameOccInfo :: SameOccInfo -> SDoc +pprSameOccInfo (SameOcc same_pkg n1 n2) = + note (ppr_from same_pkg n1 $$ ppr_from same_pkg n2) + where + ppr_from same_pkg nm + | isGoodSrcSpan loc + = hang (quotes (ppr nm) <+> text "is defined at") + 2 (ppr loc) + | otherwise -- Imported things have an UnhelpfulSrcSpan + = hang (quotes (ppr nm)) + 2 (sep [ text "is defined in" <+> quotes (ppr (moduleName mod)) + , ppUnless (same_pkg || pkg == mainUnit) $ + nest 4 $ text "in package" <+> quotes (ppr pkg) ]) + where + pkg = moduleUnit mod + mod = nameModule nm + loc = nameSrcSpan nm + +{- ********************************************************************* +* * + Outputting HoleError messages +* * +**********************************************************************-} + +pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc +pprHoleError _ (Hole { hole_ty, hole_occ = rdr }) OutOfScopeHole + = out_of_scope_msg + where + herald | isDataOcc (rdrNameOcc rdr) = text "Data constructor not in scope:" + | otherwise = text "Variable not in scope:" + out_of_scope_msg -- Print v :: ty only if the type has structure + | boring_type = hang herald 2 (ppr rdr) + | otherwise = hang herald 2 (pp_rdr_with_type rdr hole_ty) + boring_type = isTyVarTy hole_ty +pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_skol_info) = + vcat [ hole_msg + , tyvars_msg + , case sort of { ExprHole {} -> expr_hole_hint; _ -> type_hole_hint } ] + + where + + hole_msg = case sort of + ExprHole {} -> + hang (text "Found hole:") + 2 (pp_rdr_with_type hole_occ hole_ty) + TypeHole -> + hang (text "Found type wildcard" <+> quotes (ppr hole_occ)) + 2 (text "standing for" <+> quotes pp_hole_type_with_kind) + ConstraintHole -> + hang (text "Found extra-constraints wildcard standing for") + 2 (quotes $ pprType hole_ty) -- always kind Constraint + + hole_kind = typeKind hole_ty + + pp_hole_type_with_kind + | isLiftedTypeKind hole_kind + || isEqPred hole_ty -- Don't print the kind of unlifted + -- equalities (#15039) + = pprType hole_ty + | otherwise + = pprType hole_ty <+> dcolon <+> pprKind hole_kind + + tyvars = tyCoVarsOfTypeList hole_ty + tyvars_msg = ppUnless (null tyvars) $ + text "Where:" <+> (vcat (map loc_msg other_tvs) + $$ pprSkols ctxt hole_skol_info) + -- Coercion variables can be free in the + -- hole, via kind casts + expr_hole_hint -- Give hint for, say, f x = _x + | lengthFS (occNameFS (rdrNameOcc hole_occ)) > 1 -- Don't give this hint for plain "_" + = text "Or perhaps" <+> quotes (ppr hole_occ) + <+> text "is mis-spelled, or not in scope" + | otherwise + = empty + + type_hole_hint + | ErrorWithoutFlag <- cec_type_holes ctxt + = text "To use the inferred type, enable PartialTypeSignatures" + | otherwise + = empty + + loc_msg tv + | isTyVar tv + = case tcTyVarDetails tv of + MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable" + _ -> empty -- Skolems dealt with already + | otherwise -- A coercion variable can be free in the hole type + = ppWhenOption sdocPrintExplicitCoercions $ + quotes (ppr tv) <+> text "is a coercion variable" + +pp_rdr_with_type :: RdrName -> Type -> SDoc +pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty) + +{- ********************************************************************* +* * + Outputting ScopeError messages +* * +**********************************************************************-} + +pprScopeError :: RdrName -> NotInScopeError -> SDoc +pprScopeError rdr_name scope_err = + case scope_err of + NotInScope -> + hang (text "Not in scope:") + 2 (what <+> quotes (ppr rdr_name)) + NotARecordField -> + hang (text "Not in scope:") + 2 (text "record field" <+> quotes (ppr rdr_name)) + NoExactName name -> + text "The Name" <+> quotes (ppr name) <+> text "is not in scope." + SameName gres -> + assertPpr (length gres >= 2) (text "pprScopeError SameName: fewer than 2 elements" $$ nest 2 (ppr gres)) + $ hang (text "Same Name in multiple name-spaces:") + 2 (vcat (map pp_one sorted_names)) + where + sorted_names = sortBy (leftmost_smallest `on` nameSrcSpan) + $ map greName gres + pp_one name + = hang (pprNameSpace (occNameSpace (getOccName name)) + <+> quotes (ppr name) <> comma) + 2 (text "declared at:" <+> ppr (nameSrcLoc name)) + MissingBinding sig _ -> + sep [ text "The" <+> pprSigLike sig + <+> text "for" <+> quotes (ppr rdr_name) + , nest 2 $ text "lacks an accompanying binding" ] + NoTopLevelBinding -> + hang (text "No top-level binding for") + 2 (what <+> quotes (ppr rdr_name) <+> text "in this module") + UnknownSubordinate parent_nm sub -> + quotes (ppr rdr_name) <+> text "is not a (visible)" <+> pprSubordinate parent_nm sub + NotInScopeTc env -> + vcat[text "GHC internal error:" <+> quotes (ppr rdr_name) <+> + text "is not in scope during type checking, but it passed the renamer", + text "tcl_env of environment:" <+> ppr env] + where + what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) + +scopeErrorHints :: NotInScopeError -> [GhcHint] +scopeErrorHints scope_err = + case scope_err of + NotInScope -> noHints + NotARecordField -> noHints + NoExactName {} -> [SuggestDumpSlices] + SameName {} -> [SuggestDumpSlices] + MissingBinding _ hints -> hints + NoTopLevelBinding -> noHints + UnknownSubordinate {} -> noHints + NotInScopeTc _ -> noHints + +tcSolverReportMsgHints :: SolverReportErrCtxt -> TcSolverReportMsg -> [GhcHint] +tcSolverReportMsgHints ctxt = \case + BadTelescope {} + -> noHints + UserTypeError {} + -> noHints + UnsatisfiableError {} + -> noHints + ReportHoleError {} + -> noHints + CannotUnifyVariable mismatch_msg rea + -> mismatchMsgHints ctxt mismatch_msg ++ cannotUnifyVariableHints rea + Mismatch { mismatchMsg = mismatch_msg } + -> mismatchMsgHints ctxt mismatch_msg + FixedRuntimeRepError {} + -> noHints + ExpectingMoreArguments {} + -> noHints + UnboundImplicitParams {} + -> noHints + AmbiguityPreventsSolvingCt {} + -> noHints + CannotResolveInstance {} + -> noHints + OverlappingInstances {} + -> noHints + UnsafeOverlap {} + -> noHints + MultiplicityCoercionsNotSupported {} + -> noHints + +mismatchMsgHints :: SolverReportErrCtxt -> MismatchMsg -> [GhcHint] +mismatchMsgHints ctxt msg = + maybeToList [ hint | (exp,act) <- mismatchMsg_ExpectedActuals msg + , hint <- suggestAddSig ctxt exp act ] + +mismatchMsg_ExpectedActuals :: MismatchMsg -> Maybe (Type, Type) +mismatchMsg_ExpectedActuals = \case + BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } -> + Just (exp, act) + TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } -> + Just (exp,act) + CouldNotDeduce { cnd_extra = cnd_extra } + | Just (CND_Extra _ exp act) <- cnd_extra + -> Just (exp, act) + | otherwise + -> Nothing + +cannotUnifyVariableHints :: CannotUnifyVariableReason -> [GhcHint] +cannotUnifyVariableHints = \case + CannotUnifyWithPolytype {} + -> noHints + OccursCheck {} + -> noHints + SkolemEscape {} + -> noHints + DifferentTyVars {} + -> noHints + RepresentationalEq {} + -> noHints + +suggestAddSig :: SolverReportErrCtxt -> TcType -> TcType -> Maybe GhcHint +-- See Note [Suggest adding a type signature] +suggestAddSig ctxt ty1 _ty2 + | bndr : bndrs <- inferred_bndrs + = Just $ SuggestAddTypeSignatures $ NamedBindings (bndr :| bndrs) + | otherwise + = Nothing + where + inferred_bndrs = + case getTyVar_maybe ty1 of + Just tv | isSkolemTyVar tv -> find (cec_encl ctxt) False tv + _ -> [] + + -- 'find' returns the binders of an InferSkol for 'tv', + -- provided there is an intervening implication with + -- ic_given_eqs /= NoGivenEqs (i.e. a GADT match) + find [] _ _ = [] + find (implic:implics) seen_eqs tv + | tv `elem` ic_skols implic + , InferSkol prs <- ic_info implic + , seen_eqs + = map fst prs + | otherwise + = find implics (seen_eqs || ic_given_eqs implic /= NoGivenEqs) tv + +{- Note [Suggest adding a type signature] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The OutsideIn algorithm rejects GADT programs that don't have a principal +type, and indeed some that do. Example: + data T a where + MkT :: Int -> T Int + + f (MkT n) = n + +Does this have type f :: T a -> a, or f :: T a -> Int? +The error that shows up tends to be an attempt to unify an +untouchable type variable. So suggestAddSig sees if the offending +type variable is bound by an *inferred* signature, and suggests +adding a declared signature instead. + +More specifically, we suggest adding a type sig if we have p ~ ty, and +p is a skolem bound by an InferSkol. Those skolems were created from +unification variables in simplifyInfer. Why didn't we unify? It must +have been because of an intervening GADT or existential, making it +untouchable. Either way, a type signature would help. For GADTs, it +might make it typeable; for existentials the attempt to write a +signature will fail -- or at least will produce a better error message +next time + +This initially came up in #8968, concerning pattern synonyms. +-} + +{- ********************************************************************* +* * + Outputting ImportError messages +* * +**********************************************************************-} + +instance Outputable ImportError where + ppr err = note $ case err of + MissingModule mod_name -> "No module named" <+> quoted mod_name <+> "is imported" + ModulesDoNotExport mods what_look occ_name + | mod NE.:| [] <- mods -> "The module" <+> quoted mod <+> "does not export" <+> what <+> quoted occ_name + | otherwise -> "Neither" <+> quotedListWithNor (map ppr $ NE.toList mods) <+> "export" <+> what <+> quoted occ_name + where + what :: SDoc + what = case what_look of + WL_ConLike -> text "data constructor" + WL_RecField -> text "record field" + _ -> empty + where + quoted :: Outputable a => a -> SDoc + quoted = quotes . ppr + +{- ********************************************************************* +* * + Suggested fixes for implication constraints +* * +**********************************************************************-} + +-- TODO: these functions should use GhcHint instead. + +show_fixes :: [SDoc] -> SDoc +show_fixes [] = empty +show_fixes (f:fs) = sep [ text "Possible fix:" + , nest 2 (vcat (f : map (text "or" <+>) fs))] + +ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc] +ctxtFixes has_ambig_tvs pred implics + | not has_ambig_tvs + , isTyVarClassPred pred -- Don't suggest adding (Eq T) to the context, say + , (skol:skols) <- usefulContext implics pred + , let what | null skols + , SigSkol (PatSynCtxt {}) _ _ <- skol + = text "\"required\"" + | otherwise + = empty + = [sep [ text "add" <+> pprParendType pred + <+> text "to the" <+> what <+> text "context of" + , nest 2 $ ppr_skol skol $$ + vcat [ text "or" <+> ppr_skol skol + | skol <- skols ] ] ] + | otherwise = [] + where + ppr_skol (PatSkol (RealDataCon dc) _) = text "the data constructor" <+> quotes (ppr dc) + ppr_skol (PatSkol (PatSynCon ps) _) = text "the pattern synonym" <+> quotes (ppr ps) + ppr_skol skol_info = ppr skol_info + +usefulContext :: [Implication] -> PredType -> [SkolemInfoAnon] +-- usefulContext picks out the implications whose context +-- the programmer might plausibly augment to solve 'pred' +usefulContext implics pred + = go implics + where + pred_tvs = tyCoVarsOfType pred + go [] = [] + go (ic : ics) + | implausible ic = rest + | otherwise = ic_info ic : rest + where + -- Stop when the context binds a variable free in the predicate + rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = [] + | otherwise = go ics + + implausible ic + | null (ic_skols ic) = True + | implausible_info (ic_info ic) = True + | otherwise = False + + implausible_info (SigSkol (InfSigCtxt {}) _ _) = True + implausible_info _ = False + -- Do not suggest adding constraints to an *inferred* type signature + +pp_from_givens :: [Implication] -> [SDoc] +pp_from_givens givens + = case givens of + [] -> [] + (g:gs) -> ppr_given (text "from the context:") g + : map (ppr_given (text "or from:")) gs + where + ppr_given herald implic@(Implic { ic_given = gs, ic_info = skol_info }) + = hang (herald <+> pprEvVarTheta (mkMinimalBySCs evVarPred gs)) + -- See Note [Suppress redundant givens during error reporting] + -- for why we use mkMinimalBySCs above. + 2 (sep [ text "bound by" <+> ppr skol_info + , text "at" <+> ppr (getCtLocEnvLoc (ic_env implic)) ]) + +{- ********************************************************************* +* * + CtOrigin information +* * +**********************************************************************-} + +levelString :: TypeOrKind -> String +levelString TypeLevel = "type" +levelString KindLevel = "kind" + +pprArising :: CtLoc -> SDoc +-- Used for the main, top-level error message +-- We've done special processing for TypeEq, KindEq, givens +pprArising ct_loc + | in_generated_code = empty -- See Note ["Arising from" messages in generated code] + | suppress_origin = empty + | otherwise = pprCtOrigin orig + where + orig = ctLocOrigin ct_loc + in_generated_code = ctLocEnvInGeneratedCode (ctLocEnv ct_loc) + suppress_origin + | isGivenOrigin orig = True + | otherwise = case orig of + TypeEqOrigin {} -> True -- We've done special processing + KindEqOrigin {} -> True -- for TypeEq, KindEq, givens + AmbiguityCheckOrigin {} -> True -- The "In the ambiguity check" context + -- is sufficient; more would be repetitive + _ -> False + +-- Add the "arising from..." part to a message +addArising :: CtLoc -> SDoc -> SDoc +addArising ct_loc msg = hang msg 2 (pprArising ct_loc) + +pprWithArising :: [Ct] -> SDoc +-- Print something like +-- (Eq a) arising from a use of x at y +-- (Show a) arising from a use of p at q +-- Also return a location for the error message +-- Works for Wanted/Derived only +pprWithArising [] + = panic "pprWithArising" +pprWithArising (ct:cts) + | null cts + = addArising loc (pprTheta [ctPred ct]) + | otherwise + = vcat (map ppr_one (ct:cts)) + where + loc = ctLoc ct + ppr_one ct' = hang (parens (pprType (ctPred ct'))) + 2 (pprCtLoc (ctLoc ct')) + +{- Note ["Arising from" messages in generated code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider code generated when we desugar code before typechecking; +see Note [Rebindable syntax and XXExprGhcRn]. + +In this code, constraints may be generated, but we don't want to +say "arising from a call of foo" if 'foo' doesn't appear in the +users code. We leave the actual CtOrigin untouched (partly because +it is generated in many, many places), but suppress the "Arising from" +message for constraints that originate in generated code. +-} + + +{- ********************************************************************* +* * + SkolemInfo +* * +**********************************************************************-} + + +tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo +tidySkolemInfo env (SkolemInfo u sk_anon) = SkolemInfo u (tidySkolemInfoAnon env sk_anon) + +---------------- +tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon +tidySkolemInfoAnon env (DerivSkol ty) = DerivSkol (tidyType env ty) +tidySkolemInfoAnon env (SigSkol cx ty tv_prs) = tidySigSkol env cx ty tv_prs +tidySkolemInfoAnon env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids) +tidySkolemInfoAnon env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty) +tidySkolemInfoAnon _ info = info + +tidySigSkol :: TidyEnv -> UserTypeCtxt + -> TcType -> [(Name,TcTyVar)] -> SkolemInfoAnon +-- We need to take special care when tidying SigSkol +-- See Note [SigSkol SkolemInfo] in "GHC.Tc.Types.Origin" +tidySigSkol env cx ty tv_prs + = SigSkol cx (tidy_ty env ty) tv_prs' + where + tv_prs' = mapSnd (tidyTyCoVarOcc env) tv_prs + inst_env = mkNameEnv tv_prs' + + tidy_ty env (ForAllTy (Bndr tv vis) ty) + = ForAllTy (Bndr tv' vis) (tidy_ty env' ty) + where + (env', tv') = tidy_tv_bndr env tv + + tidy_ty env ty@(FunTy { ft_mult = w, ft_arg = arg, ft_res = res }) + = -- Look under c => t and t1 -> t2 + ty { ft_mult = tidy_ty env w + , ft_arg = tidyType env arg + , ft_res = tidy_ty env res } + + tidy_ty env ty = tidyType env ty + + tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar) + tidy_tv_bndr env@(occ_env, subst) tv + | Just tv' <- lookupNameEnv inst_env (tyVarName tv) + = ((occ_env, extendVarEnv subst tv tv'), tv') + + | otherwise + = tidyVarBndr env tv + +pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc +pprSkols ctxt zonked_ty_vars + = + let tidy_ty_vars = map (bimap (tidySkolemInfoAnon (cec_tidy ctxt)) id) zonked_ty_vars + in vcat (map pp_one tidy_ty_vars) + where + + no_msg = text "No skolem info - we could not find the origin of the following variables" <+> ppr zonked_ty_vars + $$ text "This should not happen, please report it as a bug following the instructions at:" + $$ text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug" + + + pp_one (UnkSkol cs, tvs) + = vcat [ hang (pprQuotedList tvs) + 2 (is_or_are tvs "a" "(rigid, skolem)") + , nest 2 (text "of unknown origin") + , nest 2 (text "bound at" <+> ppr (skolsSpan tvs)) + , no_msg + , prettyCallStackDoc cs + ] + pp_one (RuntimeUnkSkol, tvs) + = hang (pprQuotedList tvs) + 2 (is_or_are tvs "an" "unknown runtime") + pp_one (skol_info, tvs) + = vcat [ hang (pprQuotedList tvs) + 2 (is_or_are tvs "a" "rigid" <+> text "bound by") + , nest 2 (pprSkolInfo skol_info) + , nest 2 (text "at" <+> ppr (skolsSpan tvs)) ] + + is_or_are [_] article adjective = text "is" <+> text article <+> text adjective + <+> text "type variable" + is_or_are _ _ adjective = text "are" <+> text adjective + <+> text "type variables" + +skolsSpan :: [TcTyVar] -> SrcSpan +skolsSpan skol_tvs = foldr1WithDefault noSrcSpan combineSrcSpans (map getSrcSpan skol_tvs) + +{- ********************************************************************* +* * + Utilities for expected/actual messages +* * +**********************************************************************-} + +mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind + -> Type -> Type -> CtOrigin -> SDoc +mk_supplementary_ea_msg ctxt level ty1 ty2 orig + | TypeEqOrigin { uo_expected = exp, uo_actual = act } <- orig + , not (ea_looks_same ty1 ty2 exp act) + = case mk_ea_msg ctxt Nothing level orig of + Left infos -> vcat $ map (pprExpectedActualInfo ctxt) infos + Right msg -> msg + | otherwise + = empty + +ea_looks_same :: Type -> Type -> Type -> Type -> Bool +-- True if the faulting types (ty1, ty2) look the same as +-- the expected/actual types (exp, act). +-- If so, we don't want to redundantly report the latter +ea_looks_same ty1 ty2 exp act + = (act `looks_same` ty1 && exp `looks_same` ty2) || + (exp `looks_same` ty1 && act `looks_same` ty2) + where + looks_same t1 t2 = t1 `pickyEqType` t2 + || t1 `eqType` liftedTypeKind && t2 `eqType` liftedTypeKind + -- pickyEqType is sensitive to synonyms, so only replies True + -- when the types really look the same. However, + -- (TYPE 'LiftedRep) and Type both print the same way. + +mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind + -> CtOrigin -> Either [ExpectedActualInfo] SDoc +-- Constructs a "Couldn't match" message +-- The (Maybe ErrorItem) says whether this is the main top-level message (Just) +-- or a supplementary message (Nothing) +mk_ea_msg ctxt at_top level + (TypeEqOrigin { uo_actual = act, uo_expected = exp, uo_thing = mb_thing }) + | Just thing <- mb_thing + , KindLevel <- level + = Right $ pprKindMismatchMsg thing exp act + | Just item <- at_top + , let ea = EA $ if expanded_syns then Just ea_expanded else Nothing + mismatch = mkBasicMismatchMsg ea item exp act + = Right (pprMismatchMsg ctxt mismatch) + | otherwise + = Left $ + if expanded_syns + then [ea,ea_expanded] + else [ea] + + where + ea = ExpectedActual { ea_expected = exp, ea_actual = act } + ea_expanded = + ExpectedActualAfterTySynExpansion + { ea_expanded_expected = expTy1 + , ea_expanded_actual = expTy2 } + + expanded_syns = cec_expand_syns ctxt + && not (expTy1 `pickyEqType` exp && expTy2 `pickyEqType` act) + (expTy1, expTy2) = expandSynonymsToMatch exp act +mk_ea_msg _ _ _ _ = Left [] + +{- Note [Expanding type synonyms to make types similar] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In type error messages, if -fprint-expanded-types is used, we want to expand +type synonyms to make expected and found types as similar as possible, but we +shouldn't expand types too much to make type messages even more verbose and +harder to understand. The whole point here is to make the difference in expected +and found types clearer. + +`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms +only as much as necessary. Given two types t1 and t2: + + * If they're already same, it just returns the types. + + * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are + type constructors), it expands C1 and C2 if they're different type synonyms. + Then it recursively does the same thing on expanded types. If C1 and C2 are + same, then it applies the same procedure to arguments of C1 and arguments of + C2 to make them as similar as possible. + + Most important thing here is to keep number of synonym expansions at + minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3, + Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and + `T (T3, T3, Bool)`. + + * Otherwise types don't have same shapes and so the difference is clearly + visible. It doesn't do any expansions and show these types. + +Note that we only expand top-layer type synonyms. Only when top-layer +constructors are the same we start expanding inner type synonyms. + +Suppose top-layer type synonyms of t1 and t2 can expand N and M times, +respectively. If their type-synonym-expanded forms will meet at some point (i.e. +will have same shapes according to `sameShapes` function), it's possible to find +where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M)) +comparisons. We first collect all the top-layer expansions of t1 and t2 in two +lists, then drop the prefix of the longer list so that they have same lengths. +Then we search through both lists in parallel, and return the first pair of +types that have same shapes. Inner types of these two types with same shapes +are then expanded using the same algorithm. + +In case they don't meet, we return the last pair of types in the lists, which +has top-layer type synonyms completely expanded. (in this case the inner types +are not expanded at all, as the current form already shows the type error) +-} + +-- | Expand type synonyms in given types only enough to make them as similar as +-- possible. Returned types are the same in terms of used type synonyms. +-- +-- To expand all synonyms, see 'Type.expandTypeSynonyms'. +-- +-- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for +-- some examples of how this should work. +expandSynonymsToMatch :: Type -> Type -> (Type, Type) +expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret) + where + (ty1_ret, ty2_ret) = go ty1 ty2 + + -- Returns (type synonym expanded version of first type, + -- type synonym expanded version of second type) + go :: Type -> Type -> (Type, Type) + go t1 t2 + | t1 `pickyEqType` t2 = + -- Types are same, nothing to do + (t1, t2) + + go (TyConApp tc1 tys1) (TyConApp tc2 tys2) + | tc1 == tc2 + , tys1 `equalLength` tys2 = + -- Type constructors are same. They may be synonyms, but we don't + -- expand further. The lengths of tys1 and tys2 must be equal; + -- for example, with type S a = a, we don't want + -- to zip (S Monad Int) and (S Bool). + let (tys1', tys2') = unzip (zipWithEqual go tys1 tys2) + in (TyConApp tc1 tys1', TyConApp tc2 tys2') + + go (AppTy t1_1 t1_2) (AppTy t2_1 t2_2) = + let (t1_1', t2_1') = go t1_1 t2_1 + (t1_2', t2_2') = go t1_2 t2_2 + in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2') + + go ty1@(FunTy _ w1 t1_1 t1_2) ty2@(FunTy _ w2 t2_1 t2_2) | w1 `eqType` w2 = + let (t1_1', t2_1') = go t1_1 t2_1 + (t1_2', t2_2') = go t1_2 t2_2 + in ( ty1 { ft_arg = t1_1', ft_res = t1_2' } + , ty2 { ft_arg = t2_1', ft_res = t2_2' }) + + go (ForAllTy b1 t1) (ForAllTy b2 t2) = + -- NOTE: We may have a bug here, but we just can't reproduce it easily. + -- See D1016 comments for details and our attempts at producing a test + -- case. Short version: We probably need RnEnv2 to really get this right. + let (t1', t2') = go t1 t2 + in (ForAllTy b1 t1', ForAllTy b2 t2') + + go (CastTy ty1 _) ty2 = go ty1 ty2 + go ty1 (CastTy ty2 _) = go ty1 ty2 + + go t1 t2 = + -- See Note [Expanding type synonyms to make types similar] for how this + -- works + let + t1_exp_tys = t1 : tyExpansions t1 + t2_exp_tys = t2 : tyExpansions t2 + t1_exps = length t1_exp_tys + t2_exps = length t2_exp_tys + dif = abs (t1_exps - t2_exps) + in + followExpansions $ + zipEqual + (if t1_exps > t2_exps then drop dif t1_exp_tys else t1_exp_tys) + (if t2_exps > t1_exps then drop dif t2_exp_tys else t2_exp_tys) + + -- Expand the top layer type synonyms repeatedly, collect expansions in a + -- list. The list does not include the original type. + -- + -- Example, if you have: + -- + -- type T10 = T9 + -- type T9 = T8 + -- ... + -- type T0 = Int + -- + -- `tyExpansions T10` returns [T9, T8, T7, ..., Int] + -- + -- This only expands the top layer, so if you have: + -- + -- type M a = Maybe a + -- + -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded) + tyExpansions :: Type -> [Type] + tyExpansions = unfoldr (\t -> (\x -> (x, x)) `fmap` coreView t) + + -- Drop the type pairs until types in a pair look alike (i.e. the outer + -- constructors are the same). + followExpansions :: [(Type, Type)] -> (Type, Type) + followExpansions [] = pprPanic "followExpansions" empty + followExpansions [(t1, t2)] + | sameShapes t1 t2 = go t1 t2 -- expand subtrees + | otherwise = (t1, t2) -- the difference is already visible + followExpansions ((t1, t2) : tss) + -- Traverse subtrees when the outer shapes are the same + | sameShapes t1 t2 = go t1 t2 + -- Otherwise follow the expansions until they look alike + | otherwise = followExpansions tss + + sameShapes :: Type -> Type -> Bool + sameShapes AppTy{} AppTy{} = True + sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2 + sameShapes (FunTy {}) (FunTy {}) = True + sameShapes (ForAllTy {}) (ForAllTy {}) = True + sameShapes (CastTy ty1 _) ty2 = sameShapes ty1 ty2 + sameShapes ty1 (CastTy ty2 _) = sameShapes ty1 ty2 + sameShapes _ _ = False + +{- +************************************************************************ +* * +\subsection{Contexts for renaming errors} +* * +************************************************************************ +-} + +inHsDocContext :: HsDocContext -> SDoc +inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt + +pprHsDocContext :: HsDocContext -> SDoc +pprHsDocContext (GenericCtx doc) = doc +pprHsDocContext (TypeSigCtx vs) = text "the type signature for" <+> ppr_sig_bndrs vs +pprHsDocContext (StandaloneKindSigCtx v)= text "the standalone kind signature for" <+> quotes (ppr v) +pprHsDocContext PatCtx = text "a pattern type-signature" +pprHsDocContext SpecInstSigCtx = text "a SPECIALISE instance pragma" +pprHsDocContext DefaultDeclCtx = text "a `default' declaration" +pprHsDocContext DerivDeclCtx = text "a deriving declaration" +pprHsDocContext (RuleCtx name) = text "the rewrite rule" <+> doubleQuotes (ftext name) +pprHsDocContext (SpecECtx name) = text "the SPECIALISE pragma for" <+> quotes (ppr name) +pprHsDocContext (TyDataCtx tycon) = text "the data type declaration for" <+> quotes (ppr tycon) +pprHsDocContext (FamPatCtx tycon) = text "a type pattern of family instance for" <+> quotes (ppr tycon) +pprHsDocContext (TySynCtx name) = text "the declaration for type synonym" <+> quotes (ppr name) +pprHsDocContext (TyFamilyCtx name) = text "the declaration for type family" <+> quotes (ppr name) +pprHsDocContext (ClassDeclCtx name) = text "the declaration for class" <+> quotes (ppr name) +pprHsDocContext ExprWithTySigCtx = text "an expression type signature" +pprHsDocContext TypBrCtx = text "a Template-Haskell quoted type" +pprHsDocContext HsTypeCtx = text "a type argument" +pprHsDocContext HsTypePatCtx = text "a type argument in a pattern" +pprHsDocContext GHCiCtx = text "GHCi input" +pprHsDocContext (SpliceTypeCtx hs_ty) = text "the spliced type" <+> quotes (ppr hs_ty) +pprHsDocContext ReifyInstancesCtx = text "GHC.Tc.Gen.Splice.reifyInstances" +pprHsDocContext (ClassInstanceCtx inst_ty) = + text "the instance declaration for" <+> quotes (ppr inst_ty) +pprHsDocContext (ClassMethodSigCtx name) = text "a class method signature for" <+> quotes (ppr name) +pprHsDocContext (SpecialiseSigCtx name) = text "a SPECIALISE signature for" <+> quotes (ppr name) +pprHsDocContext (PatSynSigCtx vs) = + text "a pattern synonym signature for" <+> ppr_sig_bndrs vs + +pprHsDocContext (ForeignDeclCtx name) + = text "the foreign declaration for" <+> quotes (ppr name) +pprHsDocContext (ConDeclCtx [name]) + = text "the definition of data constructor" <+> quotes (ppr name) +pprHsDocContext (ConDeclCtx names) + = text "the definition of data constructors" <+> interpp'SP names + +ppr_sig_bndrs :: [LocatedN RdrName] -> SDoc +ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs) + +pprConversionFailReason :: ConversionFailReason -> SDoc +pprConversionFailReason = \case + IllegalOccName ctxt_ns occ -> + text "Illegal" <+> pprNameSpace ctxt_ns + <+> text "name:" <+> quotes (text occ) + SumAltArityExceeded alt arity -> + text "Sum alternative" <+> int alt + <+> text "exceeds its arity," <+> int arity + IllegalSumAlt alt -> + vcat [ text "Illegal sum alternative:" <+> int alt + , nest 2 $ text "Sum alternatives must start from 1" ] + IllegalSumArity arity -> + vcat [ text "Illegal sum arity:" <+> int arity + , nest 2 $ text "Sums must have an arity of at least 2" ] + MalformedType typeOrKind ty -> + text "Malformed " <> text ty_str <+> text (show ty) + where ty_str = case typeOrKind of + TypeLevel -> "type" + KindLevel -> "kind" + IllegalLastStatement do_or_lc stmt -> + vcat [ text "Illegal last statement of" <+> pprAHsDoFlavour do_or_lc <> colon + , nest 2 $ ppr stmt + , text "(It should be an expression.)" ] + KindSigsOnlyAllowedOnGADTs -> + text "Kind signatures are only allowed on GADTs" + IllegalDeclaration declDescr bad_decls -> + sep [ text "Illegal" <+> what <+> text "in" <+> descrDoc <> colon + , nest 2 bads ] + where + (what, bads) = case bad_decls of + IllegalDecls (NE.toList -> decls) -> + (text "declaration" <> plural decls, vcat $ map ppr decls) + IllegalFamDecls (NE.toList -> decls) -> + ( text "family declaration" <> plural decls, vcat $ map ppr decls) + descrDoc = text $ case declDescr of + InstanceDecl -> "an instance declaration" + WhereClause -> "a where clause" + LetBinding -> "a let expression" + LetExpression -> "a let expression" + ClssDecl -> "a class declaration" + CannotMixGADTConsWith98Cons -> + text "Cannot mix GADT constructors with Haskell 98" + <+> text "constructors" + EmptyStmtListInDoBlock -> + text "Empty stmt list in do-block" + NonVarInInfixExpr -> + text "Non-variable expression is not allowed in an infix expression" + MultiWayIfWithoutAlts -> + text "Multi-way if-expression with no alternatives" + CasesExprWithoutAlts -> + text "\\cases expression with no alternatives" + ImplicitParamsWithOtherBinds -> + text "Implicit parameters mixed with other bindings" + InvalidCCallImpent from -> + text (show from) <+> text "is not a valid ccall impent" + RecGadtNoCons -> + quotes (text "RecGadtC") <+> text "must have at least one constructor name" + GadtNoCons -> + quotes (text "GadtC") <+> text "must have at least one constructor name" + InvalidTypeInstanceHeader tys -> + text "Invalid type instance header:" + <+> text (show tys) + InvalidTyFamInstLHS lhs -> + text "Invalid type family instance LHS:" + <+> text (show lhs) + InvalidImplicitParamBinding -> + text "Implicit parameter binding only allowed in let or where" + DefaultDataInstDecl adts -> + (text "Default data instance declarations" + <+> text "are not allowed:") + $$ ppr adts + FunBindLacksEquations nm -> + text "Function binding for" + <+> quotes (text (TH.pprint nm)) + <+> text "has no equations" + EmptyGuard -> + text "Empty guard" + EmptyParStmt -> + text "Empty par stmt" + +pprTyThingUsedWrong :: WrongThingSort -> TcTyThing -> Name -> SDoc +pprTyThingUsedWrong sort thing name = + pprTcTyThingCategory thing <+> quotes (ppr name) <+> + text "used as a" <+> pprWrongThingSort sort + +pprWrongThingSort :: WrongThingSort -> SDoc +pprWrongThingSort = + text . \case + WrongThingType -> "type" + WrongThingDataCon -> "data constructor" + WrongThingPatSyn -> "pattern synonym" + WrongThingConLike -> "constructor-like thing" + WrongThingClass -> "class" + WrongThingTyCon -> "type constructor" + WrongThingAxiom -> "axiom" + +pprLevelCheckReason :: LevelCheckReason -> SDoc +pprLevelCheckReason = \case + LevelCheckInstance _ t -> + text "instance for" <+> quotes (ppr t) + LevelCheckSplice t _ -> + quotes (ppr t) + +pprUninferrableTyVarCtx :: UninferrableTyVarCtx -> SDoc +pprUninferrableTyVarCtx = \case + UninfTyCtx_ClassContext theta -> + sep [ text "the class context:", pprTheta theta ] + UninfTyCtx_DataContext theta -> + sep [ text "the datatype context:", pprTheta theta ] + UninfTyCtx_ProvidedContext theta -> + sep [ text "the provided context:" , pprTheta theta ] + UninfTyCtx_TyFamRhs rhs_ty -> + sep [ text "the type family equation right-hand side:" , ppr rhs_ty ] + UninfTyCtx_TySynRhs rhs_ty -> + sep [ text "the type synonym right-hand side:" , ppr rhs_ty ] + UninfTyCtx_Sig exp_kind full_hs_ty -> + hang (text "the kind" <+> ppr exp_kind) 2 + (text "of the type signature:" <+> ppr full_hs_ty) + +pprPatSynInvalidRhsReason :: PatSynInvalidRhsReason -> SDoc +pprPatSynInvalidRhsReason = \case + PatSynNotInvertible p -> + text "Pattern" <+> quotes (ppr p) <+> text "is not invertible" + PatSynUnboundVar var -> + quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym" + +pprBadFieldAnnotationReason :: BadFieldAnnotationReason -> SDoc +pprBadFieldAnnotationReason = \case + LazyFieldsDisabled -> + text "Lazy field annotations (~) are disabled" + UnpackWithoutStrictness -> + text "UNPACK pragma lacks '!'" + UnusableUnpackPragma -> + text "Ignoring unusable UNPACK pragma" + +pprSuperclassCycleDetail :: SuperclassCycleDetail -> SDoc +pprSuperclassCycleDetail = \case + SCD_HeadTyVar pred -> + hang (text "one of whose superclass constraints is headed by a type variable:") + 2 (quotes (ppr pred)) + SCD_HeadTyFam pred -> + hang (text "one of whose superclass constraints is headed by a type family:") + 2 (quotes (ppr pred)) + SCD_Superclass cls -> + text "one of whose superclasses is" <+> quotes (ppr cls) + +pprRoleValidationFailedReason :: Role -> RoleValidationFailedReason -> SDoc +pprRoleValidationFailedReason role = \case + TyVarRoleMismatch tv role' -> + text "type variable" <+> quotes (ppr tv) <+> + text "cannot have role" <+> ppr role <+> + text "because it was assigned role" <+> ppr role' + TyVarMissingInEnv tv -> + text "type variable" <+> quotes (ppr tv) <+> text "missing in environment" + BadCoercionRole co -> + text "coercion" <+> ppr co <+> text "has bad role" <+> ppr role + +pprDisabledClassExtension :: Class -> DisabledClassExtension -> SDoc +pprDisabledClassExtension cls = \case + MultiParamDisabled n -> + text howMany <+> text "parameters for class" <+> quotes (ppr cls) + where + howMany | n == 0 = "No" + | otherwise = "Too many" + FunDepsDisabled -> + text "Fundeps in class" <+> quotes (ppr cls) + ConstrainedClassMethodsDisabled sel_id pred -> + vcat [ hang (text "Constraint" <+> quotes (ppr pred) + <+> text "in the type of" <+> quotes (ppr sel_id)) + 2 (text "constrains only the class type variables")] + +pprImportLookup :: ImportLookupReason -> SDoc +pprImportLookup = \case + ImportLookupBad k iface decl_spec ie _exts -> + let + pprImpDeclSpec :: ModIface -> ImpDeclSpec -> SDoc + pprImpDeclSpec iface decl_spec = + quotes (ppr (moduleName $ is_mod decl_spec)) <+> case mi_boot iface of + IsBoot -> text "(hi-boot interface)" + NotBoot -> empty + withContext msgs = + hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) + 2 (vcat msgs) + in case k of + BadImportNotExported _ -> + vcat + [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> + text "does not export" <+> quotes (ppr ie) <> dot + ] + BadImportAvailVar -> + withContext + [ text "an item called" + <+> quotes val <+> text "is exported, but it is not a type." + ] + where + val_occ = rdrNameOcc $ ieName ie + val = parenSymOcc val_occ (ppr val_occ) + BadImportAvailTyCon {} -> + withContext + [ text "an item called" + <+> quotes tycon <+> text "is exported, but it is a type." + ] + where + tycon_occ = rdrNameOcc $ ieName ie + tycon = parenSymOcc tycon_occ (ppr tycon_occ) + BadImportNotExportedSubordinates gre unavailable1 -> + withContext + [ what <+> text "called" <+> parent_name <+> text "is exported, but it does not export" + , text "any" <+> what_children <+> text "called" <+> unavailable_names <> dot + ] + where + unavailable = NE.toList unavailable1 + parent_name = (quotes . pprPrefixOcc . nameOccName . gre_name) gre + unavailable_names = pprWithCommas (quotes . ppr) unavailable + any_names p = any (p . unpackFS) unavailable + what = case greInfo gre of + IAmTyCon ClassFlavour -> text "a class" + IAmTyCon _ -> text "a data type" + _ -> text "an item" + what_children = unquotedListWith "or" $ case greInfo gre of + IAmTyCon ClassFlavour -> + [text "class methods" | any_names okVarOcc ] ++ + [text "associated types" | any_names okTcOcc ] + IAmTyCon _ -> + [text "constructors" | any_names okConOcc ] ++ + [text "record fields" | any_names okVarOcc ] + _ -> [text "children"] + BadImportNonTypeSubordinates gre nontype1 -> + withContext + [ what <+> text "called" <+> parent_name <+> text "is exported," + , sep [ text "but its subordinate item" <> plural nontype <+> nontype_names + , isOrAre nontype <+> "not in the type namespace." ] ] + where + nontype = NE.toList nontype1 + parent_name = (quotes . pprPrefixOcc . nameOccName . gre_name) gre + nontype_names = pprWithCommas (quotes . pprPrefixOcc . nameOccName . gre_name) nontype + what = case greInfo gre of + IAmTyCon ClassFlavour -> text "a class" + IAmTyCon _ -> text "a data type" + _ -> text "an item" + BadImportNonDataSubordinates gre nondata1 -> + withContext + [ what <+> text "called" <+> parent_name <+> text "is exported," + , sep [ text "but its subordinate item" <> plural nondata <+> nondata_names + , isOrAre nondata <+> "not in the data namespace." ] ] + where + nondata = NE.toList nondata1 + parent_name = (quotes . pprPrefixOcc . nameOccName . gre_name) gre + nondata_names = pprWithCommas (quotes . pprPrefixOcc . nameOccName . gre_name) nondata + what = case greInfo gre of + IAmTyCon ClassFlavour -> text "a class" + IAmTyCon _ -> text "a data type" + _ -> text "an item" + BadImportAvailDataCon dataType_occ -> + withContext + [ text "an item called" <+> quotes datacon + , text "is exported, but it is a data constructor of" + , quotes dataType <> dot + ] + where + datacon_occ = rdrNameOcc $ ieName ie + datacon = parenSymOcc datacon_occ (ppr datacon_occ) + dataType = parenSymOcc dataType_occ (ppr dataType_occ) + ImportLookupQualified rdr -> + hang (text "Illegal qualified name in import item:") + 2 (ppr rdr) + ImportLookupIllegal -> + text "Illegal import item" + ImportLookupAmbiguous rdr gres -> + hang (text "Ambiguous name" <+> quotes (ppr rdr) <+> text "in import item. It could refer to:") + 2 (vcat (map (ppr . greOccName) gres)) + +pprUnusedImport :: ImportDecl GhcRn -> UnusedImportReason -> SDoc +pprUnusedImport decl = \case + UnusedImportNone -> + vcat [ pp_herald <+> quotes pp_mod <+> text "is redundant" + , nest 2 (text "except perhaps to import instances from" + <+> quotes pp_mod) + , text "To import instances alone, use:" + <+> text "import" <+> pp_mod <> parens empty ] + UnusedImportSome sort_unused -> + sep [ pp_herald <+> quotes (pprWithCommas pp_unused sort_unused) + , text "from module" <+> quotes pp_mod <+> text "is redundant"] + where + pp_mod = ppr (unLoc (ideclName decl)) + pp_herald = text "The" <+> pp_qual <+> text "import of" + pp_qual + | isImportDeclQualified (ideclQualified decl) = text "qualified" + | otherwise = empty + pp_unused = \case + UnusedImportNameRegular n -> + pprNameUnqualified n + UnusedImportNameRecField par fld_occ -> + case par of + ParentIs p -> pprNameUnqualified p <> parens (ppr fld_occ) + NoParent -> ppr fld_occ + +pprUnusedName :: OccName -> UnusedNameProv -> SDoc +pprUnusedName name reason = + sep [ msg <> colon + , nest 2 $ pprNonVarNameSpace (occNameSpace name) + <+> quotes (ppr name)] + where + msg = case reason of + UnusedNameTopDecl -> + defined + UnusedNameImported mod -> + text "Imported from" <+> quotes (ppr mod) <+> text "but not used" + UnusedNameTypePattern -> + defined <+> text "on the right hand side" + UnusedNameMatch -> + defined + UnusedNameLocalBind -> + defined + defined = text "Defined but not used" + +-- When printing the name, take care to qualify it in the same +-- way as the provenance reported by pprNameProvenance, namely +-- the head of 'gre_imp'. Otherwise we get confusing reports like +-- Ambiguous occurrence ‘null’ +-- It could refer to either ‘T15487a.null’, +-- imported from ‘Prelude’ at T15487.hs:1:8-13 +-- or ... +-- See #15487 +pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc +pprAmbiguousGreName gre_env gre + | IAmRecField fld_info <- greInfo gre + = sep [ text "the field" <+> quotes (ppr occ) <+> parent_info fld_info <> comma + , pprNameProvenance gre ] + | otherwise + = sep [ quotes (pp_qual <> dot <> ppr occ) <> comma + , pprNameProvenance gre ] + + where + occ = greOccName gre + parent_info fld_info = + case first_con of + PatSynName ps -> text "of pattern synonym" <+> quotes (ppr ps) + DataConName {} -> + case greParent gre of + ParentIs par + -- For a data family, only reporting the family TyCon can be + -- unhelpful (see T23301). So we give a bit of additional + -- info in that case. + | Just par_gre <- lookupGRE_Name gre_env par + , IAmTyCon tc_flav <- greInfo par_gre + , OpenFamilyFlavour (IAmData {}) _ <- tc_flav + -> vcat [ ppr_cons + , text "in a data family instance of" <+> quotes (ppr par) ] + | otherwise + -> text "of record" <+> quotes (ppr par) + NoParent -> ppr_cons + where + cons :: [ConLikeName] + cons = nonDetEltsUniqSet $ recFieldCons fld_info + first_con :: ConLikeName + first_con = head cons + ppr_cons :: SDoc + ppr_cons = hsep [ text "belonging to data constructor" + , quotes (ppr $ nameOccName $ conLikeName_Name first_con) + , if length cons > 1 then parens (text "among others") else empty + ] + pp_qual + | gre_lcl gre + = ppr (nameModule $ greName gre) + | Just imp <- headMaybe $ gre_imp gre + -- This 'imp' is the one that + -- pprNameProvenance chooses + , ImpDeclSpec { is_as = mod } <- is_decl imp + = ppr mod + | otherwise + = pprPanic "addNameClassErrRn" (ppr gre) + -- Invariant: either 'lcl' is True or 'iss' is non-empty + +pprNonCanonicalDefinition :: LHsSigType GhcRn + -> NonCanonicalDefinition + -> SDoc +pprNonCanonicalDefinition inst_ty = \case + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> + msg1 "(<>)" "mappend" + NonCanonical_Mappend -> + msg2 "mappend" "(<>)" + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> + msg1 "pure" "return" + NonCanonical_ThenA -> + msg1 "(*>)" "(>>)" + NonCanonical_Return -> + msg2 "return" "pure" + NonCanonical_ThenM -> + msg2 "(>>)" "(*>)" + where + msg1 :: String -> String -> SDoc + msg1 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text (lhs ++ " = " ++ rhs)) <+> + text "definition detected" + , inst + ] + + msg2 :: String -> String -> SDoc + msg2 lhs rhs = + vcat [ text "Noncanonical" <+> + quotes (text lhs) <+> + text "definition detected" + , inst + , quotes (text lhs) <+> + text "will eventually be removed in favour of" <+> + quotes (text rhs) + ] + + inst = instDeclCtxt1 inst_ty + + -- stolen from GHC.Tc.TyCl.Instance + instDeclCtxt1 :: LHsSigType GhcRn -> SDoc + instDeclCtxt1 hs_inst_ty + = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + + inst_decl_ctxt :: SDoc -> SDoc + inst_decl_ctxt doc = hang (text "in the instance declaration for") + 2 (quotes doc <> text ".") + +suggestNonCanonicalDefinition :: NonCanonicalDefinition -> [GhcHint] +suggestNonCanonicalDefinition reason = + [action doc] + where + action = case reason of + NonCanonicalMonoid sub -> case sub of + NonCanonical_Sappend -> move sappendName mappendName + NonCanonical_Mappend -> remove mappendName sappendName + NonCanonicalMonad sub -> case sub of + NonCanonical_Pure -> move pureAName returnMName + NonCanonical_ThenA -> move thenAName thenMName + NonCanonical_Return -> remove returnMName pureAName + NonCanonical_ThenM -> remove thenMName thenAName + + move = SuggestMoveNonCanonicalDefinition + remove = SuggestRemoveNonCanonicalDefinition + + doc = case reason of + NonCanonicalMonoid _ -> doc_monoid + NonCanonicalMonad _ -> doc_monad + + doc_monoid = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/semigroup-monoid" + doc_monad = + "https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/monad-of-no-return" + +suggestDefaultDeclaration :: Class-> [Type] -> [[Type]] -> [GhcHint] +suggestDefaultDeclaration cls prefix seqs = + [SuggestDefaultDeclaration cls $ supersequence (prefix : seqs)] + where + -- Not exactly the shortest possible supersequence, but it preserves + -- the head sequence as the prefix of the result which is a requirement. + supersequence :: [[Type]] -> [Type] + supersequence [] = [] + supersequence ([] : seqs) = supersequence seqs + supersequence ((x : xs) : seqs) = + x : supersequence (xs : (dropHead x <$> seqs)) + dropHead x ys@(y : ys') + | tcEqType x y = ys' + | otherwise = ys + dropHead _ [] = [] + +-------------------------------------------------------------------------------- +-- hs-boot mismatch errors + +pprBootMismatch :: HsBootOrSig -> BootMismatch -> SDoc +pprBootMismatch boot_or_sig = \case + MissingBootThing nm err -> + let def_or_exp = case err of + MissingBootDefinition -> text "defined in" + MissingBootExport -> text "exported by" + in quotes (ppr nm) <+> text "is exported by the" + <+> ppr_boot_or_sig <> comma + <+> text "but not" + <+> def_or_exp <+> text "the implementing module." + MissingBootInstance boot_dfun -> + hang (text "instance" <+> ppr (idType boot_dfun)) + 2 (text "is defined in the" <+> ppr ppr_boot_or_sig <> comma <+> + text "but not in the implementing module.") + BadReexportedBootThing name name' -> + withUserStyle alwaysQualify AllTheWay $ vcat + [ text "The" <+> ppr_boot_or_sig + <+> text "(re)exports" <+> quotes (ppr name) + , text "but the implementing module exports a different identifier" <+> quotes (ppr name') + ] + BootMismatch boot_thing real_thing err -> + vcat + [ ppr real_thing <+> + text "has conflicting definitions in the module" + , text "and its" <+> ppr_boot_or_sig <> dot, + text "Main module:" <+> real_doc + , (case boot_or_sig of + HsBoot -> text " Boot file:" + Hsig -> text " Hsig file:") <+> boot_doc + , pprBootMismatchWhat boot_or_sig err + ] + where + to_doc + = pprTyThingInContext $ + showToHeader + { ss_forall = + case boot_or_sig of + HsBoot -> ShowForAllMust + Hsig -> ShowForAllWhen } + + real_doc = to_doc real_thing + boot_doc = to_doc boot_thing + + where + ppr_boot_or_sig = case boot_or_sig of + HsBoot -> text "hs-boot file" + Hsig -> text "hsig file" + + +pprBootMismatchWhat :: HsBootOrSig -> BootMismatchWhat -> SDoc +pprBootMismatchWhat boot_or_sig = \case + BootMismatchedIdTypes {} -> + text "The two types are different." + BootMismatchedTyCons tc1 tc2 errs -> + vcat $ map (pprBootTyConMismatch boot_or_sig tc1 tc2) (NE.toList errs) + +pprBootTyConMismatch :: HsBootOrSig -> TyCon -> TyCon + -> BootTyConMismatch -> SDoc +pprBootTyConMismatch boot_or_sig tc1 tc2 = \case + TyConKindMismatch -> + text "The types have different kinds." + TyConRoleMismatch sub_type -> + if sub_type + then + text "The roles are not compatible:" $$ + text "Main module:" <+> ppr (tyConRoles tc1) $$ + text " Hsig file:" <+> ppr (tyConRoles tc2) + else + text "The roles do not match." $$ + if boot_or_sig == HsBoot + then note $ "Roles on abstract types default to" <+> quotes "representational" <+> "in hs-boot files" + else empty + TyConSynonymMismatch {} -> empty -- nothing interesting to say + TyConFlavourMismatch fam_flav1 fam_flav2 -> + whenPprDebug $ + text "Family flavours" <+> ppr fam_flav1 <+> text "and" <+> ppr fam_flav2 <+> + text "do not match" + TyConAxiomMismatch ax_errs -> + pprBootListMismatches (text "Type family equations do not match:") + pprTyConAxiomMismatch ax_errs + TyConInjectivityMismatch {} -> + text "Injectivity annotations do not match" + TyConMismatchedClasses _ _ err -> + pprBootClassMismatch boot_or_sig err + TyConMismatchedData _rhs1 _rhs2 err -> + pprBootDataMismatch err + SynAbstractData err -> + pprSynAbstractDataError err + TyConsVeryDifferent -> + empty -- should be obvious to the user what the problem is + +pprSynAbstractDataError :: SynAbstractDataError -> SDoc +pprSynAbstractDataError = \case + SynAbsDataTySynNotNullary -> + text "Illegal parameterized type synonym in implementation of abstract data." + SynAbstractDataInvalidRHS bad_sub_tys -> + let msgs = mapMaybe pprInvalidAbstractSubTy (NE.toList bad_sub_tys) + in case msgs of + [] -> herald <> dot + msg:[] -> hang (herald <> colon) + 2 msg + _ -> hang (herald <> colon) + 2 (vcat $ map (<+> bullet) msgs) + + where + herald = text "Illegal implementation of abstract data" + pprInvalidAbstractSubTy = \case + TyConApp tc _ + -> assertPpr (isTypeFamilyTyCon tc) (ppr tc) $ + Just $ text "Invalid type family" <+> quotes (ppr tc) <> dot + ty@(ForAllTy {}) + -> Just $ text "Invalid polymorphic type" <> colon <+> ppr ty <> dot + ty@(FunTy af _ _ _) + | not (af == FTF_T_T) + -> Just $ text "Invalid qualified type" <> colon <+> ppr ty <> dot + _ -> Nothing + +pprTyConAxiomMismatch :: BootListMismatch CoAxBranch BootAxiomBranchMismatch -> SDoc +pprTyConAxiomMismatch = \case + MismatchedLength -> + text "The number of equations differs." + MismatchedThing i br1 br2 err -> + hang (text "The" <+> speakNth (i+1) <+> text "equations do not match.") + 2 (pprCoAxBranchMismatch br1 br2 err) + +pprCoAxBranchMismatch :: CoAxBranch -> CoAxBranch -> BootAxiomBranchMismatch -> SDoc +pprCoAxBranchMismatch _br1 _br2 err = + text "The" <+> what <+> text "don't match." + where + what = case err of + MismatchedAxiomBinders -> text "variables bound in the equation" + MismatchedAxiomLHS -> text "equation left-hand sides" + MismatchedAxiomRHS -> text "equation right-hand sides" + +pprBootListMismatches :: SDoc -- ^ herald + -> (BootListMismatch item err -> SDoc) + -> BootListMismatches item err -> SDoc +pprBootListMismatches herald ppr_one errs = + hang herald 2 msgs + where + msgs = case errs of + err :| [] -> ppr_one err + _ -> vcat $ map ((bullet <+>) . ppr_one) $ NE.toList errs + +pprBootClassMismatch :: HsBootOrSig -> BootClassMismatch -> SDoc +pprBootClassMismatch boot_or_sig = \case + MismatchedMethods errs -> + pprBootListMismatches (text "The class methods do not match:") + pprBootClassMethodListMismatch errs + MismatchedATs at_errs -> + pprBootListMismatches (text "The associated types do not match:") + (pprATMismatch boot_or_sig) at_errs + MismatchedFunDeps -> + text "The functional dependencies do not match." + MismatchedSuperclasses -> + text "The superclass constraints do not match." + MismatchedMinimalPragmas -> + text "The MINIMAL pragmas are not compatible." + +pprATMismatch :: HsBootOrSig -> BootListMismatch ClassATItem BootATMismatch -> SDoc +pprATMismatch boot_or_sig = \case + MismatchedLength -> + text "The number of associated type defaults differs." + MismatchedThing i at1 at2 err -> + pprATMismatchErr boot_or_sig i at1 at2 err + +pprATMismatchErr :: HsBootOrSig -> Int -> ClassATItem -> ClassATItem -> BootATMismatch -> SDoc +pprATMismatchErr boot_or_sig i (ATI tc1 _) (ATI tc2 _) = \case + MismatchedTyConAT err -> + hang (text "The associated types differ:") + 2 $ pprBootTyConMismatch boot_or_sig tc1 tc2 err + MismatchedATDefaultType -> + text "The types of the" <+> speakNth (i+1) <+> + text "associated type default differ." + +pprBootClassMethodListMismatch :: BootListMismatch ClassOpItem BootMethodMismatch -> SDoc +pprBootClassMethodListMismatch = \case + MismatchedLength -> + text "The number of class methods differs." + MismatchedThing _ op1 op2 err -> + pprBootClassMethodMismatch op1 op2 err + +pprBootClassMethodMismatch :: ClassOpItem -> ClassOpItem -> BootMethodMismatch -> SDoc +pprBootClassMethodMismatch (op1, _) (op2, _) = \case + MismatchedMethodNames -> + text "The method names" <+> quotes pname1 <+> text "and" + <+> quotes pname2 <+> text "differ." + MismatchedMethodTypes {} -> + text "The types of" <+> pname1 <+> text "are different." + MismatchedDefaultMethods subtype_check -> + if subtype_check + then + text "The default methods associated with" <+> pname1 <+> + text "are not compatible." + else + text "The default methods associated with" <+> pname1 <+> + text "are different." + where + nm1 = idName op1 + nm2 = idName op2 + pname1 = quotes (ppr nm1) + pname2 = quotes (ppr nm2) + +pprBootDataMismatch :: BootDataMismatch -> SDoc +pprBootDataMismatch = \case + MismatchedNewtypeVsData -> + text "Cannot match a" <+> quotes (text "data") <+> + text "definition with a" <+> quotes (text "newtype") <+> + text "definition." + MismatchedConstructors dc_errs -> + pprBootListMismatches (text "The constructors do not match:") + pprBootDataConMismatch dc_errs + MismatchedDatatypeContexts {} -> + text "The datatype contexts do not match." + +pprBootDataConMismatch :: BootListMismatch DataCon BootDataConMismatch + -> SDoc +pprBootDataConMismatch = \case + MismatchedLength -> + text "The number of constructors differs." + MismatchedThing _ dc1 dc2 err -> + pprBootDataConMismatchErr dc1 dc2 err + +pprBootDataConMismatchErr :: DataCon -> DataCon -> BootDataConMismatch -> SDoc +pprBootDataConMismatchErr dc1 dc2 = \case + MismatchedDataConNames -> + text "The names" <+> pname1 <+> text "and" <+> pname2 <+> text "differ." + MismatchedDataConFixities -> + text "The fixities of" <+> pname1 <+> text "differ." + MismatchedDataConBangs -> + text "The strictness annotations for" <+> pname1 <+> text "differ." + MismatchedDataConFieldLabels -> + text "The record label lists for" <+> pname1 <+> text "differ." + MismatchedDataConTypes -> + text "The types for" <+> pname1 <+> text "differ." + where + name1 = dataConName dc1 + name2 = dataConName dc2 + pname1 = quotes (ppr name1) + pname2 = quotes (ppr name2) + +-------------------------------------------------------------------------------- +-- Illegal instance errors + +pprIllegalInstance :: IllegalInstanceReason -> SDoc +pprIllegalInstance = \case + IllegalClassInstance head_ty reason -> + pprIllegalClassInstanceReason head_ty reason + IllegalFamilyInstance reason -> + pprIllegalFamilyInstance reason + IllegalFamilyApplicationInInstance inst_ty invis_arg tf_tc tf_args -> + pprWithInvisibleBitsWhen invis_arg $ + hang (text "Illegal type synonym family application" + <+> quotes (ppr tf_ty) <+> text "in instance" <> colon) + 2 (ppr inst_ty) + where + tf_ty = mkTyConApp tf_tc tf_args + +pprIllegalClassInstanceReason :: TypedThing -> IllegalClassInstanceReason -> SDoc +pprIllegalClassInstanceReason head_ty = \case + IllegalInstanceHead reason -> + pprIllegalInstanceHeadReason head_ty reason + IllegalHasFieldInstance has_field_err -> + with_illegal_instance_header head_ty $ + pprIllegalHasFieldInstance has_field_err + IllegalSpecialClassInstance cls because_safeHaskell -> + text "Class" <+> quotes (ppr $ className cls) + <+> text "does not support user-specified instances" + <> safeHaskell_msg + where + safeHaskell_msg + | because_safeHaskell + = text " when Safe Haskell is enabled." + | otherwise + = dot + IllegalInstanceFailsCoverageCondition cls coverage_failure -> + with_illegal_instance_header head_ty $ + pprNotCovered cls coverage_failure + +pprIllegalInstanceHeadReason :: TypedThing + -> IllegalInstanceHeadReason -> SDoc +pprIllegalInstanceHeadReason head_ty = \case + InstHeadTySynArgs -> with_illegal_instance_header head_ty $ + text "All instance types must be of the form (T t1 ... tn)" $$ + text "where T is not a synonym." + InstHeadNonTyVarArgs -> with_illegal_instance_header head_ty $ vcat [ + text "All instance types must be of the form (T a1 ... an)", + text "where a1 ... an are *distinct type variables*,", + text "and each type variable appears at most once in the instance head."] + InstHeadMultiParam -> with_illegal_instance_header head_ty $ parens $ + text "Only one type can be given in an instance head." + InstHeadAbstractClass cls -> + text "Cannot define instance for abstract class" <+> + quotes (ppr cls) + InstHeadNonClassHead bad_head -> + vcat [ text "Illegal" <+> what_illegal <> dot + , text "Instance heads must be of the form" + , nest 2 $ text "C ty_1 ... ty_n" + , text "where" <+> quotes (char 'C') <+> text "is a class." + ] + where + what_illegal = case bad_head of + InstNonClassTyCon tc_nm flav -> + text "instance for" <+> ppr flav <+> quotes (ppr tc_nm) + InstNonTyCon -> + text "head of an instance declaration:" <+> quotes (ppr head_ty) + +with_illegal_instance_header :: TypedThing -> SDoc -> SDoc +with_illegal_instance_header head_ty msg = + hang (hang (text "Illegal instance declaration for") + 2 (quotes (ppr head_ty)) <> colon) + 2 msg + +pprIllegalHasFieldInstance :: IllegalHasFieldInstance -> SDoc +pprIllegalHasFieldInstance = \case + IllegalHasFieldInstanceNotATyCon + -> text "Record data type must be specified." + IllegalHasFieldInstanceFamilyTyCon + -> text "Record data type may not be a data family." + IllegalHasFieldInstanceTyConHasField tc lbl + -> quotes (ppr tc) <+> text "already has a field" <+> quotes (ppr lbl) <> dot + IllegalHasFieldInstanceTyConHasFields tc lbl + -> sep [ ppr_tc <+> text "has fields, and the type" <+> quotes (ppr lbl) + , text "could unify with one of the field labels of" <+> ppr_tc <> dot ] + where ppr_tc = quotes (ppr tc) + +pprNotCovered :: Class -> CoverageProblem -> SDoc +pprNotCovered clas + CoverageProblem + { not_covered_fundep = fd + , not_covered_fundep_inst = (ls, rs) + , not_covered_invis_vis_tvs = undetermined_tvs + , not_covered_liberal = which_cc_failed + } = + pprWithInvisibleBitsWhen (isEmptyVarSet $ pSnd undetermined_tvs) $ + vcat [ sep [ text "The" + <+> ppWhen liberal (text "liberal") + <+> text "coverage condition fails in class" + <+> quotes (ppr clas) + , nest 2 $ text "for functional dependency:" + <+> quotes (pprFunDep fd) ] + , sep [ text "Reason: lhs type" <> plural ls <+> pprQuotedList ls + , nest 2 $ + (if isSingleton ls + then text "does not" + else text "do not jointly") + <+> text "determine rhs type" <> plural rs + <+> pprQuotedList rs ] + , text "Un-determined variable" <> pluralVarSet undet_set <> colon + <+> pprVarSet undet_set (pprWithCommas ppr) + ] + where + liberal = case which_cc_failed of + FailedLICC -> True + FailedICC {} -> False + undet_set = fold undetermined_tvs + +illegalInstanceHints :: IllegalInstanceReason -> [GhcHint] +illegalInstanceHints = \case + IllegalClassInstance _ reason -> + illegalClassInstanceHints reason + IllegalFamilyInstance reason -> + illegalFamilyInstanceHints reason + IllegalFamilyApplicationInInstance {} -> + noHints + +illegalInstanceReason :: IllegalInstanceReason -> DiagnosticReason +illegalInstanceReason = \case + IllegalClassInstance _ reason -> + illegalClassInstanceReason reason + IllegalFamilyInstance reason -> + illegalFamilyInstanceReason reason + IllegalFamilyApplicationInInstance {} -> + ErrorWithoutFlag + +illegalClassInstanceHints :: IllegalClassInstanceReason -> [GhcHint] +illegalClassInstanceHints = \case + IllegalInstanceHead reason -> + illegalInstanceHeadHints reason + IllegalHasFieldInstance has_field_err -> + illegalHasFieldInstanceHints has_field_err + IllegalSpecialClassInstance {} -> noHints + IllegalInstanceFailsCoverageCondition _ coverage_failure -> + failedCoverageConditionHints coverage_failure + + +illegalClassInstanceReason :: IllegalClassInstanceReason -> DiagnosticReason +illegalClassInstanceReason = \case + IllegalInstanceHead reason -> + illegalInstanceHeadReason reason + IllegalHasFieldInstance has_field_err -> + illegalHasFieldInstanceReason has_field_err + IllegalSpecialClassInstance {} -> ErrorWithoutFlag + IllegalInstanceFailsCoverageCondition _ coverage_failure -> + failedCoverageConditionReason coverage_failure + +illegalInstanceHeadHints :: IllegalInstanceHeadReason -> [GhcHint] +illegalInstanceHeadHints = \case + InstHeadTySynArgs -> + [suggestExtension LangExt.TypeSynonymInstances] + InstHeadNonTyVarArgs -> + [suggestExtension LangExt.FlexibleInstances] + InstHeadMultiParam -> + [suggestExtension LangExt.MultiParamTypeClasses] + InstHeadAbstractClass {} -> + noHints + InstHeadNonClassHead {} -> + noHints + +illegalInstanceHeadReason :: IllegalInstanceHeadReason -> DiagnosticReason +illegalInstanceHeadReason = \case + -- These are serious + InstHeadAbstractClass {} -> + ErrorWithoutFlag + InstHeadNonClassHead {} -> + ErrorWithoutFlag + + -- These are less serious (enable an extension) + InstHeadTySynArgs -> + ErrorWithoutFlag + InstHeadNonTyVarArgs -> + ErrorWithoutFlag + InstHeadMultiParam -> + ErrorWithoutFlag + +illegalHasFieldInstanceHints :: IllegalHasFieldInstance -> [GhcHint] +illegalHasFieldInstanceHints = \case + IllegalHasFieldInstanceNotATyCon + -> noHints + IllegalHasFieldInstanceFamilyTyCon + -> noHints + IllegalHasFieldInstanceTyConHasField {} + -> noHints + IllegalHasFieldInstanceTyConHasFields {} + -> noHints + +illegalHasFieldInstanceReason :: IllegalHasFieldInstance -> DiagnosticReason +illegalHasFieldInstanceReason = \case + IllegalHasFieldInstanceNotATyCon + -> ErrorWithoutFlag + IllegalHasFieldInstanceFamilyTyCon + -> ErrorWithoutFlag + IllegalHasFieldInstanceTyConHasField {} + -> ErrorWithoutFlag + IllegalHasFieldInstanceTyConHasFields {} + -> ErrorWithoutFlag + +failedCoverageConditionHints :: CoverageProblem -> [GhcHint] +failedCoverageConditionHints (CoverageProblem { not_covered_liberal = failed_cc }) + = case failed_cc of + FailedLICC -> noHints + FailedICC { alsoFailedLICC = failed_licc } -> + -- Turning on UndecidableInstances makes the check liberal, + -- so if the liberal check passes, suggest enabling UndecidableInstances. + if failed_licc + then noHints + else [suggestExtension LangExt.UndecidableInstances] + +failedCoverageConditionReason :: CoverageProblem -> DiagnosticReason +failedCoverageConditionReason _ = ErrorWithoutFlag + +pprIllegalFamilyInstance :: IllegalFamilyInstanceReason -> SDoc +pprIllegalFamilyInstance = \case + InvalidAssoc reason -> pprInvalidAssoc reason + NotAFamilyTyCon ty_or_data tc -> + vcat [ text "Illegal family instance for" <+> quotes (ppr tc) + , nest 2 $ parens (quotes (ppr tc) <+> text "is not a" <+> what) ] + where + what = ppr ty_or_data <+> text "family" + NotAnOpenFamilyTyCon tc -> + text "Illegal instance for closed family" <+> quotes (ppr tc) + FamilyCategoryMismatch tc -> + text "Wrong category of family instance; declaration was for a" <+> what <> dot + where + what = case tyConFlavour tc of + OpenFamilyFlavour (IAmData {}) _ -> text "data family" + _ -> text "type family" + FamilyArityMismatch _ max_args -> + text "Number of parameters must match family declaration; expected" + <+> ppr max_args <> dot + TyFamNameMismatch fam_tc_name eqn_tc_name -> + hang (text "Mismatched type name in type family instance.") + 2 (vcat [ text "Expected:" <+> ppr fam_tc_name + , text " Actual:" <+> ppr eqn_tc_name ]) + FamInstRHSOutOfScopeTyVars mb_dodgy (NE.toList -> tvs) -> + hang (text "Out of scope type variable" <> plural tvs + <+> pprWithCommas (quotes . ppr) tvs + <+> text "in the RHS of a family instance.") + 2 (text "All such variables must be bound on the LHS.") + $$ mk_extra + where + -- mk_extra: #7536: give a decent error message for + -- type T a = Int + -- type instance F (T a) = a + mk_extra = case mb_dodgy of + Nothing -> empty + Just (fam_tc, pats, dodgy_tvs) -> + ppWhen (any (`elemVarSetByKey` dodgy_tvs) (fmap nameUnique tvs)) $ + hang (text "The real LHS (expanding synonyms) is:") + 2 (pprTypeApp fam_tc (map expandTypeSynonyms pats)) + FamInstLHSUnusedBoundTyVars (NE.toList -> bad_qtvs) -> + vcat [ not_bound_msg, not_used_msg, dodgy_msg ] + where + + -- Filter to only keep user-written variables, + -- unless none were user-written in which case we report all of them + -- (as we need to report an error). + filter_user tvs + = map ifiqtv + $ case filter ifiqtv_user_written tvs of { [] -> tvs ; qvs -> qvs } + + (not_bound, not_used, dodgy) + = case foldr acc_tv ([], [], []) bad_qtvs of + (nb, nu, d) -> (filter_user nb, filter_user nu, filter_user d) + + acc_tv tv (nb, nu, d) = case ifiqtv_reason tv of + InvalidFamInstQTvNotUsedInRHS -> (nb, tv : nu, d) + InvalidFamInstQTvNotBoundInPats -> (tv : nb, nu, d) + InvalidFamInstQTvDodgy -> (nb, nu, tv : d) + + -- Error message for type variables not bound in LHS patterns. + not_bound_msg + | null not_bound + = empty + | otherwise + = vcat [ text "The type variable" <> plural not_bound <+> pprQuotedList not_bound + <+> isOrAre not_bound <+> text "bound by a forall," + , text "but" <+> doOrDoes not_bound <+> text "not appear in any of the LHS patterns of the family instance." ] + + -- Error message for type variables bound by a forall but not used + -- in the RHS. + not_used_msg = + if null not_used + then empty + else text "The type variable" <> plural not_used <+> pprQuotedList not_used + <+> isOrAre not_used <+> text "bound by a forall," $$ + text "but" <+> itOrThey not_used <+> + isOrAre not_used <> text "n't used in the family instance." + + -- Error message for dodgy type variables. + -- See Note [Dodgy binding sites in type family instances] in GHC.Tc.Validity. + dodgy_msg + | null dodgy + = empty + | otherwise + = hang (text "Dodgy type variable" <> plural dodgy <+> pprQuotedList dodgy + <+> text "in the LHS of a family instance:") + 2 (text "the type variable" <> plural dodgy <+> pprQuotedList dodgy + <+> text "syntactically appear" <> singular dodgy <+> text "in LHS patterns," + $$ text "but" <+> itOrThey dodgy <+> doOrDoes dodgy <> text "n't appear in an injective position.") + + +illegalFamilyInstanceHints :: IllegalFamilyInstanceReason -> [GhcHint] +illegalFamilyInstanceHints = \case + InvalidAssoc rea -> invalidAssocHints rea + NotAFamilyTyCon {} -> noHints + NotAnOpenFamilyTyCon {} -> noHints + FamilyCategoryMismatch {} -> noHints + FamilyArityMismatch {} -> noHints + TyFamNameMismatch {} -> noHints + FamInstRHSOutOfScopeTyVars {} -> noHints + FamInstLHSUnusedBoundTyVars {} -> noHints + +illegalFamilyInstanceReason :: IllegalFamilyInstanceReason -> DiagnosticReason +illegalFamilyInstanceReason = \case + InvalidAssoc rea -> invalidAssocReason rea + NotAFamilyTyCon {} -> ErrorWithoutFlag + NotAnOpenFamilyTyCon {} -> ErrorWithoutFlag + FamilyCategoryMismatch {} -> ErrorWithoutFlag + FamilyArityMismatch {} -> ErrorWithoutFlag + TyFamNameMismatch {} -> ErrorWithoutFlag + FamInstRHSOutOfScopeTyVars {} -> ErrorWithoutFlag + FamInstLHSUnusedBoundTyVars {} -> ErrorWithoutFlag + +pprInvalidAssoc :: InvalidAssoc -> SDoc +pprInvalidAssoc = \case + InvalidAssocInstance rea -> pprInvalidAssocInstance rea + InvalidAssocDefault rea -> pprInvalidAssocDefault rea + +pprInvalidAssocInstance :: InvalidAssocInstance -> SDoc +pprInvalidAssocInstance = \case + AssocInstanceMissing name -> + text "No explicit" <+> text "associated type" + <+> text "or default declaration for" + <+> quotes (ppr name) + AssocInstanceNotInAClass fam_tc -> + text "Associated type" <+> quotes (ppr fam_tc) <+> + text "must be inside a class instance" + AssocNotInThisClass cls fam_tc -> + hsep [ text "Class", quotes (ppr cls) + , text "does not have an associated type", quotes (ppr fam_tc) ] + AssocNoClassTyVar cls fam_tc -> + sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc))) + , text "mentions none of the type or kind variables of the class" <+> + quotes (ppr cls <+> hsep (map ppr (classTyVars cls)))] + AssocTyVarsDontMatch vis fam_tc exp_tys act_tys -> + pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag vis) $ + vcat [ text "Type indexes must match class instance head" + , text "Expected:" <+> pp exp_tys + , text " Actual:" <+> pp act_tys ] + where + pp tys = pprIfaceTypeApp topPrec (toIfaceTyCon fam_tc) $ + toIfaceTcArgs fam_tc tys + +pprInvalidAssocDefault :: InvalidAssocDefault -> SDoc +pprInvalidAssocDefault = \case + AssocDefaultNotAssoc cls tc -> + hsep [ text "Class", quotes (ppr cls) + , text "does not have an associated type", quotes (ppr tc) ] + AssocMultipleDefaults name -> + text "More than one default declaration for" <+> quotes (ppr name) + AssocDefaultBadArgs fam_tc pat_tys bad_arg -> + let (pat_vis, main_msg) = case bad_arg of + AssocDefaultNonTyVarArg (pat_ty, pat_vis) -> + (pat_vis, + text "Illegal argument" <+> quotes (ppr pat_ty) <+> text "in:") + AssocDefaultDuplicateTyVars dups -> + let (pat_tv, pat_vis) = NE.head dups + in (pat_vis, + text "Illegal duplicate variable" <+> quotes (ppr pat_tv) <+> text "in:") + in pprWithInvisibleBitsWhen (isInvisibleForAllTyFlag pat_vis) $ + hang main_msg + 2 (vcat [ppr_eqn, suggestion]) + where + ppr_eqn :: SDoc + ppr_eqn = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pat_tys) + <+> equals <+> text "...") + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables." + +invalidAssocHints :: InvalidAssoc -> [GhcHint] +invalidAssocHints = \case + InvalidAssocInstance rea -> invalidAssocInstanceHints rea + InvalidAssocDefault rea -> invalidAssocDefaultHints rea + +invalidAssocInstanceHints :: InvalidAssocInstance -> [GhcHint] +invalidAssocInstanceHints = \case + AssocInstanceMissing {} -> noHints + AssocInstanceNotInAClass {} -> noHints + AssocNotInThisClass {} -> noHints + AssocNoClassTyVar {} -> noHints + AssocTyVarsDontMatch {} -> noHints + +invalidAssocDefaultHints :: InvalidAssocDefault -> [GhcHint] +invalidAssocDefaultHints = \case + AssocDefaultNotAssoc {} -> noHints + AssocMultipleDefaults {} -> noHints + AssocDefaultBadArgs _ _ bad -> + assocDefaultBadArgHints bad + +assocDefaultBadArgHints :: AssocDefaultBadArgs -> [GhcHint] +assocDefaultBadArgHints = \case + AssocDefaultNonTyVarArg {} -> noHints + AssocDefaultDuplicateTyVars {} -> noHints + +invalidAssocReason :: InvalidAssoc -> DiagnosticReason +invalidAssocReason = \case + InvalidAssocInstance rea -> invalidAssocInstanceReason rea + InvalidAssocDefault rea -> invalidAssocDefaultReason rea + +invalidAssocInstanceReason :: InvalidAssocInstance -> DiagnosticReason +invalidAssocInstanceReason = \case + AssocInstanceMissing {} -> WarningWithFlag (Opt_WarnMissingMethods) + AssocInstanceNotInAClass {} -> ErrorWithoutFlag + AssocNotInThisClass {} -> ErrorWithoutFlag + AssocNoClassTyVar {} -> ErrorWithoutFlag + AssocTyVarsDontMatch {} -> ErrorWithoutFlag + +invalidAssocDefaultReason :: InvalidAssocDefault -> DiagnosticReason +invalidAssocDefaultReason = \case + AssocDefaultNotAssoc {} -> ErrorWithoutFlag + AssocMultipleDefaults {} -> ErrorWithoutFlag + AssocDefaultBadArgs _ _ rea -> + assocDefaultBadArgReason rea + +assocDefaultBadArgReason :: AssocDefaultBadArgs -> DiagnosticReason +assocDefaultBadArgReason = \case + AssocDefaultNonTyVarArg {} -> ErrorWithoutFlag + AssocDefaultDuplicateTyVars {} -> ErrorWithoutFlag + +-------------------------------------------------------------------------------- +-- Template Haskell quotes and splices + +pprTHError :: THError -> DecoratedSDoc +pprTHError = \case + THSyntaxError err -> pprTHSyntaxError err + THNameError err -> pprTHNameError err + THReifyError err -> pprTHReifyError err + TypedTHError err -> pprTypedTHError err + THSpliceFailed rea -> pprSpliceFailReason rea + AddTopDeclsError err -> pprAddTopDeclsError err + + IllegalStaticFormInSplice e -> + mkSimpleDecorated $ + sep [ text "static forms cannot be used in splices:" + , nest 2 $ ppr e + ] + + FailedToLookupThInstName th_type reason -> + mkSimpleDecorated $ + case reason of + NoMatchesFound -> + text "Couldn't find any instances of" + <+> text (TH.pprint th_type) + <+> text "to add documentation to" + CouldNotDetermineInstance -> + text "Couldn't work out what instance" + <+> text (TH.pprint th_type) + <+> text "is supposed to be" + + AddInvalidCorePlugin plugin -> + mkSimpleDecorated $ + hang (text "addCorePlugin: invalid plugin module" <+> quotes (text plugin) ) + 2 (text "Plugins in the current package can't be specified.") + + AddDocToNonLocalDefn doc_loc -> + mkSimpleDecorated $ + text "Can't add documentation to" <+> ppr_loc doc_loc <> comma <+> + text "as it isn't inside the current module." + where + ppr_loc (TH.DeclDoc n) = text $ TH.pprint n + ppr_loc (TH.ArgDoc n _) = text $ TH.pprint n + ppr_loc (TH.InstDoc t) = text $ TH.pprint t + ppr_loc TH.ModuleDoc = text "the module header" + + ReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg + +pprTHSyntaxError :: THSyntaxError -> DecoratedSDoc +pprTHSyntaxError = mkSimpleDecorated . \case + IllegalTHQuotes expr -> + text "Syntax error on" <+> ppr expr + -- The error message context will say + -- "In the Template Haskell quotation", so no need to repeat that here. + BadImplicitSplice -> + sep [ text "Parse error: module header, import declaration" + , text "or top-level declaration expected." ] + -- The compiler should not mention TemplateHaskell, as the common case + -- is that this is a simple beginner error, for example: + -- + -- module M where + -- f :: Int -> Int; f x = x + -- xyzzy + -- g y = f y + 1 + -- + -- It's unlikely that 'xyzzy' above was intended to be a Template Haskell + -- splice; instead it's probably something mistakenly left in the code. + -- See #12146 for discussion. + + IllegalTHSplice -> + text "Unexpected top-level splice." + MismatchedSpliceType splice_type inner_splice_or_bracket -> + inner <+> text "may not appear in" <+> outer <> dot + where + (inner, outer) = case inner_splice_or_bracket of + IsSplice -> case splice_type of + Typed -> (text "Typed splices" , text "untyped brackets") + Untyped -> (text "Untyped splices", text "typed brackets") + IsBracket -> + case splice_type of + Typed -> (text "Untyped brackets", text "typed splices") + Untyped -> (text "Typed brackets" , text "untyped splices") + NestedTHBrackets -> + text "Template Haskell brackets cannot be nested" <+> + text "(without intervening splices)" + +pprTHNameError :: THNameError -> DecoratedSDoc +pprTHNameError = \case + NonExactName name -> + mkSimpleDecorated $ + hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.") + 2 (text "Probable cause: you used mkName instead of newName to generate a binding.") + +pprTHReifyError :: THReifyError -> DecoratedSDoc +pprTHReifyError = \case + CannotReifyInstance ty + -> mkSimpleDecorated $ + hang (text "reifyInstances:" <+> quotes (ppr ty)) + 2 (text "is not a class constraint or type family application") + CannotReifyOutOfScopeThing th_name + -> mkSimpleDecorated $ + quotes (text (TH.pprint th_name)) <+> + text "is not in scope at a reify" + -- Ugh! Rather an indirect way to display the name + CannotReifyThingNotInTypeEnv name + -> mkSimpleDecorated $ + quotes (ppr name) <+> text "is not in the type environment at a reify" + NoRolesAssociatedWithThing thing + -> mkSimpleDecorated $ + text "No roles associated with" <+> (ppr thing) + CannotRepresentType sort ty + -> mkSimpleDecorated $ + hang (text "Can't represent" <+> sort_doc <+> text "in Template Haskell:") + 2 (ppr ty) + where + sort_doc = text $ + case sort of + LinearInvisibleArgument -> "linear invisible argument" + CoercionsInTypes -> "coercions in types" + DataConVisibleForall -> "visible forall in the type of a data constructor" + +pprTypedTHError :: TypedTHError -> DecoratedSDoc +pprTypedTHError = \case + SplicePolymorphicLocalVar ident + -> mkSimpleDecorated $ + text "Can't splice the polymorphic local variable" <+> quotes (ppr ident) + TypedTHWithPolyType ty + -> mkSimpleDecorated $ + vcat [ text "Illegal polytype:" <+> ppr ty + , text "The type of a Typed Template Haskell expression must" <+> + text "not have any quantification." ] + +pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc +pprSpliceFailReason = \case + SpliceThrewException phase _exn exn_msg expr show_code -> + mkSimpleDecorated $ + vcat [ text "Exception when trying to" <+> text phaseStr <+> text "compile-time code:" + , nest 2 (text exn_msg) + , if show_code then text "Code:" <+> ppr expr else empty] + where phaseStr = + case phase of + SplicePhase_Run -> "run" + SplicePhase_CompileAndLink -> "compile and link" + RunSpliceFailure err -> pprRunSpliceFailure Nothing err + +pprAddTopDeclsError :: AddTopDeclsError -> DecoratedSDoc +pprAddTopDeclsError = \case + InvalidTopDecl _decl -> + mkSimpleDecorated $ + sep [ text "Only function, value, annotation, and foreign import declarations" + , text "may be added with" <+> quotes (text "addTopDecls") <> dot ] + AddTopDeclsUnexpectedDeclarationSplice {} -> + mkSimpleDecorated $ + text "Declaration splices are not permitted" <+> + text "inside top-level declarations added with" <+> + quotes (text "addTopDecls") <> dot + AddTopDeclsRunSpliceFailure err -> + pprRunSpliceFailure (Just "addTopDecls") err + +pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc +pprRunSpliceFailure mb_calling_fn (ConversionFail what reason) = + mkSimpleDecorated . add_calling_fn . addSpliceInfo $ + pprConversionFailReason reason + where + add_calling_fn rest = + case mb_calling_fn of + Just calling_fn -> + hang (text "Error in a declaration passed to" <+> quotes (text calling_fn) <> colon) + 2 rest + Nothing -> rest + addSpliceInfo = case what of + ConvDec d -> addSliceInfo' "declaration" d + ConvExp e -> addSliceInfo' "expression" e + ConvPat p -> addSliceInfo' "pattern" p + ConvType t -> addSliceInfo' "type" t + addSliceInfo' what item reasonErr = reasonErr $$ descr + where + -- Show the item in pretty syntax normally, + -- but with all its constructors if you say -dppr-debug + descr = hang (text "When splicing a TH" <+> text what <> colon) + 2 (getPprDebug $ \case + True -> text (show item) + False -> text (TH.pprint item)) + +thErrorReason :: THError -> DiagnosticReason +thErrorReason = \case + THSyntaxError err -> thSyntaxErrorReason err + THNameError err -> thNameErrorReason err + THReifyError err -> thReifyErrorReason err + TypedTHError err -> typedTHErrorReason err + THSpliceFailed rea -> spliceFailedReason rea + AddTopDeclsError err -> addTopDeclsErrorReason err + + IllegalStaticFormInSplice {} -> ErrorWithoutFlag + FailedToLookupThInstName {} -> ErrorWithoutFlag + AddInvalidCorePlugin {} -> ErrorWithoutFlag + AddDocToNonLocalDefn {} -> ErrorWithoutFlag + ReportCustomQuasiError is_error _ -> + if is_error + then ErrorWithoutFlag + else WarningWithoutFlag + +thSyntaxErrorReason :: THSyntaxError -> DiagnosticReason +thSyntaxErrorReason = \case + IllegalTHQuotes{} -> ErrorWithoutFlag + BadImplicitSplice -> ErrorWithoutFlag + IllegalTHSplice{} -> ErrorWithoutFlag + NestedTHBrackets{} -> ErrorWithoutFlag + MismatchedSpliceType{} -> ErrorWithoutFlag + +thNameErrorReason :: THNameError -> DiagnosticReason +thNameErrorReason = \case + NonExactName {} -> ErrorWithoutFlag + +thReifyErrorReason :: THReifyError -> DiagnosticReason +thReifyErrorReason = \case + CannotReifyInstance {} -> ErrorWithoutFlag + CannotReifyOutOfScopeThing {} -> ErrorWithoutFlag + CannotReifyThingNotInTypeEnv {} -> ErrorWithoutFlag + NoRolesAssociatedWithThing {} -> ErrorWithoutFlag + CannotRepresentType {} -> ErrorWithoutFlag + +typedTHErrorReason :: TypedTHError -> DiagnosticReason +typedTHErrorReason = \case + SplicePolymorphicLocalVar {} -> ErrorWithoutFlag + TypedTHWithPolyType {} -> ErrorWithoutFlag + +spliceFailedReason :: SpliceFailReason -> DiagnosticReason +spliceFailedReason = \case + SpliceThrewException {} -> ErrorWithoutFlag + RunSpliceFailure {} -> ErrorWithoutFlag + +addTopDeclsErrorReason :: AddTopDeclsError -> DiagnosticReason +addTopDeclsErrorReason = \case + InvalidTopDecl {} + -> ErrorWithoutFlag + AddTopDeclsUnexpectedDeclarationSplice {} + -> ErrorWithoutFlag + AddTopDeclsRunSpliceFailure {} + -> ErrorWithoutFlag + +thErrorHints :: THError -> [GhcHint] +thErrorHints = \case + THSyntaxError err -> thSyntaxErrorHints err + THNameError err -> thNameErrorHints err + THReifyError err -> thReifyErrorHints err + TypedTHError err -> typedTHErrorHints err + THSpliceFailed rea -> spliceFailedHints rea + AddTopDeclsError err -> addTopDeclsErrorHints err + + IllegalStaticFormInSplice {} -> noHints + FailedToLookupThInstName {} -> noHints + AddInvalidCorePlugin {} -> noHints + AddDocToNonLocalDefn {} -> noHints + ReportCustomQuasiError {} -> noHints + +thSyntaxErrorHints :: THSyntaxError -> [GhcHint] +thSyntaxErrorHints = \case + IllegalTHQuotes{} + -> [suggestExtension LangExt.TemplateHaskellQuotes] + BadImplicitSplice {} + -> noHints -- NB: don't suggest TemplateHaskell + -- see comments on BadImplicitSplice in pprTHSyntaxError + IllegalTHSplice{} + -> [suggestExtension LangExt.TemplateHaskell] + NestedTHBrackets{} + -> noHints + MismatchedSpliceType{} + -> noHints + +thNameErrorHints :: THNameError -> [GhcHint] +thNameErrorHints = \case + NonExactName {} -> noHints + +thReifyErrorHints :: THReifyError -> [GhcHint] +thReifyErrorHints = \case + CannotReifyInstance {} -> noHints + CannotReifyOutOfScopeThing {} -> noHints + CannotReifyThingNotInTypeEnv {} -> noHints + NoRolesAssociatedWithThing {} -> noHints + CannotRepresentType {} -> noHints + +typedTHErrorHints :: TypedTHError -> [GhcHint] +typedTHErrorHints = \case + SplicePolymorphicLocalVar {} -> noHints + TypedTHWithPolyType {} -> noHints + +spliceFailedHints :: SpliceFailReason -> [GhcHint] +spliceFailedHints = \case + SpliceThrewException {} -> noHints + RunSpliceFailure {} -> noHints + +addTopDeclsErrorHints :: AddTopDeclsError -> [GhcHint] +addTopDeclsErrorHints = \case + InvalidTopDecl {} + -> noHints + AddTopDeclsUnexpectedDeclarationSplice {} + -> noHints + AddTopDeclsRunSpliceFailure {} + -> noHints + +-------------------------------------------------------------------------------- + +pprPatersonCondFailure :: + PatersonCondFailure -> PatersonCondFailureContext -> Type -> Type -> SDoc +pprPatersonCondFailure (PCF_TyVar tvs) InInstanceDecl lhs rhs = + hang (occMsg tvs) + 2 (sep [ text "in the constraint" <+> quotes (ppr lhs) + , text "than in the instance head" <+> quotes (ppr rhs) ]) + where + occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + <+> pp_occurs <+> text "more often" + pp_occurs | isSingleton tvs = text "occurs" + | otherwise = text "occur" +pprPatersonCondFailure (PCF_TyVar tvs) InTyFamEquation lhs rhs = + hang (occMsg tvs) + 2 (sep [ text "in the type-family application" <+> quotes (ppr rhs) + , text "than in the LHS of the family instance" <+> quotes (ppr lhs) ]) + where + occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + <+> pp_occurs <+> text "more often" + pp_occurs | isSingleton tvs = text "occurs" + | otherwise = text "occur" +pprPatersonCondFailure PCF_Size InInstanceDecl lhs rhs = + hang (text "The constraint" <+> quotes (ppr lhs)) + 2 (sep [ text "is no smaller than", pp_rhs ]) + where pp_rhs = text "the instance head" <+> quotes (ppr rhs) +pprPatersonCondFailure PCF_Size InTyFamEquation lhs rhs = + hang (text "The type-family application" <+> quotes (ppr rhs)) + 2 (sep [ text "is no smaller than", pp_lhs ]) + where pp_lhs = text "the LHS of the family instance" <+> quotes (ppr lhs) +pprPatersonCondFailure (PCF_TyFam tc) InInstanceDecl lhs _rhs = + hang (text "Illegal use of type family" <+> quotes (ppr tc)) + 2 (text "in the constraint" <+> quotes (ppr lhs)) +pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs = + hang (text "Illegal nested use of type family" <+> quotes (ppr tc)) + 2 (text "in the arguments of the type-family application" <+> quotes (ppr rhs)) + +-------------------------------------------------------------------------------- + +defaultTypesAndImport :: ClassDefaults -> SDoc +defaultTypesAndImport ClassDefaults{cd_types, cd_provenance = DP_Imported cdm} = + hang (parens $ pprWithCommas ppr cd_types) + 2 (text "imported from" <+> ppr cdm) +defaultTypesAndImport ClassDefaults{cd_types} = parens (pprWithCommas ppr cd_types) + +-------------------------------------------------------------------------------- + +pprZonkerMessage :: ZonkerMessage -> SDoc +pprZonkerMessage = \case + ZonkerCannotDefaultConcrete frr -> + ppr (frr_context frr) $$ + text "cannot be assigned a fixed runtime representation," <+> + text "not even by defaulting." + +zonkerMessageHints :: ZonkerMessage -> [GhcHint] +zonkerMessageHints = \case + ZonkerCannotDefaultConcrete {} -> [SuggestAddTypeSignatures UnnamedBinding] + +zonkerMessageReason :: ZonkerMessage -> DiagnosticReason +zonkerMessageReason = \case + ZonkerCannotDefaultConcrete {} -> ErrorWithoutFlag + +-------------------------------------------------------------------------------- + +pprTypeSyntaxName :: TypeSyntax -> SDoc +pprTypeSyntaxName TypeKeywordSyntax = "keyword" <+> quotes "type" +pprTypeSyntaxName ForallTelescopeSyntax = "forall telescope" +pprTypeSyntaxName ContextArrowSyntax = "context arrow (=>)" +pprTypeSyntaxName FunctionArrowSyntax = "function type arrow (->)" + +-------------------------------------------------------------------------------- +-- ErrCtxt + +pprTyConInstFlavour :: TyConInstFlavour -> SDoc +pprTyConInstFlavour + ( TyConInstFlavour + { tyConInstFlavour = flav + , tyConInstIsDefault = is_dflt + } + ) = (if is_dflt then text "default" else empty) <+> ppr flav <+> text "instance" + +pprErrCtxtMsg :: ErrCtxtMsg -> SDoc +pprErrCtxtMsg = \case + ExprCtxt expr -> + hang (text "In the expression:") + 2 (ppr (stripParensHsExpr expr)) + ThetaCtxt ctxt theta -> + vcat [ text "In the context:" <+> pprTheta theta + , text "While checking" <+> pprUserTypeCtxt ctxt ] + QuantifiedCtCtxt pty -> + text "In the quantified constraint" <+> quotes (ppr pty) + InferredTypeCtxt poly_name poly_ty -> + vcat [ text "When checking the inferred type" + , nest 2 $ ppr poly_name <+> dcolon <+> ppr poly_ty ] + SigCtxt sig -> + text "In" <+> ppr sig + UserSigCtxt ctxt hs_ty + | Just n <- isSigMaybe ctxt + -> hang (text "In the type signature:") + 2 (pprPrefixOcc n <+> dcolon <+> ppr hs_ty) + | otherwise + -> hang (text "In" <+> pprUserTypeCtxt ctxt <> colon) + 2 (ppr hs_ty) + RecordUpdCtxt ne_relevant_cons@(relevant_con :| _) upd_fld_names ex_tvs -> + make_lines_msg $ + (text "In a record update at field" <> plural upd_fld_names <+> pprQuotedList upd_fld_names :) + $ case relevant_con of + RealDataCon con -> + [ text "with type constructor" <+> quotes (ppr (dataConTyCon con)) + , text "data constructor" <+> plural relevant_cons <+> cons ] + PatSynCon {} -> + [ text "with pattern synonym" <+> plural relevant_cons <+> cons ] + ++ if null ex_tvs + then [] + else [ text "existential variable" <> plural ex_tvs <+> pprQuotedList ex_tvs ] + + where + cons = pprQuotedList relevant_cons + relevant_cons = NE.toList ne_relevant_cons + -- Pretty-print a collection of lines, adding commas at the end of each line, + -- and adding "and" to the start of the last line. + make_lines_msg :: [SDoc] -> SDoc + make_lines_msg [] = empty + make_lines_msg [last] = ppr last <> dot + make_lines_msg [l1,l2] = l1 $$ text "and" <+> l2 <> dot + make_lines_msg (l:ls) = l <> comma $$ make_lines_msg ls + PatSigErrCtxt sig_ty res_ty -> + vcat [ hang (text "When checking that the pattern signature:") + 4 (ppr sig_ty) + , nest 2 (hang (text "fits the type of its context:") + 2 (ppr res_ty)) ] + PatCtxt pat -> + hang (text "In the pattern:") 2 (ppr pat) + PatSynDeclCtxt name -> + text "In the declaration for pattern synonym" <+> quotes (ppr name) + ClassOpCtxt meth meth_ty -> + sep [ text "When checking the class method:" + , nest 2 (pprPrefixOcc meth <+> dcolon <+> ppr meth_ty)] + MethSigCtxt sel_name sig_ty meth_ty -> + hang (text "When checking that instance signature for" <+> quotes (ppr sel_name)) + 2 (vcat [ text "is more general than its signature in the class" + , text "Instance sig:" <+> ppr sig_ty + , text " Class sig:" <+> ppr meth_ty ]) + PatMonoBindsCtxt pat grhss -> + hang (text "In a pattern binding:") + 2 (pprPatBind pat grhss) + ForeignDeclCtxt fo -> + hang (text "When checking declaration:") + 2 (ppr fo) + RuleCtxt rule_name -> + text "When checking the rewrite rule" <+> doubleQuotes (ftext rule_name) + FieldCtxt field_name -> + text "In the" <+> quotes (ppr field_name) <+> text "field of a record" + TypeCtxt ty -> + text "In the type" <+> quotes (ppr ty) + KindCtxt ki -> + text "In the kind" <+> quotes (ppr ki) + SubTypeCtxt ty_expected ty_actual -> + vcat [ hang (text "When checking that:") + 4 (ppr ty_actual) + , nest 2 (hang (text "is more polymorphic than:") + 2 (ppr ty_expected)) ] + AmbiguityCheckCtxt ctxt allow_ambiguous -> + vcat [ text "In the ambiguity check for" <+> what + , ppUnless allow_ambiguous ambig_msg ] + where + ambig_msg = text "To defer the ambiguity check to use sites, enable AllowAmbiguousTypes" + what | Just n <- isSigMaybe ctxt = quotes (ppr n) + | otherwise = pprUserTypeCtxt ctxt + + FunAppCtxt fun_arg arg_no -> + hang (hsep [ text "In the", speakNth arg_no, text "argument of" + , quotes fun <> text ", namely"]) + 2 (quotes arg) + where + fun, arg :: SDoc + (fun, arg) = case fun_arg of + FunAppCtxtExpr fn a -> (ppr fn, ppr a) + FunAppCtxtTy fn a -> (ppr fn, ppr a) + FunTysCtxt herald fun_ty n_vis_args_in_call n_fun_args + | n_vis_args_in_call <= n_fun_args -- Enough args, in the end + -> text "In the result of a function call" + | otherwise + -> hang (full_herald <> comma) + 2 (sep [ text "but its type" <+> quotes (pprSigmaType fun_ty) + , if n_fun_args == 0 then text "has none" + else text "has only" <+> speakN n_fun_args]) + where + full_herald = pprExpectedFunTyHerald herald + <+> speakNOf n_vis_args_in_call (text "visible argument") + -- What are "visible" arguments? See Note [Visibility and arity] in GHC.Types.Basic + FunResCtxt fun n_val_args res_fun res_env n_fun n_env + | -- Check for too few args + -- fun_tau = a -> b, res_tau = Int + n_fun > n_env + , not_fun res_env + -> text "Probable cause:" <+> quotes (ppr fun) + <+> text "is applied to too few arguments" + + | -- Check for too many args + -- fun_tau = a -> Int, res_tau = a -> b -> c -> d + -- The final guard suppresses the message when there + -- aren't enough args to drop; eg. the call is (f e1) + n_fun < n_env + , not_fun res_fun + , n_fun + n_val_args >= n_env + -- Never suggest that a naked variable is + -- applied to too many args! + -> text "Possible cause:" <+> quotes (ppr fun) + <+> text "is applied to too many arguments" + + | otherwise + -> empty + where + not_fun ty -- ty is definitely not an arrow type, + -- and cannot conceivably become one + = case tcSplitTyConApp_maybe ty of + Just (tc, _) -> isAlgTyCon tc + Nothing -> False + + TyConDeclCtxt name flav -> + hsep [ text "In the", ppr flav + , text "declaration for", quotes (ppr name) ] + TyConInstCtxt name flav -> + hsep [ text "In the" <+> pprTyConInstFlavour flav <+> text "declaration for" + , quotes (ppr name) ] + DataConDefCtxt cons -> + text "In the definition of data constructor" <> plural (NE.toList cons) + <+> ppr_cons (NE.toList cons) + where + ppr_cons :: [LocatedN Name] -> SDoc + ppr_cons [con] = quotes (ppr con) + ppr_cons cons = interpp'SP cons + DataConResTyCtxt cons -> + text "In the result type of data constructor" <> plural (NE.toList cons) + <+> ppr_cons (NE.toList cons) + where + ppr_cons :: [LocatedN Name] -> SDoc + ppr_cons [con] = quotes (ppr con) + ppr_cons cons = interpp'SP cons + ClosedFamEqnCtxt tc -> + text "In the equations for closed type family" <+> + quotes (ppr tc) + TySynErrCtxt tc -> + text "In the expansion of type synonym" <+> quotes (ppr tc) + RoleAnnotErrCtxt name -> + nest 2 $ text "while checking a role annotation for" <+> quotes (ppr name) + CmdCtxt cmd -> + text "In the command:" <+> ppr cmd + InstDeclErrCtxt either_ty_ty -> + hang (text "In the instance declaration for") + 2 (quotes $ ppr_ty) + where + ppr_ty = case either_ty_ty of + Left ty -> ppr ty + Right ty -> ppr ty + StaticFormCtxt expr -> + hang (text "In the body of a static form:") + 2 (ppr expr) + DefaultDeclErrCtxt { ddec_in_type_list = in_type_list } -> + if in_type_list + then + text "When checking the types in a default declaration" + else + text "When checking the class at the head of a named default declaration" + MainCtxt main_name -> + text "When checking the type of the" + <+> ppMainFn (nameOccName main_name) + + VDQWarningCtxt tycon -> + vcat + [ text "NB: Type" <+> quotes (ppr tycon) <+> + text "was inferred to use visible dependent quantification." + , text "Most types with visible dependent quantification are" + , text "polymorphically recursive and need a standalone kind" + , text "signature. Perhaps supply one, with StandaloneKindSignatures." + ] + TermLevelUseCtxt name ctxt -> + pprTermLevelUseCtxt name ctxt + + StmtErrCtxt ctxt stmt + -- For [ e | .. ], do not mutter about "stmts" + | LastStmt _ e _ _ <- stmt + , isComprehensionContext ctxt + -> hang (text "In the expression:") 2 (ppr e) + | otherwise + -> hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon) + 2 (ppr_stmt stmt) + where + -- For Group and Transform Stmts, don't print the nested stmts! + ppr_stmt (TransStmt { trS_by = by, trS_using = using + , trS_form = form }) = pprTransStmt by using form + ppr_stmt stmt = pprStmt stmt + + DerivInstCtxt pred -> + text "When deriving the instance for" <+> parens (ppr pred) + StandaloneDerivCtxt ty -> + hang (text "In the stand-alone deriving instance for") + 2 (quotes (ppr ty)) + DerivBindCtxt sel_id clas tys -> + vcat [ text "When typechecking the code for" <+> quotes (ppr sel_id) + , nest 2 (text "in a derived instance for" + <+> quotes (pprClassPred clas tys) <> colon) + , nest 2 $ text "To see the code I am typechecking, use -ddump-deriv" ] + + + ExportCtxt ie -> + text "In the export:" <+> ppr ie + PatSynExportCtxt ps -> + text "In the pattern synonym:" <+> ppr ps + PatSynRecSelExportCtxt _ps sel -> + text "In the pattern synonym record selector:" <+> ppr sel + + SyntaxNameCtxt name orig ty loc -> + vcat [ text "when checking that" <+> quotes (ppr name) + <+> text "(needed by a syntactic construct)" + , nest 2 (text "has the required type:" + <+> ppr ty) + , nest 2 (sep [ppr orig, text "at" <+> ppr loc])] + + AnnCtxt ann -> + hang (text "In the annotation:") 2 (ppr ann) + SpecPragmaCtxt prag -> + hang (text "In the pragma:") 2 (ppr prag) + MatchCtxt ctxt -> + text "In" <+> pprMatchContext ctxt + MatchInCtxt match -> + hang (text "In" <+> pprMatchContext (m_ctxt match) <> colon) + 4 (pprMatch match) + UntypedTHBracketCtxt br -> + hang (text "In the Template Haskell quotation" <> colon) + 2 (ppr br) + TypedTHBracketCtxt br_body -> + hang (text "In the Template Haskell typed quotation" <> colon) + 2 (thTyBrackets . ppr $ br_body) + UntypedSpliceCtxt splice -> + hang (text "In the" <+> what) 2 (pprUntypedSplice True Nothing splice) + where + what = case splice of + HsUntypedSpliceExpr {} -> text "untyped splice:" + HsQuasiQuote {} -> text "quasi-quotation:" + TypedSpliceCtxt mb_nm expr -> + hang (text "In the typed Template Haskell splice:") + 2 (pprTypedSplice mb_nm expr) + TypedSpliceResultCtxt expr -> + sep [ text "In the result of the splice:" + , nest 2 (pprTypedSplice Nothing (HsTypedSpliceExpr noExtField expr)) + , text "To see what the splice expanded to, use -ddump-splices"] + + ReifyInstancesCtxt th_nm th_tys -> + text "In the argument of" <+> quotes (text "reifyInstances") <> colon + <+> ppr_th th_nm <+> sep (map ppr_th th_tys) + where + ppr_th :: TH.Ppr a => a -> SDoc + ppr_th x = text (TH.pprint x) + + MergeSignaturesCtxt unit_state mod_name reqs -> + pprWithUnitState unit_state $ + if null reqs + then text "While checking the local signature" <+> ppr mod_name <+> + text "for consistency" + else hang (text "While merging the signatures from" <> colon) + 2 (vcat [ bullet <+> ppr req | req <- reqs ] $$ + bullet <+> text "...and the local signature for" <+> ppr mod_name) + CheckImplementsCtxt unit_state impl_mod (Module req_uid req_mod_name) -> + pprWithUnitState unit_state $ + text "While checking that" <+> quotes (ppr impl_mod) <+> + text "implements signature" <+> quotes (ppr req_mod_name) <+> + text "in" <+> quotes (ppr req_uid) <> dot + +-------------------------------------------------------------------------------- + +pprThBindLevel :: Set.Set ThLevelIndex -> SDoc +pprThBindLevel levels_set = text "level" <> pluralSet levels_set <+> pprUnquotedSet levels_set diff --git a/GHC/Tc/Errors/Types.hs b/GHC/Tc/Errors/Types.hs --- a/GHC/Tc/Errors/Types.hs +++ b/GHC/Tc/Errors/Types.hs @@ -6,18 +6,20 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE LambdaCase #-} module GHC.Tc.Errors.Types ( -- * Main types TcRnMessage(..) , TcRnMessageOpts(..) , mkTcRnUnknownMessage - , TcRnMessageDetailed(..) + , TcRnMessageDetailed(..), ErrInfo(..) , TypeDataForbids(..) - , ErrInfo(..) , FixedRuntimeRepProvenance(..) , pprFixedRuntimeRepProvenance , ShadowedNameProvenance(..) + , ResolvedNameInfo(..) + , pprResolvedNameProvenance , RecordFieldPart(..) , IllegalNewtypeReason(..) , BadRecordUpdateReason(..) @@ -57,7 +59,7 @@ , ErrorItem(..), errorItemOrigin, errorItemEqRel, errorItemPred, errorItemCtLoc - , SolverReport(..), SolverReportSupplementary(..) + , SolverReport(..), SupplementaryInfo(..) , SolverReportWithCtxt(..) , SolverReportErrCtxt(..) , getUserGivens, discardProvCtxtGivens @@ -77,8 +79,11 @@ , RelevantBindings(..), pprRelevantBindings , PromotionErr(..), pprPECategory, peCategory , TermLevelUseErr(..), teCategory - , NotInScopeError(..), mkTcRnNotInScope + , NotInScopeError(..) + , Subordinate(..), pprSubordinate , ImportError(..) + , WhatLooking(..) + , lookingForSubordinate , HoleError(..) , CoercibleMsg(..) , PotentialInstances(..) @@ -94,7 +99,7 @@ , RuleLhsErrReason(..) , HsigShapeMismatchReason(..) , WrongThingSort(..) - , StageCheckReason(..) + , LevelCheckReason(..) , UninferrableTyVarCtx(..) , PatSynInvalidRhsReason(..) , BadFieldAnnotationReason(..) @@ -103,13 +108,14 @@ , RoleValidationFailedReason(..) , DisabledClassExtension(..) , TyFamsDisabledReason(..) - , TypeApplication(..) + , BadInvisPatReason(..) , BadEmptyCaseReason(..) , HsTypeOrSigType(..) , HsTyVarBndrExistentialFlag(..) , TySynCycleTyCons , BadImportKind(..) , DodgyImportsReason (..) + , ImportLookupExtensions (..) , ImportLookupReason (..) , UnusedImportReason (..) , UnusedImportName (..) @@ -146,6 +152,7 @@ , InvalidFamInstQTv(..), InvalidFamInstQTvReason(..) , InvalidAssoc(..), InvalidAssocInstance(..) , InvalidAssocDefault(..), AssocDefaultBadArgs(..) + , InstHeadNonClassHead(..) -- * Template Haskell errors , THError(..), THSyntaxError(..), THNameError(..) @@ -163,9 +170,12 @@ -- * Zonker errors , ZonkerMessage(..) - -- FFI Errors + -- * FFI Errors , IllegalForeignTypeReason(..) , TypeCannotBeMarshaledReason(..) + + -- * Error contexts + , ErrCtxtMsg(..) ) where import GHC.Prelude @@ -174,28 +184,29 @@ import GHC.Tc.Errors.Types.PromotionErr import GHC.Tc.Errors.Hole.FitTypes (HoleFit) +import GHC.Tc.Types.BasicTypes import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence (EvBindsVar) +import GHC.Tc.Types.ErrCtxt import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin, SubGoalDepth ) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Types.TH -import GHC.Tc.Types.BasicTypes import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType, PatersonCondFailure, PatersonCondFailureContext) import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Avail -import GHC.Types.Hint (UntickedPromotedThing(..), AssumedDerivingStrategy(..)) +import GHC.Types.Hint (UntickedPromotedThing(..), AssumedDerivingStrategy(..), SigLike) import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name (NamedThing(..), Name, OccName, getSrcLoc, getSrcSpan) +import GHC.Types.Name.Env (NameEnv) import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader -import GHC.Types.Name.Env (NameEnv) import GHC.Types.SourceFile (HsBootOrSig(..)) import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) @@ -209,6 +220,8 @@ import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt) import GHC.Unit.Module.ModIface (ModIface) +import GHC.Utils.Outputable + import GHC.Core.Class (Class, ClassMinimalDef, ClassOpItem, ClassATItem) import GHC.Core.Coercion (Coercion) import GHC.Core.Coercion.Axiom (CoAxBranch) @@ -223,7 +236,8 @@ import GHC.Driver.Backend (Backend) -import GHC.Utils.Outputable +import GHC.Iface.Errors.Types + import GHC.Utils.Misc (filterOut) import qualified GHC.LanguageExtensions as LangExt @@ -233,15 +247,15 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Typeable (Typeable) import qualified GHC.Boot.TH.Syntax as TH import Data.Map.Strict (Map) import GHC.Generics ( Generic ) -import GHC.Iface.Errors.Types - +import qualified Data.Set as Set data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not , tcOptsIfaceOpts :: !IfaceMessageOpts @@ -279,25 +293,31 @@ existence of these two types, which for now remain a "necessary evil". -} --- The majority of TcRn messages come with extra context about the error, + +-- | The majority of TcRn messages come with extra context about the error, -- and this newtype captures it. See Note [Migrating TcM Messages]. data ErrInfo = ErrInfo { - errInfoContext :: !SDoc + errInfoContext :: ![ErrCtxtMsg] -- ^ Extra context associated to the error. - , errInfoSupplementary :: !SDoc + , errInfoSupplementary :: !(Maybe (HoleFitDispConfig, [SupplementaryInfo])) -- ^ Extra supplementary info associated to the error. + , errInfoHints :: ![GhcHint] + -- ^ Extra hints associated to the error. } + -- | 'TcRnMessageDetailed' is an \"internal\" type (used only inside -- 'GHC.Tc.Utils.Monad' that wraps a 'TcRnMessage' while also providing -- any extra info needed to correctly pretty-print this diagnostic later on. data TcRnMessageDetailed - = TcRnMessageDetailed !ErrInfo - -- ^ Extra info associated with the message - !TcRnMessage + = TcRnMessageDetailed + !ErrInfo + -- ^ extra info associated with the message + !TcRnMessage + -- ^ main error payload deriving Generic -mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) +mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ DiagnosticHint TcRnMessage) => a -> TcRnMessage mkTcRnUnknownMessage diag = TcRnUnknownMessage (mkSimpleUnknownDiagnostic diag) -- Please don't use this function inside the GHC codebase; @@ -311,7 +331,7 @@ {-| Simply wraps an unknown 'Diagnostic' message @a@. It can be used by plugins to provide custom diagnostic messages originated during typechecking/renaming. -} - TcRnUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts TcRnMessage)) -> TcRnMessage + TcRnUnknownMessage :: UnknownDiagnosticFor TcRnMessage -> TcRnMessage {-| Wrap an 'IfaceMessage' to a 'TcRnMessage' for when we attempt to load interface files during typechecking but encounter an error. -} @@ -433,7 +453,7 @@ -} TcRnTypeDoesNotHaveFixedRuntimeRep :: !Type -> !FixedRuntimeRepProvenance - -> !ErrInfo -- Extra info accumulated in the TcM monad + -> ![ErrCtxtMsg] -- Extra info accumulated in the TcM monad -> TcRnMessage {-| TcRnImplicitLift is a warning (controlled with -Wimplicit-lift) that occurs when @@ -445,7 +465,7 @@ Test cases: th/T17804 -} - TcRnImplicitLift :: Name -> !ErrInfo -> TcRnMessage + TcRnImplicitLift :: Name -> ![ErrCtxtMsg] -> TcRnMessage {-| TcRnUnusedPatternBinds is a warning (controlled with -Wunused-pattern-binds) that occurs if a pattern binding binds no variables at all, unless it is a @@ -758,6 +778,20 @@ :: RdrName -> TcRnMessage + {- TcRnIllegalPunnedVarOccInTypeArgument is an error raised + when a punned variable occurs in a required type argument. + + Example: + vfun :: forall (a :: k) -> () + f (Just @a a) = vfun a + -- ^^^ + -- which `a` is referenced? + -} + TcRnIllegalPunnedVarOccInTypeArgument + :: { illegalPunTermName :: !ResolvedNameInfo -- ^ How the variable was actually resolved (term namespace) + , illegalPunTypeName :: !ResolvedNameInfo -- ^ How the variable could have been resolved (type namespace) + } -> TcRnMessage + {-| TcRnDuplicateFieldName is an error that occurs whenever there are duplicate field names in a single record. @@ -1472,7 +1506,7 @@ Text cases: module/mod58 -} - TcRnMultipleDefaultDeclarations :: Class -> [LDefaultDecl GhcRn] -> TcRnMessage + TcRnMultipleDefaultDeclarations :: Class -> ClassDefaults -> TcRnMessage {-| TcRnWarnClashingDefaultImports is a warning that occurs when a module imports more than one default declaration for the same class, and they are not all @@ -1496,7 +1530,7 @@ Test cases: typecheck/should_fail/T11974b -} - TcRnBadDefaultType :: LHsType GhcRn -> NE.NonEmpty Class -> TcRnMessage + TcRnBadDefaultType :: LHsType GhcRn -> NonEmpty Class -> TcRnMessage {-| TcRnPatSynBundledWithNonDataCon is an error that occurs when a module's export list bundles a pattern synonym with a type that is not a proper @@ -1603,6 +1637,13 @@ -} TcRnDuplicateExport :: GlobalRdrElt -> IE GhcPs -> IE GhcPs -> TcRnMessage + {-| TcRnDuplicateNamedDefaultExport is a warning (controlled by -Wduplicate-exports) + that occurs when a named default declaration appears in an export list + more than once. + + -} + TcRnDuplicateNamedDefaultExport :: TyCon -> IE GhcPs -> IE GhcPs -> TcRnMessage + {-| TcRnExportedParentChildMismatch is an error that occurs when an export is bundled with a parent that it does not belong to @@ -2007,8 +2048,6 @@ See 'NotInScopeError' for more details. -} TcRnNotInScope :: NotInScopeError -- ^ what the problem is -> RdrName -- ^ the name that is not in scope - -> [ImportError] -- ^ import errors that are relevant - -> [GhcHint] -- ^ hints, e.g. enable DataKinds to refer to a promoted data constructor -> TcRnMessage {-| TcRnTermNameInType is an error that occurs when a term-level identifier @@ -2023,7 +2062,7 @@ Test cases: T21605{c,d} -} - TcRnTermNameInType :: RdrName -> [GhcHint] -> TcRnMessage + TcRnTermNameInType :: !RdrName -> TcRnMessage {-| TcRnUntickedPromotedThing is a warning (controlled with -Wunticked-promoted-constructors) that is triggered by an unticked occurrence of a promoted data constructor. @@ -2051,10 +2090,9 @@ Test cases: rnfail042, T14907b, T15124, T15233. -} - TcRnIllegalBuiltinSyntax :: SDoc -- ^ what kind of thing this is (a binding, fixity declaration, ...) + TcRnIllegalBuiltinSyntax :: SigLike -- ^ what kind of thing this is (a binding, fixity declaration, ...) -> RdrName -> TcRnMessage - -- TODO: remove the SDoc argument. {-| TcRnWarnDefaulting is a warning (controlled by -Wtype-defaults) that is triggered whenever a Wanted typeclass constraint @@ -2263,7 +2301,7 @@ typecheck/should_fail/T7210 rename/should_fail/T22478b -} - TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsBang -> TcRnMessage + TcRnUnexpectedAnnotation :: !(HsType GhcPs) -> !HsSrcBang -> TcRnMessage {-| TcRnIllegalRecordSyntax is an error indicating an illegal use of record syntax. @@ -2274,7 +2312,7 @@ rename/should_fail/T9077 rename/should_fail/T22478b -} - TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage + TcRnIllegalRecordSyntax :: HsType GhcPs -> TcRnMessage {-| TcRnInvalidVisibleKindArgument is an error for a kind application on a target type that cannot accept it. @@ -2448,7 +2486,13 @@ Test cases: T18740a, T18740b, T23739_fail_ret, T23739_fail_case -} - TcRnIllegalTermLevelUse :: !Name -> !TermLevelUseErr -> TcRnMessage + TcRnIllegalTermLevelUse + :: !Bool -- ^ should we give a simple "out of scope" message, + -- instead of a full-blown "Illegal term level use" message? + -> !RdrName -- ^ the user-written identifier + -> !Name -- ^ the type-level 'Name' we resolved it to + -> !TermLevelUseErr + -> TcRnMessage {-| TcRnMatchesHaveDiffNumArgs is an error occurring when something has matches that have different numbers of arguments @@ -2509,11 +2553,11 @@ rename/should_fail/T22478e th/TH_Promoted1Tuple typecheck/should_compile/tcfail094 - typecheck/should_compile/T22141a - typecheck/should_compile/T22141b - typecheck/should_compile/T22141c - typecheck/should_compile/T22141d - typecheck/should_compile/T22141e + typecheck/should_fail/T22141a + typecheck/should_fail/T22141b + typecheck/should_fail/T22141c + typecheck/should_fail/T22141d + typecheck/should_fail/T22141e typecheck/should_compile/T22141f typecheck/should_compile/T22141g typecheck/should_fail/T20873c @@ -2542,21 +2586,6 @@ -} TcRnCannotBindTyVarsInPatBind :: !(NE.NonEmpty (Name, TcTyVar)) -> TcRnMessage - {-| TcRnTooManyTyArgsInConPattern is an error occurring when a constructor pattern - has more than the expected number of type arguments - - Example(s): - f (Just @Int @Bool x) = x - - Test cases: typecheck/should_fail/TyAppPat_TooMany - typecheck/should_fail/T20443b - -} - TcRnTooManyTyArgsInConPattern - :: !ConLike - -> !Int -- ^ Expected number of args - -> !Int -- ^ Actual number of args - -> TcRnMessage - {-| TcRnMultipleInlinePragmas is a warning signifying that multiple inline pragmas reference the same definition. @@ -2595,6 +2624,7 @@ typecheck/should_compile/T10504 -} TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage + -- NB: this constructor is deprecated and will be removed in GHC 9.18 (#25540) {-| TcRnSpecialiseNotVisible is a warning that occurs when the subject of a SPECIALISE pragma has a definition that is not visible from the current module. @@ -3176,6 +3206,14 @@ -} TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage + {-| TcRnSpecSigShape is an error that occurs when the user writes a SPECIALISE + pragma that isn't just a function application. + + Example: + {-# SPECIALISE let x=True in x #-} + -} + TcRnSpecSigShape :: LHsExpr GhcPs -> TcRnMessage + {-| 'TcRnIllegalInvisTyVarBndr' is an error that occurs when invisible type variable binders in type declarations are used without enabling the @TypeAbstractions@ extension. @@ -3235,15 +3273,6 @@ -> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage - {-| TcRnDeprecatedInvisTyArgInConPat is a warning that triggers on type applications - in constructor patterns when the user has not enabled '-XTypeAbstractions' - but instead has enabled both '-XScopedTypeVariables' and '-XTypeApplications'. - - This warning is a deprecation mechanism that is scheduled until GHC 9.12. - -} - TcRnDeprecatedInvisTyArgInConPat - :: TcRnMessage - {-| TcRnUnexpectedStandaloneDerivingDecl is an error thrown when a user uses standalone deriving without enabling the StandaloneDeriving extension. @@ -3291,11 +3320,23 @@ -} TcRnIllegalRuleLhs :: RuleLhsErrReason - -> FastString -- Rule name - -> LHsExpr GhcRn -- Full expression - -> HsExpr GhcRn -- Bad expression + -> FastString -- ^ Rule name + -> LHsExpr GhcRn -- ^ Full expression + -> HsExpr GhcRn -- ^ Bad expression -> TcRnMessage + {-| TcRnRuleLhsEqualities is a warning, controlled by '-Wrule-lhs-equalities', + that is triggered by a RULE whose LHS contains equality constraints + (of a certain form, such as @F a ~ b@ for a type family @F@). + + Test case: typecheck/should_compile/RuleEqs + -} + TcRnRuleLhsEqualities + :: FastString -- ^ rule name + -> LHsExpr GhcRn -- ^ LHS expression + -> NE.NonEmpty Ct -- ^ LHS equality constraints + -> TcRnMessage + {-| TcRnDuplicateRoleAnnot is an error triggered by two or more role annotations for one type @@ -3432,41 +3473,33 @@ -> !LookupInstanceErrReason -> TcRnMessage - {-| TcRnBadlyStaged is an error that occurs when a TH binding is used in an - invalid stage. - - Test cases: - T17820d - -} - TcRnBadlyStaged - :: !StageCheckReason -- ^ The binding being spliced. - -> !Int -- ^ The binding stage. - -> !Int -- ^ The stage at which the binding is used. - -> TcRnMessage - - {-| TcRnStageRestriction is an error that occurs when a top level splice refers to - a local name. + {-| TcRnBadlyLevelled is an error that occurs when a TH binding is used at an + invalid level. Test cases: - T17820, T21547, T5795, qq00[1-4], annfail0{3,4,6,9} + T17820d, T17820, T21547, T5795, qq00[1-4], annfail0{3,4,6,9} -} - TcRnStageRestriction - :: !StageCheckReason -- ^ The binding being spliced. + TcRnBadlyLevelled + :: !LevelCheckReason -- ^ The binding + -> !(Set.Set ThLevelIndex) -- ^ The binding levels + -> !ThLevelIndex -- ^ The level at which the binding is used. + -> !(Maybe ErrorItem) -- ^ The attempt we made to implicitly lift the binding. + -> DiagnosticReason -- ^ Whether to defer this error or fail -> TcRnMessage - {-| TcRnBadlyStagedWarn is a warning that occurs when a TH type binding is + {-| TcRnBadlyLevelledWarn is a warning that occurs when a TH type binding is used in an invalid stage. Controlled by flags: - - Wbadly-staged-type + - Wbadly-levelled-type Test cases: T23829_timely T23829_tardy T23829_hasty -} - TcRnBadlyStagedType + TcRnBadlyLevelledType :: !Name -- ^ The type binding being spliced. - -> !Int -- ^ The binding stage. - -> !Int -- ^ The stage at which the binding is used. + -> !(Set.Set ThLevelIndex) -- ^ The binding stage. + -> !ThLevelIndex -- ^ The stage at which the binding is used. -> TcRnMessage {-| TcRnTyThingUsedWrong is an error that occurs when a thing is used where another @@ -3611,7 +3644,10 @@ Test cases: TcIncompleteRecSel -} - TcRnHasFieldResolvedIncomplete :: !Name -> TcRnMessage + TcRnHasFieldResolvedIncomplete :: !Name -- ^ The selector + -> ![ConLike] -- ^ The partial constructors + -> !Int -- ^ The max number of constructors reported + -> TcRnMessage {-| TcRnBadFieldAnnotation is an error/warning group indicating that a strictness/unpack related data type field annotation is invalid. @@ -4023,7 +4059,8 @@ Test cases: T12411, T12446, T15527, T16133, T18251c -} - TcRnTypeApplicationsDisabled :: !TypeApplication -- ^ what kind of type application is it? + TcRnTypeApplicationsDisabled :: !(HsType GhcPs) + -> !TypeOrKind -> TcRnMessage {-| TcRnInvalidRecordField is an error indicating that a record field was @@ -4313,33 +4350,44 @@ -} TcRnNamespacedWarningPragmaWithoutFlag :: WarnDecl GhcPs -> TcRnMessage - {-| TcRnInvisPatWithNoForAll is an error raised when invisible type pattern - is used without associated `forall` in types + {-| TcRnIllegalInvisibleTypePattern is an error raised when an invisible + type pattern, i.e. a pattern of the form `@p`, is rejected. - Examples: + Example for InvisPatWithoutFlag: + {-# LANGUAGE NoTypeAbstractions #-} + id :: a -> a + id @t x = x + + Examples for InvisPatNoForall: + f :: Int f @t = 5 g :: [a -> a] g = [\ @t x -> x :: t] - Test cases: T17694c T17594d - -} - TcRnInvisPatWithNoForAll :: HsTyPat GhcRn -> TcRnMessage - - {-| TcRnIllegalInvisibleTypePattern is an error raised when invisible type pattern - is used without the TypeAbstractions extension enabled + Examples for InvisPatMisplaced: - Example: + f (smth, $(invisP (varT (newName "blah")))) = ... - {-# LANGUAGE NoTypeAbstractions #-} - id :: a -> a - id @t x = x + g = do + $(invisP (varT (newName "blah"))) <- aciton1 + ... - Test cases: T17694b + Test cases: + T17694b -- InvisPatWithoutFlag + T17694c -- InvisPatNoForall + T17594d -- InvisPatNoForall + T24557a -- InvisPatMisplaced + T24557b -- InvisPatMisplaced + T24557c -- InvisPatMisplaced + T24557d -- InvisPatMisplaced -} - TcRnIllegalInvisibleTypePattern :: HsTyPat GhcPs -> TcRnMessage + TcRnIllegalInvisibleTypePattern + :: !(HsTyPat GhcRn) -- the rejected type pattern + -> !BadInvisPatReason -- the reason for rejection + -> TcRnMessage {-| TcRnNamespacedFixitySigWithoutFlag is an error that occurs when a namespace specifier is used in fixity signatures @@ -4382,24 +4430,6 @@ -> Name -- ^ Type variable's name -> TcRnMessage - {- TcRnMisplacedInvisPat is an error raised when invisible @-pattern - appears in invalid context (e.g. pattern in case of or in do-notation) - or nested inside the pattern. Template Haskell seems to be the only - source for this diagnostic. - - Examples: - - f (smth, $(invisP (varT (newName "blah")))) = ... - - g = do - $(invisP (varT (newName "blah"))) <- aciton1 - ... - - Test cases: T24557a T24557b T24557c T24557d - - -} - TcRnMisplacedInvisPat :: HsTyPat GhcPs -> TcRnMessage - {- TcRnUnexpectedTypeSyntaxInTerms is an error that occurs when type syntax is used in terms without -XRequiredTypeArguments extension enabled @@ -4492,6 +4522,18 @@ | ShadowedNameProvenanceGlobal [GlobalRdrElt] -- ^ The shadowed name is global, typically imported from elsewhere. +-- | Information about a resolved name +data ResolvedNameInfo + = ResolvedNameInfo ![GlobalRdrElt] !RdrName !Name + +instance Outputable ResolvedNameInfo where + ppr (ResolvedNameInfo _ rdr name) = ppr (WithUserRdr rdr name) + +pprResolvedNameProvenance :: ResolvedNameInfo -> SDoc +pprResolvedNameProvenance (ResolvedNameInfo gres _ name) + | gre:_ <- gres = pprNameProvenance gre + | otherwise = text "bound at" <+> ppr (getSrcLoc name) + -- | In what context did we require a type to have a fixed runtime representation? -- -- Used by 'GHC.Tc.Utils.TcMType.checkTypeHasFixedRuntimeRep' for throwing @@ -4788,7 +4830,7 @@ -- f :: a -- -- Test cases: typecheck/should_fail/T13068 - = InstHeadAbstractClass !Class + = InstHeadAbstractClass !(WithUserRdr Name) -- ^ name of the abstract 'Class' -- | An instance whose head is not a class. -- -- Examples(s): @@ -4808,10 +4850,7 @@ -- rename/should_fail/T18240a -- polykinds/T13267 -- deriving/should_fail/T23522 - | InstHeadNonClass - !(Maybe TyCon) -- ^ the 'TyCon' at the head of the instance head, - -- or 'Nothing' if the instance head is not even headed - -- by a 'TyCon' + | InstHeadNonClassHead InstHeadNonClassHead -- | Instance head was headed by a type synonym. -- @@ -4842,6 +4881,13 @@ deriving Generic +-- | What was at the head of an instance head, when we expected a class? +data InstHeadNonClassHead + -- | A 'TyCon' that isn't a class was at the head + = InstNonClassTyCon (WithUserRdr Name) (TyConFlavour Name) + -- | Something else than a 'TyCon' was at the head + | InstNonTyCon + -- | Why is a (type or data) family instance invalid? data IllegalFamilyInstanceReason {-| A top-level family instance for a 'TyCon' that isn't a family 'TyCon'. @@ -5021,7 +5067,7 @@ -- -- Test cases: none. | AssocMultipleDefaults !Name - -- | Invalid arguments in an associated family instance. + -- | Invalid arguments in an associated family instance default declaration. -- -- See t'AssocDefaultBadArgs'. | AssocDefaultBadArgs !TyCon ![Type] AssocDefaultBadArgs @@ -5307,17 +5353,19 @@ data SolverReport = SolverReport { sr_important_msg :: SolverReportWithCtxt - , sr_supplementary :: [SolverReportSupplementary] + , sr_supplementary :: [SupplementaryInfo] + , sr_hints :: [GhcHint] } --- | Additional information to print in a 'SolverReport', after the +-- | Additional information to print in an error message, after the -- important messages and after the error context. -- -- See Note [Error report]. -data SolverReportSupplementary - = SupplementaryBindings RelevantBindings - | SupplementaryHoleFits ValidHoleFits - | SupplementaryCts [(PredType, RealSrcSpan)] +data SupplementaryInfo + = SupplementaryBindings RelevantBindings + | SupplementaryHoleFits ValidHoleFits + | SupplementaryCts (NE.NonEmpty (PredType, RealSrcSpan)) + | SupplementaryImportErrors (NE.NonEmpty ImportError) -- | A 'TcSolverReportMsg', together with context (e.g. enclosing implication constraints) -- that are needed in order to report it. @@ -5523,17 +5571,6 @@ -- See 'FixedRuntimeRepErrorInfo' and 'FixedRuntimeRepContext' for more information. | FixedRuntimeRepError [FixedRuntimeRepErrorInfo] - -- | An equality between two types is blocked on a kind equality - -- between their kinds. - -- - -- Test cases: none. - | BlockedEquality ErrorItem - -- These are for the "blocked" equalities, as described in - -- Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality, - -- wrinkle (EIK2). There should always be another unsolved wanted around, - -- which will ordinarily suppress this message. But this can still be printed out - -- with -fdefer-type-errors (sigh), so we must produce a message. - -- | Something was not applied to sufficiently many arguments. -- -- Example: @@ -5578,11 +5615,8 @@ { cannotResolve_item :: ErrorItem , cannotResolve_unifiers :: [ClsInst] , cannotResolve_candidates :: [ClsInst] - , cannotResolve_importErrors :: [ImportError] - , cannotResolve_suggestions :: [GhcHint] - , cannotResolve_relevant_bindings :: RelevantBindings } - -- TODO: remove the fields of type [GhcHint] and RelevantBindings, - -- in order to handle them uniformly with other diagnostic messages. + , cannotResolve_relBinds :: RelevantBindings + } -- | Could not solve a constraint using available instances -- because the instances overlap. @@ -5603,6 +5637,8 @@ , unsafeOverlap_match :: ClsInst , unsafeOverlapped :: NE.NonEmpty ClsInst } + | MultiplicityCoercionsNotSupported + deriving Generic data MismatchMsg @@ -5622,19 +5658,9 @@ , mismatch_mb_same_occ :: Maybe SameOccInfo } - -- | A type has an unexpected kind. - -- - -- Test cases: T2994, T7609, ... - | KindMismatch - { kmismatch_what :: TypedThing -- ^ What thing is 'kmismatch_actual' the kind of? - , kmismatch_expected :: Type - , kmismatch_actual :: Type - } - -- TODO: combine with 'BasicMismatch'. - -- | A mismatch between two types, which arose from a type equality. -- - -- Test cases: T1470, tcfail212. + -- Test cases: T1470, tcfail212, T2994, T7609. | TypeEqMismatch { teq_mismatch_item :: ErrorItem , teq_mismatch_ty1 :: Type @@ -5783,16 +5809,58 @@ -- | Missing @type@ keyword when importing a type. -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) -- Then we want to suggest using `import TypeLits( type (+) )` - | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled? + | BadImportAvailTyCon -- | Trying to import a data constructor directly, e.g. -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@ | BadImportAvailDataCon OccName -- | The parent does not export the given children. - | BadImportNotExportedSubordinates [OccName] + | BadImportNotExportedSubordinates !GlobalRdrElt (NonEmpty FastString) + -- | Incorrect @type@ keyword when importing subordinates that aren't types. + | BadImportNonTypeSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt) + -- | Incorrect @data@ keyword when importing something which isn't a term. + | BadImportNonDataSubordinates !GlobalRdrElt (NonEmpty GlobalRdrElt) -- | Incorrect @type@ keyword when importing something which isn't a type. | BadImportAvailVar deriving Generic +{- Note [Reasons for BadImportAvailTyCon] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +BadImportAvailTyCon means a name is available in the TcCls namespace +but name resolution could not use it. Possible reasons for that: + +- Case (TyOp) `import M ((#))` or `import M (data (#))` + The user tried to import a type operator without using the `type` keyword, + or using a different keyword. Suggested fix: add 'type'. + +- Case (DataKw) `import M (data T)` + The user tried to import a non-operator type constructor, but mistakenly + used the `data` keyword, which restricted the lookup to the value namespace. + Suggested fix: remove 'data'; no need to add 'type' for non-operators. + +- Case (PatternKw) `import M (pattern T)` + Same as the (DataKw) case, mutatis mutandis. + +Any other case would not have resulted in BadImportAvailTyCon. +-} + +-- | Describes what category of subordinate we are dealing with, e.g. +-- a method of a class, a field of a record, etc. +data Subordinate + = MethodOfClass -- ^ A method of a class + | AssociatedTypeOfClass -- ^ An associated type of a class + | FieldOfConstructor -- ^ A field of a constructor + + deriving Generic + +pprSubordinate :: Name -> Subordinate -> SDoc +pprSubordinate parent_nm = \case + MethodOfClass -> + text "method of class" <+> quotes (ppr parent_nm) + AssociatedTypeOfClass -> + text "associated type of class" <+> quotes (ppr parent_nm) + FieldOfConstructor -> + text "field of constructor" <+> quotes (ppr parent_nm) + -- | Some form of @"not in scope"@ error. See also the 'OutOfScopeHole' -- constructor of 'HoleError'. data NotInScopeError @@ -5820,8 +5888,7 @@ -- A type signature, fixity declaration, pragma, standalone kind signature... -- is missing an associated binding. - | MissingBinding SDoc [GhcHint] - -- TODO: remove the SDoc argument. + | MissingBinding SigLike [GhcHint] -- | Couldn't find a top-level binding. -- @@ -5834,7 +5901,9 @@ -- | A class doesn't have a method with this name, -- or, a class doesn't have an associated type with this name, -- or, a record doesn't have a record field with this name. - | UnknownSubordinate SDoc + | UnknownSubordinate + Name -- ^ name of the parent + Subordinate -- ^ the kind of subordinate -- | A name is not in scope during type checking but passed the renamer. -- @@ -5843,10 +5912,6 @@ | NotInScopeTc (NameEnv TcTyThing) deriving Generic --- | Create a @"not in scope"@ error message for the given 'RdrName'. -mkTcRnNotInScope :: RdrName -> NotInScopeError -> TcRnMessage -mkTcRnNotInScope rdr err = TcRnNotInScope err rdr [] noHints - -- | Configuration for pretty-printing valid hole fits. data HoleFitDispConfig = HFDC { showWrap, showWrapVars, showType, showProv, showMatches @@ -5864,7 +5929,7 @@ -- See 'NotInScopeError' for other not-in-scope errors. -- -- Test cases: T9177a. - = OutOfScopeHole [ImportError] [GhcHint] + = OutOfScopeHole -- | Report a typed hole, or wildcard, with additional information. | HoleError HoleSort [TcTyVar] -- Other type variables which get computed on the way. @@ -5908,8 +5973,59 @@ -- | Couldn't find a module with the requested name. = MissingModule ModuleName -- | The imported modules don't export what we're looking for. - | ModulesDoNotExport (NE.NonEmpty Module) OccName + | ModulesDoNotExport (NE.NonEmpty Module) WhatLooking OccName +-- What kind of suggestion are we looking for? #19843 +data WhatLooking = WL_Anything + -- ^ Any sugestion + | WL_Constructor + -- ^ Suggest type constructors, data constructors + -- (including promoted data constructors), and pattern + -- synonyms. + | WL_TyCon + -- ^ Suggest type constructors/classes only; do not + -- include promoted data constructors. + | WL_TyCon_or_TermVar + -- ^ Suggest type constructors and term variables, + -- but not data constructors nor type variables + | WL_TyVar + -- ^ Suggest type variables only. + | WL_ConLike + -- ^ Suggest term-level data constructors and pattern + -- synonyms; no type constructors or promoted data + -- constructors + | WL_RecField + -- ^ Suggest record fields + -- + -- E.g. in @K { f1 = True, f2 = False }@, if @f2@ is not in + -- scope, suggest only constructor fields + | WL_Term + -- ^ Suggest terms + -- + -- If we are expecting a term value, then only suggest + -- terms (e.g. term variables, data constructors) and + -- not type constructors or type variables + | WL_TermVariable + -- ^ Suggest term variables (and record fields) + | WL_Type + -- ^ Suggest types: type constructors, type variables, + -- promoted data constructors. + | WL_None + -- ^ No suggestions + -- + -- This is is used for rebindable syntax, where there + -- is no point in suggesting alternative spellings + deriving (Eq, Show) + +-- | In what namespaces should we look for a subordinate +-- of the given 'GlobalRdrElt'. +lookingForSubordinate :: GlobalRdrElt -> WhatLooking +lookingForSubordinate parent_gre = + case greInfo parent_gre of + IAmTyCon ClassFlavour + -> WL_TyCon_or_TermVar + _ -> WL_Term + -- | This datatype collates instances that match or unifier, -- in order to report an error message for an unsolved typeclass constraint. data PotentialInstances @@ -5973,6 +6089,10 @@ , frr_info_not_concrete :: Maybe (TcTyVar, TcType) -- ^ Which non-concrete type did we try to -- unify this concrete type variable with? + , frr_info_other_origin :: Maybe CtOrigin + -- ^ Did the representation polymorphism check arise + -- from another constraint? If so, record that 'CtOrigin' here + -- (it will never be a 'FRROrigin'). } {- @@ -5983,17 +6103,20 @@ ************************************************************************ -} --- AZ:TODO: Change these all to be Name instead of RdrName. --- Merge TcType.UserTypeContext in to it. +-- | An error message context, for errors in the renamer. +-- +-- TODO: this should probably get merged in some way with 'ErrCtxtMsg', +-- but that's a battle for another day. data HsDocContext - = TypeSigCtx SDoc - | StandaloneKindSigCtx SDoc + = TypeSigCtx [LocatedN RdrName] + | StandaloneKindSigCtx (LocatedN RdrName) | PatCtx | SpecInstSigCtx | DefaultDeclCtx | ForeignDeclCtx (LocatedN RdrName) | DerivDeclCtx | RuleCtx FastString + | SpecECtx RdrName | TyDataCtx (LocatedN RdrName) | TySynCtx (LocatedN RdrName) | TyFamilyCtx (LocatedN RdrName) @@ -6006,7 +6129,16 @@ | HsTypePatCtx | GHCiCtx | SpliceTypeCtx (LHsType GhcPs) - | ClassInstanceCtx + | ReifyInstancesCtx + | ClassInstanceCtx (LHsType GhcRn) + | ClassMethodSigCtx (LocatedN RdrName) -- ^ Class method signature + | SpecialiseSigCtx (LocatedN RdrName) -- ^ SPECIALISE signature + | PatSynSigCtx [LocatedN RdrName] -- ^ Pattern synonym signature + + -- | Escape hatch, for GHC plugins and other GHC API users. + -- + -- Not for use within GHC; add a new constructor to 'HsDocContext' + -- if you need to add a new renamer error context. | GenericCtx SDoc -- | Context for a mismatch in the number of arguments @@ -6108,9 +6240,9 @@ | WrongThingTyCon | WrongThingAxiom -data StageCheckReason - = StageCheckInstance !InstanceWhat !PredType - | StageCheckSplice !Name +data LevelCheckReason + = LevelCheckInstance !InstanceWhat !PredType + | LevelCheckSplice !Name !(Maybe GlobalRdrElt) data UninferrableTyVarCtx = UninfTyCtx_ClassContext [TcType] @@ -6139,13 +6271,28 @@ T14761a, T7562 -} UnpackWithoutStrictness :: BadFieldAnnotationReason - {-| An UNPACK pragma was applied to an abstract type in an indefinite package - in Backpack. + {-| An UNPACK pragma is unusable. + A possible reason for this warning is that the UNPACK pragma was applied to + one of the following: + + * a function type @a -> b@ + * a recursive use of the data type being defined + * a sum type that cannot be unpacked, see @Note [UNPACK for sum types]@ + * a type/data family application with no matching instance in the environment + + However, it is deliberately /not/ emitted if: + + * the failure occurs in an indefinite package in Backpack + * the pragma is usable, but unpacking is disabled by @-O0@ + Test cases: - unpack_sums_5, T3966, T7050 + unpack_sums_5, T3966, T7050, T25672, T23307c + + Negative test cases (must not trigger this warning): + T3990 -} - BackpackUnpackAbstractType :: BadFieldAnnotationReason + UnusableUnpackPragma :: BadFieldAnnotationReason deriving (Generic) data SuperclassCycle = @@ -6191,10 +6338,12 @@ | TyFamsDisabledInstance !TyCon deriving (Generic) -data TypeApplication - = TypeApplication !(HsType GhcPs) !TypeOrKind - | TypeApplicationInPattern !(HsConPatTyArg GhcPs) - deriving Generic +-- | Why was an invisible pattern `@p` rejected? +data BadInvisPatReason + = InvisPatWithoutFlag + | InvisPatNoForall + | InvisPatMisplaced + deriving (Generic) -- | Why was the empty case rejected? data BadEmptyCaseReason @@ -6243,6 +6392,14 @@ DodgyImportsHiding !ImportLookupReason deriving (Generic) +-- | What extensions were enabled at import site. +data ImportLookupExtensions = + ImportLookupExtensions + { ile_pattern_synonyms :: !Bool + , ile_explicit_namespaces :: !Bool + } + deriving (Generic) + -- | Different types of errors for import lookup. data ImportLookupReason where {-| An item in an import statement is not exported by the corresponding @@ -6256,7 +6413,7 @@ -> ModIface -> ImpDeclSpec -> IE GhcPs - -> Bool -- ^ whether @-XPatternSynonyms@ was enabled + -> ImportLookupExtensions -> ImportLookupReason {-| A name is specified with a qualifying module. @@ -6606,13 +6763,6 @@ -} = NonExactName !RdrName - {-| QuotedNameWrongStage is an error that can happen when a - (non-top-level) Name is used at a different Template Haskell stage - than the stage at which it is bound. - - Test cases: T16976z - -} - | QuotedNameWrongStage !(HsQuote GhcPs) deriving Generic data THReifyError @@ -6798,6 +6948,8 @@ | InvalidImplicitParamBinding | DefaultDataInstDecl ![LDataFamInstDecl GhcPs] | FunBindLacksEquations !TH.Name + | EmptyGuard + | EmptyParStmt deriving Generic data IllegalDecls @@ -6824,6 +6976,7 @@ data UnrepresentableTypeDescr = LinearInvisibleArgument | CoercionsInTypes + | DataConVisibleForall -- FFI error types data IllegalForeignTypeReason diff --git a/GHC/Tc/Errors/Types/PromotionErr.hs b/GHC/Tc/Errors/Types/PromotionErr.hs --- a/GHC/Tc/Errors/Types/PromotionErr.hs +++ b/GHC/Tc/Errors/Types/PromotionErr.hs @@ -1,8 +1,12 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} + module GHC.Tc.Errors.Types.PromotionErr ( PromotionErr(..) , pprPECategory , peCategory , TermLevelUseErr(..) + , TermLevelUseCtxt(..) + , pprTermLevelUseCtxt , teCategory ) where @@ -11,6 +15,8 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Generics (Generic) +import GHC.Types.Name.Reader (GlobalRdrElt, pprNameProvenance) +import GHC.Types.Name (Name, nameSrcLoc) data PromotionErr = TyConPE -- TyCon used in a kind before we are ready @@ -65,6 +71,17 @@ teCategory ClassTE = "class" teCategory TyConTE = "type constructor" teCategory TyVarTE = "type variable" + +data TermLevelUseCtxt + = TermLevelUseGRE !GlobalRdrElt + | TermLevelUseTyVar + deriving (Generic) + +pprTermLevelUseCtxt :: Name -> TermLevelUseCtxt -> SDoc +pprTermLevelUseCtxt nm = \case + TermLevelUseGRE gre -> pprNameProvenance gre + TermLevelUseTyVar -> text "bound at" <+> ppr (nameSrcLoc nm) + {- Note [Type variable scoping errors during typechecking] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/Tc/Gen/Annotation.hs b/GHC/Tc/Gen/Annotation.hs --- a/GHC/Tc/Gen/Annotation.hs +++ b/GHC/Tc/Gen/Annotation.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} -- | Typechecking annotations -module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where +module GHC.Tc.Gen.Annotation ( tcAnnotations ) where import GHC.Prelude @@ -23,8 +23,6 @@ import GHC.Hs -import GHC.Utils.Outputable - import GHC.Types.Name import GHC.Types.Annotations import GHC.Types.SrcLoc @@ -54,7 +52,7 @@ let target = annProvenanceToTarget mod provenance -- Run that annotation and construct the full Annotation data structure - setSrcSpanA loc $ addErrCtxt (annCtxt ann) $ do + setSrcSpanA loc $ addErrCtxt (AnnCtxt ann) $ do -- See #10826 -- Annotations allow one to bypass Safe Haskell. dflags <- getDynFlags when (safeLanguageOn dflags) $ failWithTc TcRnAnnotationInSafeHaskell @@ -66,6 +64,3 @@ annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod -annCtxt :: (OutputableBndrId p) => AnnDecl (GhcPass p) -> SDoc -annCtxt ann - = hang (text "In the annotation:") 2 (ppr ann) diff --git a/GHC/Tc/Gen/App.hs b/GHC/Tc/Gen/App.hs --- a/GHC/Tc/Gen/App.hs +++ b/GHC/Tc/Gen/App.hs @@ -16,7 +16,6 @@ module GHC.Tc.Gen.App ( tcApp - , tcInferSigma , tcExprPrag ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr ) @@ -33,6 +32,7 @@ import GHC.Tc.Utils.Concrete ( unifyConcrete, idConcreteTvs ) import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence +import GHC.Tc.Types.ErrCtxt ( FunAppCtxtFunArg(..) ) import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType import GHC.Tc.Utils.Concrete( hasFixedRuntimeRep_syntactic ) @@ -166,26 +166,6 @@ {- ********************************************************************* * * - tcInferSigma -* * -********************************************************************* -} - -tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType --- Used only to implement :type; see GHC.Tc.Module.tcRnExpr --- True <=> instantiate -- return a rho-type --- False <=> don't instantiate -- return a sigma-type -tcInferSigma inst (L loc rn_expr) - = addExprCtxt rn_expr $ - setSrcSpanA loc $ - do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr - ; do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead fun - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (tc_fun, fun_ctxt) fun_sigma rn_args - ; _ <- tcValArgs do_ql inst_args - ; return app_res_sigma } - -{- ********************************************************************* -* * Typechecking n-ary applications * * ********************************************************************* -} @@ -218,9 +198,9 @@ A "head" has three special cases (for which we can infer a polytype using tcInferAppHead_maybe); otherwise is just any old expression (for -which we can infer a rho-type (via tcInfer). +which we can infer a rho-type (via runInferExpr). -There is no special treatment for HsUnboundVar, HsOverLit etc, because +There is no special treatment for HsHole (HsVar ...), HsOverLit, etc, because we can't get a polytype from them. Left and right sections (e.g. (x +) and (+ x)) are not yet supported. @@ -402,13 +382,22 @@ -- Step 2: Infer the type of `fun`, the head of the application ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; let tc_head = (tc_fun, fun_ctxt) + -- inst_final: top-instantiate the result type of the application, + -- EXCEPT if we are trying to infer a sigma-type + inst_final = case exp_res_ty of + Check {} -> True + Infer (IR {ir_inst=iif}) -> + case iif of + IIF_ShallowRho -> True + IIF_DeepRho -> True + IIF_Sigma -> False -- Step 3: Instantiate the function type (taking a quick look at args) ; do_ql <- wantQuickLook rn_fun ; (inst_args, app_res_rho) <- setQLInstLevel do_ql $ -- See (TCAPP1) and (TCAPP2) in -- Note [tcApp: typechecking applications] - tcInstFun do_ql True tc_head fun_sigma rn_args + tcInstFun do_ql inst_final tc_head fun_sigma rn_args ; case do_ql of NoQL -> do { traceTc "tcApp:NoQL" (ppr rn_fun $$ ppr app_res_rho) @@ -419,6 +408,7 @@ app_res_rho exp_res_ty -- Step 4.2: typecheck the arguments ; tc_args <- tcValArgs NoQL inst_args + -- Step 4.3: wrap up ; finishApp tc_head tc_args app_res_rho res_wrap } @@ -426,14 +416,17 @@ -- Step 5.1: Take a quick look at the result type ; quickLookResultType app_res_rho exp_res_ty + -- Step 5.2: typecheck the arguments, and monomorphise -- any un-unified instantiation variables ; tc_args <- tcValArgs DoQL inst_args - -- Step 5.3: typecheck the arguments + -- Step 5.3: zonk to expose the polymophism hidden under + -- QuickLook instantiation variables in `app_res_rho` ; app_res_rho <- liftZonkM $ zonkTcType app_res_rho + -- Step 5.4: subsumption check against the expected type ; res_wrap <- checkResultTy rn_expr tc_head inst_args - app_res_rho exp_res_ty + app_res_rho exp_res_ty -- Step 5.5: wrap up ; finishApp tc_head tc_args app_res_rho res_wrap } } @@ -459,20 +452,21 @@ ; res_expr <- if isTagToEnum tc_fun then tcTagToEnum tc_head tc_args app_res_rho else return (rebuildHsApps tc_head tc_args) + ; traceTc "End tcApp }" (ppr tc_fun) ; return (mkHsWrap res_wrap res_expr) } +-- | Connect up the inferred type of an application with the expected type. +-- This is usually just a unification, but with deep subsumption there is more to do. checkResultTy :: HsExpr GhcRn -> (HsExpr GhcTc, AppCtxt) -- Head -> [HsExprArg p] -- Arguments, just error messages -> TcRhoType -- Inferred type of the application; zonked to - -- expose foralls, but maybe not deeply instantiated + -- expose foralls, but maybe not /deeply/ instantiated -> ExpRhoType -- Expected type; this is deeply skolemised -> TcM HsWrapper --- Connect up the inferred type of the application with the expected type --- This is usually just a unification, but with deep subsumption there is more to do -checkResultTy _ _ _ app_res_rho (Infer inf_res) - = do { co <- fillInferResult app_res_rho inf_res - ; return (mkWpCastN co) } +checkResultTy rn_expr _fun _inst_args app_res_rho (Infer inf_res) + = fillInferResult (exprCtOrigin rn_expr) app_res_rho inf_res + -- fillInferResult does deep instantiation if DeepSubsumption is on checkResultTy rn_expr (tc_fun, fun_ctxt) inst_args app_res_rho (Check res_ty) -- Unify with expected type from the context @@ -500,8 +494,6 @@ -- Even though both app_res_rho and res_ty are rho-types, -- they may have nested polymorphism, so if deep subsumption -- is on we must call tcSubType. - -- Zonk app_res_rho first, because QL may have instantiated some - -- delta variables to polytypes, and tcSubType doesn't expect that do { wrap <- tcSubTypeDS rn_expr app_res_rho res_ty ; traceTc "checkResultTy 2 }" (ppr app_res_rho $$ ppr res_ty) ; return wrap } } @@ -614,7 +606,7 @@ -------------------- wantQuickLook :: HsExpr GhcRn -> TcM QLFlag -wantQuickLook (HsVar _ (L _ f)) +wantQuickLook (HsVar _ (L _ (WithUserRdr _ f))) | getUnique f `elem` quickLookKeys = return DoQL wantQuickLook _ = do { impred <- xoptM LangExt.ImpredicativeTypes ; if impred then return DoQL else return NoQL } @@ -630,18 +622,16 @@ ********************************************************************* -} tcInstFun :: QLFlag - -> Bool -- False <=> Instantiate only /inferred/ variables at the end + -> Bool -- False <=> Instantiate only /top-level, inferred/ variables; -- so may return a sigma-type - -- True <=> Instantiate all type variables at the end: - -- return a rho-type - -- The /only/ call site that passes in False is the one - -- in tcInferSigma, which is used only to implement :type - -- Otherwise we do eager instantiation; in Fig 5 of the paper + -- True <=> Instantiate /top-level, invisible/ type variables; + -- always return a rho-type (but not a deep-rho type) + -- Generally speaking we pass in True; in Fig 5 of the paper -- |-inst returns a rho-type -> (HsExpr GhcTc, AppCtxt) -> TcSigmaType -> [HsExprArg 'TcpRn] -> TcM ( [HsExprArg 'TcpInst] - , TcSigmaType ) + , TcSigmaType ) -- Does not instantiate trailing invisible foralls -- This crucial function implements the |-inst judgement in Fig 4, plus the -- modification in Fig 5, of the QL paper: -- "A quick look at impredicativity" (ICFP'20). @@ -679,17 +669,13 @@ fun_is_out_of_scope -- See Note [VTA for out-of-scope functions] = case tc_fun of - HsUnboundVar {} -> True + HsHole _ -> True _ -> False inst_fun :: [HsExprArg 'TcpRn] -> ForAllTyFlag -> Bool - -- True <=> instantiate a tyvar with this ForAllTyFlag + -- True <=> instantiate a tyvar that has this ForAllTyFlag inst_fun [] | inst_final = isInvisibleForAllTyFlag | otherwise = const False - -- Using `const False` for `:type` avoids - -- `forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). a -> b` - -- turning into `forall a {r2} (b :: TYPE r2). a -> b`. - -- See #21088. inst_fun (EValArg {} : _) = isInvisibleForAllTyFlag inst_fun _ = isInferredForAllTyFlag @@ -904,7 +890,7 @@ ; case ctxt of VACall fun arg_no _ | not in_generated_code -> do setSrcSpanA arg_loc $ - addErrCtxt (funAppCtxt fun arg arg_no) $ + addErrCtxt (FunAppCtxt (FunAppCtxtExpr fun arg) arg_no) $ thing_inside VAExpansion (OrigStmt (L _ stmt@(BindStmt {}))) _ loc @@ -975,6 +961,7 @@ -- only parts of it are, e.g. `vfun (Maybe Int)` or `vfun (Maybe (type Int))`. -- Apply a recursive T2T transformation. HsWC [] <$> go e + <* failIfErrsM -- Suppress unhelpful errors that arise after a failed T2T where go :: LHsExpr GhcRn -> TcM (LHsType GhcRn) go (L _ (HsEmbTy _ t)) = @@ -989,9 +976,9 @@ ; res' <- go res ; return (L l (HsFunTy noExtField mult' arg' res'))} where - go_arrow :: HsArrowOf (LHsExpr GhcRn) GhcRn -> TcM (HsArrow GhcRn) - go_arrow (HsUnrestrictedArrow{}) = pure (HsUnrestrictedArrow noExtField) - go_arrow (HsLinearArrow{}) = pure (HsLinearArrow noExtField) + go_arrow :: HsMultAnnOf (LHsExpr GhcRn) GhcRn -> TcM (HsMultAnn GhcRn) + go_arrow (HsUnannotated _) = pure (HsUnannotated noExtField) + go_arrow (HsLinearAnn{}) = pure (HsLinearAnn noExtField) go_arrow (HsExplicitMult _ exp) = HsExplicitMult noExtField <$> go exp go (L l (HsForAll _ tele expr)) = do { ty <- go expr @@ -1001,9 +988,11 @@ ; ty <- go expr ; return (L l (HsQualTy noExtField (L ann ctxt') ty)) } go (L l (HsVar _ lname)) = - -- as per #281: variables and constructors (regardless of their namespace) - -- are mapped directly, without modification. - return (L l (HsTyVar noAnn NotPromoted lname)) + -- GHC Proposal #281, section 7.5 "T2T-Mapping": + -- variables and constructors (regardless of their namespace) + -- are mapped directly, without modification. + do { detect_puns lname + ; return (L l (HsTyVar noAnn NotPromoted lname)) } go (L l (HsApp _ lhs rhs)) = do { lhs' <- go lhs ; rhs' <- go rhs @@ -1055,7 +1044,7 @@ = do { t <- go (L l e) ; let splice_result' = HsUntypedSpliceTop finalizers t ; return (L l (HsSpliceTy splice_result' splice)) } - go (L l (HsUnboundVar _ rdr)) + go (L l (HsHole (HoleVar (L _ rdr)))) | isUnderscore occ = return (L l (HsWildCardTy noExtField)) | startsWithUnderscore occ = -- See Note [Wildcards in the T2T translation] @@ -1065,7 +1054,7 @@ else not_in_scope } | otherwise = not_in_scope where occ = occName rdr - not_in_scope = failWith $ mkTcRnNotInScope rdr NotInScope + not_in_scope = failWith $ TcRnNotInScope NotInScope rdr go (L l (XExpr (ExpandedThingRn (OrigExpr orig) _))) = -- Use the original, user-written expression (before expansion). -- Example. Say we have vfun :: forall a -> blah @@ -1077,6 +1066,30 @@ go (L l orig) go e = failWith $ TcRnIllformedTypeArgument e + detect_puns :: LocatedN (WithUserRdr Name) -> TcM () + -- GHC Proposal #281, section 7.5 "T2T-Mapping": + -- there should be no variable of the same name but from + -- a different namespace, or else raise an ambiguity error + -- (does not apply to constructors) + detect_puns (L l (WithUserRdr rdr _)) + | isTermVarOrFieldNameSpace (rdrNameSpace rdr) + , Just promoted_rdr <- promoteRdrName rdr + = do { envs <- getRdrEnvs + ; whenIsJust (lookup_rdr envs rdr) $ \unpromoted -> + whenIsJust (lookup_rdr envs promoted_rdr) $ \promoted -> + addErrAt (locA l) $ + TcRnIllegalPunnedVarOccInTypeArgument { illegalPunTermName = unpromoted + , illegalPunTypeName = promoted } } + | otherwise = return () + + lookup_rdr :: (GlobalRdrEnv, LocalRdrEnv) -> RdrName -> Maybe ResolvedNameInfo + lookup_rdr (gbl_env, lcl_env) rdr + | Just name <- lookupLocalRdrEnv lcl_env rdr + = Just (ResolvedNameInfo [] rdr name) + | gres@(gre:_) <- lookupGRE gbl_env (LookupRdrName rdr (RelevantGREsFOS WantNormal)) + = Just (ResolvedNameInfo gres rdr (gre_name gre)) + | otherwise = Nothing + unwrap_wc :: HsWildCardBndrs GhcRn t -> TcM t unwrap_wc (HsWC wcs t) = do { mapM_ (illegal_wc . nameRdrName) wcs @@ -1127,7 +1140,7 @@ vfun [x | x <- xs] Can't convert list comprehension to a type vfun (\x -> x) Can't convert a lambda to a type * It needs to check for LangExt.NamedWildCards to generate an appropriate - error message for HsUnboundVar. + error message for HsHole (HsVar ...). vfun _a Not in scope: ‘_a’ (NamedWildCards disabled) vfun _a Illegal named wildcard in a required type argument: ‘_a’ @@ -1189,20 +1202,19 @@ -- -- See [Wrinkle: VTA] in Note [Representation-polymorphism checking built-ins] -- in GHC.Tc.Utils.Concrete. - ; th_stage <- getStage + ; th_lvl <- getThLevel ; ty_arg <- case mb_conc of Nothing -> return ty_arg0 Just conc -- See [Wrinkle: Typed Template Haskell] -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. - | Brack _ (TcPending {}) <- th_stage + | TypedBrack {} <- th_lvl -> return ty_arg0 | otherwise -> -- Example: user wrote e.g. (#,#) @(F Bool) for a type family F. -- Emit [W] F Bool ~ kappa[conc] and pretend the user wrote (#,#) @kappa. - do { mco <- unifyConcrete (occNameFS $ getOccName $ tv_nm) conc ty_arg0 - ; return $ case mco of { MRefl -> ty_arg0; MCo co -> coercionRKind co } } + coercionRKind <$> unifyConcrete (occNameFS $ getOccName $ tv_nm) conc ty_arg0 ; let fun_ty = mkForAllTy tvb inner_ty in_scope = mkInScopeSet (tyCoVarsOfTypes [fun_ty, ty_arg]) @@ -1337,17 +1349,18 @@ Syntax of abstractions in Pat ----------------------------- * Type patterns are represented in Pat roughly like this - data Pat = ConPat ConLike [HsTyPat] [Pat] -- (Con @tp1 @tp2 p1 p2) (constructor pattern) - | EmbTyPat HsTyPat -- (type tp) (embed a type into a pattern with `type`) + data Pat = ConPat ConLike [Pat] -- (Con @tp1 @tp2 p1 p2) (constructor pattern) + | EmbTyPat HsTyPat -- (type tp) (embed a type into a pattern with `type`) + | InvisPat HsTyPat -- (@tp) (invisible type pattern) | ... data HsTyPat = HsTP LHsType (In ConPat, the type and term arguments are actually inside HsConPatDetails.) - * Similar to HsAppType in HsExpr, the [HsTyPat] in ConPat is used just for @ty arguments + * Similar to HsAppType in HsExpr, InvisPat in ConPat is used for @ty arguments * Similar to HsEmbTy in HsExpr, EmbTyPat lets you embed a type in a pattern * Examples: - \ (MkT @a (x :: a)) -> rhs -- ConPat (c.o. Pat) and HsConPatTyArg (c.o. HsConPatTyArg) + \ (MkT @a (x :: a)) -> rhs -- ConPat (c.o. Pat) and InvisPat (c.o. Pat) \ (type a) (x :: a) -> rhs -- EmbTyPat (c.o. Pat) \ a (x :: a) -> rhs -- VarPat (c.o. Pat) \ @a (x :: a) -> rhs -- InvisPat (c.o. Pat) @@ -1478,7 +1491,7 @@ Suppose 'wurble' is not in scope, and we have (wurble @Int @Bool True 'x') -Then the renamer will make (HsUnboundVar "wurble") for 'wurble', +Then the renamer will make (HsHole (HsVar "wurble")) for 'wurble', and the typechecker will typecheck it with tcUnboundId, giving it a type 'alpha', and emitting a deferred Hole constraint, to be reported later. @@ -1493,7 +1506,7 @@ give its type. Fortunately in tcInstFun we still have access to the function, so we -can check if it is a HsUnboundVar. We use this info to simply skip +can check if it is a HsHole. We use this info to simply skip over any visible type arguments. We'll /already/ have emitted a Hole constraint; failing preserves that constraint. @@ -2038,22 +2051,22 @@ = go_flexi1 kappa ty2 go_flexi1 kappa ty2 -- ty2 is zonked - | -- See Note [QuickLook unification] (UQL1) - simpleUnifyCheck UC_QuickLook kappa ty2 - , checkTopShape (metaTyVarInfo kappa) ty2 - -- NB: don't forget to do a shape check, as we might be dealing - -- with an ordinary metavariable (and not a quick-look instantiation variable). - -- (Forgetting this led to #25950.) - = do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind - -- unifyKind: see (UQL2) in Note [QuickLook unification] - -- and (MIV2) in Note [Monomorphise instantiation variables] - ; let ty2' = mkCastTy ty2 co - ; traceTc "qlUnify:update" $ - ppr kappa <+> text ":=" <+> ppr ty2 - ; liftZonkM $ writeMetaTyVar kappa ty2' } - - | otherwise - = return () -- Occurs-check or forall-bound variable + = do { cur_lvl <- getTcLevel + -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles + -- Here we are in the TcM monad, which does not track enclosing + -- Given equalities; so for quick-look unification we conservatively + -- treat /any/ level outside this one as untouchable. Hence cur_lvl. + ; case simpleUnifyCheck UC_QuickLook cur_lvl kappa ty2 of + SUC_CanUnify -> + do { co <- unifyKind (Just (TypeThing ty2)) ty2_kind kappa_kind + -- unifyKind: see (UQL2) in Note [QuickLook unification] + -- and (MIV2) in Note [Monomorphise instantiation variables] + ; let ty2' = mkCastTy ty2 co + ; traceTc "qlUnify:update" $ + ppr kappa <+> text ":=" <+> ppr ty2 + ; liftZonkM $ writeMetaTyVar kappa ty2' } + _ -> return () -- e.g. occurs-check or forall-bound variable + } where kappa_kind = tyVarKind kappa ty2_kind = typeKind ty2 diff --git a/GHC/Tc/Gen/Arrow.hs b/GHC/Tc/Gen/Arrow.hs --- a/GHC/Tc/Gen/Arrow.hs +++ b/GHC/Tc/Gen/Arrow.hs @@ -40,7 +40,6 @@ import GHC.Types.Var.Set import GHC.Builtin.Types.Prim import GHC.Types.Basic( Arity ) -import GHC.Types.Error import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Utils.Panic @@ -155,17 +154,17 @@ ; return (HsCmdPar x cmd') } tc_cmd env (HsCmdLet x binds (L body_loc body)) res_ty - = do { (binds', _, body') <- tcLocalBinds binds $ - setSrcSpan (locA body_loc) $ - tc_cmd env body res_ty + = do { (binds', body') <- tcLocalBinds binds $ + setSrcSpan (locA body_loc) $ + tc_cmd env body res_ty ; return (HsCmdLet x binds' (L body_loc body')) } tc_cmd env in_cmd@(HsCmdCase x scrut matches) (stk, res_ty) - = addErrCtxt (cmdCtxt in_cmd) $ do + = addErrCtxt (CmdCtxt in_cmd) $ do do { (scrut', scrut_ty) <- tcInferRho scrut ; hasFixedRuntimeRep_syntactic (FRRArrow $ ArrowCmdCase) scrut_ty - ; (mult_co_wrap, matches') <- tcCmdMatches env scrut_ty matches (stk, res_ty) - ; return (HsCmdCase x (mkLHsWrap mult_co_wrap scrut') matches') } + ; matches' <- tcCmdMatches env scrut_ty matches (stk, res_ty) + ; return (HsCmdCase x scrut' matches') } tc_cmd env (HsCmdIf x NoSyntaxExprRn pred b1 b2) res_ty -- Ordinary 'if' = do { pred' <- tcCheckMonoExpr pred boolTy @@ -211,7 +210,7 @@ -- (plus -<< requires ArrowApply) tc_cmd env cmd@(HsCmdArrApp _ fun arg ho_app lr) (_, res_ty) - = addErrCtxt (cmdCtxt cmd) $ + = addErrCtxt (CmdCtxt cmd) $ do { arg_ty <- newOpenFlexiTyVarTy ; let fun_ty = mkCmdArrTy env arg_ty res_ty ; fun' <- select_arrow_scope (tcCheckMonoExpr fun fun_ty) @@ -242,7 +241,7 @@ -- D;G |-a cmd exp : stk --> res tc_cmd env cmd@(HsCmdApp x fun arg) (cmd_stk, res_ty) - = addErrCtxt (cmdCtxt cmd) $ + = addErrCtxt (CmdCtxt cmd) $ do { arg_ty <- newOpenFlexiTyVarTy ; fun' <- tcCmd env fun (mkPairTy arg_ty cmd_stk, res_ty) ; arg' <- tcCheckMonoExpr arg arg_ty @@ -261,7 +260,7 @@ tc_cmd env cmd@(HsCmdLam x lam_variant match) cmd_ty = (case lam_variant of -- Add context only for \case and \cases LamSingle -> id -- Avoids clutter in the vanilla-lambda form - _ -> addErrCtxt (cmdCtxt cmd)) $ + _ -> addErrCtxt (CmdCtxt cmd)) $ do { let match_ctxt = ArrowLamAlt lam_variant ; arity <- checkArgCounts match ; (wrap, match') <- tcCmdMatchLambda env match_ctxt arity match cmd_ty @@ -291,7 +290,7 @@ -- D; G |-a (| e c1 ... cn |) : stk --> t tc_cmd env cmd@(HsCmdArrForm fixity expr f cmd_args) (cmd_stk, res_ty) - = addErrCtxt (cmdCtxt cmd) + = addErrCtxt (CmdCtxt cmd) do { (cmd_args', cmd_tys) <- mapAndUnzipM tc_cmd_arg cmd_args -- We use alphaTyVar for 'w' ; let e_ty = mkInfForAllTy alphaTyVar $ @@ -317,7 +316,7 @@ -> TcTypeFRR -- ^ Type of the scrutinee. -> MatchGroup GhcRn (LHsCmd GhcRn) -- ^ case alternatives -> CmdType - -> TcM (HsWrapper, MatchGroup GhcTc (LHsCmd GhcTc)) + -> TcM (MatchGroup GhcTc (LHsCmd GhcTc)) tcCmdMatches env scrut_ty matches (stk, res_ty) = tcCaseMatches ctxt tc_body (unrestricted scrut_ty) matches (mkCheckExpType res_ty) where @@ -339,7 +338,7 @@ ; let check_arg_tys = map (unrestricted . mkCheckExpType) arg_tys ; matches' <- forM matches $ - addErrCtxt . pprMatchInCtxt . unLoc <*> tc_match check_arg_tys cmd_stk' + addErrCtxt . MatchInCtxt . unLoc <*> tc_match check_arg_tys cmd_stk' ; let arg_tys' = map unrestricted arg_tys mg' = mg { mg_alts = L l matches' @@ -362,8 +361,8 @@ pg_ctxt = PatGuard match_ctxt tc_grhss (GRHSs x grhss binds) stk_ty res_ty - = do { (binds', _, grhss') <- tcLocalBinds binds $ - mapM (wrapLocMA (tc_grhs stk_ty res_ty)) grhss + = do { (binds',grhss') <- tcLocalBinds binds $ + mapM (wrapLocMA (tc_grhs stk_ty res_ty)) grhss ; return (GRHSs x grhss' binds') } tc_grhs stk_ty res_ty (GRHS x guards body) @@ -471,14 +470,3 @@ arrowTyConKind :: Kind -- *->*->* arrowTyConKind = mkVisFunTysMany [liftedTypeKind, liftedTypeKind] liftedTypeKind - -{- -************************************************************************ -* * - Errors -* * -************************************************************************ --} - -cmdCtxt :: HsCmd GhcRn -> SDoc -cmdCtxt cmd = text "In the command:" <+> ppr cmd diff --git a/GHC/Tc/Gen/Bind.hs b/GHC/Tc/Gen/Bind.hs --- a/GHC/Tc/Gen/Bind.hs +++ b/GHC/Tc/Gen/Bind.hs @@ -59,8 +59,9 @@ import GHC.Core.FamInstEnv( normaliseType ) import GHC.Core.Class ( Class ) import GHC.Core.Coercion( mkSymCo ) -import GHC.Core.Type (mkStrLitTy, tidyOpenTypeX, mkCastTy) +import GHC.Core.Type (mkStrLitTy, mkCastTy) import GHC.Core.TyCo.Ppr( pprTyVars ) +import GHC.Core.TyCo.Tidy( tidyOpenTypeX ) import GHC.Builtin.Types ( mkConstraintTupleTy, multiplicityTy, oneDataConTy ) import GHC.Builtin.Types.Prim @@ -77,7 +78,6 @@ import GHC.Types.SourceFile import GHC.Types.SrcLoc -import GHC.Utils.Error import GHC.Utils.Misc import GHC.Types.Basic import GHC.Utils.Outputable as Outputable @@ -92,7 +92,7 @@ import GHC.Data.Maybe import Control.Monad -import Data.Foldable (find) +import Data.Foldable (find, traverse_) {- ************************************************************************ @@ -192,14 +192,7 @@ -- The TcLclEnv has an extended type envt for the new bindings tcTopBinds binds sigs = do { -- Pattern synonym bindings populate the global environment - (binds', wrap, (tcg_env, tcl_env)) <- tcValBinds TopLevel binds sigs getEnvs - ; massertPpr (isIdHsWrapper wrap) - (text "Non-identity multiplicity wrapper at toplevel:" <+> ppr wrap) - -- The wrapper (`wrap`) is always the identity because toplevel - -- binders are unrestricted (and `tcSubmult _ ManyTy` returns the - -- identity wrapper). Therefore it's safe to drop it altogether. - -- - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + (binds', (tcg_env, tcl_env)) <- tcValBinds TopLevel binds sigs getEnvs ; specs <- tcImpPrags sigs -- SPECIALISE prags for imported Ids @@ -229,17 +222,16 @@ ------------------------ --- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. tcLocalBinds :: HsLocalBinds GhcRn -> TcM thing - -> TcM (HsLocalBinds GhcTc, HsWrapper, thing) + -> TcM (HsLocalBinds GhcTc, thing) tcLocalBinds (EmptyLocalBinds x) thing_inside = do { thing <- thing_inside - ; return (EmptyLocalBinds x, idHsWrapper, thing) } + ; return (EmptyLocalBinds x, thing) } tcLocalBinds (HsValBinds x (XValBindsLR (NValBinds binds sigs))) thing_inside - = do { (binds', wrapper, thing) <- tcValBinds NotTopLevel binds sigs thing_inside - ; return (HsValBinds x (XValBindsLR (NValBinds binds' sigs)), wrapper, thing) } + = do { (binds', thing) <- tcValBinds NotTopLevel binds sigs thing_inside + ; return (HsValBinds x (XValBindsLR (NValBinds binds' sigs)), thing) } tcLocalBinds (HsValBinds _ (ValBinds {})) _ = panic "tcLocalBinds" tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside @@ -251,10 +243,7 @@ ; (ev_binds, result) <- checkConstraints (IPSkol ips) [] given_ips thing_inside - -- We don't have linear implicit parameters, yet. So the wrapper can be - -- the identity. - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; return (HsIPBinds x (IPBinds ev_binds ip_binds') , idHsWrapper, result) } + ; return (HsIPBinds x (IPBinds ev_binds ip_binds') , result) } where ips = [ip | (L _ (IPBind _ (L _ ip) _)) <- ip_binds] @@ -265,26 +254,14 @@ tc_ip_bind ipClass (IPBind _ l_name@(L _ ip) expr) = do { ty <- newFlexiTyVarTy liftedTypeKind -- see #24298 ; let p = mkStrLitTy $ hsIPNameFS ip - ; ip_id <- newDict ipClass [ p, ty ] + ; ip_id <- newDict ipClass [p, ty] ; expr' <- tcCheckMonoExpr expr ty - ; let d = fmap (toDict ipClass p ty) expr' - ; return (ip_id, (IPBind ip_id l_name d)) } - - -- Coerces a `t` into a dictionary for `IP "x" t`. - -- co : t -> IP "x" t - toDict :: Class -- IP class - -> Type -- type-level string for name of IP - -> Type -- type of IP - -> HsExpr GhcTc -- def'n of IP variable - -> HsExpr GhcTc -- dictionary for IP - toDict ipClass x ty = mkHsWrap $ mkWpCastR $ - wrapIP $ mkClassPred ipClass [x,ty] + ; return (ip_id, IPBind ip_id l_name expr') } --- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. tcValBinds :: TopLevelFlag -> [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM thing - -> TcM ([(RecFlag, LHsBinds GhcTc)], HsWrapper, thing) + -> TcM ([(RecFlag, LHsBinds GhcTc)], thing) tcValBinds top_lvl binds sigs thing_inside = do { -- Typecheck the signatures @@ -303,7 +280,7 @@ -- For the moment, let bindings and top-level bindings introduce -- only unrestricted variables. ; tcExtendSigIds top_lvl poly_ids $ - do { (binds', wrapper, (extra_binds', thing)) + do { (binds', (extra_binds', thing)) <- tcBindGroups top_lvl sig_fn prag_fn binds $ do { thing <- thing_inside -- See Note [Pattern synonym builders don't yield dependencies] @@ -312,17 +289,16 @@ ; let extra_binds = [ (NonRecursive, builder) | builder <- patsyn_builders ] ; return (extra_binds, thing) } - ; return (binds' ++ extra_binds', wrapper, thing) }} + ; return (binds' ++ extra_binds', thing) }} where patsyns = getPatSynBinds binds prag_fn = mkPragEnv sigs (concatMap snd binds) ------------------------ --- Why an HsWrapper? See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv -> [(RecFlag, LHsBinds GhcRn)] -> TcM thing - -> TcM ([(RecFlag, LHsBinds GhcTc)], HsWrapper, thing) + -> TcM ([(RecFlag, LHsBinds GhcTc)], thing) -- Typecheck a whole lot of value bindings, -- one strongly-connected component at a time -- Here a "strongly connected component" has the straightforward @@ -331,16 +307,16 @@ tcBindGroups _ _ _ [] thing_inside = do { thing <- thing_inside - ; return ([], idHsWrapper, thing) } + ; return ([], thing) } tcBindGroups top_lvl sig_fn prag_fn (group : groups) thing_inside = do { -- See Note [Closed binder groups] type_env <- getLclTypeEnv ; let closed = isClosedBndrGroup type_env (snd group) - ; (group', outer_wrapper, (groups', inner_wrapper, thing)) + ; (group', (groups', thing)) <- tc_group top_lvl sig_fn prag_fn group closed $ tcBindGroups top_lvl sig_fn prag_fn groups thing_inside - ; return (group' ++ groups', outer_wrapper <.> inner_wrapper, thing) } + ; return (group' ++ groups', thing) } -- Note [Closed binder groups] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -363,7 +339,7 @@ tc_group :: forall thing. TopLevelFlag -> TcSigFun -> TcPragEnv -> (RecFlag, LHsBinds GhcRn) -> IsGroupClosed -> TcM thing - -> TcM ([(RecFlag, LHsBinds GhcTc)], HsWrapper, thing) + -> TcM ([(RecFlag, LHsBinds GhcTc)], thing) -- Typecheck one strongly-connected component of the original program. -- We get a list of groups back, because there may @@ -377,9 +353,9 @@ [bind] -> bind [] -> panic "tc_group: empty list of binds" _ -> panic "tc_group: NonRecursive binds is not a singleton bag" - ; (bind', wrapper, thing) <- tc_single top_lvl sig_fn prag_fn bind closed - thing_inside - ; return ( [(NonRecursive, bind')], wrapper, thing) } + ; (bind', thing) <- tc_single top_lvl sig_fn prag_fn bind closed + thing_inside + ; return ( [(NonRecursive, bind')], thing) } tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside = -- To maximise polymorphism, we do a new @@ -390,8 +366,8 @@ do { traceTc "tc_group rec" (pprLHsBinds binds) ; whenIsJust mbFirstPatSyn $ \lpat_syn -> recursivePatSynErr (locA $ getLoc lpat_syn) binds - ; (binds1, wrapper, thing) <- go sccs - ; return ([(Recursive, binds1)], wrapper, thing) } + ; (binds1, thing) <- go sccs + ; return ([(Recursive, binds1)], thing) } -- Rec them all together where mbFirstPatSyn = find (isPatSyn . unLoc) binds @@ -401,15 +377,15 @@ sccs :: [SCC (LHsBind GhcRn)] sccs = stronglyConnCompFromEdgedVerticesUniq (mkEdges sig_fn binds) - go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTc, HsWrapper, thing) + go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTc, thing) go (scc:sccs) = do { (binds1, ids1) <- tc_scc scc -- recursive bindings must be unrestricted -- (the ids added to the environment here are the name of the recursive definitions). - ; ((binds2, inner_wrapper, thing), outer_wrapper) <- + ; (binds2, thing) <- tcExtendLetEnv top_lvl sig_fn closed ids1 (go sccs) - ; return (binds1 ++ binds2, outer_wrapper <.> inner_wrapper, thing) } - go [] = do { thing <- thing_inside; return ([], idHsWrapper, thing) } + ; return (binds1 ++ binds2, thing) } + go [] = do { thing <- thing_inside; return ([], thing) } tc_scc (AcyclicSCC bind) = tc_sub_group NonRecursive [bind] tc_scc (CyclicSCC binds) = tc_sub_group Recursive binds @@ -428,13 +404,13 @@ tc_single :: forall thing. TopLevelFlag -> TcSigFun -> TcPragEnv -> LHsBind GhcRn -> IsGroupClosed -> TcM thing - -> TcM (LHsBinds GhcTc, HsWrapper, thing) + -> TcM (LHsBinds GhcTc, thing) tc_single _top_lvl sig_fn prag_fn (L loc (PatSynBind _ psb)) _ thing_inside = do { (aux_binds, tcg_env) <- tcPatSynDecl (L loc psb) sig_fn prag_fn ; thing <- setGblEnv tcg_env thing_inside - ; return (aux_binds, idHsWrapper, thing) + ; return (aux_binds, thing) } tc_single top_lvl sig_fn prag_fn lbind closed thing_inside @@ -442,8 +418,8 @@ NonRecursive NonRecursive closed [lbind] - ; (thing, wrapper) <- tcExtendLetEnv top_lvl sig_fn closed ids thing_inside - ; return (binds1, wrapper, thing) } + ; thing <- tcExtendLetEnv top_lvl sig_fn closed ids thing_inside + ; return (binds1, thing) } ------------------------ type BKey = Int -- Just number off the bindings @@ -503,8 +479,8 @@ ; let plan = decideGeneralisationPlan dflags top_lvl closed sig_fn bind_list ; traceTc "Generalisation plan" (ppr plan) ; result@(_, scaled_poly_ids) <- case plan of - NoGen -> tcPolyNoGen rec_tc prag_fn sig_fn bind_list - InferGen -> tcPolyInfer rec_tc prag_fn sig_fn bind_list + NoGen -> tcPolyNoGen rec_tc prag_fn sig_fn bind_list + InferGen -> tcPolyInfer top_lvl rec_tc prag_fn sig_fn bind_list CheckGen lbind sig -> tcPolyCheck prag_fn sig lbind ; let poly_ids = map scaledThing scaled_poly_ids @@ -520,7 +496,7 @@ ; return result } where binder_names = collectHsBindListBinders CollNoDictBinders bind_list - loc = foldr1 combineSrcSpans (map (locA . getLoc) bind_list) + loc = foldr1WithDefault noSrcSpan combineSrcSpans (map (locA . getLoc) bind_list) -- The mbinds have been dependency analysed and -- may no longer be adjacent; so find the narrowest -- span that includes them all @@ -606,11 +582,11 @@ -- the BinderStack, whence it shows up in "Relevant bindings.." ; mono_name <- newNameAt (nameOccName name) (locA nm_loc) - ; mult <- tcMultAnn (HsNoMultAnn noExtField) + ; mult <- newMultiplicityVar ; (wrap_gen, (wrap_res, matches')) <- tcSkolemiseCompleteSig sig $ \invis_pat_tys rho_ty -> - let mono_id = mkLocalId mono_name (varMult poly_id) rho_ty in + let mono_id = mkLocalId mono_name (idMult poly_id) rho_ty in tcExtendBinderStack [TcIdBndr mono_id NotTopLevel] $ -- Why mono_id in the BinderStack? -- See Note [Relevant bindings and the binder stack] @@ -738,12 +714,13 @@ -} tcPolyInfer - :: RecFlag -- Whether it's recursive after breaking + :: TopLevelFlag + -> RecFlag -- Whether it's recursive after breaking -- dependencies based on type signatures -> TcPragEnv -> TcSigFun -> [LHsBind GhcRn] -> TcM (LHsBinds GhcTc, [Scaled TcId]) -tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list +tcPolyInfer top_lvl rec_tc prag_fn tc_sig_fn bind_list = do { (tclvl, wanted, (binds', mono_infos)) <- pushLevelAndCaptureConstraints $ tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list @@ -752,7 +729,7 @@ -- AbsBinds which are PatBinds can't be linear. -- See (NVP2) in Note [Non-variable pattern bindings aren't linear] - ; binds' <- manyIfPats binds' + ; manyIfPats binds' ; traceTc "tcPolyInfer" (ppr apply_mr $$ ppr (map mbi_sig mono_infos)) @@ -763,7 +740,7 @@ ; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted) ; ((qtvs, givens, ev_binds, insoluble), residual) - <- captureConstraints $ simplifyInfer tclvl infer_mode sigs name_taus wanted + <- captureConstraints $ simplifyInfer top_lvl tclvl infer_mode sigs name_taus wanted ; let inferred_theta = map evVarPred givens ; scaled_exports <- checkNoErrs $ @@ -790,17 +767,12 @@ ; return ([abs_bind], scaled_poly_ids) } -- poly_ids are guaranteed zonked by mkExport where - manyIfPat bind@(L _ (PatBind{pat_lhs=(L _ (VarPat{}))})) - = return bind - manyIfPat (L loc pat@(PatBind {pat_mult=mult_ann, pat_lhs=lhs, pat_ext =(pat_ty,_)})) - = do { mult_co_wrap <- tcSubMult (NonLinearPatternOrigin GeneralisedPatternReason nlWildPatName) ManyTy (getTcMultAnn mult_ann) - -- The wrapper checks for correct multiplicities. - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; let lhs' = mkLHsWrapPat mult_co_wrap lhs pat_ty - ; return $ L loc pat {pat_lhs=lhs'} - } - manyIfPat bind = return bind - manyIfPats binds' = traverse manyIfPat binds' + manyIfPat (L _ (PatBind{pat_lhs=(L _ (VarPat{}))})) + = return () + manyIfPat (L _ (PatBind {pat_mult=mult_ann})) + = tcSubMult (NonLinearPatternOrigin GeneralisedPatternReason nlWildPatName) ManyTy (getTcMultAnn mult_ann) + manyIfPat _ = return () + manyIfPats binds' = traverse_ manyIfPat binds' checkMonomorphismRestriction :: [MonoBindInfo] -> [LHsBind GhcRn] -> TcM Bool -- True <=> apply the MR @@ -930,9 +902,11 @@ ; poly_id <- mkInferredPolyId residual insoluble qtvs theta poly_name mb_sig mono_ty -- NB: poly_id has a zonked type - ; poly_id <- addInlinePrags poly_id prag_sigs - ; spec_prags <- tcSpecPrags poly_id prag_sigs - -- tcPrags requires a zonked poly_id + ; poly_id <- addInlinePrags poly_id prag_sigs + ; spec_prags <- tcExtendIdEnv1 poly_name poly_id $ + tcSpecPrags poly_id prag_sigs + -- tcSpecPrags requires a zonked poly_id. It also needs poly_id to + -- be in the type env (so we can typecheck the SPECIALISE expression) -- See Note [Impedance matching] -- NB: we have already done checkValidType, including an ambiguity check, @@ -1151,12 +1125,10 @@ chooseInferredQuantifiers _ _ _ _ (Just sig) = pprPanic "chooseInferredQuantifiers" (ppr sig) -mk_inf_msg :: Name -> TcType -> TidyEnv -> ZonkM (TidyEnv, SDoc) +mk_inf_msg :: Name -> TcType -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) mk_inf_msg poly_name poly_ty tidy_env = do { (tidy_env1, poly_ty) <- zonkTidyTcType tidy_env poly_ty - ; let msg = vcat [ text "When checking the inferred type" - , nest 2 $ ppr poly_name <+> dcolon <+> ppr poly_ty ] - ; return (tidy_env1, msg) } + ; return (tidy_env1, InferredTypeCtxt poly_name poly_ty) } -- | Warn the user about polymorphic local binders that lack type signatures. localSigWarn :: Id -> Maybe TcIdSigInst -> TcM () @@ -1300,27 +1272,6 @@ to Integer because of Num. See #7173. If we're dealing with a nondefaultable class, impedance matching can fail. See #23427. -Note [SPECIALISE pragmas] -~~~~~~~~~~~~~~~~~~~~~~~~~ -There is no point in a SPECIALISE pragma for a non-overloaded function: - reverse :: [a] -> [a] - {-# SPECIALISE reverse :: [Int] -> [Int] #-} - -But SPECIALISE INLINE *can* make sense for GADTS: - data Arr e where - ArrInt :: !Int -> ByteArray# -> Arr Int - ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2) - - (!:) :: Arr e -> Int -> e - {-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-} - {-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-} - (ArrInt _ ba) !: (I# i) = I# (indexIntArray# ba i) - (ArrPair _ a1 a2) !: i = (a1 !: i, a2 !: i) - -When (!:) is specialised it becomes non-recursive, and can usefully -be inlined. Scary! So we only warn for SPECIALISE *without* INLINE -for a non-overloaded function. - ************************************************************************ * * tcMonoBinds @@ -1351,11 +1302,11 @@ | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , Nothing <- sig_fn name -- ...with no type signature = setSrcSpanA b_loc $ - do { mult <- tcMultAnn (HsNoMultAnn noExtField) + do { mult <- newMultiplicityVar ; ((co_fn, matches'), rhs_ty') - <- tcInferFRR (FRRBinder name) $ \ exp_ty -> - -- tcInferFRR: the type of a let-binder must have + <- runInferRhoFRR (FRRBinder name) $ \ exp_ty -> + -- runInferRhoFRR: the type of a let-binder must have -- a fixed runtime rep. See #23176 tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $ -- We extend the error context even for a non-recursive @@ -1379,11 +1330,11 @@ [L b_loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_ann })] | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , all (isNothing . sig_fn) bndrs - = addErrCtxt (patMonoBindsCtxt pat grhss) $ - do { mult <- tcMultAnn mult_ann + = addErrCtxt (PatMonoBindsCtxt pat grhss) $ + do { mult <- tcMultAnnOnPatBind mult_ann - ; (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty -> - -- tcInferFRR: the type of each let-binder must have + ; (grhss', pat_ty) <- runInferRhoFRR FRRPatBind $ \ exp_ty -> + -- runInferRhoFRR: the type of each let-binder must have -- a fixed runtime rep. See #23176 tcGRHSsPat mult grhss exp_ty @@ -1547,12 +1498,12 @@ -- Just g = ...f... -- Hence always typechecked with InferGen do { mono_info <- tcLhsSigId no_gen (name, sig) - ; mult <- tcMultAnn (HsNoMultAnn noExtField) + ; mult <- newMultiplicityVar ; return (TcFunBind mono_info (locA nm_loc) mult matches) } | otherwise -- No type signature = do { mono_ty <- newOpenFlexiTyVarTy - ; mult <- tcMultAnn (HsNoMultAnn noExtField) + ; mult <- newMultiplicityVar ; mono_id <- newLetBndr no_gen name mult mono_ty ; let mono_info = MBI { mbi_poly_name = name , mbi_sig = Nothing @@ -1567,11 +1518,11 @@ ; let inst_sig_fun = lookupNameEnv $ mkNameEnv $ [ (mbi_poly_name mbi, mbi_mono_id mbi) | mbi <- sig_mbis ] - ; mult <- tcMultAnn mult_ann + ; mult <- tcMultAnnOnPatBind mult_ann -- See Note [Typechecking pattern bindings] ; ((pat', nosig_mbis), pat_ty) - <- addErrCtxt (patMonoBindsCtxt pat grhss) $ - tcInferFRR FRRPatBind $ \ exp_ty -> + <- addErrCtxt (PatMonoBindsCtxt pat grhss) $ + runInferSigmaFRR FRRPatBind $ \ exp_ty -> tcLetPat inst_sig_fun no_gen pat (Scaled mult exp_ty) $ -- The above inferred type get an unrestricted multiplicity. It may be -- worth it to try and find a finer-grained multiplicity here @@ -1654,7 +1605,7 @@ -- That's why we have the special case for a single FunBind in tcMonoBinds tcExtendIdBinderStackForRhs infos $ do { traceTc "tcRhs: pat bind" (ppr pat' $$ ppr pat_ty) - ; grhss' <- addErrCtxt (patMonoBindsCtxt pat' grhss) $ + ; grhss' <- addErrCtxt (PatMonoBindsCtxt pat' grhss) $ tcGRHSsPat mult grhss (mkCheckExpType pat_ty) ; return ( PatBind { pat_lhs = pat', pat_rhs = grhss' @@ -1662,13 +1613,13 @@ , pat_mult = setTcMultAnn mult mult_ann } )} --- | @'tcMultAnn' ann@ takes an optional multiplicity annotation. If +-- | @'tcMultAnnOnPatBind' ann@ takes an optional multiplicity annotation. If -- present the multiplicity is returned, otherwise a fresh unification variable -- is generated so that multiplicity can be inferred. -tcMultAnn :: HsMultAnn GhcRn -> TcM Mult -tcMultAnn (HsPct1Ann _) = return oneDataConTy -tcMultAnn (HsMultAnn _ p) = tcCheckLHsTypeInContext p (TheKind multiplicityTy) -tcMultAnn (HsNoMultAnn _) = newFlexiTyVarTy multiplicityTy +tcMultAnnOnPatBind :: HsMultAnn GhcRn -> TcM Mult +tcMultAnnOnPatBind (HsLinearAnn _) = return oneDataConTy +tcMultAnnOnPatBind (HsExplicitMult _ p) = tcCheckLHsTypeInContext p (TheKind multiplicityTy) +tcMultAnnOnPatBind (HsUnannotated _) = newMultiplicityVar tcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a tcExtendTyVarEnvForRhs Nothing thing_inside @@ -1892,7 +1843,7 @@ Just (TcIdSig (TcPartialSig {})) -> True _ -> False has_mult_anns_and_pats = any has_mult_ann_and_pat lbinds - has_mult_ann_and_pat (L _ (PatBind{pat_mult=HsNoMultAnn{}})) = False + has_mult_ann_and_pat (L _ (PatBind{pat_mult=HsUnannotated{}})) = False has_mult_ann_and_pat (L _ (PatBind{pat_lhs=(L _ (VarPat{}))})) = False has_mult_ann_and_pat (L _ (PatBind{})) = True has_mult_ann_and_pat _ = False @@ -1964,15 +1915,3 @@ applying to, well, local bindings. -} -{- ********************************************************************* -* * - Error contexts and messages -* * -********************************************************************* -} - --- This one is called on LHS, when pat and grhss are both Name --- and on RHS, when pat is TcId and grhss is still Name -patMonoBindsCtxt :: (OutputableBndrId p) - => LPat (GhcPass p) -> GRHSs GhcRn (LHsExpr GhcRn) -> SDoc -patMonoBindsCtxt pat grhss - = hang (text "In a pattern binding:") 2 (pprPatBind pat grhss) diff --git a/GHC/Tc/Gen/Default.hs b/GHC/Tc/Gen/Default.hs --- a/GHC/Tc/Gen/Default.hs +++ b/GHC/Tc/Gen/Default.hs @@ -5,9 +5,10 @@ -} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} -- | Typechecking @default@ declarations -module GHC.Tc.Gen.Default ( tcDefaults ) where +module GHC.Tc.Gen.Default ( tcDefaultDecls, extendDefaultEnvWithLocalDefaults ) where import GHC.Prelude import GHC.Hs @@ -16,12 +17,12 @@ import GHC.Core.Class import GHC.Core.Predicate ( Pred (..), classifyPredType ) -import GHC.Data.Maybe ( firstJusts ) +import GHC.Data.Maybe ( firstJusts, maybeToList ) import GHC.Tc.Errors.Types import GHC.Tc.Gen.HsType -import GHC.Tc.Solver ( solveWanteds ) import GHC.Tc.Solver.Monad ( runTcS ) +import GHC.Tc.Solver.Solve ( solveWanteds ) import GHC.Tc.Types.Constraint ( isEmptyWC, andWC, mkSimpleWC ) import GHC.Tc.Types.Origin ( CtOrigin(DefaultOrigin) ) import GHC.Tc.Utils.Env @@ -30,23 +31,19 @@ import GHC.Tc.Utils.TcType import GHC.Types.Basic ( TypeOrKind(..) ) -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), defaultEnv ) -import GHC.Types.Error +import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults (..), lookupDefaultEnv, insertDefaultEnv, DefaultProvenance (..) ) import GHC.Types.SrcLoc -import GHC.Unit.Types (Module, bignumUnit, ghcInternalUnit, moduleUnit, primUnit) -import GHC.Utils.Misc (fstOf3, sndOf3) +import GHC.Unit.Types (ghcInternalUnit, moduleUnit) + import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt -import Data.Function (on) -import Data.List.NonEmpty ( NonEmpty (..), groupBy ) +import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromMaybe) import Data.Traversable ( for ) - {- Note [Named default declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ With the `NamedDefaults` language extension, a `default` declaration can specify type-class @@ -87,7 +84,7 @@ * The `DefaultEnv` of all defaults in scope in a module is kept in the `tcg_default` field of `TcGblEnv`. -* This field is populated by `GHC.Tc.Gen.Default.tcDefaults` which typechecks +* This field is populated by `GHC.Tc.Gen.Default.tcDefaultDecls` which typechecks any local or imported `default` declarations. * Only a single default declaration can be in effect in any single module for @@ -104,7 +101,7 @@ in effect be `default Num (Integer, Double)` as specified by Haskell Language Report. - See Note [Default class defaults] in GHC.Tc.Utils.Env + See Note [Builtin class defaults] in GHC.Tc.Utils.Env * Beside the defaults, the `ExtendedDefaultRules` and `OverloadedStrings` extensions also affect the traditional `default` declarations that don't name @@ -121,61 +118,54 @@ tracked separately from `ImportAvails`, and returned separately from them by `GHC.Rename.Names.rnImports`. -* Class defaults are exported explicitly, as the example above shows. A module's - exported defaults are tracked in `tcg_default_exports`, which are then - transferred to `mg_defaults`, `md_defaults`, and `mi_defaults_`. +* Class defaults are exported explicitly. + For example, + module M( ..., default C, ... ) + exports the defaults for class C. + + A module's exported defaults are computed by exports_from_avail, + tracked in tcg_default_exports, which are then transferred to mg_defaults, + md_defaults, and mi_defaults_. + + Only defaults explicitly exported are actually exported. + (i.e. No defaults are exported in a module header like: + module M where ...) + See Note [Default exports] in GHC.Tc.Gen.Export * Since the class defaults merely help the solver infer the correct types, they leave no trace in Haskell Core. -} --- See Note [Named default declarations] -tcDefaults :: [LDefaultDecl GhcRn] - -> TcM DefaultEnv -- Defaulting types to heave - -- into Tc monad for later use - -- in Disambig. - -tcDefaults [] - = getDeclaredDefaultTys -- No default declaration, so get the - -- default types from the envt; - -- i.e. use the current ones - -- (the caller will put them back there) - -- It's important not to return defaultDefaultTys here (which - -- we used to do) because in a TH program, tcDefaults [] is called - -- repeatedly, once for each group of declarations between top-level - -- splices. We don't want to carefully set the default types in - -- one group, only for the next group to ignore them and install - -- defaultDefaultTys - -tcDefaults decls - = do { tcg_env <- getGblEnv - ; let - here = tcg_mod tcg_env - is_internal_unit = moduleUnit here `elem` [bignumUnit, ghcInternalUnit, primUnit] - ; case (is_internal_unit, decls) of - -- Some internal GHC modules contain @default ()@ to declare that no defaults can take place - -- in the module. - -- We shortcut the treatment of such a default declaration with no class nor types: we won't - -- try to point 'cd_class' to 'Num' since it may not even exist yet. - { (True, [L _ (DefaultDecl _ Nothing [])]) - -> return $ defaultEnv [] - -- Otherwise we take apart the declaration into the class constructor and its default types. - ; _ -> - do { h2010_dflt_clss <- getH2010DefaultClasses - ; decls' <- mapMaybeM (declarationParts h2010_dflt_clss) decls - ; let - -- Find duplicate default declarations - decl_tag (mb_cls, _, _) = - case mb_cls of - Nothing -> Nothing - Just cls -> if cls `elem` h2010_dflt_clss - then Nothing - else Just cls - decl_groups = groupBy ((==) `on` decl_tag) decls' - ; decls_without_dups <- mapM (reportDuplicates here h2010_dflt_clss) decl_groups - ; return $ defaultEnv (concat decls_without_dups) - } } } +-- | Typecheck a collection of default declarations. These can be either: +-- +-- - Haskell 98 default declarations, of the form @default (Float, Double)@ +-- - Named default declarations, of the form @default Cls(Int, Char)@. +-- See Note [Named default declarations] +tcDefaultDecls :: [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] +tcDefaultDecls decls = + do + tcg_env <- getGblEnv + let here = tcg_mod tcg_env + is_internal_unit = moduleUnit here == ghcInternalUnit + case (is_internal_unit, decls) of + -- No default declarations + (_, []) -> return [] + -- As per Remark [default () in ghc-internal] in Note [Builtin class defaults], + -- some modules in ghc-internal include an empty `default ()` declaration, in order + -- to disable built-in defaults. This is no longer necessary (see `GHC.Tc.Utils.Env.tcGetDefaultTys`), + -- but we must still make sure not to error if we fail to look up e.g. the 'Num' + -- typeclass when typechecking such a default declaration. To do this, we wrap + -- calls of 'tcLookupClass' in 'tryTc'. + (True, [L _ (DefaultDecl _ Nothing [])]) -> do + h2010_dflt_clss <- foldMapM (fmap maybeToList . fmap fst . tryTc . tcLookupClass) =<< getH2010DefaultNames + case NE.nonEmpty h2010_dflt_clss of + Nothing -> return [] + Just h2010_dflt_clss' -> toClassDefaults h2010_dflt_clss' decls + -- Otherwise we take apart the declaration into the class constructor and its default types. + _ -> do + h2010_dflt_clss <- getH2010DefaultClasses + toClassDefaults h2010_dflt_clss decls where getH2010DefaultClasses :: TcM (NonEmpty Class) -- All the classes subject to defaulting with a Haskell 2010 default @@ -187,18 +177,18 @@ -- No extensions: Num -- OverloadedStrings: add IsString -- ExtendedDefaults: add Show, Eq, Ord, Foldable, Traversable - getH2010DefaultClasses - = do { num_cls <- tcLookupClass numClassName - ; ovl_str <- xoptM LangExt.OverloadedStrings + getH2010DefaultClasses = mapM tcLookupClass =<< getH2010DefaultNames + getH2010DefaultNames + = do { ovl_str <- xoptM LangExt.OverloadedStrings ; ext_deflt <- xoptM LangExt.ExtendedDefaultRules - ; deflt_str <- if ovl_str - then mapM tcLookupClass [isStringClassName] - else return [] - ; deflt_interactive <- if ext_deflt - then mapM tcLookupClass interactiveClassNames - else return [] - ; let extra_clss = deflt_str ++ deflt_interactive - ; return $ num_cls :| extra_clss + ; let deflt_str = if ovl_str + then [isStringClassName] + else [] + ; let deflt_interactive = if ext_deflt + then interactiveClassNames + else [] + ; let extra_clss_names = deflt_str ++ deflt_interactive + ; return $ numClassName :| extra_clss_names } declarationParts :: NonEmpty Class -> LDefaultDecl GhcRn -> TcM (Maybe (Maybe Class, LDefaultDecl GhcRn, [Type])) declarationParts h2010_dflt_clss decl@(L locn (DefaultDecl _ mb_cls_name dflt_hs_tys)) @@ -206,36 +196,65 @@ case mb_cls_name of -- Haskell 98 default declaration Nothing -> - do { tau_tys <- addErrCtxt defaultDeclCtxt + do { tau_tys <- addErrCtxt (DefaultDeclErrCtxt { ddec_in_type_list = True }) $ mapMaybeM (check_instance_any h2010_dflt_clss) dflt_hs_tys ; return $ Just (Nothing, decl, tau_tys) } -- Named default declaration Just cls_name -> do { named_deflt <- xoptM LangExt.NamedDefaults ; checkErr named_deflt (TcRnIllegalNamedDefault decl) - ; mb_cls <- addErrCtxt defaultDeclClassCtxt + ; mb_cls <- addErrCtxt (DefaultDeclErrCtxt { ddec_in_type_list = False }) $ tcDefaultDeclClass cls_name ; for mb_cls $ \ cls -> - do { tau_tys <- addErrCtxt defaultDeclCtxt + do { tau_tys <- addErrCtxt (DefaultDeclErrCtxt { ddec_in_type_list = True }) $ mapMaybeM (check_instance_any (NE.singleton cls)) dflt_hs_tys ; return (Just cls, decl, tau_tys) } } - reportDuplicates :: Module -> NonEmpty Class -> NonEmpty (Maybe Class, LDefaultDecl GhcRn, [Type]) -> TcM [ClassDefaults] - reportDuplicates here h2010_dflt_clss ((mb_cls, _, tys) :| []) - = pure [ ClassDefaults{cd_class = c, cd_types = tys, cd_module = Just here, cd_warn = Nothing } - | c <- case mb_cls of - Nothing -> NE.toList h2010_dflt_clss - Just cls -> [cls] - ] - -- Report an error on multiple default declarations for the same class in the same module. - -- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module - reportDuplicates _ (num_cls :| _) decls@((_, L locn _, _) :| _) - = setSrcSpan (locA locn) (addErrTc $ dupDefaultDeclErr cls (sndOf3 <$> decls)) - >> pure [] + toClassDefaults :: NonEmpty Class -> [LDefaultDecl GhcRn] -> TcM [LocatedA ClassDefaults] + toClassDefaults h2010_dflt_clss dfs = do + dfs <- mapMaybeM (declarationParts h2010_dflt_clss) dfs + return $ concatMap (go False) dfs where - cls = fromMaybe num_cls $ firstJusts (fmap fstOf3 decls) + go h98 = \case + (Nothing, rn_decl, tys) -> concatMap (go True) [(Just cls, rn_decl, tys) | cls <- NE.toList h2010_dflt_clss] + (Just cls, (L locn _), tys) -> [(L locn $ ClassDefaults cls tys (DP_Local (locA locn) h98) Nothing)] +-- | Extend the default environment with the local default declarations +-- and do the action in the extended environment. +extendDefaultEnvWithLocalDefaults :: [LocatedA ClassDefaults] -> TcM a -> TcM a +extendDefaultEnvWithLocalDefaults decls action = do + tcg_env <- getGblEnv + let default_env = tcg_default tcg_env + new_default_env <- insertDefaultDecls default_env decls + updGblEnv (\gbl -> gbl { tcg_default = new_default_env } ) $ action + +-- | Insert local default declarations into the default environment. +-- +-- See 'insertDefaultDecl'. +insertDefaultDecls :: DefaultEnv -> [LocatedA ClassDefaults] -> TcM DefaultEnv +insertDefaultDecls = foldrM insertDefaultDecl +-- | Insert a local default declaration into the default environment. +-- +-- If the class already has a local default declaration in the DefaultEnv, +-- report an error and return the original DefaultEnv. Otherwise, override +-- any existing default declarations (e.g. imported default declarations). +-- +-- See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module +insertDefaultDecl :: LocatedA ClassDefaults -> DefaultEnv -> TcM DefaultEnv +insertDefaultDecl (L decl_loc new_cls_defaults ) default_env = + case lookupDefaultEnv default_env (className cls) of + Just cls_defaults + | DP_Local {} <- cd_provenance cls_defaults + -> do { setSrcSpan (locA decl_loc) (addErrTc $ TcRnMultipleDefaultDeclarations cls cls_defaults) + ; return default_env } + _ -> return $ insertDefaultEnv new_cls_defaults default_env + -- NB: this overrides imported and built-in default declarations + -- for this class, if there were any. + where + cls = cd_class new_cls_defaults + + -- | Check that the type is an instance of at least one of the default classes. -- -- See Note [Instance check for default declarations] @@ -289,16 +308,6 @@ | otherwise -> Nothing } - -defaultDeclCtxt :: SDoc -defaultDeclCtxt = text "When checking the types in a default declaration" - -defaultDeclClassCtxt :: SDoc -defaultDeclClassCtxt = text "When checking the class at the head of a named default declaration" - -dupDefaultDeclErr :: Class -> NonEmpty (LDefaultDecl GhcRn) -> TcRnMessage -dupDefaultDeclErr cls (L _ DefaultDecl {} :| dup_things) - = TcRnMultipleDefaultDeclarations cls dup_things {- Note [Instance check for default declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/Tc/Gen/Do.hs b/GHC/Tc/Gen/Do.hs --- a/GHC/Tc/Gen/Do.hs +++ b/GHC/Tc/Gen/Do.hs @@ -6,8 +6,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -23,7 +21,8 @@ import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, genHsLamDoExp, genHsCaseAltDoExp, genWildPat ) -import GHC.Rename.Env ( irrefutableConLikeRn ) +import GHC.Rename.Env ( irrefutableConLikeRn ) + import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcMType diff --git a/GHC/Tc/Gen/Export.hs b/GHC/Tc/Gen/Export.hs --- a/GHC/Tc/Gen/Export.hs +++ b/GHC/Tc/Gen/Export.hs @@ -1,8 +1,10 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs) where @@ -21,12 +23,11 @@ import GHC.Rename.Names import GHC.Rename.Env import GHC.Rename.Unbound ( reportUnboundName ) -import GHC.Utils.Error +import GHC.Rename.Splice import GHC.Unit.Module import GHC.Unit.Module.Imported import GHC.Unit.Module.Warnings import GHC.Core.TyCon -import GHC.Utils.Misc (sndOf3, thdOf3) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.ConLike @@ -43,8 +44,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Name.Set -import GHC.Types.DefaultEnv (ClassDefaults (cd_class), DefaultEnv, - emptyDefaultEnv, filterDefaultEnv, isEmptyDefaultEnv) +import GHC.Types.DefaultEnv import GHC.Types.Avail import GHC.Types.SourceFile import GHC.Types.Id @@ -57,6 +57,7 @@ import Data.Traversable ( for ) import Data.List ( sortBy ) import qualified Data.Map as Map +import GHC.Types.Unique.FM {- ************************************************************************ @@ -145,6 +146,8 @@ = ExportAccum { expacc_exp_occs :: ExportOccMap, -- ^ Tracks exported occurrence names + expacc_exp_dflts :: NameEnv (ClassDefaults, IE GhcPs), + -- ^ Tracks exported named default declarations expacc_mods :: UniqMap ModuleName [Name], -- ^ Tracks (re-)exported module names -- and the names they re-export @@ -157,15 +160,16 @@ emptyExportAccum :: ExportAccum -emptyExportAccum = ExportAccum emptyOccEnv emptyUniqMap [] emptyNameEnv +emptyExportAccum = ExportAccum emptyOccEnv emptyNameEnv emptyUniqMap [] emptyNameEnv accumExports :: (ExportAccum -> x -> TcRn (ExportAccum, Maybe y)) -> [x] - -> TcRn ([y], ExportWarnSpanNames, DontWarnExportNames) + -> TcRn ([y], DefaultEnv, ExportWarnSpanNames, DontWarnExportNames) accumExports f xs = do - (ExportAccum _ _ export_warn_spans dont_warn_export, ys) + (ExportAccum _ dflts _ export_warn_spans dont_warn_export, ys) <- mapAccumLM f' emptyExportAccum xs return ( catMaybes ys + , fmap fst dflts , export_warn_spans , dont_warn_export ) where f' acc x @@ -218,7 +222,7 @@ -- Rename the export list ; let do_it = exports_from_avail real_exports rdr_env imports this_mod - ; (rn_exports, final_avails, new_export_warns) + ; (rn_exports, default_env, final_avails, new_export_warns) <- if hsc_src == HsigFile then do (mb_r, msgs) <- tryTc do_it case mb_r of @@ -228,17 +232,16 @@ -- Final processing ; let final_ns = availsToNameSet final_avails - drop_defaults (spans, _defaults, avails) = (spans, avails) ; traceRn "rnExports: Exports:" (ppr final_avails) ; return (tcg_env { tcg_exports = final_avails , tcg_rn_exports = case tcg_rn_exports tcg_env of Nothing -> Nothing - Just _ -> map drop_defaults <$> rn_exports + Just _ -> rn_exports , tcg_default_exports = case exports of Nothing -> emptyDefaultEnv - _ -> foldMap (foldMap sndOf3) rn_exports + _ -> default_env , tcg_dus = tcg_dus tcg_env `plusDU` usesOnly final_ns , tcg_warns = insertWarnExports @@ -280,7 +283,7 @@ would import the above `default IsString (Text, String)` declaration into the importing module. -The `cd_module` field of `ClassDefaults` tracks the module whence the default was +The `cd_provenance` field of `ClassDefaults` tracks the module whence the default was imported from, for the purpose of warning reports. The said warning report may be triggered by `-Wtype-defaults` or by a user-defined `WARNING` pragma attached to the default export. In the latter case the warning text is stored in the @@ -296,7 +299,7 @@ -- @module Foo@ export is valid (it's not valid -- if we didn't import @Foo@!) -> Module - -> RnM (Maybe [(LIE GhcRn, DefaultEnv, Avails)], Avails, ExportWarnNames GhcRn) + -> RnM (Maybe [(LIE GhcRn, Avails)], DefaultEnv, Avails, ExportWarnNames GhcRn) -- (Nothing, _, _) <=> no explicit export list -- if explicit export list is present it contains -- each renamed export item together with its exported @@ -310,9 +313,9 @@ ; addDiagnostic (TcRnMissingExportList $ moduleName _this_mod) ; let avails = - map fix_faminst . gresToAvailInfo + map fix_faminst . gresToAvailInfo . mapMaybe pickLevelZeroGRE . filter isLocalGRE . globalRdrEnvElts $ rdr_env - ; return (Nothing, avails, []) } + ; return (Nothing, emptyDefaultEnv, avails, []) } where -- #11164: when we define a data instance -- but not data family, re-export the family @@ -328,14 +331,14 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod - = do (ie_avails, export_warn_spans, dont_warn_export) + = do (ie_avails, ie_dflts, export_warn_spans, dont_warn_export) <- accumExports do_litem rdr_items - let final_exports = nubAvails (concatMap thdOf3 ie_avails) -- Combine families + let final_exports = nubAvails (concatMap snd ie_avails) -- Combine families export_warn_names <- aggregate_warnings export_warn_spans dont_warn_export - return (Just ie_avails, final_exports, export_warn_names) + return (Just ie_avails, ie_dflts, final_exports, export_warn_names) where do_litem :: ExportAccum -> LIE GhcPs - -> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, Avails)) + -> RnM (ExportAccum, Maybe (LIE GhcRn, Avails)) do_litem acc lie = setSrcSpan (getLocA lie) (exports_from_item acc lie) -- Maps a parent to its in-scope children @@ -356,9 +359,10 @@ , imv <- importedByUser xs ] exports_from_item :: ExportAccum -> LIE GhcPs - -> RnM (ExportAccum, Maybe (LIE GhcRn, DefaultEnv, Avails)) + -> RnM (ExportAccum, Maybe (LIE GhcRn, Avails)) exports_from_item expacc@ExportAccum{ expacc_exp_occs = occs, + expacc_exp_dflts = exp_dflts, expacc_mods = earlier_mods, expacc_warn_spans = export_warn_spans, expacc_dont_warn = dont_warn_export @@ -381,6 +385,7 @@ = do { let { exportValid = (mod `elem` imported_modules) || (moduleName this_mod == mod) ; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env) + -- NB: this filters out non level 0 exports ; new_gres = [ gre' | (gre, _) <- gre_prs , gre' <- expand_tyty_gre gre ] @@ -414,38 +419,41 @@ (vcat [ ppr mod , ppr new_exports ]) ; return ( ExportAccum { expacc_exp_occs = occs' + , expacc_exp_dflts = exp_dflts -- IEModuleContents does not re-export defaults , expacc_mods = mods , expacc_warn_spans = export_warn_spans' , expacc_dont_warn = dont_warn_export' } - , Just (L loc (IEModuleContents warn_txt_rn lmod), emptyDefaultEnv, new_exports) ) } + , Just (L loc (IEModuleContents warn_txt_rn lmod), new_exports) ) } exports_from_item acc lie = do m_doc_ie <- lookup_doc_ie lie case m_doc_ie of - Just new_ie -> return (acc, Just (new_ie, emptyDefaultEnv, [])) + Just new_ie -> + return (acc, Just (new_ie, [])) Nothing -> do m_ie <- lookup_ie acc lie case m_ie of Nothing -> return (acc, Nothing) - Just (acc', new_ie, Left cls) -> do - defaults <- tcg_default <$> getGblEnv - let exported_default = filterDefaultEnv ((cls ==) . nameOccName . className . cd_class) defaults - return (acc', Just (new_ie, exported_default, [])) - Just (acc', new_ie, Right avail) - -> return (acc', Just (new_ie, emptyDefaultEnv, [avail])) + Just (acc', new_ie, mb_item) -> + case mb_item of + Nothing -> + return (acc', Nothing) + Just avail -> + return (acc', Just (new_ie, [avail])) ------------- - lookup_ie :: ExportAccum -> LIE GhcPs -> RnM (Maybe (ExportAccum, LIE GhcRn, Either OccName AvailInfo)) + lookup_ie :: ExportAccum -> LIE GhcPs -> RnM (Maybe (ExportAccum, LIE GhcRn, Maybe AvailInfo)) lookup_ie expacc@ExportAccum{ expacc_exp_occs = occs, expacc_warn_spans = export_warn_spans, expacc_dont_warn = dont_warn_export } (L loc ie@(IEVar warn_txt_ps l doc)) - = do mb_gre <- lookupGreAvailRn $ lieWrappedName l + = do mb_gre <- lookupGreAvailRn (ieLWrappedNameWhatLooking l) $ lieWrappedName l for mb_gre $ \ gre -> do let avail = availFromGRE gre name = greName gre + checkThLocalNameNoLift (ieLWrappedUserRdrName l name) occs' <- check_occs occs ie [gre] (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -459,19 +467,42 @@ , expacc_warn_spans = export_warn_spans' , expacc_dont_warn = dont_warn_export' } , L loc (IEVar warn_txt_rn (replaceLWrappedName l name) doc') - , Right avail ) + , Just avail ) lookup_ie expacc@ExportAccum{ expacc_exp_occs = occs, + expacc_exp_dflts = exp_dflts, expacc_warn_spans = export_warn_spans, expacc_dont_warn = dont_warn_export } (L loc ie@(IEThingAbs warn_txt_ps l doc)) - = do mb_gre <- lookupGreAvailRn $ lieWrappedName l + = do mb_gre <- lookupGreAvailRn (ieLWrappedNameWhatLooking l) $ lieWrappedName l for mb_gre $ \ gre -> do let avail = availFromGRE gre name = greName gre - occs' <- check_occs occs ie [gre] + (mb_avail, occs', exp_dflts') <- + case unLoc l of + -- see Note [Default exports] + IEDefault {} -> do + defaults <- tcg_default <$> getGblEnv + case lookupUFM_Directly defaults (nameUnique name) of + Nothing -> + do addErr $ TcRnExportHiddenDefault ie + return (Nothing, occs, exp_dflts) + Just cls_dflts -> do + let cls = cd_class cls_dflts + case lookupNameEnv exp_dflts (className cls) of + Just (_, ie') -> do + addDiagnostic $ + TcRnDuplicateNamedDefaultExport (classTyCon cls) ie ie' + return (Nothing, occs, exp_dflts) + Nothing -> + return $ (Nothing, occs, extendNameEnv exp_dflts (className cls) (cls_dflts, ie)) + _ -> do + occs' <- check_occs occs ie [gre] + return (Just avail, occs', exp_dflts) + + checkThLocalNameNoLift (ieLWrappedUserRdrName l name) (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans dont_warn_export @@ -480,34 +511,26 @@ (locA loc) doc' <- traverse rnLHsDoc doc - avail' <- case unLoc l of - -- see Note [Default exports] - IEDefault _ cls -> do - let defaultOccName = nameOccName . className . cd_class - occName = rdrNameOcc (unLoc cls) - defaults <- tcg_default <$> getGblEnv - when (isEmptyDefaultEnv $ filterDefaultEnv ((occName ==) . defaultOccName) defaults) - (addErr $ TcRnExportHiddenDefault ie) - pure (Left occName) - _ -> pure (Right avail) return ( expacc{ expacc_exp_occs = occs' + , expacc_exp_dflts = exp_dflts' , expacc_warn_spans = export_warn_spans' , expacc_dont_warn = dont_warn_export' } , L loc (IEThingAbs warn_txt_rn (replaceLWrappedName l name) doc') - , avail' ) + , mb_avail ) lookup_ie expacc@ExportAccum{ expacc_exp_occs = occs, expacc_warn_spans = export_warn_spans, expacc_dont_warn = dont_warn_export } (L loc ie@(IEThingAll (warn_txt_ps, ann) l doc)) - = do mb_gre <- lookupGreAvailRn $ lieWrappedName l + = do mb_gre <- lookupGreAvailRn (ieLWrappedNameWhatLooking l) $ lieWrappedName l for mb_gre $ \ par -> do all_kids <- lookup_ie_kids_all ie l par let name = greName par all_gres = par : all_kids all_names = map greName all_gres + checkThLocalNameNoLift (ieLWrappedUserRdrName l name) occs' <- check_occs occs ie all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -521,18 +544,18 @@ , expacc_warn_spans = export_warn_spans' , expacc_dont_warn = dont_warn_export' } , L loc (IEThingAll (warn_txt_rn, ann) (replaceLWrappedName l name) doc') - , Right (AvailTC name all_names) ) + , Just $ AvailTC name all_names ) lookup_ie expacc@ExportAccum{ expacc_exp_occs = occs, expacc_warn_spans = export_warn_spans, expacc_dont_warn = dont_warn_export } (L loc ie@(IEThingWith (warn_txt_ps, ann) l wc sub_rdrs doc)) - = do mb_gre <- addExportErrCtxt ie - $ lookupGreAvailRn $ lieWrappedName l + = do mb_gre <- addErrCtxt (ExportCtxt ie) + $ lookupGreAvailRn (ieLWrappedNameWhatLooking l) $ lieWrappedName l for mb_gre $ \ par -> do (subs, with_kids) - <- addExportErrCtxt ie + <- addErrCtxt (ExportCtxt ie) $ lookup_ie_kids_with par sub_rdrs wc_kids <- @@ -545,6 +568,7 @@ all_gres = par : all_kids all_names = map greName all_gres + checkThLocalNameNoLift (ieLWrappedUserRdrName l name) occs' <- check_occs occs ie all_gres (export_warn_spans', dont_warn_export', warn_txt_rn) <- process_warning export_warn_spans @@ -558,7 +582,7 @@ , expacc_warn_spans = export_warn_spans' , expacc_dont_warn = dont_warn_export' } , L loc (IEThingWith (warn_txt_rn, ann) (replaceLWrappedName l name) wc subs doc') - , Right (AvailTC name all_names) ) + , Just $ AvailTC name all_names ) lookup_ie _ _ = panic "lookup_ie" -- Other cases covered earlier @@ -566,23 +590,24 @@ lookup_ie_kids_with :: GlobalRdrElt -> [LIEWrappedName GhcPs] -> RnM ([LIEWrappedName GhcRn], [GlobalRdrElt]) lookup_ie_kids_with gre sub_rdrs = - do { let name = greName gre - ; kids <- lookupChildrenExport name sub_rdrs + do { kids <- lookupChildrenExport gre sub_rdrs ; return (map fst kids, map snd kids) } lookup_ie_kids_all :: IE GhcPs -> LIEWrappedName GhcPs -> GlobalRdrElt -> RnM [GlobalRdrElt] - lookup_ie_kids_all ie (L _ rdr) gre = + lookup_ie_kids_all ie (L _loc rdr) gre = do { let name = greName gre gres = findChildren kids_env name - ; addUsedKids (ieWrappedName rdr) gres - ; when (null gres) $ + -- We only choose level 0 exports when filling in part of an export list implicitly. + ; let kids_0 = mapMaybe pickLevelZeroGRE gres + ; addUsedKids (ieWrappedName rdr) kids_0 + ; when (null kids_0) $ if isTyConName name then addTcRnDiagnostic (TcRnDodgyExports gre) else -- This occurs when you export T(..), but -- only import T abstractly, or T is a synonym. addErr (TcRnExportHiddenComponents ie) - ; return gres } + ; return kids_0 } ------------- @@ -679,6 +704,23 @@ addUsedKids parent_rdr kid_gres = addUsedGREs ExportDeprecationWarnings (pickGREs parent_rdr kid_gres) + +ieLWrappedUserRdrName :: LIEWrappedName GhcPs -> Name -> LIdOccP GhcRn +ieLWrappedUserRdrName l n = fmap (\rdr -> WithUserRdr rdr n) $ ieLWrappedName l + +-- | In what namespaces should we go looking for an import/export item +-- that is out of scope, for suggestions in error messages? +ieWrappedNameWhatLooking :: IEWrappedName GhcPs -> WhatLooking +ieWrappedNameWhatLooking = \case + IEName {} -> WL_TyCon_or_TermVar + IEDefault {} -> WL_TyCon + IEType {} -> WL_Type + IEData {} -> WL_Term + IEPattern {} -> WL_ConLike + +ieLWrappedNameWhatLooking :: LIEWrappedName GhcPs -> WhatLooking +ieLWrappedNameWhatLooking = ieWrappedNameWhatLooking . unLoc + -- Renaming and typechecking of exports happens after everything else has -- been typechecked. @@ -689,14 +731,14 @@ >> An abbreviated form of module, consisting only of the module body, is >> permitted. If this is used, the header is assumed to be ->> ‘module Main(main) where’. +>> 'module Main(main) where'. For modules without a module header, this is implemented the following way: If the module has a main function in scope: Then create a module header and export the main function, - as if a module header like ‘module Main(main) where...’ would exist. + as if a module header like 'module Main(main) where...' would exist. This has the effect to mark the main function and all top level functions called directly or indirectly via main as 'used', and later on, unused top-level functions can be reported correctly. @@ -710,7 +752,7 @@ In GHCi this has the effect, that we don't get any 'non-used' warnings. In GHC, however, the 'has-main-module' check in GHC.Tc.Module.checkMain fires, and we get the error: - The IO action ‘main’ is not defined in module ‘Main’ + The IO action 'main' is not defined in module 'Main' -} @@ -739,27 +781,21 @@ -lookupChildrenExport :: Name -> [LIEWrappedName GhcPs] +lookupChildrenExport :: GlobalRdrElt + -> [LIEWrappedName GhcPs] -> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)]) -lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items +lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items where + spec_parent = greName parent_gre -- Process an individual child doOne :: LIEWrappedName GhcPs -> RnM (LIEWrappedName GhcRn, GlobalRdrElt) doOne n = do let bareName = (ieWrappedName . unLoc) n - what_lkup :: LookupChild - what_lkup = - LookupChild - { wantedParent = spec_parent - , lookupDataConFirst = True - , prioritiseParent = False -- See T11970. - } - -- Do not report export list declaration deprecations name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings - spec_parent bareName what_lkup + (ParentGRE spec_parent (greInfo parent_gre)) bareName traceRn "lookupChildrenExport" (ppr name) -- Default to data constructors for slightly better error -- messages @@ -770,15 +806,16 @@ case name of NameNotFound -> - do { ub <- reportUnboundName unboundName + do { ub <- reportUnboundName (lookingForSubordinate parent_gre) unboundName ; let l = getLoc n gre = mkLocalGRE UnboundGRE NoParent ub ; return (L l (IEName noExtField (L (l2l l) ub)), gre)} FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> do { checkPatSynParent spec_parent par child_nm + ; checkThLocalNameNoLift (ieLWrappedUserRdrName n child_nm) ; return (replaceLWrappedName n child_nm, child) } - IncorrectParent p c gs -> failWithDcErr p (greName c) gs + IncorrectParent p c gs -> failWithDcErr (parentGRE_name p) (greName c) gs -- Note [Typing Pattern Synonym Exports] @@ -861,16 +898,13 @@ ; case mpat_syn_thing of AnId i | isId i , RecSelId { sel_tycon = RecSelPatSyn p } <- idDetails i - -> handle_pat_syn (selErr nm) parent_ty_con p + -> handle_pat_syn (PatSynRecSelExportCtxt p nm) parent_ty_con p - AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p + AConLike (PatSynCon p) -> handle_pat_syn (PatSynExportCtxt p) parent_ty_con p _ -> failWithDcErr parent nm [] } where - psErr = exportErrCtxt "pattern synonym" - selErr = exportErrCtxt "pattern synonym record selector" - - handle_pat_syn :: SDoc + handle_pat_syn :: ErrCtxtMsg -> TyCon -- Parent TyCon -> PatSyn -- Corresponding bundled PatSyn -- and pretty printed origin @@ -974,18 +1008,6 @@ single IEThingAbs {} = True single _ = False -exportErrCtxt :: Outputable o => String -> o -> SDoc -exportErrCtxt herald exp = - text "In the" <+> text (herald ++ ":") <+> ppr exp - - -addExportErrCtxt :: (OutputableBndrId p) - => IE (GhcPass p) -> TcM a -> TcM a -addExportErrCtxt ie = addErrCtxt exportCtxt - where - exportCtxt = text "In the export:" <+> ppr ie - - failWithDcErr :: Name -> Name -> [Name] -> TcM a failWithDcErr parent child parents = do ty_thing <- tcLookupGlobal child @@ -1017,7 +1039,7 @@ -> RnM () addDuplicateFieldExportErr gre others = do { rdr_env <- getGlobalRdrEnv - ; let lkup = expectJust "addDuplicateFieldExportErr" . lookupGRE_Name rdr_env + ; let lkup = expectJust . lookupGRE_Name rdr_env other_gres = fmap (first lkup) others ; addErr (TcRnDuplicateFieldExport gre other_gres) } diff --git a/GHC/Tc/Gen/Expr.hs b/GHC/Tc/Gen/Expr.hs --- a/GHC/Tc/Gen/Expr.hs +++ b/GHC/Tc/Gen/Expr.hs @@ -19,7 +19,7 @@ ( tcCheckPolyExpr, tcCheckPolyExprNC, tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC, - tcInferRho, tcInferRhoNC, + tcInferExpr, tcInferSigma, tcInferRho, tcInferRhoNC, tcPolyLExpr, tcPolyExpr, tcExpr, tcPolyLExprSig, tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType, tcCheckId, @@ -34,59 +34,66 @@ import GHC.Hs import GHC.Hs.Syn.Type + import GHC.Rename.Utils -import GHC.Tc.Utils.Monad -import GHC.Tc.Utils.Unify -import GHC.Types.Basic -import GHC.Types.Error -import GHC.Types.FieldLabel -import GHC.Types.Unique.FM -import GHC.Types.Unique.Map -import GHC.Types.Unique.Set -import GHC.Core.Multiplicity -import GHC.Core.UsageEnv -import GHC.Tc.Errors.Types -import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic, hasFixedRuntimeRep ) -import GHC.Tc.Utils.Instantiate +import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls ) + import GHC.Tc.Gen.App import GHC.Tc.Gen.Head import GHC.Tc.Gen.Bind ( tcLocalBinds ) -import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) -import GHC.Core.FamInstEnv ( FamInstEnvs ) -import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls ) -import GHC.Tc.Utils.Env +import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Arrow import GHC.Tc.Gen.Match( tcBody, tcLambdaMatches, tcCaseMatches - , tcGRHSList, tcDoStmts ) -import GHC.Tc.Gen.HsType -import GHC.Tc.Utils.TcMType + , tcGRHSNE, tcDoStmts ) +import GHC.Tc.Instance.Family ( tcGetFamInstEnvs ) import GHC.Tc.Zonk.TcType -import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType as TcType -import GHC.Types.Id -import GHC.Types.Id.Info +import GHC.Tc.Utils.Monad +import GHC.Tc.Utils.Unify +import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic, hasFixedRuntimeRep ) +import GHC.Tc.Utils.Instantiate +import GHC.Tc.Utils.Env +import GHC.Tc.Types.Origin +import GHC.Tc.Types.Evidence +import GHC.Tc.Errors.Types hiding (HoleError) + +import GHC.Core.Multiplicity +import GHC.Core.UsageEnv +import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Core.ConLike import GHC.Core.DataCon -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Name.Set -import GHC.Types.Name.Reader import GHC.Core.Class(classTyCon) import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion -import GHC.Tc.Types.Evidence +import GHC.Core.Predicate( decomposeIPPred ) + +import GHC.Types.Basic +import GHC.Types.Unique.FM +import GHC.Types.Unique.Map +import GHC.Types.Unique.Set +import GHC.Types.Id +import GHC.Types.Id.Info +import GHC.Types.Name +import GHC.Types.Name.Env +import GHC.Types.Name.Set +import GHC.Types.Name.Reader +import GHC.Types.SrcLoc + import GHC.Builtin.Types import GHC.Builtin.Names import GHC.Builtin.Uniques ( mkBuiltinUnique ) + import GHC.Driver.DynFlags -import GHC.Types.SrcLoc + import GHC.Utils.Misc -import GHC.Data.List.SetOps -import GHC.Data.Maybe import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic +import GHC.Data.List.SetOps +import GHC.Data.Maybe + import Control.Monad import qualified Data.List.NonEmpty as NE @@ -226,17 +233,24 @@ * * ********************************************************************* -} +tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType) +tcInferSigma = tcInferExpr IIF_Sigma + tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) -- Infer a *rho*-type. The return type is always instantiated. -tcInferRho (L loc expr) - = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad +tcInferRho = tcInferExpr IIF_DeepRho +tcInferRhoNC = tcInferExprNC IIF_DeepRho + +tcInferExpr, tcInferExprNC :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) +tcInferExpr iif (L loc expr) + = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad addExprCtxt expr $ -- Note [Error contexts in generated code] - do { (expr', rho) <- tcInfer (tcExpr expr) + do { (expr', rho) <- runInfer iif IFRR_Any (tcExpr expr) ; return (L loc expr', rho) } -tcInferRhoNC (L loc expr) - = setSrcSpanA loc $ - do { (expr', rho) <- tcInfer (tcExpr expr) +tcInferExprNC iif (L loc expr) + = setSrcSpanA loc $ + do { (expr', rho) <- runInfer iif IFRR_Any (tcExpr expr) ; return (L loc expr', rho) } --------------- @@ -296,23 +310,19 @@ tcExpr (XExpr e) res_ty = tcXExpr e res_ty -tcExpr e@(HsOverLit _ lit) res_ty - = do { mb_res <- tcShortCutLit lit res_ty - -- See Note [Short cut for overloaded literals] in GHC.Tc.Zonk.Type - ; case mb_res of - Just lit' -> return (HsOverLit noExtField lit') - Nothing -> tcApp e res_ty } - -- Typecheck an occurrence of an unbound Id -- -- Some of these started life as a true expression hole "_". --- Others might simply be variables that accidentally have no binding site -tcExpr (HsUnboundVar _ occ) res_ty +-- Others might simply be variables that accidentally have no binding site. +tcExpr (HsHole (HoleVar locc@(L _ occ))) res_ty = do { ty <- expTypeToType res_ty -- Allow Int# etc (#12531) ; her <- emitNewExprHole occ ty ; tcEmitBindingUsage bottomUE -- Holes fit any usage environment -- (#18491) - ; return (HsUnboundVar her occ) } + ; return (HsHole (HoleVar locc, her)) + } +tcExpr (HsHole HoleError) _ = + panic "GHC.Tc.Gen.Expr: tcExpr: HoleError: Not implemented" tcExpr e@(HsLit x lit) res_ty = do { let lit_ty = hsLitType lit @@ -338,16 +348,15 @@ -- Create a unification type variable of kind 'Type'. -- (The type of an implicit parameter must have kind 'Type'.) ; let ip_name = mkStrLitTy (hsIPNameFS x) - ; ipClass <- tcLookupClass ipClassName - ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty]) + origin = IPOccOrigin x + ; ip_class <- tcLookupClass ipClassName + ; let ip_pred = mkClassPred ip_class [ip_name, ip_ty] + ; ip_dict <- emitWantedEvVar origin ip_pred + ; let (ip_op, _) = decomposeIPPred ip_pred + wrap = mkWpEvVarApps [ip_dict] <.> mkWpTyApps [ip_name, ip_ty] ; tcWrapResult e - (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLocA ip_var))) - ip_ty res_ty } - where - -- Coerces a dictionary for `IP "x" t` into `t`. - fromDict ipClass x ty = mkHsWrap $ mkWpCastR $ - unwrapIP $ mkClassPred ipClass [x,ty] - origin = IPOccOrigin x + (mkHsWrap wrap (mkHsVar (noLocA ip_op))) + ip_ty res_ty } tcExpr e@(HsLam x lam_variant matches) res_ty = do { (wrap, matches') <- tcLambdaMatches e lam_variant matches [] res_ty @@ -356,6 +365,51 @@ {- ************************************************************************ * * + Overloaded literals +* * +************************************************************************ +-} + +tcExpr e@(HsOverLit _ lit) res_ty + = -- See Note [Typechecking overloaded literals] + do { mb_res <- tcShortCutLit lit res_ty + -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType + ; case mb_res of + Just lit' -> return (HsOverLit noExtField lit') + Nothing -> tcApp e res_ty } + -- Why go via tcApp? See Note [Typechecking overloaded literals] + +{- Note [Typechecking overloaded literals] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Generally speaking, an overloaded literal like "3" typechecks as if you +had written (fromInteger (3 :: Integer)). But in practice it's a little +tricky: + +* Rebindable syntax (see #19154 and !4981). With rebindable syntax we might have + fromInteger :: Integer -> forall a. Num a => a + and then we might hope to use a Visible Type Application (VTA) to write + 3 @Int + expecting it to expand to + fromInteger (3::Integer) @Int dNumInt + To achieve that, we need to + * treat the application using `tcApp` to deal with the VTA + * treat the overloaded literal as the "head" of an application; + see `GHC.Tc.Gen.Head.tcInferAppHead`. + +* Short-cutting. If we have + xs :: [Int] + xs = [3,4,5,6... ] + then it's a huge short-cut (in compile time) to just cough up the `Int` literal + for `3`, rather than (fromInteger @Int d), with a wanted constraint `[W] Num Int`. + See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType. + + We can only take this short-cut if rebindable syntax is off; see `tcShortCutLit`. +-} + + +{- +************************************************************************ +* * Explicit lists * * ************************************************************************ @@ -431,11 +485,9 @@ -} tcExpr (HsLet x binds expr) res_ty - = do { (binds', wrapper, expr') <- tcLocalBinds binds $ - tcMonoExpr expr res_ty - -- The wrapper checks for correct multiplicities. - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; return (HsLet x binds' (mkLHsWrap wrapper expr')) } + = do { (binds', expr') <- tcLocalBinds binds $ + tcMonoExpr expr res_ty + ; return (HsLet x binds' expr') } tcExpr (HsCase ctxt scrut matches) res_ty = do { -- We used to typecheck the case alternatives first. @@ -458,8 +510,8 @@ ; (scrut', scrut_ty) <- tcScalingUsage mult $ tcInferRho scrut ; hasFixedRuntimeRep_syntactic FRRCase scrut_ty - ; (mult_co_wrap, matches') <- tcCaseMatches ctxt tcBody (Scaled mult scrut_ty) matches res_ty - ; return (HsCase ctxt (mkLHsWrap mult_co_wrap scrut') matches') } + ; matches' <- tcCaseMatches ctxt tcBody (Scaled mult scrut_ty) matches res_ty + ; return (HsCase ctxt scrut' matches') } tcExpr (HsIf x pred b1 b2) res_ty = do { pred' <- tcCheckMonoExpr pred boolTy @@ -493,7 +545,7 @@ -} tcExpr (HsMultiIf _ alts) res_ty - = do { alts' <- tcGRHSList IfAlt tcBody alts res_ty + = do { alts' <- tcGRHSNE IfAlt tcBody alts res_ty -- See Note [MultiWayIf linearity checking] ; res_ty <- readExpType res_ty ; return (HsMultiIf res_ty alts') } @@ -517,10 +569,8 @@ = do { res_ty <- expTypeToType res_ty ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty ; (expr', lie) <- captureConstraints $ - addErrCtxt (hang (text "In the body of a static form:") - 2 (ppr expr) - ) $ - tcCheckPolyExprNC expr expr_ty + addErrCtxt (StaticFormCtxt expr) $ + tcCheckPolyExprNC expr expr_ty -- Check that the free variables of the static form are closed. -- It's OK to use nonDetEltsUniqSet here as the only side effects of @@ -563,11 +613,11 @@ ************************************************************************ -} -tcExpr expr@(RecordCon { rcon_con = L loc con_name +tcExpr expr@(RecordCon { rcon_con = L loc qcon@(WithUserRdr _ con_name) , rcon_flds = rbinds }) res_ty - = do { con_like <- tcLookupConLike con_name + = do { con_like <- tcLookupConLike qcon - ; (con_expr, con_sigma) <- tcInferId con_name + ; (con_expr, con_sigma) <- tcInferConLike con_like ; (con_wrap, con_tau) <- topInstantiate orig con_sigma -- a shallow instantiation should really be enough for -- a data constructor. @@ -577,12 +627,7 @@ ; checkTc (conLikeHasBuilder con_like) $ nonBidirectionalErr (conLikeName con_like) - ; rbinds' <- tcRecordBinds con_like (map scaledThing arg_tys) rbinds - -- It is currently not possible for a record to have - -- multiplicities. When they do, `tcRecordBinds` will take - -- scaled types instead. Meanwhile, it's safe to take - -- `scaledThing` above, as we know all the multiplicities are - -- Many. + ; rbinds' <- tcRecordBinds con_like arg_tys rbinds ; let rcon_tc = mkHsWrap con_wrap con_expr expr' = RecordCon { rcon_ext = rcon_tc @@ -675,7 +720,7 @@ -- Here we get rid of it and add the finalizers to the global environment. -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty -tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty +tcExpr e@(HsTypedBracket _ext body) res_ty = tcTypedBracket e body res_ty tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty tcExpr (HsUntypedSplice splice _) res_ty @@ -719,12 +764,12 @@ tcXExpr xe@(ExpandedThingRn o e') res_ty | OrigStmt ls@(L loc s@LetStmt{}) <- o , HsLet x binds e <- e' - = do { (binds', wrapper, e') <- setSrcSpanA loc $ - addStmtCtxt s $ - tcLocalBinds binds $ - tcMonoExprNC e res_ty -- NB: Do not call tcMonoExpr here as it adds - -- a duplicate error context - ; return $ mkExpandedStmtTc ls (HsLet x binds' (mkLHsWrap wrapper e')) + = do { (binds', e') <- setSrcSpanA loc $ + addStmtCtxt s $ + tcLocalBinds binds $ + tcMonoExprNC e res_ty -- NB: Do not call tcMonoExpr here as it adds + -- a duplicate error context + ; return $ mkExpandedStmtTc ls (HsLet x binds' e') } | OrigStmt ls@(L loc s@LastStmt{}) <- o = setSrcSpanA loc $ @@ -737,6 +782,7 @@ | OrigStmt ls@(L loc _) <- o = setSrcSpanA loc $ mkExpandedStmtTc ls <$> tcApp (XExpr xe) res_ty + tcXExpr xe res_ty = tcApp (XExpr xe) res_ty {- @@ -839,7 +885,7 @@ ; return (Missing (Scaled mult arg_ty), arg_ty) } tc_infer_tup_arg i (Present x lexpr@(L l expr)) = do { (expr', arg_ty) <- case boxity of - Unboxed -> tcInferFRR (FRRUnboxedTuple i) (tcPolyExpr expr) + Unboxed -> runInferRhoFRR (FRRUnboxedTuple i) (tcPolyExpr expr) Boxed -> do { arg_ty <- newFlexiTyVarTy liftedTypeKind ; L _ expr' <- tcCheckPolyExpr lexpr arg_ty ; return (expr', arg_ty) } @@ -1024,7 +1070,8 @@ tc_syn_arg _ (SynFun {}) _ = pprPanic "tcSynArgA hits a SynFun" (ppr orig) tc_syn_arg res_ty (SynType the_ty) thing_inside - = do { wrap <- tcSubType orig GenSigCtxt res_ty the_ty + = do { wrap <- addSubTypeCtxt res_ty the_ty $ + tcSubType orig GenSigCtxt Nothing res_ty the_ty ; result <- thing_inside [] ; return (result, wrap) } @@ -1276,7 +1323,7 @@ -- Expanded record update expression , TcType -- result type of expanded record update - , SDoc + , ErrCtxtMsg -- error context to push when typechecking -- the expanded code ) @@ -1321,8 +1368,11 @@ <- disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty ; let sel_ids = map (unLoc . foLabel . unLoc . hfbLHS . unLoc) rbinds upd_fld_names = map idName sel_ids - relevant_cons = nonDetEltsUniqSet cons - relevant_con = head relevant_cons + relevant_cons@(relevant_con NE.:| _) = + case NE.nonEmpty $ nonDetEltsUniqSet cons of + Just rel_cons -> rel_cons + Nothing -> pprPanic "desugarRecordUpd: no relevant constructors" $ + vcat [ text "record_expr:" <+> ppr record_expr ] -- STEP 2: expand the record update. -- @@ -1448,7 +1498,7 @@ case_expr = HsCase RecUpd record_expr $ mkMatchGroup (Generated OtherExpansion DoPmc) (wrapGenSpan matches) matches :: [LMatch GhcRn (LHsExpr GhcRn)] - matches = map make_pat relevant_cons + matches = map make_pat (NE.toList relevant_cons) let_binds :: HsLocalBindsLR GhcRn GhcRn let_binds = HsValBinds noAnn $ XValBindsLR @@ -1467,31 +1517,12 @@ vcat [ text "relevant_con:" <+> ppr relevant_con , text "res_ty:" <+> ppr res_ty , text "ds_res_ty:" <+> ppr ds_res_ty + , text "ds_expr:" <+> ppr ds_expr ] - ; let cons = pprQuotedList relevant_cons - err_lines = - (text "In a record update at field" <> plural upd_fld_names <+> pprQuotedList upd_fld_names :) - $ case relevant_con of - RealDataCon con -> - [ text "with type constructor" <+> quotes (ppr (dataConTyCon con)) - , text "data constructor" <+> plural relevant_cons <+> cons ] - PatSynCon {} -> - [ text "with pattern synonym" <+> plural relevant_cons <+> cons ] - ++ if null ex_tvs - then [] - else [ text "existential variable" <> plural ex_tvs <+> pprQuotedList ex_tvs ] - err_ctxt = make_lines_msg err_lines + ; return (ds_expr, ds_res_ty, RecordUpdCtxt relevant_cons upd_fld_names ex_tvs) } - ; return (ds_expr, ds_res_ty, err_ctxt) } --- | Pretty-print a collection of lines, adding commas at the end of each line, --- and adding "and" to the start of the last line. -make_lines_msg :: [SDoc] -> SDoc -make_lines_msg [] = empty -make_lines_msg [last] = ppr last <> dot -make_lines_msg [l1,l2] = l1 $$ text "and" <+> l2 <> dot -make_lines_msg (l:ls) = l <> comma $$ make_lines_msg ls {- ********************************************************************* * * @@ -1589,7 +1620,8 @@ lookup_parent_flds par@(RnRecUpdParent { rnRecUpdLabels = lbls, rnRecUpdCons = cons }) = do { let cons' :: NonDetUniqFM ConLike ConLikeName cons' = NonDetUniqFM $ unsafeCastUFMKey $ getUniqSet cons - ; cons <- traverse (tcLookupConLike . conLikeName_Name) cons' + lookup_one con = tcLookupConLike (noUserRdr $ getName con) + ; cons <- traverse lookup_one cons' ; tc <- tcLookupRecSelParent par ; return $ TcRecUpdParent @@ -1655,16 +1687,16 @@ tcRecordBinds :: ConLike - -> [TcType] -- Expected type for each field + -> [Scaled TcType] -- Expected type for each field -> HsRecordBinds GhcRn -> TcM (HsRecordBinds GhcTc) -tcRecordBinds con_like arg_tys (HsRecFields _ rbinds dd) +tcRecordBinds con_like arg_tys (HsRecFields x rbinds dd) = do { mb_binds <- mapM do_bind rbinds - ; return (HsRecFields [] (catMaybes mb_binds) dd) } + ; return (HsRecFields x (catMaybes mb_binds) dd) } where fields = map flSelector $ conLikeFieldLabels con_like - flds_w_tys = zipEqual "tcRecordBinds" fields arg_tys + flds_w_tys = zipEqual fields arg_tys do_bind :: LHsRecField GhcRn (LHsExpr GhcRn) -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc))) @@ -1680,22 +1712,18 @@ , hfbRHS = rhs' , hfbPun = hfbPun fld}))) } -fieldCtxt :: FieldLabelString -> SDoc -fieldCtxt field_name - = text "In the" <+> quotes (ppr field_name) <+> text "field of a record" - -tcRecordField :: ConLike -> Assoc Name Type +tcRecordField :: ConLike -> Assoc Name (Scaled Type) -> LFieldOcc GhcRn -> LHsExpr GhcRn -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)) tcRecordField con_like flds_w_tys (L loc (FieldOcc rdr (L l sel_name))) rhs - | Just field_ty <- assocMaybe flds_w_tys sel_name - = addErrCtxt (fieldCtxt field_lbl) $ - do { rhs' <- tcCheckPolyExprNC rhs field_ty + | Just (Scaled field_mult field_ty) <- assocMaybe flds_w_tys sel_name + = addErrCtxt (FieldCtxt field_lbl)$ + do { rhs' <- tcScalingUsage field_mult $ tcCheckPolyExprNC rhs field_ty ; hasFixedRuntimeRep_syntactic (FRRRecordCon rdr (unLoc rhs')) field_ty ; let field_id = mkUserLocal (nameOccName sel_name) (nameUnique sel_name) - ManyTy field_ty (locA loc) + field_mult field_ty (locA loc) -- Yuk: the field_id has the *unique* of the selector Id -- (so we can find it easily) -- but is a LocalId with the appropriate type of the RHS diff --git a/GHC/Tc/Gen/Expr.hs-boot b/GHC/Tc/Gen/Expr.hs-boot --- a/GHC/Tc/Gen/Expr.hs-boot +++ b/GHC/Tc/Gen/Expr.hs-boot @@ -1,8 +1,8 @@ module GHC.Tc.Gen.Expr where import GHC.Hs ( HsExpr, LHsExpr, SyntaxExprRn , SyntaxExprTc ) -import GHC.Tc.Utils.TcType ( TcRhoType, TcSigmaType, TcSigmaTypeFRR - , SyntaxOpType +import GHC.Tc.Utils.TcType ( TcType, TcRhoType, TcSigmaType, TcSigmaTypeFRR + , SyntaxOpType, InferInstFlag , ExpType, ExpRhoType, ExpSigmaType ) import GHC.Tc.Types ( TcM ) import GHC.Tc.Types.BasicTypes( TcCompleteSig ) @@ -32,6 +32,8 @@ tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) + +tcInferExpr :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) tcSyntaxOp :: CtOrigin -> SyntaxExprRn diff --git a/GHC/Tc/Gen/Foreign.hs b/GHC/Tc/Gen/Foreign.hs --- a/GHC/Tc/Gen/Foreign.hs +++ b/GHC/Tc/Gen/Foreign.hs @@ -254,7 +254,7 @@ -> TcM (Id, LForeignDecl GhcTc, Bag GlobalRdrElt) tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty , fd_fi = imp_decl })) - = setSrcSpanA dloc $ addErrCtxt (foreignDeclCtxt fo) $ + = setSrcSpanA dloc $ addErrCtxt (ForeignDeclCtxt fo) $ do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty ; (Reduction norm_co norm_sig_ty, gres) <- normaliseFfiType sig_ty ; let @@ -412,7 +412,7 @@ tcFExport :: ForeignDecl GhcRn -> TcM (LHsBind GhcTc, ForeignDecl GhcTc, Bag GlobalRdrElt) tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spec }) - = addErrCtxt (foreignDeclCtxt fo) $ do + = addErrCtxt (ForeignDeclCtxt fo) $ do sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty @@ -579,12 +579,6 @@ -> TcM () check IsValid _ = return () check (NotValid reason) mkMessage = addErrTc (mkMessage reason) - -foreignDeclCtxt :: ForeignDecl GhcRn -> SDoc -foreignDeclCtxt fo - = hang (text "When checking declaration:") - 2 (ppr fo) - {- Predicates on Types used in this module -} diff --git a/GHC/Tc/Gen/Head.hs b/GHC/Tc/Gen/Head.hs --- a/GHC/Tc/Gen/Head.hs +++ b/GHC/Tc/Gen/Head.hs @@ -23,8 +23,8 @@ , leadingValArgs, isVisibleArg , tcInferAppHead, tcInferAppHead_maybe - , tcInferId, tcCheckId, obviousSig - , tyConOf, tyConOfET, fieldNotInType + , tcInferId, tcCheckId, tcInferConLike, obviousSig + , tyConOf, tyConOfET , nonBidirectionalErr , pprArgInst @@ -58,7 +58,7 @@ import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Core.UsageEnv ( singleUsageUE, UsageEnv ) -import GHC.Core.PatSyn( PatSyn ) +import GHC.Core.PatSyn( PatSyn, patSynName ) import GHC.Core.ConLike( ConLike(..) ) import GHC.Core.DataCon import GHC.Core.TyCon @@ -66,7 +66,6 @@ import GHC.Core.Type import GHC.Types.Id -import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.SrcLoc @@ -75,7 +74,6 @@ import GHC.Builtin.Types( multiplicityTy ) import GHC.Builtin.Names -import GHC.Builtin.Names.TH( liftStringName, liftName ) import GHC.Driver.DynFlags import GHC.Utils.Misc @@ -83,8 +81,6 @@ import GHC.Utils.Panic import GHC.Data.Maybe -import Control.Monad -import GHC.Rename.Unbound (WhatLooking(WL_Anything)) @@ -324,6 +320,7 @@ ctxt' = case splice of HsUntypedSpliceExpr _ (L l _) -> set l ctxt -- l :: SrcAnn AnnListItem HsQuasiQuote _ _ (L l _) -> set l ctxt -- l :: SrcAnn NoEpAnns + (XUntypedSplice (HsImplicitLiftSplice _ _ _ (L l _))) -> set l ctxt -- See Note [Looking through ExpandedThingRn] go (XExpr (ExpandedThingRn o e)) ctxt args @@ -559,7 +556,7 @@ do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> tcInfer (tcExpr fun) } + Nothing -> runInferRho (tcExpr fun) } tcInferAppHead_maybe :: HsExpr GhcRn -> TcM (Maybe (HsExpr GhcTc, TcSigmaType)) @@ -567,7 +564,7 @@ -- Returns Nothing for a complicated head tcInferAppHead_maybe fun = case fun of - HsVar _ (L _ nm) -> Just <$> tcInferId nm + HsVar _ nm -> Just <$> tcInferId nm XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit @@ -652,12 +649,6 @@ tyConOfET :: FamInstEnvs -> ExpRhoType -> Maybe TyCon tyConOfET fam_inst_envs ty0 = tyConOf fam_inst_envs =<< checkingExpType_maybe ty0 -fieldNotInType :: RecSelParent -> RdrName -> TcRnMessage -fieldNotInType p rdr - = mkTcRnNotInScope rdr $ - UnknownSubordinate (text "field of type" <+> quotes (ppr p)) - - {- ********************************************************************* * * Expressions with a type signature @@ -697,7 +688,8 @@ | otherwise = NoRestrictions ; ((qtvs, givens, ev_binds, _), residual) - <- captureConstraints $ simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted + <- captureConstraints $ + simplifyInfer NotTopLevel tclvl infer_mode [sig_inst] [(name, tau)] wanted ; emitConstraints residual ; tau <- liftZonkM $ zonkTcType tau @@ -764,6 +756,8 @@ -- where fromInteger is gotten by looking up from_name, and -- the (3 :: Integer) is returned by mkOverLit -- Ditto the string literal "foo" to (fromString ("foo" :: String)) + -- + -- See Note [Typechecking overloaded literals] in GHC.Tc.Gen.Expr do { hs_lit <- mkOverLit val ; from_id <- tcLookupId from_name ; (wrap1, from_ty) <- topInstantiate (LiteralOrigin lit) (idType from_id) @@ -778,11 +772,12 @@ ; let lit_expr = L (l2l loc) $ mkHsWrapCo co $ HsLit noExtField hs_lit from_expr = mkHsWrap (wrap2 <.> wrap1) $ - HsVar noExtField (L loc from_id) + mkHsVar (L loc from_id) witness = HsApp noExtField (L (l2l loc) from_expr) lit_expr - lit' = lit { ol_ext = OverLitTc { ol_rebindable = rebindable - , ol_witness = witness - , ol_type = res_ty } } + lit' = OverLit { ol_val = val + , ol_ext = OverLitTc { ol_rebindable = rebindable + , ol_witness = witness + , ol_type = res_ty } } ; return (HsOverLit noExtField lit', res_ty) } {- ********************************************************************* @@ -793,43 +788,33 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc) tcCheckId name res_ty - = do { (expr, actual_res_ty) <- tcInferId name + = do { (expr, actual_res_ty) <- tcInferId (noLocA $ noUserRdr name) ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty]) ; addFunResCtxt expr [] actual_res_ty res_ty $ tcWrapResultO (OccurrenceOf name) rn_fun expr actual_res_ty res_ty } where - rn_fun = HsVar noExtField (noLocA name) + rn_fun = mkHsVar (noLocA name) ------------------------ -tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) +tcInferId :: LocatedN (WithUserRdr Name) -> TcM (HsExpr GhcTc, TcSigmaType) -- Look up an occurrence of an Id -- Do not instantiate its type -tcInferId id_name +tcInferId lname@(L loc (WithUserRdr rdr id_name)) + | id_name `hasKey` assertIdKey - = do { dflags <- getDynFlags + = -- See Note [Overview of assertions] + do { dflags <- getDynFlags ; if gopt Opt_IgnoreAsserts dflags - then tc_infer_id id_name - else tc_infer_assert id_name } + then tc_infer_id lname + else tc_infer_id (L loc $ WithUserRdr rdr assertErrorName) } | otherwise - = do { (expr, ty) <- tc_infer_id id_name - ; traceTc "tcInferId" (ppr id_name <+> dcolon <+> ppr ty) - ; return (expr, ty) } - -tc_infer_assert :: Name -> TcM (HsExpr GhcTc, TcSigmaType) --- Deal with an occurrence of 'assert' --- See Note [Adding the implicit parameter to 'assert'] -tc_infer_assert assert_name - = do { assert_error_id <- tcLookupId assertErrorName - ; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name) - (idType assert_error_id) - ; return (mkHsWrap wrap (HsVar noExtField (noLocA assert_error_id)), id_rho) - } + = tc_infer_id lname -tc_infer_id :: Name -> TcM (HsExpr GhcTc, TcSigmaType) -tc_infer_id id_name +tc_infer_id :: LocatedN (WithUserRdr Name) -> TcM (HsExpr GhcTc, TcSigmaType) +tc_infer_id (L loc (WithUserRdr rdr id_name)) = do { thing <- tcLookup id_name - ; case thing of + ; (expr,ty) <- case thing of ATcId { tct_id = id } -> do { check_local_id id ; return_id id } @@ -839,17 +824,50 @@ -- nor does it need the 'lifting' treatment -- Hence no checkTh stuff here - AGlobal (AConLike (RealDataCon con)) -> tcInferDataCon con - AGlobal (AConLike (PatSynCon ps)) -> tcInferPatSyn id_name ps - (tcTyThingTyCon_maybe -> Just tc) -> failIllegalTyCon WL_Anything (tyConName tc) - ATyVar name _ -> failIllegalTyVal name + AGlobal (AConLike cl) -> tcInferConLike cl - _ -> failWithTc $ TcRnExpectedValueId thing } + (tcTyThingTyCon_maybe -> Just tc) -> failIllegalTyCon WL_Term (WithUserRdr rdr (tyConName tc)) + ATyVar name _ -> failIllegalTyVar (WithUserRdr rdr name) + + _ -> failWithTc $ TcRnExpectedValueId thing + + ; traceTc "tcInferId" (ppr id_name <+> dcolon <+> ppr ty) + ; return (expr, ty) } where - return_id id = return (HsVar noExtField (noLocA id), idType id) + return_id id = return (mkHsVar (L loc id), idType id) -{- Note [Suppress hints with RequiredTypeArguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Overview of assertions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If you write (assert pred x) then + + * If `-fignore-asserts` (which sets Opt_IgnoreAsserts) is on, the code is + typechecked as written, but `assert`, defined in GHC.Internal.Base + assert _pred r = r + simply ignores `pred` + + * But without `-fignore-asserts`, GHC rewrites it to (assertError pred e) + and that is defined in GHC.Internal.IO.Exception as + assertError :: (?callStack :: CallStack) => Bool -> a -> a + which does test the predicate and, if it is not True, throws an exception, + capturing the CallStack. + + This rewrite is done in `tcInferId`. + +So `-fignore-asserts` makes the assertion go away altogether, which may be good for +production code. + +The reason that `assert` and `assertError` are defined in very different modules +is a historical accident. + +Note: the Haddock for `assert` is on `GHC.Internal.Base.assert`, since that is +what appears in the user's source proram. + +It's not entirely kosher to rewrite `assert` to `assertError`, because there's no +way to "undo" if you want to see the original source code in the typechecker +output. We can fix this if it becomes a problem. + +Note [Suppress hints with RequiredTypeArguments] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When a type variable is used at the term level, GHC assumes the user might have made a typo and suggests a term variable with a similar name. @@ -895,14 +913,17 @@ check_local_id :: Id -> TcM () check_local_id id - = do { checkThLocalId id - ; tcEmitBindingUsage $ singleUsageUE id } + = do { tcEmitBindingUsage $ singleUsageUE id } check_naughty :: OccName -> TcId -> TcM () check_naughty lbl id | isNaughtyRecordSelector id = failWithTc (TcRnRecSelectorEscapedTyVar lbl) | otherwise = return () +tcInferConLike :: ConLike -> TcM (HsExpr GhcTc, TcSigmaType) +tcInferConLike (RealDataCon con) = tcInferDataCon con +tcInferConLike (PatSynCon ps) = tcInferPatSyn ps + tcInferDataCon :: DataCon -> TcM (HsExpr GhcTc, TcSigmaType) -- See Note [Typechecking data constructors] tcInferDataCon con @@ -924,7 +945,7 @@ -- in GHC.Core.DataCon. ; return ( XExpr (ConLikeTc (RealDataCon con) tvs all_arg_tys) - , mkInvisForAllTys tvbs $ mkPhiTy full_theta $ + , mkForAllTys tvbs $ mkPhiTy full_theta $ mkScaledFunTys scaled_arg_tys res ) } where linear_to_poly :: Scaled Type -> TcM (Scaled Type) @@ -934,25 +955,17 @@ ; return (Scaled mul_var ty) } linear_to_poly scaled_ty = return scaled_ty -tcInferPatSyn :: Name -> PatSyn -> TcM (HsExpr GhcTc, TcSigmaType) -tcInferPatSyn id_name ps +tcInferPatSyn :: PatSyn -> TcM (HsExpr GhcTc, TcSigmaType) +tcInferPatSyn ps = case patSynBuilderOcc ps of Just (expr,ty) -> return (expr,ty) - Nothing -> failWithTc (nonBidirectionalErr id_name) + Nothing -> failWithTc (nonBidirectionalErr (patSynName ps)) nonBidirectionalErr :: Name -> TcRnMessage nonBidirectionalErr = TcRnPatSynNotBidirectional -{- Note [Adding the implicit parameter to 'assert'] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The typechecker transforms (assert e1 e2) to (assertError e1 e2). -This isn't really the Right Thing because there's no way to "undo" -if you want to see the original source code in the typechecker -output. We'll have fix this in due course, when we care more about -being able to reconstruct the exact original program. - -Note [Typechecking data constructors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Typechecking data constructors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As per Note [Polymorphisation of linear fields] in GHC.Core.Multiplicity, linear fields of data constructors get a polymorphic multiplicity when the data constructor is used as a term: @@ -1054,81 +1067,7 @@ ************************************************************************ -} -checkThLocalId :: Id -> TcM () --- The renamer has already done checkWellStaged, --- in RnSplice.checkThLocalName, so don't repeat that here. --- Here we just add constraints for cross-stage lifting -checkThLocalId id - = do { mb_local_use <- getStageAndBindLevel (idName id) - ; case mb_local_use of - Just (top_lvl, bind_lvl, use_stage) - | thLevel use_stage > bind_lvl - -> checkCrossStageLifting top_lvl id use_stage - _ -> return () -- Not a locally-bound thing, or - -- no cross-stage link - } --------------------------------------- -checkCrossStageLifting :: TopLevelFlag -> Id -> ThStage -> TcM () --- If we are inside typed brackets, and (use_lvl > bind_lvl) --- we must check whether there's a cross-stage lift to do --- Examples \x -> [|| x ||] --- [|| map ||] --- --- This is similar to checkCrossStageLifting in GHC.Rename.Splice, but --- this code is applied to *typed* brackets. - -checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q)) - | isTopLevel top_lvl - = when (isExternalName id_name) (keepAlive id_name) - -- See Note [Keeping things alive for Template Haskell] in GHC.Rename.Splice - - | otherwise - = -- Nested identifiers, such as 'x' in - -- E.g. \x -> [|| h x ||] - -- We must behave as if the reference to x was - -- h $(lift x) - -- We use 'x' itself as the splice proxy, used by - -- the desugarer to stitch it all back together. - -- If 'x' occurs many times we may get many identical - -- bindings of the same splice proxy, but that doesn't - -- matter, although it's a mite untidy. - do { let id_ty = idType id - ; checkTc (isTauTy id_ty) $ - TcRnTHError $ TypedTHError $ SplicePolymorphicLocalVar id - -- If x is polymorphic, its occurrence sites might - -- have different instantiations, so we can't use plain - -- 'x' as the splice proxy name. I don't know how to - -- solve this, and it's probably unimportant, so I'm - -- just going to flag an error for now - - ; lift <- if isStringTy id_ty then - do { sid <- tcLookupId GHC.Builtin.Names.TH.liftStringName - -- See Note [Lifting strings] - ; return (HsVar noExtField (noLocA sid)) } - else - setConstraintVar lie_var $ - -- Put the 'lift' constraint into the right LIE - newMethodFromName (OccurrenceOf id_name) - GHC.Builtin.Names.TH.liftName - [getRuntimeRep id_ty, id_ty] - - -- Warning for implicit lift (#17804) - ; addDetailedDiagnostic (TcRnImplicitLift $ idName id) - - -- Update the pending splices - ; ps <- readMutVar ps_var - ; let pending_splice = PendingTcSplice id_name - (nlHsApp (mkLHsWrap (applyQuoteWrapper q) (noLocA lift)) - (nlHsVar id)) - ; writeMutVar ps_var (pending_splice : ps) - - ; return () } - where - id_name = idName id - -checkCrossStageLifting _ _ _ = return () - {- Note [Lifting strings] ~~~~~~~~~~~~~~~~~~~~~~ @@ -1147,6 +1086,35 @@ Record selectors for TyCons in this module are ordinary local bindings, which show up as ATcIds rather than AGlobals. So we need to check for naughtiness in both branches. c.f. GHC.Tc.TyCl.Utils.mkRecSelBinds. + +Note [Explicit Level Imports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This is the overview note which explains the whole implementation of ExplicitLevelImports + +GHC Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0682-explicit-level-imports.rst +Paper: https://mpickering.github.io/papers/explicit-level-imports.pdf + +The feature is turned on by the `ExplicitLevelImports` extension. +At the source level, the user marks imports with `quote` or `splice` to introduce +them at level 1 or -1. + +The function GHC.Tc.Utils.Monad.getCurrentAndBindLevel. computes the levels +at which a Name is available: + - for top-level Names, this information is stored in its GRE; it is either local + (level 0) or imported, in which case the levels it is imported at are stored in the + 'ImpDeclSpec's for the GRE. The function 'greLevels' retrieves this information. + - for locally-bound Names, this information is stored in the ThBindEnv. +GHC.Rename.Splice.checkCrossLevelLifting checks that levels in user-written programs +are correct. + +Instances are checked by `checkWellLevelledDFun`, which computes the level of an +instance by calling `checkWellLevelledInstanceWhat`, which sees what is available at by looking at the module graph. + +That's it for the main implementation of the feature; the rest is modifications +to the driver parts of the code to use this information. For example, in downsweep, +we only enable code generation for modules needed at the runtime stage. +See Note [-fno-code mode]. + -} @@ -1186,37 +1154,11 @@ -- is not deeply skolemised, so still use tcSplitNestedSigmaTys (args_fun, res_fun) = tcSplitFunTys fun_tau (args_env, res_env) = tcSplitFunTys env_tau - n_fun = length args_fun - n_env = length args_env - info | -- Check for too few args - -- fun_tau = a -> b, res_tau = Int - n_fun > n_env - , not_fun res_env - = text "Probable cause:" <+> quotes (ppr fun) - <+> text "is applied to too few arguments" - - | -- Check for too many args - -- fun_tau = a -> Int, res_tau = a -> b -> c -> d - -- The final guard suppresses the message when there - -- aren't enough args to drop; eg. the call is (f e1) - n_fun < n_env - , not_fun res_fun - , (n_fun + count isValArg args) >= n_env - -- Never suggest that a naked variable is - -- applied to too many args! - = text "Possible cause:" <+> quotes (ppr fun) - <+> text "is applied to too many arguments" - - | otherwise - = Outputable.empty - + info = + FunResCtxt fun (count isValArg args) res_fun res_env + (length args_fun) (length args_env) ; return info } - not_fun ty -- ty is definitely not an arrow type, - -- and cannot conceivably become one - = case tcSplitTyConApp_maybe ty of - Just (tc, _) -> isAlgTyCon tc - Nothing -> False {- Note [Splitting nested sigma types in mismatched function types] @@ -1268,25 +1210,15 @@ ********************************************************************* -} addStmtCtxt :: ExprStmt GhcRn -> TcRn a -> TcRn a -addStmtCtxt stmt thing_inside - = do let err_doc = pprStmtInCtxt (HsDoStmt (DoExpr Nothing)) stmt - addErrCtxt err_doc thing_inside - where - pprStmtInCtxt :: HsStmtContextRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc - pprStmtInCtxt ctxt stmt - = vcat [ hang (text "In a stmt of" - <+> pprAStmtContext ctxt <> colon) 2 (pprStmt stmt) - ] +addStmtCtxt stmt = + addErrCtxt (StmtErrCtxt (HsDoStmt (DoExpr Nothing)) stmt) addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of - HsUnboundVar {} -> thing_inside - _ -> addErrCtxt (exprCtxt e) thing_inside - -- The HsUnboundVar special case addresses situations like + HsHole _ -> thing_inside + _ -> addErrCtxt (ExprCtxt e) thing_inside + -- The HsHole special case addresses situations like -- f x = _ -- when we don't want to say "In the expression: _", -- because it is mentioned in the error message itself - -exprCtxt :: HsExpr GhcRn -> SDoc -exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) diff --git a/GHC/Tc/Gen/HsType.hs b/GHC/Tc/Gen/HsType.hs --- a/GHC/Tc/Gen/HsType.hs +++ b/GHC/Tc/Gen/HsType.hs @@ -7,8 +7,6 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecursiveDo #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -35,6 +33,7 @@ bindOuterFamEqnTKBndrs_Q_Tv, bindOuterFamEqnTKBndrs, tcOuterTKBndrs, scopedSortOuter, outerTyVars, outerTyVarBndrs, + tcGadtConTyVarBndrs, bindOuterSigTKBndrs_Tv, tcExplicitTKBndrs, bindNamedWildCardBinders, @@ -42,7 +41,8 @@ -- Type checking type and class decls, and instances thereof bindTyClTyVars, bindTyClTyVarsAndZonk, tcFamTyPats, - etaExpandAlgTyCon, tcbVisibilities, + maybeEtaExpandAlgTyCon, tcbVisibilities, + etaExpandAlgTyCon, -- tyvars zonkAndScopedSort, @@ -69,14 +69,12 @@ tcMult, -- Pattern type signatures - tcHsPatSigType, tcHsTyPat, + tcHsPatSigType, tcHsTyPat, tcRuleBndrSig, HoleMode(..), - -- Error messages - funAppCtxt, addTyConFlavCtxt, - -- Utils tyLitFromLit, tyLitFromOverloadedLit, + ) where import GHC.Prelude hiding ( head, init, last, tail ) @@ -87,6 +85,7 @@ import GHC.Tc.Utils.Monad import GHC.Tc.Types.Origin import GHC.Tc.Types.LclEnv +import GHC.Tc.Types.ErrCtxt import GHC.Tc.Types.Constraint import GHC.Tc.Utils.Env import GHC.Tc.Utils.TcMType @@ -108,7 +107,7 @@ import GHC.Builtin.Types.Prim import GHC.Types.Error import GHC.Types.Name.Env -import GHC.Types.Name.Reader( lookupLocalRdrOcc ) +import GHC.Types.Name.Reader( WithUserRdr(..), lookupLocalRdrOcc ) import GHC.Types.Var import GHC.Types.Var.Set import GHC.Core.TyCon @@ -358,11 +357,15 @@ funsSigCtxt (L _ name1 : _) = FunSigCtxt name1 NoRRC funsSigCtxt [] = panic "funSigCtxt" -addSigCtxt :: Outputable hs_ty => UserTypeCtxt -> LocatedA hs_ty -> TcM a -> TcM a +addSigCtxt :: UserTypeCtxt -> UserSigType GhcRn -> TcM a -> TcM a addSigCtxt ctxt hs_ty thing_inside - = setSrcSpan (getLocA hs_ty) $ - addErrCtxt (pprSigCtxt ctxt hs_ty) $ + = setSrcSpan l $ + addErrCtxt (UserSigCtxt ctxt hs_ty) $ thing_inside + where + l = case hs_ty of + UserLHsSigType ty -> getLocA ty + UserLHsType ty -> getLocA ty pprSigCtxt :: Outputable hs_ty => UserTypeCtxt -> LocatedA hs_ty -> SDoc -- (pprSigCtxt ctxt ) @@ -392,14 +395,14 @@ -- meth :: forall a (x :: f a). Proxy x -> () -- When instantiating Proxy with kappa, we must unify kappa := f a. But we're -- still working out the kind of f, and thus f a will have a coercion in it. --- Coercions may block unification (Note [Equalities with incompatible kinds] in +-- Coercions may block unification (Note [Equalities with heterogeneous kinds] in -- GHC.Tc.Solver.Equality, wrinkle (EIK2)) and so we fail to unify. If we try to -- kind-generalize, we'll end up promoting kappa to the top level (because -- kind-generalization is normally done right before adding a binding to the context), -- and then we can't set kappa := f a, because a is local. kcClassSigType names sig_ty@(L _ (HsSig { sig_bndrs = hs_outer_bndrs, sig_body = hs_ty })) - = addSigCtxt (funsSigCtxt names) sig_ty $ + = addSigCtxt (funsSigCtxt names) (UserLHsSigType sig_ty) $ do { _ <- bindOuterSigTKBndrs_Tv hs_outer_bndrs $ tcCheckLHsType hs_ty liftedTypeKind ; return () } @@ -407,7 +410,7 @@ tcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM Type -- Does not do validity checking tcClassSigType names sig_ty - = addSigCtxt sig_ctxt sig_ty $ + = addSigCtxt sig_ctxt (UserLHsSigType sig_ty) $ do { skol_info <- mkSkolemInfo skol_info_anon ; (implic, ty) <- tc_lhs_sig_type skol_info sig_ty (TheKind liftedTypeKind) ; emitImplication implic @@ -436,7 +439,7 @@ -- Does validity checking -- See Note [Recipe for checking a signature] tcHsSigType ctxt sig_ty - = addSigCtxt ctxt sig_ty $ + = addSigCtxt ctxt (UserLHsSigType sig_ty) $ do { traceTc "tcHsSigType {" (ppr sig_ty) ; skol_info <- mkSkolemInfo skol_info -- Generalise here: see Note [Kind generalisation] @@ -585,7 +588,7 @@ -- Does validity checking and zonking. tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) tcStandaloneKindSig (L _ (StandaloneKindSig _ (L _ name) ksig)) - = addSigCtxt ctxt ksig $ + = addSigCtxt ctxt (UserLHsSigType ksig) $ do { kind <- tc_top_lhs_type KindLevel ctxt ksig ; checkValidType ctxt kind ; return (name, kind) } @@ -694,8 +697,10 @@ do { addErrTc $ TcRnIllegalInstance $ IllegalClassInstance (TypeThing ty) $ IllegalInstanceHead - $ InstHeadNonClass - $ Just tc + $ InstHeadNonClassHead + $ InstNonClassTyCon + (noUserRdr $ tyConName tc) + (fmap tyConName $ tyConFlavour tc) ; return Nothing } Nothing -> do { addErrTc $ TcRnIllegalDerivingItem hs_ty; return Nothing } @@ -825,7 +830,7 @@ where fam_name = tyConName fam_tc fam_arity = tyConArity fam_tc - lhs_fun = noLocA (HsTyVar noAnn NotPromoted (noLocA fam_name)) + lhs_fun = noLocA (HsTyVar noAnn NotPromoted (noLocA $ noUserRdr fam_name)) {- Note [tcFamTyPats: zonking the result kind] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -941,7 +946,7 @@ then `id` gets instantiated to have type alpha -> alpha. The variable alpha is then unconstrained and regeneralized. So we may well end up with - x = /\x. id @a + x = /\a. id @a But we cannot do this in types, as we have no type-level lambda. So, we must be careful only to instantiate at the last possible moment, when @@ -949,9 +954,15 @@ in calls to `tcInstInvisibleTyBinders`; a particular case in point is in `checkExpectedKind`. +For example, suppose we have: + Actual: ∀ k2 k. k -> k2 -> k + Expected: ∀ k. k -> Type -> k +We must very delicately instantiate just k2 to kappa, and then unify + (∀ k. k -> Type -> k) ~ (∀ k. k -> kappa -> k) + Otherwise, we are careful /not/ to instantiate. For example: -* at a variable in `tcTyVar` -* in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi. + * at a variable in `tcTyVar` + * in `tcInferLHsTypeUnsaturated`, which is used by :kind in GHCi. ************************************************************************ * * @@ -967,8 +978,8 @@ -} -tcMult :: HsArrow GhcRn -> TcM Mult -tcMult hc = tc_mult typeLevelMode hc +tcMult :: LHsType GhcRn -> TcM Mult +tcMult ty = tc_check_lhs_type typeLevelMode ty multiplicityTy -- | Info about the context in which we're checking a type. Currently, -- differentiates only between types and kinds, but this will likely @@ -1052,9 +1063,9 @@ -- | Infer the kind of a type and desugar. This is the "up" type-checker, -- as described in Note [Bidirectional type checking] tc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind) - tc_infer_hs_type mode rn_ty - = tcInfer $ \exp_kind -> tcHsType mode rn_ty exp_kind + = runInferKind $ \exp_kind -> + tcHsType mode rn_ty exp_kind {- Note [Typechecking HsCoreTys] @@ -1122,15 +1133,6 @@ tcHsType mode (HsParTy _ ty) exp_kind = tcLHsType mode ty exp_kind tcHsType mode (HsDocTy _ ty _) exp_kind = tcLHsType mode ty exp_kind -tcHsType _ ty@(HsBangTy _ bang _) _ - -- While top-level bangs at this point are eliminated (eg !(Maybe Int)), - -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of - -- bangs are invalid, so fail. (#7210, #14761) - = failWith $ TcRnUnexpectedAnnotation ty bang -tcHsType _ ty@(HsRecTy {}) _ - -- Record types (which only show up temporarily in constructor - -- signatures) should have been removed by now - = failWithTc $ TcRnIllegalRecordSyntax (Right ty) -- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType'. -- Here we get rid of it and add the finalizers to the global environment @@ -1148,9 +1150,9 @@ tcHsType mode (HsFunTy _ mult ty1 ty2) exp_kind = tc_fun_type mode mult ty1 ty2 exp_kind -tcHsType mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind +tcHsType mode (HsOpTy _ _ ty1 (L _ (WithUserRdr _ op)) ty2) exp_kind | op `hasKey` unrestrictedFunTyConKey - = tc_fun_type mode (HsUnrestrictedArrow noExtField) ty1 ty2 exp_kind + = tc_fun_type mode (HsUnannotated noExtField) ty1 ty2 exp_kind --------- Foralls tcHsType mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind @@ -1266,10 +1268,8 @@ = checkExpKind rn_ty liftedTypeKind liftedTypeKind exp_kind --------- Literals -tcHsType _ rn_ty@(HsTyLit _ (HsNumTy x n)) exp_kind - = do { when (n < 0) $ - addErr $ TcRnNegativeNumTypeLiteral (HsNumTy x n) - ; checkWiredInTyCon naturalTyCon +tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind + = do { checkWiredInTyCon naturalTyCon ; checkExpKind rn_ty (mkNumLitTy n) naturalTy exp_kind } tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind @@ -1395,10 +1395,7 @@ -} ------------------------------------------ -tc_mult :: TcTyMode -> HsArrow GhcRn -> TcM Mult -tc_mult mode ty = tc_check_lhs_type mode (arrowToHsType ty) multiplicityTy ------------------------------------------- -tc_fun_type :: TcTyMode -> HsArrow GhcRn -> LHsType GhcRn -> LHsType GhcRn -> ExpKind +tc_fun_type :: TcTyMode -> HsMultAnn GhcRn -> LHsType GhcRn -> LHsType GhcRn -> ExpKind -> TcM TcType tc_fun_type mode mult ty1 ty2 exp_kind = case mode_tyki mode of TypeLevel -> @@ -1418,6 +1415,10 @@ ; checkExpKind (HsFunTy noExtField mult ty1 ty2) (tcMkVisFunTy mult' ty1' ty2') liftedTypeKind exp_kind } + where + tc_mult mode mult = case multAnnToHsType mult of + Just mult' -> tc_check_lhs_type mode mult' multiplicityTy + Nothing -> return manyDataConTy {- Note [Skolem escape and forall-types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1486,15 +1487,10 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do traceTc "finish_tuple" (ppr tup_sort $$ ppr tau_kinds $$ ppr exp_kind) case tup_sort of - ConstraintTuple - | [tau_ty] <- tau_tys - -- Drop any uses of 1-tuple constraints here. - -- See Note [Ignore unary constraint tuples] - -> check_expected_kind tau_ty constraintKind - | otherwise - -> do let tycon = cTupleTyCon arity - checkCTupSize arity - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + ConstraintTuple -> do + let tycon = cTupleTyCon arity + checkCTupSize arity + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkTupSize arity @@ -1513,47 +1509,6 @@ check_expected_kind ty act_kind = checkExpectedKind rn_ty ty act_kind exp_kind -{- -Note [Ignore unary constraint tuples] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -GHC provides unary tuples and unboxed tuples (see Note [One-tuples] in -GHC.Builtin.Types) but does *not* provide unary constraint tuples. Why? First, -recall the definition of a unary tuple data type: - - data Solo a = Solo a - -Note that `Solo a` is *not* the same thing as `a`, since Solo is boxed and -lazy. Therefore, the presence of `Solo` matters semantically. On the other -hand, suppose we had a unary constraint tuple: - - class a => Solo% a - -This compiles down a newtype (i.e., a cast) in Core, so `Solo% a` is -semantically equivalent to `a`. Therefore, a 1-tuple constraint would have -no user-visible impact, nor would it allow you to express anything that -you couldn't otherwise. - -We could simply add Solo% for consistency with tuples (Solo) and unboxed -tuples (Solo#), but that would require even more magic to wire in another -magical class, so we opt not to do so. We must be careful, however, since -one can try to sneak in uses of unary constraint tuples through Template -Haskell, such as in this program (from #17511): - - f :: $(pure (ForallT [] [TupleT 1 `AppT` (ConT ''Show `AppT` ConT ''Int)] - (ConT ''String))) - -- f :: Solo% (Show Int) => String - f = "abc" - -This use of `TupleT 1` will produce an HsBoxedOrConstraintTuple of arity 1, -and since it is used in a Constraint position, GHC will attempt to treat -it as thought it were a constraint tuple, which can potentially lead to -trouble if one attempts to look up the name of a constraint tuple of arity -1 (as it won't exist). To avoid this trouble, we simply take any unary -constraint tuples discovered when typechecking and drop them—i.e., treat -"Solo% a" as though the user had written "a". This is always safe to do -since the two constraints should be semantically equivalent. --} - {- ********************************************************************* * * Type applications @@ -1568,7 +1523,8 @@ is_app :: HsType GhcRn -> Bool is_app (HsAppKindTy {}) = True is_app (HsAppTy {}) = True - is_app (HsOpTy _ _ _ (L _ op) _) = not (op `hasKey` unrestrictedFunTyConKey) + is_app (HsOpTy _ _ _ (L _ (WithUserRdr _ op)) _) + = not (op `hasKey` unrestrictedFunTyConKey) -- I'm not sure why this funTyConKey test is necessary -- Can it even happen? Perhaps for t1 `(->)` t2 -- but then maybe it's ok to treat that like a normal @@ -1599,7 +1555,7 @@ -- application. In particular, for a HsTyVar (which includes type -- constructors, it does not zoom off into tcInferTyApps and family -- saturation -tcInferTyAppHead _ (L _ (HsTyVar _ _ (L _ tv))) +tcInferTyAppHead _ (L _ (HsTyVar _ _ (L _ (WithUserRdr _ tv)))) = tcTyVar tv tcInferTyAppHead mode ty = tc_infer_lhs_type mode ty @@ -1697,7 +1653,7 @@ ; let exp_kind = substTy subst $ piTyBinderType ki_binder ; arg_mode <- mkHoleMode KindLevel HM_VTA -- HM_VKA: see Note [Wildcards in visible kind application] - ; ki_arg <- addErrCtxt (funAppCtxt orig_hs_ty hs_ki_arg n) $ + ; ki_arg <- addErrCtxt (FunAppCtxt (FunAppCtxtTy orig_hs_ty hs_ki_arg) n) $ tc_check_lhs_type arg_mode hs_ki_arg exp_kind ; traceTc "tcInferTyApps (vis kind app)" (ppr exp_kind) @@ -1728,7 +1684,7 @@ , ppr (piTyBinderType ki_binder) , ppr subst ]) ; let exp_kind = substTy subst $ piTyBinderType ki_binder - ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ + ; arg' <- addErrCtxt (FunAppCtxt (FunAppCtxtTy orig_hs_ty arg) n) $ tc_check_lhs_type mode arg exp_kind ; traceTc "tcInferTyApps (vis normal app) 2" (ppr exp_kind) ; (subst', fun') <- mkAppTyM subst fun ki_binder arg' @@ -2010,11 +1966,11 @@ ; return (res_ty `mkCastTy` co_k) } } where -- We need to make sure that both kinds have the same number of implicit - -- foralls out front. If the actual kind has more, instantiate accordingly. - -- Otherwise, just pass the type & kind through: the errors are caught - -- in unifyType. - n_exp_invis_bndrs = invisibleTyBndrCount exp_kind - n_act_invis_bndrs = invisibleTyBndrCount act_kind + -- foralls and constraints out front. If the actual kind has more, instantiate + -- accordingly. Otherwise, just pass the type & kind through: the errors + -- are caught in unifyType. + n_exp_invis_bndrs = invisibleBndrCount exp_kind + n_act_invis_bndrs = invisibleBndrCount act_kind n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs @@ -2027,7 +1983,9 @@ checkExpKind rn_ty ty ki (Check ki') = checkExpectedKind rn_ty ty ki ki' checkExpKind _rn_ty ty ki (Infer cell) = do - co <- fillInferResult ki cell + -- NB: do not instantiate. + -- See Note [Do not always instantiate eagerly in types] + co <- fillInferResultNoInst ki cell pure (ty `mkCastTy` co) --------------------------- @@ -2241,12 +2199,10 @@ -- Wrap a context around only if we want to show that contexts. -- Omit invisible ones and ones user's won't grok addTypeCtxt (L _ (HsWildCardTy _)) thing = thing -- "In the type '_'" just isn't helpful. -addTypeCtxt (L _ ty) thing - = addErrCtxt doc thing - where - doc = text "In the type" <+> quotes (ppr ty) +addTypeCtxt ty thing = addErrCtxt (TypeCtxt ty) thing + {- ********************************************************************* * * Type-variable binders @@ -2456,7 +2412,7 @@ , hsq_explicit = hs_tvs }) kc_res_ki -- CUSK case -- See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl - = addTyConFlavCtxt name flav $ + = addErrCtxt (TyConDeclCtxt name flav) $ do { skol_info <- mkSkolemInfo skol_info_anon ; (tclvl, wanted, (scoped_kvs, (tc_bndrs, res_kind))) <- pushLevelAndSolveEqualitiesX "kcCheckDeclHeader_cusk" $ @@ -2493,7 +2449,7 @@ ++ map (mkExplicitTyConBinder mentioned_kv_set) tc_bndrs -- Eta expand if necessary; we are building a PolyTyCon - ; (eta_tcbs, res_kind) <- etaExpandAlgTyCon flav skol_info all_tcbs res_kind + ; (eta_tcbs, res_kind) <- maybeEtaExpandAlgTyCon flav skol_info all_tcbs res_kind ; let all_tv_prs = mkTyVarNamePairs (scoped_kvs ++ binderVars tc_bndrs) final_tcbs = all_tcbs `chkAppend` eta_tcbs @@ -2557,7 +2513,7 @@ , hsq_explicit = hs_bndrs }) kc_res_ki -- No standalone kind signature and no CUSK. -- See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl - = addTyConFlavCtxt name flav $ + = addErrCtxt (TyConDeclCtxt name flav) $ do { rejectInvisibleBinders name hs_bndrs ; (scoped_kvs, (tc_bndrs, res_kind)) -- Why bindImplicitTKBndrs_Q_Tv which uses newTyVarTyVar? @@ -2629,7 +2585,7 @@ kcCheckDeclHeader_sig sig_kind name flav (HsQTvs { hsq_ext = implicit_nms , hsq_explicit = hs_tv_bndrs }) kc_res_ki - = addTyConFlavCtxt name flav $ + = addErrCtxt (TyConDeclCtxt name flav) $ do { skol_info <- mkSkolemInfo (TyConSkol flav name) ; let avoid_occs = map nameOccName (hsLTyVarNames hs_tv_bndrs) ; (sig_tcbs :: [TcTyConBinder], sig_res_kind :: Kind) @@ -2750,8 +2706,8 @@ ; let -- Drop invisible binders from sig_kind until they match up -- with res_ki. By analogy with checkExpectedKind. - n_res_invis_bndrs = invisibleTyBndrCount actual_res_ki - n_sig_invis_bndrs = invisibleTyBndrCount sig_kind + n_res_invis_bndrs = invisibleBndrCount actual_res_ki + n_sig_invis_bndrs = invisibleBndrCount sig_kind n_to_inst = n_sig_invis_bndrs - n_res_invis_bndrs (_, sig_kind') = splitInvisPiTysN n_to_inst sig_kind @@ -3422,6 +3378,20 @@ , hso_bndrs = exp_bndrs } , thing) } +--------------- +tcGadtConTyVarBndrs :: SkolemInfo + -> HsOuterSigTyVarBndrs GhcRn + -> [HsForAllTelescope GhcRn] + -> TcM a -> TcM ([TcTyVarBinder], a) +tcGadtConTyVarBndrs skol_info outer inner thing_inside + = do { (outer_bndrs, (inner_tvbs, a)) <- + tcOuterTKBndrs skol_info outer $ + tcExplicitTKBndrs skol_info (concatMap hsForAllTelescopeBndrs inner) $ + thing_inside + ; outer_bndrs <- scopedSortOuter outer_bndrs + ; let outer_tvbs = tyVarSpecToBinders (outerTyVarBndrs outer_bndrs) + ; return (outer_tvbs ++ inner_tvbs, a) } + -------------------------------------- -- Explicit tyvar binders -------------------------------------- @@ -3946,14 +3916,20 @@ -} ----------------------------------- -etaExpandAlgTyCon :: TyConFlavour tc -> SkolemInfo +maybeEtaExpandAlgTyCon :: TyConFlavour tc -> SkolemInfo -> [TcTyConBinder] -> Kind -> TcM ([TcTyConBinder], Kind) -etaExpandAlgTyCon flav skol_info tcbs res_kind +maybeEtaExpandAlgTyCon flav skol_info tcbs res_kind | needsEtaExpansion flav - = splitTyConKind skol_info in_scope avoid_occs res_kind + = etaExpandAlgTyCon skol_info tcbs res_kind | otherwise = return ([], res_kind) + +etaExpandAlgTyCon :: SkolemInfo + -> [TcTyConBinder] -> Kind + -> TcM ([TcTyConBinder], Kind) +etaExpandAlgTyCon skol_info tcbs res_kind + = splitTyConKind skol_info in_scope avoid_occs res_kind where tyvars = binderVars tcbs in_scope = mkInScopeSetList tyvars @@ -4005,7 +3981,9 @@ name = mkInternalName uniq occ loc tv = mkTcTyVar name arg' details subst' = extendSubstInScope subst tv - uniq:uniqs' = uniqs + (uniq,uniqs') = case uniqs of + uniq:uniqs' -> (uniq,uniqs') + _ -> panic "impossible" Inf occ occs' = occs Just (Named (Bndr tv vis), kind') @@ -4236,7 +4214,7 @@ | HsWC { hswc_ext = sig_wcs, hswc_body = sig_ty } <- sig_ty , L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = body_ty}) <- sig_ty , (hs_ctxt, hs_tau) <- splitLHsQualTy body_ty - = addSigCtxt ctxt sig_ty $ + = addSigCtxt ctxt (UserLHsSigType sig_ty) $ do { mode <- mkHoleMode TypeLevel HM_Sig ; (outer_bndrs, (wcs, wcx, theta, tau)) <- solveEqualities "tcHsPartialSigType" $ @@ -4463,8 +4441,26 @@ (HsPS { hsps_ext = HsPSRn { hsps_nwcs = sig_wcs, hsps_imp_tvs = sig_ns } , hsps_body = hs_ty }) ctxt_kind - = tc_type_in_pat ctxt hole_mode hs_ty sig_wcs sig_ns ctxt_kind + = tc_type_in_pat ctxt Nothing hole_mode hs_ty sig_wcs sig_ns ctxt_kind +tcRuleBndrSig :: Name + -> SkolemInfo + -> HsPatSigType GhcRn -- The type signature + -> TcM ( [(Name, TcTyVar)] -- Wildcards + , [(Name, TcTyVar)] -- The new bit of type environment, binding + -- the scoped type variables + , TcType) -- The type +-- Used for type-checking type signatures in +-- RULE forall bndrs e.g. forall (x::Int). f x = x +-- See Note [Pattern signature binders and scoping] in GHC.Hs.Type +-- +-- This may emit constraints +-- See Note [Recipe for checking a signature] +tcRuleBndrSig name skol_info + (HsPS { hsps_ext = HsPSRn { hsps_nwcs = sig_wcs, hsps_imp_tvs = sig_ns } + , hsps_body = hs_ty }) + = tc_type_in_pat (RuleBndrTypeCtxt name) (Just skol_info) + HM_Sig hs_ty sig_wcs sig_ns OpenKind -- Typecheck type patterns, in data constructor patterns, e.g -- f (MkT @a @(Maybe b) ...) = ... @@ -4487,7 +4483,7 @@ where all_ns = imp_ns ++ exp_ns HsTPRn{hstp_nwcs = wcs, hstp_imp_tvs = imp_ns, hstp_exp_tvs = exp_ns} = hstp_rn - tc_unif_in_pat = tc_type_in_pat TypeAppCtxt HM_TyAppPat + tc_unif_in_pat = tc_type_in_pat TypeAppCtxt Nothing HM_TyAppPat -- `tc_bndr_in_pat` is used in type patterns to handle the binders case. -- See Note [Type patterns: binders and unifiers] @@ -4540,6 +4536,7 @@ -- -- * In patterns `tc_type_in_pat` is used to check pattern signatures. tc_type_in_pat :: UserTypeCtxt + -> Maybe SkolemInfo -- Just sk for RULE and SPECIALISE pragmas only -> HoleMode -- HM_Sig when in a SigPat, HM_TyAppPat when in a ConPat checking type applications. -> LHsType GhcRn -- The type in pattern -> [Name] -- All named wildcards in type @@ -4549,9 +4546,10 @@ , [(Name, TcTyVar)] -- The new bit of type environment, binding -- the scoped type variables , TcType) -- The type -tc_type_in_pat ctxt hole_mode hs_ty wcs ns ctxt_kind - = addSigCtxt ctxt hs_ty $ - do { tkv_prs <- mapM new_implicit_tv ns +tc_type_in_pat ctxt mb_skol hole_mode hs_ty wcs ns ctxt_kind + = addSigCtxt ctxt (UserLHsType hs_ty) $ + do { tkvs <- mapM new_implicit_tv ns + ; let tkv_prs = ns `zip` tkvs ; mode <- mkHoleMode TypeLevel hole_mode ; (wcs, ty) <- addTypeCtxt hs_ty $ @@ -4581,14 +4579,11 @@ where new_implicit_tv name = do { kind <- newMetaKindVar - ; tv <- case ctxt of - RuleSigCtxt rname _ -> do - skol_info <- mkSkolemInfo (RuleSkol rname) - newSkolemTyVar skol_info name kind - _ -> newPatTyVar name kind - -- See Note [Typechecking pattern signature binders] - -- NB: tv's Name may be fresh (in the case of newPatTyVar) - ; return (name, tv) } + ; case mb_skol of + Just skol_info -> newSkolemTyVar skol_info name kind + Nothing -> newPatTyVar name kind } + -- See Note [Typechecking pattern signature binders] + -- NB: tv's Name may be fresh (in the case of newPatTyVar) -- See Note [Type patterns: binders and unifiers] tyPatToBndr :: HsTyPat GhcRn -> Maybe (HsTyVarBndr () GhcRn) @@ -4605,9 +4600,9 @@ Just (HsTvb noAnn () bvar bkind) go_bvar :: HsType GhcRn -> Maybe (HsBndrVar GhcRn) - go_bvar (HsTyVar _ _ name) - | isTyVarName (unLoc name) - = Just (HsBndrVar noExtField name) + go_bvar (HsTyVar _ _ tv) + | isTyVarName (getName tv) + = Just (HsBndrVar noExtField (fmap getName tv)) go_bvar (HsWildCardTy _) = Just (HsBndrWildCard noExtField) go_bvar _ = Nothing @@ -4745,7 +4740,7 @@ tc_lhs_kind_sig mode ctxt hs_kind -- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType -- Result is zonked - = do { kind <- addErrCtxt (text "In the kind" <+> quotes (ppr hs_kind)) $ + = do { kind <- addErrCtxt (KindCtxt hs_kind) $ solveEqualities "tcLHsKindSig" $ tc_check_lhs_type mode hs_kind liftedTypeKind ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind) @@ -4766,29 +4761,6 @@ promotionErr :: Name -> PromotionErr -> TcM a promotionErr name err = failWithTc $ TcRnUnpromotableThing name err - -{- -************************************************************************ -* * - Error messages and such -* * -************************************************************************ --} - - --- | Make an appropriate message for an error in a function argument. --- Used for both expressions and types. -funAppCtxt :: (Outputable fun, Outputable arg) => fun -> arg -> Int -> SDoc -funAppCtxt fun arg arg_no - = hang (hsep [ text "In the", speakNth arg_no, text "argument of", - quotes (ppr fun) <> text ", namely"]) - 2 (quotes (ppr arg)) - --- | Add a "In the data declaration for T" or some such. -addTyConFlavCtxt :: Name -> TyConFlavour tc -> TcM a -> TcM a -addTyConFlavCtxt name flav - = addErrCtxt $ hsep [ text "In the", ppr flav - , text "declaration for", quotes (ppr name) ] {- ************************************************************************ diff --git a/GHC/Tc/Gen/Match.hs b/GHC/Tc/Gen/Match.hs --- a/GHC/Tc/Gen/Match.hs +++ b/GHC/Tc/Gen/Match.hs @@ -5,7 +5,10 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {- @@ -19,7 +22,7 @@ ( tcFunBindMatches , tcCaseMatches , tcLambdaMatches - , tcGRHSList + , tcGRHSNE , tcGRHSsPat , TcStmtChecker , TcExprStmtChecker @@ -73,13 +76,17 @@ import GHC.Utils.Misc import GHC.Types.Name +import GHC.Types.Name.Reader import GHC.Types.Id import GHC.Types.SrcLoc import GHC.Types.Basic( VisArity, isDoExpansionGenerated ) +import qualified GHC.Data.List.NonEmpty as NE + import Control.Monad import Control.Arrow ( second ) -import qualified Data.List.NonEmpty as NE +import Data.Foldable (toList) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (mapMaybe) import qualified GHC.LanguageExtensions as LangExt @@ -114,20 +121,24 @@ ; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity) - ; (wrap_fun, (wrap_mult, r)) + ; (wrap_fun, r) <- matchExpectedFunTys herald ctxt arity exp_ty $ \ pat_tys rhs_ty -> tcScalingUsage mult $ -- Makes sure that if the binding is unrestricted, it counts as -- consuming its rhs Many times. - do { traceTc "tcFunBindMatches 2" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys - , ppr pat_tys $$ ppr rhs_ty ]) + do { traceTc "tcFunBindMatches 2" $ + vcat [ text "ctxt:" <+> pprUserTypeCtxt ctxt + , text "arity:" <+> ppr arity + , text "invis_pat_tys:" <+> ppr invis_pat_tys + , text "pat_tys:" <+> ppr pat_tys + , text "rhs_ty:" <+> ppr rhs_ty ] ; tcMatches mctxt tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches } - ; return (wrap_fun <.> wrap_mult, r) } + ; return (wrap_fun, r) } where - herald = ExpectedFunTyMatches (NameThing fun_name) matches mctxt = mkPrefixFunRhs (noLocA fun_name) noAnn + herald = ExpectedFunTyMatches (NameThing fun_name) matches funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool funBindPrecondition (MG { mg_alts = L _ alts }) @@ -145,11 +156,11 @@ = do { arity <- checkArgCounts matches -- Check argument counts since this is also used for \cases - ; (wrapper, (mult_co_wrap, r)) + ; (wrapper, r) <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ pat_tys rhs_ty -> tcMatches ctxt tc_body (invis_pat_tys ++ pat_tys) rhs_ty matches - ; return (wrapper <.> mult_co_wrap, r) } + ; return (wrapper, r) } where ctxt = LamAlt lam_variant herald = ExpectedFunTyLam lam_variant e @@ -174,7 +185,7 @@ -> Scaled TcSigmaTypeFRR -- ^ Type of scrutinee -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives -> ExpRhoType -- ^ Type of the whole case expression - -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc))) + -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -- Translated alternatives -- wrapper goes from MatchGroup's ty to expected ty @@ -186,19 +197,7 @@ -> TcM (GRHSs GhcTc (LHsExpr GhcTc)) -- Used for pattern bindings tcGRHSsPat mult grhss res_ty - = tcScalingUsage mult $ do - { (mult_co_wrapper, r) <- tcGRHSs PatBindRhs tcBody grhss res_ty - ; return $ mkWrap mult_co_wrapper r } - where - mkWrap wrap grhss@(GRHSs { grhssGRHSs = L loc (GRHS x guards body) : rhss }) = - grhss { grhssGRHSs = L loc (GRHS x guards (mkLHsWrap wrap body)) : rhss } - mkWrap _ (GRHSs { grhssGRHSs = [] }) = panic "tcGRHSsPat: empty GHRSs" - mkWrap _ _ = panic "tcGRHSsPat: non-empty extensions" - -- Should be the following but it warns of redundant pattern and I couldn't - -- find a way to silence them - -- - -- mkWrap _ (GRHSs { grhssGRHSs = L _ (XGRHS absent) : _ }) = dataConCantHappen absent - -- mkWrap _ (XGRHSs absent) = dataConCantHappen absent + = tcScalingUsage mult $ tcGRHSs PatBindRhs tcBody grhss res_ty {- ********************************************************************* * * @@ -231,7 +230,7 @@ -> [ExpPatType] -- ^ Expected pattern types. -> ExpRhoType -- ^ Expected result-type of the Match. -> MatchGroup GhcRn (LocatedA (body GhcRn)) - -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc))) + -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches , mg_ext = origin }) @@ -247,23 +246,21 @@ [ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb) [] -> panic "tcMatches: no arguments in EmptyCase" _t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase" - ; rhs_ty <- expTypeToType rhs_ty - ; return (idHsWrapper, MG { mg_alts = L l [] - , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin - }) } + ; rhs_ty <- expTypeToType rhs_ty + ; return (MG { mg_alts = L l [] + , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin + }) } | otherwise = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches - ; let (usages, wmatches) = unzip umatches - ; let (wrappers, matches') = unzip wmatches - ; let wrapper = mconcat wrappers + ; let (usages, matches') = unzip umatches ; tcEmitBindingUsage $ supUEs usages ; pat_tys <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys) ; rhs_ty <- readExpType rhs_ty ; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty) - ; return (wrapper, MG { mg_alts = L l matches' - , mg_ext = MatchGroupTc pat_tys rhs_ty origin - }) } + ; return (MG { mg_alts = L l matches' + , mg_ext = MatchGroupTc pat_tys rhs_ty origin + }) } where -- We filter out foralls because we have no use for them in HsToCore. filter_out_forall_pat_tys :: [ExpPatType] -> [Scaled ExpSigmaTypeFRR] @@ -315,24 +312,24 @@ -> [ExpPatType] -- Expected pattern types -> ExpRhoType -- Expected result-type of the Match. -> LMatch GhcRn (LocatedA (body GhcRn)) - -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc))) + -> TcM (LMatch GhcTc (LocatedA (body GhcTc))) tcMatch tc_body pat_tys rhs_ty match - = do { (L loc (wrapper, r)) <- wrapLocMA (tc_match pat_tys rhs_ty) match - ; return (wrapper, L loc r) } + = do { (L loc r) <- wrapLocMA (tc_match pat_tys rhs_ty) match + ; return (L loc r) } where tc_match pat_tys rhs_ty match@(Match { m_ctxt = ctxt, m_pats = L l pats, m_grhss = grhss }) = add_match_ctxt $ - do { (pats', (wrapper, grhss')) <- tcMatchPats ctxt pats pat_tys $ - tcGRHSs ctxt tc_body grhss rhs_ty + do { (pats', (grhss')) <- tcMatchPats ctxt pats pat_tys $ + tcGRHSs ctxt tc_body grhss rhs_ty -- NB: pats' are just the /value/ patterns -- See Note [tcMatchPats] in GHC.Tc.Gen.Pat - ; return (wrapper, Match { m_ext = noExtField - , m_ctxt = ctxt - , m_pats = L l pats' - , m_grhss = grhss' }) } + ; return (Match { m_ext = noExtField + , m_ctxt = ctxt + , m_pats = L l pats' + , m_grhss = grhss' }) } where -- For (\x -> e), tcExpr has already said "In the expression \x->e" -- so we don't want to add "In the lambda abstraction \x->e" @@ -341,7 +338,7 @@ add_match_ctxt thing_inside = case ctxt of LamAlt LamSingle -> thing_inside StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt - _ -> addErrCtxt (pprMatchInCtxt match) thing_inside + _ -> addErrCtxt (MatchInCtxt match) thing_inside ------------- tcGRHSs :: AnnoBody body @@ -349,23 +346,23 @@ -> TcMatchAltChecker body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType - -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc))) + -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) -- Notice that we pass in the full res_ty, so that we get -- good inference from simple things like -- f = \(x::forall a.a->a) -> -- We used to force it to be a monotype when there was more than one guard -- but we don't need to do that any more tcGRHSs ctxt tc_body (GRHSs _ grhss binds) res_ty - = do { (binds', wrapper, grhss') <- tcLocalBinds binds $ do - tcGRHSList ctxt tc_body grhss res_ty - ; return (wrapper, GRHSs emptyComments grhss' binds') } + = do { (binds', grhss') <- tcLocalBinds binds $ do + tcGRHSNE ctxt tc_body grhss res_ty + ; return (GRHSs emptyComments grhss' binds') } -tcGRHSList :: forall body. AnnoBody body +tcGRHSNE :: forall body. AnnoBody body => HsMatchContextRn -> TcMatchAltChecker body - -> [LGRHS GhcRn (LocatedA (body GhcRn))] -> ExpRhoType - -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))] -tcGRHSList ctxt tc_body grhss res_ty - = do { (usages, grhss') <- mapAndUnzipM (wrapLocSndMA tc_alt) grhss + -> NonEmpty (LGRHS GhcRn (LocatedA (body GhcRn))) -> ExpRhoType + -> TcM (NonEmpty (LGRHS GhcTc (LocatedA (body GhcTc)))) +tcGRHSNE ctxt tc_body grhss res_ty + = do { (usages, grhss') <- unzip <$> traverse (wrapLocSndMA tc_alt) grhss ; tcEmitBindingUsage $ supUEs usages ; return grhss' } where @@ -480,7 +477,7 @@ -- LetStmts are handled uniformly, regardless of context tcStmtsAndThen ctxt stmt_chk (L loc (LetStmt x binds) : stmts) res_ty thing_inside - = do { (binds', _, (stmts',thing)) <- tcLocalBinds binds $ + = do { (binds', (stmts',thing)) <- tcLocalBinds binds $ tcStmtsAndThen ctxt stmt_chk stmts res_ty thing_inside ; return (L loc (LetStmt x binds') : stmts', thing) } @@ -499,7 +496,7 @@ | otherwise = do { (stmt', (stmts', thing)) <- setSrcSpanA loc $ - addErrCtxt (pprStmtInCtxt ctxt stmt) $ + addErrCtxt (StmtErrCtxt ctxt stmt) $ stmt_chk ctxt stmt res_ty $ \ res_ty' -> popErrCtxt $ tcStmtsAndThen ctxt stmt_chk stmts res_ty' $ @@ -608,25 +605,27 @@ ; (pairs', thing) <- loop env [] bndr_stmts_s ; return (ParStmt unitTy pairs' noExpr noSyntaxExpr, thing) } where - -- loop :: LocalRdrEnv -- The original LocalRdrEnv - -- -> [Name] -- Variables bound by earlier branches - -- -> [([LStmt GhcRn], [GhcRn])] - -- -> TcM ([([LStmt GhcTc], [GhcTc])], thing) - -- + loop + :: LocalRdrEnv -> [Name] -> NonEmpty (ParStmtBlock GhcRn GhcRn) + -> TcM (NonEmpty (ParStmtBlock GhcTc GhcTc), _) -- Invariant: on entry to `loop`, the LocalRdrEnv is set to -- origEnv, the LocalRdrEnv for the entire comprehension - loop _ allBinds [] = do { thing <- bindLocalNames allBinds $ thing_inside elt_ty - ; return ([], thing) } -- matching in the branches - - loop origEnv priorBinds (ParStmtBlock x stmts names _ : pairs) + loop origEnv priorBinds (ParStmtBlock x stmts names _ :| pairs) = do { (stmts', (ids, pairs', thing)) <- tcStmtsAndThen ctxt (tcLcStmt m_tc) stmts elt_ty $ \ _elt_ty' -> do { ids <- tcLookupLocalIds names ; (pairs', thing) <- setLocalRdrEnv origEnv $ - loop origEnv (names ++ priorBinds) pairs + loop1 origEnv (names ++ priorBinds) pairs ; return (ids, pairs', thing) } - ; return ( ParStmtBlock x stmts' ids noSyntaxExpr : pairs', thing ) } + ; return ( ParStmtBlock x stmts' ids noSyntaxExpr :| pairs', thing ) } + loop1 + :: LocalRdrEnv -> [Name] -> [ParStmtBlock GhcRn GhcRn] + -> TcM ([ParStmtBlock GhcTc GhcTc], _) + -- matching in the branches + loop1 _ binds [] = [ ([], a) | a <- bindLocalNames binds (thing_inside elt_ty) ] + loop1 env binds (x:xs) = [ (toList ys, a) | (ys, a) <- loop env binds (x:|xs) ] + tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts , trS_bndrs = bindersMap , trS_by = by, trS_using = using }) elt_ty thing_inside @@ -869,7 +868,7 @@ -- Ensure that every old binder of type `b` is linked up with its -- new binder which should have type `n b` -- See Note [TransStmt binder map] in GHC.Hs.Expr - n_bndr_ids = zipWithEqual "tcMcStmt" mk_n_bndr n_bndr_names bndr_ids + n_bndr_ids = zipWithEqual mk_n_bndr n_bndr_names bndr_ids bindersMap' = bndr_ids `zip` n_bndr_ids -- Type check the thing in the environment with @@ -924,20 +923,19 @@ ; mzip_op' <- unLoc `fmap` tcCheckPolyExpr (noLocA mzip_op) mzip_ty -- type dummies since we don't know all binder types yet - ; id_tys_s <- (mapM . mapM) (const (newFlexiTyVarTy liftedTypeKind)) - [ names | ParStmtBlock _ _ names _ <- bndr_stmts_s ] + ; tup_tys_and_bndr_stmts_s <- traverse (\ bndr_stmts@(ParStmtBlock _ _ names _) -> + [ (tup_tys, bndr_stmts) + | tup_tys <- mkBigCoreTupTy <$> traverse (const (newFlexiTyVarTy liftedTypeKind)) names ]) bndr_stmts_s -- Typecheck bind: - ; let tup_tys = [ mkBigCoreTupTy id_tys | id_tys <- id_tys_s ] - tuple_ty = mk_tuple_ty tup_tys + ; let tuple_ty = mk_tuple_ty (NE.map fst tup_tys_and_bndr_stmts_s) ; (((blocks', thing), inner_res_ty), bind_op') <- tcSyntaxOp MCompOrigin bind_op [ synKnownType (m_ty `mkAppTy` tuple_ty) , SynFun (synKnownType tuple_ty) SynRho ] res_ty $ \ [inner_res_ty] _ -> - do { stuff <- loop m_ty (mkCheckExpType inner_res_ty) - tup_tys bndr_stmts_s + do { stuff <- loop m_ty (mkCheckExpType inner_res_ty) tup_tys_and_bndr_stmts_s ; return (stuff, inner_res_ty) } ; return (ParStmt inner_res_ty blocks' mzip_op' bind_op', thing) } @@ -945,17 +943,10 @@ where mk_tuple_ty tys = foldr1 (\tn tm -> mkBoxedTupleTy [tn, tm]) tys - -- loop :: Type -- m_ty - -- -> ExpRhoType -- inner_res_ty - -- -> [TcType] -- tup_tys - -- -> [ParStmtBlock Name] - -- -> TcM ([([LStmt GhcTc], [TcId])], thing) - loop _ inner_res_ty [] [] = do { thing <- thing_inside inner_res_ty - ; return ([], thing) } - -- matching in the branches - - loop m_ty inner_res_ty (tup_ty_in : tup_tys_in) - (ParStmtBlock x stmts names return_op : pairs) + loop + :: Type -> ExpRhoType -> NonEmpty (Type, ParStmtBlock GhcRn GhcRn) + -> TcM (NonEmpty (ParStmtBlock GhcTc GhcTc), _) + loop m_ty inner_res_ty ((tup_ty_in, ParStmtBlock x stmts names return_op) :| xs) = do { let m_tup_ty = m_ty `mkAppTy` tup_ty_in ; (stmts', (ids, return_op', pairs', thing)) <- tcStmtsAndThen ctxt tcMcStmt stmts (mkCheckExpType m_tup_ty) $ @@ -966,11 +957,17 @@ tcSyntaxOp MCompOrigin return_op [synKnownType tup_ty] m_tup_ty' $ \ _ _ -> return () - ; (pairs', thing) <- loop m_ty inner_res_ty tup_tys_in pairs + ; (pairs', thing) <- loop1 m_ty inner_res_ty xs ; return (ids, return_op', pairs', thing) } - ; return (ParStmtBlock x stmts' ids return_op' : pairs', thing) } - loop _ _ _ _ = panic "tcMcStmt.loop" + ; return (ParStmtBlock x stmts' ids return_op' :| pairs', thing) } + loop1 + :: Type -> ExpRhoType -> [(Type, ParStmtBlock GhcRn GhcRn)] + -> TcM ([ParStmtBlock GhcTc GhcTc], _) + -- matching in the branches + loop1 _ r [] = [ ([], a) | a <- thing_inside r ] + loop1 m r (x:xs) = [ (toList ys, a) | (ys, a) <- loop m r (x:|xs) ] + tcMcStmt _ stmt _ _ = pprPanic "tcMcStmt: unexpected Stmt" (ppr stmt) @@ -1037,7 +1034,7 @@ ; tcExtendIdEnv tup_ids $ do { ((stmts', (ret_op', tup_rets)), stmts_ty) - <- tcInfer $ \ exp_ty -> + <- runInferRho $ \ exp_ty -> tcStmtsAndThen ctxt tcDoStmt stmts exp_ty $ \ inner_res_ty -> do { tup_rets <- zipWithM tcCheckId tup_names (map mkCheckExpType tup_elt_tys) @@ -1049,7 +1046,7 @@ ; return (ret_op', tup_rets) } ; ((_, mfix_op'), mfix_res_ty) - <- tcInfer $ \ exp_ty -> + <- runInferRho $ \ exp_ty -> tcSyntaxOp DoOrigin mfix_op [synKnownType (mkVisFunTyMany tup_ty stmts_ty)] exp_ty $ \ _ _ -> return () @@ -1175,7 +1172,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside = do { body_ty <- newFlexiTyVarTy liftedTypeKind ; let arity = length pairs - ; ts <- replicateM (arity-1) $ newInferExpType + ; ts <- replicateM (arity-1) $ newInferExpType IIF_DeepRho ; exp_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind ; pat_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind ; let fun_ty = mkVisFunTysMany pat_tys body_ty @@ -1218,7 +1215,7 @@ , .. }, pat_ty, exp_ty) = setSrcSpan (combineSrcSpans (getLocA pat) (getLocA rhs)) $ - addErrCtxt (pprStmtInCtxt ctxt (mkRnBindStmt pat rhs)) $ + addErrCtxt (StmtErrCtxt ctxt (mkRnBindStmt pat rhs)) $ do { rhs' <- tcCheckMonoExprNC rhs exp_ty ; (pat', _) <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $ return () @@ -1311,4 +1308,4 @@ reqd_args_in_match :: LocatedA (Match GhcRn body1) -> VisArity -- Counts the number of /required/ (aka visible) args in the match - reqd_args_in_match (L _ (Match { m_pats = L _ pats })) = count (isVisArgPat . unLoc) pats + reqd_args_in_match (L _ (Match { m_pats = L _ pats })) = count isVisArgLPat pats diff --git a/GHC/Tc/Gen/Pat.hs b/GHC/Tc/Gen/Pat.hs --- a/GHC/Tc/Gen/Pat.hs +++ b/GHC/Tc/Gen/Pat.hs @@ -26,7 +26,7 @@ import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferRho ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferExpr ) import GHC.Hs import GHC.Hs.Syn.Type @@ -73,7 +73,7 @@ import qualified Data.List.NonEmpty as NE import GHC.Data.List.SetOps ( getNth ) -import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Language.Haskell.Syntax.Basic (FieldLabelString(..), LexicalFixity(..)) import Data.List( partition ) import Control.Monad.Trans.Writer.CPS @@ -101,12 +101,8 @@ , pe_ctxt = ctxt , pe_orig = PatOrigin } ; dflags <- getDynFlags - ; mult_co_wrap <- manyIfLazy dflags pat - -- The wrapper checks for correct multiplicities. - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - ; (pat', r) <- tc_lpat pat_ty penv pat thing_inside - ; pat_ty' <- readExpType (scaledThing pat_ty) - ; return (mkLHsWrapPat mult_co_wrap pat' pat_ty', r) } + ; manyIfLazy dflags pat + ; tc_lpat pat_ty penv pat thing_inside } where -- The logic is partly duplicated from decideBangHood in -- GHC.HsToCore.Utils. Ugh… @@ -116,10 +112,10 @@ where xstrict p@(L _ (LazyPat _ _)) = checkManyPattern LazyPatternReason p pat_ty xstrict (L _ (ParPat _ p)) = xstrict p - xstrict _ = return WpHole + xstrict _ = return () - not_xstrict (L _ (BangPat _ _)) = return WpHole - not_xstrict (L _ (VarPat _ _)) = return WpHole + not_xstrict (L _ (BangPat _ _)) = return () + not_xstrict (L _ (VarPat _ _)) = return () not_xstrict (L _ (ParPat _ p)) = not_xstrict p not_xstrict p = checkManyPattern LazyPatternReason p pat_ty @@ -142,7 +138,7 @@ -- Returns only the /value/ patterns; see Note [tcMatchPats] tcMatchPats match_ctxt pats pat_tys thing_inside - = assertPpr (count isVisibleExpPatType pat_tys == count (isVisArgPat . unLoc) pats) + = assertPpr (count isVisibleExpPatType pat_tys == count isVisArgLPat pats) (ppr pats $$ ppr pat_tys) $ -- Check PRECONDITION -- When we get @patterns the (length pats) will change @@ -197,8 +193,9 @@ -- f @a t = ... -- loop (InvisPat{} : _) (ExpForAllPatTy (Bndr _ Required) : _) -- 4. f :: forall {a}. Int -- f @a t = ... -- loop (InvisPat{} : _) (ExpForAllPatTy (Bndr _ Inferred) : _) - loop (L loc (InvisPat _ tp) : _) _ = - failAt (locA loc) (TcRnInvisPatWithNoForAll tp) + loop (L loc (InvisPat _ tp) : _) _ + = setSrcSpanA loc $ + failWithTc (TcRnIllegalInvisibleTypePattern tp InvisPatNoForall) -- ExpFunPatTy: expecting a value pattern -- tc_lpat will error if it sees a @t type pattern @@ -223,7 +220,7 @@ -> TcM a -> TcM ((LPat GhcTc, a), TcSigmaTypeFRR) tcInferPat frr_orig ctxt pat thing_inside - = tcInferFRR frr_orig $ \ exp_ty -> + = runInferSigmaFRR frr_orig $ \ exp_ty -> tc_lpat (unrestricted exp_ty) penv pat thing_inside where penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = PatOrigin } @@ -468,11 +465,10 @@ = assertPpr (equalLength pats tys) (ppr pats $$ ppr tys) $ tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p) penv - (zipEqual "tc_lpats" pats tys) + (zipEqual pats tys) -------------------- --- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. -checkManyPattern :: NonLinearPatternReason -> LPat GhcRn -> Scaled a -> TcM HsWrapper +checkManyPattern :: NonLinearPatternReason -> LPat GhcRn -> Scaled a -> TcM () checkManyPattern reason pat pat_ty = tcSubMult (NonLinearPatternOrigin reason pat) ManyTy (scaledMult pat_ty) @@ -523,7 +519,7 @@ pat_to_type (VarPat _ lname) = do { tell (tpBuilderExplicitTV (unLoc lname)) ; return b } - where b = noLocA (HsTyVar noAnn NotPromoted lname) + where b = noLocA (HsTyVar noAnn NotPromoted $ fmap noUserRdr lname) pat_to_type (WildPat _) = return b where b = noLocA (HsWildCardTy noExtField) pat_to_type (SigPat _ pat sig_ty) @@ -562,17 +558,17 @@ ; rty <- pat_to_type (unLoc right) ; let { t = noLocA (HsOpTy noExtField NotPromoted lty lname rty)} ; pure t } -pat_to_type (ConPat _ lname (PrefixCon invis_args vis_args)) - = do { let { appHead = noLocA (HsTyVar noAnn NotPromoted lname)} - ; ty_invis <- foldM apply_invis_arg appHead invis_args - ; tys_vis <- traverse (pat_to_type . unLoc) vis_args - ; let t = foldl' mkHsAppTy ty_invis tys_vis - ; pure t } +pat_to_type (ConPat _ lname (PrefixCon args)) + = do { let { appHead = noLocA (HsTyVar noAnn NotPromoted lname) } + ; foldM apply_arg appHead args } where - apply_invis_arg :: LHsType GhcRn -> HsConPatTyArg GhcRn -> WriterT HsTyPatRnBuilder TcM (LHsType GhcRn) - apply_invis_arg !t (HsConPatTyArg _ (HsTP argx arg)) + apply_arg :: LHsType GhcRn -> LPat GhcRn -> WriterT HsTyPatRnBuilder TcM (LHsType GhcRn) + apply_arg !t (L _ (InvisPat _ (HsTP argx arg))) = do { tell (builderFromHsTyPatRn argx) ; pure (mkHsAppKindTy noExtField t arg)} + apply_arg !t (L _ p) + = do { ty_p <- pat_to_type p + ; pure (mkHsAppTy t ty_p)} pat_to_type pat = lift $ failWith $ TcRnIllformedTypePattern pat @@ -628,11 +624,10 @@ VarPat x (L l name) -> do { (wrap, id) <- tcPatBndr penv name pat_ty - ; (res, mult_wrap) <- tcCheckUsage name (scaledMult pat_ty) $ + ; res <- tcCheckUsage name (scaledMult pat_ty) $ tcExtendIdEnv1 name id thing_inside - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. ; pat_ty <- readExpType (scaledThing pat_ty) - ; return (mkHsWrapPat (wrap <.> mult_wrap) (VarPat x (L l id)) pat_ty, res) } + ; return (mkHsWrapPat wrap (VarPat x (L l id)) pat_ty, res) } ParPat x pat -> do { (pat', res) <- tc_lpat pat_ty penv pat thing_inside @@ -653,8 +648,7 @@ ; return (OrPat pat_ty pats', res) } LazyPat x pat -> do - { mult_wrap <- checkManyPattern LazyPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + { checkManyPattern LazyPatternReason (noLocA ps_pat) pat_ty ; (pat', (res, pat_ct)) <- tc_lpat pat_ty (makeLazy penv) pat $ captureConstraints thing_inside @@ -668,18 +662,16 @@ ; pat_ty <- readExpType (scaledThing pat_ty) ; _ <- unifyType Nothing (typeKind pat_ty) liftedTypeKind - ; return (mkHsWrapPat mult_wrap (LazyPat x pat') pat_ty, res) } + ; return ((LazyPat x pat'), res) } WildPat _ -> do - { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + { checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty ; res <- thing_inside ; pat_ty <- expTypeToType (scaledThing pat_ty) - ; return (mkHsWrapPat mult_wrap (WildPat pat_ty) pat_ty, res) } + ; return (WildPat pat_ty, res) } AsPat x (L nm_loc name) pat -> do - { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + { checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty ; (wrap, bndr_id) <- setSrcSpanA nm_loc (tcPatBndr penv name pat_ty) ; (pat', res) <- tcExtendIdEnv1 name bndr_id $ tc_lpat (pat_ty `scaledSet`(mkCheckExpType $ idType bndr_id)) @@ -692,26 +684,27 @@ -- -- If you fix it, don't forget the bindInstsOfPatIds! ; pat_ty <- readExpType (scaledThing pat_ty) - ; return (mkHsWrapPat (wrap <.> mult_wrap) (AsPat x (L nm_loc bndr_id) pat') pat_ty, res) } + ; return (mkHsWrapPat wrap (AsPat x (L nm_loc bndr_id) pat') pat_ty, res) } ViewPat _ expr pat -> do - { mult_wrap <- checkManyPattern ViewPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + { checkManyPattern ViewPatternReason (noLocA ps_pat) pat_ty -- -- It should be possible to have view patterns at linear (or otherwise -- non-Many) multiplicity. But it is not clear at the moment what -- restriction need to be put in place, if any, for linear view -- patterns to desugar to type-correct Core. - ; (expr',expr_ty) <- tcInferRho expr - -- Note [View patterns and polymorphism] + ; (expr', expr_rho) <- tcInferExpr IIF_ShallowRho expr + -- IIF_ShallowRho: do not perform deep instantiation, regardless of + -- DeepSubsumption (Note [View patterns and polymorphism]) + -- But we must do top-instantiation to expose the arrow to matchActualFunTy -- Expression must be a function ; let herald = ExpectedFunTyViewPat $ unLoc expr ; (expr_wrap1, Scaled _mult inf_arg_ty, inf_res_sigma) - <- matchActualFunTy herald (Just . HsExprRnThing $ unLoc expr) (1,expr_ty) expr_ty + <- matchActualFunTy herald (Just . HsExprRnThing $ unLoc expr) (1,expr_rho) expr_rho -- See Note [View patterns and polymorphism] - -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_sigma) + -- expr_wrap1 :: expr_rho "->" (inf_arg_ty -> inf_res_sigma) -- Check that overall pattern is more polymorphic than arg type ; expr_wrap2 <- tc_sub_type penv (scaledThing pat_ty) inf_arg_ty @@ -724,18 +717,18 @@ ; pat_ty <- readExpType h_pat_ty ; let expr_wrap2' = mkWpFun expr_wrap2 idHsWrapper (Scaled w pat_ty) inf_res_sigma - -- expr_wrap2' :: (inf_arg_ty -> inf_res_sigma) "->" - -- (pat_ty -> inf_res_sigma) - -- NB: pat_ty comes from matchActualFunTy, so it has a - -- fixed RuntimeRep, as needed to call mkWpFun. - ; let - expr_wrap = expr_wrap2' <.> expr_wrap1 <.> mult_wrap + -- expr_wrap2' :: (inf_arg_ty -> inf_res_sigma) "->" + -- (pat_ty -> inf_res_sigma) + -- NB: pat_ty comes from matchActualFunTy, so it has a + -- fixed RuntimeRep, as needed to call mkWpFun. + expr_wrap = expr_wrap2' <.> expr_wrap1 + ; return $ (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res) } {- Note [View patterns and polymorphism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this exotic example: +Consider this exotic example (test T26331a): pair :: forall a. Bool -> a -> forall b. b -> (a,b) f :: Int -> blah @@ -744,11 +737,15 @@ The expression (pair True) should have type pair True :: Int -> forall b. b -> (Int,b) so that it is ready to consume the incoming Int. It should be an -arrow type (t1 -> t2); hence using (tcInferRho expr). +arrow type (t1 -> t2); and we must not instantiate that `forall b`, +/even with DeepSubsumption/. Hence using `IIF_ShallowRho`; this is the only +place where `IIF_ShallowRho` is used. Then, when taking that arrow apart we want to get a *sigma* type (forall b. b->(Int,b)), because that's what we want to bind 'x' to. Fortunately that's what matchActualFunTy returns anyway. + +Another example is #26331. -} -- Type signatures in patterns @@ -777,8 +774,7 @@ penv pats thing_inside ; pat_ty <- readExpType (scaledThing pat_ty) ; return (mkHsWrapPat coi - (ListPat elt_ty pats') pat_ty, res) -} + (ListPat elt_ty pats') pat_ty, res) } TuplePat _ pats boxity -> do { let arity = length pats @@ -861,9 +857,7 @@ -- -- When there is no negation, neg_lit_ty and lit_ty are the same NPat _ (L l over_lit) mb_neg eq -> do - { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - -- + { checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty -- It may be possible to refine linear pattern so that they work in -- linear environments. But it is not clear how useful this is. ; let orig = LiteralOrigin over_lit @@ -886,7 +880,7 @@ ; res <- thing_inside ; pat_ty <- readExpType (scaledThing pat_ty) - ; return (mkHsWrapPat mult_wrap (NPat pat_ty (L l lit') mb_neg' eq') pat_ty, res) } + ; return (NPat pat_ty (L l lit') mb_neg' eq', res) } {- Note [NPlusK patterns] @@ -914,8 +908,7 @@ -- See Note [NPlusK patterns] NPlusKPat _ (L nm_loc name) (L loc lit) _ ge minus -> do - { mult_wrap <- checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + { checkManyPattern OtherPatternReason (noLocA ps_pat) pat_ty ; let pat_exp_ty = scaledThing pat_ty orig = LiteralOrigin lit ; (lit1', ge') @@ -958,7 +951,7 @@ -- we get warnings if we try. #17783 pat' = NPlusKPat pat_ty (L nm_loc bndr_id) (L loc lit1') lit2' ge' minus'' - ; return (mkHsWrapPat mult_wrap pat' pat_ty, res) } + ; return (pat', res) } -- Here we get rid of it and add the finalizers to the global environment. -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. @@ -1050,12 +1043,7 @@ = do { (tidy_env, sig_ty) <- zonkTidyTcType tidy_env sig_ty ; res_ty <- readExpType res_ty -- should be filled in by now ; (tidy_env, res_ty) <- zonkTidyTcType tidy_env res_ty - ; let msg = vcat [ hang (text "When checking that the pattern signature:") - 4 (ppr sig_ty) - , nest 2 (hang (text "fits the type of its context:") - 2 (ppr res_ty)) ] - ; return (tidy_env, msg) } - + ; return (tidy_env, PatSigErrCtxt sig_ty res_ty) } {- ********************************************************************* * * @@ -1131,12 +1119,13 @@ -- MkT :: forall a b c. (a~[b]) => b -> c -> T a -- with scrutinee of type (T ty) -tcConPat :: PatEnv -> LocatedN Name +tcConPat :: PatEnv -> LocatedN (WithUserRdr Name) -> Scaled ExpSigmaTypeFRR -- Type of the pattern -> HsConPatDetails GhcRn -> TcM a -> TcM (Pat GhcTc, a) -tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside - = do { con_like <- tcLookupConLike con_name +tcConPat penv (L loc qcon) pat_ty arg_pats thing_inside + = do { let con_lname = L loc (getName qcon) + ; con_like <- tcLookupConLike qcon ; case con_like of RealDataCon data_con -> tcDataConPat con_lname data_con pat_ty penv arg_pats thing_inside @@ -1194,7 +1183,7 @@ ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX skol_info tenv1 ex_tvs -- Get location from monad, not from ex_tvs -- This freshens: See Note [Freshen existentials] - -- Why "super"? See Note [Binding when looking up instances] + -- Why "super"? See Note [Super skolems: binding when looking up instances] -- in GHC.Core.InstEnv. ; let arg_tys' = substScaledTys tenv arg_tys @@ -1218,16 +1207,21 @@ , text "arg_tys':" <+> ppr arg_tys' , text "arg_pats" <+> ppr arg_pats ]) - ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats + ; (univ_ty_args, ex_ty_args, val_arg_pats) <- splitConTyArgs con_like arg_pats + ; traceTc "tcConPat" (vcat [ text "univ_ty_args:" <+> ppr univ_ty_args + , text "ex_ty_args:" <+> ppr ex_ty_args + , text "val_arg_pats:" <+> ppr val_arg_pats ]) + ; if null ex_tvs && null eq_spec && null theta then do { -- The common case; no class bindings etc -- (see Note [Arrows and patterns]) - (arg_pats', res) <- tcConTyArgs tenv penv univ_ty_args $ + (val_arg_pats', res) <- + tcConTyArgs tenv penv univ_ty_args $ tcConValArgs con_like arg_tys_scaled - penv arg_pats thing_inside + penv val_arg_pats thing_inside ; let res_pat = ConPat { pat_con = header - , pat_args = arg_pats' + , pat_args = val_arg_pats' , pat_con_ext = ConPatTc { cpt_tvs = [], cpt_dicts = [] , cpt_binds = emptyTcEvBinds @@ -1244,7 +1238,7 @@ -- order is *important* as we generate the list of -- dictionary binders from theta' - ; when (not (null eq_spec) || any isEqPred theta) warnMonoLocalBinds + ; when (not (null eq_spec) || any isEqClassPred theta) warnMonoLocalBinds ; given <- newEvVars theta' ; (ev_binds, (arg_pats', res)) @@ -1252,7 +1246,7 @@ tcConTyArgs tenv penv univ_ty_args $ checkConstraints (getSkolemInfo skol_info) ex_tvs' given $ tcConTyArgs tenv penv ex_ty_args $ - tcConValArgs con_like arg_tys_scaled penv arg_pats thing_inside + tcConValArgs con_like arg_tys_scaled penv val_arg_pats thing_inside ; let res_pat = ConPat { pat_con = header @@ -1281,9 +1275,10 @@ ; let all_arg_tys = ty : prov_theta ++ (map scaledThing arg_tys) ; checkGADT (PatSynCon pat_syn) ex_tvs all_arg_tys penv - ; skol_info <- case pe_ctxt penv of - LamPat mc -> mkSkolemInfo (PatSkol (PatSynCon pat_syn) mc) - LetPat {} -> return unkSkol -- Doesn't matter + ; let match_ctxt = case pe_ctxt penv of + LamPat mc -> mc + LetPat {} -> PatBindRhs + ; skol_info <- mkSkolemInfo (PatSkol (PatSynCon pat_syn) match_ctxt) ; (tenv, ex_tvs') <- tcInstSuperSkolTyVarsX skol_info subst ex_tvs -- This freshens: Note [Freshen existentials] @@ -1296,12 +1291,11 @@ req_theta' = substTheta tenv req_theta con_like = PatSynCon pat_syn - ; when (any isEqPred prov_theta) warnMonoLocalBinds + ; when (any isEqClassPred prov_theta) warnMonoLocalBinds - ; mult_wrap <- checkManyPattern PatternSynonymReason nlWildPatName pat_ty - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + ; checkManyPattern PatternSynonymReason nlWildPatName pat_ty - ; (univ_ty_args, ex_ty_args) <- splitConTyArgs con_like arg_pats + ; (univ_ty_args, ex_ty_args, val_arg_pats) <- splitConTyArgs con_like arg_pats ; wrap <- tc_sub_type penv (scaledThing pat_ty) ty' @@ -1336,17 +1330,17 @@ ; traceTc "checkConstraints {" Outputable.empty ; prov_dicts' <- newEvVars prov_theta' - ; (ev_binds, (arg_pats', res)) + ; (ev_binds, (val_arg_pats', res)) <- -- See Note [Type applications in patterns] (W4) tcConTyArgs tenv penv univ_ty_args $ checkConstraints (getSkolemInfo skol_info) ex_tvs' prov_dicts' $ tcConTyArgs tenv penv ex_ty_args $ - tcConValArgs con_like arg_tys_scaled penv arg_pats $ + tcConValArgs con_like arg_tys_scaled penv val_arg_pats $ thing_inside ; traceTc "checkConstraints }" (ppr ev_binds) ; let res_pat = ConPat { pat_con = L con_span $ PatSynCon pat_syn - , pat_args = arg_pats' + , pat_args = val_arg_pats' , pat_con_ext = ConPatTc { cpt_tvs = ex_tvs' , cpt_dicts = prov_dicts' @@ -1356,7 +1350,7 @@ } } ; pat_ty <- readExpType (scaledThing pat_ty) - ; return (mkHsWrapPat (wrap <.> mult_wrap) res_pat pat_ty, res) } + ; return (mkHsWrapPat wrap res_pat pat_ty, res) } checkFixedRuntimeRep :: DataCon -> [Scaled TcSigmaTypeFRR] -> TcM () checkFixedRuntimeRep data_con arg_tys @@ -1382,12 +1376,12 @@ This is achieve easily, but a bit trickily. When we instantiate Annotated's "required" constraints, in tcPatSynPat, give them a CtOrigin of (OccurrenceOf "Annotated"). That way the special magic -in GHC.Tc.Solver.Dict.solveCallStack which deals with CallStack +in GHC.Tc.Solver.Dict.canDictCt which deals with CallStack constraints will kick in: that logic only fires on constraints whose Origin is (OccurrenceOf f). See also Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types +and Note [Solving CallStack constraints] in GHC.Tc.Solver.Dict -} ---------------------------- -- | Convenient wrapper for calling a matchExpectedXXX function @@ -1607,44 +1601,44 @@ weren't for linearity checking, the type checker could ignore b altogether. So we have a function check_omitted_fields_multiplicity, whose purpose is to do the linearity checking on the omitted fields. - -check_omitted_fields_multiplicity returns coercions which all need to be -reflexivity after zonking: see Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. -} tcConValArgs :: ConLike -> [Scaled TcSigmaTypeFRR] -> Checker (HsConPatDetails GhcRn) (HsConPatDetails GhcTc) tcConValArgs con_like arg_tys penv con_args thing_inside = case con_args of - PrefixCon type_args arg_pats -> do - -- NB: type_args already dealt with + PrefixCon arg_pats -> do + -- NB: Type arguments already dealt with by splitConTyArgs, tcConTyArgs. -- See Note [Type applications in patterns] - { checkTc (con_arity == no_of_args) -- Check correct arity - (TcRnArityMismatch (AConLike con_like) con_arity no_of_args) - - ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys + { report_invis_arg_pats arg_pats + ; let pats_w_tys = zipEqual arg_pats arg_tys ; (arg_pats', res) <- tcMultiple tcConArg penv pats_w_tys thing_inside - ; return (PrefixCon type_args arg_pats', res) } - where - con_arity = conLikeArity con_like - no_of_args = length arg_pats + -- Return only /value/ patterns, all /type/ patterns are discarded. + -- This is also what tcMatchPats does, and Note [tcMatchPats] explains why. + ; return (PrefixCon arg_pats', res) } + where + -- Report @-patterns as errors. The valid ones have been dealt with + -- outside tcConValArgs. At this point we are expecting patterns for + -- value arguments only. + report_invis_arg_pats :: [LPat GhcRn] -> TcM () + report_invis_arg_pats ps = do + let bad_ps = [L loc tp | L loc (InvisPat _ tp) <- ps] + forM_ bad_ps $ \(L loc tp) -> + setSrcSpanA loc $ + addErrTc (TcRnIllegalInvisibleTypePattern tp InvisPatNoForall) + unless (null bad_ps) failM InfixCon p1 p2 -> do - { checkTc (con_arity == 2) -- Check correct arity - (TcRnArityMismatch (AConLike con_like) con_arity 2) - ; let [arg_ty1,arg_ty2] = arg_tys -- This can't fail after the arity check + { let [arg_ty1,arg_ty2] = arg_tys -- This can't fail after splitConTyArgs ; ([p1',p2'], res) <- tcMultiple tcConArg penv [(p1,arg_ty1),(p2,arg_ty2)] thing_inside ; return (InfixCon p1' p2', res) } - where - con_arity = conLikeArity con_like - RecCon (HsRecFields _ rpats dd) -> do - { mult_cos <- check_omitted_fields_multiplicity - -- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. + RecCon (HsRecFields x rpats dd) -> do + { check_omitted_fields_multiplicity ; (rpats', res) <- tcMultiple tc_field penv rpats thing_inside - ; return ((RecCon (HsRecFields mult_cos rpats' dd)), res) } + ; return ((RecCon (HsRecFields x rpats' dd)), res) } where tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn)) (LHsRecField GhcTc (LPat GhcTc)) @@ -1658,11 +1652,10 @@ ; return (L l (HsFieldBind ann (L loc (FieldOcc rdr (L lr sel'))) pat' pun), res) } -- See Note [Omitted record fields and linearity] - check_omitted_fields_multiplicity :: TcM MultiplicityCheckCoercions + check_omitted_fields_multiplicity :: TcM () check_omitted_fields_multiplicity = do - mult_coss <- forM omitted_field_tys $ \(fl, pat_ty) -> - tcSubMult' (OmittedFieldOrigin fl) ManyTy (scaledMult pat_ty) - return $ concat mult_coss + forM_ omitted_field_tys $ \(fl, pat_ty) -> + tcSubMult (OmittedFieldOrigin fl) ManyTy (scaledMult pat_ty) find_field_ty :: Name -> FastString -> TcM (Scaled TcType) find_field_ty sel lbl @@ -1698,44 +1691,78 @@ con_field_labels :: [Maybe FieldLabel] con_field_labels = (map Just (conLikeFieldLabels con_like)) ++ repeat Nothing +check_con_pat_arity :: ConLike -> Int -> TcM () +check_con_pat_arity con_like no_of_vis_args = + checkTc (con_vis_arity == no_of_vis_args) + (TcRnArityMismatch (AConLike con_like) con_vis_arity no_of_vis_args) + where + con_vis_arity = conLikeVisArity con_like splitConTyArgs :: ConLike -> HsConPatDetails GhcRn - -> TcM ( [(HsConPatTyArg GhcRn, TyVar)] -- Universals - , [(HsConPatTyArg GhcRn, TyVar)] ) -- Existentials + -> TcM ( [(HsTyPat GhcRn, TyVar)] -- Universals + , [(HsTyPat GhcRn, TyVar)] -- Existentials + , HsConPatDetails GhcRn ) -- Value arguments -- See Note [Type applications in patterns] (W4) --- This function is monadic only because of the error check --- for too many type arguments -splitConTyArgs con_like (PrefixCon type_args _) - = do { checkTc (type_args `leLength` con_spec_bndrs) - (TcRnTooManyTyArgsInConPattern con_like - (length con_spec_bndrs) (length type_args)) - ; if null ex_tvs -- Short cut common case - then return (bndr_ty_arg_prs, []) - else return (partition is_universal bndr_ty_arg_prs) } +-- This function is monadic only to emit error messages +splitConTyArgs con_like (PrefixCon arg_pats) = do + check_con_pat_arity con_like (count isVisArgLPat arg_pats) + split_con_ty_args Prefix con_like arg_pats +splitConTyArgs con_like (InfixCon arg1 arg2) = do + -- should not occur: (@a :+ b), (a :+ @b), or (@a :+ @b) + massert (isVisArgLPat arg1 && isVisArgLPat arg2) + check_con_pat_arity con_like 2 + split_con_ty_args Infix con_like [arg1, arg2] +splitConTyArgs _ p@(RecCon {}) = return ([], [], p) -- No type args in RecCon + +split_con_ty_args :: LexicalFixity -- How to wrap value arguments + -> ConLike -- Data constructor or pattern synonym + -> [LPat GhcRn] -- Argument patterns + -> TcM ( [(HsTyPat GhcRn, TyVar)] -- Universals + , [(HsTyPat GhcRn, TyVar)] -- Existentials + , HsConPatDetails GhcRn ) -- Value arguments +split_con_ty_args fixity con_like arg_pats = do + (bndr_ty_arg_prs, value_args) <- zip_pats_bndrs arg_pats (conLikeUserTyVarBinders con_like) + return $ if null ex_tvs -- Short cut common case + then (bndr_ty_arg_prs, [], mk_details fixity value_args) + else let (ex_prs, univ_prs) = partition is_existential bndr_ty_arg_prs + in (univ_prs, ex_prs, mk_details fixity value_args) where ex_tvs = conLikeExTyCoVars con_like - con_spec_bndrs = [ tv | Bndr tv SpecifiedSpec <- conLikeUserTyVarBinders con_like ] - -- conLikeUserTyVarBinders: see (W3) in - -- Note [Type applications in patterns] - -- SpecifiedSpec: forgetting to filter out inferred binders led to #20443 - - bndr_ty_arg_prs = type_args `zip` con_spec_bndrs - -- The zip truncates to length(type_args) + is_existential (_, tv) = tv `elem` ex_tvs + -- See Note [DataCon user type variable binders] in GHC.Core.DataCon + -- especially INVARIANT(dataConTyVars). - is_universal (_, tv) = not (tv `elem` ex_tvs) - -- See Note [DataCon user type variable binders] in GHC.Core.DataCon - -- especially INVARIANT(dataConTyVars). + mk_details Infix [a,b] = InfixCon a b + mk_details _ ps = PrefixCon ps + -- InfixCon becomes PrefixCon if there are fewer than 2 value arguments. + -- Test case: T25127_infix -splitConTyArgs _ (RecCon {}) = return ([], []) -- No type args in RecCon -splitConTyArgs _ (InfixCon {}) = return ([], []) -- No type args in InfixCon +zip_pats_bndrs :: [LPat GhcRn] -> [TyVarBinder] -> TcM ([(HsTyPat GhcRn, TyVar)], [LPat GhcRn]) +zip_pats_bndrs (L loc pat : pats) (Bndr tv vis : tvbs) + | isVisibleForAllTyFlag vis + = do { tp <- setSrcSpanA loc $ pat_to_type_pat pat + ; (prs, pats') <- zip_pats_bndrs pats tvbs + ; return ((tp, tv) : prs, pats') } + | InvisPat pat_spec tp <- pat + , Invisible spec <- vis + , pat_spec == spec + = do { (prs, pats') <- zip_pats_bndrs pats tvbs + ; return ((tp, tv):prs, pats') } +zip_pats_bndrs pats (Bndr _ vis : tvbs) + -- zip_pats_bndrs [] (Bndr _ Required : tvbs) + -- is ruled out by the arity check in splitConTyArgs, + -- so we can assume (isInvisibleForAllTyFlag vis) + = do { massert (isInvisibleForAllTyFlag vis) + ; zip_pats_bndrs pats tvbs } +zip_pats_bndrs pats [] = return ([], pats) -tcConTyArgs :: Subst -> PatEnv -> [(HsConPatTyArg GhcRn, TyVar)] +tcConTyArgs :: Subst -> PatEnv -> [(HsTyPat GhcRn, TyVar)] -> TcM a -> TcM a tcConTyArgs tenv penv prs thing_inside = tcMultiple_ (tcConTyArg tenv) penv prs thing_inside -tcConTyArg :: Subst -> Checker (HsConPatTyArg GhcRn, TyVar) () -tcConTyArg tenv penv (HsConPatTyArg _ rn_ty, con_tv) thing_inside +tcConTyArg :: Subst -> Checker (HsTyPat GhcRn, TyVar) () +tcConTyArg tenv penv (rn_ty, con_tv) thing_inside = do { (sig_wcs, sig_ibs, arg_ty) <- tcHsTyPat rn_ty (substTy tenv (varType con_tv)) ; case NE.nonEmpty sig_ibs of @@ -1889,14 +1916,13 @@ -- Not all patterns are worth pushing a context maybeWrapPatCtxt pat tcm thing_inside | not (worth_wrapping pat) = tcm thing_inside - | otherwise = addErrCtxt msg $ tcm $ popErrCtxt thing_inside + | otherwise = addErrCtxt (PatCtxt pat) $ tcm $ popErrCtxt thing_inside -- Remember to pop before doing thing_inside where worth_wrapping (VarPat {}) = False worth_wrapping (ParPat {}) = False worth_wrapping (AsPat {}) = False worth_wrapping _ = True - msg = hang (text "In the pattern:") 2 (ppr pat) ----------------------------------------------- diff --git a/GHC/Tc/Gen/Rule.hs b/GHC/Tc/Gen/Rule.hs deleted file mode 100644 --- a/GHC/Tc/Gen/Rule.hs +++ /dev/null @@ -1,529 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1993-1998 - --} - --- | Typechecking rewrite rules -module GHC.Tc.Gen.Rule ( tcRules ) where - -import GHC.Prelude - -import GHC.Hs -import GHC.Tc.Types -import GHC.Tc.Utils.Monad -import GHC.Tc.Solver -import GHC.Tc.Solver.Monad ( runTcS ) -import GHC.Tc.Types.Constraint -import GHC.Tc.Types.Origin -import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.TcType -import GHC.Tc.Gen.HsType -import GHC.Tc.Gen.Expr -import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Unify( buildImplicationFor ) -import GHC.Tc.Zonk.TcType - -import GHC.Core.Type -import GHC.Core.Coercion( mkCoVarCo ) -import GHC.Core.TyCon( isTypeFamilyTyCon ) -import GHC.Core.Predicate - -import GHC.Types.Id -import GHC.Types.Var( EvVar, tyVarName ) -import GHC.Types.Var.Set -import GHC.Types.Basic ( RuleName, NonStandardDefaultingStrategy(..) ) -import GHC.Types.SrcLoc -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Data.FastString -import GHC.Data.Bag - -{- -Note [Typechecking rules] -~~~~~~~~~~~~~~~~~~~~~~~~~ -We *infer* the typ of the LHS, and use that type to *check* the type of -the RHS. That means that higher-rank rules work reasonably well. Here's -an example (test simplCore/should_compile/rule2.hs) produced by Roman: - - foo :: (forall m. m a -> m b) -> m a -> m b - foo f = ... - - bar :: (forall m. m a -> m a) -> m a -> m a - bar f = ... - - {-# RULES "foo/bar" foo = bar #-} - -He wanted the rule to typecheck. - -Note [TcLevel in type checking rules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Bringing type variables into scope naturally bumps the TcLevel. Thus, we type -check the term-level binders in a bumped level, and we must accordingly bump -the level whenever these binders are in scope. - -Note [Re-quantify type variables in rules] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this example from #17710: - - foo :: forall k (a :: k) (b :: k). Proxy a -> Proxy b - foo x = Proxy - {-# RULES "foo" forall (x :: Proxy (a :: k)). foo x = Proxy #-} - -Written out in more detail, the "foo" rewrite rule looks like this: - - forall k (a :: k). forall (x :: Proxy (a :: k)). foo @k @a @b0 x = Proxy @k @b0 - -Where b0 is a unification variable. Where should b0 be quantified? We have to -quantify it after k, since (b0 :: k). But generalization usually puts inferred -type variables (such as b0) at the /front/ of the telescope! This creates a -conflict. - -One option is to simply throw an error, per the principles of -Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType. This is what would happen -if we were generalising over a normal type signature. On the other hand, the -types in a rewrite rule aren't quite "normal", since the notions of specified -and inferred type variables aren't applicable. - -A more permissive design (and the design that GHC uses) is to simply requantify -all of the type variables. That is, we would end up with this: - - forall k (a :: k) (b :: k). forall (x :: Proxy (a :: k)). foo @k @a @b x = Proxy @k @b - -It's a bit strange putting the generalized variable `b` after the user-written -variables `k` and `a`. But again, the notion of specificity is not relevant to -rewrite rules, since one cannot "visibly apply" a rewrite rule. This design not -only makes "foo" typecheck, but it also makes the implementation simpler. - -See also Note [Generalising in tcTyFamInstEqnGuts] in GHC.Tc.TyCl, which -explains a very similar design when generalising over a type family instance -equation. --} - -tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTc] -tcRules decls = mapM (wrapLocMA tcRuleDecls) decls - -tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTc) -tcRuleDecls (HsRules { rds_ext = src - , rds_rules = decls }) - = do { maybe_tc_decls <- mapM (wrapLocMA tcRule) decls - ; let tc_decls = [L loc rule | (L loc (Just rule)) <- maybe_tc_decls] - ; return $ HsRules { rds_ext = src - , rds_rules = tc_decls } } - - -tcRule :: RuleDecl GhcRn -> TcM (Maybe (RuleDecl GhcTc)) -tcRule (HsRule { rd_ext = ext - , rd_name = rname@(L _ name) - , rd_act = act - , rd_tyvs = ty_bndrs - , rd_tmvs = tm_bndrs - , rd_lhs = lhs - , rd_rhs = rhs }) - = addErrCtxt (ruleCtxt name) $ - do { traceTc "---- Rule ------" (pprFullRuleName (snd ext) rname) - ; skol_info <- mkSkolemInfo (RuleSkol name) - -- Note [Typechecking rules] - ; (tc_lvl, stuff) <- pushTcLevelM $ - generateRuleConstraints name ty_bndrs tm_bndrs lhs rhs - - ; let (id_bndrs, lhs', lhs_wanted - , rhs', rhs_wanted, rule_ty) = stuff - - ; traceTc "tcRule 1" (vcat [ pprFullRuleName (snd ext) rname - , ppr lhs_wanted - , ppr rhs_wanted ]) - - ; (lhs_evs, residual_lhs_wanted, dont_default) - <- simplifyRule name tc_lvl lhs_wanted rhs_wanted - - -- SimplifyRule Plan, step 4 - -- Now figure out what to quantify over - -- c.f. GHC.Tc.Solver.simplifyInfer - -- We quantify over any tyvars free in *either* the rule - -- *or* the bound variables. The latter is important. Consider - -- ss (x,(y,z)) = (x,z) - -- RULE: forall v. fst (ss v) = fst v - -- The type of the rhs of the rule is just a, but v::(a,(b,c)) - -- - -- We also need to get the completely-unconstrained tyvars of - -- the LHS, lest they otherwise get defaulted to Any; but we do that - -- during zonking (see GHC.Tc.Zonk.Type.zonkRule) - - ; let tpl_ids = lhs_evs ++ id_bndrs - - -- See Note [Re-quantify type variables in rules] - ; forall_tkvs <- candidateQTyVarsOfTypes (rule_ty : map idType tpl_ids) - ; let weed_out = (`dVarSetMinusVarSet` dont_default) - quant_cands = forall_tkvs { dv_kvs = weed_out (dv_kvs forall_tkvs) - , dv_tvs = weed_out (dv_tvs forall_tkvs) } - ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars quant_cands - ; traceTc "tcRule" (vcat [ pprFullRuleName (snd ext) rname - , text "forall_tkvs:" <+> ppr forall_tkvs - , text "quant_cands:" <+> ppr quant_cands - , text "dont_default:" <+> ppr dont_default - , text "residual_lhs_wanted:" <+> ppr residual_lhs_wanted - , text "qtkvs:" <+> ppr qtkvs - , text "rule_ty:" <+> ppr rule_ty - , text "ty_bndrs:" <+> ppr ty_bndrs - , text "qtkvs ++ tpl_ids:" <+> ppr (qtkvs ++ tpl_ids) - , text "tpl_id info:" <+> - vcat [ ppr id <+> dcolon <+> ppr (idType id) | id <- tpl_ids ] - ]) - - -- SimplfyRule Plan, step 5 - -- Simplify the LHS and RHS constraints: - -- For the LHS constraints we must solve the remaining constraints - -- (a) so that we report insoluble ones - -- (b) so that we bind any soluble ones - ; (lhs_implic, lhs_binds) <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) qtkvs - lhs_evs residual_lhs_wanted - ; (rhs_implic, rhs_binds) <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) qtkvs - lhs_evs rhs_wanted - ; emitImplications (lhs_implic `unionBags` rhs_implic) - - -- A type error on the LHS of a rule will be reported earlier while solving for - -- lhs_implic. However, we should also drop the rule entirely for cases where - -- compilation continues regardless of the error. For example with - -- `-fdefer-type-errors`, where this ill-typed LHS rule may cause follow-on errors - -- (#24026). - ; if anyBag insolubleImplic lhs_implic - then - return Nothing -- The RULE LHS does not type-check and will be dropped. - else - return . Just $ HsRule { rd_ext = ext - , rd_name = rname - , rd_act = act - , rd_tyvs = ty_bndrs -- preserved for ppr-ing - , rd_tmvs = map (noLocA . RuleBndr noAnn . noLocA) - (qtkvs ++ tpl_ids) - , rd_lhs = mkHsDictLet lhs_binds lhs' - , rd_rhs = mkHsDictLet rhs_binds rhs' } } - -generateRuleConstraints :: FastString - -> Maybe [LHsTyVarBndr () GhcRn] -> [LRuleBndr GhcRn] - -> LHsExpr GhcRn -> LHsExpr GhcRn - -> TcM ( [TcId] - , LHsExpr GhcTc, WantedConstraints - , LHsExpr GhcTc, WantedConstraints - , TcType ) -generateRuleConstraints rule_name ty_bndrs tm_bndrs lhs rhs - = do { ((tv_bndrs, id_bndrs), bndr_wanted) <- captureConstraints $ - tcRuleBndrs rule_name ty_bndrs tm_bndrs - -- bndr_wanted constraints can include wildcard hole - -- constraints, which we should not forget about. - -- It may mention the skolem type variables bound by - -- the RULE. c.f. #10072 - ; tcExtendNameTyVarEnv [(tyVarName tv, tv) | tv <- tv_bndrs] $ - tcExtendIdEnv id_bndrs $ - do { -- See Note [Solve order for RULES] - ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs) - ; (rhs', rhs_wanted) <- captureConstraints $ - tcCheckMonoExpr rhs rule_ty - ; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted - ; return (id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty) } } - --- See Note [TcLevel in type checking rules] -tcRuleBndrs :: FastString -> Maybe [LHsTyVarBndr () GhcRn] -> [LRuleBndr GhcRn] - -> TcM ([TcTyVar], [Id]) -tcRuleBndrs rule_name (Just bndrs) xs - = do { skol_info <- mkSkolemInfo (RuleSkol rule_name) - ; (tybndrs1,(tys2,tms)) <- bindExplicitTKBndrs_Skol skol_info bndrs $ - tcRuleTmBndrs rule_name xs - ; let tys1 = binderVars tybndrs1 - ; return (tys1 ++ tys2, tms) } - -tcRuleBndrs rule_name Nothing xs - = tcRuleTmBndrs rule_name xs - --- See Note [TcLevel in type checking rules] -tcRuleTmBndrs :: FastString -> [LRuleBndr GhcRn] -> TcM ([TcTyVar],[Id]) -tcRuleTmBndrs _ [] = return ([],[]) -tcRuleTmBndrs rule_name (L _ (RuleBndr _ (L _ name)) : rule_bndrs) - = do { ty <- newOpenFlexiTyVarTy - ; (tyvars, tmvars) <- tcRuleTmBndrs rule_name rule_bndrs - ; return (tyvars, mkLocalId name ManyTy ty : tmvars) } -tcRuleTmBndrs rule_name (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs) --- e.g x :: a->a --- The tyvar 'a' is brought into scope first, just as if you'd written --- a::*, x :: a->a --- If there's an explicit forall, the renamer would have already reported an --- error for each out-of-scope type variable used - = do { let ctxt = RuleSigCtxt rule_name name - ; (_ , tvs, id_ty) <- tcHsPatSigType ctxt HM_Sig rn_ty OpenKind - ; let id = mkLocalId name ManyTy id_ty - -- See Note [Typechecking pattern signature binders] in GHC.Tc.Gen.HsType - - -- The type variables scope over subsequent bindings; yuk - ; (tyvars, tmvars) <- tcExtendNameTyVarEnv tvs $ - tcRuleTmBndrs rule_name rule_bndrs - ; return (map snd tvs ++ tyvars, id : tmvars) } - -ruleCtxt :: FastString -> SDoc -ruleCtxt name = text "When checking the rewrite rule" <+> - doubleQuotes (ftext name) - - -{- -********************************************************************************* -* * - Constraint simplification for rules -* * -*********************************************************************************** - -Note [The SimplifyRule Plan] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Example. Consider the following left-hand side of a rule - f (x == y) (y > z) = ... -If we typecheck this expression we get constraints - d1 :: Ord a, d2 :: Eq a -We do NOT want to "simplify" to the LHS - forall x::a, y::a, z::a, d1::Ord a. - f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ... -Instead we want - forall x::a, y::a, z::a, d1::Ord a, d2::Eq a. - f ((==) d2 x y) ((>) d1 y z) = ... - -Here is another example: - fromIntegral :: (Integral a, Num b) => a -> b - {-# RULES "foo" fromIntegral = id :: Int -> Int #-} -In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But -we *dont* want to get - forall dIntegralInt. - fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int -because the scsel will mess up RULE matching. Instead we want - forall dIntegralInt, dNumInt. - fromIntegral Int Int dIntegralInt dNumInt = id Int - -Even if we have - g (x == y) (y == z) = .. -where the two dictionaries are *identical*, we do NOT WANT - forall x::a, y::a, z::a, d1::Eq a - f ((==) d1 x y) ((>) d1 y z) = ... -because that will only match if the dict args are (visibly) equal. -Instead we want to quantify over the dictionaries separately. - -In short, simplifyRuleLhs must *only* squash equalities, leaving -all dicts unchanged, with absolutely no sharing. - -Also note that we can't solve the LHS constraints in isolation: -Example foo :: Ord a => a -> a - foo_spec :: Int -> Int - {-# RULE "foo" foo = foo_spec #-} -Here, it's the RHS that fixes the type variable - -HOWEVER, under a nested implication things are different -Consider - f :: (forall a. Eq a => a->a) -> Bool -> ... - {-# RULES "foo" forall (v::forall b. Eq b => b->b). - f b True = ... - #-} -Here we *must* solve the wanted (Eq a) from the given (Eq a) -resulting from skolemising the argument type of g. So we -revert to SimplCheck when going under an implication. - - ---------- So the SimplifyRule Plan is this ----------------------- - -* Step 0: typecheck the LHS and RHS to get constraints from each - -* Step 1: Simplify the LHS and RHS constraints all together in one bag, - but /discarding/ the simplified constraints. We do this only - to discover all unification equalities. - -* Step 2: Zonk the ORIGINAL (unsimplified) LHS constraints, to take - advantage of those unifications - -* Setp 3: Partition the LHS constraints into the ones we will - quantify over, and the others. - See Note [RULE quantification over equalities] - -* Step 4: Decide on the type variables to quantify over - -* Step 5: Simplify the LHS and RHS constraints separately, using the - quantified constraints as givens - -Note [Solve order for RULES] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In step 1 above, we need to be a bit careful about solve order. -Consider - f :: Int -> T Int - type instance T Int = Bool - - RULE f 3 = True - -From the RULE we get - lhs-constraints: T Int ~ alpha - rhs-constraints: Bool ~ alpha -where 'alpha' is the type that connects the two. If we glom them -all together, and solve the RHS constraint first, we might solve -with alpha := Bool. But then we'd end up with a RULE like - - RULE: f 3 |> (co :: T Int ~ Bool) = True - -which is terrible. We want - - RULE: f 3 = True |> (sym co :: Bool ~ T Int) - -So we are careful to solve the LHS constraints first, and *then* the -RHS constraints. Actually much of this is done by the on-the-fly -constraint solving, so the same order must be observed in -tcRule. - - -Note [RULE quantification over equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Deciding which equalities to quantify over is tricky: - * We do not want to quantify over insoluble equalities (Int ~ Bool) - (a) because we prefer to report a LHS type error - (b) because if such things end up in 'givens' we get a bogus - "inaccessible code" error - - * But we do want to quantify over things like (a ~ F b), where - F is a type function. - -The difficulty is that it's hard to tell what is insoluble! -So we see whether the simplification step yielded any type errors, -and if so refrain from quantifying over *any* equalities. - -Note [Quantifying over coercion holes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Equality constraints from the LHS will emit coercion hole Wanteds. -These don't have a name, so we can't quantify over them directly. -Instead, because we really do want to quantify here, invent a new -EvVar for the coercion, fill the hole with the invented EvVar, and -then quantify over the EvVar. Not too tricky -- just some -impedance matching, really. - -Note [Simplify cloned constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At this stage, we're simplifying constraints only for insolubility -and for unification. Note that all the evidence is quickly discarded. -We use a clone of the real constraint. If we don't do this, -then RHS coercion-hole constraints get filled in, only to get filled -in *again* when solving the implications emitted from tcRule. That's -terrible, so we avoid the problem by cloning the constraints. - --} - -simplifyRule :: RuleName - -> TcLevel -- Level at which to solve the constraints - -> WantedConstraints -- Constraints from LHS - -> WantedConstraints -- Constraints from RHS - -> TcM ( [EvVar] -- Quantify over these LHS vars - , WantedConstraints -- Residual un-quantified LHS constraints - , TcTyVarSet ) -- Don't default these --- See Note [The SimplifyRule Plan] --- NB: This consumes all simple constraints on the LHS, but not --- any LHS implication constraints. -simplifyRule name tc_lvl lhs_wanted rhs_wanted - = do { - -- Note [The SimplifyRule Plan] step 1 - -- First solve the LHS and *then* solve the RHS - -- Crucially, this performs unifications - -- Why clone? See Note [Simplify cloned constraints] - ; lhs_clone <- cloneWC lhs_wanted - ; rhs_clone <- cloneWC rhs_wanted - ; (dont_default, _) - <- setTcLevel tc_lvl $ - runTcS $ - do { lhs_wc <- solveWanteds lhs_clone - ; _rhs_wc <- solveWanteds rhs_clone - -- Why do them separately? - -- See Note [Solve order for RULES] - - ; let dont_default = nonDefaultableTyVarsOfWC lhs_wc - -- If lhs_wanteds has - -- (a[sk] :: TYPE rr[sk]) ~ (b0[tau] :: TYPE r0[conc]) - -- we want r0 to be non-defaultable; - -- see nonDefaultableTyVarsOfWC. Simplest way to get - -- this is to look at the post-simplified lhs_wc, which - -- will contain (rr[sk] ~ r0[conc)]. An example is in - -- test rep-poly/RepPolyRule1 - ; return dont_default } - - -- Note [The SimplifyRule Plan] step 2 - ; lhs_wanted <- liftZonkM $ zonkWC lhs_wanted - ; let (quant_cts, residual_lhs_wanted) = getRuleQuantCts lhs_wanted - - -- Note [The SimplifyRule Plan] step 3 - ; quant_evs <- mapM mk_quant_ev (bagToList quant_cts) - - ; traceTc "simplifyRule" $ - vcat [ text "LHS of rule" <+> doubleQuotes (ftext name) - , text "lhs_wanted" <+> ppr lhs_wanted - , text "rhs_wanted" <+> ppr rhs_wanted - , text "quant_cts" <+> ppr quant_cts - , text "residual_lhs_wanted" <+> ppr residual_lhs_wanted - , text "dont_default" <+> ppr dont_default - ] - - ; return (quant_evs, residual_lhs_wanted, dont_default) } - - where - mk_quant_ev :: Ct -> TcM EvVar - mk_quant_ev ct - | CtWanted { ctev_dest = dest, ctev_pred = pred } <- ctEvidence ct - = case dest of - EvVarDest ev_id -> return ev_id - HoleDest hole -> -- See Note [Quantifying over coercion holes] - do { ev_id <- newEvVar pred - ; fillCoercionHole hole (mkCoVarCo ev_id) - ; return ev_id } - mk_quant_ev ct = pprPanic "mk_quant_ev" (ppr ct) - - -getRuleQuantCts :: WantedConstraints -> (Cts, WantedConstraints) --- Extract all the constraints we can quantify over, --- also returning the depleted WantedConstraints --- --- NB: we must look inside implications, because with --- -fdefer-type-errors we generate implications rather eagerly; --- see GHC.Tc.Utils.Unify.implicationNeeded. Not doing so caused #14732. --- --- Unlike simplifyInfer, we don't leave the WantedConstraints unchanged, --- and attempt to solve them from the quantified constraints. That --- nearly works, but fails for a constraint like (d :: Eq Int). --- We /do/ want to quantify over it, but the short-cut solver --- (see GHC.Tc.Solver.Dict Note [Shortcut solving]) ignores the quantified --- and instead solves from the top level. --- --- So we must partition the WantedConstraints ourselves --- Not hard, but tiresome. - -getRuleQuantCts wc - = float_wc emptyVarSet wc - where - float_wc :: TcTyCoVarSet -> WantedConstraints -> (Cts, WantedConstraints) - float_wc skol_tvs (WC { wc_simple = simples, wc_impl = implics, wc_errors = errs }) - = ( simple_yes `andCts` implic_yes - , emptyWC { wc_simple = simple_no, wc_impl = implics_no, wc_errors = errs }) - where - (simple_yes, simple_no) = partitionBag (rule_quant_ct skol_tvs) simples - (implic_yes, implics_no) = mapAccumBagL (float_implic skol_tvs) - emptyBag implics - - float_implic :: TcTyCoVarSet -> Cts -> Implication -> (Cts, Implication) - float_implic skol_tvs yes1 imp - = (yes1 `andCts` yes2, imp { ic_wanted = no }) - where - (yes2, no) = float_wc new_skol_tvs (ic_wanted imp) - new_skol_tvs = skol_tvs `extendVarSetList` ic_skols imp - - rule_quant_ct :: TcTyCoVarSet -> Ct -> Bool - rule_quant_ct skol_tvs ct = case classifyPredType (ctPred ct) of - EqPred _ t1 t2 - | not (ok_eq t1 t2) - -> False -- Note [RULE quantification over equalities] - _ -> tyCoVarsOfCt ct `disjointVarSet` skol_tvs - - ok_eq t1 t2 - | t1 `tcEqType` t2 = False - | otherwise = is_fun_app t1 || is_fun_app t2 - - is_fun_app ty -- ty is of form (F tys) where F is a type function - = case tyConAppTyCon_maybe ty of - Just tc -> isTypeFamilyTyCon tc - Nothing -> False diff --git a/GHC/Tc/Gen/Sig.hs b/GHC/Tc/Gen/Sig.hs --- a/GHC/Tc/Gen/Sig.hs +++ b/GHC/Tc/Gen/Sig.hs @@ -19,7 +19,9 @@ TcPragEnv, emptyPragEnv, lookupPragEnv, extendPragEnv, mkPragEnv, tcSpecPrags, tcSpecWrapper, tcImpPrags, - addInlinePrags, addInlinePragArity + addInlinePrags, addInlinePragArity, + + tcRules ) where import GHC.Prelude @@ -30,29 +32,40 @@ import GHC.Hs +import {-# SOURCE #-} GHC.Tc.Gen.Expr ( tcInferRho, tcCheckMonoExpr ) -import GHC.Tc.Errors.Types ( FixedRuntimeRepProvenance(..), TcRnMessage(..) ) +import GHC.Tc.Errors.Types import GHC.Tc.Gen.HsType -import GHC.Tc.Types -import GHC.Tc.Solver( pushLevelAndSolveEqualitiesX, reportUnsolvedEqualities ) +import GHC.Tc.Solver( reportUnsolvedEqualities, pushLevelAndSolveEqualitiesX + , emitResidualConstraints ) +import GHC.Tc.Solver.Solve( solveWanteds ) +import GHC.Tc.Solver.Monad( runTcS, setTcSMode, TcSMode(..), vanillaTcSMode, runTcSWithEvBinds ) +import GHC.Tc.Validity ( checkValidType ) + import GHC.Tc.Utils.Monad -import GHC.Tc.Utils.TcMType ( checkTypeHasFixedRuntimeRep, newOpenTypeKind ) -import GHC.Tc.Zonk.Type -import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType -import GHC.Tc.Validity ( checkValidType ) -import GHC.Tc.Utils.Unify( DeepSubsumptionFlag(..), tcSkolemise, unifyType ) +import GHC.Tc.Utils.TcMType +import GHC.Tc.Utils.Unify( DeepSubsumptionFlag(..), tcSkolemise, unifyType, buildImplicationFor ) import GHC.Tc.Utils.Instantiate( topInstantiate, tcInstTypeBndrs ) -import GHC.Tc.Utils.Env( tcLookupId ) -import GHC.Tc.Types.Evidence( HsWrapper, (<.>) ) +import GHC.Tc.Utils.Env +import GHC.Tc.Types.Origin +import GHC.Tc.Types.Evidence +import GHC.Tc.Types.Constraint + +import GHC.Tc.Zonk.TcType +import GHC.Tc.Zonk.Type + import GHC.Core( hasSomeUnfolding ) -import GHC.Core.Type ( mkTyVarBinders ) +import GHC.Core.Type import GHC.Core.Multiplicity +import GHC.Core.Predicate import GHC.Core.TyCo.Rep( mkNakedFunTy ) +import GHC.Core.TyCon( isTypeFamilyTyCon ) -import GHC.Types.Var ( TyVar, Specificity(..), tyVarKind, binderVars, invisArgTypeLike ) -import GHC.Types.Id ( Id, idName, idType, setInlinePragma +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Id ( idName, idType, setInlinePragma , mkLocalId, realIdUnfolding ) import GHC.Types.Basic import GHC.Types.Name @@ -60,18 +73,19 @@ import GHC.Types.SrcLoc import GHC.Builtin.Names( mkUnboundName ) -import GHC.Unit.Module( getModule ) +import GHC.Unit.Module( Module, getModule ) import GHC.Utils.Misc as Utils ( singleton ) import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Data.Bag import GHC.Data.Maybe( orElse, whenIsJust ) -import Data.Maybe( mapMaybe ) -import qualified Data.List.NonEmpty as NE import Control.Monad( unless ) - +import Data.Foldable ( toList ) +import qualified Data.List.NonEmpty as NE +import Data.Maybe( mapMaybe ) {- ------------------------------------------------------------- Note [Overview of type signatures] @@ -273,7 +287,7 @@ HsWildCardTy _ -> False HsAppTy _ ty1 ty2 -> go ty1 && go ty2 HsAppKindTy _ ty ki -> go ty && go ki - HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && go (arrowToHsType w) + HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && all go (multAnnToHsType w) HsListTy _ ty -> go ty HsTupleTy _ _ tys -> gos tys HsSumTy _ tys -> gos tys @@ -282,8 +296,6 @@ HsIParamTy _ _ ty -> go ty HsKindSig _ ty kind -> go ty && go kind HsDocTy _ ty _ -> go ty - HsBangTy _ _ ty -> go ty - HsRecTy _ flds -> gos $ map (cd_fld_type . unLoc) flds HsExplicitListTy _ _ tys -> gos tys HsExplicitTupleTy _ _ tys -> gos tys HsForAllTy { hst_tele = tele @@ -567,8 +579,9 @@ prs = mapMaybe get_sig sigs get_sig :: LSig GhcRn -> Maybe (Name, LSig GhcRn) - get_sig sig@(L _ (SpecSig _ (L _ nm) _ _)) = Just (nm, add_arity nm sig) - get_sig sig@(L _ (InlineSig _ (L _ nm) _)) = Just (nm, add_arity nm sig) + get_sig sig@(L _ (SpecSig _ (L _ nm) _ _)) = Just (nm, add_arity nm sig) + get_sig sig@(L _ (SpecSigE nm _ _ _)) = Just (nm, add_arity nm sig) + get_sig sig@(L _ (InlineSig _ (L _ nm) _)) = Just (nm, add_arity nm sig) get_sig sig@(L _ (SCCFunSig _ (L _ nm) _)) = Just (nm, sig) get_sig _ = Nothing @@ -584,6 +597,7 @@ addInlinePragArity :: Arity -> LSig GhcRn -> LSig GhcRn addInlinePragArity ar (L l (InlineSig x nm inl)) = L l (InlineSig x nm (add_inl_arity ar inl)) addInlinePragArity ar (L l (SpecSig x nm ty inl)) = L l (SpecSig x nm ty (add_inl_arity ar inl)) +addInlinePragArity ar (L l (SpecSigE n x e inl)) = L l (SpecSigE n x e (add_inl_arity ar inl)) addInlinePragArity _ sig = sig add_inl_arity :: Arity -> InlinePragma -> InlinePragma @@ -650,13 +664,163 @@ * * ************************************************************************ -Note [Handling SPECIALISE pragmas] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Overview of SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The basic idea is this: foo :: Num a => a -> b -> a - {-# SPECIALISE foo :: Int -> b -> Int #-} + foo = rhs + {-# SPECIALISE foo :: Int -> b -> Int #-} -- Old form + {-# SPECIALISE foo @Float #-} -- New form +Generally: +* Rename as usual +* Typecheck, attaching info to the ABExport record of the AbsBinds for foo +* Desugar by generating + - a specialised binding $sfoo = rhs @Float + - a rewrite rule like RULE "USPEC foo" foo @Float = $sfoo + +There are two major routes: + +* Old form + - Handled by `SpecSig` and `SpecPrag` + - Deals with SPECIALISE pragmas have multiple signatures + {-# SPECIALISE f :: Int -> Int, Float -> Float #-} + - See Note [Handling old-form SPECIALISE pragmas] + - Deprecated, to be removed in GHC 9.18 as per #25540. + +* New form, described in GHC Proposal #493 + - Handled by `SpecSigE` and `SpecPragE` + - Deals with SPECIALISE pragmas which may have value arguments + {-# SPECIALISE f @Int 3 #-} + - See Note [Handling new-form SPECIALISE pragmas] + +Note [Handling new-form SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +New-form SPECIALISE pragmas are described by GHC Proposal #493. + +The pragma takes the form of a function application, possibly with intervening +parens and type signatures, with a variable at the head: + + {-# SPECIALISE f1 @Int 3 #-} + {-# SPECIALISE f2 :: Int -> Int #-} + {-# SPECIALISE (f3 :: Int -> Int) 5 #-} + +It may also have rule for-alls at the top, e.g. + + {-# SPECIALISE forall x xs. f4 (x:xs) #-} + {-# SPECIALISE forall a. forall x xs. f5 @a @a (x:xs) #-} + +See `GHC.Rename.Bind.checkSpecESigShape` for the shape-check. + +Example: + f :: forall a b. (Eq a, Eq b, Eq c) => a -> b -> c -> Bool -> blah + {-# SPECIALISE forall x y. f (x::Int) y y True #-} + -- y::p + +We want to generate: + + RULE forall @p (d1::Eq Int) (d2::Eq p) (d3::Eq p) (x::Int) (y::p). + f @Int @p @p d1 d2 d3 x y y True + = $sf @p d2 x y + $sf @p (d2::Eq p) (x::Int) (y::p) + = let d1 = $fEqInt + d3 = d2 + in @p @p @Int (d1::Eq p) (d2::Eq p) (d3::Eq p) x y y True + +Note that + +* The `rule_bndrs`, over which the RULE is quantified, are all the variables + free in the call to `f`, /ignoring/ all dictionary simplification. Why? + Because we want to make the rule maximally applicable; provided the types + match, the dictionaries should match. + + rule_bndrs = @p (d1::Eq Int) (d2::Eq p) (d3::Eq p) (x::Int) (y::p). + + Note that we have separate binders for `d1` and `d2` even though they are + the same (Eq p) dictionary. Reason: we don't want to force them to be visibly + equal at the call site. + +* The `spec_bndrs`, which are lambda-bound in the specialised function `$sf`, + are a subset of `rule_bndrs`. + + spec_bndrs = @p (d2::Eq p) (x::Int) (y::p) + +* The `spec_const_binds` make up the difference between `rule_bndrs` and + `spec_bndrs`. They communicate the specialisation! + If `spec_bndrs` = `rule_bndrs`, no specialisation has happened. + + spec_const_binds = let d1 = $fEqInt + d3 = d2 + +This is done in three parts. + + A. Typechecker: `GHC.Tc.Gen.Sig.tcSpecPrag` + + (1) Typecheck the expression, capturing its constraints + + (2) Solve these constraints. When doing so, switch on `tcsmFullySolveQCIs`; + see wrinkle (NFS1) below. + + (3) Compute the constraints to quantify over, using `getRuleQuantCts` on + the unsolved constraints returned by (2). + + (4) Emit the residual (non-solved, non-quantified) constraints, and wrap the + expression in a let binding for those constraints. + + (5) Wrap the call in the combined evidence bindings from steps (2) and (4) + + (6) Store all the information in a 'SpecPragE' record, to be consumed + by the desugarer. + + B. Zonker: `GHC.Tc.Zonk.Type.zonkLTcSpecPrags` + + The zonker does a little extra work to collect any free type variables + of the LHS. See Note [Free tyvars on rule LHS] in GHC.Tc.Zonk.Type. + These weren't conveniently available earlier. + + C. Desugarer: `GHC.HsToCore.Binds.dsSpec`. + + See Note [Desugaring new-form SPECIALISE pragmas] in GHC.HsToCore.Binds for details, + but in brief: + + (1) Simplify the expression. This is important because a type signature in + the expression will have led to type/dictionary abstractions/applications. + After simplification it should look like + let in f d1 d2 d3 + + (2) `prepareSpecLHS` identifies the `spec_const_binds`, discards the other + dictionary bindings, and decomposes the call. + + (3) Then we build the specialised function $sf, and concoct a RULE + of the form: + forall @a @b d1 d2 d3. f d1 d2 d3 = $sf d1 d2 d3 + +(NFS1) Consider + f :: forall f a. (Ix a, forall x. Eq x => Eq (f x)) => a -> f a + {-# SPECIALISE f :: forall f. (forall x. Eq x => Eq (f x)) => Int -> f Int #-} + This SPECIALISE is treated like an expression with a type signature, so + we instantiate the constraints, simplify them and re-generalise. From the + instantiation we get [W] d :: (forall x. Eq a => Eq (f x)) + and we want to generalise over that. We do not want to attempt to solve it + and then get stuck, and emit an error message. If we can't solve it, it is + much, much better to leave it alone. + + We still need to simplify quantified constraints that can be /fully solved/ + from instances, otherwise we would never be able to specialise them + away. Example: {-# SPECIALISE f @[] @a #-}. So: + + * The constraint solver has a mode flag `tcsmFullySolveQCIs` that says + "fully solve quantified constraint, or leave them alone + * When simplifying constraints in a SPECIALISE pragma, we switch on this + flag the `SpecPragE` case of `tcSpecPrag`. + + You might worry about the wasted work from failed attempts to fully-solve, but + it is seldom repeated (because the constraint solver seldom iterates much). + +Note [Handling old-form SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +NB: this code path is deprecated, and is scheduled to be removed in GHC 9.18, as per #25440. We check that (forall a b. Num a => a -> b -> a) is more polymorphic than @@ -679,17 +843,22 @@ SpecPrag (wrap_fn :: forall a b. (Eq a, Ix b) => XXX -> forall p q. (Ix p, Ix q) => XXX[ Int/a, (p,q)/b ]) + wrap_fn = /\ p q \(d1::Ix p)(d2:Ix q). + let w1 = $fEqInt + w2 = $fIxPair d1 d2 + HOLE @Int @(p,q) (w1:Eq Int) (w2:Ix (p,q)) + From these we generate: - Rule: forall p, q, (dp:Ix p), (dq:Ix q). - f Int (p,q) dInt ($dfInPair dp dq) = f_spec p q dp dq + Rule: forall p, q, (dInt::Eq Int), (dp:Ix p), (dq:Ix q). + f Int (p,q) dInt ($fIxPair dp dq) = f_spec p q dp dq - Spec bind: f_spec = wrap_fn + Spec bind: f_spec = wrap_fn[ ] Note that * The LHS of the rule may mention dictionary *expressions* (eg - $dfIxPair dp dq), and that is essential because the dp, dq are + $fIxPair dp dq), and that is essential because the dp, dq are needed on the RHS. * The RHS of f_spec, has a *copy* of 'binds', so that it @@ -749,6 +918,27 @@ regardless of XXX. It's sort of polymorphic in XXX. This is useful: we use the same wrapper to transform each of the class ops, as well as the dict. That's what goes on in GHC.Tc.TyCl.Instance.mk_meth_spec_prags + +Note [SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~ +There is no point in a SPECIALISE pragma for a non-overloaded function: + reverse :: [a] -> [a] + {-# SPECIALISE reverse :: [Int] -> [Int] #-} + +But SPECIALISE INLINE *can* make sense for GADTS: + data Arr e where + ArrInt :: !Int -> ByteArray# -> Arr Int + ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2) + + (!:) :: Arr e -> Int -> e + {-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-} + {-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-} + (ArrInt _ ba) !: (I# i) = I# (indexIntArray# ba i) + (ArrPair _ a1 a2) !: i = (a1 !: i, a2 !: i) + +When (!:) is specialised it becomes non-recursive, and can usefully +be inlined. Scary! So we only warn for SPECIALISE *without* INLINE +for a non-overloaded function. -} tcSpecPrags :: Id -> [LSig GhcRn] @@ -775,14 +965,14 @@ -------------- tcSpecPrag :: TcId -> Sig GhcRn -> TcM [TcSpecPrag] tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl) --- See Note [Handling SPECIALISE pragmas] +-- See Note [Handling old-form SPECIALISE pragmas] -- -- The Name fun_name in the SpecSig may not be the same as that of the poly_id -- Example: SPECIALISE for a class method: the Name in the SpecSig is -- for the selector Id, but the poly_id is something like $cop -- However we want to use fun_name in the error message, since that is -- what the user wrote (#8537) - = addErrCtxt (spec_ctxt prag) $ + = addErrCtxt (SpecPragmaCtxt prag) $ do { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) $ TcRnNonOverloadedSpecialisePragma fun_name -- Note [SPECIALISE pragmas] @@ -792,26 +982,88 @@ where name = idName poly_id poly_ty = idType poly_id - spec_ctxt prag = hang (text "In the pragma:") 2 (ppr prag) tc_one hs_ty = do { spec_ty <- tcHsSigType (FunSigCtxt name NoRRC) hs_ty ; wrap <- tcSpecWrapper (FunSigCtxt name (lhsSigTypeContextSpan hs_ty)) poly_ty spec_ty ; return (SpecPrag poly_id wrap inl) } +tcSpecPrag poly_id (SpecSigE nm rule_bndrs spec_e inl) + -- For running commentary, see Note [Handling new-form SPECIALISE pragmas] + = do { -- (1) Typecheck the expression, spec_e, capturing its constraints + let skol_info_anon = SpecESkol nm + ; traceTc "tcSpecPrag SpecSigE {" (ppr nm $$ ppr spec_e) + ; skol_info <- mkSkolemInfo skol_info_anon + ; (rhs_tclvl, spec_e_wanted, (rule_bndrs', (tc_spec_e, _rho))) + <- tcRuleBndrs skol_info rule_bndrs $ + tcInferRho spec_e + + -- (2) Solve the resulting wanteds + ; ev_binds_var <- newTcEvBinds + ; spec_e_wanted <- setTcLevel rhs_tclvl $ + runTcSWithEvBinds ev_binds_var $ + setTcSMode (vanillaTcSMode { tcsmFullySolveQCIs = True }) $ + -- tcsmFullySolveQCIs: see (NFS1) + solveWanteds spec_e_wanted + ; spec_e_wanted <- liftZonkM $ zonkWC spec_e_wanted + + -- (3) Compute which constraints to quantify over, by looking + -- at the unsolved constraints from (2) + ; (quant_cands, residual_wc) <- getRuleQuantCts spec_e_wanted + + -- (4) Emit the residual constraints (i.e. ones that we have + -- not solved in (2) nor quantified in (3) + -- NB: use the same `ev_binds_var` as (2), so the bindings + -- for (2) and (4) are combined + ; let tv_bndrs = filter isTyVar rule_bndrs' + qevs = map ctEvId (bagToList quant_cands) + ; emitResidualConstraints rhs_tclvl skol_info_anon ev_binds_var + emptyVarSet tv_bndrs qevs + residual_wc + + -- (5) Wrap the call in the combined evidence bindings + -- from steps (2) and (4) + ; let lhs_call = mkLHsWrap (WpLet (TcEvBinds ev_binds_var)) tc_spec_e + + ; ev_binds <- getTcEvBindsMap ev_binds_var + + ; traceTc "tcSpecPrag SpecSigE }" $ + vcat [ text "nm:" <+> ppr nm + , text "rule_bndrs':" <+> ppr rule_bndrs' + , text "qevs:" <+> ppr qevs + , text "spec_e:" <+> ppr tc_spec_e + , text "inl:" <+> ppr inl + , text "spec_e_wanted:" <+> ppr spec_e_wanted + , text "quant_cands:" <+> ppr quant_cands + , text "residual_wc:" <+> ppr residual_wc + , text (replicate 80 '-') + , text "ev_binds_var:" <+> ppr ev_binds_var + , text "ev_binds:" <+> ppr ev_binds + ] + + -- (6) Store the results in a SpecPragE record, which will be + -- zonked and then consumed by the desugarer. + + ; return [SpecPragE { spe_fn_nm = nm + , spe_fn_id = poly_id + , spe_bndrs = qevs ++ rule_bndrs' -- Dependency order + -- does not matter + , spe_call = lhs_call + , spe_inl = inl }] } + tcSpecPrag _ prag = pprPanic "tcSpecPrag" (ppr prag) -------------- tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper -- A simpler variant of tcSubType, used for SPECIALISE pragmas --- See Note [Handling SPECIALISE pragmas], wrinkle 1 +-- See Note [Handling old-form SPECIALISE pragmas], wrinkle 1 tcSpecWrapper ctxt poly_ty spec_ty = do { (sk_wrap, inst_wrap) <- tcSkolemise Shallow ctxt spec_ty $ \spec_tau -> do { (inst_wrap, tau) <- topInstantiate orig poly_ty ; _ <- unifyType Nothing spec_tau tau -- Deliberately ignore the evidence - -- See Note [Handling SPECIALISE pragmas], + -- See Note [Handling old-form SPECIALISE pragmas], -- wrinkle (2) ; return inst_wrap } ; return (sk_wrap <.> inst_wrap) } @@ -822,15 +1074,13 @@ tcImpPrags :: [LSig GhcRn] -> TcM [LTcSpecPrag] -- SPECIALISE pragmas for imported things tcImpPrags prags - = do { this_mod <- getModule - ; dflags <- getDynFlags + = do { dflags <- getDynFlags + ; traceTc "tcImpPrags1" (ppr prags) ; if (not_specialising dflags) then return [] else do - { pss <- mapAndRecoverM (wrapLocMA tcImpSpec) - [L loc (name,prag) - | (L loc prag@(SpecSig _ (L _ name) _ _)) <- prags - , not (nameIsLocalOrFrom this_mod name) ] + { this_mod <- getModule + ; pss <- mapAndRecoverM (wrapLocMA (tcImpSpec this_mod)) prags ; return $ concatMap (\(L l ps) -> map (L (locA l)) ps) pss } } where -- Ignore SPECIALISE pragmas for imported things @@ -840,8 +1090,10 @@ not_specialising dflags = not (gopt Opt_Specialise dflags) || not (backendRespectsSpecialise (backend dflags)) -tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag] -tcImpSpec (name, prag) +tcImpSpec :: Module -> Sig GhcRn -> TcM [TcSpecPrag] +tcImpSpec this_mod prag + | Just name <- is_spec_prag prag -- It's a specialisation pragma + , not (nameIsLocalOrFrom this_mod name) -- The Id is imported = do { id <- tcLookupId name ; if hasSomeUnfolding (realIdUnfolding id) -- See Note [SPECIALISE pragmas for imported Ids] @@ -849,6 +1101,12 @@ else do { let dia = TcRnSpecialiseNotVisible name ; addDiagnosticTc dia ; return [] } } + | otherwise + = return [] + where + is_spec_prag (SpecSig _ (L _ nm) _ _) = Just nm + is_spec_prag (SpecSigE nm _ _ _) = Just nm + is_spec_prag _ = Nothing {- Note [SPECIALISE pragmas for imported Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -867,3 +1125,568 @@ error message suggesting an INLINABLE pragma, which you can follow. That seems enough for now. -} + + +{- ********************************************************************* +* * + Rules +* * +************************************************************************ + +Note [Typechecking rules] +~~~~~~~~~~~~~~~~~~~~~~~~~ +We *infer* the type of the LHS, and use that type to *check* the type of +the RHS. That means that higher-rank rules work reasonably well. Here's +an example (test simplCore/should_compile/rule2.hs) produced by Roman: + + foo :: (forall m. m a -> m b) -> m a -> m b + foo f = ... + + bar :: (forall m. m a -> m a) -> m a -> m a + bar f = ... + + {-# RULES "foo/bar" foo = bar #-} + +He wanted the rule to typecheck. + +Note [TcLevel in type checking rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Bringing type variables into scope naturally bumps the TcLevel. Thus, we type +check the term-level binders in a bumped level, and we must accordingly bump +the level whenever these binders are in scope. + +Note [Re-quantify type variables in rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this example from #17710: + + foo :: forall k (a :: k) (b :: k). Proxy a -> Proxy b + foo x = Proxy + {-# RULES "foo" forall (x :: Proxy (a :: k)). foo x = Proxy #-} + +Written out in more detail, the "foo" rewrite rule looks like this: + + forall k (a :: k). forall (x :: Proxy (a :: k)). foo @k @a @b0 x = Proxy @k @b0 + +Where b0 is a unification variable. Where should b0 be quantified? We have to +quantify it after k, since (b0 :: k). But generalization usually puts inferred +type variables (such as b0) at the /front/ of the telescope! This creates a +conflict. + +One option is to simply throw an error, per the principles of +Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType. This is what would happen +if we were generalising over a normal type signature. On the other hand, the +types in a rewrite rule aren't quite "normal", since the notions of specified +and inferred type variables aren't applicable. + +A more permissive design (and the design that GHC uses) is to simply requantify +all of the type variables. That is, we would end up with this: + + forall k (a :: k) (b :: k). forall (x :: Proxy (a :: k)). foo @k @a @b x = Proxy @k @b + +It's a bit strange putting the generalized variable `b` after the user-written +variables `k` and `a`. But again, the notion of specificity is not relevant to +rewrite rules, since one cannot "visibly apply" a rewrite rule. This design not +only makes "foo" typecheck, but it also makes the implementation simpler. + +See also Note [Generalising in tcTyFamInstEqnGuts] in GHC.Tc.TyCl, which +explains a very similar design when generalising over a type family instance +equation. +-} + +tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTc] +tcRules decls = mapM (wrapLocMA tcRuleDecls) decls + +tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTc) +tcRuleDecls (HsRules { rds_ext = src + , rds_rules = decls }) + = do { maybe_tc_decls <- mapM (wrapLocMA tcRule) decls + ; let tc_decls = [L loc rule | (L loc (Just rule)) <- maybe_tc_decls] + ; return $ HsRules { rds_ext = src + , rds_rules = tc_decls } } + +tcRule :: RuleDecl GhcRn -> TcM (Maybe (RuleDecl GhcTc)) +tcRule (HsRule { rd_ext = ext + , rd_name = rname@(L _ name) + , rd_act = act + , rd_bndrs = bndrs + , rd_lhs = lhs + , rd_rhs = rhs }) + = addErrCtxt (RuleCtxt name) $ + do { traceTc "---- Rule ------" (pprFullRuleName (snd ext) rname) + ; skol_info <- mkSkolemInfo (RuleSkol name) + -- Note [Typechecking rules] + ; (tc_lvl, lhs_wanted, stuff) + <- tcRuleBndrs skol_info bndrs $ + do { (lhs', rule_ty) <- tcInferRho lhs + ; (rhs', rhs_wanted) <- captureConstraints $ + tcCheckMonoExpr rhs rule_ty + ; return (lhs', rule_ty, rhs', rhs_wanted) } + + ; let (bndrs', (lhs', rule_ty, rhs', rhs_wanted)) = stuff + + ; traceTc "tcRule 1" (vcat [ pprFullRuleName (snd ext) rname + , ppr lhs_wanted + , ppr rhs_wanted ]) + + ; (lhs_evs, residual_lhs_wanted, dont_default) + <- simplifyRule name tc_lvl lhs_wanted rhs_wanted + + -- SimplifyRule Plan, step 4 + -- Now figure out what to quantify over + -- c.f. GHC.Tc.Solver.simplifyInfer + -- We quantify over any tyvars free in *either* the rule + -- *or* the bound variables. The latter is important. Consider + -- ss (x,(y,z)) = (x,z) + -- RULE: forall v. fst (ss v) = fst v + -- The type of the rhs of the rule is just a, but v::(a,(b,c)) + -- + -- We also need to get the completely-unconstrained tyvars of + -- the LHS, lest they otherwise get defaulted to Any; but we do that + -- during zonking (see GHC.Tc.Zonk.Type.zonkRule) + + ; let tpl_ids = lhs_evs ++ filter isId bndrs' + + -- See Note [Re-quantify type variables in rules] + ; dvs <- candidateQTyVarsOfTypes (rule_ty : map idType tpl_ids) + ; let weed_out = (`dVarSetMinusVarSet` dont_default) + weeded_dvs = weedOutCandidates weed_out dvs + ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars weeded_dvs + ; traceTc "tcRule" (vcat [ pprFullRuleName (snd ext) rname + , text "dvs:" <+> ppr dvs + , text "weeded_dvs:" <+> ppr weeded_dvs + , text "dont_default:" <+> ppr dont_default + , text "residual_lhs_wanted:" <+> ppr residual_lhs_wanted + , text "qtkvs:" <+> ppr qtkvs + , text "rule_ty:" <+> ppr rule_ty + , text "bndrs:" <+> ppr bndrs + , text "qtkvs ++ tpl_ids:" <+> ppr (qtkvs ++ tpl_ids) + , text "tpl_id info:" <+> + vcat [ ppr id <+> dcolon <+> ppr (idType id) | id <- tpl_ids ] + ]) + + -- /Temporarily/ deal with the fact that we previously accepted + -- rules that quantify over certain equality constraints. + -- + -- See Note [Quantifying over equalities in RULES]. + ; case allPreviouslyQuantifiableEqualities residual_lhs_wanted of { + Just cts | not (insolubleWC rhs_wanted) + -> do { addDiagnostic $ TcRnRuleLhsEqualities name lhs cts + ; return Nothing } ; + _ -> + + do { -- SimplifyRule Plan, step 5 + -- Simplify the LHS and RHS constraints: + -- For the LHS constraints we must solve the remaining constraints + -- (a) so that we report insoluble ones + -- (b) so that we bind any soluble ones + (lhs_implic, lhs_binds) <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) qtkvs + lhs_evs residual_lhs_wanted + ; (rhs_implic, rhs_binds) <- buildImplicationFor tc_lvl (getSkolemInfo skol_info) qtkvs + lhs_evs rhs_wanted + + ; emitImplications (lhs_implic `unionBags` rhs_implic) + + ; return $ Just $ + HsRule { rd_ext = ext + , rd_name = rname + , rd_act = act + , rd_bndrs = bndrs { rb_ext = qtkvs ++ tpl_ids } + , rd_lhs = mkHsDictLet lhs_binds lhs' + , rd_rhs = mkHsDictLet rhs_binds rhs' } } } } + +{- ******************************************************************************** +* * + tcRuleBndrs +* * +******************************************************************************** -} + +tcRuleBndrs :: SkolemInfo -> RuleBndrs GhcRn + -> TcM a -- Typecheck this with the rule binders in scope + -> TcM (TcLevel, WantedConstraints, ([Var], a)) + -- The [Var] are the explicitly-quantified variables, + -- both type variables and term variables +tcRuleBndrs skol_info (RuleBndrs { rb_tyvs = mb_tv_bndrs, rb_tmvs = tm_bndrs }) + thing_inside + = pushLevelAndCaptureConstraints $ + case mb_tv_bndrs of + Nothing -> go_tms tm_bndrs thing_inside + Just tv_bndrs -> do { (bndrs1, (bndrs2, res)) <- go_tvs tv_bndrs $ + go_tms tm_bndrs $ + thing_inside + ; return (binderVars bndrs1 ++ bndrs2, res) } + where + -------------- + go_tvs tvs thing_inside = bindExplicitTKBndrs_Skol skol_info tvs thing_inside + + -------------- + go_tms [] thing_inside + = do { res <- thing_inside; return ([], res) } + go_tms (L _ (RuleBndr _ (L _ name)) : rule_bndrs) thing_inside + = do { ty <- newOpenFlexiTyVarTy + ; let bndr_id = mkLocalId name ManyTy ty + ; (bndrs, res) <- tcExtendIdEnv [bndr_id] $ + go_tms rule_bndrs thing_inside + ; return (bndr_id : bndrs, res) } + + go_tms (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs) thing_inside + -- e.g x :: a->a + -- The tyvar 'a' is brought into scope first, just as if you'd written + -- a::*, x :: a->a + -- If there's an explicit forall, the renamer would have already reported an + -- error for each out-of-scope type variable used + = do { (_ , tv_prs, id_ty) <- tcRuleBndrSig name skol_info rn_ty + ; let bndr_id = mkLocalId name ManyTy id_ty + -- See Note [Typechecking pattern signature binders] in GHC.Tc.Gen.HsType + + -- The type variables scope over subsequent bindings; yuk + ; (bndrs, res) <- tcExtendNameTyVarEnv tv_prs $ + tcExtendIdEnv [bndr_id] $ + go_tms rule_bndrs thing_inside + ; return (map snd tv_prs ++ bndr_id : bndrs, res) } + + +{- +********************************************************************************* +* * + Constraint simplification for rules +* * +*********************************************************************************** + +Note [The SimplifyRule Plan] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Example. Consider the following left-hand side of a rule + f (x == y) (y > z) = ... +If we typecheck this expression we get constraints + d1 :: Ord a, d2 :: Eq a +We do NOT want to "simplify" to the LHS + forall x::a, y::a, z::a, d1::Ord a. + f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ... +Instead we want + forall x::a, y::a, z::a, d1::Ord a, d2::Eq a. + f ((==) d2 x y) ((>) d1 y z) = ... + +Here is another example: + fromIntegral :: (Integral a, Num b) => a -> b + {-# RULES "foo" fromIntegral = id :: Int -> Int #-} +In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But +we *dont* want to get + forall dIntegralInt. + fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int +because the scsel will mess up RULE matching. Instead we want + forall dIntegralInt, dNumInt. + fromIntegral Int Int dIntegralInt dNumInt = id Int + +Even if we have + g (x == y) (y == z) = .. +where the two dictionaries are *identical*, we do NOT WANT + forall x::a, y::a, z::a, d1::Eq a + f ((==) d1 x y) ((>) d1 y z) = ... +because that will only match if the dict args are (visibly) equal. +Instead we want to quantify over the dictionaries separately. + +In short, simplifyRuleLhs must *only* squash equalities, leaving +all dicts unchanged, with absolutely no sharing. + +Also note that we can't solve the LHS constraints in isolation: +Example foo :: Ord a => a -> a + foo_spec :: Int -> Int + {-# RULE "foo" foo = foo_spec #-} +Here, it's the RHS that fixes the type variable + +HOWEVER, under a nested implication things are different +Consider + f :: (forall a. Eq a => a->a) -> Bool -> ... + {-# RULES "foo" forall (v::forall b. Eq b => b->b). + f b True = ... + #-} +Here we *must* solve the wanted (Eq a) from the given (Eq a) +resulting from skolemising the argument type of g. So we +revert to SimplCheck when going under an implication. + + +--------- So the SimplifyRule Plan is this ----------------------- + +* Step 0: typecheck the LHS and RHS to get constraints from each + +* Step 1: Simplify the LHS and RHS constraints all together in one bag, + but /discarding/ the simplified constraints. We do this only + to discover all unification equalities. + +* Step 2: Zonk the ORIGINAL (unsimplified) LHS constraints, to take + advantage of those unifications + +* Step 3: Partition the LHS constraints into the ones we will + quantify over, and the others. + See Note [RULE quantification over equalities] + +* Step 4: Decide on the type variables to quantify over + +* Step 5: Simplify the LHS and RHS constraints separately, using the + quantified constraints as givens + +Note [Solve order for RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In step 1 above, we need to be a bit careful about solve order. +Consider + f :: Int -> T Int + type instance T Int = Bool + + RULE f 3 = True + +From the RULE we get + lhs-constraints: T Int ~ alpha + rhs-constraints: Bool ~ alpha +where 'alpha' is the type that connects the two. If we glom them +all together, and solve the RHS constraint first, we might solve +with alpha := Bool. But then we'd end up with a RULE like + + RULE: f 3 |> (co :: T Int ~ Bool) = True + +which is terrible. We want + + RULE: f 3 = True |> (sym co :: Bool ~ T Int) + +So we are careful to solve the LHS constraints first, and *then* the +RHS constraints. Actually much of this is done by the on-the-fly +constraint solving, so the same order must be observed in +tcRule. + +Note [RULE quantification over equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At the moment a RULE never quantifies over an equality; see `rule_quant_ct` +in `getRuleQuantCts`. Why not? + + * It's not clear why we would want to do so (see Historical Note + below) + + * We do not want to quantify over insoluble equalities (Int ~ Bool) + (a) because we prefer to report a LHS type error + (b) because if such things end up in 'givens' we get a bogus + "inaccessible code" error + + * Matching on coercions is Deeply Suspicious. We don't want to generate a + RULE like + forall a (co :: F a ~ Int). + foo (x |> Sym co) = ...co... + because matching on that template, to bind `co`, would require us to + match on the /structure/ of a coercion, which we must never do. + See GHC.Core.Rules Note [Casts in the template] + + * Equality constraints are unboxed, and that leads to complications + For example equality constraints from the LHS will emit coercion hole + Wanteds. These don't have a name, so we can't quantify over them directly. + Instead, in `getRuleQuantCts`, we'd have to invent a new EvVar for the + coercion, fill the hole with the invented EvVar, and then quantify over the + EvVar. Here is old code from `mk_one` + do { ev_id <- newEvVar pred + ; fillCoercionHole hole (mkCoVarCo ev_id) + ; return ev_id } + But that led to new complications becuase of the side effect on the coercion + hole. Much easier just to side-step the issue entirely by not quantifying over + equalities. + +Historical Note: + Back in 2012 (5aa1ae24567) we started quantifying over some equality + constraints, saying + * But we do want to quantify over things like (a ~ F b), + where F is a type function. + It is not clear /why/ we did so, and we don't do so any longer. +End of historical note. + +Note [Simplify cloned constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At this stage, we're simplifying constraints only for insolubility +and for unification. Note that all the evidence is quickly discarded. +We use a clone of the real constraint. If we don't do this, +then RHS coercion-hole constraints get filled in, only to get filled +in *again* when solving the implications emitted from tcRule. That's +terrible, so we avoid the problem by cloning the constraints. + +-} + +simplifyRule :: RuleName + -> TcLevel -- Level at which to solve the constraints + -> WantedConstraints -- Constraints from LHS + -> WantedConstraints -- Constraints from RHS + -> TcM ( [EvVar] -- Quantify over these LHS vars + , WantedConstraints -- Residual un-quantified LHS constraints + , TcTyVarSet ) -- Don't default these +-- See Note [The SimplifyRule Plan] +-- NB: This consumes all simple constraints on the LHS, but not +-- any LHS implication constraints. +simplifyRule name tc_lvl lhs_wanted rhs_wanted + = do { + -- Note [The SimplifyRule Plan] step 1 + -- First solve the LHS and *then* solve the RHS + -- Crucially, this performs unifications + -- Why clone? See Note [Simplify cloned constraints] + ; lhs_clone <- cloneWC lhs_wanted + ; rhs_clone <- cloneWC rhs_wanted + ; (dont_default, _) + <- setTcLevel tc_lvl $ + runTcS $ + do { lhs_wc <- solveWanteds lhs_clone + ; _rhs_wc <- solveWanteds rhs_clone + -- Why do them separately? + -- See Note [Solve order for RULES] + + ; let dont_default = nonDefaultableTyVarsOfWC lhs_wc + -- If lhs_wanteds has + -- (a[sk] :: TYPE rr[sk]) ~ (b0[tau] :: TYPE r0[conc]) + -- we want r0 to be non-defaultable; + -- see nonDefaultableTyVarsOfWC. Simplest way to get + -- this is to look at the post-simplified lhs_wc, which + -- will contain (rr[sk] ~ r0[conc)]. An example is in + -- test rep-poly/RepPolyRule1 + ; return dont_default } + + -- Note [The SimplifyRule Plan] step 2 + ; lhs_wanted <- liftZonkM $ zonkWC lhs_wanted + + -- Note [The SimplifyRule Plan] step 3 + ; (quant_cts, residual_lhs_wanted) <- getRuleQuantCts lhs_wanted + ; let quant_evs = map ctEvId (bagToList quant_cts) + + ; traceTc "simplifyRule" $ + vcat [ text "LHS of rule" <+> doubleQuotes (ftext name) + , text "lhs_wanted" <+> ppr lhs_wanted + , text "rhs_wanted" <+> ppr rhs_wanted + , text "quant_cts" <+> ppr quant_evs + , text "residual_lhs_wanted" <+> ppr residual_lhs_wanted + , text "dont_default" <+> ppr dont_default + ] + + ; return (quant_evs, residual_lhs_wanted, dont_default) } + +getRuleQuantCts :: WantedConstraints -> TcM (Cts, WantedConstraints) +-- Extract all the constraints that we can quantify over, +-- also returning the depleted WantedConstraints +-- +-- Unlike simplifyInfer, we don't leave the WantedConstraints unchanged, +-- and attempt to solve them from the quantified constraints. Instead +-- we /partition/ the WantedConstraints into ones to quantify and ones +-- we can't quantify. We could use approximateWC instead, and leave +-- `wanted` unchanged; but then we'd have to clone fresh binders and +-- generate silly identity bindings. Seems more direct to do this. +-- Probably not a big deal wither way. +-- +-- NB: we must look inside implications, because with +-- -fdefer-type-errors we generate implications rather eagerly; +-- see GHC.Tc.Utils.Unify.implicationNeeded. Not doing so caused #14732. + +getRuleQuantCts wc + = return $ float_wc emptyVarSet wc + where + float_wc :: TcTyCoVarSet -> WantedConstraints -> (Cts, WantedConstraints) + float_wc skol_tvs (WC { wc_simple = simples, wc_impl = implics, wc_errors = errs }) + = ( simple_yes `andCts` implic_yes + , emptyWC { wc_simple = simple_no, wc_impl = implics_no, wc_errors = errs }) + where + (simple_yes, simple_no) = partitionBag (rule_quant_ct skol_tvs) simples + (implic_yes, implics_no) = mapAccumBagL (float_implic skol_tvs) emptyBag implics + + float_implic :: TcTyCoVarSet -> Cts -> Implication -> (Cts, Implication) + float_implic skol_tvs yes1 imp + = (yes1 `andCts` yes2, imp { ic_wanted = no }) + where + (yes2, no) = float_wc new_skol_tvs (ic_wanted imp) + new_skol_tvs = skol_tvs `extendVarSetList` ic_skols imp + + rule_quant_ct :: TcTyCoVarSet -> Ct -> Bool + rule_quant_ct skol_tvs ct + | insolubleWantedCt ct + = False + | otherwise + = case classifyPredType (ctPred ct) of + EqPred {} -> False -- Note [RULE quantification over equalities] + _ -> tyCoVarsOfCt ct `disjointVarSet` skol_tvs + +{- Note [Quantifying over equalities in RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Up until version 9.12 (inclusive), GHC would happily quantify over certain Wanted +equalities in the LHS of a RULE. This was incorrect behaviour that led to a RULE +that would never fire, so GHC 9.14 and above no longer allow such RULES. +However, instead of throwing an error, GHC will /temporarily/ emit a warning +and drop the rule instead, in order to ease migration for library maintainers +(NB: this warning is not emitted when the RHS constraints are insoluble; in that +case we simply report those constraints as errors instead). +This warning is scheduled to be turned into an error, and the warning flag +removed (becoming a normal typechecker error), starting from version 9.18. + +The function 'allPreviouslyQuantifiableEqualities' computes the equality +constraints that previous (<= 9.12) versions of GHC accepted quantifying over. + + + Example (test case 'RuleEqs', extracted from the 'mono-traversable' library): + + type family Element mono + type instance Element [a] = a + + class MonoFoldable mono where + otoList :: mono -> [Element mono] + instance MonoFoldable [a] where + otoList = id + + ointercalate :: (MonoFoldable mono, Monoid (Element mono)) + => Element mono -> mono -> Element mono + {-# RULES "ointercalate list" forall x. ointercalate x = Data.List.intercalate x . otoList #-} + + Now, because Data.List.intercalate has the type signature + + forall a. [a] -> [[a]] -> [a] + + typechecking the LHS of this rule would give rise to the Wanted equality + + [W] Element mono ~ [a] + + Due to the type family, GHC 9.12 and below accepted to quantify over this + equality, which would lead to a rule LHS template of the form: + + forall (@mono) (@a) + ($dMonoFoldable :: MonoFoldable mono) + ($dMonoid :: Monoid (Element mono)) + (co :: [a] ~ Element mono) + (x :: [a]). + ointercalate @mono $dMonoFoldable $dMonoid + (x `cast` (Sub co)) + + Matching against this template would match on the structure of a coercion, + which goes against Note [Casts in the template] in GHC.Core.Rules. + In practice, this meant that this RULE would never fire. +-} + +-- | Computes all equality constraints that GHC doesn't accept, but previously +-- did accept (until GHC 9.12 (included)), when deciding what to quantify over +-- in the LHS of a RULE. +-- +-- See Note [Quantifying over equalities in RULES]. +allPreviouslyQuantifiableEqualities :: WantedConstraints -> Maybe (NE.NonEmpty Ct) +allPreviouslyQuantifiableEqualities wc = go emptyVarSet wc + where + go :: TyVarSet -> WantedConstraints -> Maybe (NE.NonEmpty Ct) + go skol_tvs (WC { wc_simple = simples, wc_impl = implics }) + = do { cts1 <- mapM (go_simple skol_tvs) simples + ; cts2 <- concatMapM (go_implic skol_tvs) implics + ; NE.nonEmpty $ toList cts1 ++ toList cts2 } + + go_simple :: TyVarSet -> Ct -> Maybe Ct + go_simple skol_tvs ct + | not (tyCoVarsOfCt ct `disjointVarSet` skol_tvs) + = Nothing + | EqPred _ t1 t2 <- classifyPredType (ctPred ct), ok_eq t1 t2 + = Just ct + | otherwise + = Nothing + + go_implic :: TyVarSet -> Implication -> Maybe [Ct] + go_implic skol_tvs (Implic { ic_skols = skols, ic_wanted = wc }) + = fmap toList $ go (skol_tvs `extendVarSetList` skols) wc + + ok_eq t1 t2 + | t1 `tcEqType` t2 = False + | otherwise = is_fun_app t1 || is_fun_app t2 + + is_fun_app ty -- ty is of form (F tys) where F is a type function + = case tyConAppTyCon_maybe ty of + Just tc -> isTypeFamilyTyCon tc + Nothing -> False diff --git a/GHC/Tc/Gen/Splice.hs b/GHC/Tc/Gen/Splice.hs --- a/GHC/Tc/Gen/Splice.hs +++ b/GHC/Tc/Gen/Splice.hs @@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -89,7 +90,7 @@ import GHCi.RemoteTypes import GHC.Runtime.Interpreter -import GHC.Rename.Splice( traceSplice, SpliceInfo(..)) +import GHC.Rename.Splice( traceSplice, SpliceInfo(..) ) import GHC.Rename.Expr import GHC.Rename.Env import GHC.Rename.Fixity ( lookupFixityRn_help ) @@ -124,7 +125,7 @@ import GHC.Unit.Finder import GHC.Unit.Module import GHC.Unit.Module.ModIface -import GHC.Unit.Module.Deps +import GHC.Iface.Syntax import GHC.Utils.Misc import GHC.Utils.Panic as Panic @@ -137,7 +138,9 @@ import GHC.Data.FastString import GHC.Data.Maybe( MaybeErr(..) ) +import GHC.Data.EnumSet (EnumSet) import qualified GHC.Data.EnumSet as EnumSet +import qualified GHC.LanguageExtensions as LangExt -- THSyntax gives access to internal functions and data types import qualified GHC.Boot.TH.Syntax as TH @@ -145,8 +148,13 @@ #if defined(HAVE_INTERNAL_INTERPRETER) import Unsafe.Coerce ( unsafeCoerce ) +#if !MIN_VERSION_base(4,22,0) import GHC.Desugar ( AnnotationWrapper(..) ) +#else +import GHC.Internal.Desugar ( AnnotationWrapper(..) ) #endif +import Control.DeepSeq +#endif import Control.Monad import Data.Binary @@ -170,27 +178,27 @@ {- Note [Template Haskell state diagram] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Here are the ThStages, s, their corresponding level numbers -(the result of (thLevel s)), and their state transitions. +Here are the ThLevels, their corresponding level numbers +(the result of (thLevelIndex s)), and their state transitions. The top level of the program is stage Comp: Start here | V - ----------- $ ------------ $ - | Comp | ---------> | Splice | -----| - | 1 | | 0 | <----| - ----------- ------------ + ----------- $ ------------ $ ----------------- + | Comp | ---------> | Splice | -----> | Splice Splice | + | 0 | | -1 | <---- | -2 | + ----------- ------------ [||] ----------------- ^ | ^ | $ | | [||] $ | | [||] | v | v -------------- ---------------- | Brack Comp | | Brack Splice | - | 2 | | 1 | + | 1 | | 0 | -------------- ---------------- * Normal top-level declarations start in state Comp - (which has level 1). + (which has level 0). Annotations start in state Splice, since they are treated very like a splice (only without a '$') @@ -198,31 +206,30 @@ will be *run at compile time*, with the result replacing the splice -* The original paper used level -1 instead of 0, etc. - * The original paper did not allow a splice within a splice, but there is no reason not to. This is the $ transition in the top right. Note [Template Haskell levels] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -* Imported things are impLevel (= 0) +* The level checks are implemented for terms in `checkThLocalName` -* However things at level 0 are not *necessarily* imported. - eg $( \b -> ... ) here b is bound at level 0 +* Imported things are level 0 +* Top-level things are level 0 + * In GHCi, variables bound by a previous command are treated - as impLevel, because we have bytecode for them. + as imported, because we have bytecode for them. * Variables are bound at the "current level" -* The current level starts off at outerLevel (= 1) +* The current level starts off at 0 * The level is decremented by splicing $(..) incremented by brackets [| |] incremented by name-quoting 'f -* When a variable is used, checkWellStaged compares +* When a variable is used, checkThLocalName compares bind: binding level, and use: current level at usage site @@ -233,16 +240,18 @@ bind = use Always OK (bound same stage as used) [| \x -> $(f [| x |]) |] - bind < use Inside brackets, it depends - Inside splice, OK - Inside neither, OK + bind < use Inside brackets, it depends on what cross stage + persistence rules are used. For (bind < use) inside brackets, there are three cases: - - Imported things OK f = [| map |] - - Top-level things OK g = [| f |] + - Imported things (if ImplicitStagePersistence is enabled) OK f = [| map |] + - Top-level things (if ImplicitStagePersistence is enabled) OK g = [| f |] - Non-top-level Only if there is a liftable instance h = \(x:Int) -> [| x |] + If ExplicitLevelImports is used, then imports can bring identifiers into scope + at non-zero levels. + To track top-level-ness we use the ThBindEnv in TcLclEnv For example: @@ -380,7 +389,7 @@ returned together in a `QuoteWrapper` and then passed along to two further places during compilation: -1. Typechecking nested splices (immediately in tcPendingSplice) +1. Typechecking nested splices (immediately in tcUntypedSplice) 2. Desugaring quotations (see GHC.HsToCore.Quote) `tcPendingSplice` takes the `m` type variable as an argument and @@ -407,7 +416,7 @@ Note [Lifecycle of an untyped splice, and PendingRnSplice] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Untyped splices $(f x) and quasiquotes [p| stuff |] have the following -life cycle. Remember, quasi-quotes are very like splices; see Note [Quasi-quote overview]). +life cycle. Quasi-quotes are very like splices; see Note [Quasi-quote overview]). The type structure is @@ -417,13 +426,14 @@ data HsUntypedSplice p = HsUntypedSpliceExpr (XUntypedSpliceExpr p) (LHsExpr p) | HsQuasiQuote (XQuasiQuote p) (IdP id) (XRec p FastString) + | XXUntypedSplice (XUntypedSplice p) -Remember that untyped splices can occur in expressions, patterns, +Untyped splices can occur in expressions, patterns, types, and declarations. So we have a HsUntypedSplice data constructor in all four of these types. Untyped splices never occur in (HsExpr GhcTc), and similarly -patterns etc. So we have +patterns etc, because the body of a untyped quotation is not typechecked. So we have type instance XUntypedSplice GhcTc = DataConCantHappen @@ -445,7 +455,7 @@ RENAMER (rnUntypedBracket): -* Set the ThStage to (Brack s (RnPendingUntyped ps_var)) +* Set the ThLevel to (Brack s (RnPendingUntyped ps_var)) * Rename the body @@ -462,9 +472,9 @@ The result is HsUntypedBracket - [PendingRnSplice UntypedExpSplice spn (g x :: LHsExpr GHcRn)] + [PendingRnSplice spn (HsUntypedSpliceExpr UntypedExpSplice (g x :: LHsExpr GHcRn))] (HsApp (HsVar f) (HsUntypedSplice (HsUntypedSpliceNested spn) - (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn)))) + (HsUntypedSpliceExpr UntypedExpSplice (g x :: LHsExpr GhcRn)))) Note that a nested splice, such as the `$(g x)` now appears twice: - In the PendingRnSplice: this is the version that will later be typechecked @@ -477,14 +487,13 @@ [| let $e0 in (f :: $e1) $e2 (\ $e -> body ) |] + 1 Here $e0 is a declaration splice, $e1 is a type splice, $e2 is an -expression splice, and $e3 is a pattern splice. The `PendingRnSplice` -keeps track of which is which through its `UntypedSpliceFlavour` -field. +expression splice, and $e3 is a pattern splice. The `SpliceFlavour` is stored +in the extension field of HsUntypedSpliceExpr. TYPECHECKER (tcUntypedBracket): see also Note [Typechecking Overloaded Quotes] -* Typecheck the [PendingRnSplice] individually, to give [PendingTcSplice] - So PendingTcSplice is used for both typed and untyped splices. +* Typecheck the [PendingRnSplice] individually, to give [PendingTcSplice]. + PendingTcSplice is used for both typed and untyped splices. * Ignore the body of the bracket; just check that the context expects a bracket of that type (e.g. a [p| pat |] bracket should @@ -497,7 +506,7 @@ (HsBracketTc { hsb_splices = [PendingTcSplice spn (g x :: LHsExpr GHcTc)] , hsb_quote = HsApp (HsVar f) (HsUntypedSplice (HsUntypedSpliceNested spn) - (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn))) + (HsUntypedSpliceExpr UntypedExpSplice (g x :: LHsExpr GhcRn))) }) (XQuote noExtField) @@ -505,7 +514,20 @@ have type (HsQuote GhcTc) is stubbed off with (XQuote noExtField). The payload is now in the hsb_quote field of the HsBracketTc. +------------------------------------- +Implicit lifting +------------------------------------- +When a variable is bound at level n and used at level n+1, the renamer will decide, +in `checkThLocalNameWithLift`, to implicitly lift this variable to level n+1. +This is done by replacing the occurrence of `x` with `$(lift x)`. +This decision is then stored in the extension points 'XXUntypedSplice'/'XXTypedSplice'. +When we come to typechecking these splices, the typechecker will emit the appropriate +'Lift' constraint, with a `ImplicitLiftOrigin` `CtOrigin`. If we fail to solve this constraint, +a level error is reported to the user. + + + ------------------------------------- Top-level untyped splices/quasiquotes ------------------------------------- @@ -537,8 +559,8 @@ Nested, typed splices ---------------------- When we typecheck a /typed/ bracket, we lift nested splices out as -`PendingTcSplice`, very similar to Note [PendingRnSplice]. Again, the -splice needs a SplicePointName, for the desguarer to use to connect +`PendingTcSplice`, very similar to Note [Pending Splices]. Again, the +splice needs a SplicePointName, for the desugarer to use to connect the splice expression with the point in the syntax tree where it is used. Example: [|| f $$(g 2)||] @@ -546,20 +568,20 @@ Parser: this is parsed as HsTypedBracket _ (HsApp (HsVar "f") - (HsTypedSplice _ (g 2 :: LHsExpr GhcPs))) + (HsTypedSplice _ (HsTypedSpliceExpr _ (g 2 :: LHsExpr GhcPs)))) RENAMER (rnTypedSplice): the renamer adds a SplicePointName, spn: HsTypedBracket _ (HsApp (HsVar "f") - (HsTypedSplice spn (g x :: LHsExpr GhcRn))) + (HsTypedSplice (HsTypedSpliceNested spn) (HsTypedSpliceExpr _ (g x :: LHsExpr GhcRn)))) TYPECHECKER (tcTypedBracket): -* Set the ThStage to (Brack s (TcPending ps_var lie_var)) +* Set the ThLevel to (Brack s (TcPending ps_var lie_var quote_wrapper)) -* Typecheck the body, and keep the elaborated result (despite never using it!) +* Typecheck the body, and keep the elaborated result (despite never using it!, todo: it should be stored in the AST) -* Nested splices (which must be typed) are typechecked by tcNestedSplice, and +* Nested splices (which must be typed) are typechecked by tcTypedSplice, and the results accumulated in ps_var; their constraints accumulate in lie_var * Result is a HsTypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) tc_brack @@ -651,7 +673,7 @@ tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcUntypedBracket :: HsExpr GhcRn -> HsQuote GhcRn -> [PendingRnSplice] -> ExpRhoType -> TcM (HsExpr GhcTc) -tcTypedSplice :: Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcTypedSplice :: HsTypedSpliceResult -> HsTypedSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) getUntypedSpliceBody :: HsUntypedSpliceResult (HsExpr GhcRn) -> TcM (HsExpr GhcRn) runAnnotation :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation @@ -666,9 +688,9 @@ -- See Note [How brackets and nested splices are handled] tcTypedBracket rn_expr expr res_ty - = addErrCtxt (quotationCtxtDoc expr) $ - do { cur_stage <- getStage - ; ps_ref <- newMutVar [] + = addErrCtxt (TypedTHBracketCtxt expr) $ + do { cur_lvl <- getThLevel + ; ps_var <- newMutVar [] ; lie_var <- getConstraintVar -- Any constraints arising from nested splices -- should get thrown into the constraint set -- from outside the bracket @@ -680,18 +702,19 @@ -- Bundle them together so they can be used in GHC.HsToCore.Quote for desugaring -- brackets. ; let wrapper = QuoteWrapper ev_var m_var + -- Typecheck expr to make sure it is valid. -- The typechecked expression won't be used, so we just discard it -- (See Note [The life cycle of a TH quotation] in GHC.Hs.Expr) -- We'll typecheck it again when we splice it in somewhere - ; (tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var wrapper)) $ + ; (tc_expr, expr_ty) <- setThLevel (Brack cur_lvl (TcPending ps_var lie_var wrapper)) $ tcScalingUsage ManyTy $ -- Scale by Many, TH lifting is currently nonlinear (#18465) tcInferRhoNC expr -- NC for no context; tcBracket does that ; let rep = getRuntimeRep expr_ty - ; meta_ty <- tcTExpTy m_var expr_ty - ; ps' <- readMutVar ps_ref + ; meta_ty <- tcCodeTy m_var expr_ty + ; ps' <- readMutVar ps_var ; codeco <- tcLookupId unsafeCodeCoerceName ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName ; let brack_tc = HsBracketTc { hsb_quote = ExpBr noExtField expr, hsb_ty = bracket_ty @@ -718,8 +741,8 @@ -- Match the expected type with the type of all the internal -- splices. They might have further constrained types and if they do -- we want to reflect that in the overall type of the bracket. - ; ps' <- case quoteWrapperTyVarTy <$> brack_info of - Just m_var -> mapM (tcPendingSplice m_var) ps + ; ps' <- case brack_info of + Just q -> mapM (tc_nested_splice q) ps Nothing -> assert (null ps) $ return [] -- Notice that we don't attempt to typecheck the body @@ -735,6 +758,9 @@ expected_type res_ty } + where + tc_nested_splice :: QuoteWrapper -> PendingRnSplice -> TcM PendingTcSplice + tc_nested_splice q (PendingRnSplice splice_name expr) = tcUntypedSplice q splice_name expr -- | A type variable with kind * -> * named "m" mkMetaTyVar :: TcM TyVar @@ -777,43 +803,119 @@ (PatBr {}) -> mkTy patTyConName -- Result type is m Pat (DecBrL {}) -> panic "tcBrackTy: Unexpected DecBrL" + +untypedSpliceResultType :: UntypedSpliceFlavour -> TcType -> TcM TcType +untypedSpliceResultType flavour meta_ty = do + sp_ty <- tcMetaTy sp_ty_name + return $ mkAppTy meta_ty sp_ty + where + sp_ty_name = case flavour of + UntypedExpSplice -> expTyConName + UntypedPatSplice -> patTyConName + UntypedTypeSplice -> typeTyConName + UntypedDeclSplice -> decsTyConName + --------------- -- | Typechecking a pending splice from a untyped bracket -tcPendingSplice :: TcType -- Metavariable for the expected overall type of the +-- TODO: Should return HsUntypedSplice GhcTc, and the desugarer should +-- construct the relevant CoreExpr rather than performing desugaring here. +tcUntypedSplice :: QuoteWrapper -- Metavariable for the expected overall type of the -- quotation. - -> PendingRnSplice + -> SplicePointName + -> HsUntypedSplice GhcRn -> TcM PendingTcSplice -tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) +tcUntypedSplice (QuoteWrapper _ m_var) splice_name (HsUntypedSpliceExpr (HsUserSpliceExt flavour) expr) -- See Note [Typechecking Overloaded Quotes] - = do { meta_ty <- tcMetaTy meta_ty_name - -- Expected type of splice, e.g. m Exp - ; let expected_type = mkAppTy m_var meta_ty + = do { expected_type <- untypedSpliceResultType flavour m_var ; expr' <- tcScalingUsage ManyTy $ tcCheckPolyExpr expr expected_type -- Scale by Many, TH lifting is currently nonlinear (#18465) ; return (PendingTcSplice splice_name expr') } - where - meta_ty_name = case flavour of - UntypedExpSplice -> expTyConName - UntypedPatSplice -> patTyConName - UntypedTypeSplice -> typeTyConName - UntypedDeclSplice -> decsTyConName +tcUntypedSplice (QuoteWrapper _ m_var) splice_name (HsQuasiQuote (HsQuasiQuoteExt flavour) quoter s) = do + -- 1. Check that the quoter is of type 'QuasiQuoter' + qq_type <- mkTyConTy <$> tcLookupTyCon quasiQuoterTyConName + quoter' <- setSrcSpan (getLocA quoter) $ tcCheckId (unLoc quoter) (Check qq_type) + -- 2. Check that the quasi-quote has type Q Exp/Q Pat/Q Dec/Q Decs (as appropriate) + qTy <- mkTyConTy <$> tcLookupTyCon qTyConName + quote_ty <- untypedSpliceResultType flavour m_var + splice_ty <- untypedSpliceResultType flavour qTy + res_co <- unifyInvisibleType splice_ty quote_ty + + -- 3. Lookup the relevant field selector from QuasiQuoter + sel <- tcLookupId qq_sel_name + + -- 4. Apply the selector to the quasi-quoter + let expr' = mkLHsWrapCo res_co $ + nlHsApp (nlHsApp (nlHsVar sel) (noLocA quoter')) (nlHsLit (mkHsStringFS (unLoc s))) + + return (PendingTcSplice splice_name expr') + where + qq_sel_name = case flavour of + UntypedExpSplice -> quoteExpName + UntypedPatSplice -> quotePatName + UntypedTypeSplice -> quoteTypeName + UntypedDeclSplice -> quoteDecName + + -- Identifiers that are lifted implicitly, such as 'x' in + -- E.g. \x -> [| h x |] + -- We must behave as if the reference to x was + -- h $(lift x) + -- We use 'x' itself as the SplicePointName, used by + -- the desugarer to stitch it all back together. + -- If 'x' occurs many times we may get many identical + -- bindings of the same SplicePointName, but that doesn't + -- matter, although it's a mite untidy. +tcUntypedSplice q splice_name (XUntypedSplice ils) + = do { let id_name = implicit_lift_lid ils + ; id_ty <- newOpenFlexiTyVarTy + ; let v_expr = noLocA (HsVar noExtField id_name) + ; v_expr' <- tcCheckMonoExpr v_expr id_ty + -- lift :: Quote m' => a -> m' Exp + ; lift <- setSrcSpan (getLocA id_name) $ + newMethodFromName (ImplicitLiftOrigin ils) + GHC.Builtin.Names.TH.liftName + [getRuntimeRep id_ty, id_ty] + ; let res = nlHsApp (mkLHsWrap (applyQuoteWrapper q) (noLocA lift)) v_expr' + + ; return (PendingTcSplice splice_name res) } + +tcPendingSpliceTyped :: QuoteWrapper -> SplicePointName -> HsTypedSplice GhcRn -> ExpRhoType -> TcM PendingTcSplice +tcPendingSpliceTyped q@(QuoteWrapper _ m_var) splice_name (HsTypedSpliceExpr _ expr) res_ty + = do { res_ty <- expTypeToType res_ty + ; let rep = getRuntimeRep res_ty + ; meta_exp_ty <- tcCodeTy m_var res_ty + ; expr' <- tcCheckMonoExpr expr meta_exp_ty + ; untype_code <- tcLookupId unTypeCodeName + ; let expr'' = mkHsApp + (mkLHsWrap (applyQuoteWrapper q) + (nlHsTyApp untype_code [rep, res_ty])) expr' + ; return (PendingTcSplice splice_name expr'') } +tcPendingSpliceTyped q splice_name (XTypedSplice ils) res_ty + = do { let id_name = implicit_lift_lid ils + ; res_ty <- expTypeToType res_ty + ; let rep = getRuntimeRep res_ty + ; let v_expr = noLocA (HsVar noExtField id_name) + ; v_expr' <- tcCheckMonoExpr v_expr res_ty + -- lift :: Quote m' => a -> m' Exp + ; lift <- setSrcSpan (getLocA id_name) $ + newMethodFromName (ImplicitLiftOrigin ils) + GHC.Builtin.Names.TH.liftName + [rep, res_ty] + ; let res = nlHsApp (mkLHsWrap (applyQuoteWrapper q) (noLocA lift)) v_expr' + ; return (PendingTcSplice splice_name res) } + + --------------- -- Takes a m and tau and returns the type m (TExp tau) -tcTExpTy :: TcType -> TcType -> TcM TcType -tcTExpTy m_ty exp_ty +tcCodeTy :: TcType -> TcType -> TcM TcType +tcCodeTy m_ty exp_ty = do { unless (isTauTy exp_ty) $ addErr $ TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } -quotationCtxtDoc :: LHsExpr GhcRn -> SDoc -quotationCtxtDoc br_body - = hang (text "In the Template Haskell quotation") - 2 (thTyBrackets . ppr $ br_body) - -- The whole of the rest of the file is the else-branch (ie stage2 only) @@ -835,20 +937,35 @@ getUntypedSpliceBody (HsUntypedSpliceNested {}) = panic "tcTopUntypedSplice: invalid nested splice" -tcTypedSplice splice_name expr res_ty - = addErrCtxt (typedSpliceCtxtDoc splice_name expr) $ - setSrcSpan (getLocA expr) $ do - { stage <- getStage - ; case stage of - Splice {} -> tcTopSplice expr res_ty - Brack pop_stage pend -> tcNestedSplice pop_stage pend splice_name expr res_ty - RunSplice _ -> - -- See Note [RunSplice ThLevel] in "GHC.Tc.Types". - pprPanic ("tcSpliceExpr: attempted to typecheck a splice when " ++ - "running another splice") (pprTypedSplice (Just splice_name) expr) - Comp -> tcTopSplice expr res_ty - } +tcTypedSplice HsTypedSpliceTop ctxt@(HsTypedSpliceExpr _ expr) res_ty + = addErrCtxt (TypedSpliceCtxt Nothing ctxt) $ + setSrcSpan (getLocA expr) $ + tcTopSplice expr res_ty +tcTypedSplice (HsTypedSpliceNested sp) expr res_ty + -- The expr is checked in tcPendingSpliceTyped + = addErrCtxt (TypedSpliceCtxt (Just sp) expr) $ + setSrcSpan loc $ do + lvl <- getThLevel + case lvl of + Brack _ (TcPending ps_var lie_var q) -> do + tc_splice <- setConstraintVar lie_var $ tcPendingSpliceTyped q sp expr res_ty + updTcRef ps_var (tc_splice : ) + -- stubNestedSplice: the returned expression is ignored; it's in the pending splices. + -- + -- Unfortunately, this means that tooling that works with typechecked + -- expressions will not be able to identify where the nested splices are. + -- Instead, we should modify the extension point of HsTypedSplice, in + -- order to propagate the result of typechecking. + return stubNestedSplice + _ -> panic "tcTypedSplice: invalid level" + where + loc = case expr of + HsTypedSpliceExpr _ expr -> getLocA expr + XTypedSplice (HsImplicitLiftSplice _ _ _ expr) -> getLocA expr +tcTypedSplice _ _ _ = panic "tcTypedSplice: invalid splice" + + {- Note [Collecting modFinalizers in typed splices] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 'qAddModFinalizer' of the @Quasi TcM@ instance adds finalizers in the local @@ -867,13 +984,13 @@ res_ty <- expTypeToType res_ty ; q_type <- tcMetaTy qTyConName -- Top level splices must still be of type Q (TExp a) - ; meta_exp_ty <- tcTExpTy q_type res_ty + ; meta_exp_ty <- tcCodeTy q_type res_ty ; q_expr <- tcTopSpliceExpr Typed $ tcCheckMonoExpr expr meta_exp_ty ; lcl_env <- getLclEnv ; let delayed_splice = DelayedSplice lcl_env expr res_ty q_expr - ; return (HsTypedSplice delayed_splice q_expr) + ; return (HsTypedSplice delayed_splice (HsTypedSpliceExpr noExtField q_expr)) } @@ -891,7 +1008,8 @@ tcTopSpliceExpr isTypedSplice tc_action = checkNoErrs $ -- checkNoErrs: must not try to run the thing -- if the type checker fails! - setStage (Splice isTypedSplice) $ + + setThLevel (Splice isTypedSplice Comp) $ do { -- Typecheck the expression (mb_expr', wanted) <- tryCaptureConstraints tc_action -- If tc_action fails (perhaps because of insoluble constraints) @@ -906,32 +1024,6 @@ Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' } ------------------ -tcNestedSplice :: ThStage -> PendingStuff -> Name - -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) - -- See Note [How brackets and nested splices are handled] - -- A splice inside brackets -tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) splice_name expr res_ty - = do { res_ty <- expTypeToType res_ty - ; let rep = getRuntimeRep res_ty - ; meta_exp_ty <- tcTExpTy m_var res_ty - ; expr' <- setStage pop_stage $ - setConstraintVar lie_var $ - tcCheckMonoExpr expr meta_exp_ty - ; untype_code <- tcLookupId unTypeCodeName - ; let expr'' = mkHsApp - (mkLHsWrap (applyQuoteWrapper q) - (nlHsTyApp untype_code [rep, res_ty])) expr' - ; ps <- readMutVar ps_var - ; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps) - - -- The returned expression is ignored; it's in the pending splices - ; return stubNestedSplice } - -tcNestedSplice _ _ splice_name _ _ - = pprPanic "tcNestedSplice: rename stage found" (ppr splice_name) - - ------------------- -- This is called in the zonker -- See Note [Running typed splices in the zonker] runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc) @@ -942,7 +1034,7 @@ -- See Note [Collecting modFinalizers in typed splices]. ; modfinalizers_ref <- newTcRef [] -- Run the expression - ; expr2 <- setStage (RunSplice modfinalizers_ref) $ + ; expr2 <- setThLevel (RunSplice modfinalizers_ref) $ runMetaE zonked_q_expr ; mod_finalizers <- readTcRef modfinalizers_ref ; addModFinalizersWithLclEnv $ ThModFinalizers mod_finalizers @@ -958,7 +1050,7 @@ -- These steps should never fail; this is a *typed* splice ; (res, wcs) <- captureConstraints $ - addErrCtxt (spliceResultDoc zonked_q_expr) $ do + addErrCtxt (TypedSpliceResultCtxt zonked_q_expr) $ do { (exp3, _fvs) <- rnLExpr expr2 ; tcCheckMonoExpr exp3 zonked_ty } ; ev <- simplifyTop wcs @@ -974,17 +1066,6 @@ ************************************************************************ -} -typedSpliceCtxtDoc :: SplicePointName -> LHsExpr GhcRn -> SDoc -typedSpliceCtxtDoc n splice - = hang (text "In the Template Haskell splice") - 2 (pprTypedSplice (Just n) splice) - -spliceResultDoc :: LHsExpr GhcTc -> SDoc -spliceResultDoc expr - = sep [ text "In the result of the splice:" - , nest 2 (text "$$" <> ppr expr) - , text "To see what the splice expanded to, use -ddump-splices"] - stubNestedSplice :: HsExpr GhcTc -- Used when we need a (LHsExpr GhcTc) that we are never going -- to look at. We could use "panic" but that's confusing if we ever @@ -1021,7 +1102,7 @@ ; let loc' = noAnnSrcSpan loc ; let specialised_to_annotation_wrapper_expr = L loc' (mkHsWrap wrapper - (HsVar noExtField (L (noAnnSrcSpan loc) to_annotation_wrapper_id))) + (mkHsVar (L (noAnnSrcSpan loc) to_annotation_wrapper_id))) ; return (L loc' (HsApp noExtField specialised_to_annotation_wrapper_expr expr')) }) @@ -1053,11 +1134,7 @@ -- annotation are exposed at this point. This is also why we are -- doing all this stuff inside the context of runMeta: it has the -- facilities to deal with user error in a meta-level expression - seqSerialized serialized `seq` serialized - --- | Force the contents of the Serialized value so weknow it doesn't contain any bottoms -seqSerialized :: Serialized -> () -seqSerialized (Serialized the_type bytes) = the_type `seq` bytes `seqList` () + rnf serialized `seq` serialized #endif @@ -1101,16 +1178,17 @@ runQResult :: (a -> String) - -> (Origin -> SrcSpan -> a -> b) + -> (EnumSet LangExt.Extension -> Origin -> SrcSpan -> a -> b) -> (ForeignHValue -> TcM a) -> SrcSpan -> ForeignHValue {- TH.Q a -} -> TcM b runQResult show_th f runQ expr_span hval - = do { th_result <- runQ hval + = do { exts <- fmap extensionFlags getDynFlags + ; th_result <- runQ hval ; th_origin <- getThSpliceOrigin ; traceTc "Got TH result:" (text (show_th th_result)) - ; return (f th_origin expr_span th_result) } + ; return (f exts th_origin expr_span th_result) } ----------------- @@ -1209,8 +1287,6 @@ -> TcM hs_syn -- Of type t runMeta' show_code ppr_hs run_and_convert expr = do { traceTc "About to run" (ppr expr) - ; recordThSpliceUse -- seems to be the best place to do this, - -- we catch all kinds of splices and annotations. -- Check that we've had no errors of any sort so far. -- For example, if we found an error in an earlier defn f, but @@ -1455,9 +1531,10 @@ liftIO $ newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession suffix qAddTopDecls thds = do + exts <- fmap extensionFlags getDynFlags l <- getSrcSpanM th_origin <- getThSpliceOrigin - let either_hval = convertToHsDecls th_origin l thds + let either_hval = convertToHsDecls exts th_origin l thds ds <- case either_hval of Left exn -> failWithTc $ TcRnTHError $ AddTopDeclsError $ AddTopDeclsRunSpliceFailure exn @@ -1668,15 +1745,15 @@ -- | Adds a mod finalizer reference to the local environment. addModFinalizerRef :: ForeignRef (TH.Q ()) -> TcM () addModFinalizerRef finRef = do - th_stage <- getStage - case th_stage of + th_lvl <- getThLevel + case th_lvl of RunSplice th_modfinalizers_var -> updTcRef th_modfinalizers_var (finRef :) -- This case happens only if a splice is executed and the caller does - -- not set the 'ThStage' to 'RunSplice' to collect finalizers. + -- not set the 'ThLevel' to 'RunSplice' to collect finalizers. -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. _ -> pprPanic "addModFinalizer was called when no finalizers were collected" - (ppr th_stage) + (ppr th_lvl) -- | Releases the external interpreter state. finishTH :: TcM () @@ -1898,11 +1975,11 @@ -- ^ Returns 'Left' in the case that the instances were found to -- be class instances, or 'Right' if they are family instances. reifyInstances' th_nm th_tys - = addErrCtxt (text "In the argument of reifyInstances:" - <+> ppr_th th_nm <+> sep (map ppr_th th_tys)) $ - do { loc <- getSrcSpanM + = addErrCtxt (ReifyInstancesCtxt th_nm th_tys) $ + do { exts <- fmap extensionFlags getDynFlags + ; loc <- getSrcSpanM ; th_origin <- getThSpliceOrigin - ; rdr_ty <- cvt th_origin loc (mkThAppTs (TH.ConT th_nm) th_tys) + ; rdr_ty <- cvt exts th_origin loc (mkThAppTs (TH.ConT th_nm) th_tys) -- #9262 says to bring vars into scope, like in HsForAllTy case -- of rnHsTyKi ; tv_rdrs <- filterInScopeM $ extractHsTyRdrTyVars rdr_ty @@ -1946,11 +2023,11 @@ ; return $ Right (tc, map fim_instance matches) } _ -> bale_out $ TcRnTHError $ THReifyError $ CannotReifyInstance ty } where - doc = ClassInstanceCtx + doc = ReifyInstancesCtx bale_out msg = failWithTc msg - cvt :: Origin -> SrcSpan -> TH.Type -> TcM (LHsType GhcPs) - cvt origin loc th_ty = case convertToHsType origin loc th_ty of + cvt :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> TH.Type -> TcM (LHsType GhcPs) + cvt exts origin loc th_ty = case convertToHsType exts origin loc th_ty of Left msg -> failWithTc (TcRnTHError $ THSpliceFailed $ RunSpliceFailure msg) Right ty -> return ty @@ -2030,7 +2107,8 @@ lookupThName_maybe :: TH.Name -> TcM (Maybe Name) lookupThName_maybe th_name - = do { let guesses = thRdrNameGuesses th_name + = do { listTuplePuns <- xoptM LangExt.ListTuplePuns + ; let guesses = thRdrNameGuesses listTuplePuns th_name ; case guesses of { [for_sure] -> lookupSameOccRn_maybe for_sure ; _ -> @@ -2293,13 +2371,21 @@ ret_con | null ex_tvs' && null theta' = return main_con | otherwise = do { cxt <- reifyCxt theta' - ; ex_tvs'' <- reifyTyVarBndrs ex_tvs' + ; ex_tvs'' <- case to_invis_bndrs ex_tvs' of + Nothing -> noTH DataConVisibleForall (dataConDisplayType False dc) + Just tvs -> reifyTyVarBndrs tvs ; return (TH.ForallC ex_tvs'' cxt main_con) } ; assert (r_arg_tys `equalLength` dcdBangs) ret_con } where - mk_specified tv = Bndr tv SpecifiedSpec + mk_specified tv = Bndr tv Specified + to_invis_bndrs :: [TyVarBinder] -> Maybe [InvisTVBinder] + to_invis_bndrs = traverse $ \(Bndr tv vis) -> + case vis of + Invisible spec -> Just (Bndr tv spec) + Required -> Nothing + subst_tv_binders subst tv_bndrs = let tvs = binderVars tv_bndrs flags = binderFlags tv_bndrs @@ -2840,7 +2926,7 @@ reifySourceBang :: DataCon.HsSrcBang -> (TH.SourceUnpackedness, TH.SourceStrictness) -reifySourceBang (HsSrcBang _ (HsBang u s)) = (reifyUnpackedness u, reifyStrictness s) +reifySourceBang (HsSrcBang _ u s) = (reifyUnpackedness u, reifyStrictness s) reifyDecidedStrictness :: DataCon.HsImplBang -> TH.DecidedStrictness reifyDecidedStrictness HsLazy = TH.DecidedLazy @@ -2898,26 +2984,19 @@ reifyFromIface reifMod = do iface <- loadInterfaceForModule (text "reifying module from TH for" <+> ppr reifMod) reifMod - let usages = [modToTHMod m | usage <- mi_usages iface, - Just m <- [usageToModule (moduleUnit reifMod) usage] ] + let IfaceTopEnv _ imports = mi_top_env iface + -- Convert IfaceImport to module names + usages = [modToTHMod (ifImpModule imp) | imp <- imports] return $ TH.ModuleInfo usages - usageToModule :: Unit -> Usage -> Maybe Module - usageToModule _ (UsageFile {}) = Nothing - usageToModule this_pkg (UsageHomeModule { usg_mod_name = mn }) = Just $ mkModule this_pkg mn - usageToModule _ (UsagePackageModule { usg_mod = m }) = Just m - usageToModule _ (UsageMergedRequirement { usg_mod = m }) = Just m - usageToModule this_pkg (UsageHomeModuleInterface { usg_mod_name = mn }) = Just $ mkModule this_pkg mn + ------------------------------ mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type mkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys noTH :: UnrepresentableTypeDescr -> Type -> TcM a noTH s d = failWithTc $ TcRnTHError $ THReifyError $ CannotRepresentType s d - -ppr_th :: TH.Ppr a => a -> SDoc -ppr_th x = text (TH.pprint x) tcGetInterp :: TcM Interp tcGetInterp = do diff --git a/GHC/Tc/Gen/Splice.hs-boot b/GHC/Tc/Gen/Splice.hs-boot --- a/GHC/Tc/Gen/Splice.hs-boot +++ b/GHC/Tc/Gen/Splice.hs-boot @@ -10,11 +10,11 @@ import GHC.Types.Annotations ( Annotation, CoreAnnTarget ) import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc ) -import GHC.Hs ( HsQuote, HsExpr, LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers, HsUntypedSpliceResult ) +import GHC.Hs ( HsQuote, HsExpr, LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers, HsUntypedSpliceResult, HsTypedSpliceResult, HsTypedSplice ) import qualified GHC.Boot.TH.Syntax as TH -tcTypedSplice :: Name - -> LHsExpr GhcRn +tcTypedSplice :: HsTypedSpliceResult + -> HsTypedSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) diff --git a/GHC/Tc/Instance/Class.hs b/GHC/Tc/Instance/Class.hs --- a/GHC/Tc/Instance/Class.hs +++ b/GHC/Tc/Instance/Class.hs @@ -1,19 +1,17 @@ {-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module GHC.Tc.Instance.Class ( matchGlobalInst, matchEqualityInst, ClsInstResult(..), InstanceWhat(..), safeOverlap, instanceReturnsDictCon, - AssocInstInfo(..), isNotAssociated + AssocInstInfo(..), isNotAssociated, + lookupHasFieldLabel ) where import GHC.Prelude import GHC.Driver.DynFlags -import GHC.Core.TyCo.Rep - import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -21,8 +19,10 @@ import GHC.Tc.Instance.Typeable import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence -import GHC.Tc.Types.Origin (InstanceWhat (..), SafeOverlapping) -import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst ) +import GHC.Tc.Types.CtLoc +import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) ) +import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs ) + import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) import GHC.Builtin.Types @@ -32,13 +32,15 @@ import GHC.Builtin.PrimOps.Ids ( primOpId ) import GHC.Types.FieldLabel -import GHC.Types.Name.Reader import GHC.Types.SafeHaskell import GHC.Types.Name ( Name ) +import GHC.Types.Name.Reader import GHC.Types.Var.Env ( VarEnv ) import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.Var +import GHC.Core.TyCo.Rep import GHC.Core.Predicate import GHC.Core.Coercion import GHC.Core.InstEnv @@ -47,9 +49,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class -import GHC.Core.Utils( mkCast ) - -import GHC.Core ( Expr(..) ) +import GHC.Core ( Expr(..), mkConApp ) import GHC.StgToCmm.Closure ( isSmallFamily ) @@ -63,11 +63,8 @@ import GHC.Hs.Extension import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import GHC.Types.Id.Info import GHC.Tc.Errors.Types -import Control.Monad -import Data.Functor import Data.Maybe {- ******************************************************************* @@ -138,11 +135,12 @@ matchGlobalInst :: DynFlags -> Bool -- True <=> caller is the short-cut solver -- See Note [Shortcut solving: overlap] - -> Class -> [Type] -> TcM ClsInstResult + -> Class -> [Type] -> Maybe CtLoc + -> TcM ClsInstResult -- Precondition: Class does not satisfy GHC.Core.Predicate.isEqualityClass -- (That is handled by a separate code path: see GHC.Tc.Solver.Dict.solveDict, -- which calls solveEqualityDict for equality classes.) -matchGlobalInst dflags short_cut clas tys +matchGlobalInst dflags short_cut clas tys mb_loc | cls_name == knownNatClassName = matchKnownNat dflags short_cut clas tys | cls_name == knownSymbolClassName = matchKnownSymbol dflags short_cut clas tys | cls_name == knownCharClassName = matchKnownChar dflags short_cut clas tys @@ -150,12 +148,16 @@ | cls_name == typeableClassName = matchTypeable clas tys | cls_name == withDictClassName = matchWithDict tys | cls_name == dataToTagClassName = matchDataToTag clas tys - | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys - | cls_name == unsatisfiableClassName = return NoInstance -- See (B) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors + | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys mb_loc + | cls_name == unsatisfiableClassName = matchUnsatisfiable | otherwise = matchInstEnv dflags short_cut clas tys where cls_name = className clas +matchUnsatisfiable :: TcM ClsInstResult +-- See (B) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors +matchUnsatisfiable + = return NoInstance {- ******************************************************************** * * @@ -224,7 +226,6 @@ , iw_safe_over = so , iw_warn = warn } } } - {- Note [Shortcut solving: overlap] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have @@ -255,13 +256,10 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys - , cir_mk_ev = tuple_ev + , cir_mk_ev = evDictApp clas tys , cir_canonical = EvCanonical , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! - where - data_con = tyConSingleDataCon (classTyCon clas) - tuple_ev = evDFunApp (dataConWrapId data_con) tys {- ******************************************************************** * * @@ -408,26 +406,26 @@ -- The process is mirrored for Symbols: -- String -> SSymbol n -- SSymbol n -> KnownSymbol n -makeLitDict clas ty et - | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty] - -- co_dict :: KnownNat n ~ SNat n - , [ meth ] <- classMethods clas - , Just tcRep <- tyConAppTyCon_maybe (classMethodTy meth) - -- If the method type is forall n. KnownNat n => SNat n - -- then tcRep is SNat - , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty] - -- SNat n ~ Integer - , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) - = return $ OneInst { cir_new_theta = [] - , cir_mk_ev = \_ -> ev_tm - , cir_canonical = EvCanonical - , cir_what = BuiltinInstance } +makeLitDict clas lit_ty lit_expr + | [meth] <- classMethods clas + , Just rep_tc <- tyConAppTyCon_maybe (classMethodTy meth) + -- If the method type is forall n. KnownNat n => SNat n + -- then rep_tc :: TyCon is SNat + , [rep_con] <- tyConDataCons rep_tc + = do { let mk_ev _ = evDictApp clas [lit_ty] $ + [mkConApp rep_con [Type lit_ty, lit_expr]] + ; return $ OneInst { cir_new_theta = [] + , cir_mk_ev = mk_ev + , cir_canonical = EvCanonical + , cir_what = BuiltinInstance } } - | otherwise - = pprPanic "makeLitDict" $ - text "Unexpected evidence for" <+> ppr (className clas) - $$ vcat (map (ppr . idType) (classMethods clas)) + | otherwise + = pprPanic "makeLitDict" $ + text "Unexpected evidence for" <+> ppr (className clas) + $$ vcat (map (ppr . idType) (classMethods clas)) + + {- ******************************************************************** * * Class lookup for WithDict @@ -436,38 +434,33 @@ -- See Note [withDict] matchWithDict :: [Type] -> TcM ClsInstResult -matchWithDict [cls, mty] - -- Check that cls is a class constraint `C t_1 ... t_n`, where +matchWithDict [cls_ty, mty] + -- Check that cls_ty is a class constraint `C t_1 ... t_n`, where -- `dict_tc = C` and `dict_args = t_1 ... t_n`. - | Just (dict_tc, dict_args) <- tcSplitTyConApp_maybe cls + | Just (dict_tc, dict_args) <- tcSplitTyConApp_maybe cls_ty -- Check that C is a class of the form -- `class C a_1 ... a_n where op :: meth_ty` - -- and in that case let - -- co :: C t1 ..tn ~R# inst_meth_ty - , Just (inst_meth_ty, co) <- tcInstNewTyCon_maybe dict_tc dict_args + , Just (cls, dict_dc) <- isUnaryClassTyCon_maybe dict_tc + , [inst_meth_ty] <- dataConInstArgTys dict_dc dict_args = do { sv <- mkSysLocalM (fsLit "withDict_s") ManyTy mty - ; k <- mkSysLocalM (fsLit "withDict_k") ManyTy (mkInvisFunTy cls openAlphaTy) + ; k <- mkSysLocalM (fsLit "withDict_k") ManyTy (mkInvisFunTy cls_ty openAlphaTy) + ; wd_cls <- tcLookupClass withDictClassName - -- Given co2 : mty ~N# inst_meth_ty, construct the method of + -- Given ev_expr : mty ~N# inst_meth_ty, construct the method of -- the WithDict dictionary: -- -- \@(r :: RuntimeRep) @(a :: TYPE r) (sv :: mty) (k :: cls => a) -> - -- k (sv |> (sub co ; sym co2)) - ; let evWithDict co2 = - mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $ - Var k - `App` - (Var sv `mkCast` mkTransCo (mkSubCo co2) (mkSymCo co)) + -- k (MkC tys (sv |> sub co2)) + ; let evWithDict ev_expr + = mkCoreLams [ runtimeRep1TyVar, openAlphaTyVar, sv, k ] $ + Var k `App` (evUnaryDictAppE cls dict_args meth_arg) + where + meth_arg = Var sv `Cast` mkSubCo (evExprCoercion ev_expr) - ; tc <- tcLookupTyCon withDictClassName - ; let Just withdict_data_con - = tyConSingleDataCon_maybe tc -- "Data constructor" - -- for WithDict - mk_ev [c] = evDataConApp withdict_data_con - [cls, mty] [evWithDict (evTermCoercion (EvExpr c))] + ; let mk_ev [c] = evDictApp wd_cls [cls_ty, mty] [evWithDict c] mk_ev e = pprPanic "matchWithDict" (ppr e) - ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] + ; return $ OneInst { cir_new_theta = [mkNomEqPred mty (scaledThing inst_meth_ty)] , cir_mk_ev = mk_ev , cir_canonical = EvNonCanonical -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } @@ -520,11 +513,11 @@ instance (mty ~# inst_meth_ty) => WithDict (C t1..tn) mty where withDict = \@{rr} @(r :: TYPE rr) (sv :: mty) (k :: C t1..tn => r) -> - k (sv |> (sub co2 ; sym co)) + k (MkC (sv |> sub co))) That is, it matches on the first (constraint) argument of C; if C is a single-method class, the instance "fires" and emits an equality -constraint `mty ~ inst_meth_ty`, where `inst_meth_ty` is `meth_ty[ti/ai]`. +constraint `mty ~# inst_meth_ty`, where `inst_meth_ty` is `meth_ty[ti/ai]`. The coercion `co2` witnesses the equality `mty ~ inst_meth_ty`. The coercion `co` is a newtype coercion that coerces from `C t1 ... tn` @@ -617,11 +610,65 @@ overloaded function `f` (e.g. with a type such as `f :: Eq a => ...`). See test-case T21575b. +-} +{- ******************************************************************** +* * + Class lookup for DataToTag +* * +***********************************************************************-} -Note [DataToTag overview] -~~~~~~~~~~~~~~~~~~~~~~~~~ +matchDataToTag :: Class -> [Type] -> TcM ClsInstResult +-- See Note [DataToTag overview] +matchDataToTag dataToTagClass [levity, dty] = do + famEnvs <- tcGetFamInstEnvs + (gbl_env, _lcl_env) <- getEnvs + platform <- getPlatform + if | isConcreteType levity -- condition C3 + , Just (rawTyCon, rawTyConArgs) <- tcSplitTyConApp_maybe dty + , let (repTyCon, repArgs, repCo) + = tcLookupDataFamInst famEnvs rawTyCon rawTyConArgs + + -- Condition C1 + , Just constrs <- tyConDataCons_maybe repTyCon + , not (isTypeDataTyCon repTyCon || isNewTyCon repTyCon) + + -- Condition C2 + , let rdr_env = tcg_rdr_env gbl_env + inScope con = isJust $ lookupGRE_Name rdr_env $ dataConName con + , all inScope constrs + + , let repTy = mkTyConApp repTyCon repArgs + numConstrs = tyConFamilySize repTyCon + !whichOp -- see wrinkle DTW4 + | isSmallFamily platform numConstrs + = primOpId DataToTagSmallOp + | otherwise + = primOpId DataToTagLargeOp + + -- See wrinkle DTW1; we must apply the underlying + -- operation at the representation type and cast it + methodRep = Var whichOp `App` Type levity `App` Type repTy + methodCo = mkFunCo Representational + FTF_T_T + (mkNomReflCo ManyTy) + (mkSymCo repCo) + (mkReflCo Representational intPrimTy) + -> do { addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 + ; let mk_ev _ = evDictApp dataToTagClass [levity, dty] $ + [methodRep `Cast` methodCo] + ; pure (OneInst { cir_new_theta = [] -- (Ignore stupid theta.) + , cir_mk_ev = mk_ev + , cir_canonical = EvCanonical + , cir_what = BuiltinInstance })} + | otherwise -> pure NoInstance + +matchDataToTag _ _ = pure NoInstance + + +{- Note [DataToTag overview] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Class `DataToTag` is defined like this, in GHC.Magic: type DataToTag :: forall {lev :: Levity}. @@ -648,10 +695,11 @@ * a "data" declaration, * a "data instance" declaration, * a boxed tuple type - "type data" declarations are NOT included; see also wrinkle W2c - of Note [Type data declarations] in GHC.Rename.Module. - (In principle we could accept newtypes that wrap algebraic data - types, but we do not do so.) + But NOT + * A "type data" declaration; see also wrinkle W2c + of Note [Type data declarations] in GHC.Rename.Module. + * A newtype; in principle we could accept newtypes that wrap + an algebraic data type, but we do not do so. C2: All of the constructors of that "data" or "data instance" declaration are in scope. Otherwise, `dataToTag#` could be @@ -726,7 +774,7 @@ H3. Each evaluates its argument. But we want to omit this eval when the actual argument is already evaluated and properly tagged. To do this, - * We have a special case in GHC.Stg.InferTags.Rewrite.rewriteOpApp + * We have a special case in GHC.Stg.EnforceEpt.Rewrite.rewriteOpApp ensuring that any inferred tag information on the argument is retained until code generation. @@ -886,71 +934,12 @@ Today, that story is simple: A dataToTag primop always evaluates its argument, unless tag inference determines the argument was already evaluated and correctly tagged. Getting here was a long journey, with -many similarities to the story behind Note [Strict Field Invariant] in -GHC.Stg.InferTags. See also #15696. - +many similarities to the story behind Note [Evaluated and Properly Tagged] in +GHC.Stg.EnforceEpt. See also #15696. -} - {- ******************************************************************** * * - Class lookup for DataToTag -* * -***********************************************************************-} - -matchDataToTag :: Class -> [Type] -> TcM ClsInstResult --- See Note [DataToTag overview] -matchDataToTag dataToTagClass [levity, dty] = do - famEnvs <- tcGetFamInstEnvs - (gbl_env, _lcl_env) <- getEnvs - platform <- getPlatform - if | isConcreteType levity -- condition C3 - , Just (rawTyCon, rawTyConArgs) <- tcSplitTyConApp_maybe dty - , let (repTyCon, repArgs, repCo) - = tcLookupDataFamInst famEnvs rawTyCon rawTyConArgs - - , not (isTypeDataTyCon repTyCon) - , Just constrs <- tyConAlgDataCons_maybe repTyCon - -- condition C1 - - , let rdr_env = tcg_rdr_env gbl_env - inScope con = isJust $ lookupGRE_Name rdr_env $ dataConName con - , all inScope constrs -- condition C2 - - , let repTy = mkTyConApp repTyCon repArgs - numConstrs = tyConFamilySize repTyCon - !whichOp -- see wrinkle DTW4 - | isSmallFamily platform numConstrs - = primOpId DataToTagSmallOp - | otherwise - = primOpId DataToTagLargeOp - - -- See wrinkle DTW1; we must apply the underlying - -- operation at the representation type and cast it - methodRep = Var whichOp `App` Type levity `App` Type repTy - methodCo = mkFunCo Representational - FTF_T_T - (mkNomReflCo ManyTy) - (mkSymCo repCo) - (mkReflCo Representational intPrimTy) - dataToTagDataCon = tyConSingleDataCon (classTyCon dataToTagClass) - mk_ev _ = evDataConApp dataToTagDataCon - [levity, dty] - [methodRep `mkCast` methodCo] - -> addUsedDataCons rdr_env repTyCon -- See wrinkles DTW2 and DTW3 - $> OneInst { cir_new_theta = [] -- (Ignore stupid theta.) - , cir_mk_ev = mk_ev - , cir_canonical = EvCanonical - , cir_what = BuiltinInstance - } - | otherwise -> pure NoInstance - -matchDataToTag _ _ = pure NoInstance - - - -{- ******************************************************************** -* * Class lookup for Typeable * * ***********************************************************************-} @@ -995,8 +984,8 @@ , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] - mk_ev [mult_ev, arg_ev, ret_ev] = evTypeable ty $ - EvTypeableTrFun (EvExpr mult_ev) (EvExpr arg_ev) (EvExpr ret_ev) + mk_ev [mult_ev, arg_ev, ret_ev] + = evTypeable ty $ EvTypeableTrFun (EvExpr mult_ev) (EvExpr arg_ev) (EvExpr ret_ev) mk_ev _ = panic "GHC.Tc.Instance.Class.doFunTy" @@ -1148,21 +1137,21 @@ ***********************************************************************-} -- See also Note [The equality types story] in GHC.Builtin.Types.Prim -matchEqualityInst :: Class -> [Type] -> (DataCon, Role, Type, Type) +matchEqualityInst :: Class -> [Type] -> (Role, Type, Type) -- Precondition: `cls` satisfies GHC.Core.Predicate.isEqualityClass -- See Note [Solving equality classes] in GHC.Tc.Solver.Dict matchEqualityInst cls args | cls `hasKey` eqTyConKey -- Solves (t1 ~ t2) , [_,t1,t2] <- args - = (eqDataCon, Nominal, t1, t2) + = (Nominal, t1, t2) | cls `hasKey` heqTyConKey -- Solves (t1 ~~ t2) , [_,_,t1,t2] <- args - = (heqDataCon, Nominal, t1, t2) + = (Nominal, t1, t2) | cls `hasKey` coercibleTyConKey -- Solves (Coercible t1 t2) , [_, t1, t2] <- args - = (coercibleDataCon, Representational, t1, t2) + = (Representational, t1, t2) | otherwise -- Does not satisfy the precondition = pprPanic "matchEqualityInst" (ppr (mkClassPred cls args)) @@ -1174,61 +1163,42 @@ * * ***********************************************************************-} -{- -Note [HasField instances] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have - - data T y = MkT { foo :: [y] } - -and `foo` is in scope. Then GHC will automatically solve a constraint like - - HasField "foo" (T Int) b - -by emitting a new wanted - - T alpha -> [alpha] ~# T Int -> b - -and building a HasField dictionary out of the selector function `foo`, -appropriately cast. - -The HasField class is defined (in GHC.Records) thus: +{- Note [HasField instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Recall that the HasField class is defined (in GHC.Records) thus: - type HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> Constraint + type HasField :: forall {k} {r_rep} {a_rep} . + k -> TYPE r_rep -> TYPE a_rep -> Constraint class HasField x r a | x r -> a where getField :: r -> a -Since this is a one-method class, it is represented as a newtype. -Hence we can solve `HasField "foo" (T Int) b` by taking an expression -of type `T Int -> b` and casting it using the newtype coercion. -Note that - - foo :: forall y . T y -> [y] - -so the expression we construct is - - foo @alpha |> co - -where +Suppose we have + data T y = MkT { foo :: [y] } +and `foo` is in scope, with type + foo :: forall y. T y -> [y] - co :: (T alpha -> [alpha]) ~# HasField "foo" (T Int) b +Then `matchHasField` implements the followind built-in magic to solve + [W] d : HasField "foo" (T rty) fty -is built from + * Check that `T` has a field `foo`, and get the selector Id, sel_id + This is done by `lookupHasFieldLabel` - co1 :: (T alpha -> [alpha]) ~# (T Int -> b) + * Instantiate sel_id's type, giving: T alpha -> [alpha] -which is the new wanted, and + * Generating a new Wanted + [W] co : (T alpha -> [alpha]) ~# (T rty -> fty) - co2 :: (T Int -> b) ~# HasField "foo" (T Int) b + * Solve the original Wanted via + d = MkHasField (sel_id @alpha |> co) -which can be derived from the newtype coercion. +Wrinkles: -If `foo` is not in scope, or has a higher-rank or existentially -quantified type, then the constraint is not solved automatically, but -may be solved by a user-supplied HasField instance. Similarly, if we -encounter a HasField constraint where the field is not a literal -string, or does not belong to the type, then we fall back on the -normal constraint solver behaviour. +(HF1) If `foo` is not in scope, or is "naughty" (has a higher-rank or + existentially quantified type), then the constraint is not solved + automatically, but may be solved by a user-supplied HasField instance. + Similarly, if we encounter a HasField constraint where the field is not a + literal string, or does not belong to the type, then we fall back on the + normal constraint solver behaviour. Note [Unused name reporting and HasField] @@ -1246,26 +1216,15 @@ -} -- See Note [HasField instances] -matchHasField :: DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult -matchHasField dflags short_cut clas tys +matchHasField :: DynFlags -> Bool -> Class -> [Type] + -> Maybe CtLoc -- Nothing used only during type validity checking + -> TcM ClsInstResult +matchHasField dflags short_cut clas tys mb_ct_loc = do { fam_inst_envs <- tcGetFamInstEnvs ; rdr_env <- getGlobalRdrEnv - ; case tys of - -- We are matching HasField {k} {r_rep} {a_rep} x r a... - [_k_ty, _r_rep, _a_rep, x_ty, r_ty, a_ty] - -- x should be a literal string - | Just x <- isStrLitTy x_ty - -- r should be an applied type constructor - , Just (tc, args) <- tcSplitTyConApp_maybe r_ty - -- use representation tycon (if data family); it has the fields - , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args) - -- x should be a field of r - , Just fl <- lookupTyConFieldLabel (FieldLabelString x) r_tc - -- the field selector should be in scope - , Just gre <- lookupGRE_FieldLabel rdr_env fl - - -> do { let name = flSelector fl - ; sel_id <- tcLookupId name + ; case lookupHasFieldLabel fam_inst_envs rdr_env tys of + Just (sel_name, gre, r_ty, a_ty) -> + do { sel_id <- tcLookupId sel_name ; (tv_prs, preds, sel_ty) <- tcInstType newMetaTyVars sel_id -- The first new wanted constraint equates the actual @@ -1273,37 +1232,93 @@ -- the HasField x r a dictionary. The preds will -- typically be empty, but if the datatype has a -- "stupid theta" then we have to include it here. - ; let theta = mkPrimEqPred sel_ty (mkVisFunTyMany r_ty a_ty) : preds + ; let tvs = mkTyVarTys (map snd tv_prs) + theta = mkNomEqPred sel_ty (mkVisFunTyMany r_ty a_ty) : preds -- Use the equality proof to cast the selector Id to - -- type (r -> a), then use the newtype coercion to cast - -- it to a HasField dictionary. - mk_ev (ev1:evs) = evSelector sel_id tvs evs `evCast` co - where - co = mkSubCo (evTermCoercion (EvExpr ev1)) - `mkTransCo` mkSymCo co2 + -- type (r -> a), then use evUnaryDictAppE to turn it + -- into a HasField dictionary. + mk_ev (ev1:evs) = EvExpr $ + evUnaryDictAppE clas tys $ + evCastE (evSelector sel_id tvs evs) + (mkSubCo (evExprCoercion ev1)) mk_ev [] = panic "matchHasField.mk_ev" - Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas) - tys + -- The selector must not be "naughty" (i.e. the field + -- cannot have an existentially quantified type), + -- and it must not be higher-rank. + ; if (isNaughtyRecordSelector sel_id) || not (isTauTy sel_ty) + then try_user_instances + else + do { case mb_ct_loc of + Nothing -> return () -- Nothing: happens when type-validity checking + Just loc -> setCtLocM loc $ -- Set location for warnings + do { -- See Note [Unused name reporting and HasField] + addUsedGRE AllDeprecationWarnings gre + ; keepAlive sel_name - tvs = mkTyVarTys (map snd tv_prs) + -- Warn about incomplete record selection + ; warnIncompleteRecSel dflags sel_id loc } - -- The selector must not be "naughty" (i.e. the field - -- cannot have an existentially quantified type), and - -- it must not be higher-rank. - ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty - then do { -- See Note [Unused name reporting and HasField] - addUsedGRE AllDeprecationWarnings gre - ; keepAlive name - ; unless (null $ snd $ sel_cons $ idDetails sel_id) - $ addDiagnostic $ TcRnHasFieldResolvedIncomplete name - -- Only emit an incomplete selector warning if it's an implicit instance - -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc - ; return OneInst { cir_new_theta = theta - , cir_mk_ev = mk_ev - , cir_canonical = EvCanonical - , cir_what = BuiltinInstance } } - else matchInstEnv dflags short_cut clas tys } + ; return OneInst { cir_new_theta = theta + , cir_mk_ev = mk_ev + , cir_canonical = EvCanonical + , cir_what = BuiltinInstance } } } - _ -> matchInstEnv dflags short_cut clas tys } + Nothing -> try_user_instances } + where + -- See (HF1) in Note [HasField instances] + try_user_instances = matchInstEnv dflags short_cut clas tys + +warnIncompleteRecSel :: DynFlags -> Id -> CtLoc -> TcM () +-- Warn about incomplete record selectors +-- See (IRS6) in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc +warnIncompleteRecSel dflags sel_id ct_loc + | not (isGetFieldOrigin (ctLocOrigin ct_loc)) + -- isGetFieldOrigin: see (IRS7) in + -- Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + , RecSelId { sel_cons = RSI { rsi_undef = fallible_cons } } <- idDetails sel_id + , not (null fallible_cons) + = addDiagnostic $ + TcRnHasFieldResolvedIncomplete (idName sel_id) fallible_cons maxCons + + | otherwise + = return () + where + maxCons = maxUncoveredPatterns dflags + + -- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin, + -- despite the expansion to (getField @"x" r) + isGetFieldOrigin (GetFieldOrigin {}) = True + isGetFieldOrigin _ = False + +lookupHasFieldLabel + :: FamInstEnvs -> GlobalRdrEnv -> [Type] + -> Maybe ( Name -- Name of the record selector + , GlobalRdrElt -- GRE for the selector + , Type -- Type of the record value + , Type ) -- Type of the field of the record +-- If possible, decompose application +-- (HasField @k @rrep @arep @"fld" @(T t1..tn) @fld-ty), +-- or (getField @k @rrep @arep @"fld" @(T t1..tn) @fld-ty) +-- and return the pieces, if the record selector is in scope +-- +-- A complication is that `T` might be a data family, so we need to +-- look it up in the `fam_envs` to find its representation tycon. +lookupHasFieldLabel fam_inst_envs rdr_env arg_tys + | -- We are matching HasField {k} {r_rep} {a_rep} x r a... + (_k : _rec_rep : _fld_rep : x_ty : rec_ty : fld_ty : _) <- arg_tys + -- x should be a literal string + , Just x <- isStrLitTy x_ty + -- r should be an applied type constructor + , Just (tc, args) <- tcSplitTyConApp_maybe rec_ty + -- Use the representation tycon (if data family); it has the fields + , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args) + -- x should be a field of r + , Just fl <- lookupTyConFieldLabel (FieldLabelString x) r_tc + -- Ensure the field selector is in scope + , Just gre <- lookupGRE_FieldLabel rdr_env fl + = Just (flSelector fl, gre, rec_ty, fld_ty) + + | otherwise + = Nothing diff --git a/GHC/Tc/Instance/Family.hs b/GHC/Tc/Instance/Family.hs --- a/GHC/Tc/Instance/Family.hs +++ b/GHC/Tc/Instance/Family.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE GADTs, ViewPatterns #-} +{-# LANGUAGE GADTs, ViewPatterns, LambdaCase #-} -- | The @FamInst@ type: family instance heads module GHC.Tc.Instance.Family ( FamInstEnvs, tcGetFamInstEnvs, checkFamInstConsistency, tcExtendLocalFamInstEnv, tcLookupDataFamInst, tcLookupDataFamInst_maybe, - tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe, + tcTopNormaliseNewTypeTF_maybe, -- * Injectivity reportInjectivityErrors, reportConflictingInjectivityErrs @@ -34,9 +34,7 @@ import GHC.Unit.External import GHC.Unit.Module import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModDetails import GHC.Unit.Module.Deps -import GHC.Unit.Home.ModInfo import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Name.Reader @@ -57,8 +55,8 @@ import Data.Function ( on ) import qualified GHC.LanguageExtensions as LangExt -import GHC.Unit.Env (unitEnv_hpts) import Data.List (sortOn) +import qualified GHC.Unit.Home.Graph as HUG {- Note [The type family instance consistency story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -294,47 +292,44 @@ ; traceTc "checkFamInstConsistency" (ppr directlyImpMods) ; let { -- Fetch the iface of a given module. Must succeed as -- all directly imported modules must already have been loaded. - modIface mod = - case lookupIfaceByModule hug (eps_PIT eps) mod of + modIface mod = liftIO $ + lookupIfaceByModule hug (eps_PIT eps) mod >>= \case Nothing -> panicDoc "FamInst.checkFamInstConsistency" - (ppr mod $$ ppr hug) - Just iface -> iface + (ppr mod $$ ppr (HUG.allUnits hug)) + Just iface -> pure iface -- Which family instance modules were checked for consistency -- when we compiled `mod`? -- Itself (if a family instance module) and its dep_finsts. -- This is df(D_i) from -- Note [Checking family instance optimization] - ; modConsistent :: Module -> [Module] - ; modConsistent mod = - if mi_finsts (mi_final_exts (modIface mod)) then mod:deps else deps - where - deps = dep_finsts . mi_deps . modIface $ mod + ; modConsistent :: Module -> TcM [Module] + ; modConsistent mod = do + ifc <- modIface mod + deps <- dep_finsts . mi_deps <$> modIface mod + pure $ + if mi_finsts ifc + then mod:deps + else deps - ; debug_consistent_set = map (\x -> (x, length (modConsistent x))) directlyImpMods -- Sorting the list by size has the effect of performing a topological sort. -- See Note [Order of type family consistency checks] - ; init_consistent_set = reverse (sortOn (length . modConsistent) directlyImpMods) - - ; hmiModule = mi_module . hm_iface - ; hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv - . md_fam_insts . hm_details - ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi) - | hpt <- unitEnv_hpts hug - , hmi <- eltsHpt hpt ] - } + ; hpt_fam_insts <- liftIO $ HUG.allFamInstances hug + ; debug_consistent_set <- mapM (\x -> (\y -> (x, length y)) <$> modConsistent x) directlyImpMods ; traceTc "init_consistent_set" (ppr debug_consistent_set) + ; let init_consistent_set = map fst (reverse (sortOn snd debug_consistent_set)) ; checkMany hpt_fam_insts modConsistent init_consistent_set + } where -- See Note [Checking family instance optimization] checkMany - :: ModuleEnv FamInstEnv -- home package family instances - -> (Module -> [Module]) -- given A, modules checked when A was checked - -> [Module] -- modules to process + :: ModuleEnv FamInstEnv -- home package family instances + -> (Module -> TcM [Module]) -- given A, modules checked when A was checked + -> [Module] -- modules to process -> TcM () checkMany hpt_fam_insts modConsistent mods = go [] emptyModuleSet mods where @@ -345,6 +340,36 @@ -> TcM () go _ _ [] = return () go consistent consistent_set (mod:mods) = do + mod_deps_consistent <- modConsistent mod + let + mod_deps_consistent_set = mkModuleSet mod_deps_consistent + consistent' = to_check_from_mod ++ consistent + consistent_set' = + extendModuleSetList consistent_set to_check_from_mod + to_check_from_consistent = + filterOut (`elemModuleSet` mod_deps_consistent_set) consistent + to_check_from_mod = + filterOut (`elemModuleSet` consistent_set) mod_deps_consistent + -- Why don't we just minusModuleSet here (above)? + -- We could, but doing so means one of two things: + -- + -- 1. When looping over the cartesian product we convert + -- a set into a non-deterministically ordered list. Which + -- happens to be fine for interface file determinism + -- in this case, today, because the order only + -- determines the order of deferred checks. But such + -- invariants are hard to keep. + -- + -- 2. When looping over the cartesian product we convert + -- a set into a deterministically ordered list - this + -- adds some additional cost of sorting for every + -- direct import. + -- + -- That also explains why we need to keep both 'consistent' + -- and 'consistentSet'. + -- + -- See also Note [ModuleEnv performance and determinism]. + traceTc "checkManySize" (vcat [text "mod:" <+> ppr mod , text "m1:" <+> ppr (length to_check_from_mod) , text "m2:" <+> ppr (length (to_check_from_consistent)) @@ -358,35 +383,6 @@ , m2 <- to_check_from_consistent ] go consistent' consistent_set' mods - where - mod_deps_consistent = modConsistent mod - mod_deps_consistent_set = mkModuleSet mod_deps_consistent - consistent' = to_check_from_mod ++ consistent - consistent_set' = - extendModuleSetList consistent_set to_check_from_mod - to_check_from_consistent = - filterOut (`elemModuleSet` mod_deps_consistent_set) consistent - to_check_from_mod = - filterOut (`elemModuleSet` consistent_set) mod_deps_consistent - -- Why don't we just minusModuleSet here? - -- We could, but doing so means one of two things: - -- - -- 1. When looping over the cartesian product we convert - -- a set into a non-deterministically ordered list. Which - -- happens to be fine for interface file determinism - -- in this case, today, because the order only - -- determines the order of deferred checks. But such - -- invariants are hard to keep. - -- - -- 2. When looping over the cartesian product we convert - -- a set into a deterministically ordered list - this - -- adds some additional cost of sorting for every - -- direct import. - -- - -- That also explains why we need to keep both 'consistent' - -- and 'consistentSet'. - -- - -- See also Note [ModuleEnv performance and determinism]. check hpt_fam_insts m1 m2 = do { env1' <- getFamInsts hpt_fam_insts m1 ; env2' <- getFamInsts hpt_fam_insts m2 @@ -410,7 +406,7 @@ | Just env <- lookupModuleEnv hpt_fam_insts mod = return env | otherwise = do { _ <- initIfaceTcRn (loadSysInterface doc mod) ; eps <- getEps - ; return (expectJust "checkFamInstConsistency" $ + ; return (expectJust $ lookupModuleEnv (eps_mod_fam_inst_env eps) mod) } where doc = ppr mod <+> text "is a family-instance module" @@ -423,15 +419,6 @@ ************************************************************************ -} - --- | If @co :: T ts ~ rep_ty@ then: --- --- > instNewTyCon_maybe T ts = Just (rep_ty, co) --- --- Checks for a newtype, and for being saturated --- Just like Coercion.instNewTyCon_maybe, but returns a TcCoercion -tcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion) -tcInstNewTyCon_maybe = instNewTyCon_maybe -- | Like 'tcLookupDataFamInst_maybe', but returns the arguments back if -- there is no data family to unwrap. diff --git a/GHC/Tc/Instance/FunDeps.hs b/GHC/Tc/Instance/FunDeps.hs --- a/GHC/Tc/Instance/FunDeps.hs +++ b/GHC/Tc/Instance/FunDeps.hs @@ -578,11 +578,22 @@ = case classifyPredType pred of EqPred NomEq t1 t2 -> [([t1],[t2]), ([t2],[t1])] -- See Note [Equality superclasses] - ClassPred cls tys -> [ instFD fd cls_tvs tys - | let (cls_tvs, cls_fds) = classTvsFds cls - , fd <- cls_fds ] + + ClassPred cls tys | not (isIPClass cls) + -- isIPClass: see Note [closeWrtFunDeps ignores implicit parameters] + -> [ instFD fd cls_tvs tys + | let (cls_tvs, cls_fds) = classTvsFds cls + , fd <- cls_fds ] _ -> [] +{- Note [closeWrtFunDeps ignores implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Implicit params don't really determine a type variable (that is, we might have +IP "c" Bool and IP "c" Int in different places within the same program), and +skipping this causes implicit params to monomorphise too many variables; see +Note [Inheriting implicit parameters] in GHC.Tc.Solver. Skipping causes +typecheck/should_compile/tc219 to fail. +-} {- ********************************************************************* * * @@ -652,19 +663,19 @@ | instanceCantMatch trimmed_tcs rough_tcs2 = False | otherwise - = case tcUnifyTyKis bind_fn ltys1 ltys2 of + = case tcUnifyFunDeps qtvs ltys1 ltys2 of Nothing -> False Just subst -> isNothing $ -- Bogus legacy test (#10675) -- See Note [Bogus consistency check] - tcUnifyTyKis bind_fn (substTysUnchecked subst rtys1) (substTysUnchecked subst rtys2) + tcUnifyFunDeps qtvs (substTysUnchecked subst rtys1) (substTysUnchecked subst rtys2) where trimmed_tcs = trimRoughMatchTcs cls_tvs fd rough_tcs1 (ltys1, rtys1) = instFD fd cls_tvs tys1 (ltys2, rtys2) = instFD fd cls_tvs tys2 qtv_set2 = mkVarSet qtvs2 - bind_fn = matchBindFun (qtv_set1 `unionVarSet` qtv_set2) + qtvs = qtv_set1 `unionVarSet` qtv_set2 eq_inst i1 i2 = instanceDFunId i1 == instanceDFunId i2 -- A single instance may appear twice in the un-nubbed conflict list diff --git a/GHC/Tc/Instance/Typeable.hs b/GHC/Tc/Instance/Typeable.hs --- a/GHC/Tc/Instance/Typeable.hs +++ b/GHC/Tc/Instance/Typeable.hs @@ -221,18 +221,21 @@ , tycon_rep_id :: !Id } --- | A group of 'TyCon's in need of type-rep bindings. data TypeRepTodo - = TypeRepTodo - { mod_rep_expr :: LHsExpr GhcTc -- ^ Module's typerep binding - , pkg_fingerprint :: !Fingerprint -- ^ Package name fingerprint - , mod_fingerprint :: !Fingerprint -- ^ Module name fingerprint - , todo_tycons :: [TypeableTyCon] - -- ^ The 'TyCon's in need of bindings kinds - } - | ExportedKindRepsTodo [(Kind, Id)] + = TyConTodo TyConTodo + | ExportedKindRepsTodo [(Kind, Id)] -- ^ Build exported 'KindRep' bindings for the given set of kinds. + +-- | A group of 'TyCon's in need of type-rep bindings. +data TyConTodo + = TCTD { mod_rep_expr :: LHsExpr GhcTc -- ^ Module's typerep binding + , pkg_fingerprint :: !Fingerprint -- ^ Package name fingerprint + , mod_fingerprint :: !Fingerprint -- ^ Module name fingerprint + , todo_tycons :: [TypeableTyCon] + -- ^ The 'TyCon's in need of bindings kinds + } + todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo todoForTyCons mod mod_id tycons = do trTyConTy <- mkTyConTy <$> tcLookupTyCon trTyConTyConName @@ -255,11 +258,11 @@ , Just rep_name <- pure $ tyConRepName_maybe tc'' , tyConIsTypeable tc'' ] - return TypeRepTodo { mod_rep_expr = nlHsVar mod_id - , pkg_fingerprint = pkg_fpr - , mod_fingerprint = mod_fpr - , todo_tycons = typeable_tycons - } + return $ TyConTodo $ + TCTD { mod_rep_expr = nlHsVar mod_id + , pkg_fingerprint = pkg_fpr + , mod_fingerprint = mod_fpr + , todo_tycons = typeable_tycons } where mod_fpr = fingerprintString $ moduleNameString $ moduleName mod pkg_fpr = fingerprintString $ unitString $ moduleUnit mod @@ -283,8 +286,8 @@ -- TyCon associated with the applied type constructor). ; let produced_bndrs :: [Id] produced_bndrs = [ tycon_rep_id - | todo@(TypeRepTodo{}) <- todos - , TypeableTyCon {..} <- todo_tycons todo + | TyConTodo (TCTD { todo_tycons = tcs }) <- todos + , TypeableTyCon {..} <- tcs ] ++ [ rep_id | ExportedKindRepsTodo kinds <- todos @@ -293,8 +296,8 @@ ; gbl_env <- tcExtendGlobalValEnv produced_bndrs getGblEnv ; let mk_binds :: TypeRepTodo -> KindRepM [LHsBinds GhcTc] - mk_binds todo@(TypeRepTodo {}) = - mapM (mkTyConRepBinds stuff todo) (todo_tycons todo) + mk_binds (TyConTodo (todo@(TCTD { todo_tycons = tcs }))) = + mapM (mkTyConRepBinds stuff todo) tcs mk_binds (ExportedKindRepsTodo kinds) = mkExportedKindReps stuff kinds >> return [] @@ -413,7 +416,7 @@ return trNameLit -- | Make Typeable bindings for the given 'TyCon'. -mkTyConRepBinds :: TypeableStuff -> TypeRepTodo +mkTyConRepBinds :: TypeableStuff -> TyConTodo -> TypeableTyCon -> KindRepM (LHsBinds GhcTc) mkTyConRepBinds stuff todo (TypeableTyCon {..}) = do -- Make a KindRep @@ -649,7 +652,7 @@ = pprPanic "mkTyConKindRepBinds.go(coercion)" (ppr co) -- | Produce the right-hand-side of a @TyCon@ representation. -mkTyConRepTyConRHS :: TypeableStuff -> TypeRepTodo +mkTyConRepTyConRHS :: TypeableStuff -> TyConTodo -> TyCon -- ^ the 'TyCon' we are producing a binding for -> LHsExpr GhcTc -- ^ its 'KindRep' -> LHsExpr GhcTc diff --git a/GHC/Tc/Module.hs b/GHC/Tc/Module.hs --- a/GHC/Tc/Module.hs +++ b/GHC/Tc/Module.hs @@ -16,7 +16,8 @@ -- -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/type-checker module GHC.Tc.Module ( - tcRnStmt, tcRnExpr, TcRnExprMode(..), tcRnType, + tcRnStmt, tcRnExpr, TcRnExprMode(..), + tcRnType, tcRnTypeSkolemising, tcRnImportDecls, tcRnLookupRdrName, getModuleInterface, @@ -50,6 +51,7 @@ import GHC.Driver.Plugins import GHC.Driver.DynFlags import GHC.Driver.Config.Diagnostic +import GHC.IO.Unsafe ( unsafeInterleaveIO ) import GHC.Tc.Errors.Hole.Plugin ( HoleFitPluginR (..) ) import GHC.Tc.Errors.Types @@ -60,7 +62,6 @@ import GHC.Tc.Utils.Unify( checkConstraints, tcSubTypeSigma ) import GHC.Tc.Zonk.Type import GHC.Tc.Gen.Expr -import GHC.Tc.Gen.App( tcInferSigma ) import GHC.Tc.Utils.Monad import GHC.Tc.Gen.Export import GHC.Tc.Types.Evidence @@ -71,7 +72,7 @@ import GHC.Tc.Gen.Bind import GHC.Tc.Gen.Default import GHC.Tc.Utils.Env -import GHC.Tc.Gen.Rule +import GHC.Tc.Gen.Sig( tcRules ) import GHC.Tc.Gen.Foreign import GHC.Tc.TyCl.Instance import GHC.Tc.Utils.TcMType @@ -91,7 +92,7 @@ import GHC.Rename.Env import GHC.Rename.Module import GHC.Rename.Doc -import GHC.Rename.Utils ( mkNameClashErr ) +import GHC.Rename.Utils ( mkNameClashErr, mkRnSyntaxExpr ) import GHC.Iface.Decl ( coAxiomToIfaceDecl ) import GHC.Iface.Env ( externaliseName ) @@ -115,6 +116,7 @@ import GHC.Core.Coercion.Axiom import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.TyCo.Ppr( debugPprType ) +import GHC.Core.TyCo.Tidy( tidyTopType ) import GHC.Core.FamInstEnv ( FamInst, pprFamInst, famInstsRepTyCons, orphNamesOfFamInst , famInstEnvElts, extendFamInstEnvList, normaliseType ) @@ -148,9 +150,9 @@ import GHC.Types.Annotations import GHC.Types.SrcLoc import GHC.Types.SourceFile -import GHC.Types.PkgQual import qualified GHC.LanguageExtensions as LangExt +import GHC.Unit.Env as UnitEnv import GHC.Unit.External import GHC.Unit.Types import GHC.Unit.State @@ -161,6 +163,7 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModDetails import GHC.Unit.Module.Deps +import GHC.Driver.Downsweep import GHC.Data.FastString import GHC.Data.Maybe @@ -183,6 +186,7 @@ import qualified Data.Map as M import Data.Foldable ( for_ ) import Data.Traversable ( for ) +import Data.IORef( newIORef ) @@ -315,6 +319,9 @@ traceRn "rn1a" empty ; tcg_env <- case hsc_src of + -- See Note [Don't typecheck GHC.Internal.Prim] + _ | tcg_mod tcg_env1 == gHC_PRIM -> pure tcg_env1 + HsBootOrSig boot_or_sig -> do { tcg_env <- tcRnHsBootDecls boot_or_sig local_decls ; traceRn "rn4a: before exports" empty @@ -367,7 +374,16 @@ } } +{- Note [Don't typecheck GHC.Internal.Prim] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC (currently) can't type-check GHC.Internal.Prim, as that module +contains primitive functions that can't be defined in source Haskell. +The GHC.Internal.Prim source file is only used to generate Haddock documentation; +the actual contents of the module are wired in to GHC. +-} + {- Note [Disambiguation of multiple default declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See Note [Named default declarations] in GHC.Tc.Gen.Default @@ -447,7 +463,7 @@ tcRnImports :: HscEnv -> [(LImportDecl GhcPs, SDoc)] -> TcM ([NonEmpty ClassDefaults], TcGblEnv) tcRnImports hsc_env import_decls - = do { (rn_imports, imp_user_spec, rdr_env, imports, hpc_info) <- rnImports import_decls + = do { (rn_imports, imp_user_spec, rdr_env, imports) <- rnImports import_decls -- Get the default declarations for the classes imported by this module -- and group them by class. ; tc_defaults <-(NE.groupBy ((==) `on` cd_class) . (concatMap defaultList)) @@ -456,18 +472,21 @@ ; gbl_env <- getGblEnv ; let unitId = homeUnitId $ hsc_home_unit hsc_env mnwib = GWIB (moduleName this_mod)(hscSourceToIsBoot (tcg_src gbl_env)) - ; let { -- We want instance declarations from all home-package + ; -- We want instance declarations from all home-package -- modules below this one, including boot modules, except -- ourselves. The 'except ourselves' is so that we don't -- get the instances from this module's hs-boot file. This -- filtering also ensures that we don't see instances from -- modules batch (@--make@) compiled before this one, but -- which are not below this one. - ; (home_insts, home_fam_insts) = - - hptInstancesBelow hsc_env unitId mnwib + ; (home_insts, home_fam_insts) <- liftIO $ + hugInstancesBelow hsc_env unitId mnwib - } ; + -- We use 'unsafeInterleaveIO' to avoid redundant memory allocations + -- See Note [Lazily loading COMPLETE pragmas] from GHC.HsToCore.Monad + -- and see https://gitlab.haskell.org/ghc/ghc/-/merge_requests/14274#note_620545 + ; completeSigsBelow <- liftIO $ unsafeInterleaveIO $ + hugCompleteSigsBelow hsc_env unitId mnwib -- Record boot-file info in the EPS, so that it's -- visible to loadHiBootInterface in tcRnSrcDecls, @@ -481,13 +500,14 @@ gbl { tcg_rdr_env = tcg_rdr_env gbl `plusGlobalRdrEnv` rdr_env, tcg_imports = tcg_imports gbl `plusImportAvails` imports, + tcg_complete_match_env = tcg_complete_match_env gbl ++ + completeSigsBelow, tcg_import_decls = imp_user_spec, tcg_rn_imports = rn_imports, tcg_default = foldMap subsume tc_defaults, tcg_inst_env = tcg_inst_env gbl `unionInstEnv` home_insts, tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl) - home_fam_insts, - tcg_hpc = hpc_info + home_fam_insts }) $ do { ; traceRn "rn1" (ppr (imp_direct_dep_mods imports)) @@ -978,6 +998,11 @@ = do { traceTc "checkHiBootIface" $ vcat [ ppr boot_type_env, ppr boot_exports ] + ; mod <- tcg_mod <$> getGblEnv + + -- See Note [Don't typecheck GHC.Internal.Prim] + ; if mod == gHC_PRIM then pure [] else do { + ; gre_env <- getGlobalRdrEnv -- Check the exports of the boot module, one by one @@ -997,7 +1022,7 @@ ; failIfErrsM - ; return (fld_prs ++ dfun_prs) } + ; return (fld_prs ++ dfun_prs) }} where boot_dfun_names = map idName boot_dfuns @@ -1795,9 +1820,8 @@ -- -- But only after we've typechecked 'default' declarations. -- See Note [Typechecking default declarations] - defaults <- tcDefaults default_decls ; - updGblEnv (\gbl -> gbl { tcg_default = defaults }) $ do { - + defaults <- tcDefaultDecls default_decls + ; extendDefaultEnvWithLocalDefaults defaults $ do { -- Careful to quit now in case there were instance errors, so that -- the deriving errors don't pile up as well. @@ -1916,7 +1940,7 @@ { traceTc "checkMain found" (ppr main_name) ; (io_ty, res_ty) <- getIOType ; let loc = getSrcSpan main_name - main_expr_rn = L (noAnnSrcSpan loc) (HsVar noExtField (L (noAnnSrcSpan loc) main_name)) + main_expr_rn = L (noAnnSrcSpan loc) (mkHsVar (L (noAnnSrcSpan loc) main_name)) ; (ev_binds, main_expr) <- setMainCtxt main_name io_ty $ tcCheckMonoExpr main_expr_rn io_ty @@ -1955,13 +1979,11 @@ setMainCtxt :: Name -> TcType -> TcM a -> TcM (TcEvBinds, a) setMainCtxt main_name io_ty thing_inside = setSrcSpan (getSrcSpan main_name) $ - addErrCtxt main_ctxt $ + addErrCtxt (MainCtxt main_name) $ checkConstraints skol_info [] [] $ -- Builds an implication if necessary thing_inside -- e.g. with -fdefer-type-errors where skol_info = SigSkol (FunSigCtxt main_name NoRRC) io_ty [] - main_ctxt = text "When checking the type of the" - <+> ppMainFn (nameOccName main_name) {- Note [Dealing with main] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2055,7 +2077,26 @@ There is also some similar (probably dead) logic in GHC.Rename.Env which says it was added for External Core which faced a similar issue. +Note [runTcInteractive module graph] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The `withInteractiveModuleNode` function sets up the module graph which contains +the interactive module used by `runTcInteractive`. + +The module graph is essentially the ambient module graph which is set up when +ghci loads a module using `load`, with the addition of the interactive module (Ghci), +which imports the parts specified by the `InteractiveImports`. + +Therefore `downsweepInteractiveImports` presumes that any import which is +determined to be from the home module is already present in the module graph. +This saves resummarising and performing the whole downsweep again if it's already been +done. + +On the other hand, when GHCi starts up, and no modules have been loaded yet, the +module graph will be empty. Therefore `downsweepInteractiveImports` will perform +for the unit portion of the graph, if it's not already been performed. + + ********************************************************* * * GHCi stuff @@ -2063,12 +2104,20 @@ ********************************************************* -} +-- See Note [runTcInteractive module graph] +withInteractiveModuleNode :: HscEnv -> TcM a -> TcM a +withInteractiveModuleNode hsc_env thing_inside = do + mg <- liftIO $ downsweepInteractiveImports hsc_env (hsc_IC hsc_env) + updTopEnv (setModuleGraph mg) thing_inside + + runTcInteractive :: HscEnv -> TcRn a -> IO (Messages TcRnMessage, Maybe a) -- Initialise the tcg_inst_env with instances from all home modules. -- This mimics the more selective call to hptInstances in tcRnImports runTcInteractive hsc_env thing_inside = initTcInteractive hsc_env $ withTcPlugins hsc_env $ withDefaultingPlugins hsc_env $ withHoleFitPlugins hsc_env $ + withInteractiveModuleNode hsc_env $ do { traceTc "setInteractiveContext" $ vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt)) , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) (instEnvElts ic_insts)) @@ -2077,17 +2126,23 @@ , let local_gres = filter isLocalGRE gres , not (null local_gres) ]) ] - ; let getOrphans m mb_pkg = fmap (\iface -> mi_module iface - : dep_orphs (mi_deps iface)) - (loadSrcInterface (text "runTcInteractive") m - NotBoot mb_pkg) + ; let getOrphansForModuleName m mb_pkg = do + iface <- loadSrcInterface (text "runTcInteractive") m NotBoot mb_pkg + pure $ mi_module iface : dep_orphs (mi_deps iface) + getOrphansForModule m = do + iface <- loadModuleInterface (text "runTcInteractive") m + pure $ mi_module iface : dep_orphs (mi_deps iface) + ; !orphs <- fmap (force . concat) . forM (ic_imports icxt) $ \i -> case i of -- force above: see #15111 - IIModule n -> getOrphans n NoPkgQual - IIDecl i -> getOrphans (unLoc (ideclName i)) + IIModule n -> getOrphansForModule n + IIDecl i -> getOrphansForModuleName (unLoc (ideclName i)) (renameRawPkgQual (hsc_unit_env hsc_env) (unLoc $ ideclName i) (ideclPkgQual i)) + + ; (home_insts, home_fam_insts) <- liftIO $ UnitEnv.hugAllInstances (hsc_unit_env hsc_env) + ; let imports = emptyImportAvails { imp_orphs = orphs } upd_envs (gbl_env, lcl_env) = (gbl_env', lcl_env') @@ -2111,8 +2166,6 @@ ; updEnvs upd_envs thing_inside } where - (home_insts, home_fam_insts) = hptAllInstances hsc_env - icxt = hsc_IC hsc_env (ic_insts, ic_finsts) = ic_instances icxt (lcl_ids, top_ty_things) = partitionWith is_closed (ic_tythings icxt) @@ -2575,17 +2628,18 @@ failIfErrsM ; -- Typecheck the expression - ((tclvl, res_ty), lie) + ((tclvl, (_tc_expr, res_ty)), lie) <- captureTopConstraints $ pushTcLevelM $ - tcInferSigma inst rn_expr ; + (if inst then tcInferRho rn_expr + else tcInferSigma rn_expr); -- Generalise uniq <- newUnique ; let { fresh_it = itName uniq (getLocA rdr_expr) } ; ((qtvs, dicts, _, _), residual) <- captureConstraints $ - simplifyInfer tclvl infer_mode + simplifyInfer TopLevel tclvl infer_mode [] {- No sig vars -} [(fresh_it, res_ty)] lie ; @@ -2669,6 +2723,16 @@ where zap_rdr_env gbl_env = gbl_env { tcg_rdr_env = emptyGlobalRdrEnv } + +tcRnTypeSkolemising :: HscEnv + -> LHsType GhcPs + -> IO (Messages TcRnMessage, Maybe (Type, Kind)) +-- tcRnTypeSkolemising skolemisese any free unification variables, +-- and normalises the type +tcRnTypeSkolemising env ty + = do { skol_tv_ref <- liftIO (newIORef []) + ; tcRnType env (SkolemiseFlexi skol_tv_ref) True ty } + -- tcRnType just finds the kind of a type tcRnType :: HscEnv -> ZonkFlexi @@ -2857,7 +2921,7 @@ let rdr_names = dataTcOccs rdr_name ; names_s <- mapM lookupInfoOccRn rdr_names ; let names = concat names_s - ; when (null names) (addErrTc $ mkTcRnNotInScope rdr_name NotInScope) + ; when (null names) (addErrTc $ TcRnNotInScope NotInScope rdr_name) ; return names } tcRnLookupName :: HscEnv -> Name -> IO (Messages TcRnMessage, Maybe TyThing) diff --git a/GHC/Tc/Plugin.hs b/GHC/Tc/Plugin.hs --- a/GHC/Tc/Plugin.hs +++ b/GHC/Tc/Plugin.hs @@ -1,4 +1,3 @@ - -- | This module provides an interface for typechecker plugins to -- access select functions of the 'TcM', principally those to do with -- reading parts of the state. @@ -15,6 +14,7 @@ lookupOrig, -- * Looking up Names in the typechecking environment + lookupTHName, tcLookupGlobal, tcLookupTyCon, tcLookupDataCon, @@ -66,7 +66,7 @@ import GHC.Tc.Utils.Monad ( TcGblEnv, TcLclEnv, TcPluginM , unsafeTcPluginTcM , liftIO, traceTc ) -import GHC.Tc.Types.Constraint ( Ct, CtEvidence(..) ) +import GHC.Tc.Types.Constraint ( Ct, CtEvidence(..), GivenCtEvidence(..) ) import GHC.Tc.Types.CtLoc ( CtLoc ) import GHC.Tc.Utils.TcMType ( TcTyVar, TcType ) @@ -74,6 +74,7 @@ import GHC.Tc.Types.Evidence ( CoercionHole, EvTerm(..) , EvExpr, EvBindsVar, EvBind, mkGivenEvBind ) import GHC.Types.Var ( EvVar ) +import GHC.Plugins ( thNameToGhcNameIO ) import GHC.Unit.Module ( ModuleName, Module ) import GHC.Types.Name ( OccName, Name ) @@ -90,6 +91,7 @@ import GHC.Types.Unique ( Unique ) import GHC.Types.PkgQual ( PkgQual ) +import qualified GHC.Boot.TH.Syntax as TH -- | Perform some IO, typically to interact with an external tool. tcPluginIO :: IO a -> TcPluginM a @@ -99,7 +101,6 @@ tcPluginTrace :: String -> SDoc -> TcPluginM () tcPluginTrace a b = unsafeTcPluginTcM (traceTc a b) - findImportedModule :: ModuleName -> PkgQual -> TcPluginM Finder.FindResult findImportedModule mod_name mb_pkg = do hsc_env <- getTopEnv @@ -108,6 +109,13 @@ lookupOrig :: Module -> OccName -> TcPluginM Name lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod +-- | Resolve a @template-haskell@ 'TH.Name' to a GHC 'Name'. +-- +-- @since 9.14.1 +lookupTHName :: TH.Name -> TcPluginM (Maybe Name) +lookupTHName th = do + nc <- hsc_NC <$> getTopEnv + tcPluginIO $ thNameToGhcNameIO nc th tcLookupGlobal :: Name -> TcPluginM TyThing tcLookupGlobal = unsafeTcPluginTcM . TcM.tcLookupGlobal @@ -176,7 +184,8 @@ newGiven tc_evbinds loc pty evtm = do new_ev <- newEvVar pty setEvBind tc_evbinds $ mkGivenEvBind new_ev (EvExpr evtm) - return CtGiven { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc } + return $ CtGiven $ + GivenCt { ctev_pred = pty, ctev_evar = new_ev, ctev_loc = loc } -- | Create a fresh evidence variable. -- @@ -187,7 +196,7 @@ -- | Create a fresh coercion hole. -- This should only be invoked within 'tcPluginSolve'. newCoercionHole :: PredType -> TcPluginM CoercionHole -newCoercionHole = unsafeTcPluginTcM . TcM.newVanillaCoercionHole +newCoercionHole = unsafeTcPluginTcM . TcM.newCoercionHole -- | Bind an evidence variable. -- diff --git a/GHC/Tc/Solver.hs b/GHC/Tc/Solver.hs --- a/GHC/Tc/Solver.hs +++ b/GHC/Tc/Solver.hs @@ -13,4167 +13,2235 @@ tcCheckGivens, tcCheckWanteds, tcNormalise, - - captureTopConstraints, - - simplifyTopWanteds, - - promoteTyVarSet, simplifyAndEmitFlatConstraints, - - -- For Rules we need these - solveWanteds, - approximateWC - - ) where - -import GHC.Prelude - -import GHC.Tc.Errors -import GHC.Tc.Errors.Types -import GHC.Tc.Types.Evidence -import GHC.Tc.Solver.Solve ( solveSimpleGivens, solveSimpleWanteds ) -import GHC.Tc.Solver.Dict ( makeSuperClasses, solveCallStack ) -import GHC.Tc.Solver.Rewrite ( rewriteType ) -import GHC.Tc.Utils.Unify -import GHC.Tc.Utils.TcMType as TcM -import GHC.Tc.Utils.Monad as TcM -import GHC.Tc.Zonk.TcType as TcM -import GHC.Tc.Solver.InertSet -import GHC.Tc.Solver.Monad as TcS -import GHC.Tc.Types.Constraint -import GHC.Tc.Types.CtLoc( mkGivenLoc ) -import GHC.Tc.Instance.FunDeps -import GHC.Tc.Types.Origin -import GHC.Tc.Utils.TcType - -import GHC.Core.Class -import GHC.Core.Reduction( Reduction, reductionCoercion ) -import GHC.Core -import GHC.Core.DataCon -import GHC.Core.Make -import GHC.Core.Coercion( mkNomReflCo, isReflCo ) -import GHC.Core.Unify ( tcMatchTyKis ) -import GHC.Core.Predicate -import GHC.Core.Type -import GHC.Core.Ppr -import GHC.Core.TyCon ( TyConBinder, isTypeFamilyTyCon ) - -import GHC.Types.Name -import GHC.Types.DefaultEnv ( ClassDefaults (..), defaultList ) -import GHC.Types.Unique.Set -import GHC.Types.Id - -import GHC.Builtin.Utils -import GHC.Builtin.Names -import GHC.Builtin.Types - -import GHC.Types.TyThing ( MonadThings(lookupId) ) -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic -import GHC.Types.Id.Make ( unboxedUnitExpr ) -import GHC.Types.Error - -import GHC.Driver.DynFlags -import GHC.Unit.Module ( getModule ) - -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Outputable - -import GHC.Data.FastString -import GHC.Data.List.SetOps -import GHC.Data.Bag - -import qualified GHC.LanguageExtensions as LangExt - -import Control.Monad -import Control.Monad.Trans.Class ( lift ) -import Control.Monad.Trans.State.Strict ( StateT(runStateT), put ) -import Data.Foldable ( toList, traverse_ ) -import Data.List ( partition ) -import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) -import qualified Data.List.NonEmpty as NE -import GHC.Data.Maybe ( isJust, mapMaybe, catMaybes ) -import Data.Monoid ( First(..) ) - -{- -********************************************************************************* -* * -* External interface * -* * -********************************************************************************* --} - -captureTopConstraints :: TcM a -> TcM (a, WantedConstraints) --- (captureTopConstraints m) runs m, and returns the type constraints it --- generates plus the constraints produced by static forms inside. --- If it fails with an exception, it reports any insolubles --- (out of scope variables) before doing so --- --- captureTopConstraints is used exclusively by GHC.Tc.Module at the top --- level of a module. --- --- Importantly, if captureTopConstraints propagates an exception, it --- reports any insoluble constraints first, lest they be lost --- altogether. This is important, because solveEqualities (maybe --- other things too) throws an exception without adding any error --- messages; it just puts the unsolved constraints back into the --- monad. See GHC.Tc.Utils.Monad Note [Constraints and errors] --- #16376 is an example of what goes wrong if you don't do this. --- --- NB: the caller should bring any environments into scope before --- calling this, so that the reportUnsolved has access to the most --- complete GlobalRdrEnv -captureTopConstraints thing_inside - = do { static_wc_var <- TcM.newTcRef emptyWC ; - ; (mb_res, lie) <- TcM.updGblEnv (\env -> env { tcg_static_wc = static_wc_var } ) $ - TcM.tryCaptureConstraints thing_inside - ; stWC <- TcM.readTcRef static_wc_var - - -- See GHC.Tc.Utils.Monad Note [Constraints and errors] - -- If the thing_inside threw an exception, but generated some insoluble - -- constraints, report the latter before propagating the exception - -- Otherwise they will be lost altogether - ; case mb_res of - Just res -> return (res, lie `andWC` stWC) - Nothing -> do { _ <- simplifyTop lie; failM } } - -- This call to simplifyTop is the reason - -- this function is here instead of GHC.Tc.Utils.Monad - -- We call simplifyTop so that it does defaulting - -- (esp of runtime-reps) before reporting errors - -simplifyTopImplic :: Bag Implication -> TcM () -simplifyTopImplic implics - = do { empty_binds <- simplifyTop (mkImplicWC implics) - - -- Since all the inputs are implications the returned bindings will be empty - ; massertPpr (isEmptyBag empty_binds) (ppr empty_binds) - - ; return () } - -simplifyTop :: WantedConstraints -> TcM (Bag EvBind) --- Simplify top-level constraints --- Usually these will be implications, --- but when there is nothing to quantify we don't wrap --- in a degenerate implication, so we do that here instead -simplifyTop wanteds - = do { traceTc "simplifyTop {" $ text "wanted = " <+> ppr wanteds - ; ((final_wc, unsafe_ol), binds1) <- runTcS $ - do { final_wc <- simplifyTopWanteds wanteds - ; unsafe_ol <- getSafeOverlapFailures - ; return (final_wc, unsafe_ol) } - ; traceTc "End simplifyTop }" empty - - ; binds2 <- reportUnsolved final_wc - - ; traceTc "reportUnsolved (unsafe overlapping) {" empty - ; unless (isEmptyBag unsafe_ol) $ do { - -- grab current error messages and clear, warnAllUnsolved will - -- update error messages which we'll grab and then restore saved - -- messages. - ; errs_var <- getErrsVar - ; saved_msg <- TcM.readTcRef errs_var - ; TcM.writeTcRef errs_var emptyMessages - - ; warnAllUnsolved $ emptyWC { wc_simple = fmap CDictCan unsafe_ol } - - ; whyUnsafe <- getWarningMessages <$> TcM.readTcRef errs_var - ; TcM.writeTcRef errs_var saved_msg - ; recordUnsafeInfer (mkMessages whyUnsafe) - } - ; traceTc "reportUnsolved (unsafe overlapping) }" empty - - ; return (evBindMapBinds binds1 `unionBags` binds2) } - -pushLevelAndSolveEqualities :: SkolemInfoAnon -> [TyConBinder] -> TcM a -> TcM a --- Push level, and solve all resulting equalities --- If there are any unsolved equalities, report them --- and fail (in the monad) --- --- Panics if we solve any non-equality constraints. (In runTCSEqualities --- we use an error thunk for the evidence bindings.) -pushLevelAndSolveEqualities skol_info_anon tcbs thing_inside - = do { (tclvl, wanted, res) <- pushLevelAndSolveEqualitiesX - "pushLevelAndSolveEqualities" thing_inside - ; report_unsolved_equalities skol_info_anon (binderVars tcbs) tclvl wanted - ; return res } - -pushLevelAndSolveEqualitiesX :: String -> TcM a - -> TcM (TcLevel, WantedConstraints, a) --- Push the level, gather equality constraints, and then solve them. --- Returns any remaining unsolved equalities. --- Does not report errors. --- --- Panics if we solve any non-equality constraints. (In runTCSEqualities --- we use an error thunk for the evidence bindings.) -pushLevelAndSolveEqualitiesX callsite thing_inside - = do { traceTc "pushLevelAndSolveEqualitiesX {" (text "Called from" <+> text callsite) - ; (tclvl, (wanted, res)) - <- pushTcLevelM $ - do { (res, wanted) <- captureConstraints thing_inside - ; wanted <- runTcSEqualities (simplifyTopWanteds wanted) - ; return (wanted,res) } - ; traceTc "pushLevelAndSolveEqualities }" (vcat [ text "Residual:" <+> ppr wanted - , text "Level:" <+> ppr tclvl ]) - ; return (tclvl, wanted, res) } - --- | Type-check a thing that emits only equality constraints, solving any --- constraints we can and re-emitting constraints that we can't. --- Use this variant only when we'll get another crack at it later --- See Note [Failure in local type signatures] --- --- Panics if we solve any non-equality constraints. (In runTCSEqualities --- we use an error thunk for the evidence bindings.) -solveEqualities :: String -> TcM a -> TcM a -solveEqualities callsite thing_inside - = do { traceTc "solveEqualities {" (text "Called from" <+> text callsite) - ; (res, wanted) <- captureConstraints thing_inside - ; simplifyAndEmitFlatConstraints wanted - -- simplifyAndEmitFlatConstraints fails outright unless - -- the only unsolved constraints are soluble-looking - -- equalities that can float out - ; traceTc "solveEqualities }" empty - ; return res } - -simplifyAndEmitFlatConstraints :: WantedConstraints -> TcM () --- See Note [Failure in local type signatures] -simplifyAndEmitFlatConstraints wanted - = do { -- Solve and zonk to establish the - -- preconditions for floatKindEqualities - wanted <- runTcSEqualities (solveWanteds wanted) - ; wanted <- TcM.liftZonkM $ TcM.zonkWC wanted - - ; traceTc "emitFlatConstraints {" (ppr wanted) - ; case floatKindEqualities wanted of - Nothing -> do { traceTc "emitFlatConstraints } failing" (ppr wanted) - -- Emit the bad constraints, wrapped in an implication - -- See Note [Wrapping failing kind equalities] - ; tclvl <- TcM.getTcLevel - ; implic <- buildTvImplication unkSkolAnon [] (pushTcLevel tclvl) wanted - -- ^^^^^^ | ^^^^^^^^^^^^^^^^^ - -- it's OK to use unkSkol | we must increase the TcLevel, - -- because we don't bind | as explained in - -- any skolem variables here | Note [Wrapping failing kind equalities] - ; emitImplication implic - ; failM } - Just (simples, errs) - -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples) - ; traceTc "emitFlatConstraints }" $ - vcat [ text "simples:" <+> ppr simples - , text "errs: " <+> ppr errs ] - -- Holes and other delayed errors don't need promotion - ; emitDelayedErrors errs - ; emitSimples simples } } - -floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag DelayedError) --- Float out all the constraints from the WantedConstraints, --- Return Nothing if any constraints can't be floated (captured --- by skolems), or if there is an insoluble constraint, or --- IC_Telescope telescope error --- Precondition 1: we have tried to solve the 'wanteds', both so that --- the ic_status field is set, and because solving can make constraints --- more floatable. --- Precondition 2: the 'wanteds' are zonked, since floatKindEqualities --- is not monadic --- See Note [floatKindEqualities vs approximateWC] -floatKindEqualities wc = float_wc emptyVarSet wc - where - float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag DelayedError) - float_wc trapping_tvs (WC { wc_simple = simples - , wc_impl = implics - , wc_errors = errs }) - | all is_floatable simples - = do { (inner_simples, inner_errs) - <- flatMapBagPairM (float_implic trapping_tvs) implics - ; return ( simples `unionBags` inner_simples - , errs `unionBags` inner_errs) } - | otherwise - = Nothing - where - is_floatable ct - | insolubleCt ct = False - | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs - - float_implic :: TcTyCoVarSet -> Implication -> Maybe (Bag Ct, Bag DelayedError) - float_implic trapping_tvs (Implic { ic_wanted = wanted, ic_given_eqs = given_eqs - , ic_skols = skols, ic_status = status }) - | isInsolubleStatus status - = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope - | otherwise - = do { (simples, holes) <- float_wc new_trapping_tvs wanted - ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ - Nothing - -- If there are some constraints to float out, but we can't - -- because we don't float out past local equalities - -- (c.f GHC.Tc.Solver.approximateWC), then fail - ; return (simples, holes) } - where - new_trapping_tvs = trapping_tvs `extendVarSetList` skols - - -{- Note [Failure in local type signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When kind checking a type signature, we like to fail fast if we can't -solve all the kind equality constraints, for two reasons: - - * A kind-bogus type signature may cause a cascade of knock-on - errors if we let it pass - - * More seriously, we don't have a convenient term-level place to add - deferred bindings for unsolved kind-equality constraints. In - earlier GHCs this led to un-filled-in coercion holes, which caused - GHC to crash with "fvProv falls into a hole" See #11563, #11520, - #11516, #11399 - -But what about /local/ type signatures, mentioning in-scope type -variables for which there might be 'given' equalities? For these we -might not be able to solve all the equalities locally. Here's an -example (T15076b): - - class (a ~ b) => C a b - data SameKind :: k -> k -> Type where { SK :: SameKind a b } - - bar :: forall (a :: Type) (b :: Type). - C a b => Proxy a -> Proxy b -> () - bar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y) - -Consider the type signature on 'undefined'. It's ill-kinded unless -a~b. But the superclass of (C a b) means that indeed (a~b). So all -should be well. BUT it's hard to see that when kind-checking the signature -for undefined. We want to emit a residual (a~b) constraint, to solve -later. - -Another possibility is that we might have something like - F alpha ~ [Int] -where alpha is bound further out, which might become soluble -"later" when we learn more about alpha. So we want to emit -those residual constraints. - -BUT it's no good simply wrapping all unsolved constraints from -a type signature in an implication constraint to solve later. The -problem is that we are going to /use/ that signature, including -instantiate it. Say we have - f :: forall a. (forall b. blah) -> blah2 - f x = -To typecheck the definition of f, we have to instantiate those -foralls. Moreover, any unsolved kind equalities will be coercion -holes in the type. If we naively wrap them in an implication like - forall a. (co1:k1~k2, forall b. co2:k3~k4) -hoping to solve it later, we might end up filling in the holes -co1 and co2 with coercions involving 'a' and 'b' -- but by now -we've instantiated the type. Chaos! - -Moreover, the unsolved constraints might be skolem-escape things, and -if we proceed with f bound to a nonsensical type, we get a cascade of -follow-up errors. For example polykinds/T12593, T15577, and many others. - -So here's the plan (see tcHsSigType): - -* pushLevelAndSolveEqualitiesX: try to solve the constraints - -* kindGeneraliseSome: do kind generalisation - -* buildTvImplication: build an implication for the residual, unsolved - constraint - -* simplifyAndEmitFlatConstraints: try to float out every unsolved equality - inside that implication, in the hope that it constrains only global - type variables, not the locally-quantified ones. - - * If we fail, or find an insoluble constraint, emit the implication, - so that the errors will be reported, and fail. - - * If we succeed in floating all the equalities, promote them and - re-emit them as flat constraint, not wrapped at all (since they - don't mention any of the quantified variables. - -* Note that this float-and-promote step means that anonymous - wildcards get floated to top level, as we want; see - Note [Checking partial type signatures] in GHC.Tc.Gen.HsType. - -All this is done: - -* In GHC.Tc.Gen.HsType.tcHsSigType, as above - -* solveEqualities. Use this when there no kind-generalisation - step to complicate matters; then we don't need to push levels, - and can solve the equalities immediately without needing to - wrap it in an implication constraint. (You'll generally see - a kindGeneraliseNone nearby.) - -* In GHC.Tc.TyCl and GHC.Tc.TyCl.Instance; see calls to - pushLevelAndSolveEqualitiesX, followed by quantification, and - then reportUnsolvedEqualities. - - NB: we call reportUnsolvedEqualities before zonkTcTypeToType - because the latter does not expect to see any un-filled-in - coercions, which will happen if we have unsolved equalities. - By calling reportUnsolvedEqualities first, which fails after - reporting errors, we avoid that happening. - -See also #18062, #11506 - -Note [Wrapping failing kind equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In simplifyAndEmitFlatConstraints, if we fail to get down to simple -flat constraints we will -* re-emit the constraints so that they are reported -* fail in the monad -But there is a Terrible Danger that, if -fdefer-type-errors is on, and -we just re-emit an insoluble constraint like (* ~ (*->*)), that we'll -report only a warning and proceed with compilation. But if we ever fail -in the monad it should be fatal; we should report an error and stop after -the type checker. If not, chaos results: #19142. - -Our solution is this: -* Even with -fdefer-type-errors, inside an implication with no place for - value bindings (ic_binds = CoEvBindsVar), report failing equalities as - errors. We have to do this anyway; see GHC.Tc.Errors - Note [Failing equalities with no evidence bindings]. - -* Right here in simplifyAndEmitFlatConstraints, use buildTvImplication - to wrap the failing constraint in a degenerate implication (no - skolems, no theta), with ic_binds = CoEvBindsVar. This setting of - `ic_binds` means that any failing equalities will lead to an - error not a warning, irrespective of -fdefer-type-errors: see - Note [Failing equalities with no evidence bindings] in GHC.Tc.Errors, - and `maybeSwitchOffDefer` in that module. - - We still take care to bump the TcLevel of the implication. Partly, - that ensures that nested implications have increasing level numbers - which seems nice. But more specifically, suppose the outer level - has a Given `(C ty)`, which has pending (not-yet-expanded) - superclasses. Consider what happens when we process this implication - constraint (which we have re-emitted) in that context: - - in the inner implication we'll call `getPendingGivenScs`, - - we /do not/ want to get the `(C ty)` from the outer level, - lest we try to add an evidence term for the superclass, - which we can't do because we have specifically set - `ic_binds` = `CoEvBindsVar`. - - as `getPendingGivenSCcs is careful to only get Givens from - the /current/ level, and we bumped the `TcLevel` of the implication, - we're OK. - - TL;DR: bump the `TcLevel` when creating the nested implication. - If we don't we get a panic in `GHC.Tc.Utils.Monad.addTcEvBind` (#20043). - - -We re-emit the implication rather than reporting the errors right now, -so that the error messages are improved by other solving and defaulting. -e.g. we prefer - Cannot match 'Type->Type' with 'Type' -to Cannot match 'Type->Type' with 'TYPE r0' - - -Note [floatKindEqualities vs approximateWC] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -floatKindEqualities and approximateWC are strikingly similar to each -other, but - -* floatKindEqualites tries to float /all/ equalities, and fails if - it can't, or if any implication is insoluble. -* approximateWC just floats out any constraints - (not just equalities) that can float; it never fails. --} - - -reportUnsolvedEqualities :: SkolemInfo -> [TcTyVar] -> TcLevel - -> WantedConstraints -> TcM () --- Reports all unsolved wanteds provided; fails in the monad if there are any. --- --- The provided SkolemInfo and [TcTyVar] arguments are used in an implication to --- provide skolem info for any errors. -reportUnsolvedEqualities skol_info skol_tvs tclvl wanted - = report_unsolved_equalities (getSkolemInfo skol_info) skol_tvs tclvl wanted - -report_unsolved_equalities :: SkolemInfoAnon -> [TcTyVar] -> TcLevel - -> WantedConstraints -> TcM () -report_unsolved_equalities skol_info_anon skol_tvs tclvl wanted - | isEmptyWC wanted - = return () - - | otherwise -- NB: we build an implication /even if skol_tvs is empty/, - -- just to ensure that our level invariants hold, specifically - -- (WantedInv). See Note [TcLevel invariants]. - = checkNoErrs $ -- Fail - do { implic <- buildTvImplication skol_info_anon skol_tvs tclvl wanted - ; reportAllUnsolved (mkImplicWC (unitBag implic)) } - - --- | Simplify top-level constraints, but without reporting any unsolved --- constraints nor unsafe overlapping. -simplifyTopWanteds :: WantedConstraints -> TcS WantedConstraints -simplifyTopWanteds wanteds - = do { -- Solve the constraints - wc_first_go <- nestTcS (solveWanteds wanteds) - - -- Now try defaulting: - -- see Note [Top-level Defaulting Plan] - ; tryDefaulting wc_first_go } - --------------------------- -tryDefaulting :: WantedConstraints -> TcS WantedConstraints -tryDefaulting wc - = do { dflags <- getDynFlags - ; traceTcS "tryDefaulting:before" (ppr wc) - ; wc1 <- tryTyVarDefaulting dflags wc - ; wc2 <- tryConstraintDefaulting wc1 - ; wc3 <- tryTypeClassDefaulting wc2 - ; wc4 <- tryUnsatisfiableGivens wc3 - ; traceTcS "tryDefaulting:after" (ppr wc4) - ; return wc4 } - -solveAgainIf :: Bool -> WantedConstraints -> TcS WantedConstraints --- If the Bool is true, solve the wanted constraints again --- See Note [Must simplify after defaulting] -solveAgainIf False wc = return wc -solveAgainIf True wc = nestTcS (solveWanteds wc) - --------------------------- -tryTyVarDefaulting :: DynFlags -> WantedConstraints -> TcS WantedConstraints -tryTyVarDefaulting dflags wc - | isEmptyWC wc - = return wc - | insolubleWC wc - , gopt Opt_PrintExplicitRuntimeReps dflags -- See Note [Defaulting insolubles] - = return wc - | otherwise - = do { -- Need to zonk first, as the WantedConstraints are not yet zonked. - ; free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc) - ; let defaultable_tvs = filter can_default free_tvs - can_default tv - = isTyVar tv - -- Weed out coercion variables. - - && isMetaTyVar tv - -- Weed out runtime-skolems in GHCi, which we definitely - -- shouldn't try to default. - - && not (tv `elemVarSet` nonDefaultableTyVarsOfWC wc) - -- Weed out variables for which defaulting would be unhelpful, - -- e.g. alpha appearing in [W] alpha[conc] ~# rr[sk]. - - ; unification_s <- mapM defaultTyVarTcS defaultable_tvs -- Has unification side effects - ; solveAgainIf (or unification_s) wc } - -- solveAgainIf: see Note [Must simplify after defaulting] - ----------------------------- --- | If an implication contains a Given of the form @Unsatisfiable msg@, --- use it to solve all Wanteds within the implication. --- See point (C) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors. --- --- This does a complete walk over the implication tree. -tryUnsatisfiableGivens :: WantedConstraints -> TcS WantedConstraints -tryUnsatisfiableGivens wc = - do { (final_wc, did_work) <- (`runStateT` False) $ go_wc wc - ; solveAgainIf did_work final_wc } - where - go_wc (WC { wc_simple = wtds, wc_impl = impls, wc_errors = errs }) - = do impls' <- mapMaybeBagM go_impl impls - return $ WC { wc_simple = wtds, wc_impl = impls', wc_errors = errs } - go_impl impl - | isSolvedStatus (ic_status impl) - = return $ Just impl - -- Is there a Given with type "Unsatisfiable msg"? - -- If so, use it to solve all other Wanteds. - | unsat_given:_ <- mapMaybe unsatisfiableEv_maybe (ic_given impl) - = do { put True - ; lift $ solveImplicationUsingUnsatGiven unsat_given impl } - -- Otherwise, recurse. - | otherwise - = do { wcs' <- go_wc (ic_wanted impl) - ; lift $ setImplicationStatus $ impl { ic_wanted = wcs' } } - --- | Is this evidence variable the evidence for an 'Unsatisfiable' constraint? --- --- If so, return the variable itself together with the error message type. -unsatisfiableEv_maybe :: EvVar -> Maybe (EvVar, Type) -unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v) - --- | We have an implication with an 'Unsatisfiable' Given; use that Given to --- solve all the other Wanted constraints, including those nested within --- deeper implications. -solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS (Maybe Implication) -solveImplicationUsingUnsatGiven - unsat_given@(given_ev,_) - impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var, ic_need_inner = inner }) - | isCoEvBindsVar ev_binds_var - -- We can't use Unsatisfiable evidence in kinds. - -- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence. - = return $ Just impl - | otherwise - = do { wcs <- nestImplicTcS ev_binds_var tclvl $ go_wc wtd - ; setImplicationStatus $ - impl { ic_wanted = wcs - , ic_need_inner = inner `extendVarSet` given_ev } } - where - go_wc :: WantedConstraints -> TcS WantedConstraints - go_wc wc@(WC { wc_simple = wtds, wc_impl = impls }) - = do { mapBagM_ go_simple wtds - ; impls <- mapMaybeBagM (solveImplicationUsingUnsatGiven unsat_given) impls - ; return $ wc { wc_simple = emptyBag, wc_impl = impls } } - go_simple :: Ct -> TcS () - go_simple ct = case ctEvidence ct of - CtWanted { ctev_pred = pty, ctev_dest = dst } - -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst EvNonCanonical $ EvExpr ev_expr } - _ -> return () - --- | Create an evidence expression for an arbitrary constraint using --- evidence for an "Unsatisfiable" Given. --- --- See Note [Evidence terms from Unsatisfiable Givens] -unsatisfiableEvExpr :: (EvVar, ErrorMsgType) -> PredType -> TcS EvExpr -unsatisfiableEvExpr (unsat_ev, given_msg) wtd_ty - = do { mod <- getModule - -- If we're typechecking GHC.TypeError, return a bogus expression; - -- it's only used for the ambiguity check, which throws the evidence away anyway. - -- This avoids problems with circularity; where we are trying to look - -- up the "unsatisfiable" Id while we are in the middle of typechecking it. - ; if mod == gHC_INTERNAL_TYPEERROR then return (Var unsat_ev) else - do { unsatisfiable_id <- tcLookupId unsatisfiableIdName - - -- See Note [Evidence terms from Unsatisfiable Givens] - -- for a description of what evidence term we are constructing here. - - ; let -- (##) -=> wtd_ty - fun_ty = mkFunTy visArgConstraintLike ManyTy unboxedUnitTy wtd_ty - mkDictBox = case boxingDataCon fun_ty of - BI_Box { bi_data_con = mkDictBox } -> mkDictBox - _ -> pprPanic "unsatisfiableEvExpr: no DictBox!" (ppr wtd_ty) - dictBox = dataConTyCon mkDictBox - ; ev_bndr <- mkSysLocalM (fsLit "ct") ManyTy fun_ty - -- Dict ((##) -=> wtd_ty) - ; let scrut_ty = mkTyConApp dictBox [fun_ty] - -- unsatisfiable @{LiftedRep} @given_msg @(Dict ((##) -=> wtd_ty)) unsat_ev - scrut = - mkCoreApps (Var unsatisfiable_id) - [ Type liftedRepTy - , Type given_msg - , Type scrut_ty - , Var unsat_ev ] - -- case scrut of { MkDictBox @((##) -=> wtd_ty)) ct -> ct (# #) } - ev_expr = - mkWildCase scrut (unrestricted $ scrut_ty) wtd_ty - [ Alt (DataAlt mkDictBox) [ev_bndr] $ - mkCoreApps (Var ev_bndr) [unboxedUnitExpr] - ] - ; return ev_expr } } - -{- Note [Evidence terms from Unsatisfiable Givens] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -An Unsatisfiable Given constraint, of the form [G] Unsatisfiable msg, should be -able to solve ANY Wanted constraint whatsoever. - -Recall that we have - - unsatisfiable :: forall {rep} (msg :: ErrorMessage) (a :: TYPE rep) - . Unsatisfiable msg => a - -We want to use this function, together with the evidence -[G] unsat_ev :: Unsatisfiable msg, to solve any other constraint [W] wtd_ty. - -We could naively think that a valid evidence term for the Wanted might be: - - wanted_ev = unsatisfiable @{rep} @msg @wtd_ty unsat_ev - -Unfortunately, this is a kind error: "wtd_ty :: CONSTRAINT rep", but -"unsatisfiable" expects the third type argument to be of kind "TYPE rep". - -Instead, we use a boxing data constructor to box the constraint into a type. -In the end, we construct the following evidence for the implication: - - [G] unsat_ev :: Unsatisfiable msg - ==> - [W] wtd_ev :: wtd_ty - - wtd_ev = - case unsatisfiable @{LiftedRep} @msg @(Dict ((##) -=> wtd_ty)) unsat_ev of - MkDictBox ct -> ct (# #) - -Note that we play the same trick with the function arrow -=> that we did -in order to define "unsatisfiable" in terms of "unsatisfiableLifted", as described -in Note [The Unsatisfiable representation-polymorphism trick] in base:GHC.TypeError. -This allows us to indirectly box constraints with different representations -(such as primitive equality constraints). --} - --- | A 'TcS' action which can may solve a `Ct` -type CtDefaultingStrategy = Ct -> TcS Bool - -- True <=> I solved the constraint - --------------------------------- -tryConstraintDefaulting :: WantedConstraints -> TcS WantedConstraints --- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -tryConstraintDefaulting wc - | isEmptyWC wc - = return wc - | otherwise - = do { (n_unifs, better_wc) <- reportUnifications (go_wc wc) - -- We may have done unifications; so solve again - ; solveAgainIf (n_unifs > 0) better_wc } - where - go_wc :: WantedConstraints -> TcS WantedConstraints - go_wc wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { mb_simples <- mapMaybeBagM go_simple simples - ; mb_implics <- mapMaybeBagM go_implic implics - ; return (wc { wc_simple = mb_simples, wc_impl = mb_implics }) } - - go_simple :: Ct -> TcS (Maybe Ct) - go_simple ct = do { solved <- tryCtDefaultingStrategy ct - ; if solved then return Nothing - else return (Just ct) } - - go_implic :: Implication -> TcS (Maybe Implication) - -- The Maybe is because solving the CallStack constraint - -- may well allow us to discard the implication entirely - go_implic implic - | isSolvedStatus (ic_status implic) - = return (Just implic) -- Nothing to solve inside here - | otherwise - = do { wanteds <- setEvBindsTcS (ic_binds implic) $ - -- defaultCallStack sets a binding, so - -- we must set the correct binding group - go_wc (ic_wanted implic) - ; setImplicationStatus (implic { ic_wanted = wanteds }) } - -tryCtDefaultingStrategy :: CtDefaultingStrategy --- The composition of all the CtDefaultingStrategies we want -tryCtDefaultingStrategy - = foldr1 combineStrategies - [ defaultCallStack - , defaultExceptionContext - , defaultEquality ] - --- | Default @ExceptionContext@ constraints to @emptyExceptionContext@. -defaultExceptionContext :: CtDefaultingStrategy -defaultExceptionContext ct - | ClassPred cls tys <- classifyPredType (ctPred ct) - , isJust (isExceptionContextPred cls tys) - = do { warnTcS $ TcRnDefaultedExceptionContext (ctLoc ct) - ; empty_ec_id <- lookupId emptyExceptionContextName - ; let ev = ctEvidence ct - ev_tm = mkEvCast (Var empty_ec_id) (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev EvCanonical ev_tm - -- EvCanonical: see Note [CallStack and ExecptionContext hack] - -- in GHC.Tc.Solver.Dict - ; return True } - | otherwise - = return False - --- | Default any remaining @CallStack@ constraints to empty @CallStack@s. --- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -defaultCallStack :: CtDefaultingStrategy -defaultCallStack ct - | ClassPred cls tys <- classifyPredType (ctPred ct) - , isJust (isCallStackPred cls tys) - = do { solveCallStack (ctEvidence ct) EvCsEmpty - ; return True } - | otherwise - = return False - -defaultEquality :: CtDefaultingStrategy --- See Note [Defaulting equalities] -defaultEquality ct - | EqPred NomEq ty1 ty2 <- classifyPredType (ctPred ct) - = do { -- Remember: `ct` may not be zonked; - -- see (DE3) in Note [Defaulting equalities] - z_ty1 <- TcS.zonkTcType ty1 - ; z_ty2 <- TcS.zonkTcType ty2 - - -- Now see if either LHS or RHS is a bare type variable - -- You might think the type variable will only be on the LHS - -- but with a type function we might get F t1 ~ alpha - ; case (getTyVar_maybe z_ty1, getTyVar_maybe z_ty2) of - (Just z_tv1, _) -> try_default_tv z_tv1 z_ty2 - (_, Just z_tv2) -> try_default_tv z_tv2 z_ty1 - _ -> return False } - | otherwise - = return False - - where - try_default_tv lhs_tv rhs_ty - | MetaTv { mtv_info = info, mtv_tclvl = lvl } <- tcTyVarDetails lhs_tv - , tyVarKind lhs_tv `tcEqType` typeKind rhs_ty - , checkTopShape info rhs_ty - -- Do not test for touchability of lhs_tv; that is the whole point! - -- See (DE2) in Note [Defaulting equalities] - = do { traceTcS "defaultEquality 1" (ppr lhs_tv $$ ppr rhs_ty) - - -- checkTyEqRhs: check that we can in fact unify lhs_tv := rhs_ty - -- See Note [Defaulting equalities] - -- LC_Promote: promote deeper unification variables (DE4) - -- LC_Promote True: ...including under type families (DE5) - ; let flags :: TyEqFlags () - flags = TEF { tef_foralls = False - , tef_fam_app = TEFA_Recurse - , tef_lhs = TyVarLHS lhs_tv - , tef_unifying = Unifying info lvl (LC_Promote True) - , tef_occurs = cteInsolubleOccurs } - ; res :: PuResult () Reduction <- wrapTcS (checkTyEqRhs flags rhs_ty) - - ; case res of - PuFail {} -> cant_default_tv "checkTyEqRhs" - PuOK _ redn -> assertPpr (isReflCo (reductionCoercion redn)) (ppr redn) $ - -- With TEFA_Recurse we never get any reductions - default_tv } - | otherwise - = cant_default_tv "fall through" - - where - cant_default_tv msg - = do { traceTcS ("defaultEquality fails: " ++ msg) $ - vcat [ ppr lhs_tv <+> char '~' <+> ppr rhs_ty - , ppr (tyVarKind lhs_tv) - , ppr (typeKind rhs_ty) ] - ; return False } - - -- All tests passed: do the unification - default_tv - = do { traceTcS "defaultEquality success:" (ppr rhs_ty) - ; unifyTyVar lhs_tv rhs_ty -- NB: unifyTyVar adds to the - -- TcS unification counter - ; setEvBindIfWanted (ctEvidence ct) EvCanonical $ - evCoercion (mkNomReflCo rhs_ty) - ; return True } - -combineStrategies :: CtDefaultingStrategy -> CtDefaultingStrategy -> CtDefaultingStrategy -combineStrategies default1 default2 ct - = do { solved <- default1 ct - ; case solved of - True -> return True -- default1 solved it! - False -> default2 ct -- default1 failed, try default2 - } - - -{- Note [When to do type-class defaulting] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In GHC 7.6 and 7.8.2, we did type-class defaulting only if insolubleWC -was false, on the grounds that defaulting can't help solve insoluble -constraints. But if we *don't* do defaulting we may report a whole -lot of errors that would be solved by defaulting; these errors are -quite spurious because fixing the single insoluble error means that -defaulting happens again, which makes all the other errors go away. -This is jolly confusing: #9033. - -So it seems better to always do type-class defaulting. - -However, always doing defaulting does mean that we'll do it in -situations like this (#5934): - run :: (forall s. GenST s) -> Int - run = fromInteger 0 -We don't unify the return type of fromInteger with the given function -type, because the latter involves foralls. So we're left with - (Num alpha, alpha ~ (forall s. GenST s) -> Int) -Now we do defaulting, get alpha := Integer, and report that we can't -match Integer with (forall s. GenST s) -> Int. That's not totally -stupid, but perhaps a little strange. - -Another potential alternative would be to suppress *all* non-insoluble -errors if there are *any* insoluble errors, anywhere, but that seems -too drastic. - -Note [Defaulting equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f :: forall a. (forall t. (F t ~ Int) => a -> Int) -> Int - - g :: Int - g = f id - -We'll typecheck - id :: forall t. (F t ~ Int) => alpha[1] -> Int -where the `alpha[1]` comes from instantiating `f`. So we'll end up -with the implication constraint - forall[2] t. (F t ~ Int) => alpha[1] ~ Int -And that can't be solved because `alpha` is untouchable under the -equality (F t ~ Int). - -This is tiresome, and gave rise to user complaints: #25125 and #25029. -Moreover, in this case there is no good reason not to unify alpha:=Int. -Doing so solves the constraint, and since `alpha` is not otherwise -constrained, it does no harm. So the new plan is this: - - * For the Wanted constraint - [W] alpha ~ ty - if the only reason for not unifying is untouchability, then during - top-level defaulting, go ahead and unify - -In top-level defaulting, we already do several other somewhat-ad-hoc, -but terribly convenient, unifications. This is just one more. - -Wrinkles: - -(DE1) Note carefully that this does not threaten principal types. - The original worry about unifying untouchable type variables was this: - - data T a where - T1 :: T Bool - f x = case x of T1 -> True - - Should we infer f :: T a -> Bool, or f :: T a -> a. Both are valid, but - neither is more general than the other - -(DE2) We still can't unify if there is a skolem-escape check, or an occurs check, - or it it'd mean unifying a TyVarTv with a non-tyvar. It's only the - "untouchability test" that we lift. We can lift it by saying that the innermost - given equality is at top level. - -(DE3) The contraint we are looking at may not be fully zonked; for example, - an earlier defaulting might have affected it. So we zonk-on-the fly in - `defaultEquality`. - -(DE4) Promotion. Suppose we see alpha[2] := Maybe beta[4]. We want to promote - beta[4] to level 2 and unify alpha[2] := Maybe beta'[2]. This is done by - checkTyEqRhs. - -(DE5) Promotion. Suppose we see alpha[2] := F beta[4], where F is a type - family. Then we still want to promote beta to beta'[2], and unify. This is - unusual: more commonly, we don't promote unification variables under a - type family. But here we want to. (This mattered in #25251.) - - Hence the Bool flag on LC_Promote, and its use in `tef_unifying` in - `defaultEquality`. - -Note [Must simplify after defaulting] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We may have a deeply buried constraint - (t:*) ~ (a:Open) -which we couldn't solve because of the kind incompatibility, and 'a' is free. -Then when we default 'a' we can solve the constraint. And we want to do -that before starting in on type classes. We MUST do it before reporting -errors, because it isn't an error! #7967 was due to this. - -Note [Top-level Defaulting Plan] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We have considered two design choices for where/when to apply defaulting. - (i) Do it in SimplCheck mode only /whenever/ you try to solve some - simple constraints, maybe deep inside the context of implications. - This used to be the case in GHC 7.4.1. - (ii) Do it in a tight loop at simplifyTop, once all other constraints have - finished. This is the current story. - -Option (i) had many disadvantages: - a) Firstly, it was deep inside the actual solver. - b) Secondly, it was dependent on the context (Infer a type signature, - or Check a type signature, or Interactive) since we did not want - to always start defaulting when inferring (though there is an exception to - this, see Note [Default while Inferring]). - c) It plainly did not work. Consider typecheck/should_compile/DfltProb2.hs: - f :: Int -> Bool - f x = const True (\y -> let w :: a -> a - w a = const a (y+1) - in w y) - We will get an implication constraint (for beta the type of y): - [untch=beta] forall a. 0 => Num beta - which we really cannot default /while solving/ the implication, since beta is - untouchable. - -Instead our new defaulting story is to pull defaulting out of the solver loop and -go with option (ii), implemented at SimplifyTop. Namely: - - First, have a go at solving the residual constraint of the whole - program - - Try to approximate it with a simple constraint - - Figure out derived defaulting equations for that simple constraint - - Go round the loop again if you did manage to get some equations - -Now, that has to do with class defaulting. However there exists type variable /kind/ -defaulting. Again this is done at the top-level and the plan is: - - At the top-level, once you had a go at solving the constraint, do - figure out /all/ the touchable unification variables of the wanted constraints. - - Apply defaulting to their kinds - -More details in Note [DefaultTyVar]. - -Note [Safe Haskell Overlapping Instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In Safe Haskell, we apply an extra restriction to overlapping instances. The -motive is to prevent untrusted code provided by a third-party, changing the -behavior of trusted code through type-classes. This is due to the global and -implicit nature of type-classes that can hide the source of the dictionary. - -Another way to state this is: if a module M compiles without importing another -module N, changing M to import N shouldn't change the behavior of M. - -Overlapping instances with type-classes can violate this principle. However, -overlapping instances aren't always unsafe. They are just unsafe when the most -selected dictionary comes from untrusted code (code compiled with -XSafe) and -overlaps instances provided by other modules. - -In particular, in Safe Haskell at a call site with overlapping instances, we -apply the following rule to determine if it is a 'unsafe' overlap: - - 1) Most specific instance, I1, defined in an `-XSafe` compiled module. - 2) I1 is an orphan instance or a MPTC. - 3) At least one overlapped instance, Ix, is both: - A) from a different module than I1 - B) Ix is not marked `OVERLAPPABLE` - -This is a slightly involved heuristic, but captures the situation of an -imported module N changing the behavior of existing code. For example, if -condition (2) isn't violated, then the module author M must depend either on a -type-class or type defined in N. - -Secondly, when should these heuristics be enforced? We enforced them when the -type-class method call site is in a module marked `-XSafe` or `-XTrustworthy`. -This allows `-XUnsafe` modules to operate without restriction, and for Safe -Haskell inference to infer modules with unsafe overlaps as unsafe. - -One alternative design would be to also consider if an instance was imported as -a `safe` import or not and only apply the restriction to instances imported -safely. However, since instances are global and can be imported through more -than one path, this alternative doesn't work. - -Note [Safe Haskell Overlapping Instances Implementation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -How is this implemented? It's complicated! So we'll step through it all: - - 1) `InstEnv.lookupInstEnv` -- Performs instance resolution, so this is where - we check if a particular type-class method call is safe or unsafe. We do this - through the return type, `ClsInstLookupResult`, where the last parameter is a - list of instances that are unsafe to overlap. When the method call is safe, - the list is null. - - 2) `GHC.Tc.Solver.Dict.matchClassInst` -- This module drives the instance resolution - / dictionary generation. The return type is `ClsInstResult`, which either - says no instance matched, or one found, and if it was a safe or unsafe - overlap. - - 3) `GHC.Tc.Solver.Dict.tryInstances` -- Takes a dictionary / class constraint and - tries to resolve it by calling (in part) `matchClassInst`. The resolving - mechanism has a work list (of constraints) that it process one at a time. If - the constraint can't be resolved, it's added to an inert set. When compiling - an `-XSafe` or `-XTrustworthy` module, we follow this approach as we know - compilation should fail. These are handled as normal constraint resolution - failures from here-on (see step 6). - - Otherwise, we may be inferring safety (or using `-Wunsafe`), and - compilation should succeed, but print warnings and/or mark the compiled module - as `-XUnsafe`. In this case, we call `insertSafeOverlapFailureTcS` which adds - the unsafe (but resolved!) constraint to the `inert_safehask` field of - `InertCans`. - - 4) `GHC.Tc.Solver.simplifyTop`: - * Call simplifyTopWanteds, the top-level function for driving the simplifier for - constraint resolution. - - * Once finished, call `getSafeOverlapFailures` to retrieve the - list of overlapping instances that were successfully resolved, - but unsafe. Remember, this is only applicable for generating warnings - (`-Wunsafe`) or inferring a module unsafe. `-XSafe` and `-XTrustworthy` - cause compilation failure by not resolving the unsafe constraint at all. - - * For unresolved constraints (all types), call `GHC.Tc.Errors.reportUnsolved`, - while for resolved but unsafe overlapping dictionary constraints, call - `GHC.Tc.Errors.warnAllUnsolved`. Both functions convert constraints into a - warning message for the user. - - * In the case of `warnAllUnsolved` for resolved, but unsafe - dictionary constraints, we collect the generated warning - message (pop it) and call `GHC.Tc.Utils.Monad.recordUnsafeInfer` to - mark the module we are compiling as unsafe, passing the - warning message along as the reason. - - 5) `GHC.Tc.Errors.*Unsolved` -- Generates error messages for constraints by - actually calling `InstEnv.lookupInstEnv` again! Yes, confusing, but all we - know is the constraint that is unresolved or unsafe. For dictionary, all we - know is that we need a dictionary of type C, but not what instances are - available and how they overlap. So we once again call `lookupInstEnv` to - figure that out so we can generate a helpful error message. - - 6) `GHC.Tc.Utils.Monad.recordUnsafeInfer` -- Save the unsafe result and reason in - IORefs called `tcg_safe_infer` and `tcg_safe_infer_reason`. - - 7) `GHC.Driver.Main.tcRnModule'` -- Reads `tcg_safe_infer` after type-checking, calling - `GHC.Driver.Main.markUnsafeInfer` (passing the reason along) when safe-inference - failed. - -Note [No defaulting in the ambiguity check] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When simplifying constraints for the ambiguity check, we use -solveWanteds, not simplifyTopWanteds, so that we do no defaulting. -#11947 was an example: - f :: Num a => Int -> Int -This is ambiguous of course, but we don't want to default the -(Num alpha) constraint to (Num Int)! Doing so gives a defaulting -warning, but no error. - -Note [Defaulting insolubles] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If a set of wanteds is insoluble, we have no hope of accepting the -program. Yet we do not stop constraint solving, etc., because we may -simplify the wanteds to produce better error messages. So, once -we have an insoluble constraint, everything we do is just about producing -helpful error messages. - -Should we default in this case or not? Let's look at an example (tcfail004): - - (f,g) = (1,2,3) - -With defaulting, we get a conflict between (a0,b0) and (Integer,Integer,Integer). -Without defaulting, we get a conflict between (a0,b0) and (a1,b1,c1). I (Richard) -find the latter more helpful. Several other test cases (e.g. tcfail005) suggest -similarly. So: we should not do class defaulting with insolubles. - -On the other hand, RuntimeRep-defaulting is different. Witness tcfail078: - - f :: Integer i => i - f = 0 - -Without RuntimeRep-defaulting, we GHC suggests that Integer should have kind -TYPE r0 -> Constraint and then complains that r0 is actually untouchable -(presumably, because it can't be sure if `Integer i` entails an equality). -If we default, we are told of a clash between (* -> Constraint) and Constraint. -The latter seems far better, suggesting we *should* do RuntimeRep-defaulting -even on insolubles. - -But, evidently, not always. Witness UnliftedNewtypesInfinite: - - newtype Foo = FooC (# Int#, Foo #) - -This should fail with an occurs-check error on the kind of Foo (with -XUnliftedNewtypes). -If we default RuntimeRep-vars, we get - - Expecting a lifted type, but ‘(# Int#, Foo #)’ is unlifted - -which is just plain wrong. - -Another situation in which we don't want to default involves concrete metavariables. - -In equalities such as alpha[conc] ~# rr[sk] , alpha[conc] ~# RR beta[tau] -for a type family RR (all at kind RuntimeRep), we would prefer to report a -representation-polymorphism error rather than default alpha and get error: - - Could not unify `rr` with `Lifted` / Could not unify `RR b0` with `Lifted` - -which is very confusing. For this reason, we weed out the concrete -metavariables participating in such equalities in nonDefaultableTyVarsOfWC. -Just looking at insolublity is not enough, as `alpha[conc] ~# RR beta[tau]` could -become soluble after defaulting beta (see also #21430). - -Conclusion: we should do RuntimeRep-defaulting on insolubles only when the -user does not want to hear about RuntimeRep stuff -- that is, when --fprint-explicit-runtime-reps is not set. -However, we must still take care not to default concrete type variables -participating in an equality with a non-concrete type, as seen in the -last example above. --} - ------------------- -simplifyAmbiguityCheck :: Type -> WantedConstraints -> TcM () -simplifyAmbiguityCheck ty wc - = do { traceTc "simplifyAmbiguityCheck {" $ - text "type = " <+> ppr ty $$ text "wanted = " <+> ppr wc - - ; (final_wc, _) <- runTcS $ do { wc1 <- solveWanteds wc - ; tryUnsatisfiableGivens wc1 } - -- NB: no defaulting! See Note [No defaulting in the ambiguity check] - -- Note: we do still use Unsatisfiable Givens to solve Wanteds, - -- see Wrinkle [Ambiguity] under point (C) of - -- Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors. - - ; discardResult (reportUnsolved final_wc) - - ; traceTc "End simplifyAmbiguityCheck }" empty } - ------------------- -simplifyInteractive :: WantedConstraints -> TcM (Bag EvBind) -simplifyInteractive wanteds - = traceTc "simplifyInteractive" empty >> - simplifyTop wanteds - ------------------- -{- Note [Pattern match warnings with insoluble Givens] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A pattern match on a GADT can introduce new type-level information, which needs -to be analysed in order to get the expected pattern match warnings. - -For example: - -> type IsBool :: Type -> Constraint -> type family IsBool a where -> IsBool Bool = () -> IsBool b = b ~ Bool -> -> data T a where -> MkTInt :: Int -> T Int -> MkTBool :: IsBool b => b -> T b -> -> f :: T Int -> Int -> f (MkTInt i) = i - -The pattern matching performed by `f` is complete: we can't ever call -`f (MkTBool b)`, as type-checking that application would require producing -evidence for `Int ~ Bool`, which can't be done. - -The pattern match checker uses `tcCheckGivens` to accumulate all the Given -constraints, and relies on `tcCheckGivens` to return Nothing if the -Givens become insoluble. `tcCheckGivens` in turn relies on `insolubleCt` -to identify these insoluble constraints. So the precise definition of -`insolubleCt` has a big effect on pattern match overlap warnings. - -To detect this situation, we check whether there are any insoluble Given -constraints. In the example above, the insoluble constraint was an -equality constraint, but it is also important to detect custom type errors: - -> type NotInt :: Type -> Constraint -> type family NotInt a where -> NotInt Int = TypeError (Text "That's Int, silly.") -> NotInt _ = () -> -> data R a where -> MkT1 :: a -> R a -> MkT2 :: NotInt a => R a -> -> foo :: R Int -> Int -> foo (MkT1 x) = x - -To see that we can't call `foo (MkT2)`, we must detect that `NotInt Int` is insoluble -because it is a custom type error. -Failing to do so proved quite inconvenient for users, as evidence by the -tickets #11503 #14141 #16377 #20180. -Test cases: T11503, T14141. - -Examples of constraints that tcCheckGivens considers insoluble: - - Int ~ Bool, - - Coercible Float Word, - - TypeError msg. - -Non-examples: - - constraints which we know aren't satisfied, - e.g. Show (Int -> Int) when no such instance is in scope, - - Eq (TypeError msg), - - C (Int ~ Bool), with @class C (c :: Constraint)@. --} - -tcCheckGivens :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) --- ^ Return (Just new_inerts) if the Givens are satisfiable, Nothing if definitely --- contradictory. --- --- See Note [Pattern match warnings with insoluble Givens] above. -tcCheckGivens inerts given_ids = do - (sat, new_inerts) <- runTcSInerts inerts $ do - traceTcS "checkGivens {" (ppr inerts <+> ppr given_ids) - lcl_env <- TcS.getLclEnv - let given_loc = mkGivenLoc topTcLevel (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) - let given_cts = mkGivens given_loc (bagToList given_ids) - -- See Note [Superclasses and satisfiability] - solveSimpleGivens given_cts - insols <- getInertInsols - insols <- try_harder insols - traceTcS "checkGivens }" (ppr insols) - return (isEmptyBag insols) - return $ if sat then Just new_inerts else Nothing - where - try_harder :: Cts -> TcS Cts - -- Maybe we have to search up the superclass chain to find - -- an unsatisfiable constraint. Example: pmcheck/T3927b. - -- At the moment we try just once - try_harder insols - | not (isEmptyBag insols) -- We've found that it's definitely unsatisfiable - = return insols -- Hurrah -- stop now. - | otherwise - = do { pending_given <- getPendingGivenScs - ; new_given <- makeSuperClasses pending_given - ; solveSimpleGivens new_given - ; getInertInsols } - -tcCheckWanteds :: InertSet -> ThetaType -> TcM Bool --- ^ Return True if the Wanteds are soluble, False if not -tcCheckWanteds inerts wanteds = do - cts <- newWanteds PatCheckOrigin wanteds - (sat, _new_inerts) <- runTcSInerts inerts $ do - traceTcS "checkWanteds {" (ppr inerts <+> ppr wanteds) - -- See Note [Superclasses and satisfiability] - wcs <- solveWanteds (mkSimpleWC cts) - traceTcS "checkWanteds }" (ppr wcs) - return (isSolvedWC wcs) - return sat - --- | Normalise a type as much as possible using the given constraints. --- See @Note [tcNormalise]@. -tcNormalise :: InertSet -> Type -> TcM Type -tcNormalise inerts ty - = do { norm_loc <- getCtLocM PatCheckOrigin Nothing - ; (res, _new_inerts) <- runTcSInerts inerts $ - do { traceTcS "tcNormalise {" (ppr inerts) - ; ty' <- rewriteType norm_loc ty - ; traceTcS "tcNormalise }" (ppr ty') - ; pure ty' } - ; return res } - -{- Note [Superclasses and satisfiability] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Expand superclasses before starting, because (Int ~ Bool), has -(Int ~~ Bool) as a superclass, which in turn has (Int ~N# Bool) -as a superclass, and it's the latter that is insoluble. See -Note [The equality types story] in GHC.Builtin.Types.Prim. - -If we fail to prove unsatisfiability we (arbitrarily) try just once to -find superclasses, using try_harder. Reason: we might have a type -signature - f :: F op (Implements push) => .. -where F is a type function. This happened in #3972. - -We could do more than once but we'd have to have /some/ limit: in the -the recursive case, we would go on forever in the common case where -the constraints /are/ satisfiable (#10592 comment:12!). - -For straightforward situations without type functions the try_harder -step does nothing. - -Note [tcNormalise] -~~~~~~~~~~~~~~~~~~ -tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas -most invocations of the constraint solver are intended to simplify a set of -constraints or to decide if a particular set of constraints is satisfiable, -the purpose of tcNormalise is to take a type, plus some locally solved -constraints in the form of an InertSet, and normalise the type as much as -possible with respect to those constraints. - -It does *not* reduce type or data family applications or look through newtypes. - -Why is this useful? As one example, when coverage-checking an EmptyCase -expression, it's possible that the type of the scrutinee will only reduce -if some local equalities are solved for. See "Wrinkle: Local equalities" -in Note [Type normalisation] in "GHC.HsToCore.Pmc". - -To accomplish its stated goal, tcNormalise first initialises the solver monad -with the given InertCans, then uses rewriteType to simplify the desired type -with respect to the Givens in the InertCans. - -*********************************************************************************** -* * -* Inference -* * -*********************************************************************************** - -Note [Inferring the type of a let-bound variable] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f x = rhs - -To infer f's type we do the following: - * Gather the constraints for the RHS with ambient level *one more than* - the current one. This is done by the call - pushLevelAndCaptureConstraints (tcMonoBinds...) - in GHC.Tc.Gen.Bind.tcPolyInfer - - * Call simplifyInfer to simplify the constraints and decide what to - quantify over. We pass in the level used for the RHS constraints, - here called rhs_tclvl. - -This ensures that the implication constraint we generate, if any, -has a strictly-increased level compared to the ambient level outside -the let binding. - -Note [Inferring principal types] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't always infer principal types. For instance, the inferred type for - -> f x = show [x] - -is - -> f :: Show a => a -> String - -This is not the most general type if we allow flexible contexts. -Indeed, if we try to write the following - -> g :: Show [a] => a -> String -> g x = f x - -we get the error: - - * Could not deduce (Show a) arising from a use of `f' - from the context: Show [a] - -Though replacing f x in the right-hand side of g with the definition -of f x works, the call to f x does not. This is the hallmark of -unprincip{led,al} types. - -Another example: - -> class C a -> class D a where -> d :: a -> instance C a => D a where -> d = undefined -> h _ = d -- argument is to avoid the monomorphism restriction - -The inferred type for h is - -> h :: C a => t -> a - -even though - -> h :: D a => t -> a - -is more general. - -The fix is easy: don't simplify constraints before inferring a type. -That is, have the inferred type quantify over all constraints that arise -in a definition's right-hand side, even if they are simplifiable. -Unfortunately, this would yield all manner of unwieldy types, -and so we won't do so. --} - --- | How should we choose which constraints to quantify over? -data InferMode = ApplyMR -- ^ Apply the monomorphism restriction, - -- never quantifying over any constraints - | EagerDefaulting -- ^ See Note [TcRnExprMode] in "GHC.Tc.Module", - -- the :type +d case; this mode refuses - -- to quantify over any defaultable constraint - | NoRestrictions -- ^ Quantify over any constraint that - -- satisfies pickQuantifiablePreds - -instance Outputable InferMode where - ppr ApplyMR = text "ApplyMR" - ppr EagerDefaulting = text "EagerDefaulting" - ppr NoRestrictions = text "NoRestrictions" - -simplifyInfer :: TcLevel -- Used when generating the constraints - -> InferMode - -> [TcIdSigInst] -- Any signatures (possibly partial) - -> [(Name, TcTauType)] -- Variables to be generalised, - -- and their tau-types - -> WantedConstraints - -> TcM ([TcTyVar], -- Quantify over these type variables - [EvVar], -- ... and these constraints (fully zonked) - TcEvBinds, -- ... binding these evidence variables - Bool) -- True <=> the residual constraints are insoluble - -simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds - | isEmptyWC wanteds - = do { -- When quantifying, we want to preserve any order of variables as they - -- appear in partial signatures. cf. decideQuantifiedTyVars - let psig_tv_tys = [ mkTyVarTy tv | sig <- partial_sigs - , (_,Bndr tv _) <- sig_inst_skols sig ] - psig_theta = [ pred | sig <- partial_sigs - , pred <- sig_inst_theta sig ] - - ; dep_vars <- candidateQTyVarsOfTypes (psig_tv_tys ++ psig_theta ++ map snd name_taus) - - ; skol_info <- mkSkolemInfo (InferSkol name_taus) - ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars dep_vars - ; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs) - ; return (qtkvs, [], emptyTcEvBinds, False) } - - | otherwise - = do { traceTc "simplifyInfer {" $ vcat - [ text "sigs =" <+> ppr sigs - , text "binds =" <+> ppr name_taus - , text "rhs_tclvl =" <+> ppr rhs_tclvl - , text "infer_mode =" <+> ppr infer_mode - , text "(unzonked) wanted =" <+> ppr wanteds - ] - - ; let psig_theta = concatMap sig_inst_theta partial_sigs - - -- First do full-blown solving - -- NB: we must gather up all the bindings from doing - -- this solving; hence (runTcSWithEvBinds ev_binds_var). - -- And note that since there are nested implications, - -- calling solveWanteds will side-effect their evidence - -- bindings, so we can't just revert to the input - -- constraint. - - ; ev_binds_var <- TcM.newTcEvBinds - ; psig_evs <- newWanteds AnnOrigin psig_theta - ; wanted_transformed - <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ - solveWanteds (mkSimpleWC psig_evs `andWC` wanteds) - -- psig_evs : see Note [Add signature contexts as wanteds] - -- See Note [Inferring principal types] - - -- Find quant_pred_candidates, the predicates that - -- we'll consider quantifying over - -- NB1: wanted_transformed does not include anything provable from - -- the psig_theta; it's just the extra bit - -- NB2: We do not do any defaulting when inferring a type, this can lead - -- to less polymorphic types, see Note [Default while Inferring] - ; wanted_transformed <- TcM.liftZonkM $ TcM.zonkWC wanted_transformed - ; let definite_error = insolubleWC wanted_transformed - -- See Note [Quantification with errors] - quant_pred_candidates - | definite_error = [] - | otherwise = ctsPreds (approximateWC False wanted_transformed) - - -- Decide what type variables and constraints to quantify - -- NB: quant_pred_candidates is already fully zonked - -- NB: bound_theta are constraints we want to quantify over, - -- including the psig_theta, which we always quantify over - -- NB: bound_theta are fully zonked - -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] - -- in GHC.Tc.Utils.TcType - ; rec { (qtvs, bound_theta, co_vars) <- decideQuantification skol_info infer_mode rhs_tclvl - name_taus partial_sigs - quant_pred_candidates - ; bound_theta_vars <- mapM TcM.newEvVar bound_theta - - ; let full_theta = map idType bound_theta_vars - ; skol_info <- mkSkolemInfo (InferSkol [ (name, mkPhiTy full_theta ty) - | (name, ty) <- name_taus ]) - } - - - -- Now emit the residual constraint - ; emitResidualConstraints rhs_tclvl ev_binds_var - name_taus co_vars qtvs bound_theta_vars - wanted_transformed - - -- All done! - ; traceTc "} simplifyInfer/produced residual implication for quantification" $ - vcat [ text "quant_pred_candidates =" <+> ppr quant_pred_candidates - , text "psig_theta =" <+> ppr psig_theta - , text "bound_theta =" <+> pprCoreBinders bound_theta_vars - , text "qtvs =" <+> ppr qtvs - , text "definite_error =" <+> ppr definite_error ] - - ; return ( qtvs, bound_theta_vars, TcEvBinds ev_binds_var, definite_error ) } - -- NB: bound_theta_vars must be fully zonked - where - partial_sigs = filter isPartialSig sigs - --------------------- -emitResidualConstraints :: TcLevel -> EvBindsVar - -> [(Name, TcTauType)] - -> CoVarSet -> [TcTyVar] -> [EvVar] - -> WantedConstraints -> TcM () --- Emit the remaining constraints from the RHS. -emitResidualConstraints rhs_tclvl ev_binds_var - name_taus co_vars qtvs full_theta_vars wanteds - | isEmptyWC wanteds - = return () - - | otherwise - = do { wanted_simple <- TcM.liftZonkM $ TcM.zonkSimples (wc_simple wanteds) - ; let (outer_simple, inner_simple) = partitionBag is_mono wanted_simple - is_mono ct - | Just ct_ev_id <- wantedEvId_maybe ct - = ct_ev_id `elemVarSet` co_vars - | otherwise - = False - -- Reason for the partition: - -- see Note [Emitting the residual implication in simplifyInfer] - --- Already done by defaultTyVarsAndSimplify --- ; _ <- TcM.promoteTyVarSet (tyCoVarsOfCts outer_simple) - - ; let inner_wanted = wanteds { wc_simple = inner_simple } - ; implics <- if isEmptyWC inner_wanted - then return emptyBag - else do implic1 <- newImplication - return $ unitBag $ - implic1 { ic_tclvl = rhs_tclvl - , ic_skols = qtvs - , ic_given = full_theta_vars - , ic_wanted = inner_wanted - , ic_binds = ev_binds_var - , ic_given_eqs = MaybeGivenEqs - , ic_info = skol_info } - - ; emitConstraints (emptyWC { wc_simple = outer_simple - , wc_impl = implics }) } - where - full_theta = map idType full_theta_vars - skol_info = InferSkol [ (name, mkPhiTy full_theta ty) - | (name, ty) <- name_taus ] - -- We don't add the quantified variables here, because they are - -- also bound in ic_skols and we want them to be tidied - -- uniformly. - --------------------- -findInferredDiff :: TcThetaType -> TcThetaType -> TcM TcThetaType --- Given a partial type signature f :: (C a, D a, _) => blah --- and the inferred constraints (X a, D a, Y a, C a) --- compute the difference, which is what will fill in the "_" underscore, --- In this case the diff is (X a, Y a). -findInferredDiff annotated_theta inferred_theta - | null annotated_theta -- Short cut the common case when the user didn't - = return inferred_theta -- write any constraints in the partial signature - | otherwise - = pushTcLevelM_ $ - do { lcl_env <- TcM.getLclEnv - ; given_ids <- mapM TcM.newEvVar annotated_theta - ; wanteds <- newWanteds AnnOrigin inferred_theta - ; let given_loc = mkGivenLoc topTcLevel (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) - given_cts = mkGivens given_loc given_ids - - ; (residual, _) <- runTcS $ - do { _ <- solveSimpleGivens given_cts - ; solveSimpleWanteds (listToBag (map mkNonCanonical wanteds)) } - -- NB: There are no meta tyvars fromn this level annotated_theta - -- because we have either promoted them or unified them - -- See `Note [Quantification and partial signatures]` Wrinkle 2 - - ; return (map (box_pred . ctPred) $ - bagToList $ - wc_simple residual) } - where - box_pred :: PredType -> PredType - box_pred pred = case classifyPredType pred of - EqPred rel ty1 ty2 - | Just (cls,tys) <- boxEqPred rel ty1 ty2 - -> mkClassPred cls tys - | otherwise - -> pprPanic "findInferredDiff" (ppr pred) - _other -> pred - -{- Note [Emitting the residual implication in simplifyInfer] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f = e -where f's type is inferred to be something like (a, Proxy k (Int |> co)) -and we have an as-yet-unsolved, or perhaps insoluble, constraint - [W] co :: Type ~ k -We can't form types like (forall co. blah), so we can't generalise over -the coercion variable, and hence we can't generalise over things free in -its kind, in the case 'k'. But we can still generalise over 'a'. So -we'll generalise to - f :: forall a. (a, Proxy k (Int |> co)) -Now we do NOT want to form the residual implication constraint - forall a. [W] co :: Type ~ k -because then co's eventual binding (which will be a value binding if we -use -fdefer-type-errors) won't scope over the entire binding for 'f' (whose -type mentions 'co'). Instead, just as we don't generalise over 'co', we -should not bury its constraint inside the implication. Instead, we must -put it outside. - -That is the reason for the partitionBag in emitResidualConstraints, -which takes the CoVars free in the inferred type, and pulls their -constraints out. (NB: this set of CoVars should be closed-over-kinds.) - -All rather subtle; see #14584. - -Note [Add signature contexts as wanteds] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this (#11016): - f2 :: (?x :: Int) => _ - f2 = ?x - -or this - class C a b | a -> b - g :: C p q => p -> q - f3 :: C Int b => _ - f3 = g (3::Int) - -We'll use plan InferGen because there are holes in the type. But: - * For f2 we want to have the (?x :: Int) constraint floating around - so that the functional dependencies kick in. Otherwise the - occurrence of ?x on the RHS produces constraint (?x :: alpha), and - we won't unify alpha:=Int. - - * For f3 want the (C Int b) constraint from the partial signature - to meet the (C Int beta) constraint we get from the call to g; again, - fundeps - -Solution: in simplifyInfer, we add the constraints from the signature -as extra Wanteds. - -Why Wanteds? Wouldn't it be neater to treat them as Givens? Alas -that would mess up (GivenInv) in Note [TcLevel invariants]. Consider - f :: (Eq a, _) => blah1 - f = ....g... - g :: (Eq b, _) => blah2 - g = ...f... - -Then we have two psig_theta constraints (Eq a[tv], Eq b[tv]), both with -TyVarTvs inside. Ultimately a[tv] := b[tv], but only when we've solved -all those constraints. And both have level 1, so we can't put them as -Givens when solving at level 1. - -Best to treat them as Wanteds. - -But see also #20076, which would be solved if they were Givens. - - -************************************************************************ -* * - Quantification -* * -************************************************************************ - -Note [Deciding quantification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the monomorphism restriction does not apply, then we quantify as follows: - -* Step 1: decidePromotedTyVars. - Take the global tyvars, and "grow" them using functional dependencies - E.g. if x:alpha is in the environment, and alpha ~ [beta] (which can - happen because alpha is untouchable here) then do not quantify over - beta, because alpha fixes beta, and beta is effectively free in - the environment too; this logic extends to general fundeps, not - just equalities - - We also account for the monomorphism restriction; if it applies, - add the free vars of all the constraints. - - Result is mono_tvs; we will promote all of these to the outer levek, - and certainly not quantify over them. - -* Step 2: defaultTyVarsAndSimplify. - Default any non-promoted tyvars (i.e ones that are definitely - not going to become further constrained), and re-simplify the - candidate constraints. - - Motivation for re-simplification (#7857): imagine we have a - constraint (C (a->b)), where 'a :: TYPE l1' and 'b :: TYPE l2' are - not free in the envt, and instance forall (a::*) (b::*). (C a) => C - (a -> b) The instance doesn't match while l1,l2 are polymorphic, but - it will match when we default them to LiftedRep. - - This is all very tiresome. - - This step also promotes the mono_tvs from Step 1. See - Note [Promote monomorphic tyvars]. In fact, the *only* - use of the mono_tvs from Step 1 is to promote them here. - This promotion effectively stops us from quantifying over them - later, in Step 3. Because the actual variables to quantify - over are determined in Step 3 (not in Step 1), it is OK for - the mono_tvs to be missing some variables free in the - environment. This is why removing the psig_qtvs is OK in - decidePromotedTyVars. Test case for this scenario: T14479. - -* Step 3: decideQuantifiedTyVars. - Decide which variables to quantify over, as follows: - - - Take the free vars of the partial-type-signature types and constraints, - and the tau-type (zonked_tau_tvs), and then "grow" - them using all the constraints. These are grown_tcvs. - See Note [growThetaTyVars vs closeWrtFunDeps]. - - - Use quantifyTyVars to quantify over the free variables of all the types - involved, but only those in the grown_tcvs. - - Result is qtvs. - -* Step 4: Filter the constraints using pickQuantifiablePreds and the - qtvs. We have to zonk the constraints first, so they "see" the - freshly created skolems. - -Note [Unconditionally resimplify constraints when quantifying] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -During quantification (in defaultTyVarsAndSimplify, specifically), we re-invoke -the solver to simplify the constraints before quantifying them. We do this for -two reasons, enumerated below. We could, in theory, detect when either of these -cases apply and simplify only then, but collecting this information is bothersome, -and simplifying redundantly causes no real harm. Note that this code path -happens only for definitions - * without a type signature - * when -XMonoLocalBinds does not apply - * with unsolved constraints -and so the performance cost will be small. - -1. Defaulting - -Defaulting the variables handled by defaultTyVar may unlock instance simplifications. -Example (typecheck/should_compile/T20584b): - - with (t :: Double) (u :: String) = printf "..." t u - -We know the types of t and u, but we do not know the return type of `with`. So, we -assume `with :: alpha`, where `alpha :: TYPE rho`. The type of printf is - printf :: PrintfType r => String -> r -The occurrence of printf is instantiated with a fresh var beta. We then get - beta := Double -> String -> alpha -and - [W] PrintfType (Double -> String -> alpha) - -Module Text.Printf exports - instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) -and it looks like that instance should apply. - -But I have elided some key details: (->) is polymorphic over multiplicity and -runtime representation. Here it is in full glory: - [W] PrintfType ((Double :: Type) %m1 -> (String :: Type) %m2 -> (alpha :: TYPE rho)) - instance (PrintfArg a, PrintfType r) => PrintfType ((a :: Type) %Many -> (r :: Type)) - -Because we do not know that m1 is Many, we cannot use the instance. (Perhaps a better instance -would have an explicit equality constraint to the left of =>, but that's not what we have.) -Then, in defaultTyVarsAndSimplify, we get m1 := Many, m2 := Many, and rho := LiftedRep. -Yet it's too late to simplify the quantified constraint, and thus GHC infers - wait :: PrintfType (Double -> String -> t) => Double -> String -> t -which is silly. Simplifying again after defaulting solves this problem. - -2. Interacting functional dependencies - -Suppose we have - - class C a b | a -> b - -and we are running simplifyInfer over - - forall[2] x. () => [W] C a beta1[1] - forall[2] y. () => [W] C a beta2[1] - -These are two implication constraints, both of which contain a -wanted for the class C. Neither constraint mentions the bound -skolem. We might imagine that these constraints could thus float -out of their implications and then interact, causing beta1 to unify -with beta2, but constraints do not currently float out of implications. - -Unifying the beta1 and beta2 is important. Without doing so, then we might -infer a type like (C a b1, C a b2) => a -> a, which will fail to pass the -ambiguity check, which will say (rightly) that it cannot unify b1 with b2, as -required by the fundep interactions. This happens in the parsec library, and -in test case typecheck/should_compile/FloatFDs. - -If we re-simplify, however, the two fundep constraints will interact, causing -a unification between beta1 and beta2, and all will be well. The key step -is that this simplification happens *after* the call to approximateWC in -simplifyInfer. - --} - -decideQuantification - :: SkolemInfo - -> InferMode - -> TcLevel - -> [(Name, TcTauType)] -- Variables to be generalised - -> [TcIdSigInst] -- Partial type signatures (if any) - -> [PredType] -- Candidate theta; already zonked - -> TcM ( [TcTyVar] -- Quantify over these (skolems) - , [PredType] -- and this context (fully zonked) - , CoVarSet) --- See Note [Deciding quantification] -decideQuantification skol_info infer_mode rhs_tclvl name_taus psigs candidates - = do { -- Step 1: find the mono_tvs - ; (candidates, co_vars, mono_tvs0) - <- decidePromotedTyVars infer_mode name_taus psigs candidates - - -- Step 2: default any non-mono tyvars, and re-simplify - -- This step may do some unification, but result candidates is zonked - ; candidates <- defaultTyVarsAndSimplify rhs_tclvl candidates - - -- Step 3: decide which kind/type variables to quantify over - ; qtvs <- decideQuantifiedTyVars skol_info name_taus psigs candidates - - -- Step 4: choose which of the remaining candidate - -- predicates to actually quantify over - -- NB: decideQuantifiedTyVars turned some meta tyvars - -- into quantified skolems, so we have to zonk again - ; (candidates, psig_theta) <- TcM.liftZonkM $ - do { candidates <- TcM.zonkTcTypes candidates - ; psig_theta <- TcM.zonkTcTypes (concatMap sig_inst_theta psigs) - ; return (candidates, psig_theta) } - ; min_theta <- pickQuantifiablePreds (mkVarSet qtvs) mono_tvs0 candidates - - -- Take account of partial type signatures - -- See Note [Constraints in partial type signatures] - ; let min_psig_theta = mkMinimalBySCs id psig_theta - ; theta <- if - | null psigs -> return min_theta -- Case (P3) - | not (all has_extra_constraints_wildcard psigs) -- Case (P2) - -> return min_psig_theta - | otherwise -- Case (P1) - -> do { diff <- findInferredDiff min_psig_theta min_theta - ; return (min_psig_theta ++ diff) } - - ; traceTc "decideQuantification" - (vcat [ text "infer_mode:" <+> ppr infer_mode - , text "candidates:" <+> ppr candidates - , text "psig_theta:" <+> ppr psig_theta - , text "co_vars:" <+> ppr co_vars - , text "qtvs:" <+> ppr qtvs - , text "theta:" <+> ppr theta ]) - ; return (qtvs, theta, co_vars) } - - where - has_extra_constraints_wildcard (TISI { sig_inst_wcx = Just {} }) = True - has_extra_constraints_wildcard _ = False - -{- Note [Constraints in partial type signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have decided to quantify over min_theta, say (Eq a, C a, Ix a). -Then we distinguish three cases: - -(P1) No partial type signatures: just quantify over min_theta - -(P2) Partial type signatures with no extra_constraints wildcard: - e.g. f :: (Eq a, C a) => a -> _ - Quantify over psig_theta: the user has explicitly specified the - entire context. - - That may mean we have an unsolved residual constraint (Ix a) arising - from the RHS of the function. But so be it: the user said (Eq a, C a). - -(P3) Partial type signature with an extra_constraints wildcard. - e.g. f :: (Eq a, C a, _) => a -> a - Quantify over (psig_theta ++ diff) - where diff = min_theta - psig_theta, using findInferredDiff. - In our example, diff = Ix a - -Some rationale and observations - -* See Note [When the MR applies] in GHC.Tc.Gen.Bind. - -* We always want to quantify over psig_theta (if present). The user specified - it! And pickQuantifiableCandidates might have dropped some - e.g. CallStack constraints. c.f #14658 - equalities (a ~ Bool) - -* In case (P3) we ask that /all/ the signatures have an extra-constraints - wildcard. It's a bit arbitrary; not clear what the "right" thing is. - -* In (P2) we encounter #20076: - f :: Eq [a] => a -> _ - f x = [x] == [x] - From the RHS we get [W] Eq [a]. We simplify those Wanteds in simplifyInfer, - to get (Eq a). But then we quantify over the user-specified (Eq [a]), leaving - a residual implication constraint (forall a. Eq [a] => [W] Eq a), which is - insoluble. Idea: in simplifyInfer we could put the /un-simplified/ constraints - in the residual -- at least in the case like #20076 where the partial signature - fully specifies the final constraint. Maybe: a battle for another day. - -* It's helpful to use the same "find difference" algorithm, `findInferredDiff`, - here as we use in GHC.Tc.Gen.Bind.chooseInferredQuantifiers (#20921) - - At least for single functions we would like to quantify f over precisely the - same theta as , so that we get to take the short-cut path in - `GHC.Tc.Gen.Bind.mkExport`, and avoid calling `tcSubTypeSigma` for impedance - matching. Why avoid? Because it falls over for ambiguous types (#20921). - - We can get precisely the same theta by using the same algorithm, - `findInferredDiff`. - -* All of this goes wrong if we have (a) mutual recursion, (b) multiple - partial type signatures, (c) with different constraints, and (d) - ambiguous types. Something like - f :: forall a. Eq a => F a -> _ - f x = (undefined :: a) == g x undefined - g :: forall b. Show b => F b -> _ -> b - g x y = let _ = (f y, show x) in x - But that's a battle for another day. --} - -decidePromotedTyVars :: InferMode - -> [(Name,TcType)] - -> [TcIdSigInst] - -> [PredType] - -> TcM ([PredType], CoVarSet, TcTyVarSet) --- We are about to generalise over type variables at level N --- Each must be either --- (P) promoted --- (D) defaulted --- (Q) quantified --- This function finds (P), the type variables that we are going to promote: --- (a) Mentioned in a constraint we can't generalise (the MR) --- (b) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, --- so we must not quantify over a type variable free in its kind --- (c) Connected by an equality or fundep to --- * a type variable at level < N, or --- * A tyvar subject to (a), (b) or (c) --- Having found all such level-N tyvars that we can't generalise, --- promote them, to eliminate them from further consideration. --- --- Also return CoVars that appear free in the final quantified types --- we can't quantify over these, and we must make sure they are in scope -decidePromotedTyVars infer_mode name_taus psigs candidates - = do { tc_lvl <- TcM.getTcLevel - ; (no_quant, maybe_quant) <- pick infer_mode candidates - - -- If possible, we quantify over partial-sig qtvs, so they are - -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs - ; (psig_qtvs, psig_theta, taus) <- TcM.liftZonkM $ - do { psig_qtvs <- zonkTcTyVarsToTcTyVars $ binderVars $ - concatMap (map snd . sig_inst_skols) psigs - ; psig_theta <- mapM TcM.zonkTcType $ - concatMap sig_inst_theta psigs - ; taus <- mapM (TcM.zonkTcType . snd) name_taus - ; return (psig_qtvs, psig_theta, taus) } - - ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta - - -- (b) The co_var_tvs are tvs mentioned in the types of covars or - -- coercion holes. We can't quantify over these covars, so we - -- must include the variable in their types in the mono_tvs. - -- E.g. If we can't quantify over co :: k~Type, then we can't - -- quantify over k either! Hence closeOverKinds - -- Recall that coVarsOfTypes also returns coercion holes - co_vars = coVarsOfTypes (psig_tys ++ taus ++ candidates) - co_var_tvs = closeOverKinds co_vars - - mono_tvs0 = filterVarSet (not . isQuantifiableTv tc_lvl) $ - tyCoVarsOfTypes candidates - -- We need to grab all the non-quantifiable tyvars in the - -- types so that we can grow this set to find other - -- non-quantifiable tyvars. This can happen with something like - -- f x y = ... - -- where z = x 3 - -- The body of z tries to unify the type of x (call it alpha[1]) - -- with (beta[2] -> gamma[2]). This unification fails because - -- alpha is untouchable, leaving [W] alpha[1] ~ (beta[2] -> gamma[2]). - -- We need to know not to quantify over beta or gamma, because they - -- are in the equality constraint with alpha. Actual test case: - -- typecheck/should_compile/tc213 - - mono_tvs1 = mono_tvs0 `unionVarSet` co_var_tvs - - -- mono_tvs1 is now the set of variables from an outer scope - -- (that's mono_tvs0) and the set of covars, closed over kinds. - -- Given this set of variables we know we will not quantify, - -- we want to find any other variables that are determined by this - -- set, by functional dependencies or equalities. We thus use - -- closeWrtFunDeps to find all further variables determined by this root - -- set. See Note [growThetaTyVars vs closeWrtFunDeps] - - non_ip_candidates = filterOut isIPLikePred candidates - -- implicit params don't really determine a type variable - -- (that is, we might have IP "c" Bool and IP "c" Int in different - -- places within the same program), and - -- skipping this causes implicit params to monomorphise too many - -- variables; see Note [Inheriting implicit parameters] in GHC.Tc.Solver. - -- Skipping causes typecheck/should_compile/tc219 to fail. - - mono_tvs2 = closeWrtFunDeps non_ip_candidates mono_tvs1 - -- mono_tvs2 now contains any variable determined by the "root - -- set" of monomorphic tyvars in mono_tvs1. - - constrained_tvs = filterVarSet (isQuantifiableTv tc_lvl) $ - closeWrtFunDeps non_ip_candidates (tyCoVarsOfTypes no_quant) - `minusVarSet` mono_tvs2 - -- constrained_tvs: the tyvars that we are not going to - -- quantify /solely/ because of the monomorphism restriction - -- - -- (`minusVarSet` mono_tvs2): a type variable is only - -- "constrained" (so that the MR bites) if it is not - -- free in the environment (#13785) or is determined - -- by some variable that is free in the env't - - mono_tvs = (mono_tvs2 `unionVarSet` constrained_tvs) - `delVarSetList` psig_qtvs - -- (`delVarSetList` psig_qtvs): if the user has explicitly - -- asked for quantification, then that request "wins" - -- over the MR. - -- - -- What if a psig variable is also free in the environment - -- (i.e. says "no" to isQuantifiableTv)? That's OK: explanation - -- in Step 2 of Note [Deciding quantification]. - - -- Warn about the monomorphism restriction - ; when (case infer_mode of { ApplyMR -> True; _ -> False}) $ do - let dia = TcRnMonomorphicBindings (map fst name_taus) - diagnosticTc (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus) dia - - -- Promote the mono_tvs: see Note [Promote monomorphic tyvars] - ; _ <- promoteTyVarSet mono_tvs - - ; traceTc "decidePromotedTyVars" $ vcat - [ text "infer_mode =" <+> ppr infer_mode - , text "psigs =" <+> ppr psigs - , text "psig_qtvs =" <+> ppr psig_qtvs - , text "mono_tvs0 =" <+> ppr mono_tvs0 - , text "no_quant =" <+> ppr no_quant - , text "maybe_quant =" <+> ppr maybe_quant - , text "mono_tvs =" <+> ppr mono_tvs - , text "co_vars =" <+> ppr co_vars ] - - ; return (maybe_quant, co_vars, mono_tvs0) } - where - pick :: InferMode -> [PredType] -> TcM ([PredType], [PredType]) - -- Split the candidates into ones we definitely - -- won't quantify, and ones that we might - pick ApplyMR cand = return (cand, []) - pick NoRestrictions cand = return ([], cand) - pick EagerDefaulting cand = do { os <- xoptM LangExt.OverloadedStrings - ; return (partition (is_int_ct os) cand) } - - -- is_int_ct returns True for a constraint we should /not/ quantify - -- For EagerDefaulting, do not quantify over - -- over any interactive class constraint - is_int_ct ovl_strings pred - = case classifyPredType pred of - ClassPred cls _ -> isInteractiveClass ovl_strings cls - _ -> False - -------------------- -defaultTyVarsAndSimplify :: TcLevel - -> [PredType] -- Assumed zonked - -> TcM [PredType] -- Guaranteed zonked --- Default any tyvar free in the constraints; --- and re-simplify in case the defaulting allows further simplification -defaultTyVarsAndSimplify rhs_tclvl candidates - = do { -- Default any kind/levity vars - ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} - <- candidateQTyVarsOfTypes candidates - -- NB1: decidePromotedTyVars has promoted any type variable fixed by the - -- type envt, so they won't be chosen by candidateQTyVarsOfTypes - -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars - -- Hence looking only at 'candidates' - -- NB3: Any covars should already be handled by - -- the logic in decidePromotedTyVars, which looks at - -- the constraints generated - - ; poly_kinds <- xoptM LangExt.PolyKinds - ; let default_kv | poly_kinds = default_tv - | otherwise = defaultTyVar DefaultKindVars - default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) - ; mapM_ default_kv (dVarSetElems cand_kvs) - ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) - - ; simplify_cand candidates - } - where - -- See Note [Unconditionally resimplify constraints when quantifying] - simplify_cand [] = return [] -- Fast path - simplify_cand candidates - = do { clone_wanteds <- newWanteds DefaultOrigin candidates - ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ - simplifyWantedsTcM clone_wanteds - -- Discard evidence; simples is fully zonked - - ; let new_candidates = ctsPreds simples - ; traceTc "Simplified after defaulting" $ - vcat [ text "Before:" <+> ppr candidates - , text "After:" <+> ppr new_candidates ] - ; return new_candidates } - ------------------- -decideQuantifiedTyVars - :: SkolemInfo - -> [(Name,TcType)] -- Annotated theta and (name,tau) pairs - -> [TcIdSigInst] -- Partial signatures - -> [PredType] -- Candidates, zonked - -> TcM [TyVar] --- Fix what tyvars we are going to quantify over, and quantify them -decideQuantifiedTyVars skol_info name_taus psigs candidates - = do { -- Why psig_tys? We try to quantify over everything free in here - -- See Note [Quantification and partial signatures] - -- Wrinkles 2 and 3 - ; (psig_tv_tys, psig_theta, tau_tys) <- TcM.liftZonkM $ - do { psig_tv_tys <- mapM TcM.zonkTcTyVar [ tv | sig <- psigs - , (_,Bndr tv _) <- sig_inst_skols sig ] - ; psig_theta <- mapM TcM.zonkTcType [ pred | sig <- psigs - , pred <- sig_inst_theta sig ] - ; tau_tys <- mapM (TcM.zonkTcType . snd) name_taus - ; return (psig_tv_tys, psig_theta, tau_tys) } - - ; let -- Try to quantify over variables free in these types - psig_tys = psig_tv_tys ++ psig_theta - seed_tys = psig_tys ++ tau_tys - - -- Now "grow" those seeds to find ones reachable via 'candidates' - -- See Note [growThetaTyVars vs closeWrtFunDeps] - grown_tcvs = growThetaTyVars candidates (tyCoVarsOfTypes seed_tys) - - -- Now we have to classify them into kind variables and type variables - -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyTyVars - -- - -- Keep the psig_tys first, so that candidateQTyVarsOfTypes produces - -- them in that order, so that the final qtvs quantifies in the same - -- order as the partial signatures do (#13524) - ; dv@DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} <- candidateQTyVarsOfTypes $ - psig_tys ++ candidates ++ tau_tys - ; let pick = (`dVarSetIntersectVarSet` grown_tcvs) - dvs_plus = dv { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs } - - ; traceTc "decideQuantifiedTyVars" (vcat - [ text "tau_tys =" <+> ppr tau_tys - , text "candidates =" <+> ppr candidates - , text "cand_kvs =" <+> ppr cand_kvs - , text "cand_tvs =" <+> ppr cand_tvs - , text "tau_tys =" <+> ppr tau_tys - , text "seed_tys =" <+> ppr seed_tys - , text "seed_tcvs =" <+> ppr (tyCoVarsOfTypes seed_tys) - , text "grown_tcvs =" <+> ppr grown_tcvs - , text "dvs =" <+> ppr dvs_plus]) - - ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs_plus } - ------------------- --- | When inferring types, should we quantify over a given predicate? --- See Note [pickQuantifiablePreds] -pickQuantifiablePreds - :: TyVarSet -- Quantifying over these - -> TcTyVarSet -- mono_tvs0: variables mentioned a candidate - -- constraint that come from some outer level - -> TcThetaType -- Proposed constraints to quantify - -> TcM TcThetaType -- A subset that we can actually quantify --- This function decides whether a particular constraint should be --- quantified over, given the type variables that are being quantified -pickQuantifiablePreds qtvs mono_tvs0 theta - = do { tc_lvl <- TcM.getTcLevel - ; let is_nested = not (isTopTcLevel tc_lvl) - ; return (mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] - mapMaybe (pick_me is_nested) theta) } - where - pick_me is_nested pred - = let pred_tvs = tyCoVarsOfType pred - mentions_qtvs = pred_tvs `intersectsVarSet` qtvs - in case classifyPredType pred of - - ClassPred cls tys - | Just {} <- isCallStackPred cls tys - -- NEVER infer a CallStack constraint. Otherwise we let - -- the constraints bubble up to be solved from the outer - -- context, or be defaulted when we reach the top-level. - -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence - -> Nothing - - | isIPClass cls - -> Just pred -- See Note [Inheriting implicit parameters] - - | not mentions_qtvs - -> Nothing -- Don't quantify over predicates that don't - -- mention any of the quantified type variables - - | is_nested - -> Just pred - - -- From here on, we are thinking about top-level defns only - - | pred_tvs `subVarSet` (qtvs `unionVarSet` mono_tvs0) - -- See Note [Do not quantify over constraints that determine a variable] - -> Just pred - - | otherwise - -> Nothing - - EqPred eq_rel ty1 ty2 - | mentions_qtvs - , quantify_equality eq_rel ty1 ty2 - , Just (cls, tys) <- boxEqPred eq_rel ty1 ty2 - -- boxEqPred: See Note [Lift equality constraints when quantifying] - -> Just (mkClassPred cls tys) - | otherwise - -> Nothing - - IrredPred {} | mentions_qtvs -> Just pred - | otherwise -> Nothing - - ForAllPred {} -> Nothing - - -- See Note [Quantifying over equality constraints] - quantify_equality NomEq ty1 ty2 = quant_fun ty1 || quant_fun ty2 - quantify_equality ReprEq _ _ = True - - quant_fun ty - = case tcSplitTyConApp_maybe ty of - Just (tc, tys) | isTypeFamilyTyCon tc - -> tyCoVarsOfTypes tys `intersectsVarSet` qtvs - _ -> False - ------------------- -growThetaTyVars :: ThetaType -> TyCoVarSet -> TyCoVarSet --- See Note [growThetaTyVars vs closeWrtFunDeps] -growThetaTyVars theta tcvs - | null theta = tcvs - | otherwise = transCloVarSet mk_next seed_tcvs - where - seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPLikePred theta - -- See Note [Inheriting implicit parameters] - - mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones - mk_next so_far = foldr (grow_one so_far) emptyVarSet non_ips - grow_one so_far pred tcvs - | pred_tcvs `intersectsVarSet` so_far = tcvs `unionVarSet` pred_tcvs - | otherwise = tcvs - where - pred_tcvs = tyCoVarsOfType pred - - -{- Note [Promote monomorphic tyvars] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Promote any type variables that are free in the environment. Eg - f :: forall qtvs. bound_theta => zonked_tau -The free vars of f's type become free in the envt, and hence will show -up whenever 'f' is called. They may currently at rhs_tclvl, but they -had better be unifiable at the outer_tclvl! Example: envt mentions -alpha[1] - tau_ty = beta[2] -> beta[2] - constraints = alpha ~ [beta] -we don't quantify over beta (since it is fixed by envt) -so we must promote it! The inferred type is just - f :: beta -> beta - -NB: promoteTyVarSet ignores coercion variables - -Note [pickQuantifiablePreds] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When pickQuantifiablePreds is called we have decided what type -variables to quantify over, `qtvs`. The only quesion is: which of the -unsolved candidate predicates should we quantify over? Call them -`picked_theta`. - -Note that will leave behind a residual implication - forall qtvs. picked_theta => unsolved_constraints -For the members of unsolved_constraints that we select for picked_theta -it is easy to solve, by identity. For the others we just hope that -we can solve them. - -So which of the candidates should we pick to quantify over? In some -situations we distinguish top-level from nested bindings. The point -about nested binding is that - (a) the types may mention type variables free in the environment - (b) all of the call sites are statically visible, reducing the - worries about "spooky action at a distance". - -First, never pick a constraint that doesn't mention any of the quantified -variables `qtvs`. Picking such a constraint essentially moves the solving of -the constraint from this function definition to call sites. But because the -constraint mentions no quantified variables, call sites have no advantage -over the definition site. Well, not quite: there could be new constraints -brought into scope by a pattern-match against a constrained (e.g. GADT) -constructor. Example - - data T a where { T1 :: T1 Bool; ... } - - f :: forall a. a -> T a -> blah - f x t = let g y = x&&y -- This needs a~Bool - in case t of - T1 -> g True - .... - -At g's call site we have `a~Bool`, so we /could/ infer - g :: forall . (a~Bool) => Bool -> Bool -- qtvs = {} - -This is all very contrived, and probably just postponse type errors to -the call site. If that's what you want, write a type signature. - -Actually, implicit parameters is an exception to the "no quantified vars" -rule (see Note [Inheriting implicit parameters]) so we can't actually -simply test this case first. - -Now we consider the different sorts of constraints: - -* For ClassPred constraints: - - * Never pick a CallStack constraint. - See Note [Overview of implicit CallStacks] - - * Always pick an implicit-parameter constraint. - Note [Inheriting implicit parameters] - - * For /top-level/ class constraints see - Note [Do not quantify over constraints that determine a variable] - -* For EqPred constraints see Note [Quantifying over equality constraints] - -* For IrredPred constraints, we allow anything that mentions the quantified - type variables. - -* A ForAllPred should not appear: the candidates come from approximateWC. - -Notice that we do /not/ consult -XFlexibleContexts here. For example, -we allow `pickQuantifiablePreds` to quantify over a constraint like -`Num [a]`; then if we don't have `-XFlexibleContexts` we'll get an -error from `checkValidType` but (critically) it includes the helpful -suggestion of adding `-XFlexibleContexts`. See #10608, #10351. - -Note [Lift equality constraints when quantifying] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We can't quantify over a constraint (t1 ~# t2) because that isn't a -predicate type; see Note [Types for coercions, predicates, and evidence] -in GHC.Core.TyCo.Rep. - -So we have to 'lift' it to (t1 ~ t2). Similarly (~R#) must be lifted -to Coercible. - -This tiresome lifting is the reason that pick_me (in -pickQuantifiablePreds) returns a Maybe rather than a Bool. - -Note [Inheriting implicit parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this: - - f x = (x::Int) + ?y - -where f is *not* a top-level binding. -From the RHS of f we'll get the constraint (?y::Int). -There are two types we might infer for f: - - f :: Int -> Int - -(so we get ?y from the context of f's definition), or - - f :: (?y::Int) => Int -> Int - -At first you might think the first was better, because then -?y behaves like a free variable of the definition, rather than -having to be passed at each call site. But of course, the WHOLE -IDEA is that ?y should be passed at each call site (that's what -dynamic binding means) so we'd better infer the second. - -BOTTOM LINE: when *inferring types* you must quantify over implicit -parameters, *even if* they don't mention the bound type variables. -Reason: because implicit parameters, uniquely, have local instance -declarations. See pickQuantifiablePreds. - -Note [Quantifying over equality constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Should we quantify over an equality constraint (s ~ t) -in pickQuantifiablePreds? - -* It is always /sound/ to quantify over a constraint -- those - quantified constraints will need to be proved at each call site. - -* We definitely don't want to quantify over (Maybe a ~ Bool), to get - f :: forall a. (Maybe a ~ Bool) => blah - That simply postpones a type error from the function definition site to - its call site. Fortunately we have already filtered out insoluble - constraints: see `definite_error` in `simplifyInfer`. - -* What about (a ~ T alpha b), where we are about to quantify alpha, `a` and - `b` are in-scope skolems, and `T` is a data type. It's pretty unlikely - that this will be soluble at a call site, so we don't quantify over it. - -* What about `(F beta ~ Int)` where we are going to quantify `beta`? - Should we quantify over the (F beta ~ Int), to get - f :: forall b. (F b ~ Int) => blah - Aha! Perhaps yes, because at the call site we will instantiate `b`, and - perhaps we have `instance F Bool = Int`. So we *do* quantify over a - type-family equality where the arguments mention the quantified variables. - -This is all a bit ad-hoc. - -Note [Do not quantify over constraints that determine a variable] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (typecheck/should_compile/tc231), where we're trying to infer -the type of a top-level declaration. We have - class Zork s a b | a -> b -and the candidate constraint at the end of simplifyInfer is - [W] Zork alpha[1] (Z [Char]) beta[1] -We definitely want to quantify over `alpha` (which is mentioned in the -tau-type). - -But we do *not* want to quantify over `beta`: it is determined by the -functional dependency on Zork: note that the second argument to Zork -in the Wanted is a variable-free `Z [Char]`. Quantifying over it -would be "Henry Ford polymorphism". (Presumably we don't have an -instance in scope that tells us what `beta` actually is.) Instead -we promote `beta[1]` to `beta[0]`, in `decidePromotedTyVars`. - -The question here: do we want to quantify over the constraint, to -give the type - forall a. Zork a (Z [Char]) beta[0] => blah -Definitely not. Since we're not quantifying over beta, it has been -promoted; and then will be zapped to Any in the final zonk. So we end -up with a (perhaps exported) type involving - forall a. Zork a (Z [Char]) Any => blah -No no no: - - Key principle: we never want to show the programmer - a type with `Any` in it. - -What we really want (to catch the Zork example) is this: - - Quantify over the constraint only if all its free variables are - (a) quantified, or - (b) appears in the type of something in the environment (mono_tvs0). - -To understand (b) consider - - class C a b where { op :: a -> b -> () } - - mr = 3 -- mr :: alpha - f1 x = op x mr -- f1 :: forall b. b -> (), plus [W] C b alpha - intify = mr + (4 :: Int) - -In `f1` should we quantify over that `(C b alpha)`? Answer: since `alpha` -is free in the type envt, yes we should. After all, if we'd typechecked -`intify` first, we'd have set `alpha := Int`, and /then/ we'd certainly -quantify. The delicate Zork situation applies when beta is completely -unconstrained (not free in the environment) -- except by the fundep. - -Another way to put it: let's say `alpha` is in `mono_tvs0`. It must be that -some variable `x` has `alpha` free in its type. If we are at top-level (and we -are, because nested decls don't go through this path all), then `x` must also -be at top-level. And, by induction, `x` will not have Any in its type when all -is said and done. The induction is well-founded because, if `x` is mutually -recursive with the definition at hand, then their constraints get processed -together (or `x` has a type signature, in which case the type doesn't have -`Any`). So the key thing is that we must not introduce a new top-level -unconstrained variable here. - -However this regrettably-subtle reasoning is needed only for /top-level/ -declarations. For /nested/ decls we can see all the calls, so we'll -instantiate that quantifed `Zork a (Z [Char]) beta` constraint at call sites, -and either solve it or not (probably not). We won't be left with a -still-callable function with Any in its type. So for nested definitions we -don't make this tricky test. - -Historical note: we had a different, and more complicated test -before, but it was utterly wrong: #23199. - -Note [Quantification and partial signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When choosing type variables to quantify, the basic plan is to -quantify over all type variables that are - * free in the tau_tvs, and - * not forced to be monomorphic (mono_tvs), - for example by being free in the environment. - -However, in the case of a partial type signature, we are doing inference -*in the presence of a type signature*. For example: - f :: _ -> a - f x = ... -or - g :: (Eq _a) => _b -> _b -In both cases we use plan InferGen, and hence call simplifyInfer. But -those 'a' variables are skolems (actually TyVarTvs), and we should be -sure to quantify over them. This leads to several wrinkles: - -* Wrinkle 1. In the case of a type error - f :: _ -> Maybe a - f x = True && x - The inferred type of 'f' is f :: Bool -> Bool, but there's a - left-over error of form (Maybe a ~ Bool). The error-reporting - machine expects to find a binding site for the skolem 'a', so we - add it to the quantified tyvars. - -* Wrinkle 2. Consider the partial type signature - f :: (Eq _) => Int -> Int - f x = x - In normal cases that makes sense; e.g. - g :: Eq _a => _a -> _a - g x = x - where the signature makes the type less general than it could - be. But for 'f' we must therefore quantify over the user-annotated - constraints, to get - f :: forall a. Eq a => Int -> Int - (thereby correctly triggering an ambiguity error later). If we don't - we'll end up with a strange open type - f :: Eq alpha => Int -> Int - which isn't ambiguous but is still very wrong. - - Bottom line: Try to quantify over any variable free in psig_theta, - just like the tau-part of the type. - -* Wrinkle 3 (#13482). Also consider - f :: forall a. _ => Int -> Int - f x = if (undefined :: a) == undefined then x else 0 - Here we get an (Eq a) constraint, but it's not mentioned in the - psig_theta nor the type of 'f'. But we still want to quantify - over 'a' even if the monomorphism restriction is on. - -* Wrinkle 4 (#14479) - foo :: Num a => a -> a - foo xxx = g xxx - where - g :: forall b. Num b => _ -> b - g y = xxx + y - - In the signature for 'g', we cannot quantify over 'b' because it turns out to - get unified with 'a', which is free in g's environment. So we carefully - refrain from bogusly quantifying, in GHC.Tc.Solver.decidePromotedTyVars. We - report the error later, in GHC.Tc.Gen.Bind.chooseInferredQuantifiers. - -Note [growThetaTyVars vs closeWrtFunDeps] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -GHC has two functions, growThetaTyVars and closeWrtFunDeps, both with -the same type and similar behavior. This Note outlines the differences -and why we use one or the other. - -Both functions take a list of constraints. We will call these the -*candidates*. - -closeWrtFunDeps takes a set of "determined" type variables and finds the -closure of that set with respect to the functional dependencies -within the class constraints in the set of candidates. So, if we -have - - class C a b | a -> b - class D a b -- no fundep - candidates = {C (Maybe a) (Either b c), D (Maybe a) (Either d e)} - -then closeWrtFunDeps {a} will return the set {a,b,c}. -This is because, if `a` is determined, then `b` and `c` are, too, -by functional dependency. closeWrtFunDeps called with any seed set not including -`a` will just return its argument, as only `a` determines any other -type variable (in this example). - -growThetaTyVars operates similarly, but it behaves as if every -constraint has a functional dependency among all its arguments. -So, continuing our example, growThetaTyVars {a} will return -{a,b,c,d,e}. Put another way, growThetaTyVars grows the set of -variables to include all variables that are mentioned in the same -constraint (transitively). - -We use closeWrtFunDeps in places where we need to know which variables are -*always* determined by some seed set. This includes - * when determining the mono-tyvars in decidePromotedTyVars. If `a` - is going to be monomorphic, we need b and c to be also: they - are determined by the choice for `a`. - * when checking instance coverage, in - GHC.Tc.Instance.FunDeps.checkInstCoverage - -On the other hand, we use growThetaTyVars where we need to know -which variables *might* be determined by some seed set. This includes - * deciding quantification (GHC.Tc.Gen.Bind.chooseInferredQuantifiers - and decideQuantifiedTyVars -How can `a` determine (say) `d` in the example above without a fundep? -Suppose we have - instance (b ~ a, c ~ a) => D (Maybe [a]) (Either b c) -Now, if `a` turns out to be a list, it really does determine b and c. -The danger in overdoing quantification is the creation of an ambiguous -type signature, but this is conveniently caught in the validity checker. - -Note [Quantification with errors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we find that the RHS of the definition has some absolutely-insoluble -constraints (including especially "variable not in scope"), we - -* Abandon all attempts to find a context to quantify over, - and instead make the function fully-polymorphic in whatever - type we have found - -* Return a flag from simplifyInfer, indicating that we found an - insoluble constraint. This flag is used to suppress the ambiguity - check for the inferred type, which may well be bogus, and which - tends to obscure the real error. This fix feels a bit clunky, - but I failed to come up with anything better. - -Reasons: - - Avoid downstream errors - - Do not perform an ambiguity test on a bogus type, which might well - fail spuriously, thereby obfuscating the original insoluble error. - #14000 is an example - -I tried an alternative approach: simply failM, after emitting the -residual implication constraint; the exception will be caught in -GHC.Tc.Gen.Bind.tcPolyBinds, which gives all the binders in the group the type -(forall a. a). But that didn't work with -fdefer-type-errors, because -the recovery from failM emits no code at all, so there is no function -to run! But -fdefer-type-errors aspires to produce a runnable program. - -Note [Default while Inferring] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Our current plan is that defaulting only happens at simplifyTop and -not simplifyInfer. This may lead to some insoluble deferred constraints. -Example: - -instance D g => C g Int b - -constraint inferred = (forall b. 0 => C gamma alpha b) /\ Num alpha -type inferred = gamma -> gamma - -Now, if we try to default (alpha := Int) we will be able to refine the implication to - (forall b. 0 => C gamma Int b) -which can then be simplified further to - (forall b. 0 => D gamma) -Finally, we /can/ approximate this implication with (D gamma) and infer the quantified -type: forall g. D g => g -> g - -Instead what will currently happen is that we will get a quantified type -(forall g. g -> g) and an implication: - forall g. 0 => (forall b. 0 => C g alpha b) /\ Num alpha - -Which, even if the simplifyTop defaults (alpha := Int) we will still be left with an -unsolvable implication: - forall g. 0 => (forall b. 0 => D g) - -The concrete example would be: - h :: C g a s => g -> a -> ST s a - f (x::gamma) = (\_ -> x) (runST (h x (undefined::alpha)) + 1) - -But it is quite tedious to do defaulting and resolve the implication constraints, and -we have not observed code breaking because of the lack of defaulting in inference, so -we don't do it for now. - - - -Note [Minimize by Superclasses] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we quantify over a constraint, in simplifyInfer we need to -quantify over a constraint that is minimal in some sense: For -instance, if the final wanted constraint is (Eq alpha, Ord alpha), -we'd like to quantify over Ord alpha, because we can just get Eq alpha -from superclass selection from Ord alpha. This minimization is what -mkMinimalBySCs does. Then, simplifyInfer uses the minimal constraint -to check the original wanted. - - -Note [Avoid unnecessary constraint simplification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -------- NB NB NB (Jun 12) ------------- - This note not longer applies; see the notes with #4361. - But I'm leaving it in here so we remember the issue.) - ---------------------------------------- -When inferring the type of a let-binding, with simplifyInfer, -try to avoid unnecessarily simplifying class constraints. -Doing so aids sharing, but it also helps with delicate -situations like - - instance C t => C [t] where .. - - f :: C [t] => .... - f x = let g y = ...(constraint C [t])... - in ... -When inferring a type for 'g', we don't want to apply the -instance decl, because then we can't satisfy (C t). So we -just notice that g isn't quantified over 't' and partition -the constraints before simplifying. - -This only half-works, but then let-generalisation only half-works. - -********************************************************************************* -* * -* Main Simplifier * -* * -*********************************************************************************** - --} - -simplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints --- Solve the specified Wanted constraints --- Discard the evidence binds --- Postcondition: fully zonked -simplifyWantedsTcM wanted - = do { traceTc "simplifyWantedsTcM {" (ppr wanted) - ; (result, _) <- runTcS (solveWanteds (mkSimpleWC wanted)) - ; result <- TcM.liftZonkM $ TcM.zonkWC result - ; traceTc "simplifyWantedsTcM }" (ppr result) - ; return result } - -solveWanteds :: WantedConstraints -> TcS WantedConstraints -solveWanteds wc@(WC { wc_errors = errs }) - | isEmptyWC wc -- Fast path - = return wc - | otherwise - = do { cur_lvl <- TcS.getTcLevel - ; traceTcS "solveWanteds {" $ - vcat [ text "Level =" <+> ppr cur_lvl - , ppr wc ] - - ; dflags <- getDynFlags - ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc - - ; errs' <- simplifyDelayedErrors errs - ; let final_wc = solved_wc { wc_errors = errs' } - - ; ev_binds_var <- getTcEvBindsVar - ; bb <- TcS.getTcEvBindsMap ev_binds_var - ; traceTcS "solveWanteds }" $ - vcat [ text "final wc =" <+> ppr final_wc - , text "current evbinds =" <+> ppr (evBindMapBinds bb) ] - - ; return final_wc } - -simplify_loop :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints --- Do a round of solving, and call maybe_simplify_again to iterate --- The 'definitely_redo_implications' flags is False if the only reason we --- are iterating is that we have added some new Wanted superclasses --- hoping for fundeps to help us; see Note [Superclass iteration] --- --- Does not affect wc_holes at all; reason: wc_holes never affects anything --- else, so we do them once, at the end in solveWanteds -simplify_loop n limit definitely_redo_implications - wc@(WC { wc_simple = simples, wc_impl = implics }) - = do { csTraceTcS $ - text "simplify_loop iteration=" <> int n - <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma - , int (lengthBag simples) <+> text "simples to solve" ]) - ; traceTcS "simplify_loop: wc =" (ppr wc) - - ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] - solveSimpleWanteds simples - -- Any insoluble constraints are in 'simples' and so get rewritten - -- See Note [Rewrite insolubles] in GHC.Tc.Solver.InertSet - - ; wc2 <- if not definitely_redo_implications -- See Note [Superclass iteration] - && unifs1 == 0 -- for this conditional - && isEmptyBag (wc_impl wc1) - then return (wc { wc_simple = wc_simple wc1 }) -- Short cut - else do { implics2 <- solveNestedImplications $ - implics `unionBags` (wc_impl wc1) - ; return (wc { wc_simple = wc_simple wc1 - , wc_impl = implics2 }) } - - ; unif_happened <- resetUnificationFlag - ; csTraceTcS $ text "unif_happened" <+> ppr unif_happened - -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad - ; maybe_simplify_again (n+1) limit unif_happened wc2 } - -maybe_simplify_again :: Int -> IntWithInf -> Bool - -> WantedConstraints -> TcS WantedConstraints -maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) - | n `intGtLimit` limit - = do { -- Add an error (not a warning) if we blow the limit, - -- Typically if we blow the limit we are going to report some other error - -- (an unsolved constraint), and we don't want that error to suppress - -- the iteration limit warning! - addErrTcS $ TcRnSimplifierTooManyIterations simples limit wc - ; return wc } - - | unif_happened - = simplify_loop n limit True wc - - | superClassesMightHelp wc - = -- We still have unsolved goals, and apparently no way to solve them, - -- so try expanding superclasses at this level, both Given and Wanted - do { pending_given <- getPendingGivenScs - ; let (pending_wanted, simples1) = getPendingWantedScs simples - ; if null pending_given && null pending_wanted - then return wc -- After all, superclasses did not help - else - do { new_given <- makeSuperClasses pending_given - ; new_wanted <- makeSuperClasses pending_wanted - ; solveSimpleGivens new_given -- Add the new Givens to the inert set - ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given - , text "new_given" <+> ppr new_given - , text "pending_wanted" <+> ppr pending_wanted - , text "new_wanted" <+> ppr new_wanted ]) - ; simplify_loop n limit (not (null pending_given)) $ - wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } - -- (not (null pending_given)): see Note [Superclass iteration] - - | otherwise - = return wc - -{- Note [Superclass iteration] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this implication constraint - forall a. - [W] d: C Int beta - forall b. blah -where - class D a b | a -> b - class D a b => C a b -We will expand d's superclasses, giving [W] D Int beta, in the hope of geting -fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), -and if so it seems a pity to waste time iterating the implications (forall b. blah) -(If we add new Given superclasses it's a different matter: it's really worth looking -at the implications.) - -Hence the definitely_redo_implications flag to simplify_loop. It's usually -True, but False in the case where the only reason to iterate is new Wanted -superclasses. In that case we check whether the new Wanteds actually led to -any new unifications, and iterate the implications only if so. --} - -{- Note [Expanding Recursive Superclasses and ExpansionFuel] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the class declaration (T21909) - - class C [a] => C a where - foo :: a -> Int - -and suppose during type inference we obtain an implication constraint: - - forall a. C a => C [[a]] - -To solve this implication constraint, we first expand one layer of the superclass -of Given constraints, but not for Wanted constraints. -(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] -in GHC.Tc.Solver.Dict.) We thus get: - - [G] g1 :: C a - [G] g2 :: C [a] -- new superclass layer from g1 - [W] w1 :: C [[a]] - -Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have -any instances for C. So we expand a layer of superclasses of each Wanteds and Givens -that we haven't expanded yet. -This is done in `maybe_simplify_again`. And we get: - - [G] g1 :: C a - [G] g2 :: C [a] - [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 - [W] w1 :: C [[a]] - [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable - -Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), -we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. -We thus make another go at solving in `maybe_simplify_again` by expanding more -layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. - -Side Note: In principle we don't actually need to /solve/ `w2`, as it is a superclass of `w1` -but we only expand it to expose any functional dependencies (see Note [The superclass story]) -But `w2` is a wanted constraint, so we will try to solve it like any other, -even though ultimately we will discard its evidence. - -Solution: Simply bound the maximum number of layers of expansion for -Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel -(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will -win. The Wanteds don't need much fuel: we are only expanding at all -to expose functional dependencies, and wantedFuel=1 means we will -expand a full recursive layer. If the superclass hierarchy is -non-recursive (the normal case) one layer is therefore full expansion. - -The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. -The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. -Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` -compiler flags. - -There are two preconditions for the default fuel values: - (1) default givenFuel >= default wantedsFuel - (2) default givenFuel < solverIterations - -Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints -preferably givenFuel > wantedsFuel to avoid issues like T21909 while -the precondition (2) ensures that we do not reach the solver iteration limit and fail with a -more meaningful error message (see T19627) - -This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. --} - - -solveNestedImplications :: Bag Implication - -> TcS (Bag Implication) --- Precondition: the TcS inerts may contain unsolved simples which have --- to be converted to givens before we go inside a nested implication. -solveNestedImplications implics - | isEmptyBag implics - = return (emptyBag) - | otherwise - = do { traceTcS "solveNestedImplications starting {" empty - ; unsolved_implics <- mapBagM solveImplication implics - - -- ... and we are back in the original TcS inerts - -- Notice that the original includes the _insoluble_simples so it was safe to ignore - -- them in the beginning of this function. - ; traceTcS "solveNestedImplications end }" $ - vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] - - ; return (catBagMaybes unsolved_implics) } - -solveImplication :: Implication -- Wanted - -> TcS (Maybe Implication) -- Simplified implication (empty or singleton) --- Precondition: The TcS monad contains an empty worklist and given-only inerts --- which after trying to solve this implication we must restore to their original value -solveImplication imp@(Implic { ic_tclvl = tclvl - , ic_binds = ev_binds_var - , ic_given = given_ids - , ic_wanted = wanteds - , ic_info = info - , ic_status = status }) - | isSolvedStatus status - = return (Just imp) -- Do nothing - - | otherwise -- Even for IC_Insoluble it is worth doing more work - -- The insoluble stuff might be in one sub-implication - -- and other unsolved goals in another; and we want to - -- solve the latter as much as possible - = do { inerts <- getInertSet - ; traceTcS "solveImplication {" (ppr imp $$ text "Inerts" <+> ppr inerts) - - -- commented out; see `where` clause below - -- ; when debugIsOn check_tc_level - - -- Solve the nested constraints - ; (has_given_eqs, given_insols, residual_wanted) - <- nestImplicTcS ev_binds_var tclvl $ - do { let loc = mkGivenLoc tclvl info (ic_env imp) - givens = mkGivens loc given_ids - ; solveSimpleGivens givens - - ; residual_wanted <- solveWanteds wanteds - - ; (has_eqs, given_insols) <- getHasGivenEqs tclvl - -- Call getHasGivenEqs /after/ solveWanteds, because - -- solveWanteds can augment the givens, via expandSuperClasses, - -- to reveal given superclass equalities - - ; return (has_eqs, given_insols, residual_wanted) } - - ; traceTcS "solveImplication 2" - (ppr given_insols $$ ppr residual_wanted) - ; let final_wanted = residual_wanted `addInsols` given_insols - -- Don't lose track of the insoluble givens, - -- which signal unreachable code; put them in ic_wanted - - ; res_implic <- setImplicationStatus (imp { ic_given_eqs = has_given_eqs - , ic_wanted = final_wanted }) - - ; evbinds <- TcS.getTcEvBindsMap ev_binds_var - ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var - ; traceTcS "solveImplication end }" $ vcat - [ text "has_given_eqs =" <+> ppr has_given_eqs - , text "res_implic =" <+> ppr res_implic - , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) - , text "implication tvcs =" <+> ppr tcvs ] - - ; return res_implic } - - -- TcLevels must be strictly increasing (see (ImplicInv) in - -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), - -- and in fact I think they should always increase one level at a time. - - -- Though sensible, this check causes lots of testsuite failures. It is - -- remaining commented out for now. - {- - check_tc_level = do { cur_lvl <- TcS.getTcLevel - ; massertPpr (tclvl == pushTcLevel cur_lvl) - (text "Cur lvl =" <+> ppr cur_lvl $$ text "Imp lvl =" <+> ppr tclvl) } - -} - ----------------------- -setImplicationStatus :: Implication -> TcS (Maybe Implication) --- Finalise the implication returned from solveImplication, --- setting the ic_status field --- Precondition: the ic_status field is not already IC_Solved --- Return Nothing if we can discard the implication altogether -setImplicationStatus implic@(Implic { ic_status = old_status - , ic_info = info - , ic_wanted = wc - , ic_given = givens }) - | assertPpr (not (isSolvedStatus old_status)) (ppr info) $ - -- Precondition: we only set the status if it is not already solved - not (isSolvedWC pruned_wc) - = do { traceTcS "setImplicationStatus(not-all-solved) {" (ppr implic) - - ; implic <- neededEvVars implic - - ; let new_status | insolubleWC pruned_wc = IC_Insoluble - | otherwise = IC_Unsolved - new_implic = implic { ic_status = new_status - , ic_wanted = pruned_wc } - - ; traceTcS "setImplicationStatus(not-all-solved) }" (ppr new_implic) - - ; return $ Just new_implic } - - | otherwise -- Everything is solved - -- Set status to IC_Solved, - -- and compute the dead givens and outer needs - -- See Note [Tracking redundant constraints] - = do { traceTcS "setImplicationStatus(all-solved) {" (ppr implic) - - ; implic@(Implic { ic_need_inner = need_inner - , ic_need_outer = need_outer }) <- neededEvVars implic - - ; bad_telescope <- checkBadTelescope implic - - ; let warn_givens = findUnnecessaryGivens info need_inner givens - - discard_entire_implication -- Can we discard the entire implication? - = null warn_givens -- No warning from this implication - && not bad_telescope - && isEmptyWC pruned_wc -- No live children - && isEmptyVarSet need_outer -- No needed vars to pass up to parent - - final_status - | bad_telescope = IC_BadTelescope - | otherwise = IC_Solved { ics_dead = warn_givens } - final_implic = implic { ic_status = final_status - , ic_wanted = pruned_wc } - - ; traceTcS "setImplicationStatus(all-solved) }" $ - vcat [ text "discard:" <+> ppr discard_entire_implication - , text "new_implic:" <+> ppr final_implic ] - - ; return $ if discard_entire_implication - then Nothing - else Just final_implic } - where - WC { wc_simple = simples, wc_impl = implics, wc_errors = errs } = wc - - pruned_implics = filterBag keep_me implics - pruned_wc = WC { wc_simple = simples - , wc_impl = pruned_implics - , wc_errors = errs } -- do not prune holes; these should be reported - - keep_me :: Implication -> Bool - keep_me ic - | IC_Solved { ics_dead = dead_givens } <- ic_status ic - -- Fully solved - , null dead_givens -- No redundant givens to report - , isEmptyBag (wc_impl (ic_wanted ic)) - -- And no children that might have things to report - = False -- Tnen we don't need to keep it - | otherwise - = True -- Otherwise, keep it - -findUnnecessaryGivens :: SkolemInfoAnon -> VarSet -> [EvVar] -> [EvVar] -findUnnecessaryGivens info need_inner givens - | not (warnRedundantGivens info) -- Don't report redundant constraints at all - = [] - - | not (null unused_givens) -- Some givens are literally unused - = unused_givens - - | otherwise -- All givens are used, but some might - = redundant_givens -- still be redundant e.g. (Eq a, Ord a) - - where - in_instance_decl = case info of { InstSkol {} -> True; _ -> False } - -- See Note [Redundant constraints in instance decls] - - unused_givens = filterOut is_used givens - - is_used given = is_type_error given - || given `elemVarSet` need_inner - || (in_instance_decl && is_improving (idType given)) - - minimal_givens = mkMinimalBySCs evVarPred givens - is_minimal = (`elemVarSet` mkVarSet minimal_givens) - redundant_givens - | in_instance_decl = [] - | otherwise = filterOut is_minimal givens - - -- See #15232 - is_type_error id = isTopLevelUserTypeError (idType id) - - is_improving pred -- (transSuperClasses p) does not include p - = any isImprovementPred (pred : transSuperClasses pred) - -{- Note [Redundant constraints in instance decls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Instance declarations are special in two ways: - -* We don't report unused givens if they can give rise to improvement. - Example (#10100): - class Add a b ab | a b -> ab, a ab -> b - instance Add Zero b b - instance Add a b ab => Add (Succ a) b (Succ ab) - The context (Add a b ab) for the instance is clearly unused in terms - of evidence, since the dictionary has no fields. But it is still - needed! With the context, a wanted constraint - Add (Succ Zero) beta (Succ Zero) - we will reduce to (Add Zero beta Zero), and thence we get beta := Zero. - But without the context we won't find beta := Zero. - - This only matters in instance declarations. - -* We don't report givens that are a superclass of another given. E.g. - class Ord r => UserOfRegs r a where ... - instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where - The (Ord r) is not redundant, even though it is a superclass of - (UserOfRegs r CmmReg). See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance. - - Again this is specific to instance declarations. --} - - -checkBadTelescope :: Implication -> TcS Bool --- True <=> the skolems form a bad telescope --- See Note [Checking telescopes] in GHC.Tc.Types.Constraint -checkBadTelescope (Implic { ic_info = info - , ic_skols = skols }) - | checkTelescopeSkol info - = do{ skols <- mapM TcS.zonkTyCoVarKind skols - ; return (go emptyVarSet (reverse skols))} - - | otherwise - = return False - - where - go :: TyVarSet -- skolems that appear *later* than the current ones - -> [TcTyVar] -- ordered skolems, in reverse order - -> Bool -- True <=> there is an out-of-order skolem - go _ [] = False - go later_skols (one_skol : earlier_skols) - | tyCoVarsOfType (tyVarKind one_skol) `intersectsVarSet` later_skols - = True - | otherwise - = go (later_skols `extendVarSet` one_skol) earlier_skols - -warnRedundantGivens :: SkolemInfoAnon -> Bool -warnRedundantGivens (SigSkol ctxt _ _) - = case ctxt of - FunSigCtxt _ rrc -> reportRedundantConstraints rrc - ExprSigCtxt rrc -> reportRedundantConstraints rrc - _ -> False - - -- To think about: do we want to report redundant givens for - -- pattern synonyms, PatSynSigSkol? c.f #9953, comment:21. -warnRedundantGivens (InstSkol {}) = True -warnRedundantGivens _ = False - -neededEvVars :: Implication -> TcS Implication --- Find all the evidence variables that are "needed", --- and delete dead evidence bindings --- See Note [Tracking redundant constraints] --- See Note [Delete dead Given evidence bindings] --- --- - Start from initial_seeds (from nested implications) --- --- - Add free vars of RHS of all Wanted evidence bindings --- and coercion variables accumulated in tcvs (all Wanted) --- --- - Generate 'needed', the needed set of EvVars, by doing transitive --- closure through Given bindings --- e.g. Needed {a,b} --- Given a = sc_sel a2 --- Then a2 is needed too --- --- - Prune out all Given bindings that are not needed --- --- - From the 'needed' set, delete ev_bndrs, the binders of the --- evidence bindings, to give the final needed variables --- -neededEvVars implic@(Implic { ic_given = givens - , ic_binds = ev_binds_var - , ic_wanted = WC { wc_impl = implics } - , ic_need_inner = old_needs }) - = do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var - ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var - - ; let seeds1 = foldr add_implic_seeds old_needs implics - seeds2 = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds - -- It's OK to use a non-deterministic fold here - -- because add_wanted is commutative - seeds3 = seeds2 `unionVarSet` tcvs - need_inner = findNeededEvVars ev_binds seeds3 - live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds - need_outer = varSetMinusEvBindMap need_inner live_ev_binds - `delVarSetList` givens - - ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds - -- See Note [Delete dead Given evidence bindings] - - ; traceTcS "neededEvVars" $ - vcat [ text "old_needs:" <+> ppr old_needs - , text "seeds3:" <+> ppr seeds3 - , text "tcvs:" <+> ppr tcvs - , text "ev_binds:" <+> ppr ev_binds - , text "live_ev_binds:" <+> ppr live_ev_binds ] - - ; return (implic { ic_need_inner = need_inner - , ic_need_outer = need_outer }) } - where - add_implic_seeds (Implic { ic_need_outer = needs }) acc - = needs `unionVarSet` acc - - needed_ev_bind needed (EvBind { eb_lhs = ev_var - , eb_info = info }) - | EvBindGiven{} <- info = ev_var `elemVarSet` needed - | otherwise = True -- Keep all wanted bindings - - add_wanted :: EvBind -> VarSet -> VarSet - add_wanted (EvBind { eb_info = info, eb_rhs = rhs }) needs - | EvBindGiven{} <- info = needs -- Add the rhs vars of the Wanted bindings only - | otherwise = evVarsOfTerm rhs `unionVarSet` needs - -------------------------------------------------- -simplifyDelayedErrors :: Bag DelayedError -> TcS (Bag DelayedError) --- Simplify any delayed errors: e.g. type and term holes --- NB: At this point we have finished with all the simple --- constraints; they are in wc_simple, not in the inert set. --- So those Wanteds will not rewrite these delayed errors. --- That's probably no bad thing. --- --- However if we have [W] alpha ~ Maybe a, [W] alpha ~ Int --- and _ : alpha, then we'll /unify/ alpha with the first of --- the Wanteds we get, and thereby report (_ : Maybe a) or --- (_ : Int) unpredictably, depending on which we happen to see --- first. Doesn't matter much; there is a type error anyhow. --- T17139 is a case in point. -simplifyDelayedErrors = mapBagM simpl_err - where - simpl_err :: DelayedError -> TcS DelayedError - simpl_err (DE_Hole hole) = DE_Hole <$> simpl_hole hole - simpl_err err@(DE_NotConcrete {}) = return err - - simpl_hole :: Hole -> TcS Hole - - -- See Note [Do not simplify ConstraintHoles] - simpl_hole h@(Hole { hole_sort = ConstraintHole }) = return h - - -- other wildcards should be simplified for printing - -- we must do so here, and not in the error-message generation - -- code, because we have all the givens already set up - simpl_hole h@(Hole { hole_ty = ty, hole_loc = loc }) - = do { ty' <- rewriteType loc ty - ; traceTcS "simpl_hole" (ppr ty $$ ppr ty') - ; return (h { hole_ty = ty' }) } - -{- Note [Delete dead Given evidence bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As a result of superclass expansion, we speculatively -generate evidence bindings for Givens. E.g. - f :: (a ~ b) => a -> b -> Bool - f x y = ... -We'll have - [G] d1 :: (a~b) -and we'll speculatively generate the evidence binding - [G] d2 :: (a ~# b) = sc_sel d - -Now d2 is available for solving. But it may not be needed! Usually -such dead superclass selections will eventually be dropped as dead -code, but: - - * It won't always be dropped (#13032). In the case of an - unlifted-equality superclass like d2 above, we generate - case heq_sc d1 of d2 -> ... - and we can't (in general) drop that case expression in case - d1 is bottom. So it's technically unsound to have added it - in the first place. - - * Simply generating all those extra superclasses can generate lots of - code that has to be zonked, only to be discarded later. Better not - to generate it in the first place. - - Moreover, if we simplify this implication more than once - (e.g. because we can't solve it completely on the first iteration - of simpl_loop), we'll generate all the same bindings AGAIN! - -Easy solution: take advantage of the work we are doing to track dead -(unused) Givens, and use it to prune the Given bindings too. This is -all done by neededEvVars. - -This led to a remarkable 25% overall compiler allocation decrease in -test T12227. - -But we don't get to discard all redundant equality superclasses, alas; -see #15205. - -Note [Do not simplify ConstraintHoles] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Before printing the inferred value for a type hole (a _ wildcard in -a partial type signature), we simplify it w.r.t. any Givens. This -makes for an easier-to-understand diagnostic for the user. - -However, we do not wish to do this for extra-constraint holes. Here is -the example for why (partial-sigs/should_compile/T12844): - - bar :: _ => FooData rngs - bar = foo - - data FooData rngs - - class Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs - - type family Head (xs :: [k]) where Head (x ': xs) = x - -GHC correctly infers that the extra-constraints wildcard on `bar` -should be (Head rngs ~ '(r, r'), Foo rngs). It then adds this -constraint as a Given on the implication constraint for `bar`. (This -implication is emitted by emitResidualConstraints.) The Hole for the _ -is stored within the implication's WantedConstraints. When -simplifyHoles is called, that constraint is already assumed as a -Given. Simplifying with respect to it turns it into ('(r, r') ~ '(r, -r'), Foo rngs), which is disastrous. - -Furthermore, there is no need to simplify here: extra-constraints wildcards -are filled in with the output of the solver, in chooseInferredQuantifiers -(choose_psig_context), so they are already simplified. (Contrast to normal -type holes, which are just bound to a meta-variable.) Avoiding the poor output -is simple: just don't simplify extra-constraints wildcards. - -This is the only reason we need to track ConstraintHole separately -from TypeHole in HoleSort. - -See also Note [Extra-constraint holes in partial type signatures] -in GHC.Tc.Gen.HsType. - -Note [Tracking redundant constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -With Opt_WarnRedundantConstraints, GHC can report which -constraints of a type signature (or instance declaration) are -redundant, and can be omitted. Here is an overview of how it -works. - -This is all tested in typecheck/should_compile/T20602 (among -others). - ------ What is a redundant constraint? - -* The things that can be redundant are precisely the Given - constraints of an implication. - -* A constraint can be redundant in two different ways: - a) It is not needed by the Wanted constraints covered by the - implication E.g. - f :: Eq a => a -> Bool - f x = True -- Equality not used - b) It is implied by other givens. E.g. - f :: (Eq a, Ord a) => blah -- Eq a unnecessary - g :: (Eq a, a~b, Eq b) => blah -- Either Eq a or Eq b unnecessary - -* To find (a) we need to know which evidence bindings are 'wanted'; - hence the eb_is_given field on an EvBind. - -* To find (b), we use mkMinimalBySCs on the Givens to see if any - are unnecessary. - ------ How tracking works - -(RC1) When two Givens are the same, we drop the evidence for the one - that requires more superclass selectors. This is done - according to 2(c) of Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. - -(RC2) The ic_need fields of an Implic records in-scope (given) evidence - variables bound by the context, that were needed to solve this - implication (so far). See the declaration of Implication. - -(RC3) setImplicationStatus: - When the constraint solver finishes solving all the wanteds in - an implication, it sets its status to IC_Solved - - - The ics_dead field, of IC_Solved, records the subset of this - implication's ic_given that are redundant (not needed). - - - We compute which evidence variables are needed by an implication - in setImplicationStatus. A variable is needed if - a) it is free in the RHS of a Wanted EvBind, - b) it is free in the RHS of an EvBind whose LHS is needed, or - c) it is in the ics_need of a nested implication. - - - After computing which variables are needed, we then look at the - remaining variables for internal redundancies. This is case (b) - from above. This is also done in setImplicationStatus. - Note that we only look for case (b) if case (a) shows up empty, - as exemplified below. - - - We need to be careful not to discard an implication - prematurely, even one that is fully solved, because we might - thereby forget which variables it needs, and hence wrongly - report a constraint as redundant. But we can discard it once - its free vars have been incorporated into its parent; or if it - simply has no free vars. This careful discarding is also - handled in setImplicationStatus. - -(RC4) We do not want to report redundant constraints for implications - that come from quantified constraints. Example #23323: - data T a - instance Show (T a) where ... -- No context! - foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int - bar = foo @T @Eq - - The call to `foo` gives us - [W] d : (forall a. Eq a => Show (T a)) - To solve this, GHC.Tc.Solver.Solve.solveForAll makes an implication constraint: - forall a. Eq a => [W] ds : Show (T a) - and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a` - constraint. But we don't want to report it as redundant! - -* Examples: - - f, g, h :: (Eq a, Ord a) => a -> Bool - f x = x == x - g x = x > x - h x = x == x && x > x - - All three will discover that they have two [G] Eq a constraints: - one as given and one extracted from the Ord a constraint. They will - both discard the latter, as noted above and in - Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. - - The body of f uses the [G] Eq a, but not the [G] Ord a. It will - report a redundant Ord a using the logic for case (a). - - The body of g uses the [G] Ord a, but not the [G] Eq a. It will - report a redundant Eq a using the logic for case (a). - - The body of h uses both [G] Ord a and [G] Eq a. Case (a) will - thus come up with nothing redundant. But then, the case (b) - check will discover that Eq a is redundant and report this. - - If we did case (b) even when case (a) reports something, then - we would report both constraints as redundant for f, which is - terrible. - ------ Reporting redundant constraints - -* GHC.Tc.Errors does the actual warning, in warnRedundantConstraints. - -* We don't report redundant givens for *every* implication; only - for those which reply True to GHC.Tc.Solver.warnRedundantGivens: - - - For example, in a class declaration, the default method *can* - use the class constraint, but it certainly doesn't *have* to, - and we don't want to report an error there. Ditto instance decls. - - - More subtly, in a function definition - f :: (Ord a, Ord a, Ix a) => a -> a - f x = rhs - we do an ambiguity check on the type (which would find that one - of the Ord a constraints was redundant), and then we check that - the definition has that type (which might find that both are - redundant). We don't want to report the same error twice, so we - disable it for the ambiguity check. Hence using two different - FunSigCtxts, one with the warn-redundant field set True, and the - other set False in - - GHC.Tc.Gen.Bind.tcSpecPrag - - GHC.Tc.Gen.Bind.tcTySig - - This decision is taken in setImplicationStatus, rather than GHC.Tc.Errors - so that we can discard implication constraints that we don't need. - So ics_dead consists only of the *reportable* redundant givens. - ------ Shortcomings - -Shortcoming 1. Consider - - j :: (Eq a, a ~ b) => a -> Bool - j x = x == x - - k :: (Eq a, b ~ a) => a -> Bool - k x = x == x - -Currently (Nov 2021), j issues no warning, while k says that b ~ a -is redundant. This is because j uses the a ~ b constraint to rewrite -everything to be in terms of b, while k does none of that. This is -ridiculous, but I (Richard E) don't see a good fix. - -Shortcoming 2. Removing a redundant constraint can cause clients to fail to -compile, by making the function more polymoprhic. Consider (#16154) - - f :: (a ~ Bool) => a -> Int - f x = 3 - - g :: String -> Int - g s = f (read s) - -The constraint in f's signature is redundant; not used to typecheck -`f`. And yet if you remove it, `g` won't compile, because there'll -be an ambiguous variable in `g`. --} - -type UnificationDone = Bool - -noUnification, didUnification :: UnificationDone -noUnification = False -didUnification = True - --- | Like 'defaultTyVar', but in the TcS monad. -defaultTyVarTcS :: TcTyVar -> TcS UnificationDone -defaultTyVarTcS the_tv - | isTyVarTyVar the_tv - -- TyVarTvs should only be unified with a tyvar - -- never with a type; c.f. GHC.Tc.Utils.TcMType.defaultTyVar - -- and Note [Inferring kinds for type declarations] in GHC.Tc.TyCl - = return noUnification - | isRuntimeRepVar the_tv - = do { traceTcS "defaultTyVarTcS RuntimeRep" (ppr the_tv) - ; unifyTyVar the_tv liftedRepTy - ; return didUnification } - | isLevityVar the_tv - = do { traceTcS "defaultTyVarTcS Levity" (ppr the_tv) - ; unifyTyVar the_tv liftedDataConTy - ; return didUnification } - | isMultiplicityVar the_tv - = do { traceTcS "defaultTyVarTcS Multiplicity" (ppr the_tv) - ; unifyTyVar the_tv ManyTy - ; return didUnification } - | otherwise - = return noUnification -- the common case - -approximateWC :: Bool -- See Wrinkle (W3) in Note [ApproximateWC] - -> WantedConstraints - -> Cts --- Second return value is the depleted wc --- Postcondition: Wanted Cts --- See Note [ApproximateWC] --- See Note [floatKindEqualities vs approximateWC] -approximateWC float_past_equalities wc - = float_wc False emptyVarSet wc - where - float_wc :: Bool -- True <=> there are enclosing equalities - -> TcTyCoVarSet -- Enclosing skolem binders - -> WantedConstraints -> Cts - float_wc encl_eqs trapping_tvs (WC { wc_simple = simples, wc_impl = implics }) - = filterBag (is_floatable encl_eqs trapping_tvs) simples `unionBags` - concatMapBag (float_implic encl_eqs trapping_tvs) implics - - float_implic :: Bool -> TcTyCoVarSet -> Implication -> Cts - float_implic encl_eqs trapping_tvs imp - = float_wc new_encl_eqs new_trapping_tvs (ic_wanted imp) - where - new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp - new_encl_eqs = encl_eqs || ic_given_eqs imp == MaybeGivenEqs - - is_floatable encl_eqs skol_tvs ct - | isGivenCt ct = False - | insolubleCt ct = False - | tyCoVarsOfCt ct `intersectsVarSet` skol_tvs = False - | otherwise - = case classifyPredType (ctPred ct) of - EqPred {} -> float_past_equalities || not encl_eqs - -- See Wrinkle (W1) - ClassPred {} -> True -- See Wrinkle (W2) - IrredPred {} -> True -- ..both in Note [ApproximateWC] - ForAllPred {} -> False - -{- Note [ApproximateWC] -~~~~~~~~~~~~~~~~~~~~~~~ -approximateWC takes a constraint, typically arising from the RHS of a -let-binding whose type we are *inferring*, and extracts from it some -*simple* constraints that we might plausibly abstract over. Of course -the top-level simple constraints are plausible, but we also float constraints -out from inside, if they are not captured by skolems. - -The same function is used when doing type-class defaulting (see the call -to applyDefaultingRules) to extract constraints that might be defaulted. - -Wrinkle (W1) - When inferring most-general types (in simplifyInfer), we - do *not* float an equality constraint if the implication binds - equality constraints, because that defeats the OutsideIn story. - Consider data T a where TInt :: T Int MkT :: T a - - f TInt = 3::Int - - We get the implication (a ~ Int => res ~ Int), where so far we've decided - f :: T a -> res - We don't want to float (res~Int) out because then we'll infer - f :: T a -> Int - which is only on of the possible types. (GHC 7.6 accidentally *did* - float out of such implications, which meant it would happily infer - non-principal types.) - -Wrinkle (W2) - We do allow /class/ constraints to float, even if - the implication binds equalities. This is a subtle point: see #23224. - In principle, a class constraint might ultimately be satisfiable from - a constraint bound by an implication (see #19106 for an example of this - kind), but it's extremely obscure and I was unable to construct a - concrete example. In any case, in super-subtle cases where this might - make a difference, you would be much better advised to simply write a - type signature. - - I included IrredPred here too, for good measure. In general, - abstracting over more constraints does no harm. - -Wrinkle (W3) - In findDefaultableGroups we are not worried about the - most-general type; and we /do/ want to float out of equalities - (#12797). Hence the boolean flag to approximateWC. - ------- Historical note ----------- -There used to be a second caveat, driven by #8155 - - 2. We do not float out an inner constraint that shares a type variable - (transitively) with one that is trapped by a skolem. Eg - forall a. F a ~ beta, Integral beta - We don't want to float out (Integral beta). Doing so would be bad - when defaulting, because then we'll default beta:=Integer, and that - makes the error message much worse; we'd get - Can't solve F a ~ Integer - rather than - Can't solve Integral (F a) - - Moreover, floating out these "contaminated" constraints doesn't help - when generalising either. If we generalise over (Integral b), we still - can't solve the retained implication (forall a. F a ~ b). Indeed, - arguably that too would be a harder error to understand. - -But this transitive closure stuff gives rise to a complex rule for -when defaulting actually happens, and one that was never documented. -Moreover (#12923), the more complex rule is sometimes NOT what -you want. So I simply removed the extra code to implement the -contamination stuff. There was zero effect on the testsuite (not even #8155). ------- End of historical note ----------- - -Note [DefaultTyVar] -~~~~~~~~~~~~~~~~~~~ -defaultTyVar is used on any un-instantiated meta type variables to -default any RuntimeRep variables to LiftedRep. This is important -to ensure that instance declarations match. For example consider - - instance Show (a->b) - foo x = show (\_ -> True) - -Then we'll get a constraint (Show (p ->q)) where p has kind (TYPE r), -and that won't match the typeKind (*) in the instance decl. See tests -tc217 and tc175. - -We look only at touchable type variables. No further constraints -are going to affect these type variables, so it's time to do it by -hand. However we aren't ready to default them fully to () or -whatever, because the type-class defaulting rules have yet to run. - -An alternate implementation would be to emit a Wanted constraint setting -the RuntimeRep variable to LiftedRep, but this seems unnecessarily indirect. - -Note [Promote _and_ default when inferring] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we are inferring a type, we simplify the constraint, and then use -approximateWC to produce a list of candidate constraints. Then we MUST - - a) Promote any meta-tyvars that have been floated out by - approximateWC, to restore invariant (WantedInv) described in - Note [TcLevel invariants] in GHC.Tc.Utils.TcType. - - b) Default the kind of any meta-tyvars that are not mentioned in - in the environment. - -To see (b), suppose the constraint is (C ((a :: OpenKind) -> Int)), and we -have an instance (C ((x:*) -> Int)). The instance doesn't match -- but it -should! If we don't solve the constraint, we'll stupidly quantify over -(C (a->Int)) and, worse, in doing so skolemiseQuantifiedTyVar will quantify over -(b:*) instead of (a:OpenKind), which can lead to disaster; see #7332. -#7641 is a simpler example. - -Note [Promoting unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we float an equality out of an implication we must "promote" free -unification variables of the equality, in order to maintain Invariant -(WantedInv) from Note [TcLevel invariants] in GHC.Tc.Types.TcType. - -This is absolutely necessary. Consider the following example. We start -with two implications and a class with a functional dependency. - - class C x y | x -> y - instance C [a] [a] - - (I1) [untch=beta]forall b. 0 => F Int ~ [beta] - (I2) [untch=beta]forall c. 0 => F Int ~ [[alpha]] /\ C beta [c] - -We float (F Int ~ [beta]) out of I1, and we float (F Int ~ [[alpha]]) out of I2. -They may react to yield that (beta := [alpha]) which can then be pushed inwards -the leftover of I2 to get (C [alpha] [a]) which, using the FunDep, will mean that -(alpha := a). In the end we will have the skolem 'b' escaping in the untouchable -beta! Concrete example is in indexed_types/should_fail/ExtraTcsUntch.hs: - - class C x y | x -> y where - op :: x -> y -> () - - instance C [a] [a] - - type family F a :: * - - h :: F Int -> () - h = undefined - - data TEx where - TEx :: a -> TEx - - f (x::beta) = - let g1 :: forall b. b -> () - g1 _ = h [x] - g2 z = case z of TEx y -> (h [[undefined]], op x [y]) - in (g1 '3', g2 undefined) - - -********************************************************************************* -* * -* Defaulting and disambiguation * -* * -********************************************************************************* - -Note [How type-class constraints are defaulted] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Type-class defaulting deals with the situation where we have unsolved -constraints like (Num alpha), where `alpha` is a unification variable. We want -to pick a default for `alpha`, such as `alpha := Int` to resolve the ambiguity. - -The function 'tryTypeClassDefaulting' implements type-class defaulting. The -algorithm for defaulting depends on whether certain extensions are enabled, -such as -XOverloadedStrings or -XExtendedDefaultRules. To explain this, let us -define the following: - - Unary typeclass: - a typeclass with a single visible type argument. - - Examples: - - Num :: Type -> Constraint - Eq :: Type -> Constraint - Foldable :: (Type -> Type) -> Constraint - Typeable :: forall k. k -> Constraint -- NB: also has an /invisible/ argument - - Non-examples: - - Nullary :: Constraint - Binary :: Type -> Type -> Constraint - Binary2 :: forall k -> k -> Constraint -- Two visible arguments - - Defaultable class - a typeclass which has at least one in-scope default declaration - - This includes the two different categories of default declarations: - - - Haskell 98 default declarations such as 'default (Integer, Float)'. - - - `Num` is always defaultable; either the user says 'default( Integer, Float )' - or (absent such a declaration) the system fills in a fallback default declaration. - See Section 4.3.4 in https://www.haskell.org/onlinereport/haskell2010/haskellch4.html - - - With `OverloadedStrings`, the class `IsString` is defaultable - - With `ExtendedDefaultRules`, the classes `Show`, `Eq`, `Ord`, `Foldable` and `Traversable` - are defaultable - - - Named default declarations, which apply to the named class, e.g. - 'default Cls(X, Y)' applies precisely to 'Cls'. - Note that these may be locally defined, or they may be imported. - - Standard class: - a class defined in the Prelude or the standard library, as defined - by the Haskell 98 report (section 4.3.4) - - These are defined in GHC.Builtin.Names.standardClassKeys. - -The rules for defaulting a collection 'S' of unsolved constraints are as follows: - - 1. For each metavariable 'v' appearing in 'S', define - - U_v = { C v | C v ∈ U, C is a unary typeclass } - - We then process each 'U_v' in turn, in order to find a defaulting - assignment 'v := ty' that solves all of 'U_v'. - - 2. Unless -XExtendedDefaultRules is in effect, give up if 'v' appears: - - - in any constraint that isn't a unary class constraint - - in a class constraint which is non-standard and does not have - a default declaration in scope. - - 3. Compute candidate assignments: for each unary typeclass 'C' in 'U_v' which - has a default declaration in scope, find the first type 'ty' in the list - of in-scope default types for 'C' for which all of 'U_v' is soluble. - - 4. If there is precisely one type candidate type assignment 'ty' that allows - all of 'U_v' to be solved, we default 'v := ty'. Otherwise, do nothing - ('v' remains ambiguous). - -Note [Defaulting plugins] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Defaulting plugins enable extending or overriding the defaulting -behaviour. In `applyDefaultingRules`, before the built-in defaulting -mechanism runs, the loaded defaulting plugins are passed the -`WantedConstraints` and get a chance to propose defaulting assignments -based on them. - -Proposals are represented as `[DefaultingProposal]` with each proposal -consisting of a type variable to fill-in, the list of defaulting types to -try in order, and a set of constraints to check at each try. This is -the same representation (albeit in a nicely packaged-up data type) as -the candidates generated by the built-in defaulting mechanism, so the -actual trying of proposals is done by the same `disambigGroup` function. - -Wrinkle (DP1): The role of `WantedConstraints` - - Plugins are passed `WantedConstraints` that can perhaps be - progressed on by defaulting. But a defaulting plugin is not a solver - plugin, its job is to provide defaulting proposals, i.e. mappings of - type variable to types. How do plugins know which type variables - they are supposed to default? - - The `WantedConstraints` passed to the defaulting plugin are zonked - beforehand to ensure all remaining metavariables are unfilled. Thus, - the `WantedConstraints` serve a dual purpose: they are both the - constraints of the given context that can act as hints to the - defaulting, as well as the containers of the type variables under - consideration for defaulting. - -Wrinkle (DP2): Interactions between defaulting mechanisms - - In the general case, we have multiple defaulting plugins loaded and - there is also the built-in defaulting mechanism. In this case, we - have to be careful to keep the `WantedConstraints` passed to the - plugins up-to-date by zonking between successful defaulting - rounds. Otherwise, two plugins might come up with a defaulting - proposal for the same metavariable; if the first one is accepted by - `disambigGroup` (thus the meta gets filled), the second proposal - becomes invalid (see #23821 for an example). - --} - -tryTypeClassDefaulting :: WantedConstraints -> TcS WantedConstraints -tryTypeClassDefaulting wc - | isEmptyWC wc || insolubleWC wc -- See Note [Defaulting insolubles] - = return wc - | otherwise -- See Note [When to do type-class defaulting] - = do { something_happened <- applyDefaultingRules wc - -- See Note [Top-level Defaulting Plan] - ; solveAgainIf something_happened wc } - -applyDefaultingRules :: WantedConstraints -> TcS Bool --- True <=> I did some defaulting, by unifying a meta-tyvar --- Input WantedConstraints are not necessarily zonked --- See Note [How type-class constraints are defaulted] - -applyDefaultingRules wanteds - | isEmptyWC wanteds - = return False - | otherwise - = do { (default_env, extended_rules) <- getDefaultInfo - ; wanteds <- TcS.zonkWC wanteds - - ; tcg_env <- TcS.getGblEnv - ; let plugins = tcg_defaulting_plugins tcg_env - default_tys = defaultList default_env - -- see Note [Named default declarations] in GHC.Tc.Gen.Default - - -- Run any defaulting plugins - -- See Note [Defaulting plugins] for an overview - ; (wanteds, plugin_defaulted) <- if null plugins then return (wanteds, []) else - do { - ; traceTcS "defaultingPlugins {" (ppr wanteds) - ; (wanteds, defaultedGroups) <- mapAccumLM run_defaulting_plugin wanteds plugins - ; traceTcS "defaultingPlugins }" (ppr defaultedGroups) - ; return (wanteds, defaultedGroups) - } - - ; let groups = findDefaultableGroups (default_tys, extended_rules) wanteds - - ; traceTcS "applyDefaultingRules {" $ - vcat [ text "wanteds =" <+> ppr wanteds - , text "groups =" <+> ppr groups - , text "info =" <+> ppr (default_tys, extended_rules) ] - - ; something_happeneds <- mapM (disambigGroup wanteds default_tys) groups - - ; traceTcS "applyDefaultingRules }" (ppr something_happeneds) - - ; return $ or something_happeneds || or plugin_defaulted } - - where - run_defaulting_plugin wanteds p - = do { groups <- runTcPluginTcS (p wanteds) - ; defaultedGroups <- - filterM (\g -> disambigMultiGroup - wanteds - (deProposalCts g) - (ProposalSequence (Proposal <$> deProposals g))) - groups - ; traceTcS "defaultingPlugin " $ ppr defaultedGroups - ; case defaultedGroups of - [] -> return (wanteds, False) - _ -> do - -- If a defaulting plugin solves any tyvars, some of the wanteds - -- will have filled-in metavars by now (see wrinkle DP2 of - -- Note [Defaulting plugins]). So we re-zonk to make sure later - -- defaulting doesn't try to solve the same metavars. - wanteds' <- TcS.zonkWC wanteds - return (wanteds', True) } - -findDefaultableGroups - :: ( [ClassDefaults] - , Bool ) -- extended default rules - -> WantedConstraints -- Unsolved - -> [(TyVar, [Ct])] -findDefaultableGroups (default_tys, extended_defaults) wanteds - | null default_tys - = [] - | otherwise - = [ (tv, map fstOf3 group) - | group'@((_,_,tv) :| _) <- unary_groups - , let group = toList group' - , defaultable_tyvar tv - , defaultable_classes (map sndOf3 group) ] - where - simples = approximateWC True wanteds - (unaries, non_unaries) = partitionWith find_unary (bagToList simples) - unary_groups = equivClasses cmp_tv unaries - - unary_groups :: [NonEmpty (Ct, Class, TcTyVar)] -- (C tv) constraints - unaries :: [(Ct, Class, TcTyVar)] -- (C tv) constraints - non_unaries :: [Ct] -- and *other* constraints - - -- Finds unary type-class constraints - -- But take account of polykinded classes like Typeable, - -- which may look like (Typeable Type (a:Type)) (#8931) - -- See step (1) in Note [How type-class constraints are defaulted] - find_unary :: Ct -> Either (Ct, Class, TyVar) Ct - find_unary cc - | Just (cls,tys) <- getClassPredTys_maybe (ctPred cc) - , [ty] <- filterOutInvisibleTypes (classTyCon cls) tys - -- Ignore invisible arguments for this purpose - , Just tv <- getTyVar_maybe ty - , isMetaTyVar tv -- We might have runtime-skolems in GHCi, and - -- we definitely don't want to try to assign to those! - = Left (cc, cls, tv) - find_unary cc = Right cc -- Non unary or non dictionary - - nonunary_tvs :: TcTyCoVarSet -- TyVars mentioned by non-unaries - nonunary_tvs = mapUnionVarSet tyCoVarsOfCt non_unaries - - cmp_tv (_,_,tv1) (_,_,tv2) = tv1 `compare` tv2 - - defaultable_tyvar :: TcTyVar -> Bool - defaultable_tyvar tv - = let b1 = isTyConableTyVar tv -- Note [Avoiding spurious errors] - b2 = not (tv `elemVarSet` nonunary_tvs) - in b1 && (b2 || extended_defaults) -- Note [Multi-parameter defaults] - - -- Determines whether the collection of class constraints permits defaulting. - -- See step (2) in Note [How type-class constraints are defaulted] - defaultable_classes :: [Class] -> Bool - defaultable_classes clss = - -- One of the classes has a default declaration in scope - -- (this includes 'Num', and e.g. 'IsString' with -XOverloadedStrings) - any (`elementOfUniqSet` classes_with_defaults) clss - && - -- AND, either: - -- - ExtendedDefaultRules is in effect, or - -- - all the classes are standard or have a default declaration in scope - (extended_defaults || all is_std_or_has_default clss) - is_std_or_has_default :: Class -> Bool - is_std_or_has_default cls = - (getUnique cls `elem` standardClassKeys) - || - (cls `elementOfUniqSet` classes_with_defaults) - - -- All classes with a default declaration in scope; either: - -- - -- - a named default declaration such as 'default C(Double, Bool)', or - -- - a Haskell 98 default declaration such as 'default(Int, Float)', - -- which adds defaults for Num, for IsString with OverloadedStrings, - -- and for Foldable/Traversable/... with ExtendedDefaultRules - classes_with_defaults = mkUniqSet $ map cd_class default_tys - ------------------------------- - --- | 'Proposal's to be tried in sequence until the first one that succeeds -newtype ProposalSequence = ProposalSequence{getProposalSequence :: [Proposal]} - --- | An atomic set of proposed type assignments to try applying all at once -newtype Proposal = Proposal [(TcTyVar, Type)] - -instance Outputable ProposalSequence where - ppr (ProposalSequence proposals) = ppr proposals -instance Outputable Proposal where - ppr (Proposal assignments) = ppr assignments - -disambigGroup :: WantedConstraints -- ^ Original constraints, for diagnostic purposes - -> [ClassDefaults] -- ^ The default classes and types - -> (TcTyVar, [Ct]) -- ^ All constraints sharing same type variable - -> TcS Bool -- True <=> something happened, reflected in ty_binds -disambigGroup orig_wanteds default_ctys (tv, wanteds) - = disambigProposalSequences orig_wanteds wanteds proposalSequences allConsistent - where - proposalSequences = [ ProposalSequence [Proposal [(tv, ty)] | ty <- tys] - | ClassDefaults{cd_types = tys} <- defaultses ] - allConsistent ((_, sub) :| subs) = all (eqSubAt tv sub . snd) subs - defaultses = - [ defaults | defaults@ClassDefaults{cd_class = cls} <- default_ctys - , any (isDictForClass (className cls)) wanteds ] - isDictForClass clcon ct = any ((clcon ==) . className . fst) (getClassPredTys_maybe $ ctPred ct) - eqSubAt :: TcTyVar -> Subst -> Subst -> Bool - eqSubAt tvar s1 s2 = or $ liftA2 tcEqType (lookupTyVar s1 tvar) (lookupTyVar s2 tvar) - --- See Note [How type-class constraints are defaulted] -disambigMultiGroup :: WantedConstraints -- ^ Original constraints, for diagnostic purposes - -> [Ct] -- ^ check these are solved by defaulting - -> ProposalSequence -- ^ defaulting type assignments to try - -> TcS Bool -- True <=> something happened, reflected in ty_binds -disambigMultiGroup orig_wanteds wanteds proposalSequence - = disambigProposalSequences orig_wanteds wanteds [proposalSequence] (const True) - -disambigProposalSequences :: WantedConstraints -- ^ Original constraints, for diagnostic purposes - -> [Ct] -- ^ Check these are solved by defaulting - -> [ProposalSequence] -- ^ The sequences of assignment proposals - -> (NonEmpty ([TcTyVar], Subst) -> Bool) - -- ^ Predicate for successful assignments - -> TcS Bool -- True <=> something happened, reflected in ty_binds -disambigProposalSequences orig_wanteds wanteds proposalSequences allConsistent - = do { traverse_ (traverse_ reportInvalidDefaultedTyVars . getProposalSequence) proposalSequences - ; fake_ev_binds_var <- TcS.newTcEvBinds - ; tclvl <- TcS.getTcLevel - -- Step (3) in Note [How type-class constraints are defaulted] - ; successes <- fmap catMaybes $ - nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) $ - mapM firstSuccess proposalSequences - ; traceTcS "disambigProposalSequences" (vcat [ ppr wanteds - , ppr proposalSequences - , ppr successes ]) - -- Step (4) in Note [How type-class constraints are defaulted] - ; case successes of - success@(tvs, subst) : rest - | allConsistent (success :| rest) - -> do { applyDefaultSubst tvs subst - ; let warn tv = mapM_ (warnDefaulting wanteds tv) (lookupTyVar subst tv) - ; wrapWarnTcS $ mapM_ warn tvs - ; traceTcS "disambigProposalSequences succeeded }" (ppr proposalSequences) - ; return True } - _ -> - do { traceTcS "disambigProposalSequences failed }" (ppr proposalSequences) - ; return False } } - where - reportInvalidDefaultedTyVars :: Proposal -> TcS () - firstSuccess :: ProposalSequence -> TcS (Maybe ([TcTyVar], Subst)) - firstSuccess (ProposalSequence proposals) - = getFirst <$> foldMapM (fmap First . tryDefaultGroup wanteds) proposals - reportInvalidDefaultedTyVars proposal@(Proposal assignments) - = do { let tvs = fst <$> assignments - ; invalid_tvs <- filterOutM TcS.isUnfilledMetaTyVar tvs - ; traverse_ (errInvalidDefaultedTyVar orig_wanteds proposal) (nonEmpty invalid_tvs) } - -applyDefaultSubst :: [TcTyVar] -> Subst -> TcS () -applyDefaultSubst tvs subst = - do { deep_tvs <- filterM TcS.isUnfilledMetaTyVar $ nonDetEltsUniqSet $ closeOverKinds (mkVarSet tvs) - ; forM_ deep_tvs $ \ tv -> mapM_ (unifyTyVar tv) (lookupVarEnv (getTvSubstEnv subst) tv) - } - -tryDefaultGroup :: [Ct] -- ^ check these are solved by defaulting - -> Proposal -- ^ defaulting type assignments to try - -> TcS (Maybe ([TcTyVar], Subst)) -- ^ successful substitutions, *not* reflected in ty_binds -tryDefaultGroup wanteds (Proposal assignments) - | let (tvs, default_tys) = unzip assignments - , Just subst <- tcMatchTyKis (mkTyVarTys tvs) default_tys - -- Make sure the kinds match too; hence this call to tcMatchTyKi - -- E.g. suppose the only constraint was (Typeable k (a::k)) - -- With the addition of polykinded defaulting we also want to reject - -- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here. - = do { lcl_env <- TcS.getLclEnv - ; tc_lvl <- TcS.getTcLevel - ; let loc = mkGivenLoc tc_lvl (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) - -- Equality constraints are possible due to type defaulting plugins - ; wanted_evs <- sequence [ newWantedNC loc rewriters pred' - | wanted <- wanteds - , CtWanted { ctev_pred = pred - , ctev_rewriters = rewriters } - <- return (ctEvidence wanted) - , let pred' = substTy subst pred ] - ; residual_wc <- solveSimpleWanteds $ listToBag $ map mkNonCanonical wanted_evs - ; return $ if isEmptyWC residual_wc then Just (tvs, subst) else Nothing } - - | otherwise - = return Nothing - -errInvalidDefaultedTyVar :: WantedConstraints -> Proposal -> NonEmpty TcTyVar -> TcS () -errInvalidDefaultedTyVar wanteds (Proposal assignments) problematic_tvs - = failTcS $ TcRnInvalidDefaultedTyVar tidy_wanteds tidy_assignments tidy_problems - where - proposal_tvs = concatMap (\(tv, ty) -> tv : tyCoVarsOfTypeList ty) assignments - tidy_env = tidyFreeTyCoVars emptyTidyEnv $ proposal_tvs ++ NE.toList problematic_tvs - tidy_wanteds = map (tidyCt tidy_env) $ flattenWC wanteds - tidy_assignments = [(tidyTyCoVarOcc tidy_env tv, tidyType tidy_env ty) | (tv, ty) <- assignments] - tidy_problems = fmap (tidyTyCoVarOcc tidy_env) problematic_tvs - - flattenWC :: WantedConstraints -> [Ct] - flattenWC (WC { wc_simple = cts, wc_impl = impls }) - = ctsElts cts ++ concatMap (flattenWC . ic_wanted) impls - --- In interactive mode, or with -XExtendedDefaultRules, --- we default Show a to Show () to avoid gratuitous errors on "show []" -isInteractiveClass :: Bool -- -XOverloadedStrings? - -> Class -> Bool -isInteractiveClass ovl_strings cls - = isNumClass ovl_strings cls || (classKey cls `elem` interactiveClassKeys) - - -- isNumClass adds IsString to the standard numeric classes, - -- when -XOverloadedStrings is enabled -isNumClass :: Bool -- -XOverloadedStrings? - -> Class -> Bool -isNumClass ovl_strings cls - = isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey)) - - -{- -Note [Avoiding spurious errors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When doing the unification for defaulting, we check for skolem -type variables, and simply don't default them. For example: - f = (*) -- Monomorphic - g :: Num a => a -> a - g x = f x x -Here, we get a complaint when checking the type signature for g, -that g isn't polymorphic enough; but then we get another one when -dealing with the (Num a) context arising from f's definition; -we try to unify a with Int (to default it), but find that it's -already been unified with the rigid variable from g's type sig. - -Note [Multi-parameter defaults] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -With -XExtendedDefaultRules, we default only based on single-variable -constraints, but do not exclude from defaulting any type variables which also -appear in multi-variable constraints. This means that the following will -default properly: - - default (Integer, Double) - - class A b (c :: Symbol) where - a :: b -> Proxy c - - instance A Integer c where a _ = Proxy - - main = print (a 5 :: Proxy "5") - -Note that if we change the above instance ("instance A Integer") to -"instance A Double", we get an error: - - No instance for (A Integer "5") - -This is because the first defaulted type (Integer) has successfully satisfied -its single-parameter constraints (in this case Num). + approximateWC, -- Exported for plugins to use + + captureTopConstraints, emitResidualConstraints, + + simplifyTopWanteds, + + promoteTyVarSet, simplifyAndEmitFlatConstraints + + ) where + +import GHC.Prelude + +import GHC.Tc.Errors +import GHC.Tc.Errors.Types +import GHC.Tc.Types.Evidence +import GHC.Tc.Solver.Solve ( solveSimpleGivens, solveSimpleWanteds + , solveWanteds, simplifyWantedsTcM ) +import GHC.Tc.Solver.Default ( tryDefaulting, tryDefaultingForAmbiguityCheck + , isInteractiveClass ) +import GHC.Tc.Solver.Dict ( makeSuperClasses ) +import GHC.Tc.Solver.Rewrite ( rewriteType ) +import GHC.Tc.Utils.Unify +import GHC.Tc.Utils.TcMType as TcM +import GHC.Tc.Utils.Monad as TcM +import GHC.Tc.Zonk.TcType as TcM +import GHC.Tc.Solver.InertSet +import GHC.Tc.Solver.Monad as TcS +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.CtLoc( mkGivenLoc ) +import GHC.Tc.Instance.FunDeps +import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcType + +import GHC.Core.Predicate +import GHC.Core.Type +import GHC.Core.Ppr +import GHC.Core.TyCon ( TyConBinder ) + +import GHC.Types.Name +import GHC.Types.Id + +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Basic +import GHC.Types.Error + +import GHC.Driver.DynFlags( DynFlags, xopt ) +import GHC.Driver.Flags( WarningFlag(..) ) +import GHC.Utils.Panic +import GHC.Utils.Outputable +import GHC.Utils.Misc( filterOut ) + +import GHC.Data.Bag + +import qualified GHC.LanguageExtensions as LangExt + +import Control.Monad +import Data.List ( partition ) +import GHC.Data.Maybe ( mapMaybe ) + +{- +********************************************************************************* +* * +* External interface * +* * +********************************************************************************* +-} + +captureTopConstraints :: TcM a -> TcM (a, WantedConstraints) +-- (captureTopConstraints m) runs m, and returns the type constraints it +-- generates plus the constraints produced by static forms inside. +-- If it fails with an exception, it reports any insolubles +-- (out of scope variables) before doing so +-- +-- captureTopConstraints is used exclusively by GHC.Tc.Module at the top +-- level of a module. +-- +-- Importantly, if captureTopConstraints propagates an exception, it +-- reports any insoluble constraints first, lest they be lost +-- altogether. This is important, because solveEqualities (maybe +-- other things too) throws an exception without adding any error +-- messages; it just puts the unsolved constraints back into the +-- monad. See GHC.Tc.Utils.Monad Note [Constraints and errors] +-- #16376 is an example of what goes wrong if you don't do this. +-- +-- NB: the caller should bring any environments into scope before +-- calling this, so that the reportUnsolved has access to the most +-- complete GlobalRdrEnv +captureTopConstraints thing_inside + = do { static_wc_var <- TcM.newTcRef emptyWC ; + ; (mb_res, lie) <- TcM.updGblEnv (\env -> env { tcg_static_wc = static_wc_var } ) $ + TcM.tryCaptureConstraints thing_inside + ; stWC <- TcM.readTcRef static_wc_var + + -- See GHC.Tc.Utils.Monad Note [Constraints and errors] + -- If the thing_inside threw an exception, but generated some insoluble + -- constraints, report the latter before propagating the exception + -- Otherwise they will be lost altogether + ; case mb_res of + Just res -> return (res, lie `andWC` stWC) + Nothing -> do { _ <- simplifyTop lie; failM } } + -- This call to simplifyTop is the reason + -- this function is here instead of GHC.Tc.Utils.Monad + -- We call simplifyTop so that it does defaulting + -- (esp of runtime-reps) before reporting errors + +simplifyTopImplic :: Bag Implication -> TcM () +simplifyTopImplic implics + = do { empty_binds <- simplifyTop (mkImplicWC implics) + + -- Since all the inputs are implications the returned bindings will be empty + ; massertPpr (isEmptyBag empty_binds) (ppr empty_binds) + + ; return () } + +simplifyTop :: WantedConstraints -> TcM (Bag EvBind) +-- Simplify top-level constraints +-- Usually these will be implications, +-- but when there is nothing to quantify we don't wrap +-- in a degenerate implication, so we do that here instead +simplifyTop wanteds + = do { traceTc "simplifyTop {" $ text "wanted = " <+> ppr wanteds + ; ((final_wc, unsafe_ol), binds1) <- runTcS $ + do { final_wc <- simplifyTopWanteds wanteds + ; unsafe_ol <- getSafeOverlapFailures + ; return (final_wc, unsafe_ol) } + ; traceTc "End simplifyTop }" empty + + ; binds2 <- reportUnsolved final_wc + + ; traceTc "reportUnsolved (unsafe overlapping) {" empty + ; unless (isEmptyBag unsafe_ol) $ do { + -- grab current error messages and clear, warnAllUnsolved will + -- update error messages which we'll grab and then restore saved + -- messages. + ; errs_var <- getErrsVar + ; saved_msg <- TcM.readTcRef errs_var + ; TcM.writeTcRef errs_var emptyMessages + + ; warnAllUnsolved $ emptyWC { wc_simple = fmap CDictCan unsafe_ol } + + ; whyUnsafe <- getWarningMessages <$> TcM.readTcRef errs_var + ; TcM.writeTcRef errs_var saved_msg + ; recordUnsafeInfer (mkMessages whyUnsafe) + } + ; traceTc "reportUnsolved (unsafe overlapping) }" empty + + ; return (evBindMapBinds binds1 `unionBags` binds2) } + +pushLevelAndSolveEqualities :: SkolemInfoAnon -> [TyConBinder] -> TcM a -> TcM a +-- Push level, and solve all resulting equalities +-- If there are any unsolved equalities, report them +-- and fail (in the monad) +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) +pushLevelAndSolveEqualities skol_info_anon tcbs thing_inside + = do { (tclvl, wanted, res) <- pushLevelAndSolveEqualitiesX + "pushLevelAndSolveEqualities" thing_inside + ; report_unsolved_equalities skol_info_anon (binderVars tcbs) tclvl wanted + ; return res } + +pushLevelAndSolveEqualitiesX :: String -> TcM a + -> TcM (TcLevel, WantedConstraints, a) +-- Push the level, gather equality constraints, and then solve them. +-- Returns any remaining unsolved equalities. +-- Does not report errors. +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) +pushLevelAndSolveEqualitiesX callsite thing_inside + = do { traceTc "pushLevelAndSolveEqualitiesX {" (text "Called from" <+> text callsite) + ; (tclvl, (wanted, res)) + <- pushTcLevelM $ + do { (res, wanted) <- captureConstraints thing_inside + ; wanted <- runTcSEqualities (simplifyTopWanteds wanted) + ; return (wanted,res) } + ; traceTc "pushLevelAndSolveEqualities }" (vcat [ text "Residual:" <+> ppr wanted + , text "Level:" <+> ppr tclvl ]) + ; return (tclvl, wanted, res) } + +-- | Type-check a thing that emits only equality constraints, solving any +-- constraints we can and re-emitting constraints that we can't. +-- Use this variant only when we'll get another crack at it later +-- See Note [Failure in local type signatures] +-- +-- Panics if we solve any non-equality constraints. (In runTCSEqualities +-- we use an error thunk for the evidence bindings.) +solveEqualities :: String -> TcM a -> TcM a +solveEqualities callsite thing_inside + = do { traceTc "solveEqualities {" (text "Called from" <+> text callsite) + ; (res, wanted) <- captureConstraints thing_inside + ; simplifyAndEmitFlatConstraints wanted + -- simplifyAndEmitFlatConstraints fails outright unless + -- the only unsolved constraints are soluble-looking + -- equalities that can float out + ; traceTc "solveEqualities }" empty + ; return res } + +simplifyAndEmitFlatConstraints :: WantedConstraints -> TcM () +-- See Note [Failure in local type signatures] +simplifyAndEmitFlatConstraints wanted + = do { -- Solve and zonk to establish the + -- preconditions for floatKindEqualities + wanted <- runTcSEqualities (solveWanteds wanted) + ; wanted <- TcM.liftZonkM $ TcM.zonkWC wanted + + ; traceTc "emitFlatConstraints {" (ppr wanted) + ; case floatKindEqualities wanted of + Nothing -> do { traceTc "emitFlatConstraints } failing" (ppr wanted) + -- Emit the bad constraints, wrapped in an implication + -- See Note [Wrapping failing kind equalities] + ; tclvl <- TcM.getTcLevel + ; implic <- buildTvImplication unkSkolAnon [] (pushTcLevel tclvl) wanted + -- ^^^^^^ | ^^^^^^^^^^^^^^^^^ + -- it's OK to use unkSkol | we must increase the TcLevel, + -- because we don't bind | as explained in + -- any skolem variables here | Note [Wrapping failing kind equalities] + ; TcM.emitImplication implic + ; failM } + Just (simples, errs) + -> do { _ <- promoteTyVarSet (tyCoVarsOfCts simples) + ; traceTc "emitFlatConstraints }" $ + vcat [ text "simples:" <+> ppr simples + , text "errs: " <+> ppr errs ] + -- Holes and other delayed errors don't need promotion + ; emitDelayedErrors errs + ; emitSimples simples } } + +floatKindEqualities :: WantedConstraints -> Maybe (Bag Ct, Bag DelayedError) +-- Float out all the constraints from the WantedConstraints, +-- Return Nothing if any constraints can't be floated (captured +-- by skolems), or if there is an insoluble constraint, or +-- IC_Telescope telescope error +-- Precondition 1: we have tried to solve the 'wanteds', both so that +-- the ic_status field is set, and because solving can make constraints +-- more floatable. +-- Precondition 2: the 'wanteds' are zonked, since floatKindEqualities +-- is not monadic +-- See Note [floatKindEqualities vs approximateWC] +floatKindEqualities wc = float_wc emptyVarSet wc + where + float_wc :: TcTyCoVarSet -> WantedConstraints -> Maybe (Bag Ct, Bag DelayedError) + float_wc trapping_tvs (WC { wc_simple = simples + , wc_impl = implics + , wc_errors = errs }) + | all is_floatable simples + = do { (inner_simples, inner_errs) + <- flatMapBagPairM (float_implic trapping_tvs) implics + ; return ( simples `unionBags` inner_simples + , errs `unionBags` inner_errs) } + | otherwise + = Nothing + where + is_floatable ct + | insolubleCt ct = False + | otherwise = tyCoVarsOfCt ct `disjointVarSet` trapping_tvs + + float_implic :: TcTyCoVarSet -> Implication -> Maybe (Bag Ct, Bag DelayedError) + float_implic trapping_tvs (Implic { ic_wanted = wanted, ic_given_eqs = given_eqs + , ic_skols = skols, ic_status = status }) + | isInsolubleStatus status + = Nothing -- A short cut /plus/ we must keep track of IC_BadTelescope + | otherwise + = do { (simples, holes) <- float_wc new_trapping_tvs wanted + ; when (not (isEmptyBag simples) && given_eqs == MaybeGivenEqs) $ + Nothing + -- If there are some constraints to float out, but we can't + -- because we don't float out past local equalities + -- (c.f GHC.Tc.Solver.approximateWC), then fail + ; return (simples, holes) } + where + new_trapping_tvs = trapping_tvs `extendVarSetList` skols + + +{- Note [Failure in local type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When kind checking a type signature, we like to fail fast if we can't +solve all the kind equality constraints, for two reasons: + + * A kind-bogus type signature may cause a cascade of knock-on + errors if we let it pass + + * More seriously, we don't have a convenient term-level place to add + deferred bindings for unsolved kind-equality constraints. In + earlier GHCs this led to un-filled-in coercion holes, which caused + GHC to crash with "fvProv falls into a hole" See #11563, #11520, + #11516, #11399 + +But what about /local/ type signatures, mentioning in-scope type +variables for which there might be 'given' equalities? For these we +might not be able to solve all the equalities locally. Here's an +example (T15076b): + + class (a ~ b) => C a b + data SameKind :: k -> k -> Type where { SK :: SameKind a b } + + bar :: forall (a :: Type) (b :: Type). + C a b => Proxy a -> Proxy b -> () + bar _ _ = const () (undefined :: forall (x :: a) (y :: b). SameKind x y) + +Consider the type signature on 'undefined'. It's ill-kinded unless +a~b. But the superclass of (C a b) means that indeed (a~b). So all +should be well. BUT it's hard to see that when kind-checking the signature +for undefined. We want to emit a residual (a~b) constraint, to solve +later. + +Another possibility is that we might have something like + F alpha ~ [Int] +where alpha is bound further out, which might become soluble +"later" when we learn more about alpha. So we want to emit +those residual constraints. + +BUT it's no good simply wrapping all unsolved constraints from +a type signature in an implication constraint to solve later. The +problem is that we are going to /use/ that signature, including +instantiate it. Say we have + f :: forall a. (forall b. blah) -> blah2 + f x = +To typecheck the definition of f, we have to instantiate those +foralls. Moreover, any unsolved kind equalities will be coercion +holes in the type. If we naively wrap them in an implication like + forall a. (co1:k1~k2, forall b. co2:k3~k4) +hoping to solve it later, we might end up filling in the holes +co1 and co2 with coercions involving 'a' and 'b' -- but by now +we've instantiated the type. Chaos! + +Moreover, the unsolved constraints might be skolem-escape things, and +if we proceed with f bound to a nonsensical type, we get a cascade of +follow-up errors. For example polykinds/T12593, T15577, and many others. + +So here's the plan (see tcHsSigType): + +* pushLevelAndSolveEqualitiesX: try to solve the constraints + +* kindGeneraliseSome: do kind generalisation + +* buildTvImplication: build an implication for the residual, unsolved + constraint + +* simplifyAndEmitFlatConstraints: try to float out every unsolved equality + inside that implication, in the hope that it constrains only global + type variables, not the locally-quantified ones. + + * If we fail, or find an insoluble constraint, emit the implication, + so that the errors will be reported, and fail. + + * If we succeed in floating all the equalities, promote them and + re-emit them as flat constraint, not wrapped at all (since they + don't mention any of the quantified variables. + +* Note that this float-and-promote step means that anonymous + wildcards get floated to top level, as we want; see + Note [Checking partial type signatures] in GHC.Tc.Gen.HsType. + +All this is done: + +* In GHC.Tc.Gen.HsType.tcHsSigType, as above + +* solveEqualities. Use this when there no kind-generalisation + step to complicate matters; then we don't need to push levels, + and can solve the equalities immediately without needing to + wrap it in an implication constraint. (You'll generally see + a kindGeneraliseNone nearby.) + +* In GHC.Tc.TyCl and GHC.Tc.TyCl.Instance; see calls to + pushLevelAndSolveEqualitiesX, followed by quantification, and + then reportUnsolvedEqualities. + + NB: we call reportUnsolvedEqualities before zonkTcTypeToType + because the latter does not expect to see any un-filled-in + coercions, which will happen if we have unsolved equalities. + By calling reportUnsolvedEqualities first, which fails after + reporting errors, we avoid that happening. + +See also #18062, #11506 + +Note [Wrapping failing kind equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In simplifyAndEmitFlatConstraints, if we fail to get down to simple +flat constraints we will +* re-emit the constraints so that they are reported +* fail in the monad +But there is a Terrible Danger that, if -fdefer-type-errors is on, and +we just re-emit an insoluble constraint like (* ~ (*->*)), that we'll +report only a warning and proceed with compilation. But if we ever fail +in the monad it should be fatal; we should report an error and stop after +the type checker. If not, chaos results: #19142. + +Our solution is this: +* Even with -fdefer-type-errors, inside an implication with no place for + value bindings (ic_binds = CoEvBindsVar), report failing equalities as + errors. We have to do this anyway; see GHC.Tc.Errors + Note [Failing equalities with no evidence bindings]. + +* Right here in simplifyAndEmitFlatConstraints, use buildTvImplication + to wrap the failing constraint in a degenerate implication (no + skolems, no theta), with ic_binds = CoEvBindsVar. This setting of + `ic_binds` means that any failing equalities will lead to an + error not a warning, irrespective of -fdefer-type-errors: see + Note [Failing equalities with no evidence bindings] in GHC.Tc.Errors, + and `maybeSwitchOffDefer` in that module. + + We still take care to bump the TcLevel of the implication. Partly, + that ensures that nested implications have increasing level numbers + which seems nice. But more specifically, suppose the outer level + has a Given `(C ty)`, which has pending (not-yet-expanded) + superclasses. Consider what happens when we process this implication + constraint (which we have re-emitted) in that context: + - in the inner implication we'll call `getPendingGivenScs`, + - we /do not/ want to get the `(C ty)` from the outer level, + lest we try to add an evidence term for the superclass, + which we can't do because we have specifically set + `ic_binds` = `CoEvBindsVar`. + - as `getPendingGivenSCcs is careful to only get Givens from + the /current/ level, and we bumped the `TcLevel` of the implication, + we're OK. + + TL;DR: bump the `TcLevel` when creating the nested implication. + If we don't we get a panic in `GHC.Tc.Utils.Monad.addTcEvBind` (#20043). + + +We re-emit the implication rather than reporting the errors right now, +so that the error messages are improved by other solving and defaulting. +e.g. we prefer + Cannot match 'Type->Type' with 'Type' +to Cannot match 'Type->Type' with 'TYPE r0' + + +Note [floatKindEqualities vs approximateWC] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +floatKindEqualities and approximateWC are strikingly similar to each +other, but + +* floatKindEqualites tries to float /all/ equalities, and fails if + it can't, or if any implication is insoluble. +* approximateWC just floats out any constraints + (not just equalities) that can float; it never fails. +-} + + +reportUnsolvedEqualities :: SkolemInfo -> [TcTyVar] -> TcLevel + -> WantedConstraints -> TcM () +-- Reports all unsolved wanteds provided; fails in the monad if there are any. +-- +-- The provided SkolemInfo and [TcTyVar] arguments are used in an implication to +-- provide skolem info for any errors. +reportUnsolvedEqualities skol_info skol_tvs tclvl wanted + = report_unsolved_equalities (getSkolemInfo skol_info) skol_tvs tclvl wanted + +report_unsolved_equalities :: SkolemInfoAnon -> [TcTyVar] -> TcLevel + -> WantedConstraints -> TcM () +report_unsolved_equalities skol_info_anon skol_tvs tclvl wanted + | isEmptyWC wanted + = return () + + | otherwise -- NB: we build an implication /even if skol_tvs is empty/, + -- just to ensure that our level invariants hold, specifically + -- (WantedInv). See Note [TcLevel invariants]. + = checkNoErrs $ -- Fail + do { implic <- buildTvImplication skol_info_anon skol_tvs tclvl wanted + ; reportAllUnsolved (mkImplicWC (unitBag implic)) } + + +-- | Simplify top-level constraints, but without reporting any unsolved +-- constraints nor unsafe overlapping. +simplifyTopWanteds :: WantedConstraints -> TcS WantedConstraints +simplifyTopWanteds wanteds + = do { -- Solve the constraints + wc_first_go <- nestTcS (solveWanteds wanteds) + + -- Now try defaulting: + -- see Note [Top-level Defaulting Plan] + ; tryDefaulting wc_first_go } + +{- Note [Safe Haskell Overlapping Instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In Safe Haskell, we apply an extra restriction to overlapping instances. The +motive is to prevent untrusted code provided by a third-party, changing the +behavior of trusted code through type-classes. This is due to the global and +implicit nature of type-classes that can hide the source of the dictionary. + +Another way to state this is: if a module M compiles without importing another +module N, changing M to import N shouldn't change the behavior of M. + +Overlapping instances with type-classes can violate this principle. However, +overlapping instances aren't always unsafe. They are just unsafe when the most +selected dictionary comes from untrusted code (code compiled with -XSafe) and +overlaps instances provided by other modules. + +In particular, in Safe Haskell at a call site with overlapping instances, we +apply the following rule to determine if it is a 'unsafe' overlap: + + 1) Most specific instance, I1, defined in an `-XSafe` compiled module. + 2) I1 is an orphan instance or a MPTC. + 3) At least one overlapped instance, Ix, is both: + A) from a different module than I1 + B) Ix is not marked `OVERLAPPABLE` + +This is a slightly involved heuristic, but captures the situation of an +imported module N changing the behavior of existing code. For example, if +condition (2) isn't violated, then the module author M must depend either on a +type-class or type defined in N. + +Secondly, when should these heuristics be enforced? We enforced them when the +type-class method call site is in a module marked `-XSafe` or `-XTrustworthy`. +This allows `-XUnsafe` modules to operate without restriction, and for Safe +Haskell inference to infer modules with unsafe overlaps as unsafe. + +One alternative design would be to also consider if an instance was imported as +a `safe` import or not and only apply the restriction to instances imported +safely. However, since instances are global and can be imported through more +than one path, this alternative doesn't work. + +Note [Safe Haskell Overlapping Instances Implementation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How is this implemented? It's complicated! So we'll step through it all: + + 1) `InstEnv.lookupInstEnv` -- Performs instance resolution, so this is where + we check if a particular type-class method call is safe or unsafe. We do this + through the return type, `ClsInstLookupResult`, where the last parameter is a + list of instances that are unsafe to overlap. When the method call is safe, + the list is null. + + 2) `GHC.Tc.Solver.Dict.matchClassInst` -- This module drives the instance resolution + / dictionary generation. The return type is `ClsInstResult`, which either + says no instance matched, or one found, and if it was a safe or unsafe + overlap. + + 3) `GHC.Tc.Solver.Dict.tryInstances` -- Takes a dictionary / class constraint and + tries to resolve it by calling (in part) `matchClassInst`. The resolving + mechanism has a work list (of constraints) that it process one at a time. If + the constraint can't be resolved, it's added to an inert set. When compiling + an `-XSafe` or `-XTrustworthy` module, we follow this approach as we know + compilation should fail. These are handled as normal constraint resolution + failures from here-on (see step 6). + + Otherwise, we may be inferring safety (or using `-Wunsafe`), and + compilation should succeed, but print warnings and/or mark the compiled module + as `-XUnsafe`. In this case, we call `insertSafeOverlapFailureTcS` which adds + the unsafe (but resolved!) constraint to the `inert_safehask` field of + `InertCans`. + + 4) `GHC.Tc.Solver.simplifyTop`: + * Call simplifyTopWanteds, the top-level function for driving the simplifier for + constraint resolution. + + * Once finished, call `getSafeOverlapFailures` to retrieve the + list of overlapping instances that were successfully resolved, + but unsafe. Remember, this is only applicable for generating warnings + (`-Wunsafe`) or inferring a module unsafe. `-XSafe` and `-XTrustworthy` + cause compilation failure by not resolving the unsafe constraint at all. + + * For unresolved constraints (all types), call `GHC.Tc.Errors.reportUnsolved`, + while for resolved but unsafe overlapping dictionary constraints, call + `GHC.Tc.Errors.warnAllUnsolved`. Both functions convert constraints into a + warning message for the user. + + * In the case of `warnAllUnsolved` for resolved, but unsafe + dictionary constraints, we collect the generated warning + message (pop it) and call `GHC.Tc.Utils.Monad.recordUnsafeInfer` to + mark the module we are compiling as unsafe, passing the + warning message along as the reason. + + 5) `GHC.Tc.Errors.*Unsolved` -- Generates error messages for constraints by + actually calling `InstEnv.lookupInstEnv` again! Yes, confusing, but all we + know is the constraint that is unresolved or unsafe. For dictionary, all we + know is that we need a dictionary of type C, but not what instances are + available and how they overlap. So we once again call `lookupInstEnv` to + figure that out so we can generate a helpful error message. + + 6) `GHC.Tc.Utils.Monad.recordUnsafeInfer` -- Save the unsafe result and reason in + IORefs called `tcg_safe_infer` and `tcg_safe_infer_reason`. + + 7) `GHC.Driver.Main.tcRnModule'` -- Reads `tcg_safe_infer` after type-checking, calling + `GHC.Driver.Main.markUnsafeInfer` (passing the reason along) when safe-inference + failed. +-} + +------------------ +simplifyAmbiguityCheck :: Type -> WantedConstraints -> TcM () +simplifyAmbiguityCheck ty wc + = do { traceTc "simplifyAmbiguityCheck {" $ + text "type = " <+> ppr ty $$ text "wanted = " <+> ppr wc + + ; (final_wc, _) <- runTcS $ do { wc1 <- solveWanteds wc + ; tryDefaultingForAmbiguityCheck wc1 } + + ; discardResult (reportUnsolved final_wc) + + ; traceTc "End simplifyAmbiguityCheck }" empty } + +------------------ +simplifyInteractive :: WantedConstraints -> TcM (Bag EvBind) +simplifyInteractive wanteds + = traceTc "simplifyInteractive" empty >> + simplifyTop wanteds + +------------------ +{- Note [Pattern match warnings with insoluble Givens] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A pattern match on a GADT can introduce new type-level information, which needs +to be analysed in order to get the expected pattern match warnings. + +For example: + +> type IsBool :: Type -> Constraint +> type family IsBool a where +> IsBool Bool = () +> IsBool b = b ~ Bool +> +> data T a where +> MkTInt :: Int -> T Int +> MkTBool :: IsBool b => b -> T b +> +> f :: T Int -> Int +> f (MkTInt i) = i + +The pattern matching performed by `f` is complete: we can't ever call +`f (MkTBool b)`, as type-checking that application would require producing +evidence for `Int ~ Bool`, which can't be done. + +The pattern match checker uses `tcCheckGivens` to accumulate all the Given +constraints, and relies on `tcCheckGivens` to return Nothing if the +Givens become insoluble. `tcCheckGivens` in turn relies on `insolubleCt` +to identify these insoluble constraints. So the precise definition of +`insolubleCt` has a big effect on pattern match overlap warnings. + +To detect this situation, we check whether there are any insoluble Given +constraints. In the example above, the insoluble constraint was an +equality constraint, but it is also important to detect custom type errors: + +> type NotInt :: Type -> Constraint +> type family NotInt a where +> NotInt Int = TypeError (Text "That's Int, silly.") +> NotInt _ = () +> +> data R a where +> MkT1 :: a -> R a +> MkT2 :: NotInt a => R a +> +> foo :: R Int -> Int +> foo (MkT1 x) = x + +To see that we can't call `foo (MkT2)`, we must detect that `NotInt Int` is insoluble +because it is a custom type error. +Failing to do so proved quite inconvenient for users, as evidence by the +tickets #11503 #14141 #16377 #20180. +Test cases: T11503, T14141. + +Examples of constraints that tcCheckGivens considers insoluble: + - Int ~ Bool, + - Coercible Float Word, + - TypeError msg. + +Non-examples: + - constraints which we know aren't satisfied, + e.g. Show (Int -> Int) when no such instance is in scope, + - Eq (TypeError msg), + - C (Int ~ Bool), with @class C (c :: Constraint)@. +-} + +tcCheckGivens :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) +-- ^ Return (Just new_inerts) if the Givens are satisfiable, Nothing if definitely +-- contradictory. +-- +-- See Note [Pattern match warnings with insoluble Givens] above. +tcCheckGivens inerts given_ids = do + (sat, new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkGivens {" (ppr inerts <+> ppr given_ids) + lcl_env <- TcS.getLclEnv + let given_loc = mkGivenLoc topTcLevel (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) + let given_cts = mkGivens given_loc (bagToList given_ids) + -- See Note [Superclasses and satisfiability] + solveSimpleGivens given_cts + insols <- getInertInsols + insols <- try_harder insols + traceTcS "checkGivens }" (ppr insols) + return (isEmptyBag insols) + return $ if sat then Just new_inerts else Nothing + where + try_harder :: Cts -> TcS Cts + -- Maybe we have to search up the superclass chain to find + -- an unsatisfiable constraint. Example: pmcheck/T3927b. + -- At the moment we try just once + try_harder insols + | not (isEmptyBag insols) -- We've found that it's definitely unsatisfiable + = return insols -- Hurrah -- stop now. + | otherwise + = do { pending_given <- getPendingGivenScs + ; new_given <- makeSuperClasses pending_given + ; solveSimpleGivens new_given + ; getInertInsols } + +tcCheckWanteds :: InertSet -> ThetaType -> TcM Bool +-- ^ Return True if the Wanteds are soluble, False if not +tcCheckWanteds inerts wanteds = do + cts <- newWanteds PatCheckOrigin wanteds + (sat, _new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkWanteds {" (ppr inerts <+> ppr wanteds) + -- See Note [Superclasses and satisfiability] + wcs <- solveWanteds (mkSimpleWC cts) + traceTcS "checkWanteds }" (ppr wcs) + return (isSolvedWC wcs) + return sat + +-- | Normalise a type as much as possible using the given constraints. +-- See @Note [tcNormalise]@. +tcNormalise :: InertSet -> Type -> TcM Type +tcNormalise inerts ty + = do { norm_loc <- getCtLocM PatCheckOrigin Nothing + ; (res, _new_inerts) <- runTcSInerts inerts $ + do { traceTcS "tcNormalise {" (ppr inerts) + ; ty' <- rewriteType norm_loc ty + ; traceTcS "tcNormalise }" (ppr ty') + ; pure ty' } + ; return res } + +{- Note [Superclasses and satisfiability] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Expand superclasses before starting, because (Int ~ Bool), has +(Int ~~ Bool) as a superclass, which in turn has (Int ~N# Bool) +as a superclass, and it's the latter that is insoluble. See +Note [The equality types story] in GHC.Builtin.Types.Prim. + +If we fail to prove unsatisfiability we (arbitrarily) try just once to +find superclasses, using try_harder. Reason: we might have a type +signature + f :: F op (Implements push) => .. +where F is a type function. This happened in #3972. + +We could do more than once but we'd have to have /some/ limit: in the +the recursive case, we would go on forever in the common case where +the constraints /are/ satisfiable (#10592 comment:12!). + +For straightforward situations without type functions the try_harder +step does nothing. + +Note [tcNormalise] +~~~~~~~~~~~~~~~~~~ +tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas +most invocations of the constraint solver are intended to simplify a set of +constraints or to decide if a particular set of constraints is satisfiable, +the purpose of tcNormalise is to take a type, plus some locally solved +constraints in the form of an InertSet, and normalise the type as much as +possible with respect to those constraints. + +It does *not* reduce type or data family applications or look through newtypes. + +Why is this useful? As one example, when coverage-checking an EmptyCase +expression, it's possible that the type of the scrutinee will only reduce +if some local equalities are solved for. See "Wrinkle: Local equalities" +in Note [Type normalisation] in "GHC.HsToCore.Pmc". + +To accomplish its stated goal, tcNormalise first initialises the solver monad +with the given InertCans, then uses rewriteType to simplify the desired type +with respect to the Givens in the InertCans. + +*********************************************************************************** +* * +* Inference +* * +*********************************************************************************** + +Note [Inferring the type of a let-bound variable] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f x = rhs + +To infer f's type we do the following: + * Gather the constraints for the RHS with ambient level *one more than* + the current one. This is done by the call + pushLevelAndCaptureConstraints (tcMonoBinds...) + in GHC.Tc.Gen.Bind.tcPolyInfer + + * Call simplifyInfer to simplify the constraints and decide what to + quantify over. We pass in the level used for the RHS constraints, + here called rhs_tclvl. + +This ensures that the implication constraint we generate, if any, +has a strictly-increased level compared to the ambient level outside +the let binding. + +Note [Inferring principal types] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We don't always infer principal types. For instance, the inferred type for + +> f x = show [x] + +is + +> f :: Show a => a -> String + +This is not the most general type if we allow flexible contexts. +Indeed, if we try to write the following + +> g :: Show [a] => a -> String +> g x = f x + +we get the error: + + * Could not deduce (Show a) arising from a use of `f' + from the context: Show [a] + +Though replacing f x in the right-hand side of g with the definition +of f x works, the call to f x does not. This is the hallmark of +unprincip{led,al} types. + +Another example: + +> class C a +> class D a where +> d :: a +> instance C a => D a where +> d = undefined +> h _ = d -- argument is to avoid the monomorphism restriction + +The inferred type for h is + +> h :: C a => t -> a + +even though + +> h :: D a => t -> a + +is more general. + +The fix is easy: don't simplify constraints before inferring a type. +That is, have the inferred type quantify over all constraints that arise +in a definition's right-hand side, even if they are simplifiable. +Unfortunately, this would yield all manner of unwieldy types, +and so we won't do so. +-} + +-- | How should we choose which constraints to quantify over? +data InferMode = ApplyMR -- ^ Apply the monomorphism restriction, + -- never quantifying over any constraints + | EagerDefaulting -- ^ See Note [TcRnExprMode] in "GHC.Tc.Module", + -- the :type +d case; this mode refuses + -- to quantify over any defaultable constraint + | NoRestrictions -- ^ Quantify over any constraint that + -- satisfies pickQuantifiablePreds + +instance Outputable InferMode where + ppr ApplyMR = text "ApplyMR" + ppr EagerDefaulting = text "EagerDefaulting" + ppr NoRestrictions = text "NoRestrictions" + +simplifyInfer :: TopLevelFlag + -> TcLevel -- Used when generating the constraints + -> InferMode + -> [TcIdSigInst] -- Any signatures (possibly partial) + -> [(Name, TcTauType)] -- Variables to be generalised, + -- and their tau-types + -> WantedConstraints + -> TcM ([TcTyVar], -- Quantify over these type variables + [EvVar], -- ... and these constraints (fully zonked) + TcEvBinds, -- ... binding these evidence variables + Bool) -- True <=> the residual constraints are insoluble + +simplifyInfer top_lvl rhs_tclvl infer_mode sigs name_taus wanteds + | isEmptyWC wanteds + = do { -- When quantifying, we want to preserve any order of variables as they + -- appear in partial signatures. cf. decideQuantifiedTyVars + let psig_tv_tys = [ mkTyVarTy tv | sig <- partial_sigs + , (_,Bndr tv _) <- sig_inst_skols sig ] + psig_theta = [ pred | sig <- partial_sigs + , pred <- sig_inst_theta sig ] + + ; dep_vars <- candidateQTyVarsOfTypes (psig_tv_tys ++ psig_theta ++ map snd name_taus) + + ; skol_info <- mkSkolemInfo (InferSkol name_taus) + ; qtkvs <- quantifyTyVars skol_info DefaultNonStandardTyVars dep_vars + ; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs) + ; return (qtkvs, [], emptyTcEvBinds, False) } + + | otherwise + = do { traceTc "simplifyInfer {" $ vcat + [ text "sigs =" <+> ppr sigs + , text "binds =" <+> ppr name_taus + , text "rhs_tclvl =" <+> ppr rhs_tclvl + , text "infer_mode =" <+> ppr infer_mode + , text "(unzonked) wanted =" <+> ppr wanteds + ] + + ; let psig_theta = concatMap sig_inst_theta partial_sigs + + -- First do full-blown solving + -- NB: we must gather up all the bindings from doing this solving; hence + -- (runTcSWithEvBinds ev_binds_var). And note that since there are + -- nested implications, calling solveWanteds will side-effect their + -- evidence bindings, so we can't just revert to the input constraint. + -- + -- See also Note [Inferring principal types] + ; ev_binds_var <- TcM.newTcEvBinds + ; psig_evs <- newWanteds AnnOrigin psig_theta + ; wanted_transformed + <- runTcSWithEvBinds ev_binds_var $ + setTcLevelTcS rhs_tclvl $ + solveWanteds (mkSimpleWC psig_evs `andWC` wanteds) + -- setLevelTcS: we do setLevel /inside/ the runTcS, so that + -- we initialise the InertSet inert_given_eq_lvl as far + -- out as possible, maximising oppportunities to unify + -- psig_evs : see Note [Add signature contexts as wanteds] + + -- Find quant_pred_candidates, the predicates that + -- we'll consider quantifying over + -- NB1: wanted_transformed does not include anything provable from + -- the psig_theta; it's just the extra bit + -- NB2: We do not do any defaulting when inferring a type, this can lead + -- to less polymorphic types, see Note [Default while Inferring] + ; wanted_transformed <- TcM.liftZonkM $ TcM.zonkWC wanted_transformed + ; let definite_error = insolubleWC wanted_transformed + -- See Note [Quantification with errors] + wanted_dq | definite_error = emptyWC + | otherwise = wanted_transformed + + -- Decide what type variables and constraints to quantify + -- NB: quant_pred_candidates is already fully zonked + -- NB: bound_theta are constraints we want to quantify over, + -- including the psig_theta, which we always quantify over + -- NB: bound_theta are fully zonked + -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] + -- in GHC.Tc.Utils.TcType + ; rec { (qtvs, bound_theta, co_vars) <- decideQuantification + top_lvl rhs_tclvl infer_mode + skol_info name_taus partial_sigs + wanted_dq + + ; bound_theta_vars <- mapM TcM.newEvVar bound_theta + + ; let full_theta = map idType bound_theta_vars + skol_info = InferSkol [ (name, mkPhiTy full_theta ty) + | (name, ty) <- name_taus ] + -- mkPhiTy: we don't add the quantified variables here, because + -- they are also bound in ic_skols and we want them to be tidied + -- uniformly. + } + + + -- Now emit the residual constraint + ; emitResidualConstraints rhs_tclvl skol_info ev_binds_var + co_vars qtvs bound_theta_vars + wanted_transformed + + -- All done! + ; traceTc "} simplifyInfer/produced residual implication for quantification" $ + vcat [ text "wanted_dq =" <+> ppr wanted_dq + , text "psig_theta =" <+> ppr psig_theta + , text "bound_theta =" <+> pprCoreBinders bound_theta_vars + , text "qtvs =" <+> ppr qtvs + , text "definite_error =" <+> ppr definite_error ] + + ; return ( qtvs, bound_theta_vars, TcEvBinds ev_binds_var, definite_error ) } + -- NB: bound_theta_vars must be fully zonked + where + partial_sigs = filter isPartialSig sigs + +-------------------- +emitResidualConstraints :: TcLevel -> SkolemInfoAnon -> EvBindsVar + -> CoVarSet -> [TcTyVar] -> [EvVar] + -> WantedConstraints -> TcM () +-- Emit the remaining constraints from the RHS. +emitResidualConstraints rhs_tclvl skol_info ev_binds_var + co_vars qtvs full_theta_vars wanteds + | isEmptyWC wanteds + = return () + + | otherwise + = do { wanted_simple <- TcM.liftZonkM $ TcM.zonkSimples (wc_simple wanteds) + ; let (outer_simple, inner_simple) = partitionBag is_mono wanted_simple + is_mono ct + | Just ct_ev_id <- wantedEvId_maybe ct + = ct_ev_id `elemVarSet` co_vars + | otherwise + = False + -- Reason for the partition: + -- see Note [Emitting the residual implication in simplifyInfer] + +-- Already done by defaultTyVarsAndSimplify +-- ; _ <- TcM.promoteTyVarSet (tyCoVarsOfCts outer_simple) + + ; let inner_wanted = wanteds { wc_simple = inner_simple } + ; implics <- if isEmptyWC inner_wanted + then return emptyBag + else do implic1 <- newImplication + return $ unitBag $ + implic1 { ic_tclvl = rhs_tclvl + , ic_skols = qtvs + , ic_given = full_theta_vars + , ic_wanted = inner_wanted + , ic_binds = ev_binds_var + , ic_given_eqs = MaybeGivenEqs + , ic_info = skol_info } + + ; emitConstraints (emptyWC { wc_simple = outer_simple + , wc_impl = implics }) } + +-------------------- +findInferredDiff :: TcThetaType -> TcThetaType -> TcM TcThetaType +-- Given a partial type signature f :: (C a, D a, _) => blah +-- and the inferred constraints (X a, D a, Y a, C a) +-- compute the difference, which is what will fill in the "_" underscore, +-- In this case the diff is (X a, Y a). +findInferredDiff annotated_theta inferred_theta + | null annotated_theta -- Short cut the common case when the user didn't + = return inferred_theta -- write any constraints in the partial signature + | otherwise + = pushTcLevelM_ $ + do { lcl_env <- TcM.getLclEnv + ; given_ids <- mapM TcM.newEvVar annotated_theta + ; wanteds <- newWanteds AnnOrigin inferred_theta + ; let given_loc = mkGivenLoc topTcLevel (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) + given_cts = mkGivens given_loc given_ids + + ; (residual_wc, _) <- runTcS $ + do { _ <- solveSimpleGivens given_cts + ; solveSimpleWanteds (listToBag (map mkNonCanonical wanteds)) } + -- NB: There are no meta tyvars fromn this level annotated_theta + -- because we have either promoted them or unified them + -- See `Note [Quantification and partial signatures]` Wrinkle 2 + + ; return (map (box_pred . ctPred) $ + bagToList (wc_simple residual_wc)) } + where + box_pred :: PredType -> PredType + box_pred pred = case classifyPredType pred of + EqPred rel ty1 ty2 + | Just (cls,tys) <- boxEqPred rel ty1 ty2 + -> mkClassPred cls tys + | otherwise + -> pprPanic "findInferredDiff" (ppr pred) + _other -> pred + +{- Note [Emitting the residual implication in simplifyInfer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f = e +where f's type is inferred to be something like (a, Proxy k (Int |> co)) +and we have an as-yet-unsolved, or perhaps insoluble, constraint + [W] co :: Type ~ k +We can't form types like (forall co. blah), so we can't generalise over +the coercion variable, and hence we can't generalise over things free in +its kind, in the case 'k'. But we can still generalise over 'a'. So +we'll generalise to + f :: forall a. (a, Proxy k (Int |> co)) +Now we do NOT want to form the residual implication constraint + forall a. [W] co :: Type ~ k +because then co's eventual binding (which will be a value binding if we +use -fdefer-type-errors) won't scope over the entire binding for 'f' (whose +type mentions 'co'). Instead, just as we don't generalise over 'co', we +should not bury its constraint inside the implication. Instead, we must +put it outside. + +That is the reason for the partitionBag in emitResidualConstraints, +which takes the CoVars free in the inferred type, and pulls their +constraints out. (NB: this set of CoVars should be closed-over-kinds.) + +All rather subtle; see #14584. + +Note [Add signature contexts as wanteds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (#11016): + f2 :: (?x :: Int) => _ + f2 = ?x + +or this + class C a b | a -> b + g :: C p q => p -> q + f3 :: C Int b => _ + f3 = g (3::Int) + +We'll use plan InferGen because there are holes in the type. But: + * For f2 we want to have the (?x :: Int) constraint floating around + so that the functional dependencies kick in. Otherwise the + occurrence of ?x on the RHS produces constraint (?x :: alpha), and + we won't unify alpha:=Int. + + * For f3 want the (C Int b) constraint from the partial signature + to meet the (C Int beta) constraint we get from the call to g; again, + fundeps + +Solution: in simplifyInfer, we add the constraints from the signature +as extra Wanteds. + +Why Wanteds? Wouldn't it be neater to treat them as Givens? Alas +that would mess up (GivenInv) in Note [TcLevel invariants]. Consider + f :: (Eq a, _) => blah1 + f = ....g... + g :: (Eq b, _) => blah2 + g = ...f... + +Then we have two psig_theta constraints (Eq a[tv], Eq b[tv]), both with +TyVarTvs inside. Ultimately a[tv] := b[tv], but only when we've solved +all those constraints. And both have level 1, so we can't put them as +Givens when solving at level 1. + +Best to treat them as Wanteds. + +But see also #20076, which would be solved if they were Givens. + + +************************************************************************ +* * + Quantification +* * +************************************************************************ + +Note [Deciding quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the monomorphism restriction does not apply, then we quantify as follows: + +* Step 1: decidePromotedTyVars. + Take the global tyvars, and "grow" them using functional dependencies + E.g. if x:alpha is in the environment, and alpha ~ [beta] (which can + happen because alpha is untouchable here) then do not quantify over + beta, because alpha fixes beta, and beta is effectively free in + the environment too; this logic extends to general fundeps, not + just equalities + + We also account for the monomorphism restriction; if it applies, + add the free vars of all the constraints. + + Result is mono_tvs; we will promote all of these to the outer levek, + and certainly not quantify over them. + +* Step 2: defaultTyVarsAndSimplify. + Default any non-promoted tyvars (i.e ones that are definitely + not going to become further constrained), and re-simplify the + candidate constraints. + + Motivation for re-simplification (#7857): imagine we have a + constraint (C (a->b)), where 'a :: TYPE l1' and 'b :: TYPE l2' are + not free in the envt, and instance forall (a::*) (b::*). (C a) => C + (a -> b) The instance doesn't match while l1,l2 are polymorphic, but + it will match when we default them to LiftedRep. + + This is all very tiresome. + + This step also promotes the mono_tvs from Step 1. See + Note [Promote monomorphic tyvars]. In fact, the *only* + use of the mono_tvs from Step 1 is to promote them here. + This promotion effectively stops us from quantifying over them + later, in Step 3. Because the actual variables to quantify + over are determined in Step 3 (not in Step 1), it is OK for + the mono_tvs to be missing some variables free in the + environment. This is why removing the psig_qtvs is OK in + decidePromotedTyVars. Test case for this scenario: T14479. + +* Step 3: decideQuantifiedTyVars. + Decide which variables to quantify over, as follows: + + - Take the free vars of the partial-type-signature types and constraints, + and the tau-type (zonked_tau_tvs), and then "grow" + them using all the constraints. These are grown_tcvs. + See Note [growThetaTyVars vs closeWrtFunDeps]. + + - Use quantifyTyVars to quantify over the free variables of all the types + involved, but only those in the grown_tcvs. + + Result is qtvs. + +* Step 4: Filter the constraints using pickQuantifiablePreds and the + qtvs. We have to zonk the constraints first, so they "see" the + freshly created skolems. + +Note [Unconditionally resimplify constraints when quantifying] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +During quantification (in defaultTyVarsAndSimplify, specifically), we re-invoke +the solver to simplify the constraints before quantifying them. We do this for +two reasons, enumerated below. We could, in theory, detect when either of these +cases apply and simplify only then, but collecting this information is bothersome, +and simplifying redundantly causes no real harm. Note that this code path +happens only for definitions + * without a type signature + * when -XMonoLocalBinds does not apply + * with unsolved constraints +and so the performance cost will be small. + +1. Defaulting + +Defaulting the variables handled by defaultTyVar may unlock instance simplifications. +Example (typecheck/should_compile/T20584b): + + with (t :: Double) (u :: String) = printf "..." t u + +We know the types of t and u, but we do not know the return type of `with`. So, we +assume `with :: alpha`, where `alpha :: TYPE rho`. The type of printf is + printf :: PrintfType r => String -> r +The occurrence of printf is instantiated with a fresh var beta. We then get + beta := Double -> String -> alpha +and + [W] PrintfType (Double -> String -> alpha) + +Module Text.Printf exports + instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) +and it looks like that instance should apply. + +But I have elided some key details: (->) is polymorphic over multiplicity and +runtime representation. Here it is in full glory: + [W] PrintfType ((Double :: Type) %m1 -> (String :: Type) %m2 -> (alpha :: TYPE rho)) + instance (PrintfArg a, PrintfType r) => PrintfType ((a :: Type) %Many -> (r :: Type)) + +Because we do not know that m1 is Many, we cannot use the instance. (Perhaps a better instance +would have an explicit equality constraint to the left of =>, but that's not what we have.) +Then, in defaultTyVarsAndSimplify, we get m1 := Many, m2 := Many, and rho := LiftedRep. +Yet it's too late to simplify the quantified constraint, and thus GHC infers + wait :: PrintfType (Double -> String -> t) => Double -> String -> t +which is silly. Simplifying again after defaulting solves this problem. + +2. Interacting functional dependencies + +Suppose we have + + class C a b | a -> b + +and we are running simplifyInfer over + + forall[2] x. () => [W] C a beta1[1] + forall[2] y. () => [W] C a beta2[1] + +These are two implication constraints, both of which contain a +wanted for the class C. Neither constraint mentions the bound +skolem. We might imagine that these constraints could thus float +out of their implications and then interact, causing beta1 to unify +with beta2, but constraints do not currently float out of implications. + +Unifying the beta1 and beta2 is important. Without doing so, then we might +infer a type like (C a b1, C a b2) => a -> a, which will fail to pass the +ambiguity check, which will say (rightly) that it cannot unify b1 with b2, as +required by the fundep interactions. This happens in the parsec library, and +in test case typecheck/should_compile/FloatFDs. + +If we re-simplify, however, the two fundep constraints will interact, causing +a unification between beta1 and beta2, and all will be well. The key step +is that this simplification happens *after* the call to approximateWC in +simplifyInfer. + +-} + +decideQuantification + :: TopLevelFlag + -> TcLevel + -> InferMode + -> SkolemInfoAnon + -> [(Name, TcTauType)] -- Variables to be generalised + -> [TcIdSigInst] -- Partial type signatures (if any) + -> WantedConstraints -- Candidate theta; already zonked + -> TcM ( [TcTyVar] -- Quantify over these (skolems) + , [PredType] -- and this context (fully zonked) + , CoVarSet) +-- See Note [Deciding quantification] +decideQuantification top_lvl rhs_tclvl infer_mode skol_info name_taus psigs wanted + = do { -- Step 1: find the mono_tvs + ; (candidates, co_vars) + <- decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted + + -- Step 2: default any non-mono tyvars, and re-simplify + -- This step may do some unification, but result candidates is zonked + ; candidates <- defaultTyVarsAndSimplify rhs_tclvl candidates + + -- Step 3: decide which kind/type variables to quantify over + ; qtvs <- decideQuantifiedTyVars skol_info name_taus psigs candidates + + -- Step 4: choose which of the remaining candidate + -- predicates to actually quantify over + -- NB: decideQuantifiedTyVars turned some meta tyvars + -- into quantified skolems, so we have to zonk again + ; (candidates, psig_theta) <- TcM.liftZonkM $ + do { candidates <- TcM.zonkTcTypes candidates + ; psig_theta <- TcM.zonkTcTypes (concatMap sig_inst_theta psigs) + ; return (candidates, psig_theta) } + + -- Take account of partial type signatures + -- See Note [Constraints in partial type signatures] + ; let min_psig_theta = mkMinimalBySCs id psig_theta + min_theta = pickQuantifiablePreds (mkVarSet qtvs) candidates + ; theta <- if + | null psigs -> return min_theta -- Case (P3) + | not (all has_extra_constraints_wildcard psigs) -- Case (P2) + -> return min_psig_theta + | otherwise -- Case (P1) + -> do { diff <- findInferredDiff min_psig_theta min_theta + ; return (min_psig_theta ++ diff) } + + ; traceTc "decideQuantification" + (vcat [ text "infer_mode:" <+> ppr infer_mode + , text "candidates:" <+> ppr candidates + , text "psig_theta:" <+> ppr psig_theta + , text "co_vars:" <+> ppr co_vars + , text "qtvs:" <+> ppr qtvs + , text "theta:" <+> ppr theta ]) + ; return (qtvs, theta, co_vars) } + + where + has_extra_constraints_wildcard (TISI { sig_inst_wcx = Just {} }) = True + has_extra_constraints_wildcard _ = False + +{- Note [Constraints in partial type signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have decided to quantify over min_theta, say (Eq a, C a, Ix a). +Then we distinguish three cases: + +(P1) No partial type signatures: just quantify over min_theta + +(P2) Partial type signatures with no extra_constraints wildcard: + e.g. f :: (Eq a, C a) => a -> _ + Quantify over psig_theta: the user has explicitly specified the + entire context. + + That may mean we have an unsolved residual constraint (Ix a) arising + from the RHS of the function. But so be it: the user said (Eq a, C a). + +(P3) Partial type signature with an extra_constraints wildcard. + e.g. f :: (Eq a, C a, _) => a -> a + Quantify over (psig_theta ++ diff) + where diff = min_theta - psig_theta, using findInferredDiff. + In our example, diff = Ix a + +Some rationale and observations + +* See Note [When the MR applies] in GHC.Tc.Gen.Bind. + +* We always want to quantify over psig_theta (if present). The user specified + it! And pickQuantifiableCandidates might have dropped some + e.g. CallStack constraints. c.f #14658 + equalities (a ~ Bool) + +* In case (P3) we ask that /all/ the signatures have an extra-constraints + wildcard. It's a bit arbitrary; not clear what the "right" thing is. + +* In (P2) we encounter #20076: + f :: Eq [a] => a -> _ + f x = [x] == [x] + From the RHS we get [W] Eq [a]. We simplify those Wanteds in simplifyInfer, + to get (Eq a). But then we quantify over the user-specified (Eq [a]), leaving + a residual implication constraint (forall a. Eq [a] => [W] Eq a), which is + insoluble. Idea: in simplifyInfer we could put the /un-simplified/ constraints + in the residual -- at least in the case like #20076 where the partial signature + fully specifies the final constraint. Maybe: a battle for another day. + +* It's helpful to use the same "find difference" algorithm, `findInferredDiff`, + here as we use in GHC.Tc.Gen.Bind.chooseInferredQuantifiers (#20921) + + At least for single functions we would like to quantify f over precisely the + same theta as , so that we get to take the short-cut path in + `GHC.Tc.Gen.Bind.mkExport`, and avoid calling `tcSubTypeSigma` for impedance + matching. Why avoid? Because it falls over for ambiguous types (#20921). + + We can get precisely the same theta by using the same algorithm, + `findInferredDiff`. + +* All of this goes wrong if we have (a) mutual recursion, (b) multiple + partial type signatures, (c) with different constraints, and (d) + ambiguous types. Something like + f :: forall a. Eq a => F a -> _ + f x = (undefined :: a) == g x undefined + g :: forall b. Show b => F b -> _ -> b + g x y = let _ = (f y, show x) in x + But that's a battle for another day. + +Note [Generalising top-level bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + class C a b | a -> b where .. + f x = ...[W] C Int beta[1]... + +When generalising `f`, closeWrtFunDeps will promote beta[1] to beta[0]. +But we do NOT want to make a top level type + f :: C Int beta[0] => blah +The danger is that beta[0] is defaulted to Any, and that then appears +in a user error message. Even if the type `blah` mentions beta[0], /and/ +there is a call that fixes beta[0] to (say) Bool, we'll end up with +[W] C Int Bool, which is insoluble. Why insoluble? If there was an + instance C Int Bool +then fundeps would have fixed beta:=Bool in the first place. + +If the binding of `f` is nested, things are different: we can +definitely see all the calls. + +For nested bindings, I think it just doesn't matter. No one cares what this +variable ends up being; it seems silly to halt compilation around it. (Like in +the length [] case.) +-} + +decideAndPromoteTyVars :: TopLevelFlag -> TcLevel + -> InferMode + -> [(Name,TcType)] + -> [TcIdSigInst] + -> WantedConstraints + -> TcM ([PredType], CoVarSet) +-- See Note [decideAndPromoteTyVars] +decideAndPromoteTyVars top_lvl rhs_tclvl infer_mode name_taus psigs wanted + = do { dflags <- getDynFlags + + -- If possible, we quantify over partial-sig qtvs, so they are + -- not mono. Need to zonk them because they are meta-tyvar TyVarTvs + ; (psig_qtvs, psig_theta, tau_tys) <- getSeedTys name_taus psigs + + ; let is_top_level = isTopLevel top_lvl -- A syntactically top-level binding + + -- Step 1 of Note [decideAndPromoteTyVars] + -- Get candidate constraints, decide which we can potentially quantify + -- The `no_quant_tvs` are free in constraints we can't quantify. + (can_quant_cts, no_quant_tvs) = approximateWCX False wanted + can_quant = ctsPreds can_quant_cts + can_quant_tvs = tyCoVarsOfTypes can_quant + + -- Step 2 of Note [decideAndPromoteTyVars] + -- Apply the monomorphism restriction + (post_mr_quant, mr_no_quant) = applyMR dflags infer_mode can_quant + mr_no_quant_tvs = tyCoVarsOfTypes mr_no_quant + + -- The co_var_tvs are tvs mentioned in the types of covars or + -- coercion holes. We can't quantify over these covars, so we + -- must include the variable in their types in the mono_tvs. + -- E.g. If we can't quantify over co :: k~Type, then we can't + -- quantify over k either! Hence closeOverKinds + -- Recall that coVarsOfTypes also returns coercion holes + co_vars = coVarsOfTypes (mkTyVarTys psig_qtvs ++ psig_theta + ++ tau_tys ++ post_mr_quant) + co_var_tvs = closeOverKinds co_vars + + -- outer_tvs are mentioned in `wanted`, and belong to some outer level. + -- We definitely can't quantify over them + outer_tvs = outerLevelTyVars rhs_tclvl $ + can_quant_tvs `unionVarSet` no_quant_tvs + + -- Step 3 of Note [decideAndPromoteTyVars], (a-c) + -- Identify mono_tvs: the type variables that we must not quantify over + -- At top level we are much less keen to create mono tyvars, to avoid + -- spooky action at a distance. + mono_tvs_without_mr + | is_top_level = outer_tvs -- See (DP2) + | otherwise = outer_tvs -- (a) + `unionVarSet` no_quant_tvs -- (b) + `unionVarSet` co_var_tvs -- (c) + + -- Step 3 of Note [decideAndPromoteTyVars], (d) + mono_tvs_with_mr + = -- Even at top level, we don't quantify over type variables + -- mentioned in constraints that the MR tells us not to quantify + -- See Note [decideAndPromoteTyVars] (DP2) + mono_tvs_without_mr `unionVarSet` mr_no_quant_tvs + + -------------------------------------------------------------------- + -- Step 4 of Note [decideAndPromoteTyVars] + -- Use closeWrtFunDeps to find any other variables that are determined by mono_tvs + add_determined tvs preds = closeWrtFunDeps preds tvs + `delVarSetList` psig_qtvs + -- Why delVarSetList psig_qtvs? + -- If the user has explicitly asked for quantification, then that + -- request "wins" over the MR. + -- + -- What if a psig variable is also free in the environment + -- (i.e. says "no" to isQuantifiableTv)? That's OK: explanation + -- in Step 2 of Note [Deciding quantification]. + + mono_tvs_with_mr_det = add_determined mono_tvs_with_mr post_mr_quant + mono_tvs_without_mr_det = add_determined mono_tvs_without_mr can_quant + + -------------------------------------------------------------------- + -- Step 5 of Note [decideAndPromoteTyVars] + -- Do not quantify over any constraint mentioning a "newly-mono" tyvar. + newly_mono_tvs = mono_tvs_with_mr_det `minusVarSet` mono_tvs_with_mr + final_quant + | is_top_level = filterOut (predMentions newly_mono_tvs) post_mr_quant + | otherwise = post_mr_quant + + -------------------------------------------------------------------- + -- Check if the Monomorphism Restriction has bitten + ; warn_mr <- woptM Opt_WarnMonomorphism + ; when (warn_mr && case infer_mode of { ApplyMR -> True; _ -> False}) $ + diagnosticTc (not (mono_tvs_with_mr_det `subVarSet` mono_tvs_without_mr_det)) $ + TcRnMonomorphicBindings (map fst name_taus) + -- If there is a variable in mono_tvs, but not in mono_tvs_wo_mr + -- then the MR has "bitten" and reduced polymorphism. + + -------------------------------------------------------------------- + -- Step 6: Promote the mono_tvs: see Note [Promote monomorphic tyvars] + ; _ <- promoteTyVarSet mono_tvs_with_mr_det + + ; traceTc "decideAndPromoteTyVars" $ vcat + [ text "rhs_tclvl =" <+> ppr rhs_tclvl + , text "top =" <+> ppr is_top_level + , text "infer_mode =" <+> ppr infer_mode + , text "psigs =" <+> ppr psigs + , text "psig_qtvs =" <+> ppr psig_qtvs + , text "outer_tvs =" <+> ppr outer_tvs + , text "mono_tvs_with_mr =" <+> ppr mono_tvs_with_mr + , text "mono_tvs_without_mr =" <+> ppr mono_tvs_without_mr + , text "mono_tvs_with_mr_det =" <+> ppr mono_tvs_with_mr_det + , text "mono_tvs_without_mr_det =" <+> ppr mono_tvs_without_mr_det + , text "newly_mono_tvs =" <+> ppr newly_mono_tvs + , text "can_quant =" <+> ppr can_quant + , text "post_mr_quant =" <+> ppr post_mr_quant + , text "no_quant_tvs =" <+> ppr no_quant_tvs + , text "mr_no_quant =" <+> ppr mr_no_quant + , text "final_quant =" <+> ppr final_quant + , text "co_vars =" <+> ppr co_vars ] + + ; return (final_quant, co_vars) } + -- We return `co_vars` that appear free in the final quantified types + -- we can't quantify over these, and we must make sure they are in scope + +------------------- +applyMR :: DynFlags -> InferMode -> [PredType] + -> ( [PredType] -- Quantify over these + , [PredType] ) -- But not over these +-- Split the candidates into ones we definitely +-- won't quantify, and ones that we might +applyMR _ NoRestrictions cand = (cand, []) +applyMR _ ApplyMR cand = ([], cand) +applyMR dflags EagerDefaulting cand = partition not_int_ct cand + where + ovl_strings = xopt LangExt.OverloadedStrings dflags + + -- not_int_ct returns True for a constraint we /can/ quantify + -- For EagerDefaulting, do not quantify over + -- over any interactive class constraint + not_int_ct pred + = case classifyPredType pred of + ClassPred cls _ -> not (isInteractiveClass ovl_strings cls) + _ -> True + +------------------- +outerLevelTyVars :: TcLevel -> TcTyVarSet -> TcTyVarSet +-- Find just the tyvars that are bound outside rhs_tc_lvl +outerLevelTyVars rhs_tclvl tvs + = filterVarSet is_outer_tv tvs + where + is_outer_tv tcv + | isTcTyVar tcv -- Might be a CoVar; change this when gather covars separately + = rhs_tclvl `strictlyDeeperThan` tcTyVarLevel tcv + | otherwise + = False + +{- Note [decideAndPromoteTyVars] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We are about to generalise a let-binding at "outer level" N, where we have +typechecked its RHS at "rhs level" N+1. Each tyvar must be either + (P) promoted + (D) defaulted + (Q) quantified +The function `decideAndPromoteTyVars` figures out (P), the type variables +mentioned in constraints should definitely not be quantified, and promotes them +to the outer level, namely N. + +The plan + +* Step 1. Use `approximateWCX` to extract, from the RHS `WantedConstraints`, + the PredTypes that we might quantify over; and also those that we can't. + Example: suppose the `wanted` is this: + (d1:Eq alpha, forall b. (F b ~ a) => (co:t1 ~ t2), (d:Show alpha)) + Then + can_quant = [Eq alpha, Show alpha] + no_quant = (t1 ~ t2) + We can't quantify over that (t1~t2) because of the enclosing equality (F b ~ a). + + We also choose never to quantify over some forms of equality constraints. + Both this and the "given-equality" thing are described in + Note [Quantifying over equality constraints] in GHC.Tc.Types.Constraint. + +* Step 2. Further trim can_quant using the Monomorphism Restriction, yielding the + further `mr_no_quant` predicates that we won't quantify over; plus `post_mr_quant`, + which we can in principle quantify. + +* Step 3. Identify the type variables we definitely won't quantify, because they are: + a) From an outer level <=N anyway + b) Mentioned in a constraint we /can't/ quantify. See Wrinkle (DP1). + c) Mentioned in the kind of a CoVar; we can't quantify over a CoVar, + so we must not quantify over a type variable free in its kind + d) Mentioned in a constraint that the MR says we should not quantify. + + There is a special case for top-level bindings: see Wrinkle (DP2). + +* Step 4. Close wrt functional dependencies and equalities.Example + Example + f x y = ... + where z = x 3 + The body of z tries to unify the type of x (call it alpha[1]) with + (beta[2] -> gamma[2]). This unification fails because alpha is untouchable, leaving + [W] alpha[1] ~ (beta[2] -> gamma[2]) + We don't want to quantify over beta or gamma because they are fixed by alpha, + which is monomorphic. Actual test case: typecheck/should_compile/tc213 + + Another example. Suppose we have + class C a b | a -> b + and a constraint ([W] C alpha beta), if we promote alpha we should promote beta. + + See also Note [growThetaTyVars vs closeWrtFunDeps] + +* Step 5. Further restrict the quantifiable constraints `post_mr_quant` to ones + that do not mention a "newly mono" tyvar. The "newly-mono" tyvars are the ones + not free in the envt, nor forced to be promoted by the MR; but are determined + (via fundeps) by them. Example: + class C a b | a -> b + [W] C Int beta[1], tau = beta[1]->Int + We promote beta[1] to beta[0] since it is determined by fundep, but we do not + want to generate f :: (C Int beta[0]) => beta[0] -> Int Rather, we generate + f :: beta[0] -> Int, but leave [W] C Int beta[0] in the residual constraints, + which will probably cause a type error + + See Note [Do not quantify over constraints that determine a variable] + +* Step 6: actually promote the type variables we don't want to quantify. + We must do this: see Note [Promote monomorphic tyvars]. + +We also add a warning that signals when the MR "bites". + +Wrinkles + +(DP1) In step 3, why (b)? Consider the example given in Step 1. we can't + quantify over the constraint (t1~t2). But if we quantify over the /tyvars/ in + t1 or t2, we may simply make that constraint insoluble (#25266 was an example). + +(DP2) In Step 3, for top-level bindings, we do (a,d), but /not/ (b,c). Reason: + see Note [The top-level Any principle]. At top level we are very reluctant to + promote type variables. But for bindings affected by the MR we have no choice + but to promote. + + An example is in #26004. + f w e = case e of + T1 -> let y = not w in False + T2 -> True + When generalising `f` we have a constraint + forall. (a ~ Bool) => alpha ~ Bool + where our provisional type for `f` is `f :: T alpha -> blah`. + In a /nested/ setting, we might simply not-generalise `f`, hoping to learn + about `alpha` from f's call sites (test T5266b is an example). But at top + level, to avoid spooky action at a distance. + +Note [The top-level Any principle] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Key principles: + * we never want to show the programmer a type with `Any` in it. + * avoid "spooky action at a distance" and silent defaulting + +Most /top level/ bindings have a type signature, so none of this arises. But +where a top-level binding lacks a signature, we don't want to infer a type like + f :: alpha[0] -> Int +and then subsequently default alpha[0]:=Any. Exposing `Any` to the user is bad +bad bad. Better to report an error, which is what may well happen if we +quantify over alpha instead. + +Moreover, + * If (elsewhere in this module) we add a call to `f`, say (f True), then + `f` will get the type `Bool -> Int` + * If we add /another/ call, say (f 'x'), we will then get a type error. + * If we have no calls, the final exported type of `f` may get set by + defaulting, and might not be principal (#26004). + +For /nested/ bindings, a monomorphic type like `f :: alpha[0] -> Int` is fine, +because we can see all the call sites of `f`, and they will probably fix +`alpha`. In contrast, we can't see all of (or perhaps any of) the calls of +top-level (exported) functions, reducing the worries about "spooky action at a +distance". This also moves in the direction of `MonoLocalBinds`, which we like. + +Note [Do not quantify over constraints that determine a variable] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (typecheck/should_compile/tc231), where we're trying to infer +the type of a top-level declaration. We have + class Zork s a b | a -> b +and the candidate constraint at the end of simplifyInfer is + [W] Zork alpha[1] (Z [Char]) beta[1] +We definitely want to quantify over `alpha` (which is mentioned in the +tau-type). + +But we do *not* want to quantify over `beta`: it is determined by the +functional dependency on Zork: note that the second argument to Zork +in the Wanted is a variable-free `Z [Char]`. Quantifying over it +would be "Henry Ford polymorphism". (Presumably we don't have an +instance in scope that tells us what `beta` actually is.) Instead +we promote `beta[1]` to `beta[0]`, in `decidePromotedTyVars`. + +The question here: do we want to quantify over the constraint, to +give the type + forall a. Zork a (Z [Char]) beta[0] => blah +Definitely not: see Note [The top-level Any principle] + +What we really want (to catch the Zork example) is this: + + Quantify over the constraint only if all its free variables are + (a) quantified, or + (b) appears in the type of something in the environment (mono_tvs0). + +To understand (b) consider + + class C a b where { op :: a -> b -> () } + + mr = 3 -- mr :: alpha + f1 x = op x mr -- f1 :: forall b. b -> (), plus [W] C b alpha + intify = mr + (4 :: Int) + +In `f1` should we quantify over that `(C b alpha)`? Answer: since `alpha` is +free in the type envt, yes we should. After all, if we'd typechecked `intify` +first, we'd have set `alpha := Int`, and /then/ we'd certainly quantify. The +delicate Zork situation applies when beta is completely unconstrained (not free +in the environment) -- except by the fundep. Hence `newly_mono`. + +Another way to put it: let's say `alpha` is in `outer_tvs`. It must be that +some variable `x` has `alpha` free in its type. If we are at top-level (and we +are, because nested decls don't go through this path all), then `x` must also +be at top-level. And, by induction, `x` will not have Any in its type when all +is said and done. The induction is well-founded because, if `x` is mutually +recursive with the definition at hand, then their constraints get processed +together (or `x` has a type signature, in which case the type doesn't have +`Any`). So the key thing is that we must not introduce a new top-level +unconstrained variable here. + +However this regrettably-subtle reasoning is needed only for /top-level/ +declarations. For /nested/ decls we can see all the calls, so we'll instantiate +that quantifed `Zork a (Z [Char]) beta` constraint at call sites, and either +solve it or not (probably not). We won't be left with a still-callable function +with Any in its type. So for nested definitions we don't make this tricky test. + +Historical note: we had a different, and more complicated test before, but it +was utterly wrong: #23199. + +Note [Promote monomorphic tyvars] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Promote any type variables that are free in the environment. Eg + f :: forall qtvs. bound_theta => zonked_tau +The free vars of f's type become free in the envt, and hence will show +up whenever 'f' is called. They may currently at rhs_tclvl, but they +had better be unifiable at the outer_tclvl! Example: envt mentions +alpha[1] + tau_ty = beta[2] -> beta[2] + constraints = alpha ~ [beta] +we don't quantify over beta (since it is fixed by envt) +so we must promote it! The inferred type is just + f :: beta -> beta + +NB: promoteTyVarSet ignores coercion variables + +Note [Defaulting during simplifyInfer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are inferring a type, we simplify the constraint, and then use +approximateWC to produce a list of candidate constraints. Then we MUST + + a) Promote any meta-tyvars that have been floated out by + approximateWC, to restore invariant (WantedInv) described in + Note [TcLevel invariants] in GHC.Tc.Utils.TcType. + + b) Default the kind of any meta-tyvars that are not mentioned in + in the environment. + +To see (b), suppose the constraint is (C ((a :: OpenKind) -> Int)), and we +have an instance (C ((x:*) -> Int)). The instance doesn't match -- but it +should! If we don't solve the constraint, we'll stupidly quantify over +(C (a->Int)) and, worse, in doing so skolemiseQuantifiedTyVar will quantify over +(b:*) instead of (a:OpenKind), which can lead to disaster; see #7332. +#7641 is a simpler example. + +-} + +------------------- +defaultTyVarsAndSimplify :: TcLevel + -> [PredType] -- Assumed zonked + -> TcM [PredType] -- Guaranteed zonked +-- Default any tyvar free in the constraints; +-- and re-simplify in case the defaulting allows further simplification +-- See Note [Defaulting during simplifyInfer] +defaultTyVarsAndSimplify rhs_tclvl candidates + = do { -- Default any kind/levity vars + ; DV {dv_kvs = cand_kvs, dv_tvs = cand_tvs} + <- candidateQTyVarsOfTypes candidates + -- NB1: decidePromotedTyVars has promoted any type variable fixed by the + -- type envt, so they won't be chosen by candidateQTyVarsOfTypes + -- NB2: Defaulting for variables free in tau_tys is done later, by quantifyTyVars + -- Hence looking only at 'candidates' + -- NB3: Any covars should already be handled by + -- the logic in decidePromotedTyVars, which looks at + -- the constraints generated + + ; poly_kinds <- xoptM LangExt.PolyKinds + ; let default_kv | poly_kinds = default_tv + | otherwise = defaultTyVar DefaultKindVars + default_tv = defaultTyVar (NonStandardDefaulting DefaultNonStandardTyVars) + ; mapM_ default_kv (dVarSetElems cand_kvs) + ; mapM_ default_tv (dVarSetElems (cand_tvs `minusDVarSet` cand_kvs)) + + ; simplify_cand candidates + } + where + -- See Note [Unconditionally resimplify constraints when quantifying] + simplify_cand [] = return [] -- Fast path + simplify_cand candidates + = do { clone_wanteds <- newWanteds DefaultOrigin candidates + ; WC { wc_simple = simples } <- setTcLevel rhs_tclvl $ + simplifyWantedsTcM clone_wanteds + -- Discard evidence; simples is fully zonked + + ; let new_candidates = ctsPreds simples + ; traceTc "Simplified after defaulting" $ + vcat [ text "Before:" <+> ppr candidates + , text "After:" <+> ppr new_candidates ] + ; return new_candidates } + +------------------ +decideQuantifiedTyVars + :: SkolemInfoAnon + -> [(Name,TcType)] -- Annotated theta and (name,tau) pairs + -> [TcIdSigInst] -- Partial signatures + -> [PredType] -- Candidates, zonked + -> TcM [TyVar] +-- Fix what tyvars we are going to quantify over, and quantify them +decideQuantifiedTyVars skol_info_anon name_taus psigs candidates + = do { -- Why psig_tys? We try to quantify over everything free in here + -- See Note [Quantification and partial signatures] + -- Wrinkles 2 and 3 + (psig_qtvs, psig_theta, tau_tys) <- getSeedTys name_taus psigs + + ; let psig_tys = mkTyVarTys psig_qtvs ++ psig_theta + seed_tvs = tyCoVarsOfTypes (psig_tys ++ tau_tys) + + -- "Grow" those seeds to find ones reachable via 'candidates' + -- See Note [growThetaTyVars vs closeWrtFunDeps] + grown_tcvs = growThetaTyVars candidates seed_tvs + + -- Now we have to classify them into kind variables and type variables + -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyTyVars + -- + -- The psig_tys are first in seed_tys, then candidates, then tau_tvs. + -- This makes candidateQTyVarsOfTypes produces them in that order, so that the + -- final qtvs quantifies in the same- order as the partial signatures do (#13524) + ; dvs <- candidateQTyVarsOfTypes (psig_tys ++ candidates ++ tau_tys) + ; let dvs_plus = weedOutCandidates (`dVarSetIntersectVarSet` grown_tcvs) dvs + + ; traceTc "decideQuantifiedTyVars" (vcat + [ text "tau_tys =" <+> ppr tau_tys + , text "candidates =" <+> ppr candidates + , text "dvs =" <+> ppr dvs + , text "tau_tys =" <+> ppr tau_tys + , text "seed_tvs =" <+> ppr seed_tvs + , text "grown_tcvs =" <+> ppr grown_tcvs + , text "dvs =" <+> ppr dvs_plus]) + + ; skol_info <- mkSkolemInfo skol_info_anon + ; quantifyTyVars skol_info DefaultNonStandardTyVars dvs_plus } + +------------------ +getSeedTys :: [(Name,TcType)] -- The type of each RHS in the group + -> [TcIdSigInst] -- Any partial type signatures + -> TcM ( [TcTyVar] -- Zonked partial-sig quantified tyvars + , ThetaType -- Zonked partial signature thetas + , [TcType] ) -- Zonked tau-tys from the bindings +getSeedTys name_taus psigs + = TcM.liftZonkM $ + do { psig_tv_tys <- mapM TcM.zonkTcTyVar [ tv | TISI{ sig_inst_skols = skols } <- psigs + , (_, Bndr tv _) <- skols ] + ; psig_theta <- mapM TcM.zonkTcType [ pred | TISI{ sig_inst_theta = theta } <- psigs + , pred <- theta ] + ; tau_tys <- mapM (TcM.zonkTcType . snd) name_taus + ; return ( map getTyVar psig_tv_tys + , psig_theta + , tau_tys ) } + +------------------ +predMentions :: TcTyVarSet -> TcPredType -> Bool +predMentions qtvs pred = tyCoVarsOfType pred `intersectsVarSet` qtvs + +-- | When inferring types, should we quantify over a given predicate? +-- See Note [pickQuantifiablePreds] +pickQuantifiablePreds + :: TyVarSet -- Quantifying over these + -> TcThetaType -- Proposed constraints to quantify + -> TcThetaType -- A subset that we can actually quantify +-- This function decides whether a particular constraint should be +-- quantified over, given the type variables that are being quantified +pickQuantifiablePreds qtvs theta + = mkMinimalBySCs id $ -- See Note [Minimize by Superclasses] + mapMaybe pick_me theta + where + pick_me pred + = case classifyPredType pred of + ClassPred cls _ + | isIPClass cls + -> Just pred -- Pick, say, (?x::Int) whether or not it mentions qtvs + -- See Note [Inheriting implicit parameters] + + EqPred eq_rel ty1 ty2 + | predMentions qtvs pred + , Just (cls, tys) <- boxEqPred eq_rel ty1 ty2 + -- boxEqPred: See Note [Lift equality constraints when quantifying] + -> Just (mkClassPred cls tys) + | otherwise + -> Nothing + + _ | predMentions qtvs pred -> Just pred + | otherwise -> Nothing + +------------------ +growThetaTyVars :: ThetaType -> TyCoVarSet -> TyCoVarSet +-- See Note [growThetaTyVars vs closeWrtFunDeps] +growThetaTyVars theta tcvs + | null theta = tcvs + | otherwise = transCloVarSet mk_next seed_tcvs + where + seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips + (ips, non_ips) = partition couldBeIPLike theta + -- See Note [Inheriting implicit parameters] + + mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones + mk_next so_far = foldr (grow_one so_far) emptyVarSet non_ips + grow_one so_far pred tcvs + | pred_tcvs `intersectsVarSet` so_far = tcvs `unionVarSet` pred_tcvs + | otherwise = tcvs + where + pred_tcvs = tyCoVarsOfType pred + + +{- Note [pickQuantifiablePreds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When pickQuantifiablePreds is called we have decided what type +variables to quantify over, `qtvs`. The only quesion is: which of the +unsolved candidate predicates should we quantify over? Call them +`picked_theta`. + +Note that will leave behind a residual implication + forall qtvs. picked_theta => unsolved_constraints +For the members of unsolved_constraints that we select for picked_theta +it is easy to solve, by identity. For the others we just hope that +we can solve them. + +So which of the candidates should we pick to quantify over? It's pretty easy: + +* Never pick a constraint that doesn't mention any of the quantified + variables `qtvs`. Picking such a constraint essentially moves the solving of + the constraint from this function definition to call sites. But because the + constraint mentions no quantified variables, call sites have no advantage + over the definition site. Well, not quite: there could be new constraints + brought into scope by a pattern-match against a constrained (e.g. GADT) + constructor. Example + + data T a where { T1 :: T1 Bool; ... } + + f :: forall a. a -> T a -> blah + f x t = let g y = x&&y -- This needs a~Bool + in case t of + T1 -> g True + .... + + At g's call site we have `a~Bool`, so we /could/ infer + g :: forall . (a~Bool) => Bool -> Bool -- qtvs = {} + + This is all very contrived, and probably just postponse type errors to + the call site. If that's what you want, write a type signature. + +* Implicit parameters is an exception to the "no quantified vars" + rule (see Note [Inheriting implicit parameters]) so we can't actually + simply test this case first. + +* Finally, we may need to "box" equality predicates: if we want to quantify + over `a ~# b`, we actually quantify over the boxed version, `a ~ b`. + See Note [Lift equality constraints when quantifying]. + +Notice that we do /not/ consult -XFlexibleContexts here. For example, +we allow `pickQuantifiablePreds` to quantify over a constraint like +`Num [a]`; then if we don't have `-XFlexibleContexts` we'll get an +error from `checkValidType` but (critically) it includes the helpful +suggestion of adding `-XFlexibleContexts`. See #10608, #10351. + +Note [Lift equality constraints when quantifying] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We can't quantify over a constraint (t1 ~# t2) because that isn't a +predicate type; see Note [Types for coercions, predicates, and evidence] +in GHC.Core.Predicate + +So we have to 'lift' it to (t1 ~ t2). Similarly (~R#) must be lifted +to Coercible. + +This tiresome lifting is the reason that pick_me (in +pickQuantifiablePreds) returns a Maybe rather than a Bool. + +Note [Inheriting implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this: + + f x = (x::Int) + ?y + +where f is *not* a top-level binding. +From the RHS of f we'll get the constraint (?y::Int). +There are two types we might infer for f: + + f :: Int -> Int + +(so we get ?y from the context of f's definition), or + + f :: (?y::Int) => Int -> Int + +At first you might think the first was better, because then +?y behaves like a free variable of the definition, rather than +having to be passed at each call site. But of course, the WHOLE +IDEA is that ?y should be passed at each call site (that's what +dynamic binding means) so we'd better infer the second. + +BOTTOM LINE: when *inferring types* you must quantify over implicit +parameters, *even if* they don't mention the bound type variables. +Reason: because implicit parameters, uniquely, have local instance +declarations. See pickQuantifiablePreds. + +Note [Quantification and partial signatures] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When choosing type variables to quantify, the basic plan is to +quantify over all type variables that are + * free in the tau_tvs, and + * not forced to be monomorphic (mono_tvs), + for example by being free in the environment. + +However, in the case of a partial type signature, we are doing inference +*in the presence of a type signature*. For example: + f :: _ -> a + f x = ... +or + g :: (Eq _a) => _b -> _b +In both cases we use plan InferGen, and hence call simplifyInfer. But +those 'a' variables are skolems (actually TyVarTvs), and we should be +sure to quantify over them. This leads to several wrinkles: + +* Wrinkle 1. In the case of a type error + f :: _ -> Maybe a + f x = True && x + The inferred type of 'f' is f :: Bool -> Bool, but there's a + left-over error of form (Maybe a ~ Bool). The error-reporting + machine expects to find a binding site for the skolem 'a', so we + add it to the quantified tyvars. + +* Wrinkle 2. Consider the partial type signature + f :: (Eq _) => Int -> Int + f x = x + In normal cases that makes sense; e.g. + g :: Eq _a => _a -> _a + g x = x + where the signature makes the type less general than it could + be. But for 'f' we must therefore quantify over the user-annotated + constraints, to get + f :: forall a. Eq a => Int -> Int + (thereby correctly triggering an ambiguity error later). If we don't + we'll end up with a strange open type + f :: Eq alpha => Int -> Int + which isn't ambiguous but is still very wrong. + + Bottom line: Try to quantify over any variable free in psig_theta, + just like the tau-part of the type. + +* Wrinkle 3 (#13482). Also consider + f :: forall a. _ => Int -> Int + f x = if (undefined :: a) == undefined then x else 0 + Here we get an (Eq a) constraint, but it's not mentioned in the + psig_theta nor the type of 'f'. But we still want to quantify + over 'a' even if the monomorphism restriction is on. + +* Wrinkle 4 (#14479) + foo :: Num a => a -> a + foo xxx = g xxx + where + g :: forall b. Num b => _ -> b + g y = xxx + y + + In the signature for 'g', we cannot quantify over 'b' because it turns out to + get unified with 'a', which is free in g's environment. So we carefully + refrain from bogusly quantifying, in GHC.Tc.Solver.decidePromotedTyVars. We + report the error later, in GHC.Tc.Gen.Bind.chooseInferredQuantifiers. + +Note [growThetaTyVars vs closeWrtFunDeps] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC has two functions, growThetaTyVars and closeWrtFunDeps, both with +the same type and similar behavior. This Note outlines the differences +and why we use one or the other. + +Both functions take a list of constraints. We will call these the +*candidates*. + +closeWrtFunDeps takes a set of "determined" type variables and finds the +closure of that set with respect to the functional dependencies +within the class constraints in the set of candidates. So, if we +have + + class C a b | a -> b + class D a b -- no fundep + candidates = {C (Maybe a) (Either b c), D (Maybe a) (Either d e)} + +then closeWrtFunDeps {a} will return the set {a,b,c}. +This is because, if `a` is determined, then `b` and `c` are, too, +by functional dependency. closeWrtFunDeps called with any seed set not including +`a` will just return its argument, as only `a` determines any other +type variable (in this example). + +growThetaTyVars operates similarly, but it behaves as if every +constraint has a functional dependency among all its arguments. +So, continuing our example, growThetaTyVars {a} will return +{a,b,c,d,e}. Put another way, growThetaTyVars grows the set of +variables to include all variables that are mentioned in the same +constraint (transitively). + +We use closeWrtFunDeps in places where we need to know which variables are +*always* determined by some seed set. This includes + * when determining the mono-tyvars in decidePromotedTyVars. If `a` + is going to be monomorphic, we need b and c to be also: they + are determined by the choice for `a`. + * when checking instance coverage, in + GHC.Tc.Instance.FunDeps.checkInstCoverage + +On the other hand, we use growThetaTyVars where we need to know +which variables *might* be determined by some seed set. This includes + * deciding quantification (GHC.Tc.Gen.Bind.chooseInferredQuantifiers + and decideQuantifiedTyVars +How can `a` determine (say) `d` in the example above without a fundep? +Suppose we have + instance (b ~ a, c ~ a) => D (Maybe [a]) (Either b c) +Now, if `a` turns out to be a list, it really does determine b and c. +The danger in overdoing quantification is the creation of an ambiguous +type signature, but this is conveniently caught in the validity checker. + +Note [Quantification with errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we find that the RHS of the definition has some absolutely-insoluble +constraints (including especially "variable not in scope"), we + +* Abandon all attempts to find a context to quantify over, + and instead make the function fully-polymorphic in whatever + type we have found + +* Return a flag from simplifyInfer, indicating that we found an + insoluble constraint. This flag is used to suppress the ambiguity + check for the inferred type, which may well be bogus, and which + tends to obscure the real error. This fix feels a bit clunky, + but I failed to come up with anything better. + +Reasons: + - Avoid downstream errors + - Do not perform an ambiguity test on a bogus type, which might well + fail spuriously, thereby obfuscating the original insoluble error. + #14000 is an example + +I tried an alternative approach: simply failM, after emitting the +residual implication constraint; the exception will be caught in +GHC.Tc.Gen.Bind.tcPolyBinds, which gives all the binders in the group the type +(forall a. a). But that didn't work with -fdefer-type-errors, because +the recovery from failM emits no code at all, so there is no function +to run! But -fdefer-type-errors aspires to produce a runnable program. + +Note [Default while Inferring] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Our current plan is that defaulting only happens at simplifyTop and +not simplifyInfer. This may lead to some insoluble deferred constraints. +Example: + +instance D g => C g Int b + +constraint inferred = (forall b. 0 => C gamma alpha b) /\ Num alpha +type inferred = gamma -> gamma + +Now, if we try to default (alpha := Int) we will be able to refine the implication to + (forall b. 0 => C gamma Int b) +which can then be simplified further to + (forall b. 0 => D gamma) +Finally, we /can/ approximate this implication with (D gamma) and infer the quantified +type: forall g. D g => g -> g + +Instead what will currently happen is that we will get a quantified type +(forall g. g -> g) and an implication: + forall g. 0 => (forall b. 0 => C g alpha b) /\ Num alpha + +Which, even if the simplifyTop defaults (alpha := Int) we will still be left with an +unsolvable implication: + forall g. 0 => (forall b. 0 => D g) + +The concrete example would be: + h :: C g a s => g -> a -> ST s a + f (x::gamma) = (\_ -> x) (runST (h x (undefined::alpha)) + 1) + +But it is quite tedious to do defaulting and resolve the implication constraints, and +we have not observed code breaking because of the lack of defaulting in inference, so +we don't do it for now. + +Note [Minimize by Superclasses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we quantify over a constraint, in simplifyInfer we need to +quantify over a constraint that is minimal in some sense: For +instance, if the final wanted constraint is (Eq alpha, Ord alpha), +we'd like to quantify over Ord alpha, because we can just get Eq alpha +from superclass selection from Ord alpha. This minimization is what +mkMinimalBySCs does. Then, simplifyInfer uses the minimal constraint +to check the original wanted. + + +Note [Avoid unnecessary constraint simplification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + -------- NB NB NB (Jun 12) ------------- + This note not longer applies; see the notes with #4361. + But I'm leaving it in here so we remember the issue.) + ---------------------------------------- +When inferring the type of a let-binding, with simplifyInfer, +try to avoid unnecessarily simplifying class constraints. +Doing so aids sharing, but it also helps with delicate +situations like + + instance C t => C [t] where .. + + f :: C [t] => .... + f x = let g y = ...(constraint C [t])... + in ... +When inferring a type for 'g', we don't want to apply the +instance decl, because then we can't satisfy (C t). So we +just notice that g isn't quantified over 't' and partition +the constraints before simplifying. + +This only half-works, but then let-generalisation only half-works. + +Note [DefaultTyVar] +~~~~~~~~~~~~~~~~~~~ +defaultTyVar is used on any un-instantiated meta type variables to +default any RuntimeRep variables to LiftedRep. This is important +to ensure that instance declarations match. For example consider + + instance Show (a->b) + foo x = show (\_ -> True) + +Then we'll get a constraint (Show (p ->q)) where p has kind (TYPE r), +and that won't match the typeKind (*) in the instance decl. See tests +tc217 and tc175. + +We look only at touchable type variables. No further constraints +are going to affect these type variables, so it's time to do it by +hand. However we aren't ready to default them fully to () or +whatever, because the type-class defaulting rules have yet to run. + +An alternate implementation would be to emit a Wanted constraint setting +the RuntimeRep variable to LiftedRep, but this seems unnecessarily indirect. -} diff --git a/GHC/Tc/Solver/Default.hs b/GHC/Tc/Solver/Default.hs new file mode 100644 --- /dev/null +++ b/GHC/Tc/Solver/Default.hs @@ -0,0 +1,1263 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultiWayIf #-} + +module GHC.Tc.Solver.Default( + tryDefaulting, tryDefaultingForAmbiguityCheck, + isInteractiveClass, isNumClass + ) where + +import GHC.Prelude + +import GHC.Tc.Errors +import GHC.Tc.Errors.Types +import GHC.Tc.Types.Evidence +import GHC.Tc.Solver.Solve ( solveSimpleWanteds, setImplicationStatus ) +import GHC.Tc.Solver.Dict ( solveCallStack ) +import GHC.Tc.Utils.Unify +import GHC.Tc.Utils.TcMType as TcM +import GHC.Tc.Utils.Monad as TcM +import GHC.Tc.Zonk.TcType as TcM +import GHC.Tc.Solver.Solve( solveWanteds ) +import GHC.Tc.Solver.Monad as TcS +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.CtLoc( mkGivenLoc ) +import GHC.Tc.Types.Origin +import GHC.Tc.Utils.TcType + +import GHC.Core.Class +import GHC.Core.Reduction( Reduction, reductionCoercion ) +import GHC.Core +import GHC.Core.DataCon +import GHC.Core.Make +import GHC.Core.Coercion( isReflCo, mkReflCo, mkSubCo, hasCoercionHole ) +import GHC.Core.Unify ( tcMatchTyKis ) +import GHC.Core.Predicate +import GHC.Core.Type +import GHC.Core.TyCo.Tidy + +import GHC.Types.DefaultEnv ( ClassDefaults (..), defaultList ) +import GHC.Types.Unique.Set +import GHC.Types.Id + +import GHC.Builtin.Utils +import GHC.Builtin.Names +import GHC.Builtin.Types + +import GHC.Types.TyThing ( MonadThings(lookupId) ) +import GHC.Types.Var +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Id.Make ( unboxedUnitExpr ) + +import GHC.Driver.DynFlags +import GHC.Unit.Module ( getModule ) + +import GHC.Utils.Misc +import GHC.Utils.Panic +import GHC.Utils.Outputable + +import GHC.Data.FastString +import GHC.Data.List.SetOps +import GHC.Data.Bag + +import Control.Monad +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.State.Strict ( StateT(runStateT), put ) +import Data.Foldable ( toList, traverse_ ) +import Data.List.NonEmpty ( NonEmpty(..), nonEmpty ) +import qualified Data.List.NonEmpty as NE +import GHC.Data.Maybe ( isJust, mapMaybe, catMaybes ) +import Data.Monoid ( First(..) ) + + +{- Note [Top-level Defaulting Plan] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We have considered two design choices for where/when to apply defaulting. + (i) Do it in SimplCheck mode only /whenever/ you try to solve some + simple constraints, maybe deep inside the context of implications. + This used to be the case in GHC 7.4.1. + (ii) Do it in a tight loop at simplifyTop, once all other constraints have + finished. This is the current story. + +Option (i) had many disadvantages: + a) Firstly, it was deep inside the actual solver. + b) Secondly, it was dependent on the context (Infer a type signature, + or Check a type signature, or Interactive) since we did not want + to always start defaulting when inferring (though there is an exception to + this, see Note [Default while Inferring]). + c) It plainly did not work. Consider typecheck/should_compile/DfltProb2.hs: + f :: Int -> Bool + f x = const True (\y -> let w :: a -> a + w a = const a (y+1) + in w y) + We will get an implication constraint (for beta the type of y): + [untch=beta] forall a. 0 => Num beta + which we really cannot default /while solving/ the implication, since beta is + untouchable. + +Instead our new defaulting story is to pull defaulting out of the solver loop and +go with option (ii), implemented at SimplifyTop. Namely: + - First, have a go at solving the residual constraint of the whole + program + - Try to approximate it with a simple constraint + - Figure out derived defaulting equations for that simple constraint + - Go round the loop again if you did manage to get some equations + +Now, that has to do with class defaulting. However there exists type variable /kind/ +defaulting. Again this is done at the top-level and the plan is: + - At the top-level, once you had a go at solving the constraint, do + figure out /all/ the touchable unification variables of the wanted constraints. + - Apply defaulting to their kinds + +More details in Note [DefaultTyVar]. + +Note [Limited defaulting in the ambiguity check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When simplifying constraints for the ambiguity check, we don't want full +defaulting. E.g. #11947 was an example: + f :: Num a => Int -> Int +This is ambiguous of course, but we don't want to default the (Num +alpha) constraint to (Num Int)! Doing so gives a defaulting warning, +but no error. + +But we still do + +* tryConstraintDefaulting. Example in T10009 where we have this type signature + f :: (UnF (F b) ~ b) => F b -> () + We finish up with an equality that is a member of it's + [W] hole{co_aF0} {rewriters: {co_aF0}}:: b_aES[tau:1] ~# b_aEP[sk:1] + It is not unified because of (REWRITERS) in Note [Unification preconditions] + in GHC.Tc.Utils.Unify + + (`tryConstraintDefaulting` defaults call-stack and exception constraint + as well as equalities; but in the case of the ambiguity check we will + only see equality constraints. Does not seem worth making a version + of `tryConstraintDefaulting` that looks only for equalities.) + +* tryUnsatisfiableGivens: see Wrinkle [Ambiguity] under point (C) of + Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors. +-} + + +tryDefaulting :: WantedConstraints -> TcS WantedConstraints +-- This is the function that pulls all the defaulting strategies together +tryDefaulting wc + = do { dflags <- getDynFlags + ; traceTcS "tryDefaulting {" (ppr wc) + ; wc1 <- tryTyVarDefaulting dflags wc + ; wc2 <- tryConstraintDefaulting wc1 + ; wc3 <- tryTypeClassDefaulting wc2 + ; wc4 <- tryUnsatisfiableGivens wc3 + ; traceTcS "tryDefaulting }" (ppr wc4) + ; return wc4 } + +tryDefaultingForAmbiguityCheck :: WantedConstraints -> TcS WantedConstraints +-- See Note [Limited defaulting in the ambiguity check] +tryDefaultingForAmbiguityCheck wc + = do { traceTcS "tryDefaulting for ambiguity {" (ppr wc) + ; wc1 <- tryConstraintDefaulting wc + ; wc2 <- tryUnsatisfiableGivens wc1 + ; traceTcS "tryDefaulting }" (ppr wc2) + ; return wc2 } + +solveAgainIf :: Bool -> WantedConstraints -> TcS WantedConstraints +-- If the Bool is true, solve the wanted constraints again +-- See Note [Must simplify after defaulting] +solveAgainIf False wc = return wc +solveAgainIf True wc = nestTcS (solveWanteds wc) + + +{- ****************************************************************************** +* * + tryTyVarDefaulting +* * +****************************************************************************** -} + +tryTyVarDefaulting :: DynFlags -> WantedConstraints -> TcS WantedConstraints +tryTyVarDefaulting dflags wc + | isEmptyWC wc + = return wc + | insolubleWC wc + , gopt Opt_PrintExplicitRuntimeReps dflags -- See Note [Defaulting insolubles] + = return wc + | otherwise + = do { -- Need to zonk first, as the WantedConstraints are not yet zonked. + ; free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc) + ; let defaultable_tvs = filter can_default free_tvs + can_default tv + = isTyVar tv + -- Weed out coercion variables. + + && isMetaTyVar tv + -- Weed out runtime-skolems in GHCi, which we definitely + -- shouldn't try to default. + + && not (tv `elemVarSet` nonDefaultableTyVarsOfWC wc) + -- Weed out variables for which defaulting would be unhelpful, + -- e.g. alpha appearing in [W] alpha[conc] ~# rr[sk]. + + ; unification_s <- mapM defaultTyVarTcS defaultable_tvs -- Has unification side effects + ; solveAgainIf (or unification_s) wc } + -- solveAgainIf: see Note [Must simplify after defaulting] + +type UnificationDone = Bool + +noUnification, didUnification :: UnificationDone +noUnification = False +didUnification = True + +-- | Like 'defaultTyVar', but in the TcS monad. +defaultTyVarTcS :: TcTyVar -> TcS UnificationDone +defaultTyVarTcS the_tv + | isTyVarTyVar the_tv + -- TyVarTvs should only be unified with a tyvar + -- never with a type; c.f. GHC.Tc.Utils.TcMType.defaultTyVar + -- and Note [Inferring kinds for type declarations] in GHC.Tc.TyCl + = return noUnification + | isRuntimeRepVar the_tv + = do { traceTcS "defaultTyVarTcS RuntimeRep" (ppr the_tv) + ; unifyTyVar the_tv liftedRepTy + ; return didUnification } + | isLevityVar the_tv + = do { traceTcS "defaultTyVarTcS Levity" (ppr the_tv) + ; unifyTyVar the_tv liftedDataConTy + ; return didUnification } + | isMultiplicityVar the_tv + = do { traceTcS "defaultTyVarTcS Multiplicity" (ppr the_tv) + ; unifyTyVar the_tv ManyTy + ; return didUnification } + | otherwise + = return noUnification -- the common case + + +{- ****************************************************************************** +* * + tryUnsatisfiableGivens +* * +****************************************************************************** -} + +-- | If an implication contains a Given of the form @Unsatisfiable msg@, +-- use it to solve all Wanteds within the implication. +-- See point (C) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors. +-- +-- This does a complete walk over the implication tree. +tryUnsatisfiableGivens :: WantedConstraints -> TcS WantedConstraints +tryUnsatisfiableGivens wc = + do { (final_wc, did_work) <- (`runStateT` False) $ go_wc wc + ; solveAgainIf did_work final_wc } + where + go_wc (WC { wc_simple = wtds, wc_impl = impls, wc_errors = errs }) + = do impls' <- mapBagM go_impl impls + return $ WC { wc_simple = wtds, wc_impl = impls', wc_errors = errs } + go_impl impl + | isSolvedStatus (ic_status impl) + = return impl + -- Is there a Given with type "Unsatisfiable msg"? + -- If so, use it to solve all other Wanteds. + | unsat_given:_ <- mapMaybe unsatisfiableEv_maybe (ic_given impl) + = do { put True + ; lift $ solveImplicationUsingUnsatGiven unsat_given impl } + -- Otherwise, recurse. + | otherwise + = do { wcs' <- go_wc (ic_wanted impl) + ; lift $ setImplicationStatus $ impl { ic_wanted = wcs' } } + +-- | Is this evidence variable the evidence for an 'Unsatisfiable' constraint? +-- +-- If so, return the variable itself together with the error message type. +unsatisfiableEv_maybe :: EvVar -> Maybe (EvVar, Type) +unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v) + +-- | We have an implication with an 'Unsatisfiable' Given; use that Given to +-- solve all the other Wanted constraints, including those nested within +-- deeper implications. +solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS Implication +solveImplicationUsingUnsatGiven + unsat_given@(given_ev,_) + impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var + , ic_need_implic = inner }) + | isCoEvBindsVar ev_binds_var + -- We can't use Unsatisfiable evidence in kinds. + -- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence. + = return impl + | otherwise + = do { wcs <- nestImplicTcS ev_binds_var tclvl $ go_wc wtd + ; setImplicationStatus $ + impl { ic_wanted = wcs + , ic_need_implic = inner `extendEvNeedSet` given_ev } } + -- Record that the Given is needed; I'm not certain why + where + go_wc :: WantedConstraints -> TcS WantedConstraints + go_wc wc@(WC { wc_simple = wtds, wc_impl = impls }) + = do { mapBagM_ go_simple wtds + ; impls <- mapBagM (solveImplicationUsingUnsatGiven unsat_given) impls + ; return $ wc { wc_simple = emptyBag, wc_impl = impls } } + go_simple :: Ct -> TcS () + go_simple ct = case ctEvidence ct of + CtWanted (WantedCt { ctev_pred = pty, ctev_dest = dest }) + -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty + ; setWantedEvTerm dest EvNonCanonical $ EvExpr ev_expr } + _ -> return () + +-- | Create an evidence expression for an arbitrary constraint using +-- evidence for an "Unsatisfiable" Given. +-- +-- See Note [Evidence terms from Unsatisfiable Givens] +unsatisfiableEvExpr :: (EvVar, ErrorMsgType) -> PredType -> TcS EvExpr +unsatisfiableEvExpr (unsat_ev, given_msg) wtd_ty + = do { mod <- getModule + -- If we're typechecking GHC.TypeError, return a bogus expression; + -- it's only used for the ambiguity check, which throws the evidence away anyway. + -- This avoids problems with circularity; where we are trying to look + -- up the "unsatisfiable" Id while we are in the middle of typechecking it. + ; if mod == gHC_INTERNAL_TYPEERROR then return (Var unsat_ev) else + do { unsatisfiable_id <- tcLookupId unsatisfiableIdName + + -- See Note [Evidence terms from Unsatisfiable Givens] + -- for a description of what evidence term we are constructing here. + + ; let -- (##) -=> wtd_ty + fun_ty = mkFunTy visArgConstraintLike ManyTy unboxedUnitTy wtd_ty + mkDictBox = case boxingDataCon fun_ty of + BI_Box { bi_data_con = mkDictBox } -> mkDictBox + _ -> pprPanic "unsatisfiableEvExpr: no DictBox!" (ppr wtd_ty) + dictBox = dataConTyCon mkDictBox + ; ev_bndr <- mkSysLocalM (fsLit "ct") ManyTy fun_ty + -- Dict ((##) -=> wtd_ty) + ; let scrut_ty = mkTyConApp dictBox [fun_ty] + -- unsatisfiable @{LiftedRep} @given_msg @(Dict ((##) -=> wtd_ty)) unsat_ev + scrut = + mkCoreApps (Var unsatisfiable_id) + [ Type liftedRepTy + , Type given_msg + , Type scrut_ty + , Var unsat_ev ] + -- case scrut of { MkDictBox @((##) -=> wtd_ty)) ct -> ct (# #) } + ev_expr = + mkWildCase scrut (unrestricted $ scrut_ty) wtd_ty + [ Alt (DataAlt mkDictBox) [ev_bndr] $ + mkCoreApps (Var ev_bndr) [unboxedUnitExpr] + ] + ; return ev_expr } } + +{- Note [Evidence terms from Unsatisfiable Givens] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An Unsatisfiable Given constraint, of the form [G] Unsatisfiable msg, should be +able to solve ANY Wanted constraint whatsoever. + +Recall that we have + + unsatisfiable :: forall {rep} (msg :: ErrorMessage) (a :: TYPE rep) + . Unsatisfiable msg => a + +We want to use this function, together with the evidence +[G] unsat_ev :: Unsatisfiable msg, to solve any other constraint [W] wtd_ty. + +We could naively think that a valid evidence term for the Wanted might be: + + wanted_ev = unsatisfiable @{rep} @msg @wtd_ty unsat_ev + +Unfortunately, this is a kind error: "wtd_ty :: CONSTRAINT rep", but +"unsatisfiable" expects the third type argument to be of kind "TYPE rep". + +Instead, we use a boxing data constructor to box the constraint into a type. +In the end, we construct the following evidence for the implication: + + [G] unsat_ev :: Unsatisfiable msg + ==> + [W] wtd_ev :: wtd_ty + + wtd_ev = + case unsatisfiable @{LiftedRep} @msg @(Dict ((##) -=> wtd_ty)) unsat_ev of + MkDictBox ct -> ct (# #) + +Note that we play the same trick with the function arrow -=> that we did +in order to define "unsatisfiable" in terms of "unsatisfiableLifted", as described +in Note [The Unsatisfiable representation-polymorphism trick] in base:GHC.TypeError. +This allows us to indirectly box constraints with different representations +(such as primitive equality constraints). +-} + + +{- ****************************************************************************** +* * + tryConstraintDefaulting +* * +****************************************************************************** -} + +-- | A 'TcS' action which can may solve a `Ct` +type CtDefaultingStrategy = Ct -> TcS Bool + -- True <=> I solved the constraint + +tryConstraintDefaulting :: WantedConstraints -> TcS WantedConstraints +-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence +tryConstraintDefaulting wc + | isEmptyWC wc + = return wc + | otherwise + = do { (n_unifs, better_wc) <- reportUnifications (go_wc wc) + -- We may have done unifications; so solve again + ; solveAgainIf (n_unifs > 0) better_wc } + where + go_wc :: WantedConstraints -> TcS WantedConstraints + go_wc wc@(WC { wc_simple = simples, wc_impl = implics }) + = do { simples' <- mapMaybeBagM go_simple simples + ; implics' <- mapBagM go_implic implics + ; return (wc { wc_simple = simples', wc_impl = implics' }) } + + go_simple :: Ct -> TcS (Maybe Ct) + go_simple ct = do { solved <- tryCtDefaultingStrategy ct + ; if solved then return Nothing + else return (Just ct) } + + go_implic :: Implication -> TcS Implication + -- The Maybe is because solving the CallStack constraint + -- may well allow us to discard the implication entirely + go_implic implic + | isSolvedStatus (ic_status implic) + = return implic -- Nothing to solve inside here + | otherwise + = do { wanteds <- setEvBindsTcS (ic_binds implic) $ + -- defaultCallStack sets a binding, so + -- we must set the correct binding group + go_wc (ic_wanted implic) + ; setImplicationStatus (implic { ic_wanted = wanteds }) } + +tryCtDefaultingStrategy :: CtDefaultingStrategy +-- The composition of all the CtDefaultingStrategies we want +tryCtDefaultingStrategy + = foldr1 combineStrategies + ( defaultCallStack :| + defaultExceptionContext : + defaultEquality : + [] ) + +-- | Default @ExceptionContext@ constraints to @emptyExceptionContext@. +defaultExceptionContext :: CtDefaultingStrategy +defaultExceptionContext ct + | ClassPred cls tys <- classifyPredType (ctPred ct) + , isJust (isExceptionContextPred cls tys) + = do { warnTcS $ TcRnDefaultedExceptionContext (ctLoc ct) + ; empty_ec_id <- lookupId emptyExceptionContextName + ; let ev = ctEvidence ct + ev_tm = EvExpr (evWrapIPE (ctEvPred ev) (Var empty_ec_id)) + ; setEvBindIfWanted ev EvCanonical ev_tm + -- EvCanonical: see Note [CallStack and ExceptionContext hack] + -- in GHC.Tc.Solver.Dict + ; return True } + | otherwise + = return False + +-- | Default any remaining @CallStack@ constraints to empty @CallStack@s. +-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence +defaultCallStack :: CtDefaultingStrategy +defaultCallStack ct + | ClassPred cls tys <- classifyPredType (ctPred ct) + , isJust (isCallStackPred cls tys) + = do { solveCallStack (ctEvidence ct) EvCsEmpty + ; return True } + | otherwise + = return False + +defaultEquality :: CtDefaultingStrategy +-- See Note [Defaulting equalities] +defaultEquality ct + | EqPred eq_rel ty1 ty2 <- classifyPredType (ctPred ct) + = do { -- Remember: `ct` may not be zonked; + -- see (DE3) in Note [Defaulting equalities] + z_ty1 <- TcS.zonkTcType ty1 + ; z_ty2 <- TcS.zonkTcType ty2 + ; case eq_rel of + { NomEq -> + -- Now see if either LHS or RHS is a bare type variable + -- You might think the type variable will only be on the LHS + -- but with a type function we might get F t1 ~ alpha + case (getTyVar_maybe z_ty1, getTyVar_maybe z_ty2) of + (Just z_tv1, _) -> try_default_tv z_tv1 z_ty2 + (_, Just z_tv2) -> try_default_tv z_tv2 z_ty1 + _ -> return False ; + + ; ReprEq + -- See Note [Defaulting representational equalities] + | CIrredCan (IrredCt { ir_reason }) <- ct + , isInsolubleReason ir_reason + -- Don't do this for definitely insoluble representational + -- equalities such as Int ~R# Bool. + -> return False + | otherwise + -> + do { traceTcS "defaultEquality ReprEq {" $ vcat + [ text "ct:" <+> ppr ct + , text "z_ty1:" <+> ppr z_ty1 + , text "z_ty2:" <+> ppr z_ty2 + ] + -- Promote this representational equality to a nominal equality. + -- + -- This handles cases such as @IO alpha[tau] ~R# IO Int@ + -- by defaulting @alpha := Int@, which is useful in practice + -- (see Note [Defaulting representational equalities]). + ; (co, new_eqs, _unifs) <- + wrapUnifierX (ctEvidence ct) Nominal $ + -- NB: nominal equality! + \ uenv -> uType uenv z_ty1 z_ty2 + -- Only accept this solution if no new equalities are produced + -- by the unifier. + -- + -- See Note [Defaulting representational equalities]. + ; if null new_eqs + then do { setEvBindIfWanted (ctEvidence ct) EvCanonical $ + (evCoercion $ mkSubCo co) + ; return True } + else return False + } } } + | otherwise + = return False + + where + try_default_tv lhs_tv rhs_ty + | MetaTv { mtv_info = info } <- tcTyVarDetails lhs_tv + , tyVarKind lhs_tv `tcEqType` typeKind rhs_ty + , checkTopShape info rhs_ty + , not (hasCoercionHole rhs_ty) -- See (DE6) in Note [Defaulting equalities] + -- Do not test for touchability of lhs_tv; that is the whole point! + -- See (DE2) in Note [Defaulting equalities] + = do { traceTcS "defaultEquality 1" (ppr lhs_tv $$ ppr rhs_ty) + + -- checkTyEqRhs: check that we can in fact unify lhs_tv := rhs_ty + -- See Note [Defaulting equalities] + ; let flags :: TyEqFlags TcM () + flags = defaulting_TEFTask lhs_tv + + ; res :: PuResult () Reduction <- wrapTcS (checkTyEqRhs flags rhs_ty) + + ; case res of + PuFail {} -> cant_default_tv "checkTyEqRhs" + PuOK _ redn -> assertPpr (isReflCo (reductionCoercion redn)) (ppr redn) $ + -- With TEFA_Recurse we never get any reductions + default_tv } + | otherwise + = cant_default_tv "fall through" + + where + cant_default_tv msg + = do { traceTcS ("defaultEquality fails: " ++ msg) $ + vcat [ ppr lhs_tv <+> char '~' <+> ppr rhs_ty + , ppr (tyVarKind lhs_tv) + , ppr (typeKind rhs_ty) ] + ; return False } + + -- All tests passed: do the unification + default_tv + = do { traceTcS "defaultEquality success:" (ppr rhs_ty) + ; unifyTyVar lhs_tv rhs_ty -- NB: unifyTyVar adds to the + -- TcS unification counter + ; setEvBindIfWanted (ctEvidence ct) EvCanonical $ + evCoercion (mkReflCo Nominal rhs_ty) + ; return True + } + + +combineStrategies :: CtDefaultingStrategy -> CtDefaultingStrategy -> CtDefaultingStrategy +combineStrategies default1 default2 ct + = do { solved <- default1 ct + ; case solved of + True -> return True -- default1 solved it! + False -> default2 ct -- default1 failed, try default2 + } + + +{- Note [When to do type-class defaulting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In GHC 7.6 and 7.8.2, we did type-class defaulting only if insolubleWC +was false, on the grounds that defaulting can't help solve insoluble +constraints. But if we *don't* do defaulting we may report a whole +lot of errors that would be solved by defaulting; these errors are +quite spurious because fixing the single insoluble error means that +defaulting happens again, which makes all the other errors go away. +This is jolly confusing: #9033. + +So it seems better to always do type-class defaulting. + +However, always doing defaulting does mean that we'll do it in +situations like this (#5934): + run :: (forall s. GenST s) -> Int + run = fromInteger 0 +We don't unify the return type of fromInteger with the given function +type, because the latter involves foralls. So we're left with + (Num alpha, alpha ~ (forall s. GenST s) -> Int) +Now we do defaulting, get alpha := Integer, and report that we can't +match Integer with (forall s. GenST s) -> Int. That's not totally +stupid, but perhaps a little strange. + +Another potential alternative would be to suppress *all* non-insoluble +errors if there are *any* insoluble errors, anywhere, but that seems +too drastic. + +Note [Defaulting equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In top-level defaulting (as per Note [Top-level Defaulting Plan]), it makes +sense to try to default equality constraints, in addition to e.g. typeclass +defaulting: this doesn't threaten principal types (see DE1 below), but +allows GHC to accept strictly more programs. + +This Note explains defaulting nominal equalities; see also +Note [Defaulting representational equalities] which describes +the defaulting of representational equalities. + +Consider + + f :: forall a. (forall t. (F t ~ Int) => a -> Int) -> Int + + g :: Int + g = f id + +We'll typecheck + + id :: forall t. (F t ~ Int) => alpha[1] -> Int + +where the `alpha[1]` comes from instantiating `f`. So we'll end up +with the implication constraint + + forall[2] t. (F t ~ Int) => alpha[1] ~ Int + +and that can't be solved because `alpha` is untouchable under the +equality (F t ~ Int). + +This is tiresome, and gave rise to user complaints: #25125 and #25029. +Moreover, in this case there is no good reason not to unify alpha:=Int. +Doing so solves the constraint, and since `alpha` is not otherwise +constrained, it does no harm. + +In conclusion, for a Wanted equality constraint [W] lhs ~ rhs, if the only +reason for not unifying is that either lhs or rhs is an untouchable metavariable +then, in top-level defaulting, go ahead and unify. + +In top-level defaulting, we already do several other somewhat-ad-hoc, +but terribly convenient, unifications. This is just one more. + +Wrinkles: + +(DE1) Note carefully that this does not threaten principal types. + The original worry about unifying untouchable type variables was this: + + data T a where + T1 :: T Bool + f x = case x of T1 -> True + + Should we infer f :: T a -> Bool, or f :: T a -> a. Both are valid, but + neither is more general than the other. + +(DE2) We still can't unify if there is a skolem-escape check, or an occurs check, + or it it'd mean unifying a TyVarTv with a non-tyvar. It's only the + "untouchability test" that we lift. + +(DE3) The contraint we are looking at may not be fully zonked; for example, + an earlier defaulting might have affected it. So we zonk-on-the fly in + `defaultEquality`. + +(DE4) Promotion. Suppose we see alpha[2] := Maybe beta[4]. We want to promote + beta[4] to level 2 and unify alpha[2] := Maybe beta'[2]. This is done by + checkTyEqRhs called in defaultEquality. + +(DE5) Promotion. Suppose we see alpha[2] := F beta[4], where F is a type + family. Then we still want to promote beta to beta'[2], and unify. This is + unusual: more commonly, we don't promote unification variables under a + type family. But here we want to. (This mattered in #25251.) + + Hence the Bool flag on LC_Promote, and its use in `tef_unifying` in + `defaultEquality`. + +(DE6) /Don't/ unify if the RHS has a free coercion hole in it. That means + that there is an as-yet-unsolved equality constraint (whose evidence + will fill that hole); unifying can lead to very confusing type errors. + e.g. [W] co1 :: IntRep ~ LiftedRep + [W] co2 {rewritten by co1} :: alpha ~ t2 |> (TYPE co1) + Unifying alpha := (t1 |> TYPE co1) is a Bad Idea. + + Note that we /do/ unify even if the constraint has a non-empty rewriter + set, which has prevented unification up to now; see + Note [Unify only if the rewriter set is empty] in GHC.Tc.Solver.Equality. + In obscure situations a constraint can end up in its own rewriter set, but + without a coercion hole being in the RHS. + + See #10009, and Note [Limited defaulting in the ambiguity check]. + + +Note [Must simplify after defaulting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We may have a deeply buried constraint + (t:*) ~ (a:Open) +which we couldn't solve because of the kind incompatibility, and 'a' is free. +Then when we default 'a' we can solve the constraint. And we want to do +that before starting in on type classes. We MUST do it before reporting +errors, because it isn't an error! #7967 was due to this. + +Note [Defaulting representational equalities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we end up with [W] alpha ~#R Int, with no other constraints on alpha. +Then it makes sense to simply unify alpha := Int -- the alternative is to +reject the program due to an ambiguous metavariable alpha, so it makes sense +to unify and accept instead. + +This is particularly convenient for users of `coerce`, as it lessens the +amount of type annotations required (see #21003). Consider for example: + + -- 'foldMap' defined using 'traverse' + foldMapUsingTraverse :: forall t m a. (Traversable t, Monoid m) => (a -> m) -> t a -> m + foldMapUsingTraverse = coerce $ traverse @t @(Const m) + + -- 'traverse_' defined using 'foldMap' + traverse_UsingFoldMap :: forall f t a. (Foldable t, Applicative f) => (a -> f ()) -> t a -> f () + traverse_UsingFoldMap = coerce $ foldMap @t @(Ap f ()) + +Typechecking these functions results in unsolved Wanted constraints of the form +[W] alpha[tau] ~R# some_ty; accepting such programs by unifying +alpha := some_ty avoids the need for users to specify tiresome additional +type annotations, such as: + + foldMapUsingTraverse = coerce $ traverse @t @(Const m) @a + traverse_UsingFoldMap = coerce $ foldMap @t @(Ap f ()) @a + +Consider also the following example: + + -- 'sequence_', but for two nested 'Foldable' structures + sequenceNested_ :: forall f1 f2. (Foldable f1, Foldable f2) => f1 (f2 (IO ())) -> IO () + sequenceNested_ = coerce $ sequence_ @( Compose f1 f2 ) + +Here, we end up with [W] mu[tau] beta[tau] ~#R IO (), and it similarly makes +sense to default mu := IO, beta := (). This avoids requiring the +user to provide additional type applications: + + sequenceNested_ = coerce $ sequence_ @( Compose f1 f2 ) @IO @() + +The plan for defaulting a representational equality, say [W] ty1 ~R# ty2, +is thus as follows: + + 1. attempt to unify ty1 ~# ty2 (at nominal role) + 2. a. if this succeeds without deferring any constraints, accept this solution + b. otherwise, keep the original constraint. + +(2b) ensures that we don't degrade all error messages by always turning unsolved +representational equalities into nominal ones; we only want to default a +representational equality when we can fully solve it. + +Note that this does not threaten principle types. Recall that the original worry +(as per Note [Do not unify representational equalities]) was that we might have + + [W] alpha ~R# Int + [W] alpha ~ Age + +in which case unifying alpha := Int would be wrong, as the correct solution is +alpha := Age. This worry doesn't concern us in top-level defaulting, because +defaulting takes place after generalisation; it is fully monomorphic. + +********************************************************************************* +* * +* Type-class defaulting +* * +********************************************************************************* + +Note [How type-class constraints are defaulted] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type-class defaulting deals with the situation where we have unsolved +constraints like (Num alpha), where `alpha` is a unification variable. We want +to pick a default for `alpha`, such as `alpha := Int` to resolve the ambiguity. + +The function 'tryTypeClassDefaulting' implements type-class defaulting. The +algorithm for defaulting depends on whether certain extensions are enabled, +such as -XOverloadedStrings or -XExtendedDefaultRules. To explain this, let us +define the following: + + Unary typeclass: + a typeclass with a single visible type argument. + + Examples: + + Num :: Type -> Constraint + Eq :: Type -> Constraint + Foldable :: (Type -> Type) -> Constraint + Typeable :: forall k. k -> Constraint -- NB: also has an /invisible/ argument + + Non-examples: + + Nullary :: Constraint + Binary :: Type -> Type -> Constraint + Binary2 :: forall k -> k -> Constraint -- Two visible arguments + + Defaultable class + a typeclass which has at least one in-scope default declaration + + This includes the two different categories of default declarations: + + - Haskell 98 default declarations such as 'default (Integer, Float)'. + + - `Num` is always defaultable; either the user says 'default( Integer, Float )' + or (absent such a declaration) the system fills in a fallback default declaration. + See Section 4.3.4 in https://www.haskell.org/onlinereport/haskell2010/haskellch4.html + + - With `OverloadedStrings`, the class `IsString` is defaultable + - With `ExtendedDefaultRules`, the classes `Show`, `Eq`, `Ord`, `Foldable` and `Traversable` + are defaultable + + - Named default declarations, which apply to the named class, e.g. + 'default Cls(X, Y)' applies precisely to 'Cls'. + Note that these may be locally defined, or they may be imported. + + Standard class: + a class defined in the Prelude or the standard library, as defined + by the Haskell 98 report (section 4.3.4) + + These are defined in GHC.Builtin.Names.standardClassKeys. + +The rules for defaulting a collection 'S' of unsolved constraints are as follows: + + 1. For each metavariable 'v' appearing in 'S', define + + U_v = { C v | C v ∈ U, C is a unary typeclass } + + We then process each 'U_v' in turn, in order to find a defaulting + assignment 'v := ty' that solves all of 'U_v'. + + 2. Unless -XExtendedDefaultRules is in effect, give up if 'v' appears: + + - in any constraint that isn't a unary class constraint + - in a class constraint which is non-standard and does not have + a default declaration in scope. + + 3. Compute candidate assignments: for each unary typeclass 'C' in 'U_v' which + has a default declaration in scope, find the first type 'ty' in the list + of in-scope default types for 'C' for which all of 'U_v' is soluble. + + 4. If there is precisely one type candidate type assignment 'ty' that allows + all of 'U_v' to be solved, we default 'v := ty'. Otherwise, do nothing + ('v' remains ambiguous). + +Note [Defaulting plugins] +~~~~~~~~~~~~~~~~~~~~~~~~~ +Defaulting plugins enable extending or overriding the defaulting +behaviour. In `applyDefaultingRules`, before the built-in defaulting +mechanism runs, the loaded defaulting plugins are passed the +`WantedConstraints` and get a chance to propose defaulting assignments +based on them. + +Proposals are represented as `[DefaultingProposal]` with each proposal +consisting of a type variable to fill-in, the list of defaulting types to +try in order, and a set of constraints to check at each try. This is +the same representation (albeit in a nicely packaged-up data type) as +the candidates generated by the built-in defaulting mechanism, so the +actual trying of proposals is done by the same `disambigGroup` function. + +Wrinkle (DP1): The role of `WantedConstraints` + + Plugins are passed `WantedConstraints` that can perhaps be + progressed on by defaulting. But a defaulting plugin is not a solver + plugin, its job is to provide defaulting proposals, i.e. mappings of + type variable to types. How do plugins know which type variables + they are supposed to default? + + The `WantedConstraints` passed to the defaulting plugin are zonked + beforehand to ensure all remaining metavariables are unfilled. Thus, + the `WantedConstraints` serve a dual purpose: they are both the + constraints of the given context that can act as hints to the + defaulting, as well as the containers of the type variables under + consideration for defaulting. + +Wrinkle (DP2): Interactions between defaulting mechanisms + + In the general case, we have multiple defaulting plugins loaded and + there is also the built-in defaulting mechanism. In this case, we + have to be careful to keep the `WantedConstraints` passed to the + plugins up-to-date by zonking between successful defaulting + rounds. Otherwise, two plugins might come up with a defaulting + proposal for the same metavariable; if the first one is accepted by + `disambigGroup` (thus the meta gets filled), the second proposal + becomes invalid (see #23821 for an example). + +Note [Defaulting insolubles] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If a set of wanteds is insoluble, we have no hope of accepting the +program. Yet we do not stop constraint solving, etc., because we may +simplify the wanteds to produce better error messages. So, once +we have an insoluble constraint, everything we do is just about producing +helpful error messages. + +Should we default in this case or not? Let's look at an example (tcfail004): + + (f,g) = (1,2,3) + +With defaulting, we get a conflict between (a0,b0) and (Integer,Integer,Integer). +Without defaulting, we get a conflict between (a0,b0) and (a1,b1,c1). I (Richard) +find the latter more helpful. Several other test cases (e.g. tcfail005) suggest +similarly. So: we should not do class defaulting with insolubles. + +On the other hand, RuntimeRep-defaulting is different. Witness tcfail078: + + f :: Integer i => i + f = 0 + +Without RuntimeRep-defaulting, we GHC suggests that Integer should have kind +TYPE r0 -> Constraint and then complains that r0 is actually untouchable +(presumably, because it can't be sure if `Integer i` entails an equality). +If we default, we are told of a clash between (* -> Constraint) and Constraint. +The latter seems far better, suggesting we *should* do RuntimeRep-defaulting +even on insolubles. + +But, evidently, not always. Witness UnliftedNewtypesInfinite: + + newtype Foo = FooC (# Int#, Foo #) + +This should fail with an occurs-check error on the kind of Foo (with -XUnliftedNewtypes). +If we default RuntimeRep-vars, we get + + Expecting a lifted type, but ‘(# Int#, Foo #)’ is unlifted + +which is just plain wrong. + +Another situation in which we don't want to default involves concrete metavariables. + +In equalities such as alpha[conc] ~# rr[sk] , alpha[conc] ~# RR beta[tau] +for a type family RR (all at kind RuntimeRep), we would prefer to report a +representation-polymorphism error rather than default alpha and get error: + + Could not unify `rr` with `Lifted` / Could not unify `RR b0` with `Lifted` + +which is very confusing. For this reason, we weed out the concrete +metavariables participating in such equalities in nonDefaultableTyVarsOfWC. +Just looking at insolublity is not enough, as `alpha[conc] ~# RR beta[tau]` could +become soluble after defaulting beta (see also #21430). + +Conclusion: we should do RuntimeRep-defaulting on insolubles only when the +user does not want to hear about RuntimeRep stuff -- that is, when +-fprint-explicit-runtime-reps is not set. +However, we must still take care not to default concrete type variables +participating in an equality with a non-concrete type, as seen in the +last example above. + +-} + +tryTypeClassDefaulting :: WantedConstraints -> TcS WantedConstraints +tryTypeClassDefaulting wc + | isEmptyWC wc || insolubleWC wc -- See Note [Defaulting insolubles] + = return wc + | otherwise -- See Note [When to do type-class defaulting] + = do { something_happened <- applyDefaultingRules wc + -- See Note [Top-level Defaulting Plan] + ; solveAgainIf something_happened wc } + +applyDefaultingRules :: WantedConstraints -> TcS Bool +-- True <=> I did some defaulting, by unifying a meta-tyvar +-- Input WantedConstraints are not necessarily zonked +-- See Note [How type-class constraints are defaulted] + +applyDefaultingRules wanteds + | isEmptyWC wanteds + = return False + | otherwise + = do { (default_env, extended_rules) <- getDefaultInfo + ; wanteds <- TcS.zonkWC wanteds + + ; tcg_env <- TcS.getGblEnv + ; let plugins = tcg_defaulting_plugins tcg_env + default_tys = defaultList default_env + -- see Note [Named default declarations] in GHC.Tc.Gen.Default + + -- Run any defaulting plugins + -- See Note [Defaulting plugins] for an overview + ; (wanteds, plugin_defaulted) <- if null plugins then return (wanteds, []) else + do { + ; traceTcS "defaultingPlugins {" (ppr wanteds) + ; (wanteds, defaultedGroups) <- mapAccumLM run_defaulting_plugin wanteds plugins + ; traceTcS "defaultingPlugins }" (ppr defaultedGroups) + ; return (wanteds, defaultedGroups) + } + + ; let groups = findDefaultableGroups (default_tys, extended_rules) wanteds + + ; traceTcS "applyDefaultingRules {" $ + vcat [ text "wanteds =" <+> ppr wanteds + , text "groups =" <+> ppr groups + , text "info =" <+> ppr (default_tys, extended_rules) ] + + ; something_happeneds <- mapM (disambigGroup wanteds default_tys) groups + + ; traceTcS "applyDefaultingRules }" (ppr something_happeneds) + + ; return $ or something_happeneds || or plugin_defaulted } + + where + run_defaulting_plugin wanteds p + = do { groups <- runTcPluginTcS (p wanteds) + ; defaultedGroups <- + filterM (\g -> disambigMultiGroup + wanteds + (deProposalCts g) + (ProposalSequence (Proposal <$> deProposals g))) + groups + ; traceTcS "defaultingPlugin " $ ppr defaultedGroups + ; case defaultedGroups of + [] -> return (wanteds, False) + _ -> do + -- If a defaulting plugin solves any tyvars, some of the wanteds + -- will have filled-in metavars by now (see wrinkle DP2 of + -- Note [Defaulting plugins]). So we re-zonk to make sure later + -- defaulting doesn't try to solve the same metavars. + wanteds' <- TcS.zonkWC wanteds + return (wanteds', True) } + +findDefaultableGroups + :: ( [ClassDefaults] + , Bool ) -- extended default rules + -> WantedConstraints -- Unsolved + -> [(TyVar, [Ct])] +findDefaultableGroups (default_tys, extended_defaults) wanteds + | null default_tys + = [] + | otherwise + = [ (tv, map fstOf3 group) + | group'@((_,_,tv) :| _) <- unary_groups + , let group = toList group' + , defaultable_tyvar tv + , defaultable_classes (map sndOf3 group) ] + where + simples = approximateWC True wanteds + -- True: for the purpose of defaulting we don't care + -- about shape or enclosing equalities + -- See (W3) in Note [ApproximateWC] in GHC.Tc.Types.Constraint + + (unaries, non_unaries) = partitionWith find_unary (bagToList simples) + unary_groups = equivClasses cmp_tv unaries + + unary_groups :: [NonEmpty (Ct, Class, TcTyVar)] -- (C tv) constraints + unaries :: [(Ct, Class, TcTyVar)] -- (C tv) constraints + non_unaries :: [Ct] -- and *other* constraints + + -- Finds unary type-class constraints + -- But take account of polykinded classes like Typeable, + -- which may look like (Typeable Type (a:Type)) (#8931) + -- See step (1) in Note [How type-class constraints are defaulted] + find_unary :: Ct -> Either (Ct, Class, TyVar) Ct + find_unary cc + | Just (cls,tys) <- getClassPredTys_maybe (ctPred cc) + , [ty] <- filterOutInvisibleTypes (classTyCon cls) tys + -- Ignore invisible arguments for this purpose + , Just tv <- getTyVar_maybe ty + , isMetaTyVar tv -- We might have runtime-skolems in GHCi, and + -- we definitely don't want to try to assign to those! + = Left (cc, cls, tv) + find_unary cc = Right cc -- Non unary or non dictionary + + nonunary_tvs :: TcTyCoVarSet -- TyVars mentioned by non-unaries + nonunary_tvs = mapUnionVarSet tyCoVarsOfCt non_unaries + + cmp_tv (_,_,tv1) (_,_,tv2) = tv1 `compare` tv2 + + defaultable_tyvar :: TcTyVar -> Bool + defaultable_tyvar tv + = let b1 = isTyConableTyVar tv -- Note [Avoiding spurious errors] + b2 = not (tv `elemVarSet` nonunary_tvs) + in b1 && (b2 || extended_defaults) -- Note [Multi-parameter defaults] + + -- Determines whether the collection of class constraints permits defaulting. + -- See step (2) in Note [How type-class constraints are defaulted] + defaultable_classes :: [Class] -> Bool + defaultable_classes clss = + -- One of the classes has a default declaration in scope + -- (this includes 'Num', and e.g. 'IsString' with -XOverloadedStrings) + any (`elementOfUniqSet` classes_with_defaults) clss + && + -- AND, either: + -- - ExtendedDefaultRules is in effect, or + -- - all the classes are standard or have a default declaration in scope + (extended_defaults || all is_std_or_has_default clss) + is_std_or_has_default :: Class -> Bool + is_std_or_has_default cls = + (getUnique cls `elem` standardClassKeys) + || + (cls `elementOfUniqSet` classes_with_defaults) + + -- All classes with a default declaration in scope; either: + -- + -- - a named default declaration such as 'default C(Double, Bool)', or + -- - a Haskell 98 default declaration such as 'default(Int, Float)', + -- which adds defaults for Num, for IsString with OverloadedStrings, + -- and for Foldable/Traversable/... with ExtendedDefaultRules + classes_with_defaults = mkUniqSet $ map cd_class default_tys + +------------------------------ + +-- | 'Proposal's to be tried in sequence until the first one that succeeds +newtype ProposalSequence = ProposalSequence{getProposalSequence :: [Proposal]} + +-- | An atomic set of proposed type assignments to try applying all at once +newtype Proposal = Proposal [(TcTyVar, Type)] + +instance Outputable ProposalSequence where + ppr (ProposalSequence proposals) = ppr proposals +instance Outputable Proposal where + ppr (Proposal assignments) = ppr assignments + +disambigGroup :: WantedConstraints -- ^ Original constraints, for diagnostic purposes + -> [ClassDefaults] -- ^ The default classes and types + -> (TcTyVar, [Ct]) -- ^ All constraints sharing same type variable + -> TcS Bool -- True <=> something happened, reflected in ty_binds +disambigGroup orig_wanteds default_ctys (tv, wanteds) + = disambigProposalSequences orig_wanteds wanteds proposalSequences allConsistent + where + proposalSequences = [ ProposalSequence [Proposal [(tv, ty)] | ty <- tys] + | ClassDefaults{cd_types = tys} <- defaultses ] + allConsistent ((_, sub) :| subs) = all (eqSubAt tv sub . snd) subs + defaultses = + [ defaults | defaults@ClassDefaults{cd_class = cls} <- default_ctys + , any (isDictForClass (className cls)) wanteds ] + isDictForClass clcon ct = any ((clcon ==) . className . fst) (getClassPredTys_maybe $ ctPred ct) + eqSubAt :: TcTyVar -> Subst -> Subst -> Bool + eqSubAt tvar s1 s2 = or $ liftA2 tcEqType (lookupTyVar s1 tvar) (lookupTyVar s2 tvar) + +-- See Note [How type-class constraints are defaulted] +disambigMultiGroup :: WantedConstraints -- ^ Original constraints, for diagnostic purposes + -> [Ct] -- ^ check these are solved by defaulting + -> ProposalSequence -- ^ defaulting type assignments to try + -> TcS Bool -- True <=> something happened, reflected in ty_binds +disambigMultiGroup orig_wanteds wanteds proposalSequence + = disambigProposalSequences orig_wanteds wanteds [proposalSequence] (const True) + +disambigProposalSequences :: WantedConstraints -- ^ Original constraints, for diagnostic purposes + -> [Ct] -- ^ Check these are solved by defaulting + -> [ProposalSequence] -- ^ The sequences of assignment proposals + -> (NonEmpty ([TcTyVar], Subst) -> Bool) + -- ^ Predicate for successful assignments + -> TcS Bool -- True <=> something happened, reflected in ty_binds +disambigProposalSequences orig_wanteds wanteds proposalSequences allConsistent + = do { traverse_ (traverse_ reportInvalidDefaultedTyVars . getProposalSequence) proposalSequences + ; fake_ev_binds_var <- TcS.newTcEvBinds + ; tclvl <- TcS.getTcLevel + -- Step (3) in Note [How type-class constraints are defaulted] + ; successes <- fmap catMaybes $ + nestImplicTcS fake_ev_binds_var (pushTcLevel tclvl) $ + mapM firstSuccess proposalSequences + ; traceTcS "disambigProposalSequences {" (vcat [ ppr wanteds + , ppr proposalSequences + , ppr successes ]) + -- Step (4) in Note [How type-class constraints are defaulted] + ; case successes of + success@(tvs, subst) : rest + | allConsistent (success :| rest) + -> do { applyDefaultSubst tvs subst + ; let warn tv = mapM_ (warnDefaulting wanteds tv) (lookupTyVar subst tv) + ; wrapWarnTcS $ mapM_ warn tvs + ; traceTcS "disambigProposalSequences succeeded }" (ppr proposalSequences) + ; return True } + _ -> + do { traceTcS "disambigProposalSequences failed }" (ppr proposalSequences) + ; return False } } + where + reportInvalidDefaultedTyVars :: Proposal -> TcS () + firstSuccess :: ProposalSequence -> TcS (Maybe ([TcTyVar], Subst)) + firstSuccess (ProposalSequence proposals) + = getFirst <$> foldMapM (fmap First . tryDefaultGroup wanteds) proposals + reportInvalidDefaultedTyVars proposal@(Proposal assignments) + = do { let tvs = fst <$> assignments + ; invalid_tvs <- filterOutM TcS.isUnfilledMetaTyVar tvs + ; traverse_ (errInvalidDefaultedTyVar orig_wanteds proposal) (nonEmpty invalid_tvs) } + +applyDefaultSubst :: [TcTyVar] -> Subst -> TcS () +applyDefaultSubst tvs subst = + do { deep_tvs <- filterM TcS.isUnfilledMetaTyVar $ nonDetEltsUniqSet $ closeOverKinds (mkVarSet tvs) + ; forM_ deep_tvs $ \ tv -> mapM_ (unifyTyVar tv) (lookupVarEnv (getTvSubstEnv subst) tv) + } + +tryDefaultGroup :: [Ct] -- ^ check these are solved by defaulting + -> Proposal -- ^ defaulting type assignments to try + -> TcS (Maybe ([TcTyVar], Subst)) -- ^ successful substitutions, *not* reflected in ty_binds +tryDefaultGroup wanteds (Proposal assignments) + | let (tvs, default_tys) = unzip assignments + , Just subst <- tcMatchTyKis (mkTyVarTys tvs) default_tys + -- Make sure the kinds match too; hence this call to tcMatchTyKi + -- E.g. suppose the only constraint was (Typeable k (a::k)) + -- With the addition of polykinded defaulting we also want to reject + -- ill-kinded defaulting attempts like (Eq []) or (Foldable Int) here. + = do { lcl_env <- TcS.getLclEnv + ; tc_lvl <- TcS.getTcLevel + ; let loc = mkGivenLoc tc_lvl (getSkolemInfo unkSkol) (mkCtLocEnv lcl_env) + new_wtd_ct :: WantedCtEvidence -> TcS Ct + new_wtd_ct (WantedCt { ctev_pred = wtd_pred, ctev_rewriters = rws }) = + mkNonCanonical . CtWanted <$> + -- NB: equality constraints are possible, + -- due to type defaulting plugins + newWantedNC loc rws (substTy subst wtd_pred) + ; new_wanteds <- sequence [ new_wtd_ct wtd + | CtWanted wtd <- map ctEvidence wanteds + ] + ; residual <- solveSimpleWanteds (listToBag new_wanteds) + ; return $ if isEmptyWC residual then Just (tvs, subst) else Nothing } + + | otherwise + = return Nothing + +errInvalidDefaultedTyVar :: WantedConstraints -> Proposal -> NonEmpty TcTyVar -> TcS () +errInvalidDefaultedTyVar wanteds (Proposal assignments) problematic_tvs + = failTcS $ TcRnInvalidDefaultedTyVar tidy_wanteds tidy_assignments tidy_problems + where + proposal_tvs = concatMap (\(tv, ty) -> tv : tyCoVarsOfTypeList ty) assignments + tidy_env = tidyFreeTyCoVars emptyTidyEnv $ proposal_tvs ++ NE.toList problematic_tvs + tidy_wanteds = map (tidyCt tidy_env) $ flattenWC wanteds + tidy_assignments = [(tidyTyCoVarOcc tidy_env tv, tidyType tidy_env ty) | (tv, ty) <- assignments] + tidy_problems = fmap (tidyTyCoVarOcc tidy_env) problematic_tvs + + flattenWC :: WantedConstraints -> [Ct] + flattenWC (WC { wc_simple = cts, wc_impl = impls }) + = ctsElts cts ++ concatMap (flattenWC . ic_wanted) impls + +-- In interactive mode, or with -XExtendedDefaultRules, +-- we default Show a to Show () to avoid gratuitous errors on "show []" +isInteractiveClass :: Bool -- -XOverloadedStrings? + -> Class -> Bool +isInteractiveClass ovl_strings cls + = isNumClass ovl_strings cls || (classKey cls `elem` interactiveClassKeys) + + -- isNumClass adds IsString to the standard numeric classes, + -- when -XOverloadedStrings is enabled +isNumClass :: Bool -- -XOverloadedStrings? + -> Class -> Bool +isNumClass ovl_strings cls + = isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey)) + + +{- +Note [Avoiding spurious errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When doing the unification for defaulting, we check for skolem +type variables, and simply don't default them. For example: + f = (*) -- Monomorphic + g :: Num a => a -> a + g x = f x x +Here, we get a complaint when checking the type signature for g, +that g isn't polymorphic enough; but then we get another one when +dealing with the (Num a) context arising from f's definition; +we try to unify a with Int (to default it), but find that it's +already been unified with the rigid variable from g's type sig. + +Note [Multi-parameter defaults] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With -XExtendedDefaultRules, we default only based on single-variable +constraints, but do not exclude from defaulting any type variables which also +appear in multi-variable constraints. This means that the following will +default properly: + + default (Integer, Double) + + class A b (c :: Symbol) where + a :: b -> Proxy c + + instance A Integer c where a _ = Proxy + + main = print (a 5 :: Proxy "5") + +Note that if we change the above instance ("instance A Integer") to +"instance A Double", we get an error: + + No instance for (A Integer "5") + +This is because the first defaulted type (Integer) has successfully satisfied +its single-parameter constraints (in this case Num). +-} diff --git a/GHC/Tc/Solver/Dict.hs b/GHC/Tc/Solver/Dict.hs --- a/GHC/Tc/Solver/Dict.hs +++ b/GHC/Tc/Solver/Dict.hs @@ -1,47 +1,53 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE MultiWayIf #-} -- | Solving Class constraints CDictCan module GHC.Tc.Solver.Dict ( - solveDict, solveDictNC, + solveDict, solveDictNC, solveCallStack, checkInstanceOK, matchLocalInst, chooseInstance, makeSuperClasses, mkStrictSuperClasses, - solveCallStack -- For GHC.Tc.Solver ) where import GHC.Prelude +import {-# SOURCE #-} GHC.Tc.Solver.Solve( solveSimpleWanteds ) + import GHC.Tc.Errors.Types import GHC.Tc.Instance.FunDeps -import GHC.Tc.Instance.Class( safeOverlap, matchEqualityInst ) +import GHC.Tc.Instance.Class( matchEqualityInst ) import GHC.Tc.Types.Evidence import GHC.Tc.Types.Constraint import GHC.Tc.Types.CtLoc import GHC.Tc.Types.Origin -import GHC.Tc.Types.EvTerm( evCallStack ) import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad import GHC.Tc.Solver.Types import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Unify( uType ) +import GHC.Tc.Utils.Unify( uType, mightEqualLater ) import GHC.Hs.Type( HsIPName(..) ) import GHC.Core +import GHC.Core.Make import GHC.Core.Type import GHC.Core.InstEnv ( DFunInstType, ClsInst(..) ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Core.Unify ( ruleMatchTyKiX , typesAreApart ) +import GHC.Core.Unify ( ruleMatchTyKiX ) +import GHC.Types.TyThing( lookupDataCon, lookupId ) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Var import GHC.Types.Id( mkTemplateLocals ) import GHC.Types.Var.Set import GHC.Types.Var.Env +import GHC.Types.SrcLoc +import GHC.Builtin.Names( srcLocDataConName, pushCallStackName, emptyCallStackName ) + import GHC.Utils.Monad ( concatMapM, foldlM ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -58,11 +64,8 @@ import Data.Maybe ( listToMaybe, mapMaybe, isJust ) import Data.Void( Void ) -import Control.Monad.Trans.Maybe( MaybeT, runMaybeT ) -import Control.Monad.Trans.Class( lift ) import Control.Monad - {- ********************************************************************* * * * Class Canonicalization @@ -101,55 +104,6 @@ ; simpleStage (updInertDicts dict_ct) ; stopWithStage (dictCtEvidence dict_ct) "Kept inert DictCt" } -updInertDicts :: DictCt -> TcS () -updInertDicts dict_ct - = do { traceTcS "Adding inert dict" (ppr dict_ct) - - -- For Given implicit parameters (only), delete any existing - -- Givens for the same implicit parameter. - -- See Note [Shadowing of implicit parameters] - ; deleteGivenIPs dict_ct - - -- Add the new constraint to the inert set - ; updInertCans (updDicts (addDict dict_ct)) } - -deleteGivenIPs :: DictCt -> TcS () --- Special magic when adding a Given implicit parameter to the inert set --- For [G] ?x::ty, remove any existing /Givens/ mentioning ?x, --- from /both/ inert_cans /and/ inert_solved_dicts (#23761) --- See Note [Shadowing of implicit parameters] -deleteGivenIPs (DictCt { di_cls = cls, di_ev = ev, di_tys = tys }) - | isGiven ev - , Just (str_ty, _) <- isIPPred_maybe cls tys - = updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) -> - inerts { inert_cans = updDicts (filterDicts (keep_can str_ty)) ics - , inert_solved_dicts = filterDicts (keep_solved str_ty) solved } - | otherwise - = return () - where - keep_can, keep_solved :: Type -> DictCt -> Bool - -- keep_can: we keep an inert dictionary UNLESS - -- (1) it is a Given - -- (2) it binds an implicit parameter (?str :: ty) for the given 'str' - -- regardless of 'ty', possibly via its superclasses - -- The test is a bit conservative, hence `mentionsIP` and `typesAreApart` - -- See Note [Using typesAreApart when calling mentionsIP] - -- in GHC.Core.Predicate - -- - -- keep_solved: same as keep_can, but for /all/ constraints not just Givens - -- - -- Why two functions? See (SIP3) in Note [Shadowing of implicit parameters] - keep_can str (DictCt { di_ev = ev, di_cls = cls, di_tys = tys }) - = not (isGiven ev -- (1) - && mentions_ip str cls tys) -- (2) - keep_solved str (DictCt { di_cls = cls, di_tys = tys }) - = not (mentions_ip str cls tys) - - -- mentions_ip: the inert constraint might provide evidence - -- for an implicit parameter (?str :: ty) for the given 'str' - mentions_ip str cls tys - = mentionsIP (not . typesAreApart str) (const True) cls tys - canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt -- Once-only processing of Dict constraints: -- * expand superclasses @@ -167,29 +121,29 @@ -- doNotExpand: We have already expanded superclasses for /this/ dict -- so set the fuel to doNotExpand to avoid repeating expansion - | CtWanted { ctev_rewriters = rewriters } <- ev + | CtWanted (WantedCt { ctev_rewriters = rws }) <- ev , Just ip_name <- isCallStackPred cls tys - , isPushCallStackOrigin orig + , Just fun_fs <- isPushCallStackOrigin_maybe orig -- If we're given a CallStack constraint that arose from a function -- call, we need to push the current call-site onto the stack instead -- of solving it directly from a given. -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence - -- and Note [Solving CallStack constraints] in GHC.Tc.Solver.Types + -- and Note [Solving CallStack constraints] = Stage $ do { -- First we emit a new constraint that will capture the -- given CallStack. + let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name)) -- We change the origin to IPOccOrigin so -- this rule does not fire again. -- See Note [Overview of implicit CallStacks] -- in GHC.Tc.Types.Evidence - ; new_ev <- newWantedEvVarNC new_loc rewriters pred + ; new_ev <- CtWanted <$> newWantedEvVarNC new_loc rws pred -- Then we solve the wanted by pushing the call-site -- onto the newly emitted CallStack - ; let ev_cs = EvCsPushCall (callStackOriginFS orig) - (ctLocSpan loc) (ctEvExpr new_ev) + ; let ev_cs = EvCsPushCall fun_fs (ctLocSpan loc) (ctEvExpr new_ev) ; solveCallStack ev ev_cs ; continueWith (DictCt { di_ev = new_ev, di_cls = cls @@ -205,31 +159,96 @@ -- See Invariants in `CCDictCan.cc_pend_sc` ; continueWith (DictCt { di_ev = ev, di_cls = cls , di_tys = tys, di_pend_sc = fuel }) } + where loc = ctEvLoc ev orig = ctLocOrigin loc pred = ctEvPred ev +{- ********************************************************************* +* * +* Implicit parameters and call stacks +* * +********************************************************************* -} + solveCallStack :: CtEvidence -> EvCallStack -> TcS () -- Also called from GHC.Tc.Solver when defaulting call stacks solveCallStack ev ev_cs -- We're given ev_cs :: CallStack, but the evidence term should be a -- dictionary, so we have to coerce ev_cs to a dictionary for -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] - = do { cs_tm <- evCallStack ev_cs - ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) + = do { inner_stk <- evCallStack pred ev_cs + ; let ev_tm = EvExpr (evWrapIPE pred inner_stk) ; setEvBindIfWanted ev EvCanonical ev_tm } - -- EvCanonical: see Note [CallStack and ExecptionContext hack] + -- EvCanonical: see Note [CallStack and ExceptionContext hack] + where + pred = ctEvPred ev -{- Note [CallStack and ExecptionContext hack] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Dictionary for CallStack implicit parameters +evCallStack :: TcPredType -> EvCallStack -> TcS EvExpr +-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence +evCallStack _ EvCsEmpty + = Var <$> lookupId emptyCallStackName +evCallStack pred (EvCsPushCall fs loc tm) + = do { df <- getDynFlags + ; m <- getModule + ; srcLocDataCon <- lookupDataCon srcLocDataConName + ; let platform = targetPlatform df + mkSrcLoc l = mkCoreConWrapApps srcLocDataCon <$> + sequence [ mkStringExprFS (unitFS $ moduleUnit m) + , mkStringExprFS (moduleNameFS $ moduleName m) + , mkStringExprFS (srcSpanFile l) + , return $ mkIntExprInt platform (srcSpanStartLine l) + , return $ mkIntExprInt platform (srcSpanStartCol l) + , return $ mkIntExprInt platform (srcSpanEndLine l) + , return $ mkIntExprInt platform (srcSpanEndCol l) + ] + + ; push_cs_id <- lookupId pushCallStackName + ; name_expr <- mkStringExprFS fs + ; loc_expr <- mkSrcLoc loc + -- At this point tm :: IP sym CallStack + -- but we need the actual CallStack to pass to pushCS, + -- so we use evUwrapIP to strip the dictionary wrapper + -- See Note [Overview of implicit CallStacks] + ; let outer_stk = evUnwrapIPE pred tm + ; return (mkCoreApps (Var push_cs_id) + [mkCoreTup [name_expr, loc_expr], outer_stk]) } + +{- Note [Solving CallStack constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence. + +Suppose f :: HasCallStack => blah. Then + +* Each call to 'f' gives rise to + [W] s1 :: IP "callStack" CallStack -- CtOrigin = OccurrenceOf f + with a CtOrigin that says "OccurrenceOf f". + Remember that HasCallStack is just shorthand for + IP "callStack" CallStack + See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence + +* We canonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by + pushing the call-site info on the stack, and changing the CtOrigin + to record that has been done. + Bind: s1 = pushCallStack s2 + [W] s2 :: IP "callStack" CallStack -- CtOrigin = IPOccOrigin + +* Then, and only then, we can solve the constraint from an enclosing + Given. + +So we must be careful /not/ to solve 's1' from the Givens. We guarantee +this by canonicalising before looking up in the inert set. + +Note [CallStack and ExceptionContext hack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It isn't really right that we treat CallStack and ExceptionContext dictionaries as canonical, in the sense of Note [Coherence and specialisation: overview]. They definitely are not! But if we use EvNonCanonical here we get lots of nospec (error @Int) dict string -(since `error` takes a HasCallStack dict), and that isn't bottomng (at least not +(since `error` takes a HasCallStack dict), and that isn't bottoming (at least not without extra work) So, hackily, we just say that HasCallStack and ExceptionContext are canonical, even though they aren't really. @@ -245,9 +264,7 @@ * In `updInertDicts`, in this module, when adding [G] (?x :: ty), remove any existing [G] (?x :: ty'), regardless of ty'. -There are wrinkles: - -* Wrinkle (SIP1): we must be careful of superclasses (#14218). Consider +* Wrinkle (SIP1): we must be careful of superclasses. Consider f,g :: (?x::Int, C a) => a -> a f v = let ?x = 4 in g v @@ -255,31 +272,24 @@ We must /not/ solve this from the Given (?x::Int, C a), because of the intervening binding for (?x::Int). #14218. - We deal with this by arranging that when we add [G] (?x::ty) we /delete/ + We deal with this by arranging that when we add [G] (?x::ty) we delete * from the inert_cans, and * from the inert_solved_dicts any existing [G] (?x::ty) /and/ any [G] D tys, where (D tys) has a superclass with (?x::ty). See Note [Local implicit parameters] in GHC.Core.Predicate. - An very important special case is constraint tuples like [G] (% ?x::ty, Eq a %). - - But it could also happen for `class xx => D xx where ...` and the constraint - D (?x :: int); again see Note [Local implicit parameters]. This corner - (constraint-kinded variables instantiated with implicit parameter constraints) - is not well explored. + An important special case is constraint tuples like [G] (% ?x::ty, Eq a %). + But it could happen for `class xx => D xx where ...` and the constraint D + (?x :: int). This corner (constraint-kinded variables instantiated with + implicit parameter constraints) is not well explored. - You might worry about whether deleting an /entire/ constraint just because - a distant superclass has an implicit parameter might make another Wanted for - that constraint un-solvable. Indeed so. But for constraint tuples it doesn't - matter -- their entire payload is their superclasses. And the other case is - the ill-explored corner above. + Example in #14218, and #23761 The code that accounts for (SIP1) is in updInertDicts; in particular the call to GHC.Core.Predicate.mentionsIP. * Wrinkle (SIP2): we must apply this update semantics for `inert_solved_dicts` - as well as `inert_cans` (#23761). - + as well as `inert_cans`. You might think that wouldn't be necessary, because an element of `inert_solved_dicts` is never an implicit parameter (see Note [Solved dictionaries] in GHC.Tc.Solver.InertSet). @@ -292,19 +302,6 @@ Now (C (?x::Int)) has a superclass (?x::Int). This may look exotic, but it happens particularly for constraint tuples, like `(% ?x::Int, Eq a %)`. -* Wrinkle (SIP3) - - Note that for the inert dictionaries, `inert_cans`, we must /only/ delete - existing /Givens/! Deleting an existing Wanted led to #26451; we just never - solved it! - - - In contrast, the solved dictionaries, `inert_solved_dicts`, are really like - Givens; they may be "inherited" from outer scopes, so we must delete any - solved dictionaries for this implicit parameter for /both/ Givens /and/ - Wanteds. - - Otherwise the new Given doesn't properly shadow those inherited solved - dictionaries. Test T23761 showed this up. - Example 1: Suppose we have (typecheck/should_compile/ImplicitParamFDs) @@ -415,6 +412,11 @@ pattern matching. Its compile-time allocation decreased by 40% when I added the "replace" rather than "add" semantics.) + We achieve this by + (a) not expanding superclasses for equality classes at all; + see the `isEqualityClass` test in `mk_strict_superclasses` + (b) special logic to solve (t1 ~ t2) in `solveEqualityDict`. + (EQC2) Faced with [W] t1 ~ t2, it's always OK to reduce it to [W] t1 ~# t2, without worrying about Note [Instance and Given overlap]. Why? Because if we had [G] s1 ~ s2, then we'd get the superclass [G] s1 ~# s2, and @@ -464,27 +466,29 @@ -} solveEqualityDict :: CtEvidence -> Class -> [Type] -> SolverStage Void +-- See Note [Solving equality classes] -- Precondition: (isEqualityClass cls) True, so cls is (~), (~~), or Coercible solveEqualityDict ev cls tys - | CtWanted { ctev_dest = dest } <- ev + | CtWanted (WantedCt { ctev_dest = dest }) <- ev = Stage $ - do { let (data_con, role, t1, t2) = matchEqualityInst cls tys + do { let (role, t1, t2) = matchEqualityInst cls tys -- Unify t1~t2, putting anything that can't be solved -- immediately into the work list ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co ; setWantedEvTerm dest EvCanonical $ - evDataConApp data_con tys [Coercion co] + evDictApp cls tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } - | CtGiven { ctev_evar = ev_id, ctev_loc = loc } <- ev + | CtGiven (GivenCt { ctev_evar = ev_id }) <- ev , [sel_id] <- classSCSelIds cls -- Equality classes have just one superclass = Stage $ - do { let sc_pred = classMethodInstTy sel_id tys + do { let loc = ctEvLoc ev + sc_pred = classMethodInstTy sel_id tys ev_expr = EvExpr $ Var sel_id `mkTyApps` tys `App` evId ev_id ; given_ev <- newGivenEvVar loc (sc_pred, ev_expr) - ; startAgainWith (mkNonCanonical given_ev) } + ; startAgainWith (mkNonCanonical $ CtGiven given_ev) } | otherwise = pprPanic "solveEqualityDict" (ppr cls) @@ -527,30 +531,24 @@ case x of { GHC.Types.I# x1 -> GHC.Types.I# (GHC.Prim.+# x1 1#) } ** NB: It is important to emphasize that all this is purely an optimization: -** exactly the same programs should typecheck with or without this -** procedure. - -Solving fully -~~~~~~~~~~~~~ -There is a reason why the solver does not simply try to solve such -constraints with top-level instances. If the solver finds a relevant -instance declaration in scope, that instance may require a context -that can't be solved for. A good example of this is: - - f :: Ord [a] => ... - f x = ..Need Eq [a]... +** exactly the same programs should typecheck with or without this procedure. -If we have instance `Eq a => Eq [a]` in scope and we tried to use it, we would -be left with the obligation to solve the constraint Eq a, which we cannot. So we -must be conservative in our attempt to use an instance declaration to solve the -[W] constraint we're interested in. +Consider + f :: Ord [a] => ... + f x = ..Need Eq [a]... +We could use the Eq [a] superclass of the Ord [a], or we could use the top-level +instance `Eq a => Eq [a]`. But if we did the latter we'd be stuck with an +insoluble constraint (Eq a). -Our rule is that we try to solve all of the instance's subgoals -recursively all at once. Precisely: We only attempt to solve -constraints of the form `C1, ... Cm => C t1 ... t n`, where all the Ci -are themselves class constraints of the form `C1', ... Cm' => C' t1' -... tn'` and we only succeed if the entire tree of constraints is -solvable from instances. +----------------------------------- +So the ShortCutSolving plan is this: + If we could solve a constraint from a local Given, + try first to /completely/ solve the constraint + using only top-level instances, + /without/ using any local Givens. + - If that succeeds, use it + - If not, use the local Given +----------------------------------- An example that succeeds: @@ -576,7 +574,8 @@ f :: C [a] b => b -> Bool f x = m x == [] -Which, because solving `Eq [a]` demands `Eq a` which we cannot solve, produces: +Which, because solving `Eq [a]` demands `Eq a` which we cannot solve. so short-cut +solving fails and we use the superclass of C: f :: forall a b. C [a] b => b -> Bool f = \ (@ a) (@ b) ($dC :: C [a] b) (eta :: b) -> @@ -586,24 +585,57 @@ (m @ [a] @ b $dC eta) (GHC.Types.[] @ a) -Note [Shortcut solving: type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have (#13943) - class Take (n :: Nat) where ... - instance {-# OVERLAPPING #-} Take 0 where .. - instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where .. +The moving parts are relatively simple: -And we have [W] Take 3. That only matches one instance so we get -[W] Take (3-1). Really we should now rewrite to reduce the (3-1) to 2, and -so on -- but that is reproducing yet more of the solver. Sigh. For now, -we just give up (remember all this is just an optimisation). +* To attempt to solve the constraint completely, we just recursively + call the constraint solver. See the use of `tryShortCutTcS` in + `tcShortCutSolver`. -But we must not just naively try to lookup (Take (3-1)) in the -InstEnv, or it'll (wrongly) appear not to match (Take 0) and get a -unique match on the (Take n) instance. That leads immediately to an -infinite loop. Hence the check that 'preds' have no type families -(isTyFamFree). +* When this attempted recursive solving, in `tryShortCutTcS`, we + - start with an empty inert set: no Givens and no Wanteds + - set a special mode `TcSShortCut`, which signals that we are trying to solve + using only top-level instances. +* When in TcSShortCut mode, since there are no Givens we can short-circuit; + these are all just optimisations: + - `tryInertDicts` + - `GHC.Tc.Solver.Monad.lookupInertDict` + - `noMatchableGivenDicts` + - `matchLocalInst` + - `GHC.Tc.Solver.Solve.runTcPluginsWanted` + +* In `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, + don't pick overlappable top-level instances + +Some wrinkles: + +(SCS1) Note [Shortcut solving: incoherence] + +(SCS2) The short-cut solver just uses the solver recursively, so we get its + full power: + + * We need to be able to handle recursive super classes. The + solved_dicts state ensures that we remember what we have already + tried to solve to avoid looping. + + * As #15164 showed, it can be important to exploit sharing between + goals. E.g. To solve G we may need G1 and G2. To solve G1 we may need H; + and to solve G2 we may need H. If we don't spot this sharing we may + solve H twice; and if this pattern repeats we may get exponentially bad + behaviour. + + * Suppose we have (#13943) + class Take (n :: Nat) where ... + instance {-# OVERLAPPING #-} Take 0 where .. + instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where .. + + And we have [W] Take 3. That only matches one instance so we get + [W] Take (3-1). Then we should reduce the (3-1) to 2, and continue. + +(SCS3) When doing short-cut solving we can (and should) inherit the `solved_dicts` + of the caller (#15164). You might worry about having a solved-dict that uses + a Given -- but that too will have been subject to short-cut solving so it's fine. + Note [Shortcut solving: incoherence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This optimization relies on coherence of dictionaries to be correct. When we @@ -668,38 +700,7 @@ IncoherentInstances is `1`. If we were to do the optimization, the output of `main` would be `2`. -Note [Shortcut try_solve_from_instance] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The workhorse of the short-cut solver is - try_solve_from_instance :: (EvBindMap, DictMap CtEvidence) - -> CtEvidence -- Solve this - -> MaybeT TcS (EvBindMap, DictMap CtEvidence) -Note that: -* The CtEvidence is the goal to be solved - -* The MaybeT manages early failure if we find a subgoal that - cannot be solved from instances. - -* The (EvBindMap, DictMap CtEvidence) is an accumulating purely-functional - state that allows try_solve_from_instance to augment the evidence - bindings and inert_solved_dicts as it goes. - - If it succeeds, we commit all these bindings and solved dicts to the - main TcS InertSet. If not, we abandon it all entirely. - -Passing along the solved_dicts important for two reasons: - -* We need to be able to handle recursive super classes. The - solved_dicts state ensures that we remember what we have already - tried to solve to avoid looping. - -* As #15164 showed, it can be important to exploit sharing between - goals. E.g. To solve G we may need G1 and G2. To solve G1 we may need H; - and to solve G2 we may need H. If we don't spot this sharing we may - solve H twice; and if this pattern repeats we may get exponentially bad - behaviour. - Note [No Given/Given fundeps] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We do not create constraints from: @@ -770,147 +771,75 @@ try_inert_dicts :: InertCans -> DictCt -> TcS (StopOrContinue ()) try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys }) - | Just dict_i <- lookupInertDict inerts (ctEvLoc ev_w) cls tys + | Just dict_i <- lookupInertDict inerts cls tys , let ev_i = dictCtEvidence dict_i loc_i = ctEvLoc ev_i loc_w = ctEvLoc ev_w = -- There is a matching dictionary in the inert set - do { -- First to try to solve it /completely/ from top level instances + do { -- For a Wanted, first to try to solve it /completely/ from top level instances -- See Note [Shortcut solving] - dflags <- getDynFlags - ; short_cut_worked <- shortCutSolver dflags ev_w ev_i - ; if short_cut_worked - then stopWith ev_w "interactDict/solved from instance" + ; short_cut_worked <- tryShortCutSolver (isGiven ev_i) dict_w - -- Next see if we are in "loopy-superclass" land. If so, - -- we don't want to replace the (Given) inert with the - -- (Wanted) work-item, or vice versa; we want to hang on - -- to both, and try to solve the work-item via an instance. - -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance - else if prohibitedSuperClassSolve loc_i loc_w - then continueWith () - else - do { -- The short-cut solver didn't fire, and loopy superclasses - -- are dealt with, so we can either solve - -- the inert from the work-item or vice-versa. - ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of - KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w EvCanonical (ctEvTerm ev_i) - ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } - KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i EvCanonical (ctEvTerm ev_w) - ; updInertCans (updDicts $ delDict dict_w) - ; continueWith () } } } + ; if | short_cut_worked + -> stopWith ev_w "shortCutSolver worked(1)" + -- Next see if we are in "loopy-superclass" land. If so, + -- we don't want to replace the (Given) inert with the + -- (Wanted) work-item, or vice versa; we want to hang on + -- to both, and try to solve the work-item via an instance. + -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance + | prohibitedSuperClassSolve loc_i loc_w + -> continueWith () + + | otherwise -- We can either solve the inert from the work-item or vice-versa. + -> case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of + KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) + ; setEvBindIfWanted ev_w EvCanonical (ctEvTerm ev_i) + ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } + KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) + ; setEvBindIfWanted ev_i EvCanonical (ctEvTerm ev_w) + ; updInertCans (updDicts $ delDict dict_w) + ; continueWith () } } + | otherwise = do { traceTcS "tryInertDicts:no" (ppr dict_w $$ ppr cls <+> ppr tys) ; continueWith () } -- See Note [Shortcut solving] -shortCutSolver :: DynFlags - -> CtEvidence -- Work item - -> CtEvidence -- Inert we want to try to replace - -> TcS Bool -- True <=> success -shortCutSolver dflags ev_w ev_i - | isWanted ev_w - , isGiven ev_i - -- We are about to solve a [W] constraint from a [G] constraint. We take - -- a moment to see if we can get a better solution using an instance. - -- Note that we only do this for the sake of performance. Exactly the same - -- programs should typecheck regardless of whether we take this step or - -- not. See Note [Shortcut solving] - - , not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) - - , not (xopt LangExt.IncoherentInstances dflags) - -- If IncoherentInstances is on then we cannot rely on coherence of proofs - -- in order to justify this optimization: The proof provided by the - -- [G] constraint's superclass may be different from the top-level proof. - -- See Note [Shortcut solving: incoherence] - - , gopt Opt_SolveConstantDicts dflags - -- Enabled by the -fsolve-constant-dicts flag - - = do { ev_binds_var <- getTcEvBindsVar - ; ev_binds <- assertPpr (not (isCoEvBindsVar ev_binds_var )) (ppr ev_w) $ - getTcEvBindsMap ev_binds_var - ; solved_dicts <- getSolvedDicts - - ; mb_stuff <- runMaybeT $ - try_solve_from_instance (ev_binds, solved_dicts) ev_w - - ; case mb_stuff of - Nothing -> return False - Just (ev_binds', solved_dicts') - -> do { setTcEvBindsMap ev_binds_var ev_binds' - ; setSolvedDicts solved_dicts' - ; return True } } - - | otherwise +tryShortCutSolver :: Bool -- True <=> try the short-cut solver; False <=> don't + -> DictCt -- Work item + -> TcS Bool -- True <=> success +-- We are about to solve a [W] constraint from a [G] constraint. We take +-- a moment to see if we can get a better solution using an instance. +-- Note that we only do this for the sake of performance. Exactly the same +-- programs should typecheck regardless of whether we take this step or +-- not. See Note [Shortcut solving] +tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w }) + | not try_short_cut = return False - where - -- This `CtLoc` is used only to check the well-staged condition of any - -- candidate DFun. Our subgoals all have the same stage as our root - -- [W] constraint so it is safe to use this while solving them. - loc_w = ctEvLoc ev_w - - try_solve_from_instance -- See Note [Shortcut try_solve_from_instance] - :: (EvBindMap, DictMap DictCt) -> CtEvidence - -> MaybeT TcS (EvBindMap, DictMap DictCt) - try_solve_from_instance (ev_binds, solved_dicts) ev - | let pred = ctEvPred ev - , ClassPred cls tys <- classifyPredType pred - = do { inst_res <- lift $ matchGlobalInst dflags True cls tys loc_w - ; lift $ warn_custom_warn_instance inst_res loc_w - -- See Note [Implementation of deprecated instances] - ; case inst_res of - OneInst { cir_new_theta = preds - , cir_mk_ev = mk_ev - , cir_canonical = canonical - , cir_what = what } - | safeOverlap what - , all isTyFamFree preds -- Note [Shortcut solving: type families] - -> do { let dict_ct = DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = doNotExpand } - solved_dicts' = addSolvedDict dict_ct solved_dicts - -- solved_dicts': it is important that we add our goal - -- to the cache before we solve! Otherwise we may end - -- up in a loop while solving recursive dictionaries. - - ; lift $ traceTcS "shortCutSolver: found instance" (ppr preds) - ; loc' <- lift $ checkInstanceOK (ctEvLoc ev) what pred - ; lift $ checkReductionDepth loc' pred - + | otherwise + = do { dflags <- getDynFlags + ; if | CtWanted (WantedCt { ctev_pred = pred_w }) <- ev_w - ; evc_vs <- mapM (new_wanted_cached ev loc' solved_dicts') preds - -- Emit work for subgoals but use our local cache - -- so we can solve recursive dictionaries. + , not (couldBeIPLike pred_w) -- Not for implicit parameters (#18627) - ; let ev_tm = mk_ev (map getEvExpr evc_vs) - ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) canonical ev_tm + , not (xopt LangExt.IncoherentInstances dflags) + -- If IncoherentInstances is on then we cannot rely on coherence of proofs + -- in order to justify this optimization: The proof provided by the + -- [G] constraint's superclass may be different from the top-level proof. + -- See Note [Shortcut solving: incoherence] - ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ - freshGoals evc_vs } + , gopt Opt_SolveConstantDicts dflags + -- Enabled by the -fsolve-constant-dicts flag - _ -> mzero } + -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints + do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w)) + ; return (isEmptyWC residual) } - | otherwise - = mzero + | otherwise + -> return False } - -- Use a local cache of solved dicts while emitting EvVars for new work - -- We bail out of the entire computation if we need to emit an EvVar for - -- a subgoal that isn't a ClassPred. - new_wanted_cached :: CtEvidence -> CtLoc - -> DictMap DictCt -> TcPredType -> MaybeT TcS MaybeNew - new_wanted_cached ev_w loc cache pty - | ClassPred cls tys <- classifyPredType pty - = lift $ case findDict cache loc_w cls tys of - Just dict_ct -> return $ Cached (ctEvExpr (dictCtEvidence dict_ct)) - Nothing -> Fresh <$> newWantedNC loc (ctEvRewriters ev_w) pty - | otherwise = mzero - {- ******************************************************************* * * Top-level reaction for class constraints (CDictCan) @@ -930,7 +859,7 @@ = continueWith () -- See Note [No Given/Given fundeps] - | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached + | Just solved_ev <- lookupSolvedDict inerts cls xis -- Cached = do { setEvBindIfWanted ev EvCanonical (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } @@ -939,11 +868,14 @@ ; lkup_res <- matchClassInst dflags inerts cls xis dict_loc ; case lkup_res of OneInst { cir_what = what } - -> do { insertSafeOverlapFailureTcS what work_item - ; updSolvedDicts what work_item - ; chooseInstance ev lkup_res } - _ -> -- NoInstance or NotSure - -- We didn't solve it; so try functional dependencies + -> do { let is_local_given = case what of { LocalInstance -> True; _ -> False } + ; take_shortcut <- tryShortCutSolver is_local_given work_item + ; if take_shortcut + then stopWith ev "shortCutSolver worked(2)" + else do { insertSafeOverlapFailureTcS what work_item + ; updSolvedDicts what work_item + ; chooseInstance ev lkup_res } } + _ -> -- NoInstance or NotSure: we didn't solve it continueWith () } where dict_loc = ctEvLoc ev @@ -961,7 +893,7 @@ (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) - ; emitWorkNC (freshGoals evc_vars) + ; emitWorkNC (map CtWanted $ freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where pred = ctEvPred work_item @@ -976,7 +908,7 @@ -- Returns the CtLoc to used for sub-goals -- Probably also want to call checkReductionDepth checkInstanceOK loc what pred - = do { checkWellStagedDFun loc what pred + = do { checkWellLevelledDFun loc what pred ; return deeper_loc } where deeper_loc = zap_origin (bumpCtLocDepth loc) @@ -1024,7 +956,7 @@ ; return local_res } NoInstance -- No local instances, so try global ones - -> do { global_res <- matchGlobalInst dflags False clas tys loc + -> do { global_res <- matchGlobalInst dflags clas tys loc ; warn_custom_warn_instance global_res loc -- See Note [Implementation of deprecated instances] ; traceTcS "} matchClassInst global result" $ ppr global_res @@ -1032,6 +964,25 @@ where pred = mkClassPred clas tys +-- | Returns True iff there are no Given constraints that might, +-- potentially, match the given class constraint. This is used when checking to see if a +-- Given might overlap with an instance. See Note [Instance and Given overlap] +-- in GHC.Tc.Solver.Dict +noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool +noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys + = not $ anyBag matchable_given $ + findDictsByClass (inert_dicts inert_cans) clas + where + pred_w = mkClassPred clas tys + + matchable_given :: DictCt -> Bool + matchable_given (DictCt { di_ev = ev }) + | CtGiven (GivenCt { ctev_loc = loc_g, ctev_pred = pred_g }) <- ev + = isJust $ mightEqualLater inerts pred_g loc_g pred_w loc_w + + | otherwise + = False + {- Note [Implementation of deprecated instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This note describes the implementation of the deprecated instances GHC proposal @@ -1123,7 +1074,7 @@ - natural numbers - Typeable -* See also Note [What might equal later?] in GHC.Tc.Solver.InertSet. +* See also Note [What might equal later?] in GHC.Tc.Utils.Unify * The given-overlap problem is arguably not easy to appear in practice due to our aggressive prioritization of equality solving over other @@ -1192,15 +1143,18 @@ matchLocalInst :: TcPredType -> CtLoc -> TcS ClsInstResult -- Look up the predicate in Given quantified constraints, -- which are effectively just local instance declarations. -matchLocalInst pred loc - = do { inerts@(IS { inert_cans = ics }) <- getInertSet - ; case match_local_inst inerts (inert_insts ics) of - { ([], []) -> do { traceTcS "No local instance for" (ppr pred) - ; return NoInstance } - ; (matches, unifs) -> - do { matches <- mapM mk_instDFun matches - ; unifs <- mapM mk_instDFun unifs +matchLocalInst body_pred loc + = do { -- Look in the inert set for a matching Given quantified constraint + inerts@(IS { inert_cans = ics }) <- getInertSet + ; case match_local_inst inerts (inert_qcis ics) of + { ([], []) -> do { traceTcS "No local instance for" (ppr body_pred) + ; return NoInstance } + ; (matches, unifs) -> + + do { -- Find the best match -- See Note [Use only the best matching quantified constraint] + matches <- mapM mk_instDFun matches + ; unifs <- mapM mk_instDFun unifs ; case dominatingMatch matches of { Just (dfun_id, tys, theta) | all ((theta `impliedBySCs`) . thdOf3) unifs @@ -1210,7 +1164,7 @@ , cir_canonical = EvCanonical , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ - vcat [ text "pred:" <+> ppr pred + vcat [ text "body_pred:" <+> ppr body_pred , text "result:" <+> ppr result , text "matches:" <+> ppr matches , text "unifs:" <+> ppr unifs ] @@ -1218,13 +1172,13 @@ ; mb_best -> do { traceTcS "Multiple local instances; not committing to any" - $ vcat [ text "pred:" <+> ppr pred + $ vcat [ text "body_pred:" <+> ppr body_pred , text "matches:" <+> ppr matches , text "unifs:" <+> ppr unifs , text "best_match:" <+> ppr mb_best ] ; return NotSure }}}}} where - pred_tv_set = tyCoVarsOfType pred + body_pred_tv_set = tyCoVarsOfType body_pred mk_instDFun :: (CtEvidence, [DFunInstType]) -> TcS InstDFun mk_instDFun (ev, tys) = @@ -1240,18 +1194,21 @@ match_local_inst _inerts [] = ([], []) match_local_inst inerts (qci@(QCI { qci_tvs = qtvs - , qci_pred = qpred + , qci_body = qbody , qci_ev = qev }) - :qcis) - | let in_scope = mkInScopeSet (qtv_set `unionVarSet` pred_tv_set) + : qcis) + | isWanted qev -- Skip Wanteds + = match_local_inst inerts qcis + + | let in_scope = mkInScopeSet (qtv_set `unionVarSet` body_pred_tv_set) , Just tv_subst <- ruleMatchTyKiX qtv_set (mkRnEnv2 in_scope) - emptyTvSubstEnv qpred pred + emptyTvSubstEnv qbody body_pred , let match = (qev, map (lookupVarEnv tv_subst) qtvs) = (match:matches, unifs) | otherwise - = assertPpr (disjointVarSet qtv_set (tyCoVarsOfType pred)) - (ppr qci $$ ppr pred) + = assertPpr (disjointVarSet qtv_set (tyCoVarsOfType body_pred)) + (ppr qci $$ ppr body_pred) -- ASSERT: unification relies on the -- quantified variables being fresh (matches, this_unif `combine` unifs) @@ -1260,7 +1217,7 @@ qtv_set = mkVarSet qtvs (matches, unifs) = match_local_inst inerts qcis this_unif - | Just subst <- mightEqualLater inerts qpred qloc pred loc + | Just subst <- mightEqualLater inerts qbody qloc body_pred loc = Just (qev, map (lookupTyVar subst) qtvs) | otherwise = Nothing @@ -1805,7 +1762,7 @@ 1. Eagerly generate superclasses for given (but not wanted) constraints; see Note [Eagerly expand given superclasses]. - This is done using mkStrictSuperClasses in canClassNC, when + This is done using mkStrictSuperClasses in canDictCt, when we take a non-canonical Given constraint and cannonicalise it. However stop if you encounter the same class twice. That is, @@ -1817,7 +1774,7 @@ solveSimpleWanteds; Note [Danger of adding superclasses during solving] However, /do/ continue to eagerly expand superclasses for new /given/ - /non-canonical/ constraints (canClassNC does this). As #12175 + /non-canonical/ constraints (canDictCt does this). As #12175 showed, a type-family application can expand to a class constraint, and we want to see its superclasses for just the same reason as Note [Eagerly expand given superclasses]. @@ -1873,7 +1830,7 @@ our strategy. Consider f :: C a => a -> Bool f x = x==x -Then canClassNC gets the [G] d1: C a constraint, and eager emits superclasses +Then canDictCt gets the [G] d1: C a constraint, and eager emits superclasses G] d2: D a, [G] d3: C a (psc). (The "psc" means it has its cc_pend_sc has pending expansion fuel.) When processing d3 we find a match with d1 in the inert set, and we always @@ -1910,11 +1867,11 @@ So we may need to do a little work on the givens to expose the class that has the superclasses. That's why the superclass -expansion for Givens happens in canClassNC. +expansion for Givens happens in canDictCt. This same scenario happens with quantified constraints, whose superclasses are also eagerly expanded. Test case: typecheck/should_compile/T16502b -These are handled in canForAllNC, analogously to canClassNC. +These are handled in canForAllNC, analogously to canDictCt. Note [Why adding superclasses can help] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2002,10 +1959,10 @@ More generally, if we are expanding the superclasses of g0 :: forall tvs. theta => cls tys -and find a superclass constraint +and find a superclass constraint (itself perhaps a quantified constraint) forall sc_tvs. sc_theta => sc_inner_pred we must have a selector - sel_id :: forall cls_tvs. cls cls_tvs -> forall sc_tvs. sc_theta => sc_inner_pred + sel_id :: forall cls_tvs. cls cls_tvs => forall sc_tvs. sc_theta => sc_inner_pred and thus build g_sc :: forall tvs sc_tvs. theta => sc_theta => sc_inner_pred g_sc = /\ tvs. /\ sc_tvs. \ theta_ids. \ sc_theta_ids. @@ -2018,7 +1975,13 @@ g_sc = /\ tvs. /\ sc_tvs. \ theta_ids. sel_id tys (g0 tvs theta_ids) sc_tvs - -} +(NQCS1) Common case. If theta_ids[] we get just + g_sc = /\ tvs. /\sc_tvs. sel_id tys (g0 tvs) sc_tvs + and can eta-reduce even more to + g_sc = /\ tvs. sel_id tys (g0 tvs) + and if tvs=[] we get the straight superclass selection + g_sc = sel_id tys g0 +-} makeSuperClasses :: [Ct] -> TcS [Ct] -- Returns strict superclasses, transitively, see Note [The superclass story] @@ -2038,10 +2001,9 @@ go (CDictCan (DictCt { di_ev = ev, di_cls = cls, di_tys = tys, di_pend_sc = fuel })) = assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always mkStrictSuperClasses fuel ev [] [] cls tys - go (CQuantCan (QCI { qci_pred = pred, qci_ev = ev, qci_pend_sc = fuel })) - = assertPpr (isClassPred pred) (ppr pred) $ -- The cts should all have - -- class pred heads - assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0 always + go (CQuantCan (QCI { qci_body = body_pred, qci_ev = ev, qci_pend_sc = fuel })) + = assertPpr (isClassPred body_pred) (ppr body_pred) $ -- The cts should all have class pred heads + assertFuelPreconditionStrict fuel $ -- fuel needs to be more than 0, always mkStrictSuperClasses fuel ev tvs theta cls tys where (tvs, theta, cls, tys) = tcSplitDFunTy (ctEvPred ev) @@ -2069,16 +2031,15 @@ -- The caller of this function is supposed to perform fuel book keeping -- Precondition: fuel >= 0 mk_strict_superclasses _ _ _ _ _ cls _ - | isEqualityClass cls + | isEqualityClass cls -- See (EQC1) in Note [Solving equality classes] = return [] -mk_strict_superclasses fuel rec_clss - ev@(CtGiven { ctev_evar = evar, ctev_loc = loc }) - tvs theta cls tys +mk_strict_superclasses fuel rec_clss ev@(CtGiven (GivenCt { ctev_evar = evar })) tvs theta cls tys = -- Given case do { traceTcS "mk_strict" (ppr ev $$ ppr (ctLocOrigin loc)) ; concatMapM do_one_given (classSCSelIds cls) } where + loc = ctEvLoc ev dict_ids = mkTemplateLocals theta this_size = pSizeClassPred cls tys @@ -2093,14 +2054,14 @@ = do { given_ev <- newGivenEvVar sc_loc $ mk_given_desc sel_id sc_pred ; assertFuelPrecondition fuel $ - mk_superclasses fuel rec_clss given_ev tvs theta sc_pred } + mk_superclasses fuel rec_clss (CtGiven given_ev) tvs theta sc_pred } where sc_pred = classMethodInstTy sel_id tys -- See Note [Nested quantified constraint superclasses] mk_given_desc :: Id -> PredType -> (PredType, EvTerm) mk_given_desc sel_id sc_pred - = (swizzled_pred, swizzled_evterm) + = (swizzled_pred, EvExpr swizzled_evterm) where (sc_tvs, sc_rho) = splitForAllTyCoVars sc_pred (sc_theta, sc_inner_pred) = splitFunTys sc_rho @@ -2109,17 +2070,18 @@ all_theta = theta `chkAppend` (map scaledThing sc_theta) swizzled_pred = mkInfSigmaTy all_tvs all_theta sc_inner_pred - -- evar :: forall tvs. theta => cls tys + -- evar :: forall tvs. theta => cls tys -- sel_id :: forall cls_tvs. cls cls_tvs - -- -> forall sc_tvs. sc_theta => sc_inner_pred + -- => forall sc_tvs. sc_theta => sc_inner_pred -- swizzled_evterm :: forall tvs sc_tvs. theta => sc_theta => sc_inner_pred - swizzled_evterm = EvExpr $ - mkLams all_tvs $ - mkLams dict_ids $ - Var sel_id - `mkTyApps` tys - `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) - `mkVarApps` sc_tvs + swizzled_evterm + | null tvs, null theta -- See wrinkle (NQCS1) + = Var sel_id `mkTyApps` tys `App` evId evar + | otherwise + = mkLams all_tvs $ mkLams dict_ids $ + Var sel_id `mkTyApps` tys + `App` (evId evar `mkVarApps` (tvs ++ dict_ids)) + `mkVarApps` sc_tvs sc_loc | isCTupleClass cls = loc | otherwise = loc { ctl_origin = mk_sc_origin (ctLocOrigin loc) } @@ -2149,7 +2111,9 @@ newly_blocked _ = False -- Wanted case -mk_strict_superclasses fuel rec_clss ev tvs theta cls tys +mk_strict_superclasses fuel rec_clss + (CtWanted (WantedCt { ctev_pred = pty, ctev_loc = loc0, ctev_rewriters = rws })) + tvs theta cls tys | all noFreeVarsOfType tys = return [] -- Wanteds with no variables yield no superclass constraints. -- See Note [Improvement from Ground Wanteds] @@ -2159,12 +2123,12 @@ = assertPpr (null tvs && null theta) (ppr tvs $$ ppr theta) $ concatMapM do_one (immSuperClasses cls tys) where - loc = ctEvLoc ev `updateCtLocOrigin` WantedSuperclassOrigin (ctEvPred ev) + loc = loc0 `updateCtLocOrigin` WantedSuperclassOrigin pty do_one sc_pred = do { traceTcS "mk_strict_superclasses Wanted" (ppr (mkClassPred cls tys) $$ ppr sc_pred) - ; sc_ev <- newWantedNC loc (ctEvRewriters ev) sc_pred - ; mk_superclasses fuel rec_clss sc_ev [] [] sc_pred } + ; sc_ev <- newWantedNC loc rws sc_pred + ; mk_superclasses fuel rec_clss (CtWanted sc_ev) [] [] sc_pred } {- Note [Improvement from Ground Wanteds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2225,7 +2189,8 @@ -- NB: If there is a loop, we cut off, so we have not -- added the superclasses, hence cc_pend_sc = fuel | otherwise - = CQuantCan (QCI { qci_tvs = tvs, qci_pred = mkClassPred cls tys + = CQuantCan (QCI { qci_tvs = tvs, qci_theta = theta + , qci_body = mkClassPred cls tys , qci_ev = ev, qci_pend_sc = fuel }) @@ -2255,8 +2220,7 @@ dictionary "functions" that are unboxed. Actually it does just about work, but the simplifier ends up with stuff like case (/\a. eq_sel d) of df -> ...(df @Int)... -and fails to simplify that any further. And it doesn't satisfy -isPredTy any more. +and fails to simplify that any further. So for now we simply decline to take superclasses in the quantified case. Instead we have a special case in GHC.Tc.Solver.Equality.tryQCsEqCt diff --git a/GHC/Tc/Solver/Equality.hs b/GHC/Tc/Solver/Equality.hs --- a/GHC/Tc/Solver/Equality.hs +++ b/GHC/Tc/Solver/Equality.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} module GHC.Tc.Solver.Equality( @@ -8,6 +10,8 @@ import GHC.Prelude +import {-# SOURCE #-} GHC.Tc.Solver.Solve( trySolveImplication ) + import GHC.Tc.Solver.Irred( solveIrred ) import GHC.Tc.Solver.Dict( matchLocalInst, chooseInstance ) import GHC.Tc.Solver.Rewrite @@ -33,7 +37,7 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction -import GHC.Core.Unify( tcUnifyTyWithTFs ) +import GHC.Core.Unify( tcUnifyTyForInjectivity ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -360,11 +364,13 @@ -- Then, get rid of casts can_eq_nc rewritten rdr_env envs ev eq_rel (CastTy ty1 co1) _ ty2 ps_ty2 - | isNothing (canEqLHS_maybe ty2) -- See (EIK3) in Note [Equalities with incompatible kinds] - = canEqCast rewritten rdr_env envs ev eq_rel NotSwapped ty1 co1 ty2 ps_ty2 + | isNothing (canEqLHS_maybe ty2) + = -- See (EIK3) in Note [Equalities with heterogeneous kinds] + canEqCast rewritten rdr_env envs ev eq_rel NotSwapped ty1 co1 ty2 ps_ty2 can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ - | isNothing (canEqLHS_maybe ty1) -- See (EIK3) in Note [Equalities with incompatible kinds] - = canEqCast rewritten rdr_env envs ev eq_rel IsSwapped ty2 co2 ty1 ps_ty1 + | isNothing (canEqLHS_maybe ty1) + = -- See (EIK3) in Note [Equalities with heterogeneous kinds] + canEqCast rewritten rdr_env envs ev eq_rel IsSwapped ty2 co2 ty1 ps_ty1 ---------------------- -- Otherwise try to decompose @@ -486,7 +492,7 @@ -- See Note [Solving forall equalities] can_eq_nc_forall ev eq_rel s1 s2 - | CtWanted { ctev_dest = orig_dest } <- ev + | CtWanted (WantedCt { ctev_dest = orig_dest, ctev_loc = loc }) <- ev = do { let (bndrs1, phi1, bndrs2, phi2) = split_foralls s1 s2 flags1 = binderFlags bndrs1 flags2 = binderFlags bndrs2 @@ -497,11 +503,11 @@ , ppr flags1, ppr flags2 ] ; canEqHardFailure ev s1 s2 } - else do { - traceTcS "Creating implication for polytype equality" (ppr ev) - ; let free_tvs = tyCoVarsOfTypes [s1,s2] - empty_subst1 = mkEmptySubst $ mkInScopeSet free_tvs - ; skol_info <- mkSkolemInfo (UnifyForAllSkol phi1) + else + do { let free_tvs = tyCoVarsOfTypes [s1,s2] + empty_subst1 = mkEmptySubst $ mkInScopeSet free_tvs + skol_info_anon = UnifyForAllSkol phi1 + ; skol_info <- mkSkolemInfo skol_info_anon ; (subst1, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst1 $ binderVars bndrs1 @@ -538,18 +544,36 @@ go _ _ _ _ _ = panic "can_eq_nc_forall" -- case (s:ss) [] - init_subst2 = mkEmptySubst (getSubstInScope subst1) + init_subst2 = mkEmptySubst (substInScopeSet subst1) + ; traceTcS "Generating wanteds" (ppr s1 $$ ppr s2) + -- Generate the constraints that live in the body of the implication -- See (SF5) in Note [Solving forall equalities] ; (lvl, (all_co, wanteds)) <- pushLevelNoWorkList (ppr skol_info) $ unifyForAllBody ev (eqRelRole eq_rel) $ \uenv -> go uenv skol_tvs init_subst2 bndrs1 bndrs2 - ; emitTvImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs wanteds + -- Solve the implication right away, using `trySolveImplication` + -- See (SF6) in Note [Solving forall equalities] + ; traceTcS "Trying to solve the implication" (ppr s1 $$ ppr s2 $$ ppr wanteds) + ; ev_binds_var <- newNoTcEvBinds + ; solved <- trySolveImplication $ + (implicationPrototype (ctLocEnv loc)) + { ic_tclvl = lvl + , ic_binds = ev_binds_var + , ic_info = skol_info_anon + , ic_warn_inaccessible = False + , ic_skols = skol_tvs + , ic_given = [] + , ic_wanted = emptyWC { wc_simple = wanteds } } - ; setWantedEq orig_dest all_co - ; stopWith ev "Deferred polytype equality" } } + ; if solved + then do { zonked_all_co <- zonkCo all_co + -- ToDo: explain this zonk + ; setWantedEq orig_dest zonked_all_co + ; stopWith ev "Polytype equality: solved" } + else canEqSoftFailure IrredShapeReason ev s1 s2 } } | otherwise = do { traceTcS "Omitting decomposition of given polytype equality" $ @@ -574,7 +598,8 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To solve an equality between foralls [W] (forall a. t1) ~ (forall b. t2) -the basic plan is simple: just create the implication constraint +the basic plan is simple: use `trySolveImplication` to solve the +implication constraint [W] forall a. { t1 ~ (t2[a/b]) } The evidence we produce is a ForAllCo; see the typing rule for @@ -619,6 +644,21 @@ especially Refl ones. We use the `unifyForAllBody` wrapper for `uType`, because we want to /gather/ the equality constraint (to put in the implication) rather than /emit/ them into the monad, as `wrapUnifierTcS` does. + +(SF6) We solve the implication on the spot, using `trySolveImplication`. In + the past we instead generated an `Implication` to be solved later. Nice in + some ways but it added complexity: + - We needed a `wl_implics` field of `WorkList` to collect + these emitted implications + - The types of `solveSimpleWanteds` and friends were more complicated + - Trickily, an `EvFun` had to contain an `EvBindsVar` ref-cell, which made + `evVarsOfTerm` harder. Now an `EvFun` just contains the bindings. + The disadvantage of solve-on-the-spot is that if we fail we are simply + left with an unsolved (forall a. blah) ~ (forall b. blah), and it may + not be clear /why/ we couldn't solve it. But on balance the error messages + improve: it is easier to undertand that + (forall a. a->a) ~ (forall b. b->Int) + is insoluble than it is to understand a message about matching `a` with `Int`. -} {- Note [Unwrap newtypes first] @@ -771,7 +811,7 @@ -- to an irreducible constraint; see typecheck/should_compile/T10494 -- See Note [Decomposing AppTy equalities] can_eq_app ev s1 t1 s2 t2 - | CtWanted { ctev_dest = dest } <- ev + | CtWanted (WantedCt { ctev_dest = dest }) <- ev = do { traceTcS "can_eq_app" (vcat [ text "s1:" <+> ppr s1, text "t1:" <+> ppr t1 , text "s2:" <+> ppr s2, text "t2:" <+> ppr t2 , text "vis:" <+> ppr (isNextArgVisible s1) ]) @@ -794,7 +834,7 @@ | s1k `mismatches` s2k = canEqHardFailure ev (s1 `mkAppTy` t1) (s2 `mkAppTy` t2) - | CtGiven { ctev_evar = evar } <- ev + | CtGiven (GivenCt { ctev_evar = evar }) <- ev = do { let co = mkCoVarCo evar co_s = mkLRCo CLeft co co_t = mkLRCo CRight co @@ -802,8 +842,8 @@ , evCoercion co_s ) ; evar_t <- newGivenEvVar loc ( mkTcEqPredLikeEv ev t1 t2 , evCoercion co_t ) - ; emitWorkNC [evar_t] - ; startAgainWith (mkNonCanonical evar_s) } + ; emitWorkNC [CtGiven evar_t] + ; startAgainWith (mkNonCanonical $ CtGiven evar_s) } where loc = ctEvLoc ev @@ -852,18 +892,26 @@ = do { inerts <- getInertSet ; if can_decompose inerts then canDecomposableTyConAppOK ev eq_rel tc1 (ty1,tys1) (ty2,tys2) - else canEqSoftFailure ev eq_rel ty1 ty2 } + else assert (eq_rel == ReprEq) $ + canEqSoftFailure ReprEqReason ev ty1 ty2 } -- See Note [Skolem abstract data] in GHC.Core.Tycon | tyConSkolem tc1 || tyConSkolem tc2 = do { traceTcS "canTyConApp: skolem abstract" (ppr tc1 $$ ppr tc2) ; finishCanWithIrred AbstractTyConReason ev } - | otherwise -- Different TyCons - = if both_generative -- See (TC2) and (TC3) in - -- Note [Canonicalising TyCon/TyCon equalities] - then canEqHardFailure ev ty1 ty2 - else canEqSoftFailure ev eq_rel ty1 ty2 + -- Different TyCons + | NomEq <- eq_rel + = canEqHardFailure ev ty1 ty2 + + -- Different TyCons, eq_rel = ReprEq + -- See (TC2) and (TC3) in + -- Note [Canonicalising TyCon/TyCon equalities] + | both_generative + = canEqHardFailure ev ty1 ty2 + + | otherwise + = canEqSoftFailure ReprEqReason ev ty1 ty2 where -- See Note [Decomposing TyConApp equalities] -- and Note [Decomposing newtype equalities] @@ -991,8 +1039,8 @@ is the same => arguments are the same, modulo the role shift. See comments on GHC.Core.TyCon.isInjectiveTyCon. This is also the CO_NTH rule in Fig 5 of the paper, except in the paper only -newtypes are non-injective at representation role, so the rule says "H -is not a newtype". +newtypes are non-injective at representation role, so the rule says +"H is not a newtype". Injectivity is a bit subtle: Nominal Representational @@ -1050,10 +1098,10 @@ left-to-right order. See the use of `snocBag` in `uType_defer`. * `wrapUnifierTcS` adds the bag of deferred constraints from - `do_unifications` to the work-list using `extendWorkListEqs`. + `do_unifications` to the work-list using `extendWorkListChildEqs`. -* `extendWorkListEqs` and `selectWorkItem` together arrange that the - list of constraints given to `extendWorkListEqs` is processed in +* `extendWorkListChildEqs` and `selectWorkItem` together arrange that the + list of constraints given to `extendWorkListChildEqs` is processed in left-to-right order. This is not a very big deal. It reduces the number of solver steps @@ -1119,7 +1167,7 @@ them. This is done in can_eq_nc. Of course, we can't unwrap if the data constructor isn't in scope. See Note [Unwrap newtypes first]. -* Incompleteness example (EX2): see #24887 +* Incompleteness example (EX2): prioritise Nominal equalities. See #24887 data family D a data instance D Int = MkD1 (D Char) data instance D Bool = MkD2 (D Char) @@ -1137,7 +1185,7 @@ CONCLUSION: prioritise nominal equalites in the work list. See Note [Prioritise equalities] in GHC.Tc.Solver.InertSet. -* Incompleteness example (EX3): available Givens +* Incompleteness example (EX3): check available Givens newtype Nt a = Mk Bool -- NB: a is not used in the RHS, type role Nt representational -- but the user gives it an R role anyway @@ -1155,36 +1203,41 @@ equalities that could later solve it. But what precisely does it mean to say "any Given equalities that could - later solve it"? - - In #22924 we had - [G] f a ~R# a [W] Const (f a) a ~R# Const a a - where Const is an abstract newtype. If we decomposed the newtype, we - could solve. Not-decomposing on the grounds that (f a ~R# a) might turn - into (Const (f a) a ~R# Const a a) seems a bit silly. + later solve it"? It's tricky! - In #22331 we had - [G] N a ~R# N b [W] N b ~R# N a - (where N is abstract so we can't unwrap). Here we really /don't/ want to - decompose, because the /only/ way to solve the Wanted is from that Given - (with a Sym). + * In #22924 we had + [G] f a ~R# a [W] Const (f a) a ~R# Const a a + where Const is an abstract newtype. If we decomposed the newtype, we + could solve. Not-decomposing on the grounds that (f a ~R# a) might turn + into (Const (f a) a ~R# Const a a) seems a bit silly. - In #22519 we had - [G] a <= b [W] IO Age ~R# IO Int + * In #22331 we had + [G] N a ~R# N b [W] N b ~R# N a + (where N is abstract so we can't unwrap). Here we really /don't/ want to + decompose, because the /only/ way to solve the Wanted is from that Given + (with a Sym). - (where IO is abstract so we can't unwrap, and newtype Age = Int; and (<=) - is a type-level comparison on Nats). Here we /must/ decompose, despite the - existence of an Irred Given, or we will simply be stuck. (Side note: We - flirted with deep-rewriting of newtypes (see discussion on #22519 and - !9623) but that turned out not to solve #22924, and also makes type - inference loop more often on recursive newtypes.) + * In #22519 we had + [G] a <= b [W] IO Age ~R# IO Int - The currently-implemented compromise is this: + (where IO is abstract so we can't unwrap, and newtype Age = Int; and (<=) + is a type-level comparison on Nats). Here we /must/ decompose, despite the + existence of an Irred Given, or we will simply be stuck. (Side note: We + flirted with deep-rewriting of newtypes (see discussion on #22519 and + !9623) but that turned out not to solve #22924, and also makes type + inference loop more often on recursive newtypes.) - we decompose [W] N s ~R# N t unless there is a [G] N s' ~ N t' + * In #26020 we had a /quantified/ constraint + forall x. Coercible (N t1) (N t2) + and (roughly) [W] N t1 ~R# N t2 + That quantified constraint can solve the Wanted, so don't decompose! - that is, a Given Irred equality with both sides headed with N. - See the call to noGivenNewtypeReprEqs in canTyConApp. + The currently-implemented compromise is this: + We decompose [W] N s ~R# N t unless there is + - an Irred [G] N s' ~ N t' + - a quantified [G] forall ... => N s' ~ N t' + that is, a Given equality with both sides headed with N. + See the call to `noGivenNewtypeReprEqs` in `canTyConApp`. This is not perfect. In principle a Given like [G] (a b) ~ (c d), or even just [G] c, could later turn into N s ~ N t. But since the free @@ -1195,7 +1248,7 @@ un-expanded equality superclasses; but only in some very obscure recursive-superclass situations. - Yet another approach (!) is desribed in + Yet another approach (!) is described in Note [Decomposing newtypes a bit more aggressively]. Remember: decomposing Wanteds is always /sound/. This Note is @@ -1344,19 +1397,18 @@ do { traceTcS "canDecomposableTyConAppOK" (ppr ev $$ ppr eq_rel $$ ppr tc $$ ppr tys1 $$ ppr tys2) ; case ev of - CtWanted { ctev_dest = dest } + CtWanted (WantedCt { ctev_dest = dest }) -- new_locs and tc_roles are both infinite, so we are -- guaranteed that cos has the same length as tys1 and tys2 -- See Note [Fast path when decomposing TyConApps] -> do { (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> do { cos <- zipWith4M (u_arg uenv) new_locs tc_roles tys1 tys2 -- zipWith4M: see Note [Work-list ordering] - -- in GHC.Tc.Solved.Equality ; return (mkTyConAppCo role tc cos) } ; setWantedEq dest co } - CtGiven { ctev_evar = evar } - | let pred_ty = mkPrimEqPredRole (eqRelRole eq_rel) ty1 ty2 + CtGiven (GivenCt { ctev_evar = evar }) + | let pred_ty = mkEqPred eq_rel ty1 ty2 ev_co = mkCoVarCo (setVarType evar pred_ty) -- setVarType: satisfy Note [mkSelCo precondition] in Coercion.hs -- Remember: ty1/ty2 may be more fully zonked than evar @@ -1403,7 +1455,7 @@ = do { traceTcS "canDecomposableFunTy" (ppr ev $$ ppr eq_rel $$ ppr f1 $$ ppr f2) ; case ev of - CtWanted { ctev_dest = dest } + CtWanted (WantedCt { ctev_dest = dest }) -> do { (co, _, _) <- wrapUnifierTcS ev Nominal $ \ uenv -> do { let mult_env = uenv `updUEnvLoc` toInvisibleLoc `setUEnvRole` funRole role SelMult @@ -1413,8 +1465,8 @@ ; return (mkNakedFunCo role af mult arg res) } ; setWantedEq dest co } - CtGiven { ctev_evar = evar } - | let pred_ty = mkPrimEqPredRole (eqRelRole eq_rel) ty1 ty2 + CtGiven (GivenCt { ctev_evar = evar }) + | let pred_ty = mkEqPred eq_rel ty1 ty2 ev_co = mkCoVarCo (setVarType evar pred_ty) -- setVarType: satisfy Note [mkSelCo precondition] in Coercion.hs -- Remember: ty1/ty2 may be more fully zonked than evar @@ -1431,20 +1483,18 @@ -- | Call canEqSoftFailure when canonicalizing an equality fails, but if the -- equality is representational, there is some hope for the future. -canEqSoftFailure :: CtEvidence -> EqRel -> TcType -> TcType +canEqSoftFailure :: CtIrredReason -> CtEvidence -> TcType -> TcType -> TcS (StopOrContinue (Either IrredCt a)) -canEqSoftFailure ev NomEq ty1 ty2 - = canEqHardFailure ev ty1 ty2 -canEqSoftFailure ev ReprEq ty1 ty2 +canEqSoftFailure reason ev ty1 ty2 = do { (redn1, rewriters1) <- rewrite ev ty1 ; (redn2, rewriters2) <- rewrite ev ty2 -- We must rewrite the types before putting them in the -- inert set, so that we are sure to kick them out when -- new equalities become available - ; traceTcS "canEqSoftFailure with ReprEq" $ + ; traceTcS "canEqSoftFailure" $ vcat [ ppr ev, ppr redn1, ppr redn2 ] ; new_ev <- rewriteEqEvidence (rewriters1 S.<> rewriters2) ev NotSwapped redn1 redn2 - ; finishCanWithIrred ReprEqReason new_ev } + ; finishCanWithIrred reason new_ev } -- | Call when canonicalizing an equality fails with utterly no hope. canEqHardFailure :: CtEvidence -> TcType -> TcType @@ -1626,7 +1676,7 @@ -> TcKind -- ki2 -> TcS (StopOrContinue (Either IrredCt EqCt)) canEqCanLHSHetero ev eq_rel swapped lhs1 ps_xi1 ki1 xi2 ps_xi2 ki2 --- See Note [Equalities with incompatible kinds] +-- See Note [Equalities with heterogeneous kinds] -- See Note [Kind Equality Orientation] -- NB: preserve left-to-right orientation!! See wrinkle (W2) in @@ -1634,54 +1684,70 @@ -- NotSwapped: -- ev :: (lhs1:ki1) ~r# (xi2:ki2) -- kind_co :: k11 ~# ki2 -- Same orientation as ev --- type_ev :: lhs1 ~r# (xi2 |> sym kind_co) +-- new_ev :: lhs1 ~r# (xi2 |> sym kind_co) -- Swapped -- ev :: (xi2:ki2) ~r# (lhs1:ki1) -- kind_co :: ki2 ~# ki1 -- Same orientation as ev --- type_ev :: (xi2 |> kind_co) ~r# lhs1 - - = do { (kind_co, rewriters, unifs_happened) <- mk_kind_eq -- :: ki1 ~N ki2 - ; if unifs_happened - -- Unifications happened, so start again to do the zonking - -- Otherwise we might put something in the inert set that isn't inert - then startAgainWith (mkNonCanonical ev) - else - do { let lhs_redn = mkReflRedn role ps_xi1 - rhs_redn = mkGReflRightRedn role xi2 mb_sym_kind_co - mb_sym_kind_co = case swapped of - NotSwapped -> mkSymCo kind_co - IsSwapped -> kind_co - - ; traceTcS "Hetero equality gives rise to kind equality" - (ppr swapped $$ - ppr kind_co <+> dcolon <+> sep [ ppr ki1, text "~#", ppr ki2 ]) - ; type_ev <- rewriteEqEvidence rewriters ev swapped lhs_redn rhs_redn - - ; let new_xi2 = mkCastTy ps_xi2 mb_sym_kind_co - ; canEqCanLHSHomo type_ev eq_rel NotSwapped lhs1 ps_xi1 new_xi2 new_xi2 }} +-- new_ev :: (xi2 |> kind_co) ~r# lhs1 +-- Note that we need the `sym` when we are /not/ swapped; hence `mk_sym_co` - where - mk_kind_eq :: TcS (CoercionN, RewriterSet, Bool) - -- Returned kind_co has kind (k1 ~ k2) if NotSwapped, (k2 ~ k1) if Swapped - -- Returned Bool = True if unifications happened, so we should retry - mk_kind_eq = case ev of - CtGiven { ctev_evar = evar } + = case ev of + CtGiven (GivenCt { ctev_evar = evar, ctev_loc = loc }) -> do { let kind_co = mkKindCo (mkCoVarCo evar) - pred_ty = unSwap swapped (mkNomPrimEqPred liftedTypeKind) ki1 ki2 - kind_loc = mkKindEqLoc xi1 xi2 (ctev_loc ev) + pred_ty = unSwap swapped mkNomEqPred ki1 ki2 + kind_loc = mkKindEqLoc xi1 xi2 loc ; kind_ev <- newGivenEvVar kind_loc (pred_ty, evCoercion kind_co) - ; emitWorkNC [kind_ev] - ; return (ctEvCoercion kind_ev, emptyRewriterSet, False) } + ; emitWorkNC [CtGiven kind_ev] + ; finish emptyRewriterSet (givenCtEvCoercion kind_ev) } CtWanted {} - -> do { (kind_co, cts, unifs) <- wrapUnifierTcS ev Nominal $ \uenv -> - let uenv' = updUEnvLoc uenv (mkKindEqLoc xi1 xi2) - in unSwap swapped (uType uenv') ki1 ki2 - ; return (kind_co, rewriterSetFromCts cts, not (null unifs)) } + -> do { (kind_co, cts, unifs) <- wrapUnifierTcS ev Nominal $ \uenv -> + let uenv' = updUEnvLoc uenv (mkKindEqLoc xi1 xi2) + in unSwap swapped (uType uenv') ki1 ki2 + -- mkKindEqLoc: any new constraints, arising from the kind + -- unification, say they thay come from unifying xi1~xi2 + ; if not (null unifs) + then -- Unifications happened, so start again to do the zonking + -- Otherwise we might put something in the inert set that isn't inert + startAgainWith (mkNonCanonical ev) + else + assertPpr (not (isEmptyCts cts)) (ppr ev $$ ppr ki1 $$ ppr ki2) $ + -- assert: the constraints won't be empty because the two kinds differ, + -- and there are no unifications, so we must have emitted one or + -- more constraints + finish (rewriterSetFromCts cts) kind_co } + -- rewriterSetFromCts: record in the /type/ unification xi1~xi2 that + -- it has been rewritten by any (unsolved) consraints in `cts`; that + -- stops xi1~xi2 from unifying until `cts` are solved. See (EIK2). + where xi1 = canEqLHSType lhs1 role = eqRelRole eq_rel + finish rewriters kind_co + = do { traceTcS "Hetero equality gives rise to kind equality" + (ppr swapped $$ + ppr kind_co <+> dcolon <+> sep [ ppr ki1, text "~#", ppr ki2 ]) + ; new_ev <- rewriteEqEvidence rewriters ev swapped lhs_redn rhs_redn + -- rewriteEqEvidence adds any as-yet-unsolved equalities + -- from the kind equality (namely `rewriters`) to the + -- rewriter set for `new_ev`. See (EIK2). + + -- Now `new_ev` is homogenous: carry on! + ; canEqCanLHSHomo new_ev eq_rel NotSwapped lhs1 ps_xi1 new_xi2 new_xi2 } + + where + -- kind_co :: ki1 ~N ki2 + lhs_redn = mkReflRedn role ps_xi1 + rhs_redn = mkGReflRightRedn role xi2 sym_kind_co + new_xi2 = mkCastTy ps_xi2 sym_kind_co + + -- Apply mkSymCo when /not/ swapped + sym_kind_co = case swapped of + NotSwapped -> mkSymCo kind_co + IsSwapped -> kind_co + + canEqCanLHSHomo :: CtEvidence -- lhs ~ rhs -- or, if swapped: rhs ~ lhs -> EqRel -> SwapFlag @@ -1884,84 +1950,106 @@ ----------------------- canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Try unification; for Wanted, Nominal equalities with a meta-tyvar on the LHS - | isWanted ev -- See Note [Do not unify Givens] - , NomEq <- eq_rel -- See Note [Do not unify representational equalities] - , TyVarLHS tv <- lhs - = do { given_eq_lvl <- getInnermostGivenEqLevel - ; if not (touchabilityAndShapeTest given_eq_lvl tv rhs) - then if | Just can_rhs <- canTyFamEqLHS_maybe rhs - -> swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs - -- See Note [Orienting TyVarLHS/TyFamLHS] - - | otherwise - -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs - else - - -- We have a touchable unification variable on the left - do { check_result <- checkTouchableTyVarEq ev tv rhs - ; case check_result of { - PuFail reason + | CtWanted wev <- ev -- See Note [Do not unify Givens] + , NomEq <- eq_rel -- See Note [Do not unify representational equalities] + , wantedCtHasNoRewriters wev -- See Note [Unify only if the rewriter set is empty] + , TyVarLHS lhs_tv <- lhs + = do { given_eq_lvl <- getInnermostGivenEqLevel + ; case simpleUnifyCheck UC_Solver given_eq_lvl lhs_tv rhs of + SUC_CanUnify -> + unify lhs_tv (mkReflRedn Nominal rhs) + SUC_CannotUnify | Just can_rhs <- canTyFamEqLHS_maybe rhs - -> swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs - -- Swap back: see Note [Orienting TyVarLHS/TyFamLHS] - - | reason `cterHasOnlyProblems` do_not_prevent_rewriting - -> canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs - + -> swap_and_finish lhs_tv can_rhs -- See Note [Orienting TyVarLHS/TyFamLHS] | otherwise - -> tryIrredInstead reason ev eq_rel swapped lhs rhs ; + -> finish_no_unify + SUC_NotSure -> + -- We have a touchable unification variable on the left, + -- and the top-shape check succeeded. These are both guaranteed + -- by the fact that simpleUnifyCheck did not return SUC_CannotUnify. + do { let flags = unifyingLHSMetaTyVar_TEFTask ev lhs_tv + ; check_result <- wrapTcS (checkTyEqRhs flags rhs) + ; case check_result of + PuOK cts rhs_redn -> + do { emitWork cts + ; unify lhs_tv rhs_redn } + PuFail reason + | Just can_rhs <- canTyFamEqLHS_maybe rhs + -> swap_and_finish lhs_tv can_rhs -- See Note [Orienting TyVarLHS/TyFamLHS] + | reason `cterHasOnlyProblems` do_not_prevent_rewriting + -> + -- ContinueWith, to allow using this constraint for + -- rewriting (e.g. alpha[2] ~ beta[3]). + do { let role = eqRelRole eq_rel + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn role (canEqLHSType lhs)) + (mkReflRedn role rhs) + ; continueWith $ Right $ + EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel + , eq_lhs = lhs , eq_rhs = rhs } + } + | otherwise + -> try_irred reason + } + } + -- Otherwise unification is off the table + | otherwise + = finish_no_unify - PuOK _ rhs_redn -> + where + -- We can't unify, but this equality can go in the inert set + -- and be used to rewrite other constraints. + finish_no_unify = + canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs - -- Success: we can solve by unification - do { -- In the common case where rhs_redn is Refl, we don't need to rewrite - -- the evidence, even if swapped=IsSwapped. Suppose the original was - -- [W] co : Int ~ alpha - -- We unify alpha := Int, and set co := . No need to - -- swap to co = sym co' - -- co' = - new_ev <- if isReflCo (reductionCoercion rhs_redn) - then return ev - else rewriteEqEvidence emptyRewriterSet ev swapped - (mkReflRedn Nominal (mkTyVarTy tv)) rhs_redn + -- We can't unify, and this equality should not be used to rewrite + -- other constraints (e.g. because it has an occurs check). + -- So add it to the inert Irreds. + try_irred reason = + tryIrredInstead reason ev eq_rel swapped lhs rhs - ; let tv_ty = mkTyVarTy tv - final_rhs = reductionReducedType rhs_redn + -- We can't unify as-is, and want to flip the equality around. + -- Example: alpha ~ F tys, flip it around to become the canonical + -- equality f tys ~ alpha. + swap_and_finish tv can_rhs = + swapAndFinish ev eq_rel swapped (mkTyVarTy tv) can_rhs - ; traceTcS "Sneaky unification:" $ - vcat [text "Unifies:" <+> ppr tv <+> text ":=" <+> ppr final_rhs, - text "Coercion:" <+> pprEq tv_ty final_rhs, - text "Left Kind is:" <+> ppr (typeKind tv_ty), - text "Right Kind is:" <+> ppr (typeKind final_rhs) ] + -- We can unify; go ahead and do so. + unify tv rhs_redn = - -- Update the unification variable itself - ; unifyTyVar tv final_rhs + do { -- In the common case where rhs_redn is Refl, we don't need to rewrite + -- the evidence, even if swapped=IsSwapped. Suppose the original was + -- [W] co : Int ~ alpha + -- We unify alpha := Int, and set co := . No need to + -- swap to co = sym co' + -- co' = + new_ev <- if isReflCo (reductionCoercion rhs_redn) + then return ev + else rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn Nominal (mkTyVarTy tv)) rhs_redn - -- Provide Refl evidence for the constraint - -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev EvCanonical $ - evCoercion (mkNomReflCo final_rhs) + ; let tv_ty = mkTyVarTy tv + final_rhs = reductionReducedType rhs_redn - -- Kick out any constraints that can now be rewritten - ; kickOutAfterUnification [tv] + ; traceTcS "Sneaky unification:" $ + vcat [text "Unifies:" <+> ppr tv <+> text ":=" <+> ppr final_rhs, + text "Coercion:" <+> pprEq tv_ty final_rhs, + text "Left Kind is:" <+> ppr (typeKind tv_ty), + text "Right Kind is:" <+> ppr (typeKind final_rhs) ] - ; return (Stop new_ev (text "Solved by unification")) }}}} + -- Update the unification variable itself + ; unifyTyVar tv final_rhs - -- Otherwise unification is off the table - | otherwise - = canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs + -- Provide Refl evidence for the constraint + -- Ignore 'swapped' because it's Refl! + ; setEvBindIfWanted new_ev EvCanonical $ + evCoercion (mkNomReflCo final_rhs) - where - -- Some problems prevent /unification/ but not /rewriting/ - -- Skolem-escape: if we have [W] alpha[2] ~ Maybe b[3] - -- we can't unify (skolem-escape); but it /is/ canonical, - -- and hence we /can/ use it for rewriting - -- Concrete-ness: alpha[conc] ~ b[sk] - -- We can use it to rewrite; we still have to solve the original - do_not_prevent_rewriting :: CheckTyEqResult - do_not_prevent_rewriting = cteProblem cteSkolemEscape S.<> - cteProblem cteConcrete + -- Kick out any constraints that can now be rewritten + ; kickOutAfterUnification [tv] + ; return (Stop new_ev (text "Solved by unification")) } + --------------------------- -- Unification is off the table canEqCanLHSFinish_no_unification ev eq_rel swapped lhs rhs @@ -1987,6 +2075,17 @@ -- -> swapAndFinish ev eq_rel swapped lhs_ty can_rhs -- | otherwise + | reason `cterHasOnlyProblems` do_not_prevent_rewriting + -> do { let role = eqRelRole eq_rel + ; new_ev <- rewriteEqEvidence emptyRewriterSet ev swapped + (mkReflRedn role (canEqLHSType lhs)) + (mkReflRedn role rhs) + ; continueWith $ Right $ + EqCt { eq_ev = new_ev, eq_eq_rel = eq_rel + , eq_lhs = lhs , eq_rhs = rhs } + } + + | otherwise -> tryIrredInstead reason ev eq_rel swapped lhs rhs PuOK _ rhs_redn @@ -2003,6 +2102,18 @@ , eq_lhs = lhs , eq_rhs = reductionReducedType rhs_redn } } } +-- | Some problems prevent /unification/ but not /rewriting/: +-- +-- Skolem-escape: if we have [W] alpha[2] ~ Maybe b[3] +-- we can't unify (skolem-escape); but it /is/ canonical, +-- and hence we /can/ use it for rewriting +-- +-- Concrete-ness: alpha[conc] ~ b[sk] +-- We can use it to rewrite; we still have to solve the original +do_not_prevent_rewriting :: CheckTyEqResult +do_not_prevent_rewriting = cteProblem cteSkolemEscape S.<> + cteProblem cteConcrete + ---------------------- swapAndFinish :: CtEvidence -> EqRel -> SwapFlag -> TcType -> CanEqLHS -- ty ~ F tys @@ -2056,8 +2167,8 @@ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } -{- Note [Equalities with incompatible kinds] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Equalities with heterogeneous kinds] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What do we do when we have an equality (tv :: k1) ~ (rhs :: k2) @@ -2065,83 +2176,70 @@ where k1 and k2 differ? Easy: we create a coercion that relates k1 and k2 and use this to cast. To wit, from - [X] (tv :: k1) ~ (rhs :: k2) + [X] co1 :: (tv :: k1) ~ (rhs :: k2) (where [X] is [G] or [W]), we go to - [X] co :: k1 ~ k2 - [X] (tv :: k1) ~ ((rhs |> sym co) :: k1) + co1 = co2 ; sym (GRefl kco) + [X] co2 :: (tv :: k1) ~ ((rhs |> sym kco) :: k1) + [X] kco :: k1 ~ k2 Wrinkles: -(EIK1) When X is W, the new type-level wanted is effectively rewritten by the - kind-level one. We thus include the kind-level wanted in the RewriterSet - for the type-level one. See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. - This is done in canEqCanLHSHetero. +(EIK1) When X=Wanted, the new type-level wanted for `co` is effectively rewritten by + the kind-level one. We thus include the kind-level wanted in the RewriterSet + for the type-level one. See Note [Wanteds rewrite Wanteds] in + GHC.Tc.Types.Constraint. This is done in canEqCanLHSHetero. (EIK2) Suppose we have [W] (a::Type) ~ (b::Type->Type). The above rewrite will produce - [W] w : a ~ (b |> kw) - [W] kw : Type ~ (Type->Type) - - But we do /not/ want to regard `w` as canonical, and use it for rewriting - other constraints: `kw` is insoluble, and replacing something of kind - `Type` with something of kind `Type->Type` (even wrapped in an insouluble - cast) does not help, and doing so turns out to lead to much worse error - messages. (In particular, if 'a' is a unification variable, we might - unify, losing the tracking info that it depends on solving `kw`.) - - Conclusion: if a RHS contains a coercion hole arising from fixing a hetero-kinded - equality, treat the equality (`w` in this case) as non-canonical, so that - * It will not be used for unification - * It will not be used for rewriting - Instead, it lands in the inert_irreds in the inert set, awaiting solution of - that `kw`. + [W] w (rewriters: {kw}) : a ~ (b |> kw) + [W] kw : Type ~ (Type->Type) - (EIK2a) We must later indeed unify if/when the kind-level wanted, `kw` gets - solved. This is done in kickOutAfterFillingCoercionHole, which kicks out - all equalities whose RHS mentions the filled-in coercion hole. Note that - it looks for type family equalities, too, because of the use of unifyTest - in canEqTyVarFunEq. + We track `w` as having `kw` in its rewriter set. That will stop us unifying `w` + (see Note [Unify only if the rewriter set is empty] in GHC.Tc.Solver.Equality). - (EIK2b) What if the RHS mentions /other/ coercion holes? How can that happen? The - main way is like this. Assume F :: forall k. k -> Type + But `w` is still /canonical/, and used for rewriting other constraints. + See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. That's important + in general. Consider: [W] kw : k ~ Type [W] w : a ~ F k t We can rewrite `w` with `kw` like this: - [W] w' : a ~ F Type (t |> kw) + [W] w' (rewriters: {kw}) : a ~ F Type (t |> kw) The cast on the second argument of `F` is necessary to keep the appliation well-kinded. There is nothing special here; no reason not treat w' as canonical, and use it for - rewriting. Indeed tests JuanLopez only typechecks if we do. So we'd like to treat - this kind of equality as canonical. + rewriting. Indeed test JuanLopez only typechecks if we do. - Hence the ch_hetero_kind field in CoercionHole: it is True of constraints - created by `canEqCanLHSHetero` to fix up hetero-kinded equalities; and False otherwise: + So here is our implementation: + * When doing the kind unification, any equality constraints we can't solve + immediately get an origin that tells that the constraint arises from + the kind of the parent type-equality. See the calls to `mkKindEqLoc` + in `canEqCanLHSHetero`. - * An equality constraint is non-canonical if it mentions a hetero-kind - CoercionHole on the RHS. See the `hasCoercionHoleCo` test in GHC.Tc.Utils.checkCo. + * We /also/ add these unsolved kind equalities to the `RewriterSet` of the + parent constraint; see the call to `rewriteEqEvidence` in `finish` in + `canEqCanLHSHetero`. - * Hetero-kind CoercionHoles are created when the parent's CtOrigin is - KindEqOrigin: see GHC.Tc.Utils.TcMType.newCoercionHole and friends. We - set this origin, via `mkKindLoc`, in `mk_kind_eq` in `canEqCanLHSHetero`. + * When filling a coercion hole we kick out any equality constraints whose + rewriter set mentions this hole. See `kickOutAfterFillingCoercionHole` -(EIK3) Suppose we have [W] (a :: k1) ~ (rhs :: k2). We duly follow the - algorithm detailed here, producing [W] co :: k1 ~ k2, and adding - [W] (a :: k1) ~ ((rhs |> sym co) :: k1) to the irreducibles. Some time - later, we solve co, and fill in co's coercion hole. This kicks out - the irreducible as described in (2). +(EIK3) Suppose we have [W] co1 : (a :: k1) ~ (rhs :: k2). We duly follow the + algorithm detailed here, producing [W] kco :: k1 ~ k2, and adding + [W] co2 : (a :: k1) ~ ((rhs |> sym kco) :: k1) to the inert set. + Some time later, we solve `kco`, and fill in kco's coercion hole. + This kicks out the inert equality `co2` But now, during canonicalization, we see the cast and remove it, in - canEqCast. By the time we get into canEqCanLHS, the equality is - heterogeneous again, and the process repeats. + `canEqCast`. By the time we get into `canEqCanLHS`, the equality is + heterogeneous again, and the process repeats! To avoid this, we don't strip casts off a type if the other type in the - equality is a CanEqLHS (the scenario above can happen with a type - family, too. testcase: typecheck/should_compile/T13822). + equality is a CanEqLHS. See the `CastTy` case of `can_eq_nc`. + (The scenario above can happen with a type family, too. + testcase: typecheck/should_compile/T13822). And this is an improvement regardless: because tyvars can, generally, unify with casted types, there's no reason to go through the work of - stripping off the cast when the cast appears opposite a tyvar. This is - implemented in the cast case of can_eq_nc. + stripping off the cast when the cast appears opposite a tyvar. Historical note: @@ -2278,7 +2376,7 @@ Note that * `cbv` is a fresh cycle breaker variable. -* `cbv` is a is a meta-tyvar, but it is completely untouchable. +* `cbv` is a meta-tyvar, but it is completely untouchable. * We track the cycle-breaker variables in inert_cycle_breakers in InertSet * We eventually fill in the cycle-breakers, with `cbv := F lhs`. No one else fills in CycleBreakerTvs! @@ -2308,8 +2406,9 @@ [W] Arg alpha ~ cbv1 [W] Res alpha ~ cbv2 -where cbv1 and cbv2 are fresh TauTvs. This is actually done by `break_wanted` -in `GHC.Tc.Solver.Monad.checkTouchableTyVarEq`. +where cbv1 and cbv2 are fresh TauTvs. This is actually done within checkTyEqRhs, +called within canEqCanLHSFinish_try_unification, which will use the BreakWanted +FamAppBreaker. Why TauTvs? See [Why TauTvs] below. @@ -2318,7 +2417,7 @@ unifying cbv1 and cbv2 immediately, achieving nothing.) Next, we unify alpha := cbv1 -> cbv2, having eliminated the occurs check. This unification happens immediately following a successful call to -checkTouchableTyVarEq, in canEqCanLHSFinish_try_unification. +checkTyEqRhs, in canEqCanLHSFinish_try_unification. Now, we're here (including further context from our original example, from the top of the Note): @@ -2468,10 +2567,9 @@ However, we make no attempt to detect cases like a ~ (F a, F a) and use the same tyvar to replace F a. The constraint solver will common them up later! - (Cf. Note [Flattening type-family applications when matching instances] in - GHC.Core.Unify, which goes to this extra effort.) However, this is really - a very small corner case. The investment to craft a clever, performant - solution seems unworthwhile. + (Cf. Note [Apartness and type families] in GHC.Core.Unify, which goes to + this extra effort.) However, this is really a very small corner case. The + investment to craft a clever, performant solution seems unworthwhile. (6) We often get the predicate associated with a constraint from its evidence with ctPred. We thus must not only make sure the generated CEqCan's fields @@ -2559,16 +2657,15 @@ , isReflCo rhs_co = return (setCtEvPredType old_ev new_pred) - | CtGiven { ctev_evar = old_evar } <- old_ev + | CtGiven (GivenCt { ctev_evar = old_evar }) <- old_ev = do { let new_tm = evCoercion ( mkSymCo lhs_co `mkTransCo` maybeSymCo swapped (mkCoVarCo old_evar) `mkTransCo` rhs_co) - ; newGivenEvVar loc (new_pred, new_tm) } + ; CtGiven <$> newGivenEvVar loc (new_pred, new_tm) } - | CtWanted { ctev_dest = dest - , ctev_rewriters = rewriters } <- old_ev - , let rewriters' = rewriters S.<> new_rewriters - = do { (new_ev, hole_co) <- newWantedEq loc rewriters' (ctEvRewriteRole old_ev) nlhs nrhs + | CtWanted (WantedCt { ctev_dest = dest, ctev_rewriters = rewriters }) <- old_ev + = do { let rewriters' = rewriters S.<> new_rewriters + ; (new_ev, hole_co) <- newWantedEq loc rewriters' (ctEvRewriteRole old_ev) nlhs nrhs ; let co = maybeSymCo swapped $ lhs_co `mkTransCo` hole_co `mkTransCo` mkSymCo rhs_co ; setWantedEq dest co @@ -2577,7 +2674,7 @@ , ppr nrhs , ppr co , ppr new_rewriters ]) - ; return new_ev } + ; return $ CtWanted new_ev } where new_pred = mkTcEqPredLikeEv old_ev nlhs nrhs @@ -2599,17 +2696,17 @@ Then we can simply solve g2 from g1, thus g2 := g1. Easy! But it's not so simple: -* If t is a type variable, the equalties might be oriented differently: +(CE1) If t is a type variable, the equalties might be oriented differently: e.g. (g1 :: a~b) and (g2 :: b~a) So we look both ways round. Hence the SwapFlag result to inertsCanDischarge. -* We can only do g2 := g1 if g1 can discharge g2; that depends on +(CE2) We can only do g2 := g1 if g1 can discharge g2; that depends on (a) the role and (b) the flavour. E.g. a representational equality cannot discharge a nominal one; a Wanted cannot discharge a Given. The predicate is eqCanRewriteFR. -* Visibility. Suppose S :: forall k. k -> Type, and consider unifying +(CE3) Visibility. Suppose S :: forall k. k -> Type, and consider unifying S @Type (a::Type) ~ S @(Type->Type) (b::Type->Type) From the first argument we get (Type ~ Type->Type); from the second argument we get (a ~ b) which in turn gives (Type ~ Type->Type). @@ -2624,13 +2721,31 @@ So when combining two otherwise-identical equalites, we want to keep the visible one, and discharge the invisible one. Hence the call to strictly_more_visible. + +(CE4) Suppose we have this set up (#25440): + Inert: [W] g1: F a ~ a Int (arising from (F a ~ a Int) + Work item: [W] g2: F alpha ~ F a (arising from (F alpha ~ F a) + We rewrite g2 with g1, to give + [W] g2{rw:g1} : F alpha ~ a Int + Now if F is injective we can get [W] alpha~a, and hence alpha:=a, and + we kick out g1. Now we have two constraints + [W] g1 : F a ~ a Int (arising from (F a ~ a Int) + [W] g2{rw:g1} : F a ~ a Int (arising from (F alpha ~ F a) + If we end up with g2 in the inert set (not g1) we'll get a very confusing + error message that we can solve (F a ~ a Int) + arising from F a ~ F a + + TL;DR: Better to hang on to `g1` (with no rewriters), in preference + to `g2` (which has a rewriter). + + See (WRW1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. -} tryInertEqs :: EqCt -> SolverStage () tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans - ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item + ; if | Just (ev_i, swapped) <- inertsEqsCanDischarge inerts work_item -> do { setEvBindIfWanted ev EvCanonical $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) @@ -2641,10 +2756,10 @@ | otherwise -> continueWith () } -inertsCanDischarge :: InertCans -> EqCt - -> Maybe ( CtEvidence -- The evidence for the inert - , SwapFlag ) -- Whether we need mkSymCo -inertsCanDischarge inerts (EqCt { eq_lhs = lhs_w, eq_rhs = rhs_w +inertsEqsCanDischarge :: InertCans -> EqCt + -> Maybe ( CtEvidence -- The evidence for the inert + , SwapFlag ) -- Whether we need mkSymCo +inertsEqsCanDischarge inerts (EqCt { eq_lhs = lhs_w, eq_rhs = rhs_w , eq_ev = ev_w, eq_eq_rel = eq_rel }) | (ev_i : _) <- [ ev_i | EqCt { eq_ev = ev_i, eq_rhs = rhs_i , eq_eq_rel = eq_rel } @@ -2669,25 +2784,31 @@ loc_w = ctEvLoc ev_w flav_w = ctEvFlavour ev_w fr_w = (flav_w, eq_rel) + empty_rw_w = isEmptyRewriterSet (ctEvRewriters ev_w) inert_beats_wanted ev_i eq_rel = -- eqCanRewriteFR: see second bullet of Note [Combining equalities] - -- strictly_more_visible: see last bullet of Note [Combining equalities] fr_i `eqCanRewriteFR` fr_w - && not ((loc_w `strictly_more_visible` ctEvLoc ev_i) - && (fr_w `eqCanRewriteFR` fr_i)) + && not (prefer_wanted ev_i && (fr_w `eqCanRewriteFR` fr_i)) where fr_i = (ctEvFlavour ev_i, eq_rel) - -- See Note [Combining equalities], final bullet + -- See (CE3) in Note [Combining equalities] strictly_more_visible loc1 loc2 = not (isVisibleOrigin (ctLocOrigin loc2)) && isVisibleOrigin (ctLocOrigin loc1) -inertsCanDischarge _ _ = Nothing + prefer_wanted ev_i + = (loc_w `strictly_more_visible` ctEvLoc ev_i) + -- strictly_more_visible: see (CE3) in Note [Combining equalities] + || (empty_rw_w && not (isEmptyRewriterSet (ctEvRewriters ev_i))) + -- Prefer the one that has no rewriters + -- See (CE4) in Note [Combining equalities] +inertsEqsCanDischarge _ _ = Nothing + {- Note [Do not unify Givens] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this GADT match @@ -2730,6 +2851,34 @@ See also #15144, which was caused by unifying a representational equality. +Note that it does however make sense to perform such unifications, as a last +resort, when doing top-level defaulting. +See Note [Defaulting representational equalities]. + +Note [Unify only if the rewriter set is empty] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + co (rewriters = {co1,co2}) :: alpha ~# blah +If we unify before solving `co1` and `co2` (which might well be insoluble) +we destroy the careful tracking of Note [Wanteds rewrite Wanteds] in +GHC.Tc.Types.Constraint. So we decline to unify any equality with a +non-empty rewriter set: see (REWRITERS) in Note [Unification preconditions] +in GHC.Tc.Utils. + +Wrinkles: + +(URW1) We may, however, be willing to /default/ such an equality; see + (DE6) in Note [Defaulting equalities] in GHC.Tc.Solver.Default. + +(URW2) If we have `co` in the inert set, and we solve `co1` and `co2`, + we should kick out `co` so that we can now unify it, which might + unlock other stuff. See `kickOutAfterFillingCoercionHole` in + GHC.Tc.Solver.Monad. + + However the solver prioritises equalities with an empty rewriter + set, to try to avoid unnecessary kick-out. See GHC.Tc.Types.Constraint + Note [Prioritise Wanteds with empty RewriterSet] esp (PER1) + Note [Solve by unification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we solve @@ -2808,7 +2957,7 @@ do { ev_binds_var <- getTcEvBindsVar ; ics <- getInertCans ; if isWanted ev -- Never look up Givens in quantified constraints - && not (null (inert_insts ics)) -- Shortcut common case + && not (null (inert_qcis ics)) -- Shortcut common case && not (isCoEvBindsVar ev_binds_var) -- See Note [Instances in no-evidence implications] then try_for_qci else continueWith () } @@ -2913,7 +3062,7 @@ When this was originally conceived, it was necessary to avoid a loop in T13135. That loop is now avoided by continuing with the kind equality (not the type -equality) in canEqCanLHSHetero (see Note [Equalities with incompatible kinds]). +equality) in canEqCanLHSHetero (see Note [Equalities with heterogeneous kinds]). However, the idea of working left-to-right still seems worthwhile, and so the calls to 'reverse' remain. @@ -2976,7 +3125,7 @@ -------------------- improveTopFunEqs :: TyCon -> [TcType] -> EqCt -> TcS Bool -- TyCon is definitely a type family --- See Note [FunDep and implicit parameter reactions] +-- See Note [FunDep and implicit parameter reactions] in GHC.Tc.Solver.Dict improveTopFunEqs fam_tc args (EqCt { eq_ev = ev, eq_rhs = rhs_ty }) | isGiven ev = improveGivenTopFunEqs fam_tc args ev rhs_ty | otherwise = improveWantedTopFunEqs fam_tc args ev rhs_ty @@ -3036,6 +3185,7 @@ improve_injective_wanted_top :: FamInstEnvs -> [Bool] -> TyCon -> [TcType] -> Xi -> TcS [TypeEqn] -- Interact with top-level instance declarations +-- See Section 5.2 in the Injective Type Families paper improve_injective_wanted_top fam_envs inj_args fam_tc lhs_tys rhs_ty = concatMapM do_one branches where @@ -3053,7 +3203,8 @@ do_one :: CoAxBranch -> TcS [TypeEqn] do_one branch@(CoAxBranch { cab_tvs = branch_tvs, cab_lhs = branch_lhs_tys, cab_rhs = branch_rhs }) | let in_scope1 = in_scope `extendInScopeSetList` branch_tvs - , Just subst <- tcUnifyTyWithTFs False in_scope1 branch_rhs rhs_ty + , Just subst <- tcUnifyTyForInjectivity False in_scope1 branch_rhs rhs_ty + -- False: matching, not unifying = do { let inSubst tv = tv `elemVarEnv` getTvSubstEnv subst unsubstTvs = filterOut inSubst branch_tvs -- The order of unsubstTvs is important; it must be @@ -3065,13 +3216,20 @@ -- be sure to apply the current substitution to a's kind. -- Hence instFlexiX. #13135 was an example. + ; traceTcS "improve_inj_top" $ + vcat [ text "branch_rhs" <+> ppr branch_rhs + , text "rhs_ty" <+> ppr rhs_ty + , text "subst" <+> ppr subst + , text "subst1" <+> ppr subst1 ] ; if apartnessCheck (substTys subst1 branch_lhs_tys) branch - then return (mkInjectivityEqns inj_args (map (substTy subst1) branch_lhs_tys) lhs_tys) + then do { traceTcS "improv_inj_top1" (ppr branch_lhs_tys) + ; return (mkInjectivityEqns inj_args (map (substTy subst1) branch_lhs_tys) lhs_tys) } -- NB: The fresh unification variables (from unsubstTvs) are on the left -- See Note [Improvement orientation] - else return [] } + else do { traceTcS "improve_inj_top2" empty; return [] } } | otherwise - = return [] + = do { traceTcS "improve_inj_top:fail" (ppr branch_rhs $$ ppr rhs_ty $$ ppr in_scope $$ ppr branch_tvs) + ; return [] } in_scope = mkInScopeSet (tyCoVarsOfType rhs_ty) @@ -3162,7 +3320,7 @@ -- the current work item with inert CFunEqs (boh Given and Wanted) -- E.g. x + y ~ z, x + y' ~ z => [W] y ~ y' -- --- See Note [FunDep and implicit parameter reactions] +-- See Note [FunDep and implicit parameter reactions] in GHC.Tc.Solver.Dict improveWantedLocalFunEqs funeqs_for_tc fam_tc args work_ev rhs | null improvement_eqns = return False diff --git a/GHC/Tc/Solver/InertSet.hs b/GHC/Tc/Solver/InertSet.hs --- a/GHC/Tc/Solver/InertSet.hs +++ b/GHC/Tc/Solver/InertSet.hs @@ -1,38 +1,36 @@ {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - module GHC.Tc.Solver.InertSet ( -- * The work list WorkList(..), isEmptyWorkList, emptyWorkList, extendWorkListNonEq, extendWorkListCt, extendWorkListCts, extendWorkListCtList, - extendWorkListEq, extendWorkListEqs, - appendWorkList, extendWorkListImplic, + extendWorkListEq, extendWorkListChildEqs, + extendWorkListRewrittenEqs, + appendWorkList, workListSize, - selectWorkItem, -- * The inert set InertSet(..), InertCans(..), - emptyInert, + emptyInertSet, emptyInertCans, - noMatchableGivenDicts, noGivenNewtypeReprEqs, updGivenEqs, - mightEqualLater, prohibitedSuperClassSolve, -- * Inert equalities InertEqs, foldTyEqs, delEq, findEq, partitionInertEqs, partitionFunEqs, + filterInertEqs, filterFunEqs, foldFunEqs, addEqToCans, -- * Inert Dicts updDicts, delDict, addDict, filterDicts, partitionDicts, - addSolvedDict, + addSolvedDict, lookupSolvedDict, lookupInertDict, -- * Inert Irreds InertIrreds, delIrred, addIrreds, addIrred, foldIrreds, @@ -63,28 +61,23 @@ import GHC.Types.Var import GHC.Types.Var.Env import GHC.Types.Var.Set +import GHC.Types.Unique( hasKey ) import GHC.Types.Basic( SwapFlag(..) ) import GHC.Core.Reduction import GHC.Core.Predicate -import GHC.Core.TyCo.FVs import qualified GHC.Core.TyCo.Rep as Rep -import GHC.Core.Class( Class ) import GHC.Core.TyCon -import GHC.Core.Class( classTyCon ) -import GHC.Core.Unify - +import GHC.Core.Class( Class, classTyCon ) +import GHC.Builtin.Names( eqPrimTyConKey, heqTyConKey, eqTyConKey, coercibleTyConKey ) import GHC.Utils.Misc ( partitionWith ) import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Data.Maybe import GHC.Data.Bag -import Data.List.NonEmpty ( NonEmpty(..), (<|) ) -import qualified Data.List.NonEmpty as NE -import Data.Function ( on ) - import Control.Monad ( forM_ ) +import Data.List.NonEmpty ( NonEmpty(..), (<|) ) +import Data.Function ( on ) {- ************************************************************************ @@ -161,53 +154,47 @@ NB: since we do not currently apply the substitution to the inert_solved_dicts, the knot-tying still seems a bit fragile. But this makes it better. - -Note [Residual implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The wl_implics in the WorkList are the residual implication -constraints that are generated while solving or canonicalising the -current worklist. Specifically, when canonicalising - (forall a. t1 ~ forall a. t2) -from which we get the implication - (forall a. t1 ~ t2) -See GHC.Tc.Solver.Monad.deferTcSForAllEq - -} -- See Note [WorkList priorities] data WorkList = WL { wl_eqs_N :: [Ct] -- /Nominal/ equalities (s ~#N t), (s ~ t), (s ~~ t) - -- with empty rewriter set + -- with definitely-empty rewriter set + , wl_eqs_X :: [Ct] -- CEqCan, CDictCan, CIrredCan - -- with empty rewriter set + -- with definitely-empty rewriter set -- All other equalities: contains both equality constraints and -- their class-level variants (a~b) and (a~~b); -- See Note [Prioritise equalities] -- See Note [Prioritise class equalities] - , wl_rw_eqs :: [Ct] -- Like wl_eqs, but ones that have a non-empty - -- rewriter set; or, more precisely, did when - -- added to the WorkList + , wl_rw_eqs :: [Ct] -- Like wl_eqs, but ones that may have a non-empty + -- rewriter set -- We prioritise wl_eqs over wl_rw_eqs; -- see Note [Prioritise Wanteds with empty RewriterSet] -- in GHC.Tc.Types.Constraint for more details. , wl_rest :: [Ct] - - , wl_implics :: Bag Implication -- See Note [Residual implications] } +isNominalEqualityCt :: Ct -> Bool +-- A nominal equality, primitive or not, +-- canonical or not +-- (s ~# t), (s ~ t), or (s ~~ t) +isNominalEqualityCt ct + | Just tc <- tcTyConAppTyCon_maybe (ctPred ct) + = tc `hasKey` eqPrimTyConKey || tc `hasKey` heqTyConKey || tc `hasKey` eqTyConKey + | otherwise + = False + appendWorkList :: WorkList -> WorkList -> WorkList appendWorkList - (WL { wl_eqs_N = eqs1_N, wl_eqs_X = eqs1_X, wl_rw_eqs = rw_eqs1 - , wl_rest = rest1, wl_implics = implics1 }) - (WL { wl_eqs_N = eqs2_N, wl_eqs_X = eqs2_X, wl_rw_eqs = rw_eqs2 - , wl_rest = rest2, wl_implics = implics2 }) + (WL { wl_eqs_N = eqs1_N, wl_eqs_X = eqs1_X, wl_rw_eqs = rw_eqs1, wl_rest = rest1 }) + (WL { wl_eqs_N = eqs2_N, wl_eqs_X = eqs2_X, wl_rw_eqs = rw_eqs2, wl_rest = rest2 }) = WL { wl_eqs_N = eqs1_N ++ eqs2_N , wl_eqs_X = eqs1_X ++ eqs2_X , wl_rw_eqs = rw_eqs1 ++ rw_eqs2 - , wl_rest = rest1 ++ rest2 - , wl_implics = implics1 `unionBags` implics2 } + , wl_rest = rest1 ++ rest2 } workListSize :: WorkList -> Int workListSize (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs, wl_rest = rest }) @@ -219,26 +206,28 @@ | isEmptyRewriterSet rewriters -- A wanted that has not been rewritten -- isEmptyRewriterSet: see Note [Prioritise Wanteds with empty RewriterSet] -- in GHC.Tc.Types.Constraint - = if isNomEqPred (ctPred ct) + = if isNominalEqualityCt ct then wl { wl_eqs_N = ct : eqs_N } else wl { wl_eqs_X = ct : eqs_X } | otherwise = wl { wl_rw_eqs = ct : rw_eqs } -extendWorkListEqs :: RewriterSet -> Bag Ct -> WorkList -> WorkList +extendWorkListChildEqs :: CtEvidence -> Bag Ct -> WorkList -> WorkList -- Add [eq1,...,eqn] to the work-list --- They all have the same rewriter set -- The constraints will be solved in left-to-right order: -- see Note [Work-list ordering] in GHC.Tc.Solver.Equality -- +-- Precondition: if the parent constraint has an empty +-- rewriter set, so will the new equalities -- Precondition: new_eqs is non-empty -extendWorkListEqs rewriters new_eqs +extendWorkListChildEqs parent_ev new_eqs wl@(WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs }) - | isEmptyRewriterSet rewriters + | isEmptyRewriterSet (ctEvRewriters parent_ev) -- isEmptyRewriterSet: see Note [Prioritise Wanteds with empty RewriterSet] -- in GHC.Tc.Types.Constraint - = case partitionBag is_nominal new_eqs of + -- If the rewriter set is empty, add to wl_eqs_X and wl_eqs_N + = case partitionBag isNominalEqualityCt new_eqs of (new_eqs_N, new_eqs_X) | isEmptyBag new_eqs_N -> wl { wl_eqs_X = new_eqs_X `push_on_front` eqs_X } | isEmptyBag new_eqs_X -> wl { wl_eqs_N = new_eqs_N `push_on_front` eqs_N } @@ -247,22 +236,22 @@ -- These isEmptyBag tests are just trying -- to avoid creating unnecessary thunks - | otherwise + | otherwise -- If the rewriter set is non-empty, add to wl_rw_eqs = wl { wl_rw_eqs = new_eqs `push_on_front` rw_eqs } where push_on_front :: Bag Ct -> [Ct] -> [Ct] - -- push_on_front puts the new equlities on the front of the queue + -- push_on_front puts the new equalities on the front of the queue push_on_front new_eqs eqs = foldr (:) eqs new_eqs - is_nominal ct = isNomEqPred (ctPred ct) +extendWorkListRewrittenEqs :: [EqCt] -> WorkList -> WorkList +-- Don't bother checking the RewriterSet: just pop them into wl_rw_eqs +extendWorkListRewrittenEqs new_eqs wl@(WL { wl_rw_eqs = rw_eqs }) + = wl { wl_rw_eqs = foldr ((:) . CEqCan) rw_eqs new_eqs } extendWorkListNonEq :: Ct -> WorkList -> WorkList -- Extension by non equality extendWorkListNonEq ct wl = wl { wl_rest = ct : wl_rest wl } -extendWorkListImplic :: Implication -> WorkList -> WorkList -extendWorkListImplic implic wl = wl { wl_implics = implic `consBag` wl_implics wl } - extendWorkListCt :: Ct -> WorkList -> WorkList -- Agnostic about what kind of constraint extendWorkListCt ct wl @@ -287,27 +276,17 @@ isEmptyWorkList :: WorkList -> Bool isEmptyWorkList (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X - , wl_rest = rest, wl_implics = implics }) - = null eqs_N && null eqs_X && null rest && isEmptyBag implics + , wl_rw_eqs = rw_eqs, wl_rest = rest }) + = null eqs_N && null eqs_X && null rw_eqs && null rest emptyWorkList :: WorkList emptyWorkList = WL { wl_eqs_N = [], wl_eqs_X = [] - , wl_rw_eqs = [], wl_rest = [], wl_implics = emptyBag } - -selectWorkItem :: WorkList -> Maybe (Ct, WorkList) --- See Note [Prioritise equalities] -selectWorkItem wl@(WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X - , wl_rw_eqs = rw_eqs, wl_rest = rest }) - | ct:cts <- eqs_N = Just (ct, wl { wl_eqs_N = cts }) - | ct:cts <- eqs_X = Just (ct, wl { wl_eqs_X = cts }) - | ct:cts <- rw_eqs = Just (ct, wl { wl_rw_eqs = cts }) - | ct:cts <- rest = Just (ct, wl { wl_rest = cts }) - | otherwise = Nothing + , wl_rw_eqs = [], wl_rest = [] } -- Pretty printing instance Outputable WorkList where - ppr (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X, wl_rw_eqs = rw_eqs - , wl_rest = rest, wl_implics = implics }) + ppr (WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X + , wl_rw_eqs = rw_eqs, wl_rest = rest }) = text "WL" <+> (braces $ vcat [ ppUnless (null eqs_N) $ text "Eqs_N =" <+> vcat (map ppr eqs_N) @@ -317,9 +296,6 @@ text "RwEqs =" <+> vcat (map ppr rw_eqs) , ppUnless (null rest) $ text "Non-eqs =" <+> vcat (map ppr rest) - , ppUnless (isEmptyBag implics) $ - ifPprDebug (text "Implics =" <+> vcat (map ppr (bagToList implics))) - (text "(Implics omitted)") ]) {- ********************************************************************* @@ -344,6 +320,10 @@ -- Canonical Given, Wanted -- Sometimes called "the inert set" + , inert_givens :: InertCans + -- A subset of inert_cans, containing only Givens + -- Used to initialise inert_cans when recursing inside implications + , inert_cycle_breakers :: CycleBreakerVarStack , inert_famapp_cache :: FunEqMap Reduction @@ -361,35 +341,49 @@ -- Always a dictionary solved by an instance decl; never an implict parameter -- See Note [Solved dictionaries] -- and Note [Do not add superclasses of solved dictionaries] + + , inert_safehask :: DictMap DictCt + -- Failed dictionary resolution due to Safe Haskell overlapping + -- instances restriction. We keep this separate from inert_dicts + -- as it doesn't cause compilation failure, just safe inference + -- failure. + -- + -- ^ See Note [Safe Haskell Overlapping Instances Implementation] + -- in GHC.Tc.Solver } instance Outputable InertSet where ppr (IS { inert_cans = ics + , inert_safehask = safehask , inert_solved_dicts = solved_dicts }) = vcat [ ppr ics , ppUnless (null dicts) $ - text "Solved dicts =" <+> vcat (map ppr dicts) ] + text "Solved dicts =" <+> vcat (map ppr dicts) + , ppUnless (isEmptyTcAppMap safehask) $ + text "Safe Haskell unsafe overlap =" <+> pprBag (dictsToBag safehask) ] where dicts = bagToList (dictsToBag solved_dicts) -emptyInertCans :: InertCans -emptyInertCans +emptyInertCans :: TcLevel -> InertCans +emptyInertCans given_eq_lvl = IC { inert_eqs = emptyTyEqs , inert_funeqs = emptyFunEqs - , inert_given_eq_lvl = topTcLevel + , inert_given_eq_lvl = given_eq_lvl , inert_given_eqs = False , inert_dicts = emptyDictMap - , inert_safehask = emptyDictMap - , inert_insts = [] + , inert_qcis = [] , inert_irreds = emptyBag } -emptyInert :: InertSet -emptyInert - = IS { inert_cans = emptyInertCans +emptyInertSet :: TcLevel -> InertSet +emptyInertSet given_eq_lvl + = IS { inert_cans = empty_cans + , inert_givens = empty_cans , inert_cycle_breakers = emptyBag :| [] , inert_famapp_cache = emptyFunEqs - , inert_solved_dicts = emptyDictMap } - + , inert_solved_dicts = emptyDictMap + , inert_safehask = emptyDictMap } + where + empty_cans = emptyInertCans given_eq_lvl {- Note [Solved dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -677,6 +671,23 @@ imply nominal ones. For example, if (G a ~R G b) and G's argument's role is nominal, then we can deduce a ~N b. +(TGE6) A subtle point is this: when initialising the solver, giving it + an empty InertSet, we must conservatively initialise `inert_given_lvl` + to the /current/ TcLevel. This matters when doing let-generalisation. + Consider #26004: + f w e = case e of + T1 -> let y = not w in False -- T1 is a GADT + T2 -> True + When let-generalising `y`, we will have (w :: alpha[1]) in the type + envt; and we are under GADT pattern match. So when we solve the + constraints from y's RHS, in simplifyInfer, we must NOT unify + alpha[1] := Bool + Since we don't know what enclosing equalities there are, we just + conservatively assume that there are some. + + This initialisation in done in `runTcSWithEvBinds`, which passes + the current TcLevel to `emptyInertSet`. + Historical note: prior to #24938 we also ignored Given equalities that did not mention an "outer" type variable. But that is wrong, as #24938 showed. Another example is immortalised in test LocalGivenEqs2 @@ -1237,16 +1248,8 @@ -- All fully rewritten (modulo flavour constraints) -- wrt inert_eqs - , inert_insts :: [QCInst] - - , inert_safehask :: DictMap DictCt - -- Failed dictionary resolution due to Safe Haskell overlapping - -- instances restriction. We keep this separate from inert_dicts - -- as it doesn't cause compilation failure, just safe inference - -- failure. - -- - -- ^ See Note [Safe Haskell Overlapping Instances Implementation] - -- in GHC.Tc.Solver + , inert_qcis :: [QCInst] -- See Note [Quantified constraints] + -- in GHC.Tc.Solver.Solve , inert_irreds :: InertIrreds -- Irreducible predicates that cannot be made canonical, @@ -1275,11 +1278,10 @@ ppr (IC { inert_eqs = eqs , inert_funeqs = funeqs , inert_dicts = dicts - , inert_safehask = safehask , inert_irreds = irreds , inert_given_eq_lvl = ge_lvl , inert_given_eqs = given_eqs - , inert_insts = insts }) + , inert_qcis = insts }) = braces $ vcat [ ppUnless (isEmptyDVarEnv eqs) $ @@ -1290,8 +1292,6 @@ <+> pprBag (foldFunEqs consBag funeqs emptyBag) , ppUnless (isEmptyTcAppMap dicts) $ text "Dictionaries =" <+> pprBag (dictsToBag dicts) - , ppUnless (isEmptyTcAppMap safehask) $ - text "Safe Haskell unsafe overlap =" <+> pprBag (dictsToBag safehask) , ppUnless (isEmptyBag irreds) $ text "Irreds =" <+> pprBag irreds , ppUnless (null insts) $ @@ -1377,6 +1377,17 @@ addInertEqs eq_ct@(EqCt { eq_lhs = TyVarLHS tv }) eqs = addTyEq eqs tv eq_ct addInertEqs other _ = pprPanic "extendInertEqs" (ppr other) +-- | Filter InertEqs according to a predicate +filterInertEqs :: (EqCt -> Bool) -> InertEqs -> InertEqs +filterInertEqs f = mapMaybeDVarEnv g + where + g xs = + let filtered = filter f xs + in + if null filtered + then Nothing + else Just filtered + ------------------------ addCanFunEq :: InertFunEqs -> TyCon -> [TcType] -> EqCt -> InertFunEqs @@ -1400,7 +1411,16 @@ = addCanFunEq fun_eqs tc args eq_ct addFunEqs other _ = pprPanic "extendFunEqs" (ppr other) - +-- | Filter entries in InertFunEqs that satisfy the predicate +filterFunEqs :: (EqCt -> Bool) -> InertFunEqs -> InertFunEqs +filterFunEqs f = mapMaybeTcAppMap g + where + g xs = + let filtered = filter f xs + in + if null filtered + then Nothing + else Just filtered {- ********************************************************************* * * @@ -1408,6 +1428,17 @@ * * ********************************************************************* -} +-- | Look up a dictionary inert. +lookupInertDict :: InertCans -> Class -> [Type] -> Maybe DictCt +lookupInertDict (IC { inert_dicts = dicts }) cls tys + = findDict dicts cls tys + +-- | Look up a solved inert. +lookupSolvedDict :: InertSet -> Class -> [Type] -> Maybe CtEvidence +-- Returns just if exactly this predicate type exists in the solved. +lookupSolvedDict (IS { inert_solved_dicts = solved }) cls tys + = fmap dictCtEvidence (findDict solved cls tys) + updDicts :: (DictMap DictCt -> DictMap DictCt) -> InertCans -> InertCans updDicts upd ics = ics { inert_dicts = upd (inert_dicts ics) } @@ -1574,19 +1605,18 @@ kickOutRewritableLHS :: KickOutSpec -> CtFlavourRole -> InertCans -> (Cts, InertCans) -- See Note [kickOutRewritable] kickOutRewritableLHS ko_spec new_fr@(_, new_role) - ics@(IC { inert_eqs = tv_eqs - , inert_dicts = dictmap - , inert_funeqs = funeqmap - , inert_irreds = irreds - , inert_insts = old_insts }) + ics@(IC { inert_eqs = tv_eqs + , inert_dicts = dictmap + , inert_funeqs = funeqmap + , inert_irreds = irreds + , inert_qcis = old_insts }) = (kicked_out, inert_cans_in) where - -- inert_safehask stays unchanged; is that right? - inert_cans_in = ics { inert_eqs = tv_eqs_in - , inert_dicts = dicts_in - , inert_funeqs = feqs_in - , inert_irreds = irs_in - , inert_insts = insts_in } + inert_cans_in = ics { inert_eqs = tv_eqs_in + , inert_dicts = dicts_in + , inert_funeqs = feqs_in + , inert_irreds = irs_in + , inert_qcis = insts_in } kicked_out :: Cts kicked_out = (fmap CDictCan dicts_out `andCts` fmap CIrredCan irs_out) @@ -1824,114 +1854,36 @@ | otherwise = False -- Coercion variables; doesn't much matter noGivenNewtypeReprEqs :: TyCon -> InertSet -> Bool --- True <=> there is no Irred looking like (N tys1 ~ N tys2) --- See Note [Decomposing newtype equalities] (EX2) in GHC.Tc.Solver.Equality --- This is the only call site. -noGivenNewtypeReprEqs tc inerts - = not (anyBag might_help (inert_irreds (inert_cans inerts))) - where - might_help irred - = case classifyPredType (ctEvPred (irredCtEvidence irred)) of - EqPred ReprEq t1 t2 - | Just (tc1,_) <- tcSplitTyConApp_maybe t1 - , tc == tc1 - , Just (tc2,_) <- tcSplitTyConApp_maybe t2 - , tc == tc2 - -> True - _ -> False - --- | Returns True iff there are no Given constraints that might, --- potentially, match the given class constraint. This is used when checking to see if a --- Given might overlap with an instance. See Note [Instance and Given overlap] --- in GHC.Tc.Solver.Dict -noMatchableGivenDicts :: InertSet -> CtLoc -> Class -> [TcType] -> Bool -noMatchableGivenDicts inerts@(IS { inert_cans = inert_cans }) loc_w clas tys - = not $ anyBag matchable_given $ - findDictsByClass (inert_dicts inert_cans) clas +-- True <=> there is no Given looking like (N tys1 ~ N tys2) +-- See Note [Decomposing newtype equalities] (EX3) in GHC.Tc.Solver.Equality +noGivenNewtypeReprEqs tc (IS { inert_cans = inerts }) + | IC { inert_irreds = irreds, inert_qcis = quant_cts } <- inerts + = not (anyBag might_help_irred irreds || any might_help_qc quant_cts) + -- Look in both inert_irreds /and/ inert_qcis (#26020) where - pred_w = mkClassPred clas tys - - matchable_given :: DictCt -> Bool - matchable_given (DictCt { di_ev = ev }) - | CtGiven { ctev_loc = loc_g, ctev_pred = pred_g } <- ev - = isJust $ mightEqualLater inerts pred_g loc_g pred_w loc_w - + might_help_irred (IrredCt { ir_ev = ev }) + | EqPred ReprEq t1 t2 <- classifyPredType (ctEvPred ev) + = headed_by_tc t1 t2 | otherwise = False -mightEqualLater :: InertSet -> TcPredType -> CtLoc -> TcPredType -> CtLoc -> Maybe Subst --- See Note [What might equal later?] --- Used to implement logic in Note [Instance and Given overlap] in GHC.Tc.Solver.Dict -mightEqualLater inert_set given_pred given_loc wanted_pred wanted_loc - | prohibitedSuperClassSolve given_loc wanted_loc - = Nothing - - | otherwise - = case tcUnifyTysFG bind_fun [flattened_given] [flattened_wanted] of - Unifiable subst - -> Just subst - MaybeApart reason subst - | MARInfinite <- reason -- see Example 7 in the Note. - -> Nothing - | otherwise - -> Just subst - SurelyApart -> Nothing - - where - in_scope = mkInScopeSet $ tyCoVarsOfTypes [given_pred, wanted_pred] - - -- NB: flatten both at the same time, so that we can share mappings - -- from type family applications to variables, and also to guarantee - -- that the fresh variables are really fresh between the given and - -- the wanted. Flattening both at the same time is needed to get - -- Example 10 from the Note. - ([flattened_given, flattened_wanted], var_mapping) - = flattenTysX in_scope [given_pred, wanted_pred] - - bind_fun :: BindFun - bind_fun tv rhs_ty - | isMetaTyVar tv - , can_unify tv (metaTyVarInfo tv) rhs_ty - -- this checks for CycleBreakerTvs and TyVarTvs; forgetting - -- the latter was #19106. - = BindMe - - -- See Examples 4, 5, and 6 from the Note - | Just (_fam_tc, fam_args) <- lookupVarEnv var_mapping tv - , anyFreeVarsOfTypes mentions_meta_ty_var fam_args - = BindMe - + might_help_qc (QCI { qci_ev = ev, qci_body = pred }) + | isGiven ev + , ClassPred cls [_, t1, t2] <- classifyPredType pred + , cls `hasKey` coercibleTyConKey + = headed_by_tc t1 t2 | otherwise - = Apart + = False - -- True for TauTv and TyVarTv (and RuntimeUnkTv) meta-tyvars - -- (as they can be unified) - -- and also for CycleBreakerTvs that mentions meta-tyvars - mentions_meta_ty_var :: TyVar -> Bool - mentions_meta_ty_var tv - | isMetaTyVar tv - = case metaTyVarInfo tv of - -- See Examples 8 and 9 in the Note - CycleBreakerTv - -> anyFreeVarsOfType mentions_meta_ty_var - (lookupCycleBreakerVar tv inert_set) - _ -> True + headed_by_tc t1 t2 + | Just (tc1,_) <- tcSplitTyConApp_maybe t1 + , tc == tc1 + , Just (tc2,_) <- tcSplitTyConApp_maybe t2 + , tc == tc2 + = True | otherwise = False - -- Like checkTopShape, but allows cbv variables to unify - can_unify :: TcTyVar -> MetaInfo -> Type -> Bool - can_unify _lhs_tv TyVarTv rhs_ty -- see Example 3 from the Note - | Just rhs_tv <- getTyVar_maybe rhs_ty - = case tcTyVarDetails rhs_tv of - MetaTv { mtv_info = TyVarTv } -> True - MetaTv {} -> False -- Could unify with anything - SkolemTv {} -> True - RuntimeUnk -> True - | otherwise -- not a var on the RHS - = False - can_unify lhs_tv _other _rhs_ty = mentions_meta_ty_var lhs_tv - -- | Is it (potentially) loopy to use the first @ct1@ to solve @ct2@? -- -- Necessary (but not sufficient) conditions for this function to return @True@: @@ -1953,155 +1905,13 @@ | otherwise = False -{- Note [What might equal later?] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We must determine whether a Given might later equal a Wanted. We -definitely need to account for the possibility that any metavariable -might be arbitrarily instantiated. Yet we do *not* want -to allow skolems in to be instantiated, as we've already rewritten -with respect to any Givens. (We're solving a Wanted here, and so -all Givens have already been processed.) -This is best understood by example. - -1. C alpha ~? C Int - - That given certainly might match later. - -2. C a ~? C Int - - No. No new givens are going to arise that will get the `a` to rewrite - to Int. - -3. C alpha[tv] ~? C Int - - That alpha[tv] is a TyVarTv, unifiable only with other type variables. - It cannot equal later. - -4. C (F alpha) ~? C Int - - Sure -- that can equal later, if we learn something useful about alpha. - -5. C (F alpha[tv]) ~? C Int - - This, too, might equal later. Perhaps we have [G] F b ~ Int elsewhere. - Or maybe we have C (F alpha[tv] beta[tv]), these unify with each other, - and F x x = Int. Remember: returning True doesn't commit ourselves to - anything. - -6. C (F a) ~? C a - - No, this won't match later. If we could rewrite (F a) or a, we would - have by now. But see also Red Herring below. - -7. C (Maybe alpha) ~? C alpha - - We say this cannot equal later, because it would require - alpha := Maybe (Maybe (Maybe ...)). While such a type can be contrived, - we choose not to worry about it. See Note [Infinitary substitution in lookup] - in GHC.Core.InstEnv. Getting this wrong let to #19107, tested in - typecheck/should_compile/T19107. - -8. C cbv ~? C Int - where cbv = F a - - The cbv is a cycle-breaker var which stands for F a. See - Note [Type equality cycles] in GHC.Tc.Solver.Equality - This is just like case 6, and we say "no". Saying "no" here is - essential in getting the parser to type-check, with its use of DisambECP. - -9. C cbv ~? C Int - where cbv = F alpha - - Here, we might indeed equal later. Distinguishing between - this case and Example 8 is why we need the InertSet in mightEqualLater. - -10. C (F alpha, Int) ~? C (Bool, F alpha) - - This cannot equal later, because F a would have to equal both Bool and - Int. - -To deal with type family applications, we use the Core flattener. See -Note [Flattening type-family applications when matching instances] in GHC.Core.Unify. -The Core flattener replaces all type family applications with -fresh variables. The next question: should we allow these fresh -variables in the domain of a unifying substitution? - -A type family application that mentions only skolems (example 6) is settled: -any skolems would have been rewritten w.r.t. Givens by now. These type family -applications match only themselves. A type family application that mentions -metavariables, on the other hand, can match anything. So, if the original type -family application contains a metavariable, we use BindMe to tell the unifier -to allow it in the substitution. On the other hand, a type family application -with only skolems is considered rigid. - -This treatment fixes #18910 and is tested in -typecheck/should_compile/InstanceGivenOverlap{,2} - -Red Herring -~~~~~~~~~~~ -In #21208, we have this scenario: - -instance forall b. C b -[G] C a[sk] -[W] C (F a[sk]) - -What should we do with that wanted? According to the logic above, the Given -cannot match later (this is example 6), and so we use the global instance. -But wait, you say: What if we learn later (say by a future type instance F a = a) -that F a unifies with a? That looks like the Given might really match later! - -This mechanism described in this Note is *not* about this kind of situation, however. -It is all asking whether a Given might match the Wanted *in this run of the solver*. -It is *not* about whether a variable might be instantiated so that the Given matches, -or whether a type instance introduced in a downstream module might make the Given match. -The reason we care about what might match later is only about avoiding order-dependence. -That is, we don't want to commit to a course of action that depends on seeing constraints -in a certain order. But an instantiation of a variable and a later type instance -don't introduce order dependency in this way, and so mightMatchLater is right to ignore -these possibilities. - -Here is an example, with no type families, that is perhaps clearer: - -instance forall b. C (Maybe b) -[G] C (Maybe Int) -[W] C (Maybe a) - -What to do? We *might* say that the Given could match later and should thus block -us from using the global instance. But we don't do this. Instead, we rely on class -coherence to say that choosing the global instance is just fine, even if later we -call a function with (a := Int). After all, in this run of the solver, [G] C (Maybe Int) -will definitely never match [W] C (Maybe a). (Recall that we process Givens before -Wanteds, so there is no [G] a ~ Int hanging about unseen.) - -Interestingly, in the first case (from #21208), the behavior changed between -GHC 8.10.7 and GHC 9.2, with the latter behaving correctly and the former -reporting overlapping instances. - -Test case: typecheck/should_compile/T21208. - --} - {- ********************************************************************* * * Cycle breakers * * ********************************************************************* -} --- | Return the type family application a CycleBreakerTv maps to. -lookupCycleBreakerVar :: TcTyVar -- ^ cbv, must be a CycleBreakerTv - -> InertSet - -> TcType -- ^ type family application the cbv maps to -lookupCycleBreakerVar cbv (IS { inert_cycle_breakers = cbvs_stack }) --- This function looks at every environment in the stack. This is necessary --- to avoid #20231. This function (and its one usage site) is the only reason --- that we store a stack instead of just the top environment. - | Just tyfam_app <- assert (isCycleBreakerTyVar cbv) $ - firstJusts (NE.map (lookupBag cbv) cbvs_stack) - = tyfam_app - | otherwise - = pprPanic "lookupCycleBreakerVar found an unbound cycle breaker" (ppr cbv $$ ppr cbvs_stack) - -- | Push a fresh environment onto the cycle-breaker var stack. Useful -- when entering a nested implication. pushCycleBreakerVarStack :: CycleBreakerVarStack -> CycleBreakerVarStack @@ -2151,45 +1961,55 @@ -- We can always solve one from the other: even if both are wanted, -- although we don't rewrite wanteds with wanteds, we can combine -- two wanteds into one by solving one from the other +-- +-- Compare the corresponding function for equalities: +-- GHC.Tc.Solver.Equality.inertEqsCanDischarge solveOneFromTheOther ct_i ct_w - | CtWanted { ctev_loc = loc_w } <- ev_w + | CtWanted {} <- ev_w , prohibitedSuperClassSolve loc_i loc_w -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance = -- Inert must be Given KeepWork - | CtWanted {} <- ev_w + | CtWanted (WantedCt { ctev_rewriters = rw_w }) <- ev_w = -- Inert is Given or Wanted case ev_i of CtGiven {} -> KeepInert -- work is Wanted; inert is Given: easy choice. - CtWanted {} -- Both are Wanted + CtWanted (WantedCt { ctev_rewriters = rw_i }) -- Both are Wanted -- If only one has no pending superclasses, use it -- Otherwise we can get infinite superclass expansion (#22516) -- in silly cases like class C T b => C a b where ... - | not is_psc_i, is_psc_w -> KeepInert - | is_psc_i, not is_psc_w -> KeepWork + | Just res <- better (not is_psc_i) (not is_psc_w) + -> res + -- If only one has an empty rewriter set, use it + -- c.f. GHC.Tc.Solver.Equality.inertsCanDischarge, and especially + -- (CE4) in Note [Combining equalities] + | Just res <- better (isEmptyRewriterSet rw_i) (isEmptyRewriterSet rw_w) + -> res + -- If only one is a WantedSuperclassOrigin (arising from expanding -- a Wanted class constraint), keep the other: wanted superclasses -- may be unexpected by users - | not is_wsc_orig_i, is_wsc_orig_w -> KeepInert - | is_wsc_orig_i, not is_wsc_orig_w -> KeepWork + | Just res <- better (not is_wsc_orig_i) (not is_wsc_orig_w) + -> res - -- otherwise, just choose the lower span + -- Otherwise, just choose the lower span -- reason: if we have something like (abs 1) (where the -- Num constraint cannot be satisfied), it's better to -- get an error about abs than about 1. -- This test might become more elaborate if we see an -- opportunity to improve the error messages | ((<) `on` ctLocSpan) loc_i loc_w -> KeepInert + | otherwise -> KeepWork -- From here on the work-item is Given - | CtWanted { ctev_loc = loc_i } <- ev_i + | CtWanted {} <- ev_i , prohibitedSuperClassSolve loc_w loc_i = KeepInert -- Just discard the un-usable Given -- This never actually happens because @@ -2207,6 +2027,15 @@ | otherwise -- Both are Given, levels differ = different_level_strategy where + better :: Bool -> Bool -> Maybe InteractResult + -- (better inert-is-good wanted-is-good) returns + -- Just KeepWork if wanted is strictly better than inert + -- Just KeepInert if inert is strictly better than wanted + -- Nothing if they are the same + better True False = Just KeepInert + better False True = Just KeepWork + better _ _ = Nothing + ev_i = ctEvidence ct_i ev_w = ctEvidence ct_w @@ -2226,10 +2055,10 @@ is_wsc_orig_w = isWantedSuperclassOrigin orig_w different_level_strategy -- Both Given - | isIPLikePred pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork + | couldBeIPLike pred = if lvl_w `strictlyDeeperThan` lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w `strictlyDeeperThan` lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] part (1) - -- For the isIPLikePred case see Note [Shadowing of implicit parameters] + -- For the couldBeIPLike case see Note [Shadowing of implicit parameters] -- in GHC.Tc.Solver.Dict same_level_strategy -- Both Given @@ -2275,18 +2104,8 @@ (a) If both are GivenSCOrigin, choose the one that is unblocked if possible according to Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. - (b) Prefer constraints that are not superclass selections. Example: - - f :: (Eq a, Ord a) => a -> Bool - f x = x == x - - Eager superclass expansion gives us two [G] Eq a constraints. We - want to keep the one from the user-written Eq a, not the superclass - selection. This means we report the Ord a as redundant with - -Wredundant-constraints, not the Eq a. - - Getting this wrong was #20602. See also - Note [Tracking redundant constraints] in GHC.Tc.Solver. + (b) Prefer constraints that are not superclass selections. See + (TRC3) in Note [Tracking redundant constraints] in GHC.Tc.Solver. (c) If both are GivenSCOrigin, chooose the one with the shallower superclass-selection depth, in the hope of identifying more correct @@ -2320,3 +2139,4 @@ (Actually I think that the order in which the work-list is processed means that this chain of events won't happen, but that's very fragile.) -} + diff --git a/GHC/Tc/Solver/Irred.hs b/GHC/Tc/Solver/Irred.hs --- a/GHC/Tc/Solver/Irred.hs +++ b/GHC/Tc/Solver/Irred.hs @@ -39,10 +39,6 @@ ; simpleStage (updInertIrreds irred) ; stopWithStage (irredCtEvidence irred) "Kept inert IrredCt" } -updInertIrreds :: IrredCt -> TcS () -updInertIrreds irred - = do { tc_lvl <- getTcLevel - ; updInertCans $ addIrredToCans tc_lvl irred } {- ********************************************************************* * * diff --git a/GHC/Tc/Solver/Monad.hs b/GHC/Tc/Solver/Monad.hs --- a/GHC/Tc/Solver/Monad.hs +++ b/GHC/Tc/Solver/Monad.hs @@ -1,2386 +1,2420 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - --- | Monadic definitions for the constraint solver -module GHC.Tc.Solver.Monad ( - - -- The TcS monad - TcS, runTcS, runTcSEarlyAbort, runTcSWithEvBinds, runTcSInerts, - failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, - runTcSEqualities, - nestTcS, nestImplicTcS, setEvBindsTcS, - emitImplicationTcS, emitTvImplicationTcS, - emitFunDepWanteds, - - selectNextWorkItem, - getWorkList, - updWorkListTcS, - pushLevelNoWorkList, - - runTcPluginTcS, recordUsedGREs, - matchGlobalInst, TcM.ClsInstResult(..), - - QCInst(..), - - -- The pipeline - StopOrContinue(..), continueWith, stopWith, - startAgainWith, SolverStage(Stage, runSolverStage), simpleStage, - stopWithStage, nopStage, - - -- Tracing etc - panicTcS, traceTcS, tryEarlyAbortTcS, - traceFireTcS, bumpStepCountTcS, csTraceTcS, - wrapErrTcS, wrapWarnTcS, - resetUnificationFlag, setUnificationFlag, - - -- Evidence creation and transformation - MaybeNew(..), freshGoals, isFresh, getEvExpr, - CanonicalEvidence(..), - - newTcEvBinds, newNoTcEvBinds, - newWantedEq, emitNewWantedEq, - newWanted, - newWantedNC, newWantedEvVarNC, - newBoundEvVarId, - unifyTyVar, reportUnifications, - setEvBind, setWantedEq, - setWantedEvTerm, setEvBindIfWanted, - newEvVar, newGivenEvVar, emitNewGivens, - checkReductionDepth, - getSolvedDicts, setSolvedDicts, - - getInstEnvs, getFamInstEnvs, -- Getting the environments - getTopEnv, getGblEnv, getLclEnv, setSrcSpan, - getTcEvBindsVar, getTcLevel, - getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, - tcLookupClass, tcLookupId, tcLookupTyCon, - - - -- Inerts - updInertSet, updInertCans, - getHasGivenEqs, setInertCans, - getInertEqs, getInertCans, getInertGivens, - getInertInsols, getInnermostGivenEqLevel, - getInertSet, setInertSet, - getUnsolvedInerts, - removeInertCts, getPendingGivenScs, - insertFunEq, addInertForAll, - emitWorkNC, emitWork, - lookupInertDict, - - -- The Model - kickOutAfterUnification, kickOutRewritable, - - -- Inert Safe Haskell safe-overlap failures - addInertSafehask, insertSafeOverlapFailureTcS, updInertSafehask, - getSafeOverlapFailures, - - -- Inert solved dictionaries - updSolvedDicts, lookupSolvedDict, - - -- Irreds - foldIrreds, - - -- The family application cache - lookupFamAppInert, lookupFamAppCache, extendFamAppCache, - pprKicked, - - -- Instantiation - instDFunType, - - -- Unification - wrapUnifierTcS, unifyFunDeps, uPairsTcM, unifyForAllBody, - - -- MetaTyVars - newFlexiTcSTy, instFlexiX, - cloneMetaTyVar, - tcInstSkolTyVarsX, - - TcLevel, - isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar, - zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo, - zonkTyCoVarsAndFVList, - zonkSimples, zonkWC, - zonkTyCoVarKind, - - -- References - newTcRef, readTcRef, writeTcRef, updTcRef, - - -- Misc - getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS, - matchFam, matchFamTcM, - checkWellStagedDFun, - pprEq, - - -- Enforcing invariants for type equalities - checkTypeEq, checkTouchableTyVarEq -) where - -import GHC.Prelude - -import GHC.Driver.Env - -import qualified GHC.Tc.Utils.Instantiate as TcM -import GHC.Core.InstEnv -import GHC.Tc.Instance.Family as FamInst -import GHC.Core.FamInstEnv - -import qualified GHC.Tc.Utils.Monad as TcM -import qualified GHC.Tc.Utils.TcMType as TcM -import qualified GHC.Tc.Instance.Class as TcM( matchGlobalInst, ClsInstResult(..) ) -import qualified GHC.Tc.Utils.Env as TcM - ( checkWellStaged, tcGetDefaultTys - , tcLookupClass, tcLookupId, tcLookupTyCon - , topIdLvl ) -import GHC.Tc.Zonk.Monad ( ZonkM ) -import qualified GHC.Tc.Zonk.TcType as TcM -import qualified GHC.Tc.Zonk.Type as TcM - -import GHC.Driver.DynFlags - -import GHC.Tc.Instance.Class( safeOverlap, instanceReturnsDictCon ) -import GHC.Tc.Instance.FunDeps( FunDepEqn(..) ) - - -import GHC.Tc.Solver.Types -import GHC.Tc.Solver.InertSet -import GHC.Tc.Errors.Types - -import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.Unify - -import GHC.Tc.Types.Evidence -import GHC.Tc.Types -import GHC.Tc.Types.Origin -import GHC.Tc.Types.CtLoc -import GHC.Tc.Types.Constraint - -import GHC.Builtin.Names ( unsatisfiableClassNameKey, callStackTyConName, exceptionContextTyConName ) - -import GHC.Core.Type -import GHC.Core.TyCo.Rep as Rep -import GHC.Core.Coercion -import GHC.Core.Coercion.Axiom( TypeEqn ) -import GHC.Core.Predicate -import GHC.Core.Reduction -import GHC.Core.Class -import GHC.Core.TyCon -import GHC.Core.Unify (typesAreApart) - -import GHC.Types.Name -import GHC.Types.TyThing -import GHC.Types.Name.Reader -import GHC.Types.DefaultEnv ( DefaultEnv ) -import GHC.Types.Var -import GHC.Types.Var.Set -import GHC.Types.Unique.Supply -import GHC.Types.Unique.Set( elementOfUniqSet ) - -import GHC.Unit.Module ( HasModule, getModule, extractModule, moduleUnit, primUnit, ghcInternalUnit, bignumUnit) -import qualified GHC.Rename.Env as TcM - -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Utils.Logger -import GHC.Utils.Misc (HasDebugCallStack, (<||>)) - -import GHC.Data.Bag as Bag -import GHC.Data.Pair - -import GHC.Utils.Monad - -import GHC.Exts (oneShot) -import Control.Monad -import Data.IORef -import Data.List ( mapAccumL ) -import Data.Foldable -import qualified Data.Semigroup as S -import GHC.Types.SrcLoc -import GHC.Rename.Env - -#if defined(DEBUG) -import GHC.Types.Unique.Set (nonDetEltsUniqSet) -import GHC.Data.Graph.Directed -#endif - -{- ********************************************************************* -* * - SolverStage and StopOrContinue -* * -********************************************************************* -} - -{- Note [The SolverStage monad] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The SolverStage monad allows us to write simple code like that in -GHC.Tc.Solver.solveEquality. At the time of writing it looked like -this (may get out of date but the idea is clear): - -solveEquality :: ... -> SolverStage Void -solveEquality ev eq_rel ty1 ty2 - = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 - ; mb_canon <- canonicaliseEquality ev' eq_rel ty1' ty2' - ; case mb_canon of { - Left irred_ct -> do { tryQCsIrredEqCt irred_ct - ; solveIrred irred_ct } ; - Right eq_ct -> do { tryInertEqs eq_ct - ; tryFunDeps eq_ct - ; tryQCsEqCt eq_ct - ; simpleStage (updInertEqs eq_ct) - ; stopWithStage (eqCtEvidence eq_ct) ".." }}} - -Each sub-stage can elect to - (a) ContinueWith: continue to the next stasge - (b) StartAgain: start again at the beginning of the pipeline - (c) Stop: stop altogether; constraint is solved - -These three possiblities are described by the `StopOrContinue` data type. -The `SolverStage` monad does the plumbing. - -Notes: - -(SM1) Each individual stage pretty quickly drops down into - TcS (StopOrContinue a) - because the monadic plumbing of `SolverStage` is relatively ineffienct, - with that three-way split. - -(SM2) We use `SolverStage Void` to express the idea that ContinueWith is - impossible; we don't need to pattern match on it as a possible outcome:A - see GHC.Tc.Solver.Solve.solveOne. To that end, ContinueWith is strict. --} - -data StopOrContinue a - = StartAgain Ct -- Constraint is not solved, but some unifications - -- happened, so go back to the beginning of the pipeline - - | ContinueWith !a -- The constraint was not solved, although it may have - -- been rewritten. It is strict so that - -- ContinueWith Void can't happen; see (SM2) in - -- Note [The SolverStage monad] - - | Stop CtEvidence -- The (rewritten) constraint was solved - SDoc -- Tells how it was solved - -- Any new sub-goals have been put on the work list - deriving (Functor) - -instance Outputable a => Outputable (StopOrContinue a) where - ppr (Stop ev s) = text "Stop" <> parens (s $$ text "ev:" <+> ppr ev) - ppr (ContinueWith w) = text "ContinueWith" <+> ppr w - ppr (StartAgain w) = text "StartAgain" <+> ppr w - -newtype SolverStage a = Stage { runSolverStage :: TcS (StopOrContinue a) } - deriving( Functor ) - -instance Applicative SolverStage where - pure x = Stage (return (ContinueWith x)) - (<*>) = ap - -instance Monad SolverStage where - return = pure - (Stage m) >>= k = Stage $ - do { soc <- m - ; case soc of - StartAgain x -> return (StartAgain x) - Stop ev d -> return (Stop ev d) - ContinueWith x -> runSolverStage (k x) } - -nopStage :: a -> SolverStage a -nopStage res = Stage (continueWith res) - -simpleStage :: TcS a -> SolverStage a --- Always does a ContinueWith; no Stop or StartAgain -simpleStage thing = Stage (do { res <- thing; continueWith res }) - -startAgainWith :: Ct -> TcS (StopOrContinue a) -startAgainWith ct = return (StartAgain ct) - -continueWith :: a -> TcS (StopOrContinue a) -continueWith ct = return (ContinueWith ct) - -stopWith :: CtEvidence -> String -> TcS (StopOrContinue a) -stopWith ev s = return (Stop ev (text s)) - -stopWithStage :: CtEvidence -> String -> SolverStage a -stopWithStage ev s = Stage (stopWith ev s) - - -{- ********************************************************************* -* * - Inert instances: inert_insts -* * -********************************************************************* -} - -addInertForAll :: QCInst -> TcS () --- Add a local Given instance, typically arising from a type signature -addInertForAll new_qci - = do { ics <- getInertCans - ; ics1 <- add_qci ics - - -- Update given equalities. C.f updateGivenEqs - ; tclvl <- getTcLevel - ; let pred = qci_pred new_qci - not_equality = isClassPred pred && not (isEqPred pred) - -- True <=> definitely not an equality - -- A qci_pred like (f a) might be an equality - - ics2 | not_equality = ics1 - | otherwise = ics1 { inert_given_eq_lvl = tclvl - , inert_given_eqs = True } - - ; setInertCans ics2 } - where - add_qci :: InertCans -> TcS InertCans - -- See Note [Do not add duplicate quantified instances] - add_qci ics@(IC { inert_insts = qcis }) - | any same_qci qcis - = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) - ; return ics } - - | otherwise - = do { traceTcS "adding new inert quantified instance" (ppr new_qci) - ; return (ics { inert_insts = new_qci : qcis }) } - - same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) - (ctEvPred (qci_ev new_qci)) - -{- Note [Do not add duplicate quantified instances] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As an optimisation, we avoid adding duplicate quantified instances to the -inert set; we use a simple duplicate check using tcEqType for simplicity, -even though it doesn't account for superficial differences, e.g. it will count -the following two constraints as different (#22223): - - - forall a b. C a b - - forall b a. C a b - -The main logic that allows us to pick local instances, even in the presence of -duplicates, is explained in Note [Use only the best matching quantified constraint] -in GHC.Tc.Solver.Dict. --} - -{- ********************************************************************* -* * - Kicking out -* * -************************************************************************ --} - - ------------------------------------------ -kickOutRewritable :: KickOutSpec -> CtFlavourRole -> TcS () -kickOutRewritable ko_spec new_fr - = do { ics <- getInertCans - ; let (kicked_out, ics') = kickOutRewritableLHS ko_spec new_fr ics - n_kicked = lengthBag kicked_out - ; setInertCans ics' - - ; unless (isEmptyBag kicked_out) $ - do { emitWork kicked_out - - -- The famapp-cache contains Given evidence from the inert set. - -- If we're kicking out Givens, we need to remove this evidence - -- from the cache, too. - ; let kicked_given_ev_vars = foldr add_one emptyVarSet kicked_out - add_one :: Ct -> VarSet -> VarSet - add_one ct vs | CtGiven { ctev_evar = ev_var } <- ctEvidence ct - = vs `extendVarSet` ev_var - | otherwise = vs - - ; when (new_fr `eqCanRewriteFR` (Given, NomEq) && - -- if this isn't true, no use looking through the constraints - not (isEmptyVarSet kicked_given_ev_vars)) $ - do { traceTcS "Given(s) have been kicked out; drop from famapp-cache" - (ppr kicked_given_ev_vars) - ; dropFromFamAppCache kicked_given_ev_vars } - - ; csTraceTcS $ - hang (text "Kick out") - 2 (vcat [ text "n-kicked =" <+> int n_kicked - , text "kicked_out =" <+> ppr kicked_out - , text "Residual inerts =" <+> ppr ics' ]) } } - -kickOutAfterUnification :: [TcTyVar] -> TcS () -kickOutAfterUnification tvs - | null tvs - = return () - | otherwise - = do { let tv_set = mkVarSet tvs - - ; n_kicked <- kickOutRewritable (KOAfterUnify tv_set) (Given, NomEq) - -- Given because the tv := xi is given; NomEq because - -- only nominal equalities are solved by unification - - -- Set the unification flag if we have done outer unifications - -- that might affect an earlier implication constraint - ; let min_tv_lvl = foldr1 minTcLevel (map tcTyVarLevel tvs) - ; ambient_lvl <- getTcLevel - ; when (ambient_lvl `strictlyDeeperThan` min_tv_lvl) $ - setUnificationFlag min_tv_lvl - - ; traceTcS "kickOutAfterUnification" (ppr tvs $$ text "n_kicked =" <+> ppr n_kicked) - ; return n_kicked } - -kickOutAfterFillingCoercionHole :: CoercionHole -> TcS () --- See Wrinkle (EIK2a) in Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Equality --- It's possible that this could just go ahead and unify, but could there be occurs-check --- problems? Seems simpler just to kick out. -kickOutAfterFillingCoercionHole hole - = do { ics <- getInertCans - ; let (kicked_out, ics') = kick_out ics - n_kicked = lengthBag kicked_out - - ; unless (n_kicked == 0) $ - do { updWorkListTcS (extendWorkListCts (fmap CIrredCan kicked_out)) - ; csTraceTcS $ - hang (text "Kick out, hole =" <+> ppr hole) - 2 (vcat [ text "n-kicked =" <+> int n_kicked - , text "kicked_out =" <+> ppr kicked_out - , text "Residual inerts =" <+> ppr ics' ]) } - - ; setInertCans ics' } - where - kick_out :: InertCans -> (Bag IrredCt, InertCans) - kick_out ics@(IC { inert_irreds = irreds }) - = -- We only care about irreds here, because any constraint blocked - -- by a coercion hole is an irred. See wrinkle (EIK2a) in - -- Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Canonical - (irreds_to_kick, ics { inert_irreds = irreds_to_keep }) - where - (irreds_to_kick, irreds_to_keep) = partitionBag kick_ct irreds - - kick_ct :: IrredCt -> Bool - -- True: kick out; False: keep. - kick_ct ct - | IrredCt { ir_ev = ev, ir_reason = reason } <- ct - , CtWanted { ctev_rewriters = RewriterSet rewriters } <- ev - , NonCanonicalReason ctyeq <- reason - , ctyeq `cterHasProblem` cteCoercionHole - , hole `elementOfUniqSet` rewriters - = True - | otherwise - = False - --------------- -addInertSafehask :: InertCans -> DictCt -> InertCans -addInertSafehask ics item - = ics { inert_safehask = addDict item (inert_dicts ics) } - -insertSafeOverlapFailureTcS :: InstanceWhat -> DictCt -> TcS () --- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver -insertSafeOverlapFailureTcS what item - | safeOverlap what = return () - | otherwise = updInertCans (\ics -> addInertSafehask ics item) - -getSafeOverlapFailures :: TcS (Bag DictCt) --- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver -getSafeOverlapFailures - = do { IC { inert_safehask = safehask } <- getInertCans - ; return $ foldDicts consBag safehask emptyBag } - --------------- -updSolvedDicts :: InstanceWhat -> DictCt -> TcS () --- Conditionally add a new item in the solved set of the monad --- See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet -updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev }) - | isWanted ev - , instanceReturnsDictCon what - = do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName - ; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName - ; let contains_callstack_or_exceptionCtx = - mentionsIP - (const True) - -- NB: the name of the call-stack IP is irrelevant - -- e.g (?foo :: CallStack) counts! - (is_callstack <||> is_exceptionCtx) - cls tys - -- See Note [Don't add HasCallStack constraints to the solved set] - ; unless contains_callstack_or_exceptionCtx $ - do { traceTcS "updSolvedDicts:" $ ppr dict_ct - ; updInertSet $ \ ics -> - ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) } - } } - | otherwise - = return () - where - - -- Return a predicate that decides whether a type is CallStack - -- or ExceptionContext, accounting for e.g. type family reduction, as - -- per Note [Using typesAreApart when calling mentionsIP]. - -- - -- See Note [Using isCallStackTy in mentionsIP]. - is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool) - is_tyConTy is_eq tc_name - = do { mb_tc <- wrapTcS $ do - mod <- tcg_mod <$> TcM.getGblEnv - if moduleUnit mod `elem` [primUnit, ghcInternalUnit, bignumUnit] - then return Nothing - else Just <$> TcM.tcLookupTyCon tc_name - ; case mb_tc of - Just tc -> - return $ \ ty -> not (typesAreApart ty (mkTyConTy tc)) - Nothing -> - return is_eq - } - -{- Note [Don't add HasCallStack constraints to the solved set] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We must not add solved Wanted dictionaries that mention HasCallStack constraints -to the solved set, or we might fail to accumulate the proper call stack, as was -reported in #25529. - -Recall that HasCallStack constraints (and the related HasExceptionContext -constraints) are implicit parameter constraints, and are accumulated as per -Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence. - -When we solve a Wanted that contains a HasCallStack constraint, we don't want -to cache the result, because re-using that solution means re-using the call-stack -in a different context! - -See also Note [Shadowing of implicit parameters], which deals with a similar -problem with Given implicit parameter constraints. - -Note [Using isCallStackTy in mentionsIP] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -To implement Note [Don't add HasCallStack constraints to the solved set], -we need to check whether a constraint contains a HasCallStack or HasExceptionContext -constraint. We do this using the 'mentionsIP' function, but as per -Note [Using typesAreApart when calling mentionsIP] we don't want to simply do: - - mentionsIP - (const True) -- (ignore the implicit parameter string) - (isCallStackTy <||> isExceptionContextTy) - -because this does not account for e.g. a type family that reduces to CallStack. -The predicate we want to use instead is: - - \ ty -> not (typesAreApart ty callStackTy && typesAreApart ty exceptionContextTy) - -However, this is made difficult by the fact that CallStack and ExceptionContext -are not wired-in types; they are only known-key. This means we must look them -up using 'tcLookupTyCon'. However, this might fail, e.g. if we are in the middle -of typechecking ghc-internal and these data-types have not been typechecked yet! - -In that case, we simply fall back to the naive 'isCallStackTy'/'isExceptionContextTy' -logic. - -Note that it would be somewhat painful to wire-in ExceptionContext: at the time -of writing (March 2025), this would require wiring in the ExceptionAnnotation -class, as well as SomeExceptionAnnotation, which is a data type with existentials. --} - -getSolvedDicts :: TcS (DictMap DictCt) -getSolvedDicts = do { ics <- getInertSet; return (inert_solved_dicts ics) } - -setSolvedDicts :: DictMap DictCt -> TcS () -setSolvedDicts solved_dicts - = updInertSet $ \ ics -> - ics { inert_solved_dicts = solved_dicts } - -{- ********************************************************************* -* * - Other inert-set operations -* * -********************************************************************* -} - -updInertSet :: (InertSet -> InertSet) -> TcS () --- Modify the inert set with the supplied function -updInertSet upd_fn - = do { is_var <- getInertSetRef - ; wrapTcS (do { curr_inert <- TcM.readTcRef is_var - ; TcM.writeTcRef is_var (upd_fn curr_inert) }) } - -getInertCans :: TcS InertCans -getInertCans = do { inerts <- getInertSet; return (inert_cans inerts) } - -setInertCans :: InertCans -> TcS () -setInertCans ics = updInertSet $ \ inerts -> inerts { inert_cans = ics } - -updRetInertCans :: (InertCans -> (a, InertCans)) -> TcS a --- Modify the inert set with the supplied function -updRetInertCans upd_fn - = do { is_var <- getInertSetRef - ; wrapTcS (do { inerts <- TcM.readTcRef is_var - ; let (res, cans') = upd_fn (inert_cans inerts) - ; TcM.writeTcRef is_var (inerts { inert_cans = cans' }) - ; return res }) } - -updInertCans :: (InertCans -> InertCans) -> TcS () --- Modify the inert set with the supplied function -updInertCans upd_fn - = updInertSet $ \ inerts -> inerts { inert_cans = upd_fn (inert_cans inerts) } - -updInertSafehask :: (DictMap DictCt -> DictMap DictCt) -> TcS () --- Modify the inert set with the supplied function -updInertSafehask upd_fn - = updInertCans $ \ ics -> ics { inert_safehask = upd_fn (inert_safehask ics) } - -getInertEqs :: TcS InertEqs -getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } - -getInnermostGivenEqLevel :: TcS TcLevel -getInnermostGivenEqLevel = do { inert <- getInertCans - ; return (inert_given_eq_lvl inert) } - --- | Retrieves all insoluble constraints from the inert set, --- specifically including Given constraints. --- --- This consists of: --- --- - insoluble equalities, such as @Int ~# Bool@; --- - constraints that are top-level custom type errors, of the form --- @TypeError msg@, but not constraints such as @Eq (TypeError msg)@ --- in which the type error is nested; --- - unsatisfiable constraints, of the form @Unsatisfiable msg@. --- --- The inclusion of Givens is important for pattern match warnings, as we --- want to consider a pattern match that introduces insoluble Givens to be --- redundant (see Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver). -getInertInsols :: TcS Cts -getInertInsols - = do { inert <- getInertCans - ; let insols = filterBag insolubleIrredCt (inert_irreds inert) - unsats = findDictsByTyConKey (inert_dicts inert) unsatisfiableClassNameKey - ; return $ fmap CDictCan unsats `unionBags` fmap CIrredCan insols } - -getInertGivens :: TcS [Ct] --- Returns the Given constraints in the inert set -getInertGivens - = do { inerts <- getInertCans - ; let all_cts = foldIrreds ((:) . CIrredCan) (inert_irreds inerts) - $ foldDicts ((:) . CDictCan) (inert_dicts inerts) - $ foldFunEqs ((:) . CEqCan) (inert_funeqs inerts) - $ foldTyEqs ((:) . CEqCan) (inert_eqs inerts) - $ [] - ; return (filter isGivenCt all_cts) } - -getPendingGivenScs :: TcS [Ct] --- Find all inert Given dictionaries, or quantified constraints, such that --- 1. cc_pend_sc flag has fuel strictly > 0 --- 2. belongs to the current level --- For each such dictionary: --- * Return it (with unmodified cc_pend_sc) in sc_pending --- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand --- to record that we have expanded superclasses for this dict -getPendingGivenScs = do { lvl <- getTcLevel - ; updRetInertCans (get_sc_pending lvl) } - -get_sc_pending :: TcLevel -> InertCans -> ([Ct], InertCans) -get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_insts = insts }) - = assertPpr (all isGivenCt sc_pending) (ppr sc_pending) - -- When getPendingScDics is called, - -- there are never any Wanteds in the inert set - (sc_pending, ic { inert_dicts = dicts', inert_insts = insts' }) - where - sc_pending = sc_pend_insts ++ map CDictCan sc_pend_dicts - - sc_pend_dicts :: [DictCt] - sc_pend_dicts = foldDicts get_pending dicts [] - dicts' = foldr exhaustAndAdd dicts sc_pend_dicts - - (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts - - exhaustAndAdd :: DictCt -> DictMap DictCt -> DictMap DictCt - exhaustAndAdd ct dicts = addDict (ct {di_pend_sc = doNotExpand}) dicts - -- Exhaust the fuel for this constraint before adding it as - -- we don't want to expand these constraints again - - get_pending :: DictCt -> [DictCt] -> [DictCt] -- Get dicts with cc_pend_sc > 0 - get_pending dict dicts - | isPendingScDictCt dict - , belongs_to_this_level (dictCtEvidence dict) - = dict : dicts - | otherwise - = dicts - - get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) - get_pending_inst cts qci@(QCI { qci_ev = ev }) - | Just qci' <- pendingScInst_maybe qci - , belongs_to_this_level ev - = (CQuantCan qci : cts, qci') - -- qci' have their fuel exhausted - -- we don't want to expand these constraints again - -- qci is expanded - | otherwise - = (cts, qci) - - belongs_to_this_level ev = ctLocLevel (ctEvLoc ev) `sameDepthAs` this_lvl - -- We only want Givens from this level; see (3a) in - -- Note [The superclass story] in GHC.Tc.Solver.Dict - -getUnsolvedInerts :: TcS ( Bag Implication - , Cts ) -- All simple constraints --- Return all the unsolved [Wanted] constraints --- --- Post-condition: the returned simple constraints are all fully zonked --- (because they come from the inert set) --- the unsolved implics may not be -getUnsolvedInerts - = do { IC { inert_eqs = tv_eqs - , inert_funeqs = fun_eqs - , inert_irreds = irreds - , inert_dicts = idicts - } <- getInertCans - - ; let unsolved_tv_eqs = foldTyEqs (add_if_unsolved CEqCan) tv_eqs emptyCts - unsolved_fun_eqs = foldFunEqs (add_if_unsolved CEqCan) fun_eqs emptyCts - unsolved_irreds = foldr (add_if_unsolved CIrredCan) emptyCts irreds - unsolved_dicts = foldDicts (add_if_unsolved CDictCan) idicts emptyCts - - ; implics <- getWorkListImplics - - ; traceTcS "getUnsolvedInerts" $ - vcat [ text " tv eqs =" <+> ppr unsolved_tv_eqs - , text "fun eqs =" <+> ppr unsolved_fun_eqs - , text "dicts =" <+> ppr unsolved_dicts - , text "irreds =" <+> ppr unsolved_irreds - , text "implics =" <+> ppr implics ] - - ; return ( implics, unsolved_tv_eqs `unionBags` - unsolved_fun_eqs `unionBags` - unsolved_irreds `unionBags` - unsolved_dicts ) } - where - add_if_unsolved :: (a -> Ct) -> a -> Cts -> Cts - add_if_unsolved mk_ct thing cts - | isWantedCt ct = ct `consCts` cts - | otherwise = cts - where - ct = mk_ct thing - -getHasGivenEqs :: TcLevel -- TcLevel of this implication - -> TcS ( HasGivenEqs -- are there Given equalities? - , InertIrreds ) -- Insoluble equalities arising from givens --- See Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet -getHasGivenEqs tclvl - = do { inerts@(IC { inert_irreds = irreds - , inert_given_eqs = given_eqs - , inert_given_eq_lvl = ge_lvl }) - <- getInertCans - ; let given_insols = filterBag insoluble_given_equality irreds - -- Specifically includes ones that originated in some - -- outer context but were refined to an insoluble by - -- a local equality; so no level-check needed - - -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and - -- Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet - has_ge | ge_lvl `sameDepthAs` tclvl = MaybeGivenEqs - | given_eqs = LocalGivenEqs - | otherwise = NoGivenEqs - - ; traceTcS "getHasGivenEqs" $ - vcat [ text "given_eqs:" <+> ppr given_eqs - , text "ge_lvl:" <+> ppr ge_lvl - , text "ambient level:" <+> ppr tclvl - , text "Inerts:" <+> ppr inerts - , text "Insols:" <+> ppr given_insols] - ; return (has_ge, given_insols) } - where - insoluble_given_equality :: IrredCt -> Bool - -- Check for unreachability; specifically do not include UserError/Unsatisfiable - insoluble_given_equality (IrredCt { ir_ev = ev, ir_reason = reason }) - = isInsolubleReason reason && isGiven ev - -removeInertCts :: [Ct] -> InertCans -> InertCans --- ^ Remove inert constraints from the 'InertCans', for use when a --- typechecker plugin wishes to discard a given. -removeInertCts cts icans = foldl' removeInertCt icans cts - -removeInertCt :: InertCans -> Ct -> InertCans -removeInertCt is ct - = case ct of - CDictCan dict_ct -> is { inert_dicts = delDict dict_ct (inert_dicts is) } - CEqCan eq_ct -> delEq eq_ct is - CIrredCan ir_ct -> delIrred ir_ct is - CQuantCan {} -> panic "removeInertCt: CQuantCan" - CNonCanonical {} -> panic "removeInertCt: CNonCanonical" - --- | Looks up a family application in the inerts. -lookupFamAppInert :: (CtFlavourRole -> Bool) -- can it rewrite the target? - -> TyCon -> [Type] -> TcS (Maybe (Reduction, CtFlavourRole)) -lookupFamAppInert rewrite_pred fam_tc tys - = do { IS { inert_cans = IC { inert_funeqs = inert_funeqs } } <- getInertSet - ; return (lookup_inerts inert_funeqs) } - where - lookup_inerts inert_funeqs - | Just ecl <- findFunEq inert_funeqs fam_tc tys - , Just (EqCt { eq_ev = ctev, eq_rhs = rhs }) - <- find (rewrite_pred . eqCtFlavourRole) ecl - = Just (mkReduction (ctEvCoercion ctev) rhs, ctEvFlavourRole ctev) - | otherwise = Nothing - -lookupInInerts :: CtLoc -> TcPredType -> TcS (Maybe CtEvidence) --- Is this exact predicate type cached in the solved or canonicals of the InertSet? -lookupInInerts loc pty - | ClassPred cls tys <- classifyPredType pty - = do { inerts <- getInertSet - ; let mb_solved = lookupSolvedDict inerts loc cls tys - mb_inert = fmap dictCtEvidence (lookupInertDict (inert_cans inerts) loc cls tys) - ; return $ do -- Maybe monad - found_ev <- mb_solved `mplus` mb_inert - - -- We're about to "solve" the wanted we're looking up, so we - -- must make sure doing so wouldn't run afoul of - -- Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance. - -- Forgetting this led to #20666. - guard $ not (prohibitedSuperClassSolve (ctEvLoc found_ev) loc) - - return found_ev } - | otherwise -- NB: No caching for equalities, IPs, holes, or errors - = return Nothing - --- | Look up a dictionary inert. -lookupInertDict :: InertCans -> CtLoc -> Class -> [Type] -> Maybe DictCt -lookupInertDict (IC { inert_dicts = dicts }) loc cls tys - = findDict dicts loc cls tys - --- | Look up a solved inert. -lookupSolvedDict :: InertSet -> CtLoc -> Class -> [Type] -> Maybe CtEvidence --- Returns just if exactly this predicate type exists in the solved. -lookupSolvedDict (IS { inert_solved_dicts = solved }) loc cls tys - = fmap dictCtEvidence (findDict solved loc cls tys) - ---------------------------- -lookupFamAppCache :: TyCon -> [Type] -> TcS (Maybe Reduction) -lookupFamAppCache fam_tc tys - = do { IS { inert_famapp_cache = famapp_cache } <- getInertSet - ; case findFunEq famapp_cache fam_tc tys of - result@(Just redn) -> - do { traceTcS "famapp_cache hit" (vcat [ ppr (mkTyConApp fam_tc tys) - , ppr redn ]) - ; return result } - Nothing -> return Nothing } - -extendFamAppCache :: TyCon -> [Type] -> Reduction -> TcS () --- NB: co :: rhs ~ F tys, to match expectations of rewriter -extendFamAppCache tc xi_args stuff@(Reduction _ ty) - = do { dflags <- getDynFlags - ; when (gopt Opt_FamAppCache dflags) $ - do { traceTcS "extendFamAppCache" (vcat [ ppr tc <+> ppr xi_args - , ppr ty ]) - ; updInertSet $ \ is@(IS { inert_famapp_cache = fc }) -> - is { inert_famapp_cache = insertFunEq fc tc xi_args stuff } } } - --- Remove entries from the cache whose evidence mentions variables in the --- supplied set -dropFromFamAppCache :: VarSet -> TcS () -dropFromFamAppCache varset - = updInertSet (\inerts@(IS { inert_famapp_cache = famapp_cache }) -> - inerts { inert_famapp_cache = filterTcAppMap check famapp_cache }) - where - check :: Reduction -> Bool - check redn - = not (anyFreeVarsOfCo (`elemVarSet` varset) $ reductionCoercion redn) - -{- -************************************************************************ -* * -* The TcS solver monad * -* * -************************************************************************ - -Note [The TcS monad] -~~~~~~~~~~~~~~~~~~~~ -The TcS monad is a weak form of the main Tc monad - -All you can do is - * fail - * allocate new variables - * fill in evidence variables - -Filling in a dictionary evidence variable means to create a binding -for it, so TcS carries a mutable location where the binding can be -added. This is initialised from the innermost implication constraint. --} - -data TcSEnv - = TcSEnv { - tcs_ev_binds :: EvBindsVar, - - tcs_unified :: IORef Int, - -- The number of unification variables we have filled - -- The important thing is whether it is non-zero, so it - -- could equally well be a Bool instead of an Int. - - tcs_unif_lvl :: IORef (Maybe TcLevel), - -- The Unification Level Flag - -- Outermost level at which we have unified a meta tyvar - -- Starts at Nothing, then (Just i), then (Just j) where j TcM a } - deriving (Functor) - -instance MonadFix TcS where - mfix k = TcS $ \env -> mfix (\x -> unTcS (k x) env) - --- | Smart constructor for 'TcS', as describe in Note [The one-shot state --- monad trick] in "GHC.Utils.Monad". -mkTcS :: (TcSEnv -> TcM a) -> TcS a -mkTcS f = TcS (oneShot f) - -instance Applicative TcS where - pure x = mkTcS $ \_ -> return x - (<*>) = ap - -instance Monad TcS where - m >>= k = mkTcS $ \ebs -> do - unTcS m ebs >>= (\r -> unTcS (k r) ebs) - -instance MonadIO TcS where - liftIO act = TcS $ \_env -> liftIO act - -instance MonadFail TcS where - fail err = mkTcS $ \_ -> fail err - -instance MonadUnique TcS where - getUniqueSupplyM = wrapTcS getUniqueSupplyM - -instance HasModule TcS where - getModule = wrapTcS getModule - -instance MonadThings TcS where - lookupThing n = wrapTcS (lookupThing n) - --- Basic functionality --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -wrapTcS :: TcM a -> TcS a --- Do not export wrapTcS, because it promotes an arbitrary TcM to TcS, --- and TcS is supposed to have limited functionality -wrapTcS action = mkTcS $ \_env -> action -- a TcM action will not use the TcEvBinds - -liftZonkTcS :: ZonkM a -> TcS a -liftZonkTcS = wrapTcS . TcM.liftZonkM - -wrap2TcS :: (TcM a -> TcM a) -> TcS a -> TcS a -wrap2TcS fn (TcS thing) = mkTcS $ \env -> fn (thing env) - -wrapErrTcS :: TcM a -> TcS a --- The thing wrapped should just fail --- There's no static check; it's up to the user --- Having a variant for each error message is too painful -wrapErrTcS = wrapTcS - -wrapWarnTcS :: TcM a -> TcS a --- The thing wrapped should just add a warning, or no-op --- There's no static check; it's up to the user -wrapWarnTcS = wrapTcS - -panicTcS :: SDoc -> TcS a -failTcS :: TcRnMessage -> TcS a -warnTcS, addErrTcS :: TcRnMessage -> TcS () -failTcS = wrapTcS . TcM.failWith -warnTcS msg = wrapTcS (TcM.addDiagnostic msg) -addErrTcS = wrapTcS . TcM.addErr -panicTcS doc = pprPanic "GHC.Tc.Solver.Monad" doc - -tryEarlyAbortTcS :: TcS () --- Abort (fail in the monad) if the abort_on_insoluble flag is on -tryEarlyAbortTcS - = mkTcS (\env -> when (tcs_abort_on_insoluble env) TcM.failM) - --- | Emit a warning within the 'TcS' monad at the location given by the 'CtLoc'. -ctLocWarnTcS :: CtLoc -> TcRnMessage -> TcS () -ctLocWarnTcS loc msg = wrapTcS $ TcM.setCtLocM loc $ TcM.addDiagnostic msg - -traceTcS :: String -> SDoc -> TcS () -traceTcS herald doc = wrapTcS (TcM.traceTc herald doc) -{-# INLINE traceTcS #-} -- see Note [INLINE conditional tracing utilities] - -runTcPluginTcS :: TcPluginM a -> TcS a -runTcPluginTcS = wrapTcS . runTcPluginM - -instance HasDynFlags TcS where - getDynFlags = wrapTcS getDynFlags - -getGlobalRdrEnvTcS :: TcS GlobalRdrEnv -getGlobalRdrEnvTcS = wrapTcS TcM.getGlobalRdrEnv - -bumpStepCountTcS :: TcS () -bumpStepCountTcS = mkTcS $ \env -> - do { let ref = tcs_count env - ; n <- TcM.readTcRef ref - ; TcM.writeTcRef ref (n+1) } - -csTraceTcS :: SDoc -> TcS () -csTraceTcS doc - = wrapTcS $ csTraceTcM (return doc) -{-# INLINE csTraceTcS #-} -- see Note [INLINE conditional tracing utilities] - -traceFireTcS :: CtEvidence -> SDoc -> TcS () --- Dump a rule-firing trace -traceFireTcS ev doc - = mkTcS $ \env -> csTraceTcM $ - do { n <- TcM.readTcRef (tcs_count env) - ; tclvl <- TcM.getTcLevel - ; return (hang (text "Step" <+> int n - <> brackets (text "l:" <> ppr tclvl <> comma <> - text "d:" <> ppr (ctLocDepth (ctEvLoc ev))) - <+> doc <> colon) - 4 (ppr ev)) } -{-# INLINE traceFireTcS #-} -- see Note [INLINE conditional tracing utilities] - -csTraceTcM :: TcM SDoc -> TcM () --- Constraint-solver tracing, -ddump-cs-trace -csTraceTcM mk_doc - = do { logger <- getLogger - ; when ( logHasDumpFlag logger Opt_D_dump_cs_trace - || logHasDumpFlag logger Opt_D_dump_tc_trace) - ( do { msg <- mk_doc - ; TcM.dumpTcRn False - Opt_D_dump_cs_trace - "" FormatText - msg }) } -{-# INLINE csTraceTcM #-} -- see Note [INLINE conditional tracing utilities] - -runTcS :: TcS a -- What to run - -> TcM (a, EvBindMap) -runTcS tcs - = do { ev_binds_var <- TcM.newTcEvBinds - ; res <- runTcSWithEvBinds ev_binds_var tcs - ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var - ; return (res, ev_binds) } - --- | This variant of 'runTcS' will immediately fail upon encountering an --- insoluble ct. See Note [Speeding up valid hole-fits]. Its one usage --- site does not need the ev_binds, so we do not return them. -runTcSEarlyAbort :: TcS a -> TcM a -runTcSEarlyAbort tcs - = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds' True True ev_binds_var tcs } - --- | This can deal only with equality constraints. -runTcSEqualities :: TcS a -> TcM a -runTcSEqualities thing_inside - = do { ev_binds_var <- TcM.newNoTcEvBinds - ; runTcSWithEvBinds ev_binds_var thing_inside } - --- | A variant of 'runTcS' that takes and returns an 'InertSet' for --- later resumption of the 'TcS' session. -runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) -runTcSInerts inerts tcs = do - ev_binds_var <- TcM.newTcEvBinds - runTcSWithEvBinds' False False ev_binds_var $ do - setInertSet inerts - a <- tcs - new_inerts <- getInertSet - return (a, new_inerts) - -runTcSWithEvBinds :: EvBindsVar - -> TcS a - -> TcM a -runTcSWithEvBinds = runTcSWithEvBinds' True False - -runTcSWithEvBinds' :: Bool -- ^ Restore type variable cycles afterwards? - -- Don't if you want to reuse the InertSet. - -- See also Note [Type equality cycles] - -- in GHC.Tc.Solver.Equality - -> Bool - -> EvBindsVar - -> TcS a - -> TcM a -runTcSWithEvBinds' restore_cycles abort_on_insoluble ev_binds_var tcs - = do { unified_var <- TcM.newTcRef 0 - ; step_count <- TcM.newTcRef 0 - ; inert_var <- TcM.newTcRef emptyInert - ; wl_var <- TcM.newTcRef emptyWorkList - ; unif_lvl_var <- TcM.newTcRef Nothing - ; let env = TcSEnv { tcs_ev_binds = ev_binds_var - , tcs_unified = unified_var - , tcs_unif_lvl = unif_lvl_var - , tcs_count = step_count - , tcs_inerts = inert_var - , tcs_abort_on_insoluble = abort_on_insoluble - , tcs_worklist = wl_var } - - -- Run the computation - ; res <- unTcS tcs env - - ; count <- TcM.readTcRef step_count - ; when (count > 0) $ - csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - - ; when restore_cycles $ - do { inert_set <- TcM.readTcRef inert_var - ; restoreTyVarCycles inert_set } - -#if defined(DEBUG) - ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var - ; checkForCyclicBinds ev_binds -#endif - - ; return res } - ----------------------------- -#if defined(DEBUG) -checkForCyclicBinds :: EvBindMap -> TcM () -checkForCyclicBinds ev_binds_map - | null cycles - = return () - | null coercion_cycles - = TcM.traceTc "Cycle in evidence binds" $ ppr cycles - | otherwise - = pprPanic "Cycle in coercion bindings" $ ppr coercion_cycles - where - ev_binds = evBindMapBinds ev_binds_map - - cycles :: [[EvBind]] - cycles = [c | CyclicSCC c <- stronglyConnCompFromEdgedVerticesUniq edges] - - coercion_cycles = [c | c <- cycles, any is_co_bind c] - is_co_bind (EvBind { eb_lhs = b }) = isEqPrimPred (varType b) - - edges :: [ Node EvVar EvBind ] - edges = [ DigraphNode bind bndr (nonDetEltsUniqSet (evVarsOfTerm rhs)) - | bind@(EvBind { eb_lhs = bndr, eb_rhs = rhs}) <- bagToList ev_binds ] - -- It's OK to use nonDetEltsUFM here as - -- stronglyConnCompFromEdgedVertices is still deterministic even - -- if the edges are in nondeterministic order as explained in - -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. -#endif - ----------------------------- -setEvBindsTcS :: EvBindsVar -> TcS a -> TcS a -setEvBindsTcS ref (TcS thing_inside) - = TcS $ \ env -> thing_inside (env { tcs_ev_binds = ref }) - -nestImplicTcS :: EvBindsVar - -> TcLevel -> TcS a - -> TcS a -nestImplicTcS ref inner_tclvl (TcS thing_inside) - = TcS $ \ TcSEnv { tcs_unified = unified_var - , tcs_inerts = old_inert_var - , tcs_count = count - , tcs_unif_lvl = unif_lvl - , tcs_abort_on_insoluble = abort_on_insoluble - } -> - do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = pushCycleBreakerVarStack - (inert_cycle_breakers inerts) - , inert_cans = (inert_cans inerts) - { inert_given_eqs = False } } - -- All other InertSet fields are inherited - ; new_inert_var <- TcM.newTcRef nest_inert - ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = TcSEnv { tcs_count = count -- Inherited - , tcs_unif_lvl = unif_lvl -- Inherited - , tcs_ev_binds = ref - , tcs_unified = unified_var - , tcs_inerts = new_inert_var - , tcs_abort_on_insoluble = abort_on_insoluble - , tcs_worklist = new_wl_var } - ; res <- TcM.setTcLevel inner_tclvl $ - thing_inside nest_env - - ; out_inert_set <- TcM.readTcRef new_inert_var - ; restoreTyVarCycles out_inert_set - -#if defined(DEBUG) - -- Perform a check that the thing_inside did not cause cycles - ; ev_binds <- TcM.getTcEvBindsMap ref - ; checkForCyclicBinds ev_binds -#endif - ; return res } - -nestTcS :: TcS a -> TcS a --- Use the current untouchables, augmenting the current --- evidence bindings, and solved dictionaries --- But have no effect on the InertCans, or on the inert_famapp_cache --- (we want to inherit the latter from processing the Givens) -nestTcS (TcS thing_inside) - = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) -> - do { inerts <- TcM.readTcRef inerts_var - ; new_inert_var <- TcM.newTcRef inerts - ; new_wl_var <- TcM.newTcRef emptyWorkList - ; let nest_env = env { tcs_inerts = new_inert_var - , tcs_worklist = new_wl_var } - - ; res <- thing_inside nest_env - - ; new_inerts <- TcM.readTcRef new_inert_var - - -- we want to propagate the safe haskell failures - ; let old_ic = inert_cans inerts - new_ic = inert_cans new_inerts - nxt_ic = old_ic { inert_safehask = inert_safehask new_ic } - - ; TcM.writeTcRef inerts_var -- See Note [Propagate the solved dictionaries] - (inerts { inert_solved_dicts = inert_solved_dicts new_inerts - , inert_cans = nxt_ic }) - - ; return res } - -emitImplicationTcS :: TcLevel -> SkolemInfoAnon - -> [TcTyVar] -- Skolems - -> [EvVar] -- Givens - -> Cts -- Wanteds - -> TcS TcEvBinds --- Add an implication to the TcS monad work-list -emitImplicationTcS new_tclvl skol_info skol_tvs givens wanteds - = do { let wc = emptyWC { wc_simple = wanteds } - ; imp <- wrapTcS $ - do { ev_binds_var <- TcM.newTcEvBinds - ; imp <- TcM.newImplication - ; return (imp { ic_tclvl = new_tclvl - , ic_skols = skol_tvs - , ic_given = givens - , ic_wanted = wc - , ic_binds = ev_binds_var - , ic_info = skol_info }) } - - ; emitImplication imp - ; return (TcEvBinds (ic_binds imp)) } - -emitTvImplicationTcS :: TcLevel -> SkolemInfoAnon - -> [TcTyVar] -- Skolems - -> Cts -- Wanteds - -> TcS () --- Just like emitImplicationTcS but no givens and no bindings -emitTvImplicationTcS new_tclvl skol_info skol_tvs wanteds - = do { let wc = emptyWC { wc_simple = wanteds } - ; imp <- wrapTcS $ - do { ev_binds_var <- TcM.newNoTcEvBinds - ; imp <- TcM.newImplication - ; return (imp { ic_tclvl = new_tclvl - , ic_skols = skol_tvs - , ic_wanted = wc - , ic_binds = ev_binds_var - , ic_info = skol_info }) } - - ; emitImplication imp } - - -{- Note [Propagate the solved dictionaries] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's really quite important that nestTcS does not discard the solved -dictionaries from the thing_inside. -Consider - Eq [a] - forall b. empty => Eq [a] -We solve the simple (Eq [a]), under nestTcS, and then turn our attention to -the implications. It's definitely fine to use the solved dictionaries on -the inner implications, and it can make a significant performance difference -if you do so. --} - --- Getters and setters of GHC.Tc.Utils.Env fields --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -getUnifiedRef :: TcS (IORef Int) -getUnifiedRef = TcS (return . tcs_unified) - --- Getter of inerts and worklist -getInertSetRef :: TcS (IORef InertSet) -getInertSetRef = TcS (return . tcs_inerts) - -getInertSet :: TcS InertSet -getInertSet = getInertSetRef >>= readTcRef - -setInertSet :: InertSet -> TcS () -setInertSet is = do { r <- getInertSetRef; writeTcRef r is } - -getTcSWorkListRef :: TcS (IORef WorkList) -getTcSWorkListRef = TcS (return . tcs_worklist) - -getWorkListImplics :: TcS (Bag Implication) -getWorkListImplics - = do { wl_var <- getTcSWorkListRef - ; wl_curr <- readTcRef wl_var - ; return (wl_implics wl_curr) } - -pushLevelNoWorkList :: SDoc -> TcS a -> TcS (TcLevel, a) --- Push the level and run thing_inside --- However, thing_inside should not generate any work items -#if defined(DEBUG) -pushLevelNoWorkList err_doc (TcS thing_inside) - = TcS (\env -> TcM.pushTcLevelM $ - thing_inside (env { tcs_worklist = wl_panic }) - ) - where - wl_panic = pprPanic "GHC.Tc.Solver.Monad.buildImplication" err_doc - -- This panic checks that the thing-inside - -- does not emit any work-list constraints -#else -pushLevelNoWorkList _ (TcS thing_inside) - = TcS (\env -> TcM.pushTcLevelM (thing_inside env)) -- Don't check -#endif - -updWorkListTcS :: (WorkList -> WorkList) -> TcS () -updWorkListTcS f - = do { wl_var <- getTcSWorkListRef - ; updTcRef wl_var f } - -emitWorkNC :: [CtEvidence] -> TcS () -emitWorkNC evs - | null evs - = return () - | otherwise - = emitWork (listToBag (map mkNonCanonical evs)) - -emitWork :: Cts -> TcS () -emitWork cts - | isEmptyBag cts -- Avoid printing, among other work - = return () - | otherwise - = do { traceTcS "Emitting fresh work" (pprBag cts) - -- Zonk the rewriter set of Wanteds, because that affects - -- the prioritisation of the work-list. Suppose a constraint - -- c1 is rewritten by another, c2. When c2 gets solved, - -- c1 has no rewriters, and can be prioritised; see - -- Note [Prioritise Wanteds with empty RewriterSet] - -- in GHC.Tc.Types.Constraint wrinkle (WRW1) - ; cts <- wrapTcS $ mapBagM TcM.zonkCtRewriterSet cts - ; updWorkListTcS (extendWorkListCts cts) } - -emitImplication :: Implication -> TcS () -emitImplication implic - = updWorkListTcS (extendWorkListImplic implic) - -newTcRef :: a -> TcS (TcRef a) -newTcRef x = wrapTcS (TcM.newTcRef x) - -readTcRef :: TcRef a -> TcS a -readTcRef ref = wrapTcS (TcM.readTcRef ref) - -writeTcRef :: TcRef a -> a -> TcS () -writeTcRef ref val = wrapTcS (TcM.writeTcRef ref val) - -updTcRef :: TcRef a -> (a->a) -> TcS () -updTcRef ref upd_fn = wrapTcS (TcM.updTcRef ref upd_fn) - -getTcEvBindsVar :: TcS EvBindsVar -getTcEvBindsVar = TcS (return . tcs_ev_binds) - -getTcLevel :: TcS TcLevel -getTcLevel = wrapTcS TcM.getTcLevel - -getTcEvTyCoVars :: EvBindsVar -> TcS TyCoVarSet -getTcEvTyCoVars ev_binds_var - = wrapTcS $ TcM.getTcEvTyCoVars ev_binds_var - -getTcEvBindsMap :: EvBindsVar -> TcS EvBindMap -getTcEvBindsMap ev_binds_var - = wrapTcS $ TcM.getTcEvBindsMap ev_binds_var - -setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcS () -setTcEvBindsMap ev_binds_var binds - = wrapTcS $ TcM.setTcEvBindsMap ev_binds_var binds - -unifyTyVar :: TcTyVar -> TcType -> TcS () --- Unify a meta-tyvar with a type --- We keep track of how many unifications have happened in tcs_unified, --- --- We should never unify the same variable twice! -unifyTyVar tv ty - = assertPpr (isMetaTyVar tv) (ppr tv) $ - TcS $ \ env -> - do { TcM.traceTc "unifyTyVar" (ppr tv <+> text ":=" <+> ppr ty) - ; TcM.liftZonkM $ TcM.writeMetaTyVar tv ty - ; TcM.updTcRef (tcs_unified env) (+1) } - -reportUnifications :: TcS a -> TcS (Int, a) --- Record how many unifications are done by thing_inside --- We could return a Bool instead of an Int; --- all that matters is whether it is no-zero -reportUnifications (TcS thing_inside) - = TcS $ \ env -> - do { inner_unified <- TcM.newTcRef 0 - ; res <- thing_inside (env { tcs_unified = inner_unified }) - ; n_unifs <- TcM.readTcRef inner_unified - ; TcM.updTcRef (tcs_unified env) (+ n_unifs) - ; return (n_unifs, res) } - -getDefaultInfo :: TcS (DefaultEnv, Bool) -getDefaultInfo = wrapTcS TcM.tcGetDefaultTys - -getWorkList :: TcS WorkList -getWorkList = do { wl_var <- getTcSWorkListRef - ; wrapTcS (TcM.readTcRef wl_var) } - -selectNextWorkItem :: TcS (Maybe Ct) --- Pick which work item to do next --- See Note [Prioritise equalities] -selectNextWorkItem - = do { wl_var <- getTcSWorkListRef - ; wl <- readTcRef wl_var - ; case selectWorkItem wl of { - Nothing -> return Nothing ; - Just (ct, new_wl) -> - do { -- checkReductionDepth (ctLoc ct) (ctPred ct) - -- This is done by GHC.Tc.Solver.Dict.chooseInstance - ; writeTcRef wl_var new_wl - ; return (Just ct) } } } - --- Just get some environments needed for instance looking up and matching --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -getInstEnvs :: TcS InstEnvs -getInstEnvs = wrapTcS $ TcM.tcGetInstEnvs - -getFamInstEnvs :: TcS (FamInstEnv, FamInstEnv) -getFamInstEnvs = wrapTcS $ FamInst.tcGetFamInstEnvs - -getTopEnv :: TcS HscEnv -getTopEnv = wrapTcS $ TcM.getTopEnv - -getGblEnv :: TcS TcGblEnv -getGblEnv = wrapTcS $ TcM.getGblEnv - -getLclEnv :: TcS TcLclEnv -getLclEnv = wrapTcS $ TcM.getLclEnv - -setSrcSpan :: RealSrcSpan -> TcS a -> TcS a -setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) - -tcLookupClass :: Name -> TcS Class -tcLookupClass c = wrapTcS $ TcM.tcLookupClass c - -tcLookupId :: Name -> TcS Id -tcLookupId n = wrapTcS $ TcM.tcLookupId n - -tcLookupTyCon :: Name -> TcS TyCon -tcLookupTyCon n = wrapTcS $ TcM.tcLookupTyCon n - --- Any use of this function is a bit suspect, because it violates the --- pure veneer of TcS. But it's just about warnings around unused imports --- and local constructors (GHC will issue fewer warnings than it otherwise --- might), so it's not worth losing sleep over. -recordUsedGREs :: Bag GlobalRdrElt -> TcS () -recordUsedGREs gres - = do { wrapTcS $ TcM.addUsedGREs NoDeprecationWarnings gre_list - -- If a newtype constructor was imported, don't warn about not - -- importing it... - ; wrapTcS $ traverse_ (TcM.keepAlive . greName) gre_list } - -- ...and similarly, if a newtype constructor was defined in the same - -- module, don't warn about it being unused. - -- See Note [Tracking unused binding and imports] in GHC.Tc.Utils. - - where - gre_list = bagToList gres - --- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -checkWellStagedDFun :: CtLoc -> InstanceWhat -> PredType -> TcS () --- Check that we do not try to use an instance before it is available. E.g. --- instance Eq T where ... --- f x = $( ... (\(p::T) -> p == p)... ) --- Here we can't use the equality function from the instance in the splice - -checkWellStagedDFun loc what pred - = do - mbind_lvl <- checkWellStagedInstanceWhat what - case mbind_lvl of - Just bind_lvl | bind_lvl > impLevel -> - wrapTcS $ TcM.setCtLocM loc $ do - { use_stage <- TcM.getStage - ; TcM.checkWellStaged (StageCheckInstance what pred) bind_lvl (thLevel use_stage) } - _ -> - return () - --- | Returns the ThLevel of evidence for the solved constraint (if it has evidence) --- See Note [Well-staged instance evidence] -checkWellStagedInstanceWhat :: InstanceWhat -> TcS (Maybe ThLevel) -checkWellStagedInstanceWhat what - | TopLevInstance { iw_dfun_id = dfun_id } <- what - = return $ Just (TcM.topIdLvl dfun_id) - | BuiltinTypeableInstance tc <- what - = do - cur_mod <- extractModule <$> getGblEnv - return $ Just (if nameIsLocalOrFrom cur_mod (tyConName tc) - then outerLevel - else impLevel) - | otherwise = return Nothing - -{- -Note [Well-staged instance evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Evidence for instances must obey the same level restrictions as normal bindings. -In particular, it is forbidden to use an instance in a top-level splice in the -module which the instance is defined. This is because the evidence is bound at -the top-level and top-level definitions are forbidden from being using in top-level splices in -the same module. - -For example, suppose you have a function.. foo :: Show a => Code Q a -> Code Q () -then the following program is disallowed, - -``` -data T a = T a deriving (Show) - -main :: IO () -main = - let x = $$(foo [|| T () ||]) - in return () -``` - -because the `foo` function (used in a top-level splice) requires `Show T` evidence, -which is defined at the top-level and therefore fails with an error that we have violated -the stage restriction. - -``` -Main.hs:12:14: error: - • GHC stage restriction: - instance for ‘Show - (T ())’ is used in a top-level splice, quasi-quote, or annotation, - and must be imported, not defined locally - • In the expression: foo [|| T () ||] - In the Template Haskell splice $$(foo [|| T () ||]) - In the expression: $$(foo [|| T () ||]) - | -12 | let x = $$(foo [|| T () ||]) - | -``` - -Solving a `Typeable (T t1 ...tn)` constraint generates code that relies on -`$tcT`, the `TypeRep` for `T`; and we must check that this reference to `$tcT` -is well staged. It's easy to know the stage of `$tcT`: for imported TyCons it -will be `impLevel`, and for local TyCons it will be `toplevel`. - -Therefore the `InstanceWhat` type had to be extended with -a special case for `Typeable`, which recorded the TyCon the evidence was for and -could them be used to check that we were not attempting to evidence in a stage incorrect -manner. - --} - -pprEq :: TcType -> TcType -> SDoc -pprEq ty1 ty2 = pprParendType ty1 <+> char '~' <+> pprParendType ty2 - -isFilledMetaTyVar_maybe :: TcTyVar -> TcS (Maybe Type) -isFilledMetaTyVar_maybe tv = wrapTcS (TcM.isFilledMetaTyVar_maybe tv) - -isFilledMetaTyVar :: TcTyVar -> TcS Bool -isFilledMetaTyVar tv = wrapTcS (TcM.isFilledMetaTyVar tv) - -isUnfilledMetaTyVar :: TcTyVar -> TcS Bool -isUnfilledMetaTyVar tv = wrapTcS $ TcM.isUnfilledMetaTyVar tv - -zonkTyCoVarsAndFV :: TcTyCoVarSet -> TcS TcTyCoVarSet -zonkTyCoVarsAndFV tvs = liftZonkTcS (TcM.zonkTyCoVarsAndFV tvs) - -zonkTyCoVarsAndFVList :: [TcTyCoVar] -> TcS [TcTyCoVar] -zonkTyCoVarsAndFVList tvs = liftZonkTcS (TcM.zonkTyCoVarsAndFVList tvs) - -zonkCo :: Coercion -> TcS Coercion -zonkCo = wrapTcS . fmap TcM.liftZonkM TcM.zonkCo - -zonkTcType :: TcType -> TcS TcType -zonkTcType ty = liftZonkTcS (TcM.zonkTcType ty) - -zonkTcTypes :: [TcType] -> TcS [TcType] -zonkTcTypes tys = liftZonkTcS (TcM.zonkTcTypes tys) - -zonkTcTyVar :: TcTyVar -> TcS TcType -zonkTcTyVar tv = liftZonkTcS (TcM.zonkTcTyVar tv) - -zonkSimples :: Cts -> TcS Cts -zonkSimples cts = liftZonkTcS (TcM.zonkSimples cts) - -zonkWC :: WantedConstraints -> TcS WantedConstraints -zonkWC wc = liftZonkTcS (TcM.zonkWC wc) - -zonkTyCoVarKind :: TcTyCoVar -> TcS TcTyCoVar -zonkTyCoVarKind tv = liftZonkTcS (TcM.zonkTyCoVarKind tv) - ----------------------------- -pprKicked :: Int -> SDoc -pprKicked 0 = empty -pprKicked n = parens (int n <+> text "kicked out") - -{- ********************************************************************* -* * -* The Unification Level Flag * -* * -********************************************************************* -} - -{- Note [The Unification Level Flag] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider a deep tree of implication constraints - forall[1] a. -- Outer-implic - C alpha[1] -- Simple - forall[2] c. ....(C alpha[1]).... -- Implic-1 - forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 - -The (C alpha) is insoluble until we know alpha. We solve alpha -by unifying alpha:=Int somewhere deep inside Implic-2. But then we -must try to solve the Outer-implic all over again. This time we can -solve (C alpha) both in Outer-implic, and nested inside Implic-1. - -When should we iterate solving a level-n implication? -Answer: if any unification of a tyvar at level n takes place - in the ic_implics of that implication. - -* What if a unification takes place at level n-1? Then don't iterate - level n, because we'll iterate level n-1, and that will in turn iterate - level n. - -* What if a unification takes place at level n, in the ic_simples of - level n? No need to track this, because the kick-out mechanism deals - with it. (We can't drop kick-out in favour of iteration, because kick-out - works for skolem-equalities, not just unifications.) - -So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps -track of - - Whether any unifications at all have taken place (Nothing => no unifications) - - If so, what is the outermost level that has seen a unification (Just lvl) - -The iteration is done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. - -It helpful not to iterate unless there is a chance of progress. #8474 is -an example: - - * There's a deeply-nested chain of implication constraints. - ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int - - * From the innermost one we get a [W] alpha[1] ~ Int, - so we can unify. - - * It's better not to iterate the inner implications, but go all the - way out to level 1 before iterating -- because iterating level 1 - will iterate the inner levels anyway. - -(In the olden days when we "floated" thse Derived constraints, this was -much, much more important -- we got exponential behaviour, as each iteration -produced the same Derived constraint.) --} - - -resetUnificationFlag :: TcS Bool --- We are at ambient level i --- If the unification flag = Just i, reset it to Nothing and return True --- Otherwise leave it unchanged and return False -resetUnificationFlag - = TcS $ \env -> - do { let ref = tcs_unif_lvl env - ; ambient_lvl <- TcM.getTcLevel - ; mb_lvl <- TcM.readTcRef ref - ; TcM.traceTc "resetUnificationFlag" $ - vcat [ text "ambient:" <+> ppr ambient_lvl - , text "unif_lvl:" <+> ppr mb_lvl ] - ; case mb_lvl of - Nothing -> return False - Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl - -> return False - | otherwise - -> do { TcM.writeTcRef ref Nothing - ; return True } } - -setUnificationFlag :: TcLevel -> TcS () --- (setUnificationFlag i) sets the unification level to (Just i) --- unless it already is (Just j) where j <= i -setUnificationFlag lvl - = TcS $ \env -> - do { let ref = tcs_unif_lvl env - ; mb_lvl <- TcM.readTcRef ref - ; case mb_lvl of - Just unif_lvl | lvl `deeperThanOrSame` unif_lvl - -> return () - _ -> TcM.writeTcRef ref (Just lvl) } - - -{- ********************************************************************* -* * -* Instantiation etc. -* * -********************************************************************* -} - --- Instantiations --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -instDFunType :: DFunId -> [DFunInstType] -> TcS ([TcType], TcThetaType) -instDFunType dfun_id inst_tys - = wrapTcS $ TcM.instDFunType dfun_id inst_tys - -newFlexiTcSTy :: Kind -> TcS TcType -newFlexiTcSTy knd = wrapTcS (TcM.newFlexiTyVarTy knd) - -cloneMetaTyVar :: TcTyVar -> TcS TcTyVar -cloneMetaTyVar tv = wrapTcS (TcM.cloneMetaTyVar tv) - -instFlexiX :: Subst -> [TKVar] -> TcS Subst -instFlexiX subst tvs = wrapTcS (instFlexiXTcM subst tvs) - -instFlexiXTcM :: Subst -> [TKVar] -> TcM Subst --- Makes fresh tyvar, extends the substitution, and the in-scope set --- Takes account of the case [k::Type, a::k, ...], --- where we must substitute for k in a's kind -instFlexiXTcM subst [] - = return subst -instFlexiXTcM subst (tv:tvs) - = do { uniq <- TcM.newUnique - ; details <- TcM.newMetaDetails TauTv - ; let name = setNameUnique (tyVarName tv) uniq - kind = substTyUnchecked subst (tyVarKind tv) - tv' = mkTcTyVar name kind details - subst' = extendTvSubstWithClone subst tv tv' - ; instFlexiXTcM subst' tvs } - -matchGlobalInst :: DynFlags - -> Bool -- True <=> caller is the short-cut solver - -- See Note [Shortcut solving: overlap] - -> Class -> [Type] -> CtLoc -> TcS TcM.ClsInstResult -matchGlobalInst dflags short_cut cls tys loc - = wrapTcS $ TcM.setCtLocM loc $ TcM.matchGlobalInst dflags short_cut cls tys - -tcInstSkolTyVarsX :: SkolemInfo -> Subst -> [TyVar] -> TcS (Subst, [TcTyVar]) -tcInstSkolTyVarsX skol_info subst tvs = wrapTcS $ TcM.tcInstSkolTyVarsX skol_info subst tvs - --- Creating and setting evidence variables and CtFlavors --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -data MaybeNew = Fresh CtEvidence | Cached EvExpr - -isFresh :: MaybeNew -> Bool -isFresh (Fresh {}) = True -isFresh (Cached {}) = False - -freshGoals :: [MaybeNew] -> [CtEvidence] -freshGoals mns = [ ctev | Fresh ctev <- mns ] - -getEvExpr :: MaybeNew -> EvExpr -getEvExpr (Fresh ctev) = ctEvExpr ctev -getEvExpr (Cached evt) = evt - -setEvBind :: EvBind -> TcS () -setEvBind ev_bind - = do { evb <- getTcEvBindsVar - ; wrapTcS $ TcM.addTcEvBind evb ev_bind } - --- | Mark variables as used filling a coercion hole -useVars :: CoVarSet -> TcS () -useVars co_vars - = do { ev_binds_var <- getTcEvBindsVar - ; let ref = ebv_tcvs ev_binds_var - ; wrapTcS $ - do { tcvs <- TcM.readTcRef ref - ; let tcvs' = tcvs `unionVarSet` co_vars - ; TcM.writeTcRef ref tcvs' } } - --- | Equalities only -setWantedEq :: HasDebugCallStack => TcEvDest -> Coercion -> TcS () -setWantedEq (HoleDest hole) co - = do { useVars (coVarsOfCo co) - ; fillCoercionHole hole co } -setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) - --- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> CanonicalEvidence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _canonical tm - | Just co <- evTermCoercion_maybe tm - = do { useVars (coVarsOfCo co) - ; fillCoercionHole hole co } - | otherwise - = -- See Note [Yukky eq_sel for a HoleDest] - do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var EvCanonical tm) - ; fillCoercionHole hole (mkCoVarCo co_var) } - -setWantedEvTerm (EvVarDest ev_id) canonical tm - = setEvBind (mkWantedEvBind ev_id canonical tm) - -{- Note [Yukky eq_sel for a HoleDest] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -How can it be that a Wanted with HoleDest gets evidence that isn't -just a coercion? i.e. evTermCoercion_maybe returns Nothing. - -Consider [G] forall a. blah => a ~ T - [W] S ~# T - -Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ T) -in the quantified constraints, and wraps the (boxed) evidence it -gets back in an eq_sel to extract the unboxed (S ~# T). We can't put -that term into a coercion, so we add a value binding - h = eq_sel (...) -and the coercion variable h to fill the coercion hole. -We even re-use the CoHole's Id for this binding! - -Yuk! --} - -fillCoercionHole :: CoercionHole -> Coercion -> TcS () -fillCoercionHole hole co - = do { wrapTcS $ TcM.fillCoercionHole hole co - ; kickOutAfterFillingCoercionHole hole } - -setEvBindIfWanted :: CtEvidence -> CanonicalEvidence -> EvTerm -> TcS () -setEvBindIfWanted ev canonical tm - = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm - _ -> return () - -newTcEvBinds :: TcS EvBindsVar -newTcEvBinds = wrapTcS TcM.newTcEvBinds - -newNoTcEvBinds :: TcS EvBindsVar -newNoTcEvBinds = wrapTcS TcM.newNoTcEvBinds - -newEvVar :: TcPredType -> TcS EvVar -newEvVar pred = wrapTcS (TcM.newEvVar pred) - -newGivenEvVar :: CtLoc -> (TcPredType, EvTerm) -> TcS CtEvidence --- Make a new variable of the given PredType, --- immediately bind it to the given term --- and return its CtEvidence --- See Note [Bind new Givens immediately] in GHC.Tc.Types.Constraint -newGivenEvVar loc (pred, rhs) - = do { new_ev <- newBoundEvVarId pred rhs - ; return (CtGiven { ctev_pred = pred, ctev_evar = new_ev, ctev_loc = loc }) } - --- | Make a new 'Id' of the given type, bound (in the monad's EvBinds) to the --- given term -newBoundEvVarId :: TcPredType -> EvTerm -> TcS EvVar -newBoundEvVarId pred rhs - = do { new_ev <- newEvVar pred - ; setEvBind (mkGivenEvBind new_ev rhs) - ; return new_ev } - -emitNewGivens :: CtLoc -> [(Role,TcCoercion)] -> TcS () -emitNewGivens loc pts - = do { traceTcS "emitNewGivens" (ppr pts) - ; evs <- mapM (newGivenEvVar loc) $ - [ (mkPrimEqPredRole role ty1 ty2, evCoercion co) - | (role, co) <- pts - , let Pair ty1 ty2 = coercionKind co - , not (ty1 `tcEqType` ty2) ] -- Kill reflexive Givens at birth - ; emitWorkNC evs } - -emitNewWantedEq :: CtLoc -> RewriterSet -> Role -> TcType -> TcType -> TcS Coercion --- | Emit a new Wanted equality into the work-list -emitNewWantedEq loc rewriters role ty1 ty2 - = do { (ev, co) <- newWantedEq loc rewriters role ty1 ty2 - ; updWorkListTcS (extendWorkListEq rewriters (mkNonCanonical ev)) - ; return co } - --- | Create a new Wanted constraint holding a coercion hole --- for an equality between the two types at the given 'Role'. -newWantedEq :: CtLoc -> RewriterSet -> Role -> TcType -> TcType - -> TcS (CtEvidence, Coercion) -newWantedEq loc rewriters role ty1 ty2 - = do { hole <- wrapTcS $ TcM.newCoercionHole loc pty - ; return ( CtWanted { ctev_pred = pty - , ctev_dest = HoleDest hole - , ctev_loc = loc - , ctev_rewriters = rewriters } - , mkHoleCo hole ) } - where - pty = mkPrimEqPredRole role ty1 ty2 - --- | Create a new Wanted constraint holding an evidence variable. --- --- Don't use this for equality constraints: use 'newWantedEq' instead. -newWantedEvVarNC :: CtLoc -> RewriterSet - -> TcPredType -> TcS CtEvidence --- Don't look up in the solved/inerts; we know it's not there -newWantedEvVarNC loc rewriters pty - = do { new_ev <- newEvVar pty - ; traceTcS "Emitting new wanted" (ppr new_ev <+> dcolon <+> ppr pty $$ - pprCtLoc loc) - ; return (CtWanted { ctev_pred = pty - , ctev_dest = EvVarDest new_ev - , ctev_loc = loc - , ctev_rewriters = rewriters })} - --- | Like 'newWantedEvVarNC', except it might look up in the inert set --- to see if an inert already exists, and uses that instead of creating --- a new Wanted constraint. --- --- Don't use this for equality constraints: this function is only for --- constraints with 'EvVarDest'. -newWantedEvVar :: CtLoc -> RewriterSet - -> TcPredType -> TcS MaybeNew --- For anything except ClassPred, this is the same as newWantedEvVarNC -newWantedEvVar loc rewriters pty - = assertPpr (not (isEqPrimPred pty)) - (vcat [ text "newWantedEvVar: HoleDestPred" - , text "pty:" <+> ppr pty ]) $ - do { mb_ct <- lookupInInerts loc pty - ; case mb_ct of - Just ctev - -> do { traceTcS "newWantedEvVar/cache hit" $ ppr ctev - ; return $ Cached (ctEvExpr ctev) } - _ -> do { ctev <- newWantedEvVarNC loc rewriters pty - ; return (Fresh ctev) } } - --- | Create a new Wanted constraint, potentially looking up --- non-equality constraints in the cache instead of creating --- a new one from scratch. --- --- Deals with both equality and non-equality constraints. -newWanted :: CtLoc -> RewriterSet -> PredType -> TcS MaybeNew -newWanted loc rewriters pty - | Just (role, ty1, ty2) <- getEqPredTys_maybe pty - = Fresh . fst <$> newWantedEq loc rewriters role ty1 ty2 - | otherwise - = newWantedEvVar loc rewriters pty - --- | Create a new Wanted constraint. --- --- Deals with both equality and non-equality constraints. --- --- Does not attempt to re-use non-equality constraints that already --- exist in the inert set. -newWantedNC :: CtLoc -> RewriterSet -> PredType -> TcS CtEvidence -newWantedNC loc rewriters pty - | Just (role, ty1, ty2) <- getEqPredTys_maybe pty - = fst <$> newWantedEq loc rewriters role ty1 ty2 - | otherwise - = newWantedEvVarNC loc rewriters pty - --- | Checks if the depth of the given location is too much. Fails if --- it's too big, with an appropriate error message. -checkReductionDepth :: CtLoc -> TcType -- ^ type being reduced - -> TcS () -checkReductionDepth loc ty - = do { dflags <- getDynFlags - ; when (subGoalDepthExceeded (reductionDepth dflags) (ctLocDepth loc)) $ - wrapErrTcS $ solverDepthError loc ty } - -matchFam :: TyCon -> [Type] -> TcS (Maybe ReductionN) -matchFam tycon args = wrapTcS $ matchFamTcM tycon args - -matchFamTcM :: TyCon -> [Type] -> TcM (Maybe ReductionN) --- Given (F tys) return (ty, co), where co :: F tys ~N ty -matchFamTcM tycon args - = do { fam_envs <- FamInst.tcGetFamInstEnvs - ; let match_fam_result - = reduceTyFamApp_maybe fam_envs Nominal tycon args - ; TcM.traceTc "matchFamTcM" $ - vcat [ text "Matching:" <+> ppr (mkTyConApp tycon args) - , ppr_res match_fam_result ] - ; return match_fam_result } - where - ppr_res Nothing = text "Match failed" - ppr_res (Just (Reduction co ty)) - = hang (text "Match succeeded:") - 2 (vcat [ text "Rewrites to:" <+> ppr ty - , text "Coercion:" <+> ppr co ]) - -solverDepthError :: CtLoc -> TcType -> TcM a -solverDepthError loc ty - = TcM.setCtLocM loc $ - do { (ty, env0) <- TcM.liftZonkM $ - do { ty <- TcM.zonkTcType ty - ; env0 <- TcM.tcInitTidyEnv - ; return (ty, env0) } - ; let (tidy_env, tidy_ty) = tidyOpenTypeX env0 ty - msg = TcRnSolverDepthError tidy_ty depth - ; TcM.failWithTcM (tidy_env, msg) } - where - depth = ctLocDepth loc - -{- -************************************************************************ -* * - Emitting equalities arising from fundeps -* * -************************************************************************ --} - -emitFunDepWanteds :: CtEvidence -- The work item - -> [FunDepEqn (CtLoc, RewriterSet)] - -> TcS Bool -- True <=> some unification happened - -emitFunDepWanteds _ [] = return False -- common case noop --- See Note [FunDep and implicit parameter reactions] - -emitFunDepWanteds ev fd_eqns - = unifyFunDeps ev Nominal do_fundeps - where - do_fundeps :: UnifyEnv -> TcM () - do_fundeps env = mapM_ (do_one env) fd_eqns - - do_one :: UnifyEnv -> FunDepEqn (CtLoc, RewriterSet) -> TcM () - do_one uenv (FDEqn { fd_qtvs = tvs, fd_eqs = eqs, fd_loc = (loc, rewriters) }) - = do { eqs' <- instantiate_eqs tvs (reverse eqs) - -- (reverse eqs): See Note [Reverse order of fundep equations] - ; uPairsTcM env_one eqs' } - where - env_one = uenv { u_rewriters = u_rewriters uenv S.<> rewriters - , u_loc = loc } - - instantiate_eqs :: [TyVar] -> [TypeEqn] -> TcM [TypeEqn] - instantiate_eqs tvs eqs - | null tvs - = return eqs - | otherwise - = do { TcM.traceTc "emitFunDepWanteds 2" (ppr tvs $$ ppr eqs) - ; subst <- instFlexiXTcM emptySubst tvs -- Takes account of kind substitution - ; return [ Pair (substTyUnchecked subst' ty1) ty2 - -- ty2 does not mention fd_qtvs, so no need to subst it. - -- See GHC.Tc.Instance.Fundeps Note [Improving against instances] - -- Wrinkle (1) - | Pair ty1 ty2 <- eqs - , let subst' = extendSubstInScopeSet subst (tyCoVarsOfType ty1) ] - -- The free vars of ty1 aren't just fd_qtvs: ty1 is the result - -- of matching with the [W] constraint. So we add its free - -- vars to InScopeSet, to satisfy substTy's invariants, even - -- though ty1 will never (currently) be a poytype, so this - -- InScopeSet will never be looked at. - } - -{- -************************************************************************ -* * - Unification -* * -************************************************************************ - -Note [wrapUnifierTcS] -~~~~~~~~~~~~~~~~~~~ -When decomposing equalities we often create new wanted constraints for -(s ~ t). But what if s=t? Then it'd be faster to return Refl right away. - -Rather than making an equality test (which traverses the structure of the type, -perhaps fruitlessly), we call uType (via wrapUnifierTcS) to traverse the common -structure, and bales out when it finds a difference by creating a new deferred -Wanted constraint. But where it succeeds in finding common structure, it just -builds a coercion to reflect it. - -This is all much faster than creating a new constraint, putting it in the -work list, picking it out, canonicalising it, etc etc. - -Note [unifyFunDeps] -~~~~~~~~~~~~~~~~~~~ -The Bool returned by `unifyFunDeps` is True if we have unified a variable -that occurs in the constraint we are trying to solve; it is not in the -inert set so `wrapUnifierTcS` won't kick it out. Instead we want to send it -back to the start of the pipeline. Hence the Bool. - -It's vital that we don't return (not (null unified)) because the fundeps -may create fresh variables; unifying them (alone) should not make us send -the constraint back to the start, or we'll get an infinite loop. See -Note [Fundeps with instances, and equality orientation] in GHC.Tc.Solver.Dict -and Note [Improvement orientation] in GHC.Tc.Solver.Equality. --} - -uPairsTcM :: UnifyEnv -> [TypeEqn] -> TcM () -uPairsTcM uenv eqns = mapM_ (\(Pair ty1 ty2) -> uType uenv ty1 ty2) eqns - -unifyFunDeps :: CtEvidence -> Role - -> (UnifyEnv -> TcM ()) - -> TcS Bool -unifyFunDeps ev role do_unifications - = do { (_, _, unified) <- wrapUnifierTcS ev role do_unifications - ; return (any (`elemVarSet` fvs) unified) } - -- See Note [unifyFunDeps] - where - fvs = tyCoVarsOfType (ctEvPred ev) - -unifyForAllBody :: CtEvidence -> Role -> (UnifyEnv -> TcM a) - -> TcS (a, Cts) --- We /return/ the equality constraints we generate, --- rather than emitting them into the monad. --- See See (SF5) in Note [Solving forall equalities] in GHC.Tc.Solver.Equality -unifyForAllBody ev role unify_body - = do { (res, cts, unified, _rewriters) <- wrapUnifierX ev role unify_body - -- Ignore the rewriters. They are used in wrapUnifierTcS only - -- as an optimistion to prioritise the work list; but they are - -- /also/ stored in each individual constraint we return. - - -- Kick out any inert constraint that we have unified - ; _ <- kickOutAfterUnification unified - - ; return (res, cts) } - -wrapUnifierTcS :: CtEvidence -> Role - -> (UnifyEnv -> TcM a) -- Some calls to uType - -> TcS (a, Bag Ct, [TcTyVar]) --- Invokes the do_unifications argument, with a suitable UnifyEnv. --- Emit deferred equalities and kick-out from the inert set as a --- result of any unifications. --- Very good short-cut when the two types are equal, or nearly so --- See Note [wrapUnifierTcS] --- --- The [TcTyVar] is the list of unification variables that were --- unified the process; the (Bag Ct) are the deferred constraints. - -wrapUnifierTcS ev role do_unifications - = do { (res, cts, unified, rewriters) <- wrapUnifierX ev role do_unifications - - -- Emit the deferred constraints - -- See Note [Work-list ordering] in GHC.Tc.Solved.Equality - -- - -- All the constraints in `cts` share the same rewriter set so, - -- rather than looking at it one by one, we pass it to - -- extendWorkListEqs; just a small optimisation. - ; unless (isEmptyBag cts) $ - updWorkListTcS (extendWorkListEqs rewriters cts) - - -- And kick out any inert constraint that we have unified - ; _ <- kickOutAfterUnification unified - - ; return (res, cts, unified) } - -wrapUnifierX :: CtEvidence -> Role - -> (UnifyEnv -> TcM a) -- Some calls to uType - -> TcS (a, Bag Ct, [TcTyVar], RewriterSet) -wrapUnifierX ev role do_unifications - = do { unif_count_ref <- getUnifiedRef - ; wrapTcS $ - do { defer_ref <- TcM.newTcRef emptyBag - ; unified_ref <- TcM.newTcRef [] - ; rewriters <- TcM.zonkRewriterSet (ctEvRewriters ev) - ; let env = UE { u_role = role - , u_rewriters = rewriters - , u_loc = ctEvLoc ev - , u_defer = defer_ref - , u_unified = Just unified_ref} - - ; res <- do_unifications env - - ; cts <- TcM.readTcRef defer_ref - ; unified <- TcM.readTcRef unified_ref - - -- Don't forget to update the count of variables - -- unified, lest we forget to iterate (#24146) - ; unless (null unified) $ - TcM.updTcRef unif_count_ref (+ (length unified)) - - ; return (res, cts, unified, rewriters) } } - - -{- -************************************************************************ -* * - Breaking type variable cycles -* * -************************************************************************ --} - -checkTouchableTyVarEq - :: CtEvidence - -> TcTyVar -- A touchable meta-tyvar - -> TcType -- The RHS - -> TcS (PuResult () Reduction) --- Used for Nominal, Wanted equalities, with a touchable meta-tyvar on LHS --- If checkTouchableTyVarEq tv ty = PuOK cts redn --- then we can unify --- tv := ty |> redn --- with extra wanteds 'cts' --- If it returns (PuFail reason) we can't unify, and the reason explains why. -checkTouchableTyVarEq ev lhs_tv rhs - | simpleUnifyCheck UC_Solver lhs_tv rhs -- An (optional) short-cut - = do { traceTcS "checkTouchableTyVarEq: simple-check wins" (ppr lhs_tv $$ ppr rhs) - ; return (pure (mkReflRedn Nominal rhs)) } - - | otherwise - = do { traceTcS "checkTouchableTyVarEq {" (ppr lhs_tv $$ ppr rhs) - ; check_result <- wrapTcS (check_rhs rhs) - ; traceTcS "checkTouchableTyVarEq }" (ppr lhs_tv $$ ppr check_result) - ; case check_result of - PuFail reason -> return (PuFail reason) - PuOK cts redn -> do { emitWork cts - ; return (pure redn) } } - - where - (lhs_tv_info, lhs_tv_lvl) = case tcTyVarDetails lhs_tv of - MetaTv { mtv_info = info, mtv_tclvl = lvl } -> (info,lvl) - _ -> pprPanic "checkTouchableTyVarEq" (ppr lhs_tv) - -- lhs_tv should be a meta-tyvar - - is_concrete_lhs_tv = isConcreteInfo lhs_tv_info - - check_rhs rhs - -- Crucial special case for alpha ~ F tys - -- We don't want to flatten that (F tys)! - | Just (TyFamLHS tc tys) <- canTyFamEqLHS_maybe rhs - = if is_concrete_lhs_tv - then failCheckWith (cteProblem cteConcrete) - else recurseIntoTyConApp arg_flags tc tys - | otherwise - = checkTyEqRhs flags rhs - - flags = TEF { tef_foralls = False -- isRuntimeUnkSkol lhs_tv - , tef_fam_app = mkTEFA_Break ev NomEq break_wanted - , tef_unifying = Unifying lhs_tv_info lhs_tv_lvl (LC_Promote False) - , tef_lhs = TyVarLHS lhs_tv - , tef_occurs = cteInsolubleOccurs } - - arg_flags = famAppArgFlags flags - - break_wanted :: FamAppBreaker Ct - break_wanted fam_app - -- Occurs check or skolem escape; so flatten - = do { let fam_app_kind = typeKind fam_app - ; reason <- checkPromoteFreeVars cteInsolubleOccurs - lhs_tv lhs_tv_lvl (tyCoVarsOfType fam_app_kind) - ; if not (cterHasNoProblem reason) -- Failed to promote free vars - then failCheckWith reason - else - do { new_tv_ty <- - case lhs_tv_info of - ConcreteTv conc_info -> - -- Make a concrete tyvar if lhs_tv is concrete - -- e.g. alpha[2,conc] ~ Maybe (F beta[4]) - -- We want to flatten to - -- alpha[2,conc] ~ Maybe gamma[2,conc] - -- gamma[2,conc] ~ F beta[4] - TcM.newConcreteTyVarTyAtLevel conc_info lhs_tv_lvl fam_app_kind - _ -> TcM.newMetaTyVarTyAtLevel lhs_tv_lvl fam_app_kind - - ; let pty = mkPrimEqPredRole Nominal fam_app new_tv_ty - ; hole <- TcM.newVanillaCoercionHole pty - ; let new_ev = CtWanted { ctev_pred = pty - , ctev_dest = HoleDest hole - , ctev_loc = cb_loc - , ctev_rewriters = ctEvRewriters ev } - ; return (PuOK (singleCt (mkNonCanonical new_ev)) - (mkReduction (HoleCo hole) new_tv_ty)) } } - - -- See Detail (7) of the Note - cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin - ------------------------- -checkTypeEq :: CtEvidence -> EqRel -> CanEqLHS -> TcType - -> TcS (PuResult () Reduction) --- Used for general CanEqLHSs, ones that do --- not have a touchable type variable on the LHS (i.e. not unifying) -checkTypeEq ev eq_rel lhs rhs - | isGiven ev - = do { traceTcS "checkTypeEq {" (vcat [ text "lhs:" <+> ppr lhs - , text "rhs:" <+> ppr rhs ]) - ; check_result <- wrapTcS (check_given_rhs rhs) - ; traceTcS "checkTypeEq }" (ppr check_result) - ; case check_result of - PuFail reason -> return (PuFail reason) - PuOK prs redn -> do { new_givens <- mapBagM mk_new_given prs - ; emitWork new_givens - ; updInertSet (addCycleBreakerBindings prs) - ; return (pure redn) } } - - | otherwise -- Wanted - = do { check_result <- wrapTcS (checkTyEqRhs wanted_flags rhs) - ; case check_result of - PuFail reason -> return (PuFail reason) - PuOK cts redn -> do { emitWork cts - ; return (pure redn) } } - where - check_given_rhs :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) - check_given_rhs rhs - -- See Note [Special case for top-level of Given equality] - | Just (TyFamLHS tc tys) <- canTyFamEqLHS_maybe rhs - = recurseIntoTyConApp arg_flags tc tys - | otherwise - = checkTyEqRhs given_flags rhs - - arg_flags = famAppArgFlags given_flags - - given_flags :: TyEqFlags (TcTyVar,TcType) - given_flags = TEF { tef_lhs = lhs - , tef_foralls = False - , tef_unifying = NotUnifying - , tef_fam_app = mkTEFA_Break ev eq_rel break_given - , tef_occurs = occ_prob } - -- TEFA_Break used for: [G] a ~ Maybe (F a) - -- or [W] F a ~ Maybe (F a) - - wanted_flags = TEF { tef_lhs = lhs - , tef_foralls = False - , tef_unifying = NotUnifying - , tef_fam_app = TEFA_Recurse - , tef_occurs = occ_prob } - -- TEFA_Recurse: see Note [Don't cycle-break Wanteds when not unifying] - - -- occ_prob: see Note [Occurs check and representational equality] - occ_prob = case eq_rel of - NomEq -> cteInsolubleOccurs - ReprEq -> cteSolubleOccurs - - break_given :: TcType -> TcM (PuResult (TcTyVar,TcType) Reduction) - break_given fam_app - = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) - ; return (PuOK (unitBag (new_tv, fam_app)) - (mkReflRedn Nominal (mkTyVarTy new_tv))) } - -- Why reflexive? See Detail (4) of the Note - - --------------------------- - mk_new_given :: (TcTyVar, TcType) -> TcS Ct - mk_new_given (new_tv, fam_app) - = mkNonCanonical <$> newGivenEvVar cb_loc (given_pred, given_term) - where - new_ty = mkTyVarTy new_tv - given_pred = mkPrimEqPred fam_app new_ty - given_term = evCoercion $ mkNomReflCo new_ty -- See Detail (4) of Note - - -- See Detail (7) of the Note - cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin - -mkTEFA_Break :: CtEvidence -> EqRel -> FamAppBreaker a -> TyEqFamApp a -mkTEFA_Break ev eq_rel breaker - | NomEq <- eq_rel - , not cycle_breaker_origin - = TEFA_Break breaker - | otherwise - = TEFA_Recurse - where - -- cycle_breaker_origin: see Detail (7) of Note [Type equality cycles] - -- in GHC.Tc.Solver.Equality - cycle_breaker_origin = case ctLocOrigin (ctEvLoc ev) of - CycleBreakerOrigin {} -> True - _ -> False - -------------------------- --- | Fill in CycleBreakerTvs with the variables they stand for. --- See Note [Type equality cycles] in GHC.Tc.Solver.Equality -restoreTyVarCycles :: InertSet -> TcM () -restoreTyVarCycles is - = TcM.liftZonkM - $ forAllCycleBreakerBindings_ (inert_cycle_breakers is) TcM.writeMetaTyVar -{-# SPECIALISE forAllCycleBreakerBindings_ :: - CycleBreakerVarStack -> (TcTyVar -> TcType -> ZonkM ()) -> ZonkM () #-} - - -{- Note [Occurs check and representational equality] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -(a ~R# b a) is soluble if b later turns out to be Identity -So we treat this as a "soluble occurs check". - -Note [Special case for top-level of Given equality] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We take care when examining - [G] F ty ~ G (...(F ty)...) -where both sides are TyFamLHSs. We don't want to flatten that RHS to - [G] F ty ~ cbv - [G] G (...(F ty)...) ~ cbv -Instead we'd like to say "occurs-check" and swap LHS and RHS, which yields a -canonical constraint - [G] G (...(F ty)...) ~ F ty -That tents to rewrite a big type to smaller one. This happens in T15703, -where we had: - [G] Pure g ~ From1 (To1 (Pure g)) -Making a loop breaker and rewriting left to right just makes much bigger -types than swapping it over. - -(We might hope to have swapped it over before getting to checkTypeEq, -but better safe than sorry.) - -NB: We never see a TyVarLHS here, such as - [G] a ~ F tys here -because we'd have swapped it to - [G] F tys ~ a -in canEqCanLHS2, before getting to checkTypeEq. +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Monadic definitions for the constraint solver +module GHC.Tc.Solver.Monad ( + + -- The TcS monad + TcS(..), TcSEnv(..), + runTcS, runTcSEarlyAbort, runTcSWithEvBinds, runTcSInerts, + failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, + runTcSEqualities, + nestTcS, nestImplicTcS, tryShortCutTcS, + setEvBindsTcS, setTcLevelTcS, + emitFunDepWanteds, + + selectNextWorkItem, + getWorkList, + updWorkListTcS, + pushLevelNoWorkList, + + runTcPluginTcS, recordUsedGREs, + matchGlobalInst, TcM.ClsInstResult(..), + + QCInst(..), + + -- TcSMode + TcSMode(..), getTcSMode, setTcSMode, vanillaTcSMode, + + -- The pipeline + StopOrContinue(..), continueWith, stopWith, + startAgainWith, SolverStage(Stage, runSolverStage), simpleStage, + stopWithStage, nopStage, + + -- Tracing etc + panicTcS, traceTcS, tryEarlyAbortTcS, + traceFireTcS, bumpStepCountTcS, csTraceTcS, + wrapErrTcS, wrapWarnTcS, + resetUnificationFlag, setUnificationFlag, + + -- Evidence creation and transformation + MaybeNew(..), freshGoals, isFresh, getEvExpr, + CanonicalEvidence(..), + + newTcEvBinds, newNoTcEvBinds, + newWantedEq, emitNewWantedEq, + newWanted, + newWantedNC, newWantedEvVarNC, + newBoundEvVarId, + unifyTyVar, reportUnifications, + setEvBind, setWantedEq, + setWantedEvTerm, setEvBindIfWanted, + newEvVar, newGivenEvVar, emitNewGivens, + checkReductionDepth, + + getInstEnvs, getFamInstEnvs, -- Getting the environments + getTopEnv, getGblEnv, getLclEnv, setSrcSpan, + getTcEvBindsVar, getTcLevel, + getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, + tcLookupClass, tcLookupId, tcLookupTyCon, + + getUnifiedRef, + + + -- Inerts + updInertSet, updInertCans, + getHasGivenEqs, setInertCans, + getInertEqs, getInertCans, getInertGivens, + getInertInsols, getInnermostGivenEqLevel, + getInertSet, setInertSet, + getUnsolvedInerts, + removeInertCts, getPendingGivenScs, + insertFunEq, addInertQCI, + updInertDicts, updInertIrreds, + emitWorkNC, emitWork, + lookupInertDict, + + -- The Model + kickOutAfterUnification, kickOutRewritable, + + -- Inert Safe Haskell safe-overlap failures + insertSafeOverlapFailureTcS, + getSafeOverlapFailures, + + -- Inert solved dictionaries + getSolvedDicts, setSolvedDicts, + updSolvedDicts, lookupSolvedDict, + + -- Irreds + foldIrreds, + + -- The family application cache + lookupFamAppInert, lookupFamAppCache, extendFamAppCache, + pprKicked, + + -- Instantiation + instDFunType, + + -- Unification + wrapUnifierX, wrapUnifierTcS, unifyFunDeps, uPairsTcM, unifyForAllBody, + + -- MetaTyVars + newFlexiTcSTy, instFlexiX, + cloneMetaTyVar, + tcInstSkolTyVarsX, + + TcLevel, + isFilledMetaTyVar_maybe, isFilledMetaTyVar, isUnfilledMetaTyVar, + zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo, + zonkTyCoVarsAndFVList, + zonkSimples, zonkWC, + zonkTyCoVarKind, + + -- References + newTcRef, readTcRef, writeTcRef, updTcRef, + + -- Misc + getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS, + matchFam, matchFamTcM, + checkWellLevelledDFun, + pprEq, + + -- Enforcing invariants for type equalities + checkTypeEq +) where + +import GHC.Prelude + +import GHC.Driver.Env + +import qualified GHC.Tc.Utils.Instantiate as TcM +import GHC.Core.InstEnv +import GHC.Tc.Instance.Family as FamInst +import GHC.Core.FamInstEnv + +import qualified GHC.Tc.Utils.Monad as TcM +import qualified GHC.Tc.Utils.TcMType as TcM +import qualified GHC.Tc.Instance.Class as TcM( matchGlobalInst, ClsInstResult(..) ) +import qualified GHC.Tc.Utils.Env as TcM + ( tcGetDefaultTys + , tcLookupClass, tcLookupId, tcLookupTyCon + ) +import GHC.Tc.Zonk.Monad ( ZonkM ) +import qualified GHC.Tc.Zonk.TcType as TcM + +import GHC.Driver.DynFlags + +import GHC.Tc.Instance.Class( safeOverlap, instanceReturnsDictCon ) +import GHC.Tc.Instance.FunDeps( FunDepEqn(..) ) +import GHC.Utils.Misc + + +import GHC.Tc.Solver.Types +import GHC.Tc.Solver.InertSet +import GHC.Tc.Errors.Types + +import GHC.Tc.Utils.TcType +import GHC.Tc.Utils.Unify + +import GHC.Tc.Types.Evidence +import GHC.Tc.Types +import GHC.Tc.Types.Origin +import GHC.Tc.Types.CtLoc +import GHC.Tc.Types.Constraint + +import GHC.Builtin.Names ( unsatisfiableClassNameKey, callStackTyConName, exceptionContextTyConName ) + +import GHC.Core.Type +import GHC.Core.TyCo.Rep as Rep +import GHC.Core.TyCo.Tidy +import GHC.Core.Coercion +import GHC.Core.Coercion.Axiom( TypeEqn ) +import GHC.Core.Predicate +import GHC.Core.Reduction +import GHC.Core.Class +import GHC.Core.TyCon +import GHC.Core.Unify (typesAreApart) + +import GHC.Types.Name +import GHC.Types.TyThing +import GHC.Types.Name.Reader +import GHC.Types.DefaultEnv ( DefaultEnv ) +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Unique.Supply +import GHC.Types.Unique.Set( elementOfUniqSet ) +import GHC.Types.Id +import GHC.Types.Basic (allImportLevels) +import GHC.Types.ThLevelIndex (thLevelIndexFromImportLevel) +import GHC.Types.SrcLoc + +import GHC.Unit.Module +import qualified GHC.Rename.Env as TcM +import GHC.Rename.Env + +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Logger + +import GHC.Data.Bag as Bag +import GHC.Data.Pair + +import GHC.Utils.Monad + +import GHC.Exts (oneShot) +import Control.Monad +import Data.Foldable hiding ( foldr1 ) +import Data.IORef +import Data.Maybe( catMaybes ) +import Data.List ( mapAccumL ) +import Data.List.NonEmpty ( nonEmpty ) +import qualified Data.List.NonEmpty as NE +import qualified Data.Semigroup as S +import GHC.LanguageExtensions as LangExt + +#if defined(DEBUG) +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Data.Graph.Directed +#endif + +import qualified Data.Set as Set +import GHC.Unit.Module.Graph + +{- ********************************************************************* +* * + SolverStage and StopOrContinue +* * +********************************************************************* -} + +{- Note [The SolverStage monad] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The SolverStage monad allows us to write simple code like that in +GHC.Tc.Solver.solveEquality. At the time of writing it looked like +this (may get out of date but the idea is clear): + +solveEquality :: ... -> SolverStage Void +solveEquality ev eq_rel ty1 ty2 + = do { Pair ty1' ty2' <- zonkEqTypes ev eq_rel ty1 ty2 + ; mb_canon <- canonicaliseEquality ev' eq_rel ty1' ty2' + ; case mb_canon of { + Left irred_ct -> do { tryQCsIrredEqCt irred_ct + ; solveIrred irred_ct } ; + Right eq_ct -> do { tryInertEqs eq_ct + ; tryFunDeps eq_ct + ; tryQCsEqCt eq_ct + ; simpleStage (updInertEqs eq_ct) + ; stopWithStage (eqCtEvidence eq_ct) ".." }}} + +Each sub-stage can elect to + (a) ContinueWith: continue to the next stasge + (b) StartAgain: start again at the beginning of the pipeline + (c) Stop: stop altogether; constraint is solved + +These three possiblities are described by the `StopOrContinue` data type. +The `SolverStage` monad does the plumbing. + +Notes: + +(SM1) Each individual stage pretty quickly drops down into + TcS (StopOrContinue a) + because the monadic plumbing of `SolverStage` is relatively ineffienct, + with that three-way split. + +(SM2) We use `SolverStage Void` to express the idea that ContinueWith is + impossible; we don't need to pattern match on it as a possible outcome:A + see GHC.Tc.Solver.Solve.solveOne. To that end, ContinueWith is strict. +-} + +data StopOrContinue a + = StartAgain Ct -- Constraint is not solved, but some unifications + -- happened, so go back to the beginning of the pipeline + + | ContinueWith !a -- The constraint was not solved, although it may have + -- been rewritten. It is strict so that + -- ContinueWith Void can't happen; see (SM2) in + -- Note [The SolverStage monad] + + | Stop CtEvidence -- The (rewritten) constraint was solved + SDoc -- Tells how it was solved + -- Any new sub-goals have been put on the work list + deriving (Functor) + +instance Outputable a => Outputable (StopOrContinue a) where + ppr (Stop ev s) = text "Stop" <> parens (s $$ text "ev:" <+> ppr ev) + ppr (ContinueWith w) = text "ContinueWith" <+> ppr w + ppr (StartAgain w) = text "StartAgain" <+> ppr w + +newtype SolverStage a = Stage { runSolverStage :: TcS (StopOrContinue a) } + deriving( Functor ) + +instance Applicative SolverStage where + pure x = Stage (return (ContinueWith x)) + (<*>) = ap + +instance Monad SolverStage where + return = pure + (Stage m) >>= k = Stage $ + do { soc <- m + ; case soc of + StartAgain x -> return (StartAgain x) + Stop ev d -> return (Stop ev d) + ContinueWith x -> runSolverStage (k x) } + +nopStage :: a -> SolverStage a +nopStage res = Stage (continueWith res) + +simpleStage :: TcS a -> SolverStage a +-- Always does a ContinueWith; no Stop or StartAgain +simpleStage thing = Stage (do { res <- thing; continueWith res }) + +startAgainWith :: Ct -> TcS (StopOrContinue a) +startAgainWith ct = return (StartAgain ct) + +continueWith :: a -> TcS (StopOrContinue a) +continueWith ct = return (ContinueWith ct) + +stopWith :: CtEvidence -> String -> TcS (StopOrContinue a) +stopWith ev s = return (Stop ev (text s)) + +stopWithStage :: CtEvidence -> String -> SolverStage a +stopWithStage ev s = Stage (stopWith ev s) + + +{- ********************************************************************* +* * + Inert instances: inert_qcis +* * +********************************************************************* -} + +addInertQCI :: QCInst -> TcS () +-- Add a local quantified constraint, typically arising from a type signature +addInertQCI new_qci + = do { ics <- getInertCans + ; ics1 <- add_qci ics + + -- Update given equalities. C.f updateGivenEqs + ; tclvl <- getTcLevel + ; let body_pred = qci_body new_qci + not_equality = isClassPred body_pred && not (isEqClassPred body_pred) + -- True <=> definitely not an equality + -- A qci_body like (f a) might be an equality + + ics2 | not_equality = ics1 + | otherwise = ics1 { inert_given_eq_lvl = tclvl + , inert_given_eqs = True } + + ; setInertCans ics2 } + where + add_qci :: InertCans -> TcS InertCans + -- See Note [Do not add duplicate quantified instances] + add_qci ics@(IC { inert_qcis = qcis }) + | any same_qci qcis + = do { traceTcS "skipping duplicate quantified instance" (ppr new_qci) + ; return ics } + + | otherwise + = do { traceTcS "adding new inert quantified instance" (ppr new_qci) + ; return (ics { inert_qcis = new_qci : qcis }) } + + same_qci old_qci = tcEqType (ctEvPred (qci_ev old_qci)) + (ctEvPred (qci_ev new_qci)) + +{- Note [Do not add duplicate quantified instances] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As an optimisation, we avoid adding duplicate quantified instances to the +inert set; we use a simple duplicate check using tcEqType for simplicity, +even though it doesn't account for superficial differences, e.g. it will count +the following two constraints as different (#22223): + + - forall a b. C a b + - forall b a. C a b + +The main logic that allows us to pick local instances, even in the presence of +duplicates, is explained in Note [Use only the best matching quantified constraint] +in GHC.Tc.Solver.Dict. +-} + +updInertDicts :: DictCt -> TcS () +updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys }) + = do { traceTcS "Adding inert dict" (ppr dict_ct $$ ppr cls <+> ppr tys) + + ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys + -> -- For [G] ?x::ty, remove any dicts mentioning ?x, + -- from /both/ inert_cans /and/ inert_solved_dicts (#23761) + -- See (SIP1) and (SIP2) in Note [Shadowing of implicit parameters] + updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) -> + inerts { inert_cans = updDicts (filterDicts (does_not_mention_ip_for str_ty)) ics + , inert_solved_dicts = filterDicts (does_not_mention_ip_for str_ty) solved } + | otherwise + -> return () + -- Add the new constraint to the inert set + ; updInertCans (updDicts (addDict dict_ct)) } + where + -- Does this class constraint or any of its superclasses mention + -- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'? + does_not_mention_ip_for :: Type -> DictCt -> Bool + does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys }) + = not $ mightMentionIP (not . typesAreApart str_ty) (const True) cls tys + -- See Note [Using typesAreApart when calling mightMentionIP] + -- in GHC.Core.Predicate + +updInertIrreds :: IrredCt -> TcS () +updInertIrreds irred + = do { tc_lvl <- getTcLevel + ; updInertCans $ addIrredToCans tc_lvl irred } + +{- ********************************************************************* +* * + Kicking out +* * +************************************************************************ +-} + + +----------------------------------------- +kickOutRewritable :: KickOutSpec -> CtFlavourRole -> TcS () +kickOutRewritable ko_spec new_fr + = do { ics <- getInertCans + ; let (kicked_out, ics') = kickOutRewritableLHS ko_spec new_fr ics + n_kicked = lengthBag kicked_out + ; setInertCans ics' + + ; unless (isEmptyBag kicked_out) $ + do { emitWork kicked_out + + -- The famapp-cache contains Given evidence from the inert set. + -- If we're kicking out Givens, we need to remove this evidence + -- from the cache, too. + ; let kicked_given_ev_vars = foldr add_one emptyVarSet kicked_out + add_one :: Ct -> VarSet -> VarSet + add_one ct vs | CtGiven (GivenCt { ctev_evar = ev_var }) <- ctEvidence ct + = vs `extendVarSet` ev_var + | otherwise = vs + + ; when (new_fr `eqCanRewriteFR` (Given, NomEq) && + -- if this isn't true, no use looking through the constraints + not (isEmptyVarSet kicked_given_ev_vars)) $ + do { traceTcS "Given(s) have been kicked out; drop from famapp-cache" + (ppr kicked_given_ev_vars) + ; dropFromFamAppCache kicked_given_ev_vars } + + ; csTraceTcS $ + hang (text "Kick out") + 2 (vcat [ text "n-kicked =" <+> int n_kicked + , text "kicked_out =" <+> ppr kicked_out + , text "Residual inerts =" <+> ppr ics' ]) } } + +kickOutAfterUnification :: [TcTyVar] -> TcS () +kickOutAfterUnification tv_list = case nonEmpty tv_list of + Nothing -> return () + Just tvs -> do + { let tv_set = mkVarSet tv_list + + ; n_kicked <- kickOutRewritable (KOAfterUnify tv_set) (Given, NomEq) + -- Given because the tv := xi is given; NomEq because + -- only nominal equalities are solved by unification + + -- Set the unification flag if we have done outer unifications + -- that might affect an earlier implication constraint + ; let min_tv_lvl = foldr1 minTcLevel (NE.map tcTyVarLevel tvs) + ; ambient_lvl <- getTcLevel + ; when (ambient_lvl `strictlyDeeperThan` min_tv_lvl) $ + setUnificationFlag min_tv_lvl + + ; traceTcS "kickOutAfterUnification" (ppr tvs $$ text "n_kicked =" <+> ppr n_kicked) + ; return n_kicked } + +kickOutAfterFillingCoercionHole :: CoercionHole -> TcS () +-- See Wrinkle (URW2) in Note [Unify only if the rewriter set is empty] +-- in GHC.Tc.Solver.Equality +-- +-- It's possible that this could just go ahead and unify, but could there +-- be occurs-check problems? Seems simpler just to kick out. +kickOutAfterFillingCoercionHole hole + = do { ics <- getInertCans + ; let (kicked_out, ics') = kick_out ics + n_kicked = length kicked_out + + ; unless (n_kicked == 0) $ + do { updWorkListTcS (extendWorkListRewrittenEqs kicked_out) + ; csTraceTcS $ + hang (text "Kick out, hole =" <+> ppr hole) + 2 (vcat [ text "n-kicked =" <+> int n_kicked + , text "kicked_out =" <+> ppr kicked_out + , text "Residual inerts =" <+> ppr ics' ]) } + + ; setInertCans ics' } + where + kick_out :: InertCans -> ([EqCt], InertCans) + kick_out ics@(IC { inert_eqs = eqs }) + = (eqs_to_kick, ics { inert_eqs = eqs_to_keep }) + where + (eqs_to_kick, eqs_to_keep) = partitionInertEqs kick_out_eq eqs + + kick_out_eq :: EqCt -> Bool -- True: kick out; False: keep. + kick_out_eq (EqCt { eq_ev = ev ,eq_lhs = lhs }) + | CtWanted (WantedCt { ctev_rewriters = RewriterSet rewriters }) <- ev + , TyVarLHS tv <- lhs + , isMetaTyVar tv + = hole `elementOfUniqSet` rewriters + | otherwise + = False + +-------------- +insertSafeOverlapFailureTcS :: InstanceWhat -> DictCt -> TcS () +-- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver +insertSafeOverlapFailureTcS what item + | safeOverlap what + = return () + | otherwise + = updInertSet (\is -> is { inert_safehask = addDict item (inert_safehask is) }) + +getSafeOverlapFailures :: TcS (Bag DictCt) +-- See Note [Safe Haskell Overlapping Instances Implementation] in GHC.Tc.Solver +getSafeOverlapFailures + = do { IS { inert_safehask = safehask } <- getInertSet + ; return $ foldDicts consBag safehask emptyBag } + +-------------- +updSolvedDicts :: InstanceWhat -> DictCt -> TcS () +-- Conditionally add a new item in the solved set of the monad +-- See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet +updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev }) + | isWanted ev + , instanceReturnsDictCon what + = do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName + ; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName + ; let contains_callstack_or_exceptionCtx = + mightMentionIP + (const True) + -- NB: the name of the call-stack IP is irrelevant + -- e.g (?foo :: CallStack) counts! + (is_callstack <||> is_exceptionCtx) + cls tys + -- See Note [Don't add HasCallStack constraints to the solved set] + ; unless contains_callstack_or_exceptionCtx $ + do { traceTcS "updSolvedDicts:" $ ppr dict_ct + ; updInertSet $ \ ics -> + ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) } + } } + | otherwise + = return () + where + + -- Return a predicate that decides whether a type is CallStack + -- or ExceptionContext, accounting for e.g. type family reduction, as + -- per Note [Using typesAreApart when calling mightMentionIP]. + -- + -- See Note [Using isCallStackTy in mightMentionIP]. + is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool) + is_tyConTy is_eq tc_name + = do { (mb_tc, _) <- wrapTcS $ TcM.tryTc $ TcM.tcLookupTyCon tc_name + ; case mb_tc of + Just tc -> + return $ \ ty -> not (typesAreApart ty (mkTyConTy tc)) + Nothing -> + return is_eq + } + +{- Note [Don't add HasCallStack constraints to the solved set] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must not add solved Wanted dictionaries that mention HasCallStack constraints +to the solved set, or we might fail to accumulate the proper call stack, as was +reported in #25529. + +Recall that HasCallStack constraints (and the related HasExceptionContext +constraints) are implicit parameter constraints, and are accumulated as per +Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence. + +When we solve a Wanted that contains a HasCallStack constraint, we don't want +to cache the result, because re-using that solution means re-using the call-stack +in a different context! + +See also Note [Shadowing of implicit parameters], which deals with a similar +problem with Given implicit parameter constraints. + +Note [Using isCallStackTy in mightMentionIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To implement Note [Don't add HasCallStack constraints to the solved set], +we need to check whether a constraint contains a HasCallStack or HasExceptionContext +constraint. We do this using the 'mentionsIP' function, but as per +Note [Using typesAreApart when calling mightMentionIP] we don't want to simply do: + + mightMentionIP + (const True) -- (ignore the implicit parameter string) + (isCallStackTy <||> isExceptionContextTy) + +because this does not account for e.g. a type family that reduces to CallStack. +The predicate we want to use instead is: + + \ ty -> not (typesAreApart ty callStackTy && typesAreApart ty exceptionContextTy) + +However, this is made difficult by the fact that CallStack and ExceptionContext +are not wired-in types; they are only known-key. This means we must look them +up using 'tcLookupTyCon'. However, this might fail, e.g. if we are in the middle +of typechecking ghc-internal and these data-types have not been typechecked yet! + +In that case, we simply fall back to the naive 'isCallStackTy'/'isExceptionContextTy' +logic. + +Note that it would be somewhat painful to wire-in ExceptionContext: at the time +of writing (March 2025), this would require wiring in the ExceptionAnnotation +class, as well as SomeExceptionAnnotation, which is a data type with existentials. +-} + +getSolvedDicts :: TcS (DictMap DictCt) +getSolvedDicts = do { ics <- getInertSet; return (inert_solved_dicts ics) } + +setSolvedDicts :: DictMap DictCt -> TcS () +setSolvedDicts solved_dicts + = updInertSet $ \ ics -> + ics { inert_solved_dicts = solved_dicts } + +{- ********************************************************************* +* * + Other inert-set operations +* * +********************************************************************* -} + +updInertSet :: (InertSet -> InertSet) -> TcS () +-- Modify the inert set with the supplied function +updInertSet upd_fn + = do { is_var <- getInertSetRef + ; wrapTcS (do { curr_inert <- TcM.readTcRef is_var + ; TcM.writeTcRef is_var (upd_fn curr_inert) }) } + +getInertCans :: TcS InertCans +getInertCans = do { inerts <- getInertSet; return (inert_cans inerts) } + +setInertCans :: InertCans -> TcS () +setInertCans ics = updInertSet $ \ inerts -> inerts { inert_cans = ics } + +updRetInertCans :: (InertCans -> (a, InertCans)) -> TcS a +-- Modify the inert set with the supplied function +updRetInertCans upd_fn + = do { is_var <- getInertSetRef + ; wrapTcS (do { inerts <- TcM.readTcRef is_var + ; let (res, cans') = upd_fn (inert_cans inerts) + ; TcM.writeTcRef is_var (inerts { inert_cans = cans' }) + ; return res }) } + +updInertCans :: (InertCans -> InertCans) -> TcS () +-- Modify the inert set with the supplied function +updInertCans upd_fn + = updInertSet $ \ inerts -> inerts { inert_cans = upd_fn (inert_cans inerts) } + +getInertEqs :: TcS InertEqs +getInertEqs = do { inert <- getInertCans; return (inert_eqs inert) } + +getInnermostGivenEqLevel :: TcS TcLevel +getInnermostGivenEqLevel = do { inert <- getInertCans + ; return (inert_given_eq_lvl inert) } + +-- | Retrieves all insoluble constraints from the inert set, +-- specifically including Given constraints. +-- +-- This consists of: +-- +-- - insoluble equalities, such as @Int ~# Bool@; +-- - constraints that are top-level custom type errors, of the form +-- @TypeError msg@, but not constraints such as @Eq (TypeError msg)@ +-- in which the type error is nested; +-- - unsatisfiable constraints, of the form @Unsatisfiable msg@. +-- +-- The inclusion of Givens is important for pattern match warnings, as we +-- want to consider a pattern match that introduces insoluble Givens to be +-- redundant (see Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver). +getInertInsols :: TcS Cts +getInertInsols + = do { inert <- getInertCans + ; let insols = filterBag insolubleIrredCt (inert_irreds inert) + unsats = findDictsByTyConKey (inert_dicts inert) unsatisfiableClassNameKey + ; return $ fmap CDictCan unsats `unionBags` fmap CIrredCan insols } + +getInertGivens :: TcS [Ct] +-- Returns the Given constraints in the inert set +getInertGivens + = do { inerts <- getInertCans + ; let all_cts = foldIrreds ((:) . CIrredCan) (inert_irreds inerts) + $ foldDicts ((:) . CDictCan) (inert_dicts inerts) + $ foldFunEqs ((:) . CEqCan) (inert_funeqs inerts) + $ foldTyEqs ((:) . CEqCan) (inert_eqs inerts) + $ [] + ; return (filter isGivenCt all_cts) } + +getPendingGivenScs :: TcS [Ct] +-- Find all inert Given dictionaries, or quantified constraints, such that +-- 1. cc_pend_sc flag has fuel strictly > 0 +-- 2. belongs to the current level +-- For each such dictionary: +-- * Return it (with unmodified cc_pend_sc) in sc_pending +-- * Modify the dict in the inert set to have cc_pend_sc = doNotExpand +-- to record that we have expanded superclasses for this dict +getPendingGivenScs = do { lvl <- getTcLevel + ; updRetInertCans (get_sc_pending lvl) } + +get_sc_pending :: TcLevel -> InertCans -> ([Ct], InertCans) +get_sc_pending this_lvl ic@(IC { inert_dicts = dicts, inert_qcis = insts }) + = assertPpr (all isGivenCt sc_pending) (ppr sc_pending) + -- When getPendingScDics is called, + -- there are never any Wanteds in the inert set + (sc_pending, ic { inert_dicts = dicts', inert_qcis = insts' }) + where + sc_pending = sc_pend_insts ++ map CDictCan sc_pend_dicts + + sc_pend_dicts :: [DictCt] + sc_pend_dicts = foldDicts get_pending dicts [] + dicts' = foldr exhaustAndAdd dicts sc_pend_dicts + + (sc_pend_insts, insts') = mapAccumL get_pending_inst [] insts + + exhaustAndAdd :: DictCt -> DictMap DictCt -> DictMap DictCt + exhaustAndAdd ct dicts = addDict (ct {di_pend_sc = doNotExpand}) dicts + -- Exhaust the fuel for this constraint before adding it as + -- we don't want to expand these constraints again + + get_pending :: DictCt -> [DictCt] -> [DictCt] -- Get dicts with cc_pend_sc > 0 + get_pending dict dicts + | isPendingScDictCt dict + , belongs_to_this_level (dictCtEvidence dict) + = dict : dicts + | otherwise + = dicts + + get_pending_inst :: [Ct] -> QCInst -> ([Ct], QCInst) + get_pending_inst cts qci@(QCI { qci_ev = ev }) + | Just qci' <- pendingScInst_maybe qci + , belongs_to_this_level ev + = (CQuantCan qci : cts, qci') + -- qci' have their fuel exhausted + -- we don't want to expand these constraints again + -- qci is expanded + | otherwise + = (cts, qci) + + belongs_to_this_level ev = ctLocLevel (ctEvLoc ev) `sameDepthAs` this_lvl + -- We only want Givens from this level; see (3a) in + -- Note [The superclass story] in GHC.Tc.Solver.Dict + +getUnsolvedInerts :: TcS Cts -- All simple constraints +-- Return all the unsolved [Wanted] constraints +-- +-- Post-condition: the returned simple constraints are all fully zonked +-- (because they come from the inert set) +-- the unsolved implics may not be +getUnsolvedInerts + = do { IC { inert_eqs = tv_eqs + , inert_funeqs = fun_eqs + , inert_irreds = irreds + , inert_dicts = idicts + , inert_qcis = qcis + } <- getInertCans + + ; let unsolved_tv_eqs = foldTyEqs (add_if_unsolved CEqCan) tv_eqs emptyCts + unsolved_fun_eqs = foldFunEqs (add_if_unsolved CEqCan) fun_eqs emptyCts + unsolved_irreds = foldr (add_if_unsolved CIrredCan) emptyCts irreds + unsolved_dicts = foldDicts (add_if_unsolved CDictCan) idicts emptyCts + unsolved_qcis = foldr (add_if_unsolved CQuantCan) emptyCts qcis + + ; traceTcS "getUnsolvedInerts" $ + vcat [ text " tv eqs =" <+> ppr unsolved_tv_eqs + , text "fun eqs =" <+> ppr unsolved_fun_eqs + , text "dicts =" <+> ppr unsolved_dicts + , text "irreds =" <+> ppr unsolved_irreds ] + + ; return ( unsolved_tv_eqs `unionBags` + unsolved_fun_eqs `unionBags` + unsolved_irreds `unionBags` + unsolved_dicts `unionBags` + unsolved_qcis ) } + where + add_if_unsolved :: (a -> Ct) -> a -> Cts -> Cts + add_if_unsolved mk_ct thing cts + | isWantedCt ct = ct `consCts` cts + | otherwise = cts + where + ct = mk_ct thing + + +getHasGivenEqs :: TcLevel -- TcLevel of this implication + -> TcS ( HasGivenEqs -- are there Given equalities? + , InertIrreds ) -- Insoluble equalities arising from givens +-- See Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet +getHasGivenEqs tclvl + = do { inerts@(IC { inert_irreds = irreds + , inert_given_eqs = given_eqs + , inert_given_eq_lvl = ge_lvl }) + <- getInertCans + ; let given_insols = filterBag insoluble_given_equality irreds + -- Specifically includes ones that originated in some + -- outer context but were refined to an insoluble by + -- a local equality; so no level-check needed + + -- See Note [HasGivenEqs] in GHC.Tc.Types.Constraint, and + -- Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet + has_ge | ge_lvl `sameDepthAs` tclvl = MaybeGivenEqs + | given_eqs = LocalGivenEqs + | otherwise = NoGivenEqs + + ; traceTcS "getHasGivenEqs" $ + vcat [ text "given_eqs:" <+> ppr given_eqs + , text "ge_lvl:" <+> ppr ge_lvl + , text "ambient level:" <+> ppr tclvl + , text "Inerts:" <+> ppr inerts + , text "Insols:" <+> ppr given_insols] + ; return (has_ge, given_insols) } + where + insoluble_given_equality :: IrredCt -> Bool + -- Check for unreachability; specifically do not include UserError/Unsatisfiable + insoluble_given_equality (IrredCt { ir_ev = ev, ir_reason = reason }) + = isInsolubleReason reason && isGiven ev + +removeInertCts :: [Ct] -> InertCans -> InertCans +-- ^ Remove inert constraints from the 'InertCans', for use when a +-- typechecker plugin wishes to discard a given. +removeInertCts cts icans = foldl' removeInertCt icans cts + +removeInertCt :: InertCans -> Ct -> InertCans +removeInertCt is ct + = case ct of + CDictCan dict_ct -> is { inert_dicts = delDict dict_ct (inert_dicts is) } + CEqCan eq_ct -> delEq eq_ct is + CIrredCan ir_ct -> delIrred ir_ct is + CQuantCan {} -> panic "removeInertCt: CQuantCan" + CNonCanonical {} -> panic "removeInertCt: CNonCanonical" + +-- | Looks up a family application in the inerts. +lookupFamAppInert :: (CtFlavourRole -> Bool) -- can it rewrite the target? + -> TyCon -> [Type] -> TcS (Maybe EqCt) +lookupFamAppInert rewrite_pred fam_tc tys + = do { IS { inert_cans = IC { inert_funeqs = inert_funeqs } } <- getInertSet + ; return (lookup_inerts inert_funeqs) } + where + lookup_inerts inert_funeqs + = case findFunEq inert_funeqs fam_tc tys of + Nothing -> Nothing + Just (ecl :: [EqCt]) -> find (rewrite_pred . eqCtFlavourRole) ecl + +--------------------------- +lookupFamAppCache :: TyCon -> [Type] -> TcS (Maybe Reduction) +lookupFamAppCache fam_tc tys + = do { IS { inert_famapp_cache = famapp_cache } <- getInertSet + ; case findFunEq famapp_cache fam_tc tys of + result@(Just redn) -> + do { traceTcS "famapp_cache hit" (vcat [ ppr (mkTyConApp fam_tc tys) + , ppr redn ]) + ; return result } + Nothing -> return Nothing } + +extendFamAppCache :: TyCon -> [Type] -> Reduction -> TcS () +-- NB: co :: rhs ~ F tys, to match expectations of rewriter +extendFamAppCache tc xi_args stuff@(Reduction _ ty) + = do { dflags <- getDynFlags + ; when (gopt Opt_FamAppCache dflags) $ + do { traceTcS "extendFamAppCache" (vcat [ ppr tc <+> ppr xi_args + , ppr ty ]) + ; updInertSet $ \ is@(IS { inert_famapp_cache = fc }) -> + is { inert_famapp_cache = insertFunEq fc tc xi_args stuff } } } + +-- Remove entries from the cache whose evidence mentions variables in the +-- supplied set +dropFromFamAppCache :: VarSet -> TcS () +dropFromFamAppCache varset + = updInertSet (\inerts@(IS { inert_famapp_cache = famapp_cache }) -> + inerts { inert_famapp_cache = filterTcAppMap check famapp_cache }) + where + check :: Reduction -> Bool + check redn + = not (anyFreeVarsOfCo (`elemVarSet` varset) $ reductionCoercion redn) + +{- +************************************************************************ +* * +* The TcS solver monad * +* * +************************************************************************ + +Note [The TcS monad] +~~~~~~~~~~~~~~~~~~~~ +The TcS monad is a weak form of the main Tc monad + +All you can do is + * fail + * allocate new variables + * fill in evidence variables + +Filling in a dictionary evidence variable means to create a binding +for it, so TcS carries a mutable location where the binding can be +added. This is initialised from the innermost implication constraint. +-} + +-- | The mode for the constraint solving monad. +data TcSMode + = TcSMode -- See Note [TcSMode], where each field is documented + { tcsmResumable :: Bool + -- ^ Do not restore type-equality cycles + , tcsmEarlyAbort :: Bool + -- ^ Abort early on insoluble constraints + , tcsmSkipOverlappable :: Bool + -- ^ Do not select an OVERLAPPABLE instance + , tcsmFullySolveQCIs :: Bool + -- ^ Fully solve quantified constraints + } + +vanillaTcSMode :: TcSMode +vanillaTcSMode = TcSMode { tcsmResumable = False + , tcsmEarlyAbort = False + , tcsmSkipOverlappable = False + , tcsmFullySolveQCIs = False } + +instance Outputable TcSMode where + ppr (TcSMode { tcsmResumable = pm, tcsmEarlyAbort = ea + , tcsmSkipOverlappable = so, tcsmFullySolveQCIs = fs }) + = text "TcSMode" <> (braces $ cat $ punctuate comma $ catMaybes $ + [ pp_one pm "Resumable", pp_one ea "EarlyAbort" + , pp_one so "SkipOverlappable", pp_one fs "FullySolveQCIs" ]) + -- We get something like TcSMode{EarlyAbort,FullySolveQCIs}, + -- mentioning just the flags that are on + where + pp_one True s = Just (text s) + pp_one False _ = Nothing + +{- Note [TcSMode] +~~~~~~~~~~~~~~~~~ +The constraint solver can operate in different modes: + +* `tcsmResumable`: Used by the pattern match overlap checker. The idea is that + the returned InertSet will later be resumed, so we do not want to restore + type-equality cycles See also Note [Type equality cycles] in GHC.Tc.Solver.Equality + +* `tcsmEarlyAbort`: Abort (fail in the monad) as soon as we come across an + insoluble constraint. This is used to fail-fast when checking for hole-fits. + See Note [Speeding up valid hole-fits]. + +* `tcsmSkipOverlappable`: don't use OVERLAPPABLE instances. Used by the + short-cut solver. See Note [Shortcut solving] in GHC.Tc.Solver.Dict + +* `tcsmFullSolveQCIs`: fully solve quantified constraints, or leave them alone. + Used (only) for SPECIALISE pragmas; + see (NFS1) in Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig +-} + +data TcSEnv + = TcSEnv { + tcs_ev_binds :: EvBindsVar, + + tcs_unified :: IORef Int, + -- The number of unification variables we have filled + -- The important thing is whether it is non-zero, so it + -- could equally well be a Bool instead of an Int. + + tcs_unif_lvl :: IORef (Maybe TcLevel), + -- The Unification Level Flag + -- Outermost level at which we have unified a meta tyvar + -- Starts at Nothing, then (Just i), then (Just j) where j TcM a } + deriving (Functor) + +instance MonadFix TcS where + mfix k = TcS $ \env -> mfix (\x -> unTcS (k x) env) + +-- | Smart constructor for 'TcS', as describe in Note [The one-shot state +-- monad trick] in "GHC.Utils.Monad". +mkTcS :: (TcSEnv -> TcM a) -> TcS a +mkTcS f = TcS (oneShot f) + +instance Applicative TcS where + pure x = mkTcS $ \_ -> return x + (<*>) = ap + +instance Monad TcS where + m >>= k = mkTcS $ \ebs -> do + unTcS m ebs >>= (\r -> unTcS (k r) ebs) + +instance MonadIO TcS where + liftIO act = TcS $ \_env -> liftIO act + +instance MonadFail TcS where + fail err = mkTcS $ \_ -> fail err + +instance MonadUnique TcS where + getUniqueSupplyM = wrapTcS getUniqueSupplyM + +instance HasModule TcS where + getModule = wrapTcS getModule + +instance MonadThings TcS where + lookupThing n = wrapTcS (lookupThing n) + +-- Basic functionality +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +wrapTcS :: TcM a -> TcS a +-- Do not export wrapTcS, because it promotes an arbitrary TcM to TcS, +-- and TcS is supposed to have limited functionality +wrapTcS action = mkTcS $ \_env -> action -- a TcM action will not use the TcEvBinds + +liftZonkTcS :: ZonkM a -> TcS a +liftZonkTcS = wrapTcS . TcM.liftZonkM + +wrap2TcS :: (TcM a -> TcM a) -> TcS a -> TcS a +wrap2TcS fn (TcS thing) = mkTcS $ \env -> fn (thing env) + +wrapErrTcS :: TcM a -> TcS a +-- The thing wrapped should just fail +-- There's no static check; it's up to the user +-- Having a variant for each error message is too painful +wrapErrTcS = wrapTcS + +wrapWarnTcS :: TcM a -> TcS a +-- The thing wrapped should just add a warning, or no-op +-- There's no static check; it's up to the user +wrapWarnTcS = wrapTcS + +panicTcS :: SDoc -> TcS a +failTcS :: TcRnMessage -> TcS a +warnTcS, addErrTcS :: TcRnMessage -> TcS () +failTcS = wrapTcS . TcM.failWith +warnTcS msg = wrapTcS (TcM.addDiagnostic msg) +addErrTcS = wrapTcS . TcM.addErr +panicTcS doc = pprPanic "GHC.Tc.Solver.Monad" doc + +tryEarlyAbortTcS :: TcS () +-- Abort (fail in the monad) if the mode is TcSEarlyAbort +tryEarlyAbortTcS + = mkTcS (\env -> when (tcsmEarlyAbort (tcs_mode env)) TcM.failM) + +-- | Emit a warning within the 'TcS' monad at the location given by the 'CtLoc'. +ctLocWarnTcS :: CtLoc -> TcRnMessage -> TcS () +ctLocWarnTcS loc msg = wrapTcS $ TcM.setCtLocM loc $ TcM.addDiagnostic msg + +traceTcS :: String -> SDoc -> TcS () +traceTcS herald doc = wrapTcS (TcM.traceTc herald doc) +{-# INLINE traceTcS #-} -- see Note [INLINE conditional tracing utilities] + +runTcPluginTcS :: TcPluginM a -> TcS a +runTcPluginTcS = wrapTcS . runTcPluginM + +instance HasDynFlags TcS where + getDynFlags = wrapTcS getDynFlags + +getGlobalRdrEnvTcS :: TcS GlobalRdrEnv +getGlobalRdrEnvTcS = wrapTcS TcM.getGlobalRdrEnv + +bumpStepCountTcS :: TcS () +bumpStepCountTcS = mkTcS $ \env -> + do { let ref = tcs_count env + ; n <- TcM.readTcRef ref + ; TcM.writeTcRef ref (n+1) } + +csTraceTcS :: SDoc -> TcS () +csTraceTcS doc + = wrapTcS $ csTraceTcM (return doc) +{-# INLINE csTraceTcS #-} -- see Note [INLINE conditional tracing utilities] + +traceFireTcS :: CtEvidence -> SDoc -> TcS () +-- Dump a rule-firing trace +traceFireTcS ev doc + = mkTcS $ \env -> csTraceTcM $ + do { n <- TcM.readTcRef (tcs_count env) + ; tclvl <- TcM.getTcLevel + ; return (hang (text "Step" <+> int n + <> brackets (text "l:" <> ppr tclvl <> comma <> + text "d:" <> ppr (ctLocDepth (ctEvLoc ev))) + <+> doc <> colon) + 4 (ppr ev)) } +{-# INLINE traceFireTcS #-} -- see Note [INLINE conditional tracing utilities] + +csTraceTcM :: TcM SDoc -> TcM () +-- Constraint-solver tracing, -ddump-cs-trace +csTraceTcM mk_doc + = do { logger <- getLogger + ; when ( logHasDumpFlag logger Opt_D_dump_cs_trace + || logHasDumpFlag logger Opt_D_dump_tc_trace) + ( do { msg <- mk_doc + ; TcM.dumpTcRn False + Opt_D_dump_cs_trace + "" FormatText + msg }) } +{-# INLINE csTraceTcM #-} -- see Note [INLINE conditional tracing utilities] + +runTcS :: TcS a -- What to run + -> TcM (a, EvBindMap) +runTcS tcs + = do { ev_binds_var <- TcM.newTcEvBinds + ; res <- runTcSWithEvBinds ev_binds_var tcs + ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var + ; return (res, ev_binds) } + +-- | This variant of 'runTcS' will immediately fail upon encountering an +-- insoluble ct. See Note [Speeding up valid hole-fits]. Its one usage +-- site does not need the ev_binds, so we do not return them. +runTcSEarlyAbort :: TcS a -> TcM a +runTcSEarlyAbort tcs + = do { ev_binds_var <- TcM.newTcEvBinds + ; runTcSWithEvBinds' mode ev_binds_var tcs } + where + mode = vanillaTcSMode { tcsmEarlyAbort = True } + +-- | This can deal only with equality constraints. +runTcSEqualities :: TcS a -> TcM a +runTcSEqualities thing_inside + = do { ev_binds_var <- TcM.newNoTcEvBinds + ; runTcSWithEvBinds ev_binds_var thing_inside } + +-- | A variant of 'runTcS' that takes and returns an 'InertSet' for +-- later resumption of the 'TcS' session. +runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) +runTcSInerts inerts tcs + = do { ev_binds_var <- TcM.newTcEvBinds + ; runTcSWithEvBinds' (vanillaTcSMode { tcsmResumable = True }) + ev_binds_var $ + do { setInertSet inerts + ; a <- tcs + ; new_inerts <- getInertSet + ; return (a, new_inerts) } } + +runTcSWithEvBinds :: EvBindsVar + -> TcS a + -> TcM a +runTcSWithEvBinds = runTcSWithEvBinds' vanillaTcSMode + +runTcSWithEvBinds' :: TcSMode + -> EvBindsVar + -> TcS a + -> TcM a +runTcSWithEvBinds' mode ev_binds_var thing_inside + = do { unified_var <- TcM.newTcRef 0 + ; step_count <- TcM.newTcRef 0 + + -- Make a fresh, empty inert set + -- Subtle point: see (TGE6) in Note [Tracking Given equalities] + -- in GHC.Tc.Solver.InertSet + ; tc_lvl <- TcM.getTcLevel + ; inert_var <- TcM.newTcRef (emptyInertSet tc_lvl) + + ; wl_var <- TcM.newTcRef emptyWorkList + ; unif_lvl_var <- TcM.newTcRef Nothing + ; let env = TcSEnv { tcs_ev_binds = ev_binds_var + , tcs_unified = unified_var + , tcs_unif_lvl = unif_lvl_var + , tcs_count = step_count + , tcs_inerts = inert_var + , tcs_mode = mode + , tcs_worklist = wl_var } + + -- Run the computation + ; res <- unTcS thing_inside env + + ; count <- TcM.readTcRef step_count + ; when (count > 0) $ + csTraceTcM $ return (text "Constraint solver steps =" <+> int count) + + -- Restore tyvar cycles: see Note [Type equality cycles] in + -- GHC.Tc.Solver.Equality + -- But /not/ when tcsmResumable is set: see Note [TcSMode] + ; unless (tcsmResumable mode) $ + do { inert_set <- TcM.readTcRef inert_var + ; restoreTyVarCycles inert_set } + +#if defined(DEBUG) + ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var + ; checkForCyclicBinds ev_binds +#endif + + ; return res } + +---------------------------- +#if defined(DEBUG) +checkForCyclicBinds :: EvBindMap -> TcM () +checkForCyclicBinds ev_binds_map + | null cycles + = return () + | null coercion_cycles + = TcM.traceTc "Cycle in evidence binds" $ ppr cycles + | otherwise + = pprPanic "Cycle in coercion bindings" $ ppr coercion_cycles + where + ev_binds = evBindMapBinds ev_binds_map + + cycles :: [[EvBind]] + cycles = [c | CyclicSCC c <- stronglyConnCompFromEdgedVerticesUniq edges] + + coercion_cycles = [c | c <- cycles, any is_co_bind c] + is_co_bind (EvBind { eb_lhs = b }) = isEqPred (varType b) + + edges :: [ Node EvVar EvBind ] + edges = [ DigraphNode bind bndr (nonDetEltsUniqSet (nestedEvIdsOfTerm rhs)) + | bind@(EvBind { eb_lhs = bndr, eb_rhs = rhs}) <- bagToList ev_binds ] + -- It's OK to use nonDetEltsUFM here as + -- stronglyConnCompFromEdgedVertices is still deterministic even + -- if the edges are in nondeterministic order as explained in + -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. +#endif + +---------------------------- +setEvBindsTcS :: EvBindsVar -> TcS a -> TcS a +setEvBindsTcS ref (TcS thing_inside) + = TcS $ \ env -> thing_inside (env { tcs_ev_binds = ref }) + +setTcLevelTcS :: TcLevel -> TcS a -> TcS a +setTcLevelTcS lvl (TcS thing_inside) + = TcS $ \ env -> TcM.setTcLevel lvl (thing_inside env) + +nestImplicTcS :: EvBindsVar + -> TcLevel -> TcS a + -> TcS a +nestImplicTcS ev_binds_var inner_tclvl (TcS thing_inside) + = TcS $ \ env@(TcSEnv { tcs_inerts = old_inert_var }) -> + do { inerts <- TcM.readTcRef old_inert_var + + -- Initialise the inert_cans from the inert_givens of the parent + -- so that the child is not polluted with the parent's inert Wanteds + -- See Note [trySolveImplication] in GHC.Tc.Solver.Solve + -- All other InertSet fields are inherited + ; let nest_inert = inerts { inert_cycle_breakers = pushCycleBreakerVarStack + (inert_cycle_breakers inerts) + , inert_cans = (inert_givens inerts) + { inert_given_eqs = False } } + ; new_inert_var <- TcM.newTcRef nest_inert + ; new_wl_var <- TcM.newTcRef emptyWorkList + ; let nest_env = env { tcs_ev_binds = ev_binds_var + , tcs_inerts = new_inert_var + , tcs_worklist = new_wl_var } + ; res <- TcM.setTcLevel inner_tclvl $ + thing_inside nest_env + + ; out_inert_set <- TcM.readTcRef new_inert_var + ; restoreTyVarCycles out_inert_set + +#if defined(DEBUG) + -- Perform a check that the thing_inside did not cause cycles + ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var + ; checkForCyclicBinds ev_binds +#endif + ; return res } + +nestTcS :: TcS a -> TcS a +-- Use the current untouchables, augmenting the current +-- evidence bindings, and solved dictionaries +-- But have no effect on the InertCans, or on the inert_famapp_cache +-- (we want to inherit the latter from processing the Givens) +nestTcS (TcS thing_inside) + = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) -> + do { inerts <- TcM.readTcRef inerts_var + ; new_inert_var <- TcM.newTcRef inerts + ; new_wl_var <- TcM.newTcRef emptyWorkList + ; let nest_env = env { tcs_inerts = new_inert_var + , tcs_worklist = new_wl_var } + -- Inherit tcs_ev_binds from caller + + ; res <- thing_inside nest_env + + ; new_inerts <- TcM.readTcRef new_inert_var + ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts) + + ; return res } + +tryShortCutTcS :: TcS Bool -> TcS Bool +-- Like nestTcS, but +-- (a) be a no-op if the nested computation returns False +-- (b) if (but only if) success, propagate nested bindings to the caller +-- Use only by the short-cut solver; +-- see Note [Shortcut solving] in GHC.Tc.Solver.Dict +tryShortCutTcS (TcS thing_inside) + = TcS $ \ env@(TcSEnv { tcs_mode = mode + , tcs_inerts = inerts_var + , tcs_ev_binds = old_ev_binds_var }) -> + do { -- Initialise a fresh inert set, with no Givens and no Wanteds + -- (i.e. empty `inert_cans`) + -- But inherit all the InertSet cache fields; in particular + -- * the given_eq_lvl, so we don't accidentally unify a + -- unification variable from outside a GADT match + -- * the `solved_dicts`; see wrinkle (SCS3) of Note [Shortcut solving] + -- * the `famapp_cache`; similarly + old_inerts <- TcM.readTcRef inerts_var + ; let given_eq_lvl = inert_given_eq_lvl (inert_cans old_inerts) + new_inerts = old_inerts { inert_cans = emptyInertCans given_eq_lvl } + ; new_inert_var <- TcM.newTcRef new_inerts + + ; new_wl_var <- TcM.newTcRef emptyWorkList + ; new_ev_binds_var <- TcM.cloneEvBindsVar old_ev_binds_var + ; let nest_env = env { tcs_mode = mode { tcsmSkipOverlappable = True } + , tcs_ev_binds = new_ev_binds_var + , tcs_inerts = new_inert_var + , tcs_worklist = new_wl_var } + + ; TcM.traceTc "tryTcS {" $ + vcat [ text "old_ev_binds:" <+> ppr old_ev_binds_var + , text "new_ev_binds:" <+> ppr new_ev_binds_var + , ppr old_inerts ] + ; solved <- thing_inside nest_env + ; TcM.traceTc "tryTcS }" (ppr solved) + + ; if not solved + then return False + else do { -- Successfully solved + -- Add the new bindings to the existing ones + ; TcM.updTcEvBinds old_ev_binds_var new_ev_binds_var + + -- Update the existing inert set + ; new_inerts <- TcM.readTcRef new_inert_var + ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts) + + ; TcM.traceTc "tryTcS update" (ppr (inert_solved_dicts new_inerts)) + + ; return True } } + +updateInertsWith :: InertSet -> InertSet -> InertSet +-- Update the current inert set with bits from a nested solve, +-- that finished with a new inert set +-- In particular, propagate: +-- - solved dictionaires; see Note [Propagate the solved dictionaries] +-- - Safe Haskell failures +updateInertsWith current_inerts + (IS { inert_solved_dicts = new_solved + , inert_safehask = new_safehask }) + = current_inerts { inert_solved_dicts = new_solved + , inert_safehask = new_safehask } + +{- Note [Propagate the solved dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's really quite important that nestTcS does not discard the solved +dictionaries from the thing_inside. +Consider + Eq [a] + forall b. empty => Eq [a] +We solve the simple (Eq [a]), under nestTcS, and then turn our attention to +the implications. It's definitely fine to use the solved dictionaries on +the inner implications, and it can make a significant performance difference +if you do so. +-} + +-- Getters and setters of GHC.Tc.Utils.Env fields +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +getTcSMode :: TcS TcSMode +getTcSMode = TcS (return . tcs_mode) + +setTcSMode :: TcSMode -> TcS a -> TcS a +setTcSMode mode thing_inside + = TcS (\env -> unTcS thing_inside (env { tcs_mode = mode })) + +getUnifiedRef :: TcS (IORef Int) +getUnifiedRef = TcS (return . tcs_unified) + +-- Getter of inerts and worklist +getInertSetRef :: TcS (IORef InertSet) +getInertSetRef = TcS (return . tcs_inerts) + +getInertSet :: TcS InertSet +getInertSet = getInertSetRef >>= readTcRef + +setInertSet :: InertSet -> TcS () +setInertSet is = do { r <- getInertSetRef; writeTcRef r is } + + +newTcRef :: a -> TcS (TcRef a) +newTcRef x = wrapTcS (TcM.newTcRef x) + +readTcRef :: TcRef a -> TcS a +readTcRef ref = wrapTcS (TcM.readTcRef ref) + +writeTcRef :: TcRef a -> a -> TcS () +writeTcRef ref val = wrapTcS (TcM.writeTcRef ref val) + +updTcRef :: TcRef a -> (a->a) -> TcS () +updTcRef ref upd_fn = wrapTcS (TcM.updTcRef ref upd_fn) + +getTcEvBindsVar :: TcS EvBindsVar +getTcEvBindsVar = TcS (return . tcs_ev_binds) + +getTcLevel :: TcS TcLevel +getTcLevel = wrapTcS TcM.getTcLevel + +getTcEvTyCoVars :: EvBindsVar -> TcS [TcCoercion] +getTcEvTyCoVars ev_binds_var + = wrapTcS $ TcM.getTcEvTyCoVars ev_binds_var + +getTcEvBindsMap :: EvBindsVar -> TcS EvBindMap +getTcEvBindsMap ev_binds_var + = wrapTcS $ TcM.getTcEvBindsMap ev_binds_var + +setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcS () +setTcEvBindsMap ev_binds_var binds + = wrapTcS $ TcM.setTcEvBindsMap ev_binds_var binds + +unifyTyVar :: TcTyVar -> TcType -> TcS () +-- Unify a meta-tyvar with a type +-- We keep track of how many unifications have happened in tcs_unified, +-- +-- We should never unify the same variable twice! +unifyTyVar tv ty + = assertPpr (isMetaTyVar tv) (ppr tv) $ + TcS $ \ env -> + do { TcM.traceTc "unifyTyVar" (ppr tv <+> text ":=" <+> ppr ty) + ; TcM.liftZonkM $ TcM.writeMetaTyVar tv ty + ; TcM.updTcRef (tcs_unified env) (+1) } + +reportUnifications :: TcS a -> TcS (Int, a) +-- Record how many unifications are done by thing_inside +-- We could return a Bool instead of an Int; +-- all that matters is whether it is no-zero +reportUnifications (TcS thing_inside) + = TcS $ \ env -> + do { inner_unified <- TcM.newTcRef 0 + ; res <- thing_inside (env { tcs_unified = inner_unified }) + ; n_unifs <- TcM.readTcRef inner_unified + ; TcM.updTcRef (tcs_unified env) (+ n_unifs) + ; return (n_unifs, res) } + +getDefaultInfo :: TcS (DefaultEnv, Bool) +getDefaultInfo = wrapTcS TcM.tcGetDefaultTys + + +-- Just get some environments needed for instance looking up and matching +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +getInstEnvs :: TcS InstEnvs +getInstEnvs = wrapTcS $ TcM.tcGetInstEnvs + +getFamInstEnvs :: TcS (FamInstEnv, FamInstEnv) +getFamInstEnvs = wrapTcS $ FamInst.tcGetFamInstEnvs + +getTopEnv :: TcS HscEnv +getTopEnv = wrapTcS $ TcM.getTopEnv + +getGblEnv :: TcS TcGblEnv +getGblEnv = wrapTcS $ TcM.getGblEnv + +getLclEnv :: TcS TcLclEnv +getLclEnv = wrapTcS $ TcM.getLclEnv + +setSrcSpan :: RealSrcSpan -> TcS a -> TcS a +setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty)) + +tcLookupClass :: Name -> TcS Class +tcLookupClass c = wrapTcS $ TcM.tcLookupClass c + +tcLookupId :: Name -> TcS Id +tcLookupId n = wrapTcS $ TcM.tcLookupId n + +tcLookupTyCon :: Name -> TcS TyCon +tcLookupTyCon n = wrapTcS $ TcM.tcLookupTyCon n + +-- Any use of this function is a bit suspect, because it violates the +-- pure veneer of TcS. But it's just about warnings around unused imports +-- and local constructors (GHC will issue fewer warnings than it otherwise +-- might), so it's not worth losing sleep over. +recordUsedGREs :: Bag GlobalRdrElt -> TcS () +recordUsedGREs gres + = do { wrapTcS $ TcM.addUsedGREs NoDeprecationWarnings gre_list + -- If a newtype constructor was imported, don't warn about not + -- importing it... + ; wrapTcS $ traverse_ (TcM.keepAlive . greName) gre_list } + -- ...and similarly, if a newtype constructor was defined in the same + -- module, don't warn about it being unused. + -- See Note [Tracking unused binding and imports] in GHC.Tc.Utils. + + where + gre_list = bagToList gres + +-- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +checkWellLevelledDFun :: CtLoc -> InstanceWhat -> PredType -> TcS () +-- Check that we do not try to use an instance before it is available. E.g. +-- instance Eq T where ... +-- f x = $( ... (\(p::T) -> p == p)... ) +-- Here we can't use the equality function from the instance in the splice + +checkWellLevelledDFun loc what pred + = do + mbind_lvl <- checkWellLevelledInstanceWhat what + case mbind_lvl of + Just (bind_lvls, is_local) -> + wrapTcS $ TcM.setCtLocM loc $ do + { use_lvl <- thLevelIndex <$> TcM.getThLevel + ; dflags <- getDynFlags + ; checkCrossLevelClsInst dflags (LevelCheckInstance what pred) bind_lvls use_lvl is_local } + -- If no level information is returned for an InstanceWhat, then it's safe to use + -- at any level. + Nothing -> return () + + +-- TODO: Unify this with checkCrossLevelLifting function +checkCrossLevelClsInst :: DynFlags -> LevelCheckReason + -> Set.Set ThLevelIndex -> ThLevelIndex + -> Bool -> TcM () +checkCrossLevelClsInst dflags reason bind_lvls use_lvl_idx is_local + -- If the Id is imported, then allow with ImplicitStagePersistence + | not is_local + , xopt LangExt.ImplicitStagePersistence dflags + = return () + -- NB: Do this check after the ImplicitStagePersistence check, because + -- it will do some computation to work out the levels of instances. + | use_lvl_idx `Set.member` bind_lvls = return () + -- With ImplicitStagePersistence, using later than bound is fine + | xopt LangExt.ImplicitStagePersistence dflags + , any (use_lvl_idx >=) bind_lvls = return () + | otherwise = TcM.addErrTc (TcRnBadlyLevelled reason bind_lvls use_lvl_idx Nothing ErrorWithoutFlag) + + + +-- | Returns the ThLevel of evidence for the solved constraint (if it has evidence) +-- See Note [Well-levelled instance evidence] +checkWellLevelledInstanceWhat :: HasCallStack => InstanceWhat -> TcS (Maybe (Set.Set ThLevelIndex, Bool)) +checkWellLevelledInstanceWhat what + | TopLevInstance { iw_dfun_id = dfun_id } <- what + = Just <$> checkNameVisibleLevels (idName dfun_id) + | BuiltinTypeableInstance tc <- what + -- The typeable instance is always defined in the same module as the TyCon. + = Just <$> checkNameVisibleLevels (tyConName tc) + | otherwise = return Nothing + +-- | Check the levels at which the given name is visible, including a boolean +-- indicating if the name is local or not. +checkNameVisibleLevels :: Name -> TcS (Set.Set ThLevelIndex, Bool) +checkNameVisibleLevels name = do + cur_mod <- extractModule <$> getGblEnv + if nameIsLocalOrFrom cur_mod name + then return (Set.singleton topLevelIndex, True) + else do + lvls <- checkModuleVisibleLevels (nameModule name) + return (lvls, False) + +{- Note [Using the module graph to compute TH level visiblities] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When typechecking a module M, in order to implement GHC proposal #682 +(see Note [Explicit Level Imports] in GHC.Tc.Gen.Head), we need to be able to +compute the Template Haskell levels that typeclass instances are visible at in M. + +To do this, we use the "level 0 imports" module graph, which we query via +GHC.Unit.Module.Graph.mgQueryZero. For example, if we want all modules that are +visible at level -1 from M, we do the following: + + 1. start with all the direct of M imports at level -1, i.e. the "splice imports" + 2. then look at all modules that are reachable from these using only level 0 + normal imports, using 'mgQueryZero'. + +This works precisely because, as specified in the proposal, with -XNoImplicitStagePersistence, +modules only export items at level 0. In particular, instances are only exported +at level 0. + +See the SI36 test for an illustration. +-} + +-- | Check which TH levels a module is visable at +-- +-- Used to check visibility of instances (do not use this for normal identifiers). +checkModuleVisibleLevels :: Module -> TcS (Set.Set ThLevelIndex) +checkModuleVisibleLevels check_mod = do + cur_mod <- extractModule <$> getGblEnv + hsc_env <- getTopEnv + + -- 0. The keys for the scope of the current module. + let mkKey s m = (ModuleScope (moduleToMnk m NotBoot) s) + cur_mod_scope_key s = mkKey s cur_mod + + -- 1. is_visible checks that a specific key is visible from the given level in the + -- current module. + let is_visible :: ImportLevel -> ZeroScopeKey -> Bool + is_visible s k = mgQueryZero (hsc_mod_graph hsc_env) (cur_mod_scope_key s) k + + -- 2. The key we are looking for, either the module itself in the home package or the + -- module unit id of the module we are checking. + let instance_key = if moduleUnitId check_mod `Set.member` hsc_all_home_unit_ids hsc_env + then mkKey NormalLevel check_mod + else UnitScope (moduleUnitId check_mod) + + -- 3. For each level, check if the key is visible from that level. + let lvls = [ thLevelIndexFromImportLevel lvl | lvl <- allImportLevels, is_visible lvl instance_key] + return $ Set.fromList lvls + +{- +Note [Well-levelled instance evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Evidence for instances must obey the same level restrictions as normal bindings. +In particular, it is forbidden to use an instance in a top-level splice in the +module which the instance is defined. This is because the evidence is bound at +the top-level and top-level definitions are forbidden from being using in top-level splices in +the same module. + +For example, suppose you have a function.. foo :: Show a => Code Q a -> Code Q () +then the following program is disallowed, + +``` +data T a = T a deriving (Show) + +main :: IO () +main = + let x = $$(foo [|| T () ||]) + in return () +``` + +because the `foo` function (used in a top-level splice) requires `Show T` evidence, +which is defined at the top-level and therefore fails with an error that we have violated +the stage restriction. + +``` +Main.hs:12:14: error: + • GHC stage restriction: + instance for ‘Show + (T ())’ is used in a top-level splice, quasi-quote, or annotation, + and must be imported, not defined locally + • In the expression: foo [|| T () ||] + In the Template Haskell splice $$(foo [|| T () ||]) + In the expression: $$(foo [|| T () ||]) + | +12 | let x = $$(foo [|| T () ||]) + | +``` + +Solving a `Typeable (T t1 ...tn)` constraint generates code that relies on +`$tcT`, the `TypeRep` for `T`; and we must check that this reference to `$tcT` +is well levelled. It's easy to know the level of `$tcT`: for imported TyCons it +will be the level of the imported TyCon Name, and for local TyCons it will be `toplevel`. + +Therefore the `InstanceWhat` type had to be extended with +a special case for `Typeable`, which recorded the TyCon the evidence was for and +could them be used to check that we were not attempting to evidence in a level incorrect +manner. + +-} + +pprEq :: TcType -> TcType -> SDoc +pprEq ty1 ty2 = pprParendType ty1 <+> char '~' <+> pprParendType ty2 + +isFilledMetaTyVar_maybe :: TcTyVar -> TcS (Maybe Type) +isFilledMetaTyVar_maybe tv = wrapTcS (TcM.isFilledMetaTyVar_maybe tv) + +isFilledMetaTyVar :: TcTyVar -> TcS Bool +isFilledMetaTyVar tv = wrapTcS (TcM.isFilledMetaTyVar tv) + +isUnfilledMetaTyVar :: TcTyVar -> TcS Bool +isUnfilledMetaTyVar tv = wrapTcS $ TcM.isUnfilledMetaTyVar tv + +zonkTyCoVarsAndFV :: TcTyCoVarSet -> TcS TcTyCoVarSet +zonkTyCoVarsAndFV tvs = liftZonkTcS (TcM.zonkTyCoVarsAndFV tvs) + +zonkTyCoVarsAndFVList :: [TcTyCoVar] -> TcS [TcTyCoVar] +zonkTyCoVarsAndFVList tvs = liftZonkTcS (TcM.zonkTyCoVarsAndFVList tvs) + +zonkCo :: Coercion -> TcS Coercion +zonkCo = wrapTcS . fmap TcM.liftZonkM TcM.zonkCo + +zonkTcType :: TcType -> TcS TcType +zonkTcType ty = liftZonkTcS (TcM.zonkTcType ty) + +zonkTcTypes :: [TcType] -> TcS [TcType] +zonkTcTypes tys = liftZonkTcS (TcM.zonkTcTypes tys) + +zonkTcTyVar :: TcTyVar -> TcS TcType +zonkTcTyVar tv = liftZonkTcS (TcM.zonkTcTyVar tv) + +zonkSimples :: Cts -> TcS Cts +zonkSimples cts = liftZonkTcS (TcM.zonkSimples cts) + +zonkWC :: WantedConstraints -> TcS WantedConstraints +zonkWC wc = liftZonkTcS (TcM.zonkWC wc) + +zonkTyCoVarKind :: TcTyCoVar -> TcS TcTyCoVar +zonkTyCoVarKind tv = liftZonkTcS (TcM.zonkTyCoVarKind tv) + +---------------------------- +pprKicked :: Int -> SDoc +pprKicked 0 = empty +pprKicked n = parens (int n <+> text "kicked out") + + +{- ********************************************************************* +* * +* The work list +* * +********************************************************************* -} + + +getTcSWorkListRef :: TcS (IORef WorkList) +getTcSWorkListRef = TcS (return . tcs_worklist) + +getWorkList :: TcS WorkList +getWorkList = do { wl_var <- getTcSWorkListRef + ; readTcRef wl_var } + +updWorkListTcS :: (WorkList -> WorkList) -> TcS () +updWorkListTcS f + = do { wl_var <- getTcSWorkListRef + ; updTcRef wl_var f } + +emitWorkNC :: [CtEvidence] -> TcS () +emitWorkNC evs + | null evs + = return () + | otherwise + = emitWork (listToBag (map mkNonCanonical evs)) + +emitWork :: Cts -> TcS () +emitWork cts + | isEmptyBag cts -- Avoid printing, among other work + = return () + | otherwise + = do { traceTcS "Emitting fresh work" (pprBag cts) + ; updWorkListTcS (extendWorkListCts cts) } + +selectNextWorkItem :: TcS (Maybe Ct) +-- Pick which work item to do next +-- See Note [Prioritise equalities] +-- +-- Postcondition: if the returned item is a Wanted equality, +-- then its rewriter set is fully zonked. +-- +-- Suppose a constraint c1 is rewritten by another, c2. When c2 +-- gets solved, c1 has no rewriters, and can be prioritised; see +-- Note [Prioritise Wanteds with empty RewriterSet] in +-- GHC.Tc.Types.Constraint wrinkle (PER1) + +-- ToDo: if wl_rw_eqs is long, we'll re-zonk it each time we pick +-- a new item from wl_rest. Bad. +selectNextWorkItem + = do { wl_var <- getTcSWorkListRef + ; wl <- readTcRef wl_var + + ; case wl of { WL { wl_eqs_N = eqs_N, wl_eqs_X = eqs_X + , wl_rw_eqs = rw_eqs, wl_rest = rest } + | ct:cts <- eqs_N -> pick_me ct (wl { wl_eqs_N = cts }) + | ct:cts <- eqs_X -> pick_me ct (wl { wl_eqs_X = cts }) + | otherwise -> try_rws [] rw_eqs + where + pick_me :: Ct -> WorkList -> TcS (Maybe Ct) + pick_me ct new_wl + = do { writeTcRef wl_var new_wl + ; return (Just ct) } + -- NB: no need for checkReductionDepth (ctLoc ct) (ctPred ct) + -- This is done by GHC.Tc.Solver.Dict.chooseInstance + + -- try_rws looks through rw_eqs to find one that has an empty + -- rewriter set, after zonking. If none such, call try_rest. + try_rws acc (ct:cts) + = do { ct' <- liftZonkTcS (TcM.zonkCtRewriterSet ct) + ; if ctHasNoRewriters ct' + then pick_me ct' (wl { wl_rw_eqs = cts ++ acc }) + else try_rws (ct':acc) cts } + try_rws acc [] = try_rest acc + + try_rest zonked_rws + | ct:cts <- rest = pick_me ct (wl { wl_rw_eqs = zonked_rws, wl_rest = cts }) + | ct:cts <- zonked_rws = pick_me ct (wl { wl_rw_eqs = cts }) + | otherwise = return Nothing + } } + + +pushLevelNoWorkList :: SDoc -> TcS a -> TcS (TcLevel, a) +-- Push the level and run thing_inside +-- However, thing_inside should not generate any work items +#if defined(DEBUG) +pushLevelNoWorkList err_doc (TcS thing_inside) + = TcS (\env -> TcM.pushTcLevelM $ + thing_inside (env { tcs_worklist = wl_panic }) + ) + where + wl_panic = pprPanic "GHC.Tc.Solver.Monad.buildImplication" err_doc + -- This panic checks that the thing-inside + -- does not emit any work-list constraints +#else +pushLevelNoWorkList _ (TcS thing_inside) + = TcS (\env -> TcM.pushTcLevelM (thing_inside env)) -- Don't check +#endif + + +{- ********************************************************************* +* * +* The Unification Level Flag * +* * +********************************************************************* -} + +{- Note [The Unification Level Flag] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider a deep tree of implication constraints + forall[1] a. -- Outer-implic + C alpha[1] -- Simple + forall[2] c. ....(C alpha[1]).... -- Implic-1 + forall[2] b. ....(alpha[1] ~ Int).... -- Implic-2 + +The (C alpha) is insoluble until we know alpha. We solve alpha +by unifying alpha:=Int somewhere deep inside Implic-2. But then we +must try to solve the Outer-implic all over again. This time we can +solve (C alpha) both in Outer-implic, and nested inside Implic-1. + +When should we iterate solving a level-n implication? +Answer: if any unification of a tyvar at level n takes place + in the ic_implics of that implication. + +* What if a unification takes place at level n-1? Then don't iterate + level n, because we'll iterate level n-1, and that will in turn iterate + level n. + +* What if a unification takes place at level n, in the ic_simples of + level n? No need to track this, because the kick-out mechanism deals + with it. (We can't drop kick-out in favour of iteration, because kick-out + works for skolem-equalities, not just unifications.) + +So the monad-global Unification Level Flag, kept in tcs_unif_lvl keeps +track of + - Whether any unifications at all have taken place (Nothing => no unifications) + - If so, what is the outermost level that has seen a unification (Just lvl) + +The iteration is done in the simplify_loop/maybe_simplify_again loop in GHC.Tc.Solver. + +It helpful not to iterate unless there is a chance of progress. #8474 is +an example: + + * There's a deeply-nested chain of implication constraints. + ?x:alpha => ?y1:beta1 => ... ?yn:betan => [W] ?x:Int + + * From the innermost one we get a [W] alpha[1] ~ Int, + so we can unify. + + * It's better not to iterate the inner implications, but go all the + way out to level 1 before iterating -- because iterating level 1 + will iterate the inner levels anyway. + +(In the olden days when we "floated" thse Derived constraints, this was +much, much more important -- we got exponential behaviour, as each iteration +produced the same Derived constraint.) +-} + + +resetUnificationFlag :: TcS Bool +-- We are at ambient level i +-- If the unification flag = Just i, reset it to Nothing and return True +-- Otherwise leave it unchanged and return False +resetUnificationFlag + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; ambient_lvl <- TcM.getTcLevel + ; mb_lvl <- TcM.readTcRef ref + ; TcM.traceTc "resetUnificationFlag" $ + vcat [ text "ambient:" <+> ppr ambient_lvl + , text "unif_lvl:" <+> ppr mb_lvl ] + ; case mb_lvl of + Nothing -> return False + Just unif_lvl | ambient_lvl `strictlyDeeperThan` unif_lvl + -> return False + | otherwise + -> do { TcM.writeTcRef ref Nothing + ; return True } } + +setUnificationFlag :: TcLevel -> TcS () +-- (setUnificationFlag i) sets the unification level to (Just i) +-- unless it already is (Just j) where j <= i +setUnificationFlag lvl + = TcS $ \env -> + do { let ref = tcs_unif_lvl env + ; mb_lvl <- TcM.readTcRef ref + ; case mb_lvl of + Just unif_lvl | lvl `deeperThanOrSame` unif_lvl + -> return () + _ -> TcM.writeTcRef ref (Just lvl) } + + +{- ********************************************************************* +* * +* Instantiation etc. +* * +********************************************************************* -} + +-- Instantiations +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +instDFunType :: DFunId -> [DFunInstType] -> TcS ([TcType], TcThetaType) +instDFunType dfun_id inst_tys + = wrapTcS $ TcM.instDFunType dfun_id inst_tys + +newFlexiTcSTy :: Kind -> TcS TcType +newFlexiTcSTy knd = wrapTcS (TcM.newFlexiTyVarTy knd) + +cloneMetaTyVar :: TcTyVar -> TcS TcTyVar +cloneMetaTyVar tv = wrapTcS (TcM.cloneMetaTyVar tv) + +instFlexiX :: Subst -> [TKVar] -> TcS Subst +instFlexiX subst tvs = wrapTcS (instFlexiXTcM subst tvs) + +instFlexiXTcM :: Subst -> [TKVar] -> TcM Subst +-- Makes fresh tyvar, extends the substitution, and the in-scope set +-- Takes account of the case [k::Type, a::k, ...], +-- where we must substitute for k in a's kind +instFlexiXTcM subst [] + = return subst +instFlexiXTcM subst (tv:tvs) + = do { uniq <- TcM.newUnique + ; details <- TcM.newMetaDetails TauTv + ; let name = setNameUnique (tyVarName tv) uniq + kind = substTyUnchecked subst (tyVarKind tv) + tv' = mkTcTyVar name kind details + subst' = extendTvSubstWithClone subst tv tv' + ; instFlexiXTcM subst' tvs } + +matchGlobalInst :: DynFlags -> Class -> [Type] -> CtLoc -> TcS TcM.ClsInstResult +matchGlobalInst dflags cls tys loc + = do { mode <- getTcSMode + ; let skip_overlappable = tcsmSkipOverlappable mode + ; wrapTcS $ TcM.matchGlobalInst dflags skip_overlappable cls tys (Just loc) } + +tcInstSkolTyVarsX :: SkolemInfo -> Subst -> [TyVar] -> TcS (Subst, [TcTyVar]) +tcInstSkolTyVarsX skol_info subst tvs = wrapTcS $ TcM.tcInstSkolTyVarsX skol_info subst tvs + +-- Creating and setting evidence variables and CtFlavors +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +data MaybeNew = Fresh WantedCtEvidence | Cached EvExpr + +isFresh :: MaybeNew -> Bool +isFresh (Fresh {}) = True +isFresh (Cached {}) = False + +freshGoals :: [MaybeNew] -> [WantedCtEvidence] +freshGoals mns = [ ctev | Fresh ctev <- mns ] + +getEvExpr :: MaybeNew -> EvExpr +getEvExpr (Fresh ctev) = ctEvExpr (CtWanted ctev) +getEvExpr (Cached evt) = evt + +setEvBind :: EvBind -> TcS () +setEvBind ev_bind + = do { evb <- getTcEvBindsVar + ; wrapTcS $ TcM.addTcEvBind evb ev_bind } + +-- | Mark variables as used filling a coercion hole +addUsedCoercion :: TcCoercion -> TcS () +addUsedCoercion co + = do { ev_binds_var <- getTcEvBindsVar + ; wrapTcS (TcM.updTcRef (ebv_tcvs ev_binds_var) (co :)) } + +-- | Equalities only +setWantedEq :: HasDebugCallStack => TcEvDest -> TcCoercion -> TcS () +setWantedEq (HoleDest hole) co + = do { addUsedCoercion co + ; fillCoercionHole hole co } +setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) + +-- | Good for both equalities and non-equalities +setWantedEvTerm :: TcEvDest -> CanonicalEvidence -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm + | Just co <- evTermCoercion_maybe tm + = do { addUsedCoercion co + ; fillCoercionHole hole co } + | otherwise + = -- See Note [Yukky eq_sel for a HoleDest] + do { let co_var = coHoleCoVar hole + ; setEvBind (mkWantedEvBind co_var EvCanonical tm) + ; fillCoercionHole hole (mkCoVarCo co_var) } + +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) + +{- Note [Yukky eq_sel for a HoleDest] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How can it be that a Wanted with HoleDest gets evidence that isn't +just a coercion? i.e. evTermCoercion_maybe returns Nothing. + +Consider [G] forall a. blah => a ~ T + [W] S ~# T + +Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ T) +in the quantified constraints, and wraps the (boxed) evidence it +gets back in an eq_sel to extract the unboxed (S ~# T). We can't put +that term into a coercion, so we add a value binding + h = eq_sel (...) +and the coercion variable h to fill the coercion hole. +We even re-use the CoHole's Id for this binding! + +Yuk! +-} + +fillCoercionHole :: CoercionHole -> Coercion -> TcS () +fillCoercionHole hole co + = do { wrapTcS $ TcM.fillCoercionHole hole co + ; kickOutAfterFillingCoercionHole hole } + +setEvBindIfWanted :: CtEvidence -> CanonicalEvidence -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm + = case ev of + CtWanted (WantedCt { ctev_dest = dest }) -> setWantedEvTerm dest canonical tm + _ -> return () + +newTcEvBinds :: TcS EvBindsVar +newTcEvBinds = wrapTcS TcM.newTcEvBinds + +newNoTcEvBinds :: TcS EvBindsVar +newNoTcEvBinds = wrapTcS TcM.newNoTcEvBinds + +newEvVar :: TcPredType -> TcS EvVar +newEvVar pred = wrapTcS (TcM.newEvVar pred) + +newGivenEvVar :: CtLoc -> (TcPredType, EvTerm) -> TcS GivenCtEvidence +-- Make a new variable of the given PredType, +-- immediately bind it to the given term +-- and return its CtEvidence +-- See Note [Bind new Givens immediately] in GHC.Tc.Types.Constraint +newGivenEvVar loc (pred, rhs) + = do { new_ev <- newBoundEvVarId pred rhs + ; return $ GivenCt { ctev_pred = pred, ctev_evar = new_ev, ctev_loc = loc } } + +-- | Make a new 'Id' of the given type, bound (in the monad's EvBinds) to the +-- given term +newBoundEvVarId :: TcPredType -> EvTerm -> TcS EvVar +newBoundEvVarId pred rhs + = do { new_ev <- newEvVar pred + ; setEvBind (mkGivenEvBind new_ev rhs) + ; return new_ev } + +emitNewGivens :: CtLoc -> [(Role,TcCoercion)] -> TcS () +emitNewGivens loc pts + = do { traceTcS "emitNewGivens" (ppr pts) + ; gs <- mapM (newGivenEvVar loc) $ + [ (mkEqPredRole role ty1 ty2, evCoercion co) + | (role, co) <- pts + , let Pair ty1 ty2 = coercionKind co + , not (ty1 `tcEqType` ty2) ] -- Kill reflexive Givens at birth + ; emitWorkNC (map CtGiven gs) } + +emitNewWantedEq :: CtLoc -> RewriterSet -> Role -> TcType -> TcType -> TcS Coercion +-- | Emit a new Wanted equality into the work-list +emitNewWantedEq loc rewriters role ty1 ty2 + = do { (wtd, co) <- newWantedEq loc rewriters role ty1 ty2 + ; updWorkListTcS (extendWorkListEq rewriters (mkNonCanonical $ CtWanted wtd)) + ; return co } + +-- | Create a new Wanted constraint holding a coercion hole +-- for an equality between the two types at the given 'Role'. +newWantedEq :: CtLoc -> RewriterSet -> Role -> TcType -> TcType + -> TcS (WantedCtEvidence, Coercion) +newWantedEq loc rewriters role ty1 ty2 + = do { hole <- wrapTcS $ TcM.newCoercionHole pty + ; let wtd = WantedCt { ctev_pred = pty + , ctev_dest = HoleDest hole + , ctev_loc = loc + , ctev_rewriters = rewriters } + ; return (wtd, mkHoleCo hole) } + where + pty = mkEqPredRole role ty1 ty2 + +-- | Create a new Wanted constraint holding an evidence variable. +-- +-- Don't use this for equality constraints: use 'newWantedEq' instead. +newWantedEvVarNC :: CtLoc -> RewriterSet + -> TcPredType -> TcS WantedCtEvidence +-- Don't look up in the solved/inerts; we know it's not there +newWantedEvVarNC loc rewriters pty + = assertPpr (not (isEqPred pty)) (ppr pty) $ + do { new_ev <- newEvVar pty + ; traceTcS "Emitting new wanted" (ppr new_ev <+> dcolon <+> ppr pty $$ + pprCtLoc loc) + ; return $ WantedCt { ctev_pred = pty + , ctev_dest = EvVarDest new_ev + , ctev_loc = loc + , ctev_rewriters = rewriters } + } + +-- | `newWantedEvVar` makes up a fresh evidence variable for the given predicate. +-- For ClassPred, check if this exact predicate type is in the solved dicts +-- But do /not/ look in the inert_cans, because doing so bypasses all +-- all the careful tests in tryInertDicts, leading to +-- #20666 (prohibitedSuperClassSolve) and #26117 (short-cut solve) +-- We do no such caching forIPs, holes, or errors; so for anything +-- except ClassPred, this is the same as newWantedEvVarNC +-- +-- Don't use this for equality constraints: this function is only for +-- constraints with 'EvVarDest'. +newWantedEvVar :: CtLoc -> RewriterSet + -> TcPredType -> TcS MaybeNew +newWantedEvVar loc rewriters pty + = case classifyPredType pty of + EqPred {} -> pprPanic "newWantedEvVar: HoleDestPred" (ppr pty) + ClassPred cls tys + -> do { inerts <- getInertSet + ; case lookupSolvedDict inerts cls tys of + Just ev -> do { traceTcS "newWantedEvVar/cache hit" $ ppr ev + ; return $ Cached (ctEvExpr ev) } + Nothing -> do { ev <- newWantedEvVarNC loc rewriters pty + ; return (Fresh ev) } } + _other -> do { ev <- newWantedEvVarNC loc rewriters pty + ; return (Fresh ev) } + +-- | Create a new Wanted constraint, potentially looking up +-- non-equality constraints in the cache instead of creating +-- a new one from scratch. +-- +-- Deals with both equality and non-equality constraints. +newWanted :: CtLoc -> RewriterSet -> PredType -> TcS MaybeNew +newWanted loc rewriters pty + | Just (role, ty1, ty2) <- getEqPredTys_maybe pty + = Fresh . fst <$> newWantedEq loc rewriters role ty1 ty2 + | otherwise + = newWantedEvVar loc rewriters pty + +-- | Create a new Wanted constraint. +-- +-- Deals with both equality and non-equality constraints. +-- +-- Does not attempt to re-use non-equality constraints that already +-- exist in the inert set. +newWantedNC :: CtLoc -> RewriterSet -> PredType -> TcS WantedCtEvidence +newWantedNC loc rewriters pty + | Just (role, ty1, ty2) <- getEqPredTys_maybe pty + = fst <$> newWantedEq loc rewriters role ty1 ty2 + | otherwise + = newWantedEvVarNC loc rewriters pty + +-- | Checks if the depth of the given location is too much. Fails if +-- it's too big, with an appropriate error message. +checkReductionDepth :: CtLoc -> TcType -- ^ type being reduced + -> TcS () +checkReductionDepth loc ty + = do { dflags <- getDynFlags + ; when (subGoalDepthExceeded (reductionDepth dflags) (ctLocDepth loc)) $ + wrapErrTcS $ solverDepthError loc ty } + +matchFam :: TyCon -> [Type] -> TcS (Maybe ReductionN) +matchFam tycon args = wrapTcS $ matchFamTcM tycon args + +matchFamTcM :: TyCon -> [Type] -> TcM (Maybe ReductionN) +-- Given (F tys) return (ty, co), where co :: F tys ~N ty +matchFamTcM tycon args + = do { fam_envs <- FamInst.tcGetFamInstEnvs + ; let match_fam_result + = reduceTyFamApp_maybe fam_envs Nominal tycon args + ; TcM.traceTc "matchFamTcM" $ + vcat [ text "Matching:" <+> ppr (mkTyConApp tycon args) + , ppr_res match_fam_result ] + ; return match_fam_result } + where + ppr_res Nothing = text "Match failed" + ppr_res (Just (Reduction co ty)) + = hang (text "Match succeeded:") + 2 (vcat [ text "Rewrites to:" <+> ppr ty + , text "Coercion:" <+> ppr co ]) + +solverDepthError :: CtLoc -> TcType -> TcM a +solverDepthError loc ty + = TcM.setCtLocM loc $ + do { (ty, env0) <- TcM.liftZonkM $ + do { ty <- TcM.zonkTcType ty + ; env0 <- TcM.tcInitTidyEnv + ; return (ty, env0) } + ; let (tidy_env, tidy_ty) = tidyOpenTypeX env0 ty + msg = TcRnSolverDepthError tidy_ty depth + ; TcM.failWithTcM (tidy_env, msg) } + where + depth = ctLocDepth loc + +{- +************************************************************************ +* * + Emitting equalities arising from fundeps +* * +************************************************************************ +-} + +emitFunDepWanteds :: CtEvidence -- The work item + -> [FunDepEqn (CtLoc, RewriterSet)] + -> TcS Bool -- True <=> some unification happened + +emitFunDepWanteds _ [] = return False -- common case noop +-- See Note [FunDep and implicit parameter reactions] in GHC.Tc.Solver.Dict + +emitFunDepWanteds ev fd_eqns + = unifyFunDeps ev Nominal do_fundeps + where + do_fundeps :: UnifyEnv -> TcM () + do_fundeps env = mapM_ (do_one env) fd_eqns + + do_one :: UnifyEnv -> FunDepEqn (CtLoc, RewriterSet) -> TcM () + do_one uenv (FDEqn { fd_qtvs = tvs, fd_eqs = eqs, fd_loc = (loc, rewriters) }) + = do { eqs' <- instantiate_eqs tvs (reverse eqs) + -- (reverse eqs): See Note [Reverse order of fundep equations] + ; uPairsTcM env_one eqs' } + where + env_one = uenv { u_rewriters = u_rewriters uenv S.<> rewriters + , u_loc = loc } + + instantiate_eqs :: [TyVar] -> [TypeEqn] -> TcM [TypeEqn] + instantiate_eqs tvs eqs + | null tvs + = return eqs + | otherwise + = do { TcM.traceTc "emitFunDepWanteds 2" (ppr tvs $$ ppr eqs) + ; subst <- instFlexiXTcM emptySubst tvs -- Takes account of kind substitution + ; return [ Pair (substTyUnchecked subst' ty1) ty2 + -- ty2 does not mention fd_qtvs, so no need to subst it. + -- See GHC.Tc.Instance.Fundeps Note [Improving against instances] + -- Wrinkle (1) + | Pair ty1 ty2 <- eqs + , let subst' = extendSubstInScopeSet subst (tyCoVarsOfType ty1) ] + -- The free vars of ty1 aren't just fd_qtvs: ty1 is the result + -- of matching with the [W] constraint. So we add its free + -- vars to InScopeSet, to satisfy substTy's invariants, even + -- though ty1 will never (currently) be a poytype, so this + -- InScopeSet will never be looked at. + } + +{- +************************************************************************ +* * + Unification +* * +************************************************************************ + +Note [wrapUnifierTcS] +~~~~~~~~~~~~~~~~~~~ +When decomposing equalities we often create new wanted constraints for +(s ~ t). But what if s=t? Then it'd be faster to return Refl right away. + +Rather than making an equality test (which traverses the structure of the type, +perhaps fruitlessly), we call uType (via wrapUnifierTcS) to traverse the common +structure, and bales out when it finds a difference by creating a new deferred +Wanted constraint. But where it succeeds in finding common structure, it just +builds a coercion to reflect it. + +This is all much faster than creating a new constraint, putting it in the +work list, picking it out, canonicalising it, etc etc. + +Note [unifyFunDeps] +~~~~~~~~~~~~~~~~~~~ +The Bool returned by `unifyFunDeps` is True if we have unified a variable +that occurs in the constraint we are trying to solve; it is not in the +inert set so `wrapUnifierTcS` won't kick it out. Instead we want to send it +back to the start of the pipeline. Hence the Bool. + +It's vital that we don't return (not (null unified)) because the fundeps +may create fresh variables; unifying them (alone) should not make us send +the constraint back to the start, or we'll get an infinite loop. See +Note [Fundeps with instances, and equality orientation] in GHC.Tc.Solver.Dict +and Note [Improvement orientation] in GHC.Tc.Solver.Equality. +-} + +uPairsTcM :: UnifyEnv -> [TypeEqn] -> TcM () +uPairsTcM uenv eqns = mapM_ (\(Pair ty1 ty2) -> uType uenv ty1 ty2) eqns + +unifyFunDeps :: CtEvidence -> Role + -> (UnifyEnv -> TcM ()) + -> TcS Bool +unifyFunDeps ev role do_unifications + = do { (_, _, unified) <- wrapUnifierTcS ev role do_unifications + ; return (any (`elemVarSet` fvs) unified) } + -- See Note [unifyFunDeps] + where + fvs = tyCoVarsOfType (ctEvPred ev) + +unifyForAllBody :: CtEvidence -> Role -> (UnifyEnv -> TcM a) + -> TcS (a, Cts) +-- We /return/ the equality constraints we generate, +-- rather than emitting them into the monad. +-- See See (SF5) in Note [Solving forall equalities] in GHC.Tc.Solver.Equality +unifyForAllBody ev role unify_body + = do { (res, cts, unified) <- wrapUnifierX ev role unify_body + + -- Kick out any inert constraint that we have unified + ; _ <- kickOutAfterUnification unified + + ; return (res, cts) } + +wrapUnifierTcS :: CtEvidence -> Role + -> (UnifyEnv -> TcM a) -- Some calls to uType + -> TcS (a, Bag Ct, [TcTyVar]) +-- Invokes the do_unifications argument, with a suitable UnifyEnv. +-- Emit deferred equalities and kick-out from the inert set as a +-- result of any unifications. +-- Very good short-cut when the two types are equal, or nearly so +-- See Note [wrapUnifierTcS] +-- +-- The [TcTyVar] is the list of unification variables that were +-- unified the process; the (Bag Ct) are the deferred constraints. + +wrapUnifierTcS ev role do_unifications + = do { (res, cts, unified) <- wrapUnifierX ev role do_unifications + + -- Emit the deferred constraints + -- See Note [Work-list ordering] in GHC.Tc.Solved.Equality + -- + -- All the constraints in `cts` share the same rewriter set so, + -- rather than looking at it one by one, we pass it to + -- extendWorkListChildEqs; just a small optimisation. + ; unless (isEmptyBag cts) $ + updWorkListTcS (extendWorkListChildEqs ev cts) + + -- And kick out any inert constraint that we have unified + ; _ <- kickOutAfterUnification unified + + ; return (res, cts, unified) } + +wrapUnifierX :: CtEvidence -> Role + -> (UnifyEnv -> TcM a) -- Some calls to uType + -> TcS (a, Bag Ct, [TcTyVar]) +wrapUnifierX ev role do_unifications + = do { unif_count_ref <- getUnifiedRef + ; wrapTcS $ + do { defer_ref <- TcM.newTcRef emptyBag + ; unified_ref <- TcM.newTcRef [] + ; let env = UE { u_role = role + , u_rewriters = ctEvRewriters ev + , u_loc = ctEvLoc ev + , u_defer = defer_ref + , u_unified = Just unified_ref} + -- u_rewriters: the rewriter set and location from + -- the parent constraint `ev` are inherited in any + -- new constraints spat out by the unifier + + ; res <- do_unifications env + + ; cts <- TcM.readTcRef defer_ref + ; unified <- TcM.readTcRef unified_ref + + -- Don't forget to update the count of variables + -- unified, lest we forget to iterate (#24146) + ; unless (null unified) $ + TcM.updTcRef unif_count_ref (+ (length unified)) + + ; return (res, cts, unified) } } + + +{- +************************************************************************ +* * + Breaking type variable cycles +* * +************************************************************************ +-} + +checkTypeEq :: CtEvidence -> EqRel -> CanEqLHS -> TcType + -> TcS (PuResult () Reduction) +-- Used for general CanEqLHSs, ones that do +-- not have a touchable type variable on the LHS (i.e. not unifying) +checkTypeEq ev eq_rel lhs rhs = + case ev of + CtGiven {} -> + do { traceTcS "checkTypeEq {" (vcat [ text "lhs:" <+> ppr lhs + , text "rhs:" <+> ppr rhs ]) + ; check_result <- wrapTcS (checkTyEqRhs given_flags rhs) + ; traceTcS "checkTypeEq }" (ppr check_result) + ; case check_result of + PuFail reason -> return (PuFail reason) + PuOK prs redn -> do { new_givens <- mapBagM mk_new_given prs + ; emitWork new_givens + ; updInertSet (addCycleBreakerBindings prs) + ; return (pure redn) } } + CtWanted {} -> + do { check_result <- wrapTcS (checkTyEqRhs wanted_flags rhs) + ; case check_result of + PuFail reason -> return (PuFail reason) + PuOK cts redn -> do { emitWork cts + ; return (pure redn) } } + where + wanted_flags :: TyEqFlags TcM Ct + wanted_flags = notUnifying_TEFTask occ_prob lhs + -- checkTypeEq deals only with the non-unifying case + + given_flags :: TyEqFlags TcM (TcTyVar, TcType) + given_flags = wanted_flags { tef_fam_app = mkTEFA_Break ev eq_rel BreakGiven } + -- TEFA_Break used for: [G] a ~ Maybe (F a) + -- or [W] F a ~ Maybe (F a) + + -- occ_prob: see Note [Occurs check and representational equality] + occ_prob = case eq_rel of + NomEq -> cteInsolubleOccurs + ReprEq -> cteSolubleOccurs + + --------------------------- + mk_new_given :: (TcTyVar, TcType) -> TcS Ct + mk_new_given (new_tv, fam_app) + = mkNonCanonical . CtGiven <$> newGivenEvVar cb_loc (given_pred, given_term) + where + new_ty = mkTyVarTy new_tv + given_pred = mkNomEqPred fam_app new_ty + given_term = evCoercion $ mkNomReflCo new_ty -- See Detail (4) of Note + + -- See Detail (7) of the Note + cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin + +------------------------- +-- | Fill in CycleBreakerTvs with the variables they stand for. +-- See Note [Type equality cycles] in GHC.Tc.Solver.Equality +restoreTyVarCycles :: InertSet -> TcM () +restoreTyVarCycles is + = TcM.liftZonkM + $ forAllCycleBreakerBindings_ (inert_cycle_breakers is) TcM.writeMetaTyVar +{-# SPECIALISE forAllCycleBreakerBindings_ :: + CycleBreakerVarStack -> (TcTyVar -> TcType -> ZonkM ()) -> ZonkM () #-} + + +{- Note [Occurs check and representational equality] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +(a ~R# b a) is soluble if b later turns out to be Identity +So we treat this as a "soluble occurs check". Note [Don't cycle-break Wanteds when not unifying] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/GHC/Tc/Solver/Rewrite.hs b/GHC/Tc/Solver/Rewrite.hs --- a/GHC/Tc/Solver/Rewrite.hs +++ b/GHC/Tc/Solver/Rewrite.hs @@ -150,16 +150,19 @@ { let !env' = env { re_loc = bumpCtLocDepth (re_loc env) } ; thing_inside env' } --- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint --- Precondition: the CtEvidence is a CtWanted of an equality recordRewriter :: CtEvidence -> RewriteM () -recordRewriter (CtWanted { ctev_dest = HoleDest hole }) - = RewriteM $ \env -> updTcRef (re_rewriters env) (`addRewriter` hole) -recordRewriter other = pprPanic "recordRewriter" (ppr other) +-- Record that we have rewritten the target with this (equality) evidence +-- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint +-- Precondition: the CtEvidence is for an equality constraint +recordRewriter (CtGiven {}) + = return () +recordRewriter (CtWanted (WantedCt { ctev_dest = dest })) + = case dest of + HoleDest hole -> RewriteM $ \env -> updTcRef (re_rewriters env) (`addRewriter` hole) + other -> pprPanic "recordRewriter: non-equality constraint" (ppr other) -{- -Note [Rewriter EqRels] -~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Rewriter EqRels] +~~~~~~~~~~~~~~~~~~~~~~~~~ When rewriting, we need to know which equality relation -- nominal or representational -- we should be respecting. This is controlled by the `re_eq_rel` field of RewriteEnv. @@ -220,7 +223,7 @@ -- | See Note [Rewriting]. -- If (xi, co, rewriters) <- rewrite mode ev ty, then co :: xi ~r ty -- where r is the role in @ev@. --- rewriters is the set of coercion holes that have been used to rewrite +-- `rewriters` is the set of coercion holes that have been used to rewrite -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint rewrite :: CtEvidence -> TcType -> TcS (Reduction, RewriterSet) @@ -848,16 +851,18 @@ -- STEP 3: try the inerts ; flavour <- getFlavour - ; result2 <- liftTcS $ lookupFamAppInert (`eqCanRewriteFR` (flavour, eq_rel)) tc xis - ; case result2 of - { Just (redn, (inert_flavour, inert_eq_rel)) + ; mb_eq <- liftTcS $ lookupFamAppInert (`eqCanRewriteFR` (flavour, eq_rel)) tc xis + ; case mb_eq of + { Just (EqCt { eq_ev = inert_ev, eq_rhs = inert_rhs, eq_eq_rel = inert_eq_rel }) -> do { traceRewriteM "rewrite family application with inert" (ppr tc <+> ppr xis $$ ppr redn) - ; finish (inert_flavour == Given) (homogenise downgraded_redn) } - -- this will sometimes duplicate an inert in the cache, + ; recordRewriter inert_ev + ; finish (isGiven inert_ev) (homogenise downgraded_redn) } + -- This will sometimes duplicate an inert in the cache, -- but avoiding doing so had no impact on performance, and -- it seems easier not to weed out that special case where + redn = mkReduction (ctEvCoercion inert_ev) inert_rhs inert_role = eqRelRole inert_eq_rel role = eqRelRole eq_rel downgraded_redn = downgradeRedn role inert_role redn @@ -1021,12 +1026,11 @@ | Just ct <- find can_rewrite equal_ct_list , EqCt { eq_ev = ctev, eq_lhs = TyVarLHS tv , eq_rhs = rhs_ty, eq_eq_rel = ct_eq_rel } <- ct - -> do { let wrw = isWanted ctev - ; traceRewriteM "Following inert tyvar" $ + -> do { traceRewriteM "Following inert tyvar" $ vcat [ ppr tv <+> equals <+> ppr rhs_ty - , ppr ctev - , text "wanted_rewrite_wanted:" <+> ppr wrw ] - ; when wrw $ recordRewriter ctev + , ppr ctev ] + ; recordRewriter ctev + -- See Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint ; let rewriting_co1 = ctEvCoercion ctev rewriting_co = case (ct_eq_rel, eq_rel) of diff --git a/GHC/Tc/Solver/Solve.hs b/GHC/Tc/Solver/Solve.hs --- a/GHC/Tc/Solver/Solve.hs +++ b/GHC/Tc/Solver/Solve.hs @@ -1,722 +1,1837 @@ -{-# LANGUAGE RecursiveDo #-} - -module GHC.Tc.Solver.Solve ( - solveSimpleGivens, -- Solves [Ct] - solveSimpleWanteds -- Solves Cts - ) where - -import GHC.Prelude - -import GHC.Tc.Solver.Dict -import GHC.Tc.Solver.Equality( solveEquality ) -import GHC.Tc.Solver.Irred( solveIrred ) -import GHC.Tc.Solver.Rewrite( rewrite ) -import GHC.Tc.Errors.Types -import GHC.Tc.Utils.TcType -import GHC.Tc.Types.Evidence -import GHC.Tc.Types.CtLoc( ctLocEnv, ctLocOrigin, setCtLocOrigin ) -import GHC.Tc.Types -import GHC.Tc.Types.Origin -import GHC.Tc.Types.Constraint -import GHC.Tc.Solver.InertSet -import GHC.Tc.Solver.Monad - -import GHC.Core.Predicate -import GHC.Core.Reduction -import GHC.Core.Coercion -import GHC.Core.Class( classHasSCs ) - -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Types.Basic ( IntWithInf, intGtLimit ) - -import GHC.Data.Bag - -import GHC.Utils.Outputable -import GHC.Utils.Panic -import GHC.Utils.Misc - -import GHC.Driver.Session - -import Data.List( deleteFirstsBy ) - -import Control.Monad -import Data.Semigroup as S -import Data.Void( Void ) - -{- -********************************************************************** -* * -* Main Solver * -* * -********************************************************************** - -Note [Basic Simplifier Plan] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -1. Pick an element from the WorkList if there exists one with depth - less than our context-stack depth. - -2. Run it down the 'stage' pipeline. Stages are: - - canonicalization - - inert reactions - - spontaneous reactions - - top-level interactions - Each stage returns a StopOrContinue and may have sideeffected - the inerts or worklist. - - The threading of the stages is as follows: - - If (Stop) is returned by a stage then we start again from Step 1. - - If (ContinueWith ct) is returned by a stage, we feed 'ct' on to - the next stage in the pipeline. -4. If the element has survived (i.e. ContinueWith x) the last stage - then we add it in the inerts and jump back to Step 1. - -If in Step 1 no such element exists, we have exceeded our context-stack -depth and will simply fail. --} - -solveSimpleGivens :: [Ct] -> TcS () -solveSimpleGivens givens - | null givens -- Shortcut for common case - = return () - | otherwise - = do { traceTcS "solveSimpleGivens {" (ppr givens) - ; go givens - ; traceTcS "End solveSimpleGivens }" empty } - where - go givens = do { solveSimples (listToBag givens) - ; new_givens <- runTcPluginsGiven - ; when (notNull new_givens) $ - go new_givens } - -solveSimpleWanteds :: Cts -> TcS WantedConstraints --- The result is not necessarily zonked -solveSimpleWanteds simples - = do { traceTcS "solveSimpleWanteds {" (ppr simples) - ; dflags <- getDynFlags - ; (n,wc) <- go 1 (solverIterations dflags) (emptyWC { wc_simple = simples }) - ; traceTcS "solveSimpleWanteds end }" $ - vcat [ text "iterations =" <+> ppr n - , text "residual =" <+> ppr wc ] - ; return wc } - where - go :: Int -> IntWithInf -> WantedConstraints -> TcS (Int, WantedConstraints) - -- See Note [The solveSimpleWanteds loop] - go n limit wc - | n `intGtLimit` limit - = failTcS $ TcRnSimplifierTooManyIterations simples limit wc - | isEmptyBag (wc_simple wc) - = return (n,wc) - - | otherwise - = do { -- Solve - wc1 <- solve_simple_wanteds wc - - -- Run plugins - ; (rerun_plugin, wc2) <- runTcPluginsWanted wc1 - - ; if rerun_plugin - then do { traceTcS "solveSimple going round again:" (ppr rerun_plugin) - ; go (n+1) limit wc2 } -- Loop - else return (n, wc2) } -- Done - - -solve_simple_wanteds :: WantedConstraints -> TcS WantedConstraints --- Try solving these constraints --- Affects the unification state (of course) but not the inert set --- The result is not necessarily zonked -solve_simple_wanteds (WC { wc_simple = simples1, wc_impl = implics1, wc_errors = errs }) - = nestTcS $ - do { solveSimples simples1 - ; (implics2, unsolved) <- getUnsolvedInerts - ; return (WC { wc_simple = unsolved - , wc_impl = implics1 `unionBags` implics2 - , wc_errors = errs }) } - -{- Note [The solveSimpleWanteds loop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving a bunch of simple constraints is done in a loop, -(the 'go' loop of 'solveSimpleWanteds'): - 1. Try to solve them - 2. Try the plugin - 3. If the plugin wants to run again, go back to step 1 --} - -{- -************************************************************************ -* * - Solving flat constraints: solveSimples -* * -********************************************************************* -} - --- The main solver loop implements Note [Basic Simplifier Plan] ---------------------------------------------------------------- -solveSimples :: Cts -> TcS () --- Returns the final InertSet in TcS --- Has no effect on work-list or residual-implications --- The constraints are initially examined in left-to-right order - -solveSimples cts - = {-# SCC "solveSimples" #-} - do { emitWork cts; solve_loop } - where - solve_loop - = {-# SCC "solve_loop" #-} - do { sel <- selectNextWorkItem - ; case sel of - Nothing -> return () - Just ct -> do { solveOne ct - ; solve_loop } } - -solveOne :: Ct -> TcS () -- Solve one constraint -solveOne workItem - = do { wl <- getWorkList - ; inerts <- getInertSet - ; tclevel <- getTcLevel - ; traceTcS "----------------------------- " empty - ; traceTcS "Start solver pipeline {" $ - vcat [ text "tclevel =" <+> ppr tclevel - , text "work item =" <+> ppr workItem - , text "inerts =" <+> ppr inerts - , text "rest of worklist =" <+> ppr wl ] - - ; bumpStepCountTcS -- One step for each constraint processed - ; solve workItem } - where - solve :: Ct -> TcS () - solve ct - = do { traceTcS "solve {" (text "workitem = " <+> ppr ct) - ; res <- runSolverStage (solveCt ct) - ; traceTcS "end solve }" (ppr res) - ; case res of - StartAgain ct -> do { traceTcS "Go round again" (ppr ct) - ; solve ct } - - Stop ev s -> do { traceFireTcS ev s - ; traceTcS "End solver pipeline }" empty - ; return () } - - -- ContinueWith can't happen: res :: SolverStage Void - -- solveCt either solves the constraint, or puts - -- the unsolved constraint in the inert set. - } - -{- ********************************************************************* -* * -* Solving one constraint: solveCt -* * -************************************************************************ - -Note [Canonicalization] -~~~~~~~~~~~~~~~~~~~~~~~ -Canonicalization converts a simple constraint to a canonical form. It is -unary (i.e. treats individual constraints one at a time). - -Constraints originating from user-written code come into being as -CNonCanonicals. We know nothing about these constraints. So, first: - - Classify CNonCanoncal constraints, depending on whether they - are equalities, class predicates, or other. - -Then proceed depending on the shape of the constraint. Generally speaking, -each constraint gets rewritten and then decomposed into one of several forms -(see type Ct in GHC.Tc.Types). - -When an already-canonicalized constraint gets kicked out of the inert set, -it must be recanonicalized. But we know a bit about its shape from the -last time through, so we can skip the classification step. --} - -solveCt :: Ct -> SolverStage Void --- The Void result tells us that solveCt cannot return --- a ContinueWith; it must return Stop or StartAgain. -solveCt (CNonCanonical ev) = solveNC ev -solveCt (CIrredCan (IrredCt { ir_ev = ev })) = solveNC ev - -solveCt (CEqCan (EqCt { eq_ev = ev, eq_eq_rel = eq_rel - , eq_lhs = lhs, eq_rhs = rhs })) - = solveEquality ev eq_rel (canEqLHSType lhs) rhs - -solveCt (CQuantCan (QCI { qci_ev = ev, qci_pend_sc = pend_sc })) - = do { ev <- rewriteEvidence ev - -- It is (much) easier to rewrite and re-classify than to - -- rewrite the pieces and build a Reduction that will rewrite - -- the whole constraint - ; case classifyPredType (ctEvPred ev) of - ForAllPred tvs th p -> Stage $ solveForAll ev tvs th p pend_sc - _ -> pprPanic "SolveCt" (ppr ev) } - -solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) - = do { ev <- rewriteEvidence ev - -- It is easier to rewrite and re-classify than to rewrite - -- the pieces and build a Reduction that will rewrite the - -- whole constraint - ; case classifyPredType (ctEvPred ev) of - ClassPred cls tys - -> solveDict (DictCt { di_ev = ev, di_cls = cls - , di_tys = tys, di_pend_sc = pend_sc }) - _ -> pprPanic "solveCt" (ppr ev) } - ------------------- -solveNC :: CtEvidence -> SolverStage Void -solveNC ev - = -- Instead of rewriting the evidence before classifying, it's possible we - -- can make progress without the rewrite. Try this first. - -- For insolubles (all of which are equalities), do /not/ rewrite the arguments - -- In #14350 doing so led entire-unnecessary and ridiculously large - -- type function expansion. Instead, canEqNC just applies - -- the substitution to the predicate, and may do decomposition; - -- e.g. a ~ [a], where [G] a ~ [Int], can decompose - case classifyPredType (ctEvPred ev) of { - EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 ; - _ -> - - -- Do rewriting on the constraint, especially zonking - do { ev <- rewriteEvidence ev - ; let irred = IrredCt { ir_ev = ev, ir_reason = IrredShapeReason } - - -- And then re-classify - ; case classifyPredType (ctEvPred ev) of - ClassPred cls tys -> solveDictNC ev cls tys - ForAllPred tvs th p -> Stage $ solveForAllNC ev tvs th p - IrredPred {} -> solveIrred irred - EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 - -- This case only happens if (say) `c` is unified with `a ~# b`, - -- but that is rare becuase it requires c :: CONSTRAINT UnliftedRep - - }} - - -{- ********************************************************************* -* * -* Quantified constraints -* * -********************************************************************* -} - -{- Note [Quantified constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The -XQuantifiedConstraints extension allows type-class contexts like this: - - data Rose f x = Rose x (f (Rose f x)) - - instance (Eq a, forall b. Eq b => Eq (f b)) - => Eq (Rose f a) where - (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 == rs2 - -Note the (forall b. Eq b => Eq (f b)) in the instance contexts. -This quantified constraint is needed to solve the - [W] (Eq (f (Rose f x))) -constraint which arises form the (==) definition. - -The wiki page is - https://gitlab.haskell.org/ghc/ghc/wikis/quantified-constraints -which in turn contains a link to the GHC Proposal where the change -is specified, and a Haskell Symposium paper about it. - -We implement two main extensions to the design in the paper: - - 1. We allow a variable in the instance head, e.g. - f :: forall m a. (forall b. m b) => D (m a) - Notice the 'm' in the head of the quantified constraint, not - a class. - - 2. We support superclasses to quantified constraints. - For example (contrived): - f :: (Ord b, forall b. Ord b => Ord (m b)) => m a -> m a -> Bool - f x y = x==y - Here we need (Eq (m a)); but the quantified constraint deals only - with Ord. But we can make it work by using its superclass. - -Here are the moving parts - * Language extension {-# LANGUAGE QuantifiedConstraints #-} - and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension - - * A new form of evidence, EvDFun, that is used to discharge - such wanted constraints - - * checkValidType gets some changes to accept forall-constraints - only in the right places. - - * Predicate.Pred gets a new constructor ForAllPred, and - and classifyPredType analyses a PredType to decompose - the new forall-constraints - - * GHC.Tc.Solver.Monad.InertCans gets an extra field, inert_insts, - which holds all the Given forall-constraints. In effect, - such Given constraints are like local instance decls. - - * When trying to solve a class constraint, via - GHC.Tc.Solver.Instance.Class.matchInstEnv, use the InstEnv from inert_insts - so that we include the local Given forall-constraints - in the lookup. (See GHC.Tc.Solver.Monad.getInstEnvs.) - - * `solveForAll` deals with solving a forall-constraint. See - Note [Solving a Wanted forall-constraint] - - * We augment the kick-out code to kick out an inert - forall constraint if it can be rewritten by a new - type equality; see GHC.Tc.Solver.Monad.kick_out_rewritable - -Note that a quantified constraint is never /inferred/ -(by GHC.Tc.Solver.simplifyInfer). A function can only have a -quantified constraint in its type if it is given an explicit -type signature. - --} - -solveForAllNC :: CtEvidence -> [TcTyVar] -> TcThetaType -> TcPredType - -> TcS (StopOrContinue Void) --- NC: this came from CNonCanonical, so we have not yet expanded superclasses --- Precondition: already rewritten by inert set -solveForAllNC ev tvs theta pred - | isGiven ev -- See Note [Eagerly expand given superclasses] - , Just (cls, tys) <- cls_pred_tys_maybe - = do { dflags <- getDynFlags - ; sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys - -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] - ; emitWork (listToBag sc_cts) - ; solveForAll ev tvs theta pred doNotExpand } - -- doNotExpand: as we have already (eagerly) expanded superclasses for this class - - | otherwise - = do { dflags <- getDynFlags - ; let fuel | Just (cls, _) <- cls_pred_tys_maybe - , classHasSCs cls = qcsFuel dflags - -- See invariants (a) and (b) in QCI.qci_pend_sc - -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] - -- See Note [Quantified constraints] - | otherwise = doNotExpand - ; solveForAll ev tvs theta pred fuel } - where - cls_pred_tys_maybe = getClassPredTys_maybe pred - -solveForAll :: CtEvidence -> [TcTyVar] -> TcThetaType -> PredType -> ExpansionFuel - -> TcS (StopOrContinue Void) --- Precondition: already rewritten by inert set -solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc }) - tvs theta pred _fuel - = -- See Note [Solving a Wanted forall-constraint] - setSrcSpan (getCtLocEnvLoc $ ctLocEnv loc) $ - -- This setSrcSpan is important: the emitImplicationTcS uses that - -- TcLclEnv for the implication, and that in turn sets the location - -- for the Givens when solving the constraint (#21006) - do { let empty_subst = mkEmptySubst $ mkInScopeSet $ - tyCoVarsOfTypes (pred:theta) `delVarSetList` tvs - is_qc = IsQC (ctLocOrigin loc) - - -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] - -- in GHC.Tc.Utils.TcType - -- Very like the code in tcSkolDFunType - ; rec { skol_info <- mkSkolemInfo skol_info_anon - ; (subst, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst tvs - ; let inst_pred = substTy subst pred - inst_theta = substTheta subst theta - skol_info_anon = InstSkol is_qc (get_size inst_pred) } - - ; given_ev_vars <- mapM newEvVar inst_theta - ; (lvl, (w_id, wanteds)) - <- pushLevelNoWorkList (ppr skol_info) $ - do { let loc' = setCtLocOrigin loc (ScOrigin is_qc NakedSc) - -- Set the thing to prove to have a ScOrigin, so we are - -- careful about its termination checks. - -- See (QC-INV) in Note [Solving a Wanted forall-constraint] - ; wanted_ev <- newWantedEvVarNC loc' rewriters inst_pred - ; return ( ctEvEvId wanted_ev - , unitBag (mkNonCanonical wanted_ev)) } - - ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - - ; setWantedEvTerm dest EvCanonical $ - EvFun { et_tvs = skol_tvs, et_given = given_ev_vars - , et_binds = ev_binds, et_body = w_id } - - ; stopWith ev "Wanted forall-constraint" } - where - -- Getting the size of the head is a bit horrible - -- because of the special treament for class predicates - get_size pred = case classifyPredType pred of - ClassPred cls tys -> pSizeClassPred cls tys - _ -> pSizeType pred - - -- See Note [Solving a Given forall-constraint] -solveForAll ev@(CtGiven {}) tvs _theta pred fuel - = do { addInertForAll qci - ; stopWith ev "Given forall-constraint" } - where - qci = QCI { qci_ev = ev, qci_tvs = tvs - , qci_pred = pred, qci_pend_sc = fuel } - -{- Note [Solving a Wanted forall-constraint] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Solving a wanted forall (quantified) constraint - [W] df :: forall ab. (Eq a, Ord b) => C x a b -is delightfully easy. Just build an implication constraint - forall ab. (g1::Eq a, g2::Ord b) => [W] d :: C x a -and discharge df thus: - df = /\ab. \g1 g2. let in d -where is filled in by solving the implication constraint. -All the machinery is to hand; there is little to do. - -The tricky point is about termination: see #19690. We want to maintain -the invariant (QC-INV): - - (QC-INV) Every quantified constraint returns a non-bottom dictionary - -just as every top-level instance declaration guarantees to return a non-bottom -dictionary. But as #19690 shows, it is possible to get a bottom dicionary -by superclass selection if we aren't careful. The situation is very similar -to that described in Note [Recursive superclasses] in GHC.Tc.TyCl.Instance; -and we use the same solution: - -* Give the Givens a CtOrigin of (GivenOrigin (InstSkol IsQC head_size)) -* Give the Wanted a CtOrigin of (ScOrigin IsQC NakedSc) - -Both of these things are done in solveForAll. Now the mechanism described -in Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance takes over. - -Note [Solving a Given forall-constraint] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For a Given constraint - [G] df :: forall ab. (Eq a, Ord b) => C x a b -we just add it to TcS's local InstEnv of known instances, -via addInertForall. Then, if we look up (C x Int Bool), say, -we'll find a match in the InstEnv. - - -************************************************************************ -* * - Evidence transformation -* * -************************************************************************ --} - -rewriteEvidence :: CtEvidence -> SolverStage CtEvidence --- (rewriteEvidence old_ev new_pred co do_next) --- Main purpose: create new evidence for new_pred; --- unless new_pred is cached already --- * Calls do_next with (new_ev :: new_pred), with same wanted/given flag as old_ev --- * If old_ev was wanted, create a binding for old_ev, in terms of new_ev --- * If old_ev was given, AND not cached, create a binding for new_ev, in terms of old_ev --- * Stops if new_ev is already cached --- --- Old evidence New predicate is Return new evidence --- flavour of same flavor --- ------------------------------------------------------------------- --- Wanted Already solved or in inert Stop --- Not do_next new_evidence --- --- Given Already in inert Stop --- Not do_next new_evidence - -{- Note [Rewriting with Refl] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the coercion is just reflexivity then you may re-use the same -evidence variable. But be careful! Although the coercion is Refl, new_pred -may reflect the result of unification alpha := ty, so new_pred might -not _look_ the same as old_pred, and it's vital to proceed from now on -using new_pred. - -The rewriter preserves type synonyms, so they should appear in new_pred -as well as in old_pred; that is important for good error messages. - -If we are rewriting with Refl, then there are no new rewriters to add to -the rewriter set. We check this with an assertion. - -} - - -rewriteEvidence ev - = Stage $ do { traceTcS "rewriteEvidence" (ppr ev) - ; (redn, rewriters) <- rewrite ev (ctEvPred ev) - ; finish_rewrite ev redn rewriters } - -finish_rewrite :: CtEvidence -- ^ old evidence - -> Reduction -- ^ new predicate + coercion, of type ~ new predicate - -> RewriterSet -- ^ See Note [Wanteds rewrite Wanteds] - -- in GHC.Tc.Types.Constraint - -> TcS (StopOrContinue CtEvidence) -finish_rewrite old_ev (Reduction co new_pred) rewriters - | isReflCo co -- See Note [Rewriting with Refl] - = assert (isEmptyRewriterSet rewriters) $ - continueWith (setCtEvPredType old_ev new_pred) - -finish_rewrite ev@(CtGiven { ctev_evar = old_evar, ctev_loc = loc }) - (Reduction co new_pred) rewriters - = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted - do { new_ev <- newGivenEvVar loc (new_pred, new_tm) - ; continueWith new_ev } - where - -- mkEvCast optimises ReflCo - ev_rw_role = ctEvRewriteRole ev - new_tm = assert (coercionRole co == ev_rw_role) - mkEvCast (evId old_evar) - (downgradeRole Representational ev_rw_role co) - -finish_rewrite ev@(CtWanted { ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = rewriters }) - (Reduction co new_pred) new_rewriters - = do { mb_new_ev <- newWanted loc rewriters' new_pred - ; let ev_rw_role = ctEvRewriteRole ev - ; massert (coercionRole co == ev_rw_role) - ; setWantedEvTerm dest EvCanonical $ - mkEvCast (getEvExpr mb_new_ev) - (downgradeRole Representational ev_rw_role (mkSymCo co)) - ; case mb_new_ev of - Fresh new_ev -> continueWith new_ev - Cached _ -> stopWith ev "Cached wanted" } - where - rewriters' = rewriters S.<> new_rewriters - -{- ******************************************************************* -* * -* Typechecker plugins -* * -******************************************************************* -} - --- | Extract the (inert) givens and invoke the plugins on them. --- Remove solved givens from the inert set and emit insolubles, but --- return new work produced so that 'solveSimpleGivens' can feed it back --- into the main solver. -runTcPluginsGiven :: TcS [Ct] -runTcPluginsGiven - = do { solvers <- getTcPluginSolvers - ; if null solvers then return [] else - do { givens <- getInertGivens - ; if null givens then return [] else - do { traceTcS "runTcPluginsGiven {" (ppr givens) - ; p <- runTcPluginSolvers solvers (givens,[]) - ; let (solved_givens, _) = pluginSolvedCts p - insols = map (ctIrredCt PluginReason) (pluginBadCts p) - ; updInertCans (removeInertCts solved_givens . - updIrreds (addIrreds insols) ) - ; traceTcS "runTcPluginsGiven }" $ - vcat [ text "solved_givens:" <+> ppr solved_givens - , text "insols:" <+> ppr insols - , text "new:" <+> ppr (pluginNewCts p) ] - ; return (pluginNewCts p) } } } - --- | Given a bag of (rewritten, zonked) wanteds, invoke the plugins on --- them and produce an updated bag of wanteds (possibly with some new --- work) and a bag of insolubles. The boolean indicates whether --- 'solveSimpleWanteds' should feed the updated wanteds back into the --- main solver. -runTcPluginsWanted :: WantedConstraints -> TcS (Bool, WantedConstraints) -runTcPluginsWanted wc@(WC { wc_simple = simples1 }) - | isEmptyBag simples1 - = return (False, wc) - | otherwise - = do { solvers <- getTcPluginSolvers - ; if null solvers then return (False, wc) else - - do { given <- getInertGivens - ; wanted <- zonkSimples simples1 -- Plugin requires zonked inputs - - ; traceTcS "Running plugins (" (vcat [ text "Given:" <+> ppr given - , text "Watned:" <+> ppr wanted ]) - ; p <- runTcPluginSolvers solvers (given, bagToList wanted) - ; let (_, solved_wanted) = pluginSolvedCts p - (_, unsolved_wanted) = pluginInputCts p - new_wanted = pluginNewCts p - insols = pluginBadCts p - all_new_wanted = listToBag new_wanted `andCts` - listToBag unsolved_wanted `andCts` - listToBag insols - --- SLPJ: I'm deeply suspicious of this --- ; updInertCans (removeInertCts $ solved_givens) - - ; mapM_ setEv solved_wanted - - ; traceTcS "Finished plugins }" (ppr new_wanted) - ; return ( notNull (pluginNewCts p) - , wc { wc_simple = all_new_wanted } ) } } - where - setEv :: (EvTerm,Ct) -> TcS () - setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest EvCanonical ev - -- TODO: plugins should be able to signal non-canonicity - _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" - --- | A pair of (given, wanted) constraints to pass to plugins -type SplitCts = ([Ct], [Ct]) - --- | A solved pair of constraints, with evidence for wanteds -type SolvedCts = ([Ct], [(EvTerm,Ct)]) - --- | Represents collections of constraints generated by typechecker --- plugins -data TcPluginProgress = TcPluginProgress - { pluginInputCts :: SplitCts - -- ^ Original inputs to the plugins with solved/bad constraints - -- removed, but otherwise unmodified - , pluginSolvedCts :: SolvedCts - -- ^ Constraints solved by plugins - , pluginBadCts :: [Ct] - -- ^ Constraints reported as insoluble by plugins - , pluginNewCts :: [Ct] - -- ^ New constraints emitted by plugins - } - -getTcPluginSolvers :: TcS [TcPluginSolver] -getTcPluginSolvers - = do { tcg_env <- getGblEnv; return (tcg_tc_plugin_solvers tcg_env) } - --- | Starting from a pair of (given, wanted) constraints, --- invoke each of the typechecker constraint-solving plugins in turn and return --- --- * the remaining unmodified constraints, --- * constraints that have been solved, --- * constraints that are insoluble, and --- * new work. --- --- Note that new work generated by one plugin will not be seen by --- other plugins on this pass (but the main constraint solver will be --- re-invoked and they will see it later). There is no check that new --- work differs from the original constraints supplied to the plugin: --- the plugin itself should perform this check if necessary. -runTcPluginSolvers :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress -runTcPluginSolvers solvers all_cts - = do { ev_binds_var <- getTcEvBindsVar - ; foldM (do_plugin ev_binds_var) initialProgress solvers } - where - do_plugin :: EvBindsVar -> TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress - do_plugin ev_binds_var p solver = do - result <- runTcPluginTcS (uncurry (solver ev_binds_var) (pluginInputCts p)) - return $ progress p result - - progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress - progress p - (TcPluginSolveResult - { tcPluginInsolubleCts = bad_cts - , tcPluginSolvedCts = solved_cts - , tcPluginNewCts = new_cts - } - ) = - p { pluginInputCts = discard (bad_cts ++ map snd solved_cts) (pluginInputCts p) - , pluginSolvedCts = add solved_cts (pluginSolvedCts p) - , pluginNewCts = new_cts ++ pluginNewCts p - , pluginBadCts = bad_cts ++ pluginBadCts p - } - - initialProgress = TcPluginProgress all_cts ([], []) [] [] - - discard :: [Ct] -> SplitCts -> SplitCts - discard cts (xs, ys) = - (xs `without` cts, ys `without` cts) - - without :: [Ct] -> [Ct] -> [Ct] - without = deleteFirstsBy eq_ct - - eq_ct :: Ct -> Ct -> Bool - eq_ct c c' = ctFlavour c == ctFlavour c' - && ctPred c `tcEqType` ctPred c' - - add :: [(EvTerm,Ct)] -> SolvedCts -> SolvedCts - add xs scs = foldl' addOne scs xs - - addOne :: SolvedCts -> (EvTerm,Ct) -> SolvedCts - addOne (givens, wanteds) (ev,ct) = case ctEvidence ct of - CtGiven {} -> (ct:givens, wanteds) - CtWanted {} -> (givens, (ev,ct):wanteds) - - +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} + +module GHC.Tc.Solver.Solve ( + simplifyWantedsTcM, + solveWanteds, -- Solves WantedConstraints + solveSimpleGivens, -- Solves [Ct] + solveSimpleWanteds, -- Solves Cts + trySolveImplication, + + setImplicationStatus + ) where + +import GHC.Prelude + +import GHC.Tc.Solver.Dict +import GHC.Tc.Solver.Equality( solveEquality ) +import GHC.Tc.Solver.Irred( solveIrred ) +import GHC.Tc.Solver.Rewrite( rewrite, rewriteType ) +import GHC.Tc.Errors.Types +import GHC.Tc.Utils.TcType +import GHC.Tc.Types.Evidence +import GHC.Tc.Types.CtLoc( ctLocEnv, ctLocOrigin, setCtLocOrigin ) +import GHC.Tc.Types +import GHC.Tc.Types.Origin +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.CtLoc( mkGivenLoc ) +import GHC.Tc.Solver.InertSet +import GHC.Tc.Solver.Monad as TcS +import qualified GHC.Tc.Utils.Monad as TcM +import qualified GHC.Tc.Zonk.TcType as TcM + +import GHC.Core.Predicate +import GHC.Core.Reduction +import GHC.Core.Coercion +import GHC.Core.TyCo.FVs( coVarsOfCos ) +import GHC.Core.Class( classHasSCs ) + +import GHC.Types.Id( idType ) +import GHC.Types.Var( EvVar, tyVarKind ) +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Basic ( IntWithInf, intGtLimit ) +import GHC.Types.Unique.Set( nonDetStrictFoldUniqSet ) + +import GHC.Data.Bag + +import GHC.Utils.Outputable +import GHC.Utils.Panic +import GHC.Utils.Misc + +import GHC.Driver.Session + + +import Control.Monad + +import Data.List( deleteFirstsBy ) +import Data.Maybe ( mapMaybe ) +import qualified Data.Semigroup as S +import Data.Void( Void ) + +{- ******************************************************************************** +* * +* Main Simplifier * +* * +******************************************************************************** -} + +simplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints +-- Solve the specified Wanted constraints +-- Discard the evidence binds +-- Postcondition: fully zonked +simplifyWantedsTcM wanted + = do { TcM.traceTc "simplifyWantedsTcM {" (ppr wanted) + ; (result, _) <- runTcS (solveWanteds (mkSimpleWC wanted)) + ; result <- TcM.liftZonkM $ TcM.zonkWC result + ; TcM.traceTc "simplifyWantedsTcM }" (ppr result) + ; return result } + +solveWanteds :: WantedConstraints -> TcS WantedConstraints +solveWanteds wc@(WC { wc_errors = errs }) + = do { cur_lvl <- TcS.getTcLevel + ; traceTcS "solveWanteds {" $ + vcat [ text "Level =" <+> ppr cur_lvl + , ppr wc ] + + ; dflags <- getDynFlags + ; solved_wc <- simplify_loop 0 (solverIterations dflags) True wc + + ; errs' <- simplifyDelayedErrors errs + ; let final_wc = solved_wc { wc_errors = errs' } + + ; ev_binds_var <- getTcEvBindsVar + ; bb <- TcS.getTcEvBindsMap ev_binds_var + ; traceTcS "solveWanteds }" $ + vcat [ text "final wc =" <+> ppr final_wc + , text "ev_binds_var =" <+> ppr ev_binds_var + , text "current evbinds =" <+> ppr (evBindMapBinds bb) ] + + ; return final_wc } + +simplify_loop :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +-- Do a round of solving, and call maybe_simplify_again to iterate +-- The 'definitely_redo_implications' flags is False if the only reason we +-- are iterating is that we have added some new Wanted superclasses +-- hoping for fundeps to help us; see Note [Superclass iteration] +-- +-- Does not affect wc_holes at all; reason: wc_holes never affects anything +-- else, so we do them once, at the end in solveWanteds +simplify_loop n limit definitely_redo_implications + wc@(WC { wc_simple = simples, wc_impl = implics }) + | isSolvedWC wc -- Fast path + = return wc + | otherwise + = do { csTraceTcS $ + text "simplify_loop iteration=" <> int n + <+> (parens $ hsep [ text "definitely_redo =" <+> ppr definitely_redo_implications <> comma + , int (lengthBag simples) <+> text "simples to solve" ]) + ; traceTcS "simplify_loop: wc =" (ppr wc) + + ; (unifs1, wc1) <- reportUnifications $ -- See Note [Superclass iteration] + solveSimpleWanteds simples + -- Any insoluble constraints are in 'simples' and so get rewritten + -- See Note [Rewrite insolubles] in GHC.Tc.Solver.InertSet + + -- Next, solve implications from wc_impl + ; implics' <- if not definitely_redo_implications -- See Note [Superclass iteration] + && unifs1 == 0 -- for this conditional + then return implics + else solveNestedImplications implics + + ; let wc' = wc1 { wc_impl = wc_impl wc1 `unionBags` implics' } + + ; unif_happened <- resetUnificationFlag + ; csTraceTcS $ text "unif_happened" <+> ppr unif_happened + -- Note [The Unification Level Flag] in GHC.Tc.Solver.Monad + ; maybe_simplify_again (n+1) limit unif_happened wc' } + +maybe_simplify_again :: Int -> IntWithInf -> Bool + -> WantedConstraints -> TcS WantedConstraints +maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples }) + | n `intGtLimit` limit + = do { -- Add an error (not a warning) if we blow the limit, + -- Typically if we blow the limit we are going to report some other error + -- (an unsolved constraint), and we don't want that error to suppress + -- the iteration limit warning! + addErrTcS $ TcRnSimplifierTooManyIterations simples limit wc + ; return wc } + + | unif_happened + = simplify_loop n limit True wc + + | superClassesMightHelp wc -- Returns False quickly if wc is solved + = -- We still have unsolved goals, and apparently no way to solve them, + -- so try expanding superclasses at this level, both Given and Wanted + do { pending_given <- getPendingGivenScs + ; let (pending_wanted, simples1) = getPendingWantedScs simples + ; if null pending_given && null pending_wanted + then return wc -- After all, superclasses did not help + else + do { new_given <- makeSuperClasses pending_given + ; new_wanted <- makeSuperClasses pending_wanted + ; solveSimpleGivens new_given -- Add the new Givens to the inert set + ; traceTcS "maybe_simplify_again" (vcat [ text "pending_given" <+> ppr pending_given + , text "new_given" <+> ppr new_given + , text "pending_wanted" <+> ppr pending_wanted + , text "new_wanted" <+> ppr new_wanted ]) + ; simplify_loop n limit (not (null pending_given)) $ + wc { wc_simple = simples1 `unionBags` listToBag new_wanted } } } + -- (not (null pending_given)): see Note [Superclass iteration] + + | otherwise + = return wc + +{- Note [Superclass iteration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this implication constraint + forall a. + [W] d: C Int beta + forall b. blah +where + class D a b | a -> b + class D a b => C a b +We will expand d's superclasses, giving [W] D Int beta, in the hope of geting +fundeps to unify beta. Doing so is usually fruitless (no useful fundeps), +and if so it seems a pity to waste time iterating the implications (forall b. blah) +(If we add new Given superclasses it's a different matter: it's really worth looking +at the implications.) + +Hence the definitely_redo_implications flag to simplify_loop. It's usually +True, but False in the case where the only reason to iterate is new Wanted +superclasses. In that case we check whether the new Wanteds actually led to +any new unifications, and iterate the implications only if so. +-} + +{- Note [Expanding Recursive Superclasses and ExpansionFuel] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the class declaration (T21909) + + class C [a] => C a where + foo :: a -> Int + +and suppose during type inference we obtain an implication constraint: + + forall a. C a => C [[a]] + +To solve this implication constraint, we first expand one layer of the superclass +of Given constraints, but not for Wanted constraints. +(See Note [Eagerly expand given superclasses] and Note [Why adding superclasses can help] +in GHC.Tc.Solver.Dict.) We thus get: + + [G] g1 :: C a + [G] g2 :: C [a] -- new superclass layer from g1 + [W] w1 :: C [[a]] + +Now, we cannot solve `w1` directly from `g1` or `g2` as we may not have +any instances for C. So we expand a layer of superclasses of each Wanteds and Givens +that we haven't expanded yet. +This is done in `maybe_simplify_again`. And we get: + + [G] g1 :: C a + [G] g2 :: C [a] + [G] g3 :: C [[a]] -- new superclass layer from g2, can solve w1 + [W] w1 :: C [[a]] + [W] w2 :: C [[[a]]] -- new superclass layer from w1, not solvable + +Now, although we can solve `w1` using `g3` (obtained from expanding `g2`), +we have a new wanted constraint `w2` (obtained from expanding `w1`) that cannot be solved. +We thus make another go at solving in `maybe_simplify_again` by expanding more +layers of superclasses. This looping is futile as Givens will never be able to catch up with Wanteds. + +Side Note: In principle we don't actually need to /solve/ `w2`, as it is a superclass of `w1` +but we only expand it to expose any functional dependencies (see Note [The superclass story]) +But `w2` is a wanted constraint, so we will try to solve it like any other, +even though ultimately we will discard its evidence. + +Solution: Simply bound the maximum number of layers of expansion for +Givens and Wanteds, with ExpansionFuel. Give the Givens more fuel +(say 3 layers) than the Wanteds (say 1 layer). Now the Givens will +win. The Wanteds don't need much fuel: we are only expanding at all +to expose functional dependencies, and wantedFuel=1 means we will +expand a full recursive layer. If the superclass hierarchy is +non-recursive (the normal case) one layer is therefore full expansion. + +The default value for wantedFuel = Constants.max_WANTEDS_FUEL = 1. +The default value for givenFuel = Constants.max_GIVENS_FUEL = 3. +Both are configurable via the `-fgivens-fuel` and `-fwanteds-fuel` +compiler flags. + +There are two preconditions for the default fuel values: + (1) default givenFuel >= default wantedsFuel + (2) default givenFuel < solverIterations + +Precondition (1) ensures that we expand givens at least as many times as we expand wanted constraints +preferably givenFuel > wantedsFuel to avoid issues like T21909 while +the precondition (2) ensures that we do not reach the solver iteration limit and fail with a +more meaningful error message (see T19627) + +This also applies for quantified constraints; see `-fqcs-fuel` compiler flag and `QCI.qci_pend_sc` field. +-} + +{- ******************************************************************************** +* * +* Solving implication constraints * +* * +******************************************************************************** -} + +solveNestedImplications :: Bag Implication + -> TcS (Bag Implication) +-- Precondition: the TcS inerts may contain unsolved simples which have +-- to be converted to givens before we go inside a nested implication. +solveNestedImplications implics + | isEmptyBag implics + = return (emptyBag) + | otherwise + = do { traceTcS "solveNestedImplications starting {" empty + ; unsolved_implics <- mapBagM solveImplication implics + + -- ... and we are back in the original TcS inerts + -- Notice that the original includes the _insoluble_simples so it was safe to ignore + -- them in the beginning of this function. + ; traceTcS "solveNestedImplications end }" $ + vcat [ text "unsolved_implics =" <+> ppr unsolved_implics ] + + ; return unsolved_implics } + +{- Note [trySolveImplication] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`trySolveImplication` may be invoked while solving simple wanteds, notably from +`solveWantedForAll`. It returns a Bool to say if solving succeeded or failed. + +It uses `nestImplicTcS` to build a nested scope. One subtle point is that +`nestImplicTcS` uses the `inert_givens` (not the `inert_cans`) of the current +inert set to initialse the `InertSet` of the nested scope. It is super-important not +to pollute the sub-solving problem with the unsolved Wanteds of the current scope. + +Whenever we do `solveSimpleGivens`, we snapshot the `inert_cans` into `inert_givens`. +(At that moment there should be no Wanteds.) +-} + +trySolveImplication :: Implication -> TcS Bool +-- See Note [trySolveImplication] +trySolveImplication (Implic { ic_tclvl = tclvl + , ic_binds = ev_binds_var + , ic_given = given_ids + , ic_wanted = wanteds + , ic_env = ct_loc_env + , ic_info = info }) + = nestImplicTcS ev_binds_var tclvl $ + do { let loc = mkGivenLoc tclvl info ct_loc_env + givens = mkGivens loc given_ids + ; solveSimpleGivens givens + ; residual_wanted <- solveWanteds wanteds + ; return (isSolvedWC residual_wanted) } + +solveImplication :: Implication -- Wanted + -> TcS Implication -- Simplified implication +-- Precondition: The TcS monad contains an empty worklist and given-only inerts +-- which after trying to solve this implication we must restore to their original value +solveImplication imp@(Implic { ic_tclvl = tclvl + , ic_binds = ev_binds_var + , ic_given = given_ids + , ic_wanted = wanteds + , ic_info = info + , ic_env = ct_loc_env + , ic_status = status }) + | isSolvedStatus status + = return imp -- Do nothing + + | otherwise -- Even for IC_Insoluble it is worth doing more work + -- The insoluble stuff might be in one sub-implication + -- and other unsolved goals in another; and we want to + -- solve the latter as much as possible + = do { inerts <- getInertSet + ; traceTcS "solveImplication {" (ppr imp $$ text "Inerts" <+> ppr inerts) + + -- commented out; see `where` clause below + -- ; when debugIsOn check_tc_level + + -- Solve the nested constraints + ; (has_given_eqs, given_insols, residual_wanted) + <- nestImplicTcS ev_binds_var tclvl $ + do { let loc = mkGivenLoc tclvl info ct_loc_env + givens = mkGivens loc given_ids + ; solveSimpleGivens givens + + ; residual_wanted <- solveWanteds wanteds + + ; (has_eqs, given_insols) <- getHasGivenEqs tclvl + -- Call getHasGivenEqs /after/ solveWanteds, because + -- solveWanteds can augment the givens, via expandSuperClasses, + -- to reveal given superclass equalities + + ; return (has_eqs, given_insols, residual_wanted) } + + ; traceTcS "solveImplication 2" + (ppr given_insols $$ ppr residual_wanted) + + ; evbinds <- TcS.getTcEvBindsMap ev_binds_var + ; traceTcS "solveImplication 3" $ vcat + [ text "ev_binds_var" <+> ppr ev_binds_var + , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) ] + + ; let final_wanted = residual_wanted `addInsols` given_insols + -- Don't lose track of the insoluble givens, + -- which signal unreachable code; put them in ic_wanted + + ; res_implic <- setImplicationStatus (imp { ic_given_eqs = has_given_eqs + , ic_wanted = final_wanted }) + + ; evbinds <- TcS.getTcEvBindsMap ev_binds_var + ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var + ; traceTcS "solveImplication end }" $ vcat + [ text "has_given_eqs =" <+> ppr has_given_eqs + , text "res_implic =" <+> ppr res_implic + , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds) + , text "implication tvcs =" <+> ppr tcvs ] + + ; return res_implic } + + -- TcLevels must be strictly increasing (see (ImplicInv) in + -- Note [TcLevel invariants] in GHC.Tc.Utils.TcType), + -- and in fact I think they should always increase one level at a time. + + -- Though sensible, this check causes lots of testsuite failures. It is + -- remaining commented out for now. + {- + check_tc_level = do { cur_lvl <- TcS.getTcLevel + ; massertPpr (tclvl == pushTcLevel cur_lvl) + (text "Cur lvl =" <+> ppr cur_lvl $$ text "Imp lvl =" <+> ppr tclvl) } + -} + +---------------------- +setImplicationStatus :: Implication -> TcS Implication +-- Finalise the implication returned from solveImplication, +-- * Set the ic_status field +-- * Prune unnecessary evidence bindings +-- * Prune unnecessary child implications +-- Precondition: the ic_status field is not already IC_Solved +setImplicationStatus implic@(Implic { ic_status = old_status + , ic_info = info + , ic_wanted = wc }) + = assertPpr (not (isSolvedStatus old_status)) (ppr info) $ + -- Precondition: we only set the status if it is not already solved + do { traceTcS "setImplicationStatus {" (ppr implic) + + ; let solved = isSolvedWC wc + ; new_implic <- neededEvVars implic + ; bad_telescope <- if solved then checkBadTelescope implic + else return False + + ; let new_status | insolubleWC wc = IC_Insoluble + | not solved = IC_Unsolved + | bad_telescope = IC_BadTelescope + | otherwise = IC_Solved { ics_dead = dead_givens } + dead_givens = findRedundantGivens new_implic + new_wc = pruneImplications wc + + final_implic = new_implic { ic_status = new_status + , ic_wanted = new_wc } + + ; traceTcS "setImplicationStatus }" (ppr final_implic) + ; return final_implic } + +pruneImplications :: WantedConstraints -> WantedConstraints +-- We have now recorded the `ic_need` variables of the child +-- implications (in `ic_need_implics` of the parent) so we can +-- delete any unnecessary children. +pruneImplications wc@(WC { wc_impl = implics }) + = wc { wc_impl = filterBag keep_me implics } + -- Do not prune holes; these should be reported + where + keep_me :: Implication -> Bool + keep_me (Implic { ic_status = status, ic_wanted = wanted }) + | IC_Solved { ics_dead = dead_givens } <- status -- Fully solved + , null dead_givens -- No redundant givens to report + , isEmptyBag (wc_impl wanted) -- No children that might have things to report + = False + | otherwise + = True -- Otherwise, keep it + +findRedundantGivens :: Implication -> [EvVar] +findRedundantGivens (Implic { ic_info = info, ic_need = need, ic_given = givens }) + | not (warnRedundantGivens info) -- Don't report redundant constraints at all + = [] -- See (TRC4) of Note [Tracking redundant constraints] + + | not (null unused_givens) -- Some givens are literally unused + = unused_givens + + -- Only try this if unused_givens is empty: see (TRC2a) + | otherwise -- All givens are used, but some might + = redundant_givens -- still be redundant e.g. (Eq a, Ord a) + + where + in_instance_decl = case info of { InstSkol {} -> True; _ -> False } + -- See Note [Redundant constraints in instance decls] + + unused_givens = filterOut is_used givens + + needed_givens_ignoring_default_methods = ens_fvs need + is_used given = is_type_error given + || given `elemVarSet` needed_givens_ignoring_default_methods + || (in_instance_decl && is_improving (idType given)) + + minimal_givens = mkMinimalBySCs evVarPred givens -- See (TRC2) + + is_minimal = (`elemVarSet` mkVarSet minimal_givens) + redundant_givens + | in_instance_decl = [] + | otherwise = filterOut is_minimal givens + + -- See #15232 + is_type_error id = isTopLevelUserTypeError (idType id) + + is_improving pred -- (transSuperClasses p) does not include p + = any isImprovementPred (pred : transSuperClasses pred) + +warnRedundantGivens :: SkolemInfoAnon -> Bool +warnRedundantGivens (SigSkol ctxt _ _) + = case ctxt of + FunSigCtxt _ rrc -> reportRedundantConstraints rrc + ExprSigCtxt rrc -> reportRedundantConstraints rrc + _ -> False + +warnRedundantGivens (InstSkol from _) + -- Do not report redundant constraints for quantified constraints + -- See (TRC4) in Note [Tracking redundant constraints] + -- Fortunately it is easy to spot implications constraints that arise + -- from quantified constraints, from their SkolInfo + = case from of + IsQC {} -> False + IsClsInst {} -> True + + -- To think about: do we want to report redundant givens for + -- pattern synonyms, PatSynSigSkol? c.f #9953, comment:21. +warnRedundantGivens _ = False + +{- Note [Redundant constraints in instance decls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Instance declarations are special in two ways: + +* We don't report unused givens if they can give rise to improvement. + Example (#10100): + class Add a b ab | a b -> ab, a ab -> b + instance Add Zero b b + instance Add a b ab => Add (Succ a) b (Succ ab) + The context (Add a b ab) for the instance is clearly unused in terms + of evidence, since the dictionary has no fields. But it is still + needed! With the context, a wanted constraint + Add (Succ Zero) beta (Succ Zero) + we will reduce to (Add Zero beta Zero), and thence we get beta := Zero. + But without the context we won't find beta := Zero. + + This only matters in instance declarations. + +* We don't report givens that are a superclass of another given. E.g. + class Ord r => UserOfRegs r a where ... + instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where + The (Ord r) is not redundant, even though it is a superclass of + (UserOfRegs r CmmReg). See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance. + + Again this is specific to instance declarations. +-} + + +checkBadTelescope :: Implication -> TcS Bool +-- True <=> the skolems form a bad telescope +-- See Note [Checking telescopes] in GHC.Tc.Types.Constraint +checkBadTelescope (Implic { ic_info = info + , ic_skols = skols }) + | checkTelescopeSkol info + = do{ skols <- mapM TcS.zonkTyCoVarKind skols + ; return (go emptyVarSet (reverse skols))} + + | otherwise + = return False + + where + go :: TyVarSet -- skolems that appear *later* than the current ones + -> [TcTyVar] -- ordered skolems, in reverse order + -> Bool -- True <=> there is an out-of-order skolem + go _ [] = False + go later_skols (one_skol : earlier_skols) + | tyCoVarsOfType (tyVarKind one_skol) `intersectsVarSet` later_skols + = True + | otherwise + = go (later_skols `extendVarSet` one_skol) earlier_skols + +neededEvVars :: Implication -> TcS Implication +-- Find all the evidence variables that are "needed", +-- /and/ delete dead evidence bindings +-- +-- See Note [Tracking redundant constraints] +-- See Note [Delete dead Given evidence bindings] +-- +-- - Start from initial_seeds (from nested implications) +-- +-- - Add free vars of RHS of all Wanted evidence bindings +-- and coercion variables accumulated in tcvs (all Wanted) +-- +-- - Generate 'needed', the needed set of EvVars, by doing transitive +-- closure through Given bindings +-- e.g. Needed {a,b} +-- Given a = sc_sel a2 +-- Then a2 is needed too +-- +-- - Prune out all Given bindings that are not needed + +neededEvVars implic@(Implic { ic_info = info + , ic_binds = ev_binds_var + , ic_wanted = WC { wc_impl = implics } + , ic_need_implic = old_need_implic -- See (TRC1) + }) + = do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var + ; used_cos <- TcS.getTcEvTyCoVars ev_binds_var + + ; let -- Find the variables needed by `implics` + new_need_implic@(ENS { ens_dms = dm_seeds, ens_fvs = other_seeds }) + = foldr add_implic old_need_implic implics + -- Start from old_need_implic! See (TRC1) + + -- Get the variables needed by the solved bindings + -- (It's OK to use a non-deterministic fold here + -- because add_wanted is commutative.) + used_covars = coVarsOfCos used_cos + seeds_w = nonDetStrictFoldEvBindMap add_wanted used_covars ev_binds + + need_ignoring_dms = findNeededGivenEvVars ev_binds (other_seeds `unionVarSet` seeds_w) + need_from_dms = findNeededGivenEvVars ev_binds dm_seeds + need_full = need_ignoring_dms `unionVarSet` need_from_dms + + -- `need`: the Givens from outer scopes that are used in this implication + -- is_dm_skol: see (TRC5) + need | is_dm_skol info = ENS { ens_dms = trim ev_binds need_full + , ens_fvs = emptyVarSet } + | otherwise = ENS { ens_dms = trim ev_binds need_from_dms + , ens_fvs = trim ev_binds need_ignoring_dms } + + -- Delete dead Given evidence bindings + -- See Note [Delete dead Given evidence bindings] + ; let live_ev_binds = filterEvBindMap (needed_ev_bind need_full) ev_binds + ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds + + ; traceTcS "neededEvVars" $ + vcat [ text "old_need_implic:" <+> ppr old_need_implic + , text "new_need_implic:" <+> ppr new_need_implic + , text "used_covars:" <+> ppr used_covars + , text "need_ignoring_dms:" <+> ppr need_ignoring_dms + , text "need_from_dms:" <+> ppr need_from_dms + , text "need:" <+> ppr need + , text "ev_binds:" <+> ppr ev_binds + , text "live_ev_binds:" <+> ppr live_ev_binds ] + ; return (implic { ic_need = need + , ic_need_implic = new_need_implic }) } + where + trim :: EvBindMap -> VarSet -> VarSet + -- Delete variables bound by Givens or bindings + trim ev_binds needs = needs `varSetMinusEvBindMap` ev_binds + + add_implic :: Implication -> EvNeedSet -> EvNeedSet + add_implic (Implic { ic_given = givens, ic_need = need }) acc + = (need `delGivensFromEvNeedSet` givens) `unionEvNeedSet` acc + + needed_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info }) + | EvBindGiven{} <- info = ev_var `elemVarSet` needed + | otherwise = True -- Keep all wanted bindings + + add_wanted :: EvBind -> VarSet -> VarSet + add_wanted (EvBind { eb_info = info, eb_rhs = rhs }) needs + | EvBindGiven{} <- info = needs -- Add the rhs vars of the Wanted bindings only + | otherwise = nestedEvIdsOfTerm rhs `unionVarSet` needs + + is_dm_skol :: SkolemInfoAnon -> Bool + is_dm_skol (MethSkol _ is_dm) = is_dm + is_dm_skol _ = False + +findNeededGivenEvVars :: EvBindMap -> VarSet -> VarSet +-- Find all the Given evidence needed by seeds, +-- looking transitively through bindings for Givens (only) +findNeededGivenEvVars ev_binds seeds + = transCloVarSet also_needs seeds + where + also_needs :: VarSet -> VarSet + also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs + -- It's OK to use a non-deterministic fold here because we immediately + -- forget about the ordering by creating a set + + add :: Var -> VarSet -> VarSet + add v needs + | Just ev_bind <- lookupEvBind ev_binds v + , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind + -- Look at Given bindings only + = nestedEvIdsOfTerm rhs `unionVarSet` needs + | otherwise + = needs + +------------------------------------------------- +simplifyDelayedErrors :: Bag DelayedError -> TcS (Bag DelayedError) +-- Simplify any delayed errors: e.g. type and term holes +-- NB: At this point we have finished with all the simple +-- constraints; they are in wc_simple, not in the inert set. +-- So those Wanteds will not rewrite these delayed errors. +-- That's probably no bad thing. +-- +-- However if we have [W] alpha ~ Maybe a, [W] alpha ~ Int +-- and _ : alpha, then we'll /unify/ alpha with the first of +-- the Wanteds we get, and thereby report (_ : Maybe a) or +-- (_ : Int) unpredictably, depending on which we happen to see +-- first. Doesn't matter much; there is a type error anyhow. +-- T17139 is a case in point. +simplifyDelayedErrors = mapMaybeBagM simpl_err + where + simpl_err :: DelayedError -> TcS (Maybe DelayedError) + simpl_err (DE_Hole hole) = Just . DE_Hole <$> simpl_hole hole + simpl_err err@(DE_NotConcrete {}) = return $ Just err + simpl_err (DE_Multiplicity mult_co loc) + = do { mult_co' <- TcS.zonkCo mult_co + ; if isReflexiveCo mult_co' then + return Nothing + else + return $ Just (DE_Multiplicity mult_co' loc) } + + simpl_hole :: Hole -> TcS Hole + + -- See Note [Do not simplify ConstraintHoles] + simpl_hole h@(Hole { hole_sort = ConstraintHole }) = return h + + -- other wildcards should be simplified for printing + -- we must do so here, and not in the error-message generation + -- code, because we have all the givens already set up + simpl_hole h@(Hole { hole_ty = ty, hole_loc = loc }) + = do { ty' <- rewriteType loc ty + ; traceTcS "simpl_hole" (ppr ty $$ ppr ty') + ; return (h { hole_ty = ty' }) } + +{- Note [Delete dead Given evidence bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +As a result of superclass expansion, we speculatively +generate evidence bindings for Givens. E.g. + f :: (a ~ b) => a -> b -> Bool + f x y = ... +We'll have + [G] d1 :: (a~b) +and we'll speculatively generate the evidence binding + [G] d2 :: (a ~# b) = sc_sel d + +Now d2 is available for solving. But it may not be needed! Usually +such dead superclass selections will eventually be dropped as dead +code, but: + + * It won't always be dropped (#13032). In the case of an + unlifted-equality superclass like d2 above, we generate + case heq_sc d1 of d2 -> ... + and we can't (in general) drop that case expression in case + d1 is bottom. So it's technically unsound to have added it + in the first place. + + * Simply generating all those extra superclasses can generate lots of + code that has to be zonked, only to be discarded later. Better not + to generate it in the first place. + + Moreover, if we simplify this implication more than once + (e.g. because we can't solve it completely on the first iteration + of simpl_loop), we'll generate all the same bindings AGAIN! + +Easy solution: take advantage of the work we are doing to track dead +(unused) Givens, and use it to prune the Given bindings too. This is +all done by neededEvVars. + +This led to a remarkable 25% overall compiler allocation decrease in +test T12227. + +But we don't get to discard all redundant equality superclasses, alas; +see #15205. + +Note [Do not simplify ConstraintHoles] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Before printing the inferred value for a type hole (a _ wildcard in +a partial type signature), we simplify it w.r.t. any Givens. This +makes for an easier-to-understand diagnostic for the user. + +However, we do not wish to do this for extra-constraint holes. Here is +the example for why (partial-sigs/should_compile/T12844): + + bar :: _ => FooData rngs + bar = foo + + data FooData rngs + + class Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs + + type family Head (xs :: [k]) where Head (x ': xs) = x + +GHC correctly infers that the extra-constraints wildcard on `bar` +should be (Head rngs ~ '(r, r'), Foo rngs). It then adds this +constraint as a Given on the implication constraint for `bar`. (This +implication is emitted by emitResidualConstraints.) The Hole for the _ +is stored within the implication's WantedConstraints. When +simplifyHoles is called, that constraint is already assumed as a +Given. Simplifying with respect to it turns it into ('(r, r') ~ '(r, +r'), Foo rngs), which is disastrous. + +Furthermore, there is no need to simplify here: extra-constraints wildcards +are filled in with the output of the solver, in chooseInferredQuantifiers +(choose_psig_context), so they are already simplified. (Contrast to normal +type holes, which are just bound to a meta-variable.) Avoiding the poor output +is simple: just don't simplify extra-constraints wildcards. + +This is the only reason we need to track ConstraintHole separately +from TypeHole in HoleSort. + +See also Note [Extra-constraint holes in partial type signatures] +in GHC.Tc.Gen.HsType. + +Note [Tracking redundant constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +With Opt_WarnRedundantConstraints, GHC can report which constraints of a type +signature (or instance declaration) are redundant, and can be omitted. Here is +an overview of how it works. + +This is all tested in typecheck/should_compile/T20602 (among others). + +How tracking works: + +* We maintain the `ic_need` field in an implication: + ic_need: the set of Given evidence variables that are needed somewhere + inside this implication; and are bound either by this implication + or by an enclosing one. + +* `setImplicationStatus` does all the work: + - When the constraint solver finishes solving all the wanteds in + an implication, it sets its status to IC_Solved + + - `neededEvVars`: computes which evidence variables are needed by an + implication in `setImplicationStatus`. A variable is needed if + + a) It is in the ic_need field of this implication, computed in + a previous call to `setImplicationStatus`; see (TRC1) + + b) It is in the ics_need of a nested implication; see `add_implic` + in `neededEvVars` + + c) It is free in the RHS of any /Wanted/ EvBind; each such binding + solves a Wanted, so we want them all. See `add_wanted` in + `neededEvVars` + + d) It is free in the RHS of a /Given/ EvBind whose LHS is needed: + see `findNeededGivenEvVars` called from `neededEvVars`. + + - Next, if the final status is IC_Solved, `setImplicationStatus` uses + `findRedundantGivens` to decide which of this implication's Givens + are redundant. + + - It also uses `pruneImplications` to discard any now-unnecessary child + implications. + +* GHC.Tc.Errors does the actual warning, in `warnRedundantConstraints`. + + +Wrinkles: + +(TRC1) `pruneImplications` drops any sub-implications of an Implication + that are irrelevant for error reporting: + - no unsolved wanteds + - no sub-implications + - no redundant givens to report + But in doing so we must not lose track of the variables that those implications + needed! So we track the ic_needs of all child implications in `ic_need_implics`. + Crucially, this set includes things need by child implications that have been + discarded by `pruneImplications`. + +(TRC2) A Given can be redundant because it is implied by other Givens + f :: (Eq a, Ord a) => blah -- Eq a unnecessary + g :: (Eq a, a~b, Eq b) => blah -- Either Eq a or Eq b unnecessary + We nail this by using `mkMinimalBySCs` in `findRedundantGivens`. + (TRC2a) But NOTE that we only attempt this mkMinimalBySCs stuff if all Givens + used by evidence bindings. Example: + f :: (Eq a, Ord a) => a -> Bool + f x = x == x + We report (Ord a) as unused because it is. But we must not also report (Eq a) + as unused because it is a superclass of Ord! + +(TRC3) When two Givens are the same, prefer one that does not involve superclass + selection, or more generally has shallower superclass-selection depth: + see 2(b,c) in Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. + e.g f :: (Eq a, Ord a) => a -> Bool + f x = x == x + Eager superclass expansion gives us two [G] Eq a constraints. We want to keep + the one from the user-written Eq a, not the superclass selection. This means + we report the Ord a as redundant with -Wredundant-constraints, not the Eq a. + Getting this wrong was #20602. + +(TRC4) We don't compute redundant givens for *every* implication; only + for those which reply True to `warnRedundantGivens`: + + - For example, in a class declaration, the default method *can* + use the class constraint, but it certainly doesn't *have* to, + and we don't want to report an error there. Ditto instance decls. + + - More subtly, in a function definition + f :: (Ord a, Ord a, Ix a) => a -> a + f x = rhs + we do an ambiguity check on the type (which would find that one + of the Ord a constraints was redundant), and then we check that + the definition has that type (which might find that both are + redundant). We don't want to report the same error twice, so we + disable it for the ambiguity check. Hence using two different + FunSigCtxts, one with the warn-redundant field set True, and the + other set False in + - GHC.Tc.Gen.Bind.tcSpecPrag + - GHC.Tc.Gen.Bind.tcTySig + + - We do not want to report redundant constraints for implications + that come from quantified constraints. Example #23323: + data T a + instance Show (T a) where ... -- No context! + foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int + bar = foo @T @Eq + + The call to `foo` gives us + [W] d : (forall a. Eq a => Show (T a)) + To solve this, GHC.Tc.Solver.Solve.solveForAll makes an implication constraint: + forall a. Eq a => [W] ds : Show (T a) + and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a` + constraint. But we don't want to report it as redundant! + +(TRC5) Consider this (#25992), where `op2` has a default method + class C a where { op1, op2 :: a -> a + ; op2 = op1 . op1 } + instance C a => C [a] where + op1 x = x + + Plainly the (C a) constraint is unused; but the expanded decl will look like + $dmop2 :: C a => a -> a + $dmop2 = op1 . op1 + + $fCList :: forall a. C a => C [a] + $fCList @a (d::C a) = MkC (\(x:a).x) ($dmop2 @a d) + + Notice that `d` gets passed to `$dmop`: it is "needed". But it's only + /really/ needed if some /other/ method (in this case `op1`) uses it. + + So, rather than one set of "needed Givens" we use `EvNeedSet` to track + a /pair/ of sets: + ens_dms: needed /only/ by default-method calls + ens_fvs: needed by something other than a default-method call + It's a bit of a palaver, but not really difficult. + All the logic is localised in `neededEvVars`. + + But NOTE that this only applies to /vanilla/ default methods. + For /generic/ default methods, like + class D a where { op1 :: blah + ; default op1 :: Eq a => blah2 } + the (Eq a) constraint really is needed (e.g. class NFData and #25992). + Hence the `Bool` field of `MethSkol` indicates a /vanilla/ default method. + +----- Examples + + f, g, h :: (Eq a, Ord a) => a -> Bool + f x = x == x + g x = x > x + h x = x == x && x > x + + All of f,g,h will discover that they have two [G] Eq a constraints: one as + given and one extracted from the Ord a constraint. They will both discard + the latter; see (TRC3). + + The body of f uses the [G] Eq a, but not the [G] Ord a. It will report a + redundant Ord a. + + The body of g uses the [G] Ord a, but not the [G] Eq a. It will report a + redundant Eq a. + + The body of h uses both [G] Ord a and [G] Eq a; each is used in a solved + Wanted evidence binding. But (TRC2) kicks in and discovers the Eq a + is redundant. + +----- Shortcomings + +Shortcoming 1. Consider + + j :: (Eq a, a ~ b) => a -> Bool + j x = x == x + + k :: (Eq a, b ~ a) => a -> Bool + k x = x == x + +Currently (Nov 2021), j issues no warning, while k says that b ~ a +is redundant. This is because j uses the a ~ b constraint to rewrite +everything to be in terms of b, while k does none of that. This is +ridiculous, but I (Richard E) don't see a good fix. + +Shortcoming 2. Removing a redundant constraint can cause clients to fail to +compile, by making the function more polymorphic. Consider (#16154) + + f :: (a ~ Bool) => a -> Int + f x = 3 + + g :: String -> Int + g s = f (read s) + +The constraint in f's signature is redundant; not used to typecheck +`f`. And yet if you remove it, `g` won't compile, because there'll +be an ambiguous variable in `g`. + + +********************************************************************** +* * +* Main Solver * +* * +********************************************************************** + +Note [Basic Simplifier Plan] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +1. Pick an element from the WorkList if there exists one with depth + less than our context-stack depth. + +2. Run it down the 'stage' pipeline. Stages are: + - canonicalization + - inert reactions + - spontaneous reactions + - top-level interactions + Each stage returns a StopOrContinue and may have sideeffected + the inerts or worklist. + + The threading of the stages is as follows: + - If (Stop) is returned by a stage then we start again from Step 1. + - If (ContinueWith ct) is returned by a stage, we feed 'ct' on to + the next stage in the pipeline. +4. If the element has survived (i.e. ContinueWith x) the last stage + then we add it in the inerts and jump back to Step 1. + +If in Step 1 no such element exists, we have exceeded our context-stack +depth and will simply fail. +-} + +solveSimpleGivens :: [Ct] -> TcS () +solveSimpleGivens givens + | null givens -- Shortcut for common case + = return () + | otherwise + = do { traceTcS "solveSimpleGivens {" (ppr givens) + ; go givens + + -- Capture the Givens in the inert_givens of the inert set + -- for use by subsequent calls of nestImplicTcS + -- See Note [trySolveImplication] + ; updInertSet (\is -> is { inert_givens = inert_cans is }) + + ; cans <- getInertCans + ; traceTcS "End solveSimpleGivens }" (ppr cans) } + where + go givens = do { solveSimples (listToBag givens) + ; new_givens <- runTcPluginsGiven + ; when (notNull new_givens) $ + go new_givens } + +solveSimpleWanteds :: Cts -> TcS WantedConstraints +-- Returns unsolved constraints, mostly just flat ones (Cts), +-- but also any unsolved implications arising from forall-constraints +-- The result is not necessarily zonked +solveSimpleWanteds simples + = do { mode <- getTcSMode + ; dflags <- getDynFlags + ; inerts <- getInertSet + + ; traceTcS "solveSimpleWanteds {" $ + vcat [ text "Mode:" <+> ppr mode + , text "Inerts:" <+> ppr inerts + , text "Wanteds to solve:" <+> ppr simples ] + + ; (n,simples',implics') <- go (solverIterations dflags) 1 emptyBag simples + + ; let unsolved_wc = emptyWC { wc_simple = simples', wc_impl = implics' } + + ; traceTcS "solveSimpleWanteds end }" $ + vcat [ text "iterations =" <+> ppr n + , text "residual =" <+> ppr unsolved_wc ] + + ; return unsolved_wc } + where + go :: IntWithInf -- Limit + -> Int -- Iteration number + -> Bag Implication -- Accumulating parameter: unsolved implications + -> Cts -- Try to solve these + -> TcS (Int, Cts, Bag Implication) + -- See Note [The solveSimpleWanteds loop] + go limit n implics wanted + | n `intGtLimit` limit + = failTcS $ TcRnSimplifierTooManyIterations + simples limit + (emptyWC { wc_simple = wanted, wc_impl = implics }) + + | isEmptyBag wanted + = return (n, wanted, implics) + + | otherwise + = do { -- Solve + (wanted1, implics1) <- solve_one wanted + ; let implics2 = implics `unionBags` implics1 + + -- Run plugins + -- NB: runTcPluginsWanted has a fast path for + -- empty wanted1, which is the common case + ; (rerun_plugin, wanted2) <- runTcPluginsWanted wanted1 + + ; if rerun_plugin + then do { traceTcS "solveSimple going round again:" (ppr rerun_plugin) + ; go limit (n+1) implics2 wanted2 } -- Loop + else return (n, wanted2, implics2) } -- Done + + + solve_one :: Cts -> TcS (Cts, Bag Implication) + -- Try solving these constraints + -- Affects the unification state (of course) but not the inert set + -- The result is not necessarily zonked + solve_one simples + = nestTcS $ + do { solveSimples simples + ; simples' <- getUnsolvedInerts + -- Now try to solve any Wanted quantified + -- constraints (i.e. QCInsts) in `simples1` + ; solveWantedQCIs simples' } + + +{- Note [The solveSimpleWanteds loop] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Solving a bunch of simple constraints is done in a loop, +(the 'go' loop of 'solveSimpleWanteds'): + 1. Try to solve them + 2. Try the plugin + 3. If the plugin wants to run again, go back to step 1 +-} + +{- +************************************************************************ +* * + Solving flat constraints: solveSimples +* * +********************************************************************* -} + +-- The main solver loop implements Note [Basic Simplifier Plan] +--------------------------------------------------------------- + +solveSimples :: Cts -> TcS () +-- Solve this bag of constraints, +-- returning the final InertSet in TcS +-- The constraints are initially examined in left-to-right order + +solveSimples cts + = {-# SCC "solveSimples" #-} + do { emitWork cts; solve_loop } + where + solve_loop + = {-# SCC "solve_loop" #-} + do { sel <- selectNextWorkItem + ; case sel of + Nothing -> return () + Just ct -> do { solveOne ct + ; solve_loop } } + +solveOne :: Ct -> TcS () -- Solve one constraint +solveOne workItem + = do { wl <- getWorkList + ; inerts <- getInertSet + ; tclevel <- TcS.getTcLevel + ; traceTcS "----------------------------- " empty + ; traceTcS "Start solver pipeline {" $ + vcat [ text "tclevel =" <+> ppr tclevel + , text "work item =" <+> ppr workItem + , text "inerts =" <+> ppr inerts + , text "rest of worklist =" <+> ppr wl ] + + ; bumpStepCountTcS -- One step for each constraint processed + ; solve workItem } + where + solve :: Ct -> TcS () + solve ct + = do { traceTcS "solve {" (text "workitem = " <+> ppr ct) + ; res <- runSolverStage (solveCt ct) + ; traceTcS "end solve }" (ppr res) + ; case res of + StartAgain ct -> do { traceTcS "Go round again" (ppr ct) + ; solve ct } + + Stop ev s -> do { traceFireTcS ev s + ; traceTcS "End solver pipeline }" empty + ; return () } + + -- ContinueWith can't happen: res :: SolverStage Void + -- solveCt either solves the constraint, or puts + -- the unsolved constraint in the inert set. + } + +{- ********************************************************************* +* * +* Solving one constraint: solveCt +* * +************************************************************************ + +Note [Canonicalization] +~~~~~~~~~~~~~~~~~~~~~~~ +Canonicalization converts a simple constraint to a canonical form. It is +unary (i.e. treats individual constraints one at a time). + +Constraints originating from user-written code come into being as +CNonCanonicals. We know nothing about these constraints. So, first: + + Classify CNonCanoncal constraints, depending on whether they + are equalities, class predicates, or other. + +Then proceed depending on the shape of the constraint. Generally speaking, +each constraint gets rewritten and then decomposed into one of several forms +(see type Ct in GHC.Tc.Types). + +When an already-canonicalized constraint gets kicked out of the inert set, +it must be recanonicalized. But we know a bit about its shape from the +last time through, so we can skip the classification step. +-} + +solveCt :: Ct -> SolverStage Void +-- The Void result tells us that solveCt cannot return +-- a ContinueWith; it must return Stop or StartAgain. +solveCt (CNonCanonical ev) = solveNC ev +solveCt (CIrredCan (IrredCt { ir_ev = ev })) = solveNC ev + +solveCt (CEqCan (EqCt { eq_ev = ev, eq_eq_rel = eq_rel + , eq_lhs = lhs, eq_rhs = rhs })) + = solveEquality ev eq_rel (canEqLHSType lhs) rhs + +solveCt (CQuantCan qci@(QCI { qci_ev = ev })) + = do { ev' <- rewriteEvidence ev + -- It is (much) easier to rewrite and re-classify than to + -- rewrite the pieces and build a Reduction that will rewrite + -- the whole constraint + ; case classifyPredType (ctEvPred ev') of + ForAllPred tvs theta body_pred + -> solveForAll (qci { qci_ev = ev', qci_tvs = tvs + , qci_theta = theta, qci_body = body_pred }) + _ -> pprPanic "SolveCt" (ppr ev) } + +solveCt (CDictCan (DictCt { di_ev = ev, di_pend_sc = pend_sc })) + = do { ev <- rewriteEvidence ev + -- It is easier to rewrite and re-classify than to rewrite + -- the pieces and build a Reduction that will rewrite the + -- whole constraint + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys + -> solveDict (DictCt { di_ev = ev, di_cls = cls + , di_tys = tys, di_pend_sc = pend_sc }) + _ -> pprPanic "solveCt" (ppr ev) } + +------------------ +solveNC :: CtEvidence -> SolverStage Void +solveNC ev + = -- Instead of rewriting the evidence before classifying, it's possible we + -- can make progress without the rewrite. Try this first. + -- For insolubles (all of which are equalities), do /not/ rewrite the arguments + -- In #14350 doing so led entire-unnecessary and ridiculously large + -- type function expansion. Instead, canEqNC just applies + -- the substitution to the predicate, and may do decomposition; + -- e.g. a ~ [a], where [G] a ~ [Int], can decompose + case classifyPredType (ctEvPred ev) of { + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 ; + _ -> + + -- Do rewriting on the constraint, especially zonking + do { ev <- rewriteEvidence ev + + -- And then re-classify + ; case classifyPredType (ctEvPred ev) of + ClassPred cls tys -> solveDictNC ev cls tys + ForAllPred tvs th p -> solveForAllNC ev tvs th p + IrredPred {} -> solveIrred (IrredCt { ir_ev = ev, ir_reason = IrredShapeReason }) + EqPred eq_rel ty1 ty2 -> solveEquality ev eq_rel ty1 ty2 + -- EqPred only happens if (say) `c` is unified with `a ~# b`, + -- but that is rare because it requires c :: CONSTRAINT UnliftedRep + + }} + + +{- ********************************************************************* +* * +* Quantified constraints +* * +********************************************************************* -} + +{- Note [Quantified constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The -XQuantifiedConstraints extension allows type-class contexts like this: + + data Rose f x = Rose x (f (Rose f x)) + + instance (Eq a, forall b. Eq b => Eq (f b)) + => Eq (Rose f a) where + (Rose x1 rs1) == (Rose x2 rs2) = x1==x2 && rs1 == rs2 + +Note the (forall b. Eq b => Eq (f b)) in the instance contexts. +This quantified constraint is needed to solve the + [W] (Eq (f (Rose f x))) +constraint which arises form the (==) definition. + +The wiki page is + https://gitlab.haskell.org/ghc/ghc/wikis/quantified-constraints +which in turn contains a link to the GHC Proposal where the change +is specified, and a Haskell Symposium paper about it. + +We implement two main extensions to the design in the paper: + + 1. We allow a variable in the instance head, e.g. + f :: forall m a. (forall b. m b) => D (m a) + Notice the 'm' in the head of the quantified constraint, not + a class. + + 2. We support superclasses to quantified constraints. + For example (contrived): + f :: (Ord b, forall b. Ord b => Ord (m b)) => m a -> m a -> Bool + f x y = x==y + Here we need (Eq (m a)); but the quantified constraint deals only + with Ord. But we can make it work by using its superclass. + +Here are the moving parts + * Language extension {-# LANGUAGE QuantifiedConstraints #-} + and add it to ghc-boot-th:GHC.LanguageExtensions.Type.Extension + + * A new form of evidence, EvDFun, that is used to discharge + such wanted constraints + + * checkValidType gets some changes to accept forall-constraints + only in the right places. + + * Predicate.Pred gets a new constructor ForAllPred, and + and `classifyPredType` analyses a `PredType` to decompose + the new forall-constraints + + * GHC.Tc.Solver.Monad.InertCans gets an extra field, `inert_qcis`, + which holds all the Given forall-constraints. In effect, + such Given constraints are like local instance decls. + + * `inert_qcis` also temporarily holds Wanted quantified constraints + (see Note [Solving a Wanted forall-constraint]) + + * When trying to solve a class constraint, GHC.Tc.Solver.Dict.matchLocalInst + (note "local" inst) uses the Given `inert_qcis` to solve the constraint. + + * `solveForAll` deals with solving a forall-constraint. See + * Note [Solving a Given forall-constraint] + * Note [Solving a Wanted forall-constraint] + +Note that a quantified constraint is never /inferred/ +(by GHC.Tc.Solver.simplifyInfer). A function can only have a +quantified constraint in its type if it is given an explicit +type signature. + +Note [Solving a Given forall-constraint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For a Given constraint + [G] df :: forall ab. (Eq a, Ord b) => C x a b +we just add it to TcS's local InstEnv of known instances, `inert_qcis`, +via addInertQCI. Then, if we look up (C x Int Bool), say, +we'll find a match in the `inert_qcis`. + +Note [Solving a Wanted forall-constraint] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Solving a wanted forall (quantified) constraint + [W] df :: forall a b. (Eq a, Ord b) => C x a b +is delightfully easy in principle. Just build an implication constraint + forall ab. (g1::Eq a, g2::Ord b) => [W] d :: C x a +and discharge df thus: + df = /\ab. \g1 g2. let in d +where is filled in by solving the implication constraint. + +What we actually do is this: + +* In `solveForAll` we see if we have an identical quantified constraint + to solve it (using tryInertQCs). In particular, solve a Wanted QCI + from an identical Given. This is more than a simple optimisation: + see Note [Solving Wanted QCs from Given QCs] + + If not, just stash it in `inert_qcis :: [QCInst]`. (If it's a Given + we can use it to solve other constraints; if a Wanted we will solve + it later using `solveWantedQCIs`.) + +* In the main `solveSimpleWanteds` (specifically `solve_one`): + + - We attempt to solve the `wc_simple` constraints with `solveSimples` + Unsolved quantified constraints just accumulate in the `inert_qcis` field + of the `InertSet`. + + - Then we use `solveWantedQCIs` to solve any quantified constraints. That + often turns the `QCInst` into an `Implication`; but not invariably (WFA4) + +Wrinkles: + +(WFA2) Termination: see #19690. We want to maintain the invariant (QC-INV): + + (QC-INV) Every quantified constraint returns a non-bottom dictionary + + just as every top-level instance declaration guarantees to return a non-bottom + dictionary. But as #19690 shows, it is possible to get a bottom dictionary + by superclass selection if we aren't careful. The situation is very similar + to that described in Note [Recursive superclasses] in GHC.Tc.TyCl.Instance; + and we use the same solution: + + * Give the Givens a CtOrigin of (GivenOrigin (InstSkol IsQC head_size)) + * Give the Wanted a CtOrigin of (ScOrigin IsQC NakedSc) + + Both of these things are done in `solveWantedQCI`. Now the mechanism described + in Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance takes over. + +(WFA3) Error messages. Suppose we are trying to solve the quantified constraint + forall a. Eq a => Eq (c a) + We don't just want to say "No instance for Eq (c a)". It /really/ helps to + say what quantified constraint we were trying to solve. + + So the `IsQC` origin carries that info, and `GHC.Tc.Errors.Ppr.pprQCOriginExtra` + prints the extra info. + +(WFA4) When `tcsmFullySolveQCIs` is on, we adopt an all-or-nothing strategy: + either solve the forall-constraint /fully/ or do nothing at all. + Why? See (NFS1) in Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig + +(WFA5) Why not /always/ us the all-or-nothing strategy, so we don't need a + flag? Several reasons: + + * Less efficient; `tcsmFullySolveQCIs` abandons the work done on the constraint, + so we might do it again next time around. + + * More importantly, we would get worse results from `deriving`: #26315. + In that code the `deriving` mechanism was trying to solve + [W] df :: forall n. Eq (Const i n) + If we turn it into an implication, we can simplfy that `Const` to get + the residual implication + forall n. [W] d :: Eq i + And then `approximateWC` can extract the (Eq i) as a plausible context for + the instance. + + * Very much the same issue came up for the inferred type of a function that + lacks a type signature #26376. Again, if the forall-constraint is not + turned into an implication `approximateWC` gives a less-good answer. + +Note [Solving Wanted QCs from Given QCs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we are about to solve a Wanted quantified constraint, and there is a +Given quantified constraint with the same type, we should directly solve the +Wanted from the Given (instead of building an implication). + +Not only is this more direct and efficient, sometimes it is also /necessary/. +Consider: + + f :: forall a k. (Eq a, forall x. Eq x => Eq k x) => a -> blah + {-# SPECIALISE (f :: forall k. (forall x. Eq x => Eq k x) => Int -> blah #-} + +Here we specialise the `a` parameter to `f`, leaving the quantified constraint +untouched. We want to get a rule like: + + RULE forall @k (d :: forall x. Eq x => Eq k x). + f @Int @k d = $sf @k d + +But when we typecheck that expression-with-a-type-signature, if we don't solve +Wanted forall constraints directly, we will do so indirectly and end up with +this as the LHS of the RULE: + + (/\k \(df::forall x.Eq x => Eq k x). f @Int @k (/\x \(d:Eq x). df @x d)) + @kk dd + +We run the simple optimiser on that, which eliminates the beta-redex. However, +it may not eta-reduce that `/\x \(d:Eq x)...`, because we are cautious about +eta-reduction. So we may be left with an over-complicated and hard-to-match +RULE LHS. It's all a bit silly, because the implication constraint is /identical/; +we just need to spot it. + +This came up while implementing GHC proposal 493 (allowing expresions in +SPECIALISE pragmas). +-} + +-- | Solve a quantified constraint that came from @CNonCanonical@ (which means +-- that superclasses have not yet been expanded). +-- +-- Precondition: the constraint has already been rewritten by the inert set. +solveForAllNC :: CtEvidence -> [TcTyVar] -> TcThetaType -> TcPredType + -> SolverStage Void +solveForAllNC ev tvs theta body_pred + = do { fuel <- simpleStage mk_super_classes + ; solveForAll (QCI { qci_ev = ev, qci_tvs = tvs, qci_theta = theta + , qci_body = body_pred, qci_pend_sc = fuel }) } + + where + mk_super_classes :: TcS ExpansionFuel + mk_super_classes + | Just (cls,tys) <- getClassPredTys_maybe body_pred + , classHasSCs cls + = do { dflags <- getDynFlags + -- Either expand superclasses (Givens) or provide fuel to do so (Wanteds) + ; if isGiven ev + then + -- See Note [Eagerly expand given superclasses] + -- givensFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + do { sc_cts <- mkStrictSuperClasses (givensFuel dflags) ev tvs theta cls tys + ; emitWork (listToBag sc_cts) + ; return doNotExpand } + else + -- See invariants (a) and (b) in QCI.qci_pend_sc + -- qcsFuel dflags: See Note [Expanding Recursive Superclasses and ExpansionFuel] + -- See Note [Quantified constraints] + return (qcsFuel dflags) + } + + | otherwise + = return doNotExpand + +-- | Solve a canonical quantified constraint. +-- +-- Precondition: the constraint has already been rewritten by the inert set. +solveForAll :: QCInst -> SolverStage Void +solveForAll qci@(QCI { qci_ev = ev }) + = case ev of + CtGiven {} -> + -- See Note [Solving a Given forall-constraint] + do { simpleStage (addInertQCI qci) + ; stopWithStage ev "Given forall-constraint" } + CtWanted {} -> + -- See Note [Solving a Wanted forall-constraint] + do { tryInertQCs qci + ; simpleStage (addInertQCI qci) + ; stopWithStage ev "Wanted forall-constraint" } + +tryInertQCs :: QCInst -> SolverStage () +tryInertQCs qc + = Stage $ + do { inerts <- getInertCans + ; try_inert_qcs qc (inert_qcis inerts) } + +try_inert_qcs :: QCInst -> [QCInst] -> TcS (StopOrContinue ()) +try_inert_qcs (QCI { qci_ev = ev_w }) inerts = + case mapMaybe matching_inert inerts of + [] -> do { traceTcS "tryInertQCs:nothing" (ppr ev_w $$ ppr inerts) + ; continueWith () } + ev_i:_ -> + do { traceTcS "tryInertQCs:KeepInert" (ppr ev_i) + ; setEvBindIfWanted ev_w EvCanonical (ctEvTerm ev_i) + ; stopWith ev_w "Solved Wanted forall-constraint from inert" } + where + matching_inert (QCI { qci_ev = ev_i }) + | ctEvPred ev_i `tcEqType` ctEvPred ev_w + = Just ev_i + | otherwise + = Nothing + +solveWantedQCIs :: Cts -> TcS (Cts, Bag Implication) +solveWantedQCIs wanteds + = do { mode <- getTcSMode + ; bag_of_eithers <- mapBagM (solveWantedQCI mode) wanteds + -- bag_of_eithers :: Bag (Either Ct Implication) + ; return (partitionBagWith id bag_of_eithers) } + +solveWantedQCI :: TcSMode + -> Ct -- Definitely a Wanted + -> TcS (Either Ct Implication) +-- Try to solve a quantified constraint, `ct` +-- Returns +-- (Left ct) if `ct` is not a quantified constraint +-- (Right implic) if we can solve a quantified constraint `ct` by creating +-- an implication and fully or partly solving it +-- (Left ct) for a quantified constraint that can't be /fully solved/, +-- but mode is tcsmFullySolveQCIs +-- See Note [Solving a Wanted forall-constraint] +solveWantedQCI mode ct@(CQuantCan (QCI { qci_ev = ev, qci_tvs = tvs + , qci_theta = theta, qci_body = body_pred })) + | CtWanted (WantedCt { ctev_pred = forall_pred, ctev_dest = dest + , ctev_rewriters = rewriters, ctev_loc = loc }) <- ev + , let is_qc = IsQC forall_pred (ctLocOrigin loc) + empty_subst = mkEmptySubst $ mkInScopeSet $ + tyCoVarsOfTypes (body_pred:theta) `delVarSetList` tvs + = TcS.setSrcSpan (getCtLocEnvLoc $ ctLocEnv loc) $ + -- This setSrcSpan is important: the TcM.newImplication uses that + -- TcLclEnv for the implication, and that in turn sets the location + -- for the Givens when solving the constraint (#21006) + do { -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] + -- in GHC.Tc.Utils.TcType + -- Very like the code in tcSkolDFunType + ; rec { skol_info <- mkSkolemInfo skol_info_anon + ; (subst, skol_tvs) <- tcInstSkolTyVarsX skol_info empty_subst tvs + ; let inst_pred = substTy subst body_pred + inst_theta = substTheta subst theta + skol_info_anon = InstSkol is_qc (pSizeHead inst_pred) } + + ; given_ev_vars <- mapM TcS.newEvVar inst_theta + ; (lvl, wanted_ev) + <- pushLevelNoWorkList (ppr skol_info) $ + do { let loc' = setCtLocOrigin loc (ScOrigin is_qc NakedSc) + -- Set the thing to prove to have a ScOrigin, so we are + -- careful about its termination checks. + -- See (QC-INV) in Note [Solving a Wanted forall-constraint] + ; newWantedNC loc' rewriters inst_pred } + + ; ev_binds_var <- TcS.newTcEvBinds + ; let imp :: Implication + imp = (implicationPrototype (ctLocEnv loc)) + { ic_tclvl = lvl + , ic_skols = skol_tvs + , ic_given = given_ev_vars + , ic_wanted = mkSimpleWC [CtWanted wanted_ev] + , ic_binds = ev_binds_var + , ic_warn_inaccessible = False + , ic_info = skol_info_anon } + + ; imp' <- solveImplication imp + + + ; if | tcsmFullySolveQCIs mode + , not (isSolvedStatus (ic_status imp')) + -> -- Not fully solved, but mode says that we must fully + -- solve quantified constraints; so abandon the attempt + -- See (WFA4) in Note [Solving a Wanted forall-constraint] + return (Left ct) + + | otherwise + -> -- Commit to the (partly or fully solved) implication + -- See (WFA5) in Note [Solving a Wanted forall-constraint] + -- Record evidence and return residual implication + -- NB: even if it is fully solved we must return it, because it is + -- carrying a record of which evidence variables are used + -- See Note [Free vars of EvFun] in GHC.Tc.Types.Evidence + do { setWantedEvTerm dest EvCanonical $ + EvFun { et_tvs = skol_tvs, et_given = given_ev_vars + , et_binds = TcEvBinds ev_binds_var + , et_body = wantedCtEvEvId wanted_ev } + + ; return (Right imp') } + } + + | otherwise -- A Given QCInst + = pprPanic "wantedQciToImplic: found a Given QCI" (ppr ct) + +-- No-op on all Ct's other than CQuantCan +solveWantedQCI _ ct = return (Left ct) + + +{- +************************************************************************ +* * + Evidence transformation +* * +************************************************************************ +-} + +rewriteEvidence :: CtEvidence -> SolverStage CtEvidence +-- (rewriteEvidence old_ev new_pred co do_next) +-- Main purpose: create new evidence for new_pred; +-- unless new_pred is cached already +-- * Calls do_next with (new_ev :: new_pred), with same wanted/given flag as old_ev +-- * If old_ev was wanted, create a binding for old_ev, in terms of new_ev +-- * If old_ev was given, AND not cached, create a binding for new_ev, in terms of old_ev +-- * Stops if new_ev is already cached +-- +-- Old evidence New predicate is Return new evidence +-- flavour of same flavor +-- ------------------------------------------------------------------- +-- Wanted Already solved or in inert Stop +-- Not do_next new_evidence +-- +-- Given Already in inert Stop +-- Not do_next new_evidence + +{- Note [Rewriting with Refl] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the coercion is just reflexivity then you may re-use the same +evidence variable. But be careful! Although the coercion is Refl, new_pred +may reflect the result of unification alpha := ty, so new_pred might +not _look_ the same as old_pred, and it's vital to proceed from now on +using new_pred. + +The rewriter preserves type synonyms, so they should appear in new_pred +as well as in old_pred; that is important for good error messages. + +If we are rewriting with Refl, then there are no new rewriters to add to +the rewriter set. We check this with an assertion. + -} + + +rewriteEvidence ev + = Stage $ do { traceTcS "rewriteEvidence" (ppr ev) + ; (redn, rewriters) <- rewrite ev (ctEvPred ev) + ; finish_rewrite ev redn rewriters } + +finish_rewrite :: CtEvidence -- ^ old evidence + -> Reduction -- ^ new predicate + coercion, of type ~ new predicate + -> RewriterSet -- ^ See Note [Wanteds rewrite Wanteds] + -- in GHC.Tc.Types.Constraint + -> TcS (StopOrContinue CtEvidence) +finish_rewrite old_ev (Reduction co new_pred) rewriters + | isReflCo co -- See Note [Rewriting with Refl] + = assert (isEmptyRewriterSet rewriters) $ + continueWith (setCtEvPredType old_ev new_pred) + +finish_rewrite + ev@(CtGiven (GivenCt { ctev_evar = old_evar })) + (Reduction co new_pred) + rewriters + = assert (isEmptyRewriterSet rewriters) $ -- this is a Given, not a wanted + do { let loc = ctEvLoc ev + -- mkEvCast optimises ReflCo + ev_rw_role = ctEvRewriteRole ev + new_tm = assert (coercionRole co == ev_rw_role) + evCast (evId old_evar) $ -- evCast optimises ReflCo + downgradeRole Representational ev_rw_role co + ; new_ev <- newGivenEvVar loc (new_pred, new_tm) + ; continueWith $ CtGiven new_ev } + +finish_rewrite + ev@(CtWanted (WantedCt { ctev_rewriters = rewriters, ctev_dest = dest })) + (Reduction co new_pred) + new_rewriters + = do { let loc = ctEvLoc ev + rewriters' = rewriters S.<> new_rewriters + ev_rw_role = ctEvRewriteRole ev + ; mb_new_ev <- newWanted loc rewriters' new_pred + ; massert (coercionRole co == ev_rw_role) + ; setWantedEvTerm dest EvCanonical $ + evCast (getEvExpr mb_new_ev) $ + downgradeRole Representational ev_rw_role (mkSymCo co) + ; case mb_new_ev of + Fresh new_ev -> continueWith $ CtWanted new_ev + Cached _ -> stopWith ev "Cached wanted" } + +{- ******************************************************************* +* * +* Typechecker plugins +* * +******************************************************************* -} + +-- | Extract the (inert) givens and invoke the plugins on them. +-- Remove solved givens from the inert set and emit insolubles, but +-- return new work produced so that 'solveSimpleGivens' can feed it back +-- into the main solver. +runTcPluginsGiven :: TcS [Ct] +runTcPluginsGiven + = do { solvers <- getTcPluginSolvers + ; if null solvers then return [] else + do { givens <- getInertGivens + ; if null givens then return [] else + do { traceTcS "runTcPluginsGiven {" (ppr givens) + ; p <- runTcPluginSolvers solvers (givens,[]) + ; let (solved_givens, _) = pluginSolvedCts p + insols = map (ctIrredCt PluginReason) (pluginBadCts p) + ; updInertCans (removeInertCts solved_givens . + updIrreds (addIrreds insols) ) + ; traceTcS "runTcPluginsGiven }" $ + vcat [ text "solved_givens:" <+> ppr solved_givens + , text "insols:" <+> ppr insols + , text "new:" <+> ppr (pluginNewCts p) ] + ; return (pluginNewCts p) } } } + +-- | Given a bag of (rewritten, zonked) wanteds, invoke the plugins on +-- them and produce an updated bag of wanteds (possibly with some new +-- work) and a bag of insolubles. The boolean indicates whether +-- 'solveSimpleWanteds' should feed the updated wanteds back into the +-- main solver. +runTcPluginsWanted :: Cts -> TcS (Bool, Cts) +runTcPluginsWanted wanted + | isEmptyBag wanted + = return (False, wanted) + | otherwise + = do { solvers <- getTcPluginSolvers + ; if null solvers then return (False, wanted) else + + do { -- Find the set of Givens to give to the plugin. + given <- getInertGivens + + -- Plugin requires zonked input wanteds + ; zonked_wanted <- TcS.zonkSimples wanted + + ; traceTcS "Running plugins {" (vcat [ text "Given:" <+> ppr given + , text "Wanted:" <+> ppr zonked_wanted ]) + ; p <- runTcPluginSolvers solvers (given, bagToList zonked_wanted) + ; let (_, solved_wanted) = pluginSolvedCts p + (_, unsolved_wanted) = pluginInputCts p + new_wanted = pluginNewCts p + insols = pluginBadCts p + all_new_wanted = listToBag new_wanted `andCts` + listToBag unsolved_wanted `andCts` + listToBag insols + + ; mapM_ setEv solved_wanted + + ; traceTcS "Finished plugins }" (ppr new_wanted) + ; return ( notNull (pluginNewCts p), all_new_wanted ) } } + where + setEv :: (EvTerm,Ct) -> TcS () + setEv (ev,ct) = case ctEvidence ct of + CtWanted (WantedCt { ctev_dest = dest }) -> setWantedEvTerm dest EvCanonical ev + -- TODO: plugins should be able to signal non-canonicity + _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" + +-- | A pair of (given, wanted) constraints to pass to plugins +type SplitCts = ([Ct], [Ct]) + +-- | A solved pair of constraints, with evidence for wanteds +type SolvedCts = ([Ct], [(EvTerm,Ct)]) + +-- | Represents collections of constraints generated by typechecker +-- plugins +data TcPluginProgress = TcPluginProgress + { pluginInputCts :: SplitCts + -- ^ Original inputs to the plugins with solved/bad constraints + -- removed, but otherwise unmodified + , pluginSolvedCts :: SolvedCts + -- ^ Constraints solved by plugins + , pluginBadCts :: [Ct] + -- ^ Constraints reported as insoluble by plugins + , pluginNewCts :: [Ct] + -- ^ New constraints emitted by plugins + } + +getTcPluginSolvers :: TcS [TcPluginSolver] +getTcPluginSolvers + = do { tcg_env <- TcS.getGblEnv; return (tcg_tc_plugin_solvers tcg_env) } + +-- | Starting from a pair of (given, wanted) constraints, +-- invoke each of the typechecker constraint-solving plugins in turn and return +-- +-- * the remaining unmodified constraints, +-- * constraints that have been solved, +-- * constraints that are insoluble, and +-- * new work. +-- +-- Note that new work generated by one plugin will not be seen by +-- other plugins on this pass (but the main constraint solver will be +-- re-invoked and they will see it later). There is no check that new +-- work differs from the original constraints supplied to the plugin: +-- the plugin itself should perform this check if necessary. +runTcPluginSolvers :: [TcPluginSolver] -> SplitCts -> TcS TcPluginProgress +runTcPluginSolvers solvers all_cts + = do { ev_binds_var <- getTcEvBindsVar + ; foldM (do_plugin ev_binds_var) initialProgress solvers } + where + do_plugin :: EvBindsVar -> TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress + do_plugin ev_binds_var p solver = do + result <- runTcPluginTcS (uncurry (solver ev_binds_var) (pluginInputCts p)) + return $ progress p result + + progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress + progress p + (TcPluginSolveResult + { tcPluginInsolubleCts = bad_cts + , tcPluginSolvedCts = solved_cts + , tcPluginNewCts = new_cts + } + ) = + p { pluginInputCts = discard (bad_cts ++ map snd solved_cts) (pluginInputCts p) + , pluginSolvedCts = add solved_cts (pluginSolvedCts p) + , pluginNewCts = new_cts ++ pluginNewCts p + , pluginBadCts = bad_cts ++ pluginBadCts p + } + + initialProgress = TcPluginProgress all_cts ([], []) [] [] + + discard :: [Ct] -> SplitCts -> SplitCts + discard cts (xs, ys) = + (xs `without` cts, ys `without` cts) + + without :: [Ct] -> [Ct] -> [Ct] + without = deleteFirstsBy eq_ct + + eq_ct :: Ct -> Ct -> Bool + eq_ct c c' = ctFlavour c == ctFlavour c' + && ctPred c `tcEqType` ctPred c' + + add :: [(EvTerm,Ct)] -> SolvedCts -> SolvedCts + add xs scs = foldl' addOne scs xs + + addOne :: SolvedCts -> (EvTerm,Ct) -> SolvedCts + addOne (givens, wanteds) (ev,ct) = case ctEvidence ct of + CtGiven {} -> (ct:givens, wanteds) + CtWanted {} -> (givens, (ev,ct):wanteds) diff --git a/GHC/Tc/Solver/Solve.hs-boot b/GHC/Tc/Solver/Solve.hs-boot new file mode 100644 --- /dev/null +++ b/GHC/Tc/Solver/Solve.hs-boot @@ -0,0 +1,8 @@ +module GHC.Tc.Solver.Solve where + +import Prelude( Bool ) +import GHC.Tc.Solver.Monad( TcS ) +import GHC.Tc.Types.Constraint( Cts, Implication, WantedConstraints ) + +solveSimpleWanteds :: Cts -> TcS WantedConstraints +trySolveImplication :: Implication -> TcS Bool diff --git a/GHC/Tc/Solver/Types.hs b/GHC/Tc/Solver/Types.hs --- a/GHC/Tc/Solver/Types.hs +++ b/GHC/Tc/Solver/Types.hs @@ -14,6 +14,7 @@ TcAppMap, emptyTcAppMap, isEmptyTcAppMap, insertTcApp, alterTcApp, filterTcAppMap, + mapMaybeTcAppMap, tcAppMapToBag, foldTcAppMap, delTcApp, EqualCtList, filterEqualCtList, addToEqualCtList @@ -23,8 +24,6 @@ import GHC.Prelude import GHC.Tc.Types.Constraint -import GHC.Tc.Types.Origin -import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin ) import GHC.Tc.Utils.TcType import GHC.Types.Unique @@ -32,7 +31,6 @@ import GHC.Core.Class import GHC.Core.Map.Type -import GHC.Core.Predicate import GHC.Core.TyCon import GHC.Core.TyCon.Env @@ -114,6 +112,16 @@ where filtered_tm = filterTM f tm +mapMaybeTcAppMap :: forall a b. (a -> Maybe b) -> TcAppMap a -> TcAppMap b +mapMaybeTcAppMap f m = mapMaybeDTyConEnv one_tycon m + where + one_tycon :: ListMap LooseTypeMap a -> Maybe (ListMap LooseTypeMap b) + one_tycon tm + | isEmptyTM mapped_tm = Nothing + | otherwise = Just mapped_tm + where + mapped_tm = mapMaybeTM f tm + tcAppMapToBag :: TcAppMap a -> Bag a tcAppMapToBag m = foldTcAppMap consBag m emptyBag @@ -131,13 +139,8 @@ emptyDictMap :: DictMap a emptyDictMap = emptyTcAppMap -findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a -findDict m loc cls tys - | Just {} <- isCallStackPred cls tys - , isPushCallStackOrigin (ctLocOrigin loc) - = Nothing -- See Note [Solving CallStack constraints] - - | otherwise +findDict :: DictMap a -> Class -> [Type] -> Maybe a +findDict m cls tys = findTcApp m (classTyCon cls) tys findDictsByClass :: DictMap a -> Class -> Bag a @@ -153,33 +156,6 @@ foldDicts :: (a -> b -> b) -> DictMap a -> b -> b foldDicts = foldTcAppMap - -{- Note [Solving CallStack constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence. - -Suppose f :: HasCallStack => blah. Then - -* Each call to 'f' gives rise to - [W] s1 :: IP "callStack" CallStack -- CtOrigin = OccurrenceOf f - with a CtOrigin that says "OccurrenceOf f". - Remember that HasCallStack is just shorthand for - IP "callStack" CallStack - See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence - -* We canonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by - pushing the call-site info on the stack, and changing the CtOrigin - to record that has been done. - Bind: s1 = pushCallStack s2 - [W] s2 :: IP "callStack" CallStack -- CtOrigin = IPOccOrigin - -* Then, and only then, we can solve the constraint from an enclosing - Given. - -So we must be careful /not/ to solve 's1' from the Givens. Again, -we ensure this by arranging that findDict always misses when looking -up such constraints. --} {- ********************************************************************* * * diff --git a/GHC/Tc/TyCl.hs b/GHC/Tc/TyCl.hs --- a/GHC/Tc/TyCl.hs +++ b/GHC/Tc/TyCl.hs @@ -10,8 +10,6 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Typecheck type and class declarations module GHC.Tc.TyCl ( tcTyAndClassDecls, @@ -21,9 +19,12 @@ kcConDecls, tcConDecls, DataDeclInfo(..), dataDeclChecks, checkValidTyCon, tcFamTyPats, tcTyFamInstEqn, - tcAddTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, + tcAddOpenTyFamInstCtxt, tcMkDataFamInstCtxt, tcAddDataFamInstCtxt, unravelFamInstPats, addConsistencyConstraints, - checkFamTelescope + checkFamTelescope, + + -- Used by GHC.HsToCore.Quote + IsPrefixConGADT(..), unannotatedMultIsLinear ) where import GHC.Prelude @@ -55,10 +56,11 @@ import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType import GHC.Tc.Instance.Family -import GHC.Tc.Types.Origin +import GHC.Tc.Types.ErrCtxt ( TyConInstFlavour(..) ) import GHC.Tc.Types.LclEnv +import GHC.Tc.Types.Origin -import GHC.Builtin.Types (oneDataConTy, unitTy, makeRecoveryTyCon ) +import GHC.Builtin.Types ( oneDataConTy, unitTy, makeRecoveryTyCon, manyDataConTy ) import GHC.Rename.Env( lookupConstructorFields ) @@ -74,7 +76,6 @@ import GHC.Core.DataCon import GHC.Core.Unify -import GHC.Types.Error import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Var @@ -88,11 +89,13 @@ import GHC.Types.TypeEnv import GHC.Types.Unique import GHC.Types.Basic +import GHC.Types.Error import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString import GHC.Data.Maybe import GHC.Data.List.SetOps( minusList, equivClasses ) +import GHC.Data.OrdList import GHC.Unit import GHC.Unit.Module.ModDetails @@ -112,6 +115,7 @@ import qualified Data.List.NonEmpty as NE import Data.Traversable ( for ) import Data.Tuple( swap ) +import qualified Data.Semigroup as S {- ************************************************************************ @@ -147,44 +151,379 @@ *all* the tycons in a group for validity before checking *any* of the roles. Thus, we take two passes over the resulting tycons, first checking for general validity and then checking for valid role annotations. + +Note [Retrying TyClGroups] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +After renaming type, class, and instance declarations in a module (or, to be +more precise, in an HsGroup), GHC.Rename.Module.rnTyClDecls does dependency +analysis on the renamed declarations and returns a topologically sorted list +of SCCs, each SCC represented by one TyClGroup. + +If the dependency analysis were complete, i.e. if it were able to discover all +dependencies between all declarations, then tcTyAndClassDecls could simply +kind-check TyClGroups in order. Unfortunately, this is not the case, because +dependencies come in two varieties: + +* Lexical dependencies arise when X mentions Y by name: + + data X (a :: Y) = MkX -- depends on Y + data Y = MkY + +* Non-lexical dependencies arise when an instance must be in the + typing environment: + + type family F x + data X (a :: F Int) = MkX a -- depends on (F Int ~ Type) + type instance F x = Type + +Non-lexical dependencies can't be discovered by looking at the free variables of +a declaration (attempts to find a good heuristic did not bear fruit, see the +long discussion at #12088 and the linked Wiki pages). As a consequence, the +order of SCCs (i.e. TyClGroups) coming out of the renamer is determined solely +by lexical dependencies. + +In other words, the TyClGroups are in /lexical dependency order/, meaning: +- definitely in dependency order if all dependencies are lexical +- possibly not in dependency order if there are non-lexical dependencies + +Here are some examples how type checking declarations might go wrong due to +non-lexical dependencies: + +* Consider (#11348) + + type family F a + type instance F Int = Bool + + data R = MkR (F Int) + + type Foo = 'MkR 'True + + For Foo to kind-check we need to know that (F Int) ~ Bool. But we won't + know that unless we've looked at the type instance declaration for F + before kind-checking Foo. + +* Things become more complicated when we introduce transitive + dependencies through imported definitions, like in this scenario: + + A.hs + type family Closed (t :: Type) :: Type where + Closed t = Open t + + type family Open (t :: Type) :: Type + + B.hs + data Q where + Q :: Closed Bool -> Q + + type instance Open Int = Bool + + type S = 'Q 'True + + Somehow, we must ensure that the instance Open Int = Bool is checked before + the type synonym S. While we know that S depends upon 'Q depends upon Closed, + we have no idea that Closed depends upon Open! + +* Another example is this (#3990). + + data family Complex a + data instance Complex Double = CD {-# UNPACK #-} !Double + {-# UNPACK #-} !Double + + data T = T {-# UNPACK #-} !(Complex Double) + + Here, to generate the right kind of unpacked implementation for T, + we must have access to the 'data instance' declaration. + +To accommodate for these situations, tcTyAndClassDecls discovers the correct +kind-checking order by trial and error. + +The algorithm works as follows: + +1. (in rnTyClDecls) + Perform the SCC analysis on declarations without instances and considering + lexical dependencies only. The result is a topologically sorted list of SCCs. + See Note [Dependency analysis of type and class decls] in GHC.Rename.Module + +2. (in rnTyClDecls) + Create one singleton "SCC" per instance and put them at the end. + See Note [Put instances at the end] in GHC.Rename.Module + +3. (in tcTyAndClassDecls) + Check all SCCs in order, skipping any that are blocked (FVs not in env), + flawed (unusable unpack pragmas), or fail (type errors) + (3a) if none were skipped, we are done + (3b) if all were skipped and none are flawed, we are stuck; + report errors and exit (tcFailedTyClGroups) + (3c) if all were skipped and some are flawed, redo the pass + allowing flawed SCCs (tcTyClGroupsPass.go with strict=False) + (3d) if some were skipped and some weren't, we've made progress; iterate + +In the common case of lexical dependencies only, the algorithm is linear in the +number of groups: it completes in one pass if the program is kind-correct, or +two passes if there are kind errors. + +In the less common case of non-lexical dependencies, the algorithm is worst-case +quadratic in the number of groups: if each pass manages to check only one group, +we end up doing a pass per group. + +Now, regarding the "flawed" groups. These are the ones where the programmer used +the {-# UNPACK #-} pragma on a field, yet we could not unpack (#3990) + +* One possible reason for this is that we lack a data instance in the + environment that would allow for the field to be unpacked, so it is beneficial + to treat this like a kind error: skip the flawed group and retry it in a later + pass, when we might have more data instances in the env. + +* However, if the /only/ reason a pass gets stuck is due to flawed groups, + then we can make progress by treating unpacking failure is a warning. + +This way we maximize unpacking with explicit {-# UNPACK #-} pragmas. +Unfortunately, it does not help with -funbox-strict-fields. +See Note [Flaky -funbox-strict-fields with type/data families] + +Later we might check TyClGroups for other "flaws", but for now the property is +just about unusable unpack pragmas. + +Finally, a short comment on why it is necessary to check whether a group is +ready (FVs in the env) or blocked (FVs not in the env) using isReadyTyClGroup. +One might expect this check to be redundant, as the TyClGroups come in lexical +dependency order. However, as soon as we skip a group, the rest of the pass can +no longer rely on this property, hence the check. It is rare to encounter this +problem in a kind-correct program, but see e.g. the T12088e test case. + +Note [Flaky -funbox-strict-fields with type/data families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this program: + + {-# OPTIONS -funbox-strict-fields #-} + data family Complex a + data instance Complex Double = CD !Double !Double + data T = T !(Complex Double) -- does (Complex Double) get unpacked? + +Could we unpack T's field (Complex Double)? This depends on whether we have the +data instance in the environment. Prior GHC versions could handle this example, +but it was not reliable. A slightly more involved arrangement could throw it off +balance: + + {-# OPTIONS -funbox-strict-fields #-} + type family F a + data D1 = MkD1 !(F Int) -- does (F Int) get unpacked? + data D2 = MkD2 !Int !Int + type instance F Int = D2 + +Here, MkD1's field (F Int) would not get unpacked unless we used a top-level +splice to separate the module and force the desired order of kind-checking: + + {-# OPTIONS -funbox-strict-fields #-} + type family F a + data D2 = MkD2 !Int !Int + type instance F Int = D2 + $(return []) -- break the module into two sections + data D1 = MkD1 !(F Int) -- now (F Int) surely gets unpacked + +The current version of GHC is more predictable. Neither the (Complex Double) nor +the (F Int) example gets unpacking unless the type/data instance is put into a +separate HsGroup, either with $(return []) or by placing it in another module +altogether. This is a direct result of placing instances after the other SCCs, +as described in Note [Put instances at the end] in GHC.Rename.Module + +It is also possible to get the desired unpacking with an explicit {-# UNPACK #-} +pragma, as an unusable unpack pragma marks a TyClGroup "flawed", which means it +will be retried after more type/data instances are added to the typing +environment. See the algorithm in Note [Retrying TyClGroups]. -} -tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in - -- dependency order - -> TcM ( TcGblEnv -- Input env extended by types and - -- classes - -- and their implicit Ids,DataCons - , [InstInfo GhcRn] -- Source-code instance decls info - , [DerivInfo] -- Deriving info - , ThBindEnv -- TH binding levels - ) +data TcTyClGroupsAccum = + TcTyClGroupsAccum + { ttcga_inst_info :: !(OrdList (InstInfo GhcRn)) -- ^ Source-code instance decls info + , ttcga_deriv_info :: !(OrdList DerivInfo) -- ^ Deriving info + , ttcga_th_bndrs :: !ThBindEnv -- ^ TH binding levels + } + +instance S.Semigroup TcTyClGroupsAccum where + (TcTyClGroupsAccum a1 b1 c1) <> (TcTyClGroupsAccum a2 b2 c2) = + TcTyClGroupsAccum (a1 S.<> a2) + (b1 S.<> b2) + (c1 S.<> c2) + +instance Monoid TcTyClGroupsAccum where + mempty = TcTyClGroupsAccum mempty mempty mempty + +tcTyAndClassDecls :: [TyClGroup GhcRn] -- Mutually-recursive groups in lexical dependency order + -> TcM ( TcGblEnv -- Input env extended by types and classes and their implicit Ids, DataCons + , [InstInfo GhcRn] -- Source-code instance decls info + , [DerivInfo] -- Deriving info + , ThBindEnv -- TH binding levels + ) -- Fails if there are any errors tcTyAndClassDecls tyclds_s -- The code recovers internally, but if anything gave rise to -- an error we'd better stop now, to avoid a cascade -- Type check each group in dependency order folding the global env - = checkNoErrs $ fold_env [] [] emptyNameEnv tyclds_s + = checkNoErrs $ go mempty tyclds_s where - fold_env :: [InstInfo GhcRn] - -> [DerivInfo] - -> ThBindEnv - -> [TyClGroup GhcRn] - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], ThBindEnv) - fold_env inst_info deriv_info th_bndrs [] - = do { gbl_env <- getGblEnv - ; return (gbl_env, inst_info, deriv_info, th_bndrs) } - fold_env inst_info deriv_info th_bndrs (tyclds:tyclds_s) - = do { (tcg_env, inst_info', deriv_info', th_bndrs') - <- tcTyClGroup tyclds - ; setGblEnv tcg_env $ - -- remaining groups are typechecked in the extended global env. - fold_env (inst_info' ++ inst_info) - (deriv_info' ++ deriv_info) - (th_bndrs' `plusNameEnv` th_bndrs) - tyclds_s } + go :: TcTyClGroupsAccum + -> [TyClGroup GhcRn] + -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], ThBindEnv) + go acc [] = do -- Case (3a) of the algorithm in Note [Retrying TyClGroups] + -- All good, we are done. + tcg_env <- getGblEnv + let inst_info = fromOL (ttcga_inst_info acc) + deriv_info = fromOL (ttcga_deriv_info acc) + th_bndrs = ttcga_th_bndrs acc + return (tcg_env, inst_info, deriv_info, th_bndrs) + go acc gs = + tcTyClGroupsPass gs $ \acc' n gs' -> + if n == 0 then + -- Case (3b) of the algorithm in Note [Retrying TyClGroups] + -- The pass made no progress. We are stuck. Report errors and exit. + tcFailedTyClGroups gs' + else + -- Case (3b) of the algorithm in Note [Retrying TyClGroups] + -- The pass made some progress. Iterate. + go (acc' S.<> acc) gs' +-- Check the remaining TyClGroups that are known to fail, +-- extending the environment with fake tycons to report more errors. +-- See Note [Recover from validity error] +tcFailedTyClGroups :: [TyClGroup GhcRn] -> TcM a +tcFailedTyClGroups [] = failM +tcFailedTyClGroups (g:gs) = do + tcg_env <- getGblEnv + m_result <- + if isReadyTyClGroup tcg_env g + then attemptM (tcTyClGroup g) + else return Nothing + let tcg_env' = maybe tcg_env fst m_result + setGblEnv tcg_env' $ tcFailedTyClGroups gs + +-- Type check as many TyClGroups as possible, skipping any failures. +-- thing_inside runs in the extended environment. +tcTyClGroupsPass :: forall a. + [TyClGroup GhcRn] -- Mutually-recursive groups in lexical dependency order + -> (TcTyClGroupsAccum + -> Int -- Number of successfully checked groups + -> [TyClGroup GhcRn] -- Remaining groups in lexical dependency order + -> TcM a) + -> TcM a +tcTyClGroupsPass all_gs thing_inside = go True ttcgs_zero mempty nilOL all_gs + where + go :: Bool -- Strict pass, True <=> fail on unusable {-# UNPACK #-} + -> TcTyClGroupsStats + -> TcTyClGroupsAccum + -> OrdList (TyClGroup GhcRn) -- Skipped groups (accumulator) + -> [TyClGroup GhcRn] -- Groups to check + -> TcM a + go strict !stats acc skipped_gs [] + | strict, ttcgs_n_success stats == 0, ttcgs_n_flawed stats > 0 = do + -- Case (3b) of the algorithm in Note [Retrying TyClGroups] + -- The strict pass made no progress but found flawed groups; + -- now do a lax pass to allow them to succeed. + traceTc "tcTyClGroupsPass end of strict pass" (ppr stats) + go False ttcgs_zero acc nilOL (fromOL skipped_gs) + | otherwise = do + traceTc "tcTyClGroupsPass done" (ppr stats) + thing_inside acc (ttcgs_n_success stats) (fromOL skipped_gs) + go strict !stats acc skipped_gs (g:gs) = do + (stats', m_result) <- try_tc_group strict stats (null skipped_gs) g + case m_result of + Nothing -> + go strict stats' acc (skipped_gs `snocOL` g) gs + Just (tcg_env, acc') -> + setGblEnv tcg_env $ + go strict stats' (acc' S.<> acc) skipped_gs gs + + try_tc_group :: Bool -- Strict pass, True <=> fail on unusable {-# UNPACK #-} + -> TcTyClGroupsStats + -> Bool -- True <=> No groups skipped this pass (yet) + -> TyClGroup GhcRn + -> TcM (TcTyClGroupsStats, Maybe (TcGblEnv, TcTyClGroupsAccum)) + try_tc_group strict stats no_skipped g = do + tcg_env <- getGblEnv + let on_flawed = (ttcgs_inc_flawed stats, Nothing) + on_failed = (ttcgs_inc_failed stats, Nothing) + on_blocked = (ttcgs_inc_blocked stats, Nothing) + on_success r = (ttcgs_inc_success stats, Just r) + ready = no_skipped || isReadyTyClGroup tcg_env g + -- (no_skipped ||) is a shortcut: if no groups were skipped this + -- pass, the current group's lexical dependencies must have been + -- satisfied by the preceding groups; no need for the ready check, + -- this avoids some lookups in tcg_env + + -- See Note [Expedient use of diagnostics in tcTyClGroupsPass] + set_opts action + | strict = setWOptM Opt_WarnUnusableUnpackPragmas action + | otherwise = action + validate _ msgs _ + | strict = not (unpackErrorsFound msgs) + | otherwise = True + + if not ready then return on_blocked else + tryTcDiscardingErrs' validate + (return on_flawed) + (return on_failed) + (on_success <$> set_opts (tcTyClGroup g)) + +data TcTyClGroupsStats = + TcTyClGroupsStats + { ttcgs_n_success :: !Int -- ^ Number of successfully checked groups + , ttcgs_n_blocked :: !Int -- ^ Number of groups whose FVs are not in the env + , ttcgs_n_failed :: !Int -- ^ Number of groups that failed with an error + , ttcgs_n_flawed :: !Int -- ^ Number of groups that did not pass validation + } + +ttcgs_zero :: TcTyClGroupsStats +ttcgs_zero = TcTyClGroupsStats 0 0 0 0 + +ttcgs_inc_success, ttcgs_inc_blocked, ttcgs_inc_failed, ttcgs_inc_flawed :: TcTyClGroupsStats -> TcTyClGroupsStats +ttcgs_inc_success stats = stats { ttcgs_n_success = 1 + ttcgs_n_success stats } +ttcgs_inc_blocked stats = stats { ttcgs_n_blocked = 1 + ttcgs_n_blocked stats } +ttcgs_inc_failed stats = stats { ttcgs_n_failed = 1 + ttcgs_n_failed stats } +ttcgs_inc_flawed stats = stats { ttcgs_n_flawed = 1 + ttcgs_n_flawed stats } + +instance Outputable TcTyClGroupsStats where + ppr stats = + vcat [ text "n_success =" <+> ppr (ttcgs_n_success stats) + , text "n_blocked =" <+> ppr (ttcgs_n_blocked stats) + , text "n_failed =" <+> ppr (ttcgs_n_failed stats) + , text "n_flawed =" <+> ppr (ttcgs_n_flawed stats) ] + +-- See Note [Expedient use of diagnostics in tcTyClGroupsPass] +unpackErrorsFound :: Messages TcRnMessage -> Bool +unpackErrorsFound = any is_unpack_error + where + is_unpack_error :: TcRnMessage -> Bool + is_unpack_error (TcRnMessageWithInfo _ (TcRnMessageDetailed _ msg)) = is_unpack_error msg + is_unpack_error (TcRnWithHsDocContext _ msg) = is_unpack_error msg + is_unpack_error (TcRnBadFieldAnnotation _ _ UnusableUnpackPragma) = True + is_unpack_error _ = False + +{- Note [Expedient use of diagnostics in tcTyClGroupsPass] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In tcTyClGroupsPass.go with strict=True, we want to skip "flawed" groups, i.e. +groups with unusable unpack pragmas, as explained in Note [Retrying TyClGroups]. +To detect these unusable {-# UNPACK #-} pragmas, we currently piggy-back on the +diagnostics infrastructure: + + 1. (setWOptM Opt_WarnUnusableUnpackPragmas) to enable the warning. + The warning is on by default, but the user may have disabled it with + -Wno-unusable-unpack-pragmas, in which case we need to turn it back on. + + 2. (unpackErrorsFound msgs) to check if UnusableUnpackPragma is one of the + collected diagnostics. This is somewhat unpleasant because of the need to + recurse into TcRnMessageWithInfo and TcRnWithHsDocContext. + +Arguably, this is not a principled solution, because diagnostics are meant for +the user and here we inspect them to determine the order of type-checking. The +only reason for the current setup is that it was the easy thing to do. +-} + +isReadyTyClGroup :: TcGblEnv -> TyClGroup GhcRn -> Bool +isReadyTyClGroup tcg_env TyClGroup{group_ext = deps} = + nameSetAll (\n -> n `elemNameEnv` tcg_type_env tcg_env) deps + tcTyClGroup :: TyClGroup GhcRn - -> TcM (TcGblEnv, [InstInfo GhcRn], [DerivInfo], ThBindEnv) + -> TcM (TcGblEnv, TcTyClGroupsAccum) -- Typecheck one strongly-connected component of type, class, and instance decls -- See Note [TyClGroups and dependency analysis] in GHC.Hs.Decls tcTyClGroup (TyClGroup { group_tyclds = tyclds @@ -218,8 +557,13 @@ -- as we might look them up in checkTyConConsistentWithBoot. -- See Note [TyCon boot consistency checking]. fmap concat . for tyclss_with_validity_infos $ \ (tycls, ax_validity_infos) -> - do { tcAddFamInstCtxt (text "type family") (tyConName tycls) $ - tcAddClosedTypeFamilyDeclCtxt tycls $ + do { let inst_flav = + TyConInstFlavour + { tyConInstFlavour = tyConFlavour tycls + , tyConInstIsDefault = False + } + ; tcAddFamInstCtxt inst_flav (tyConName tycls) $ + addErrCtxt (ClosedFamEqnCtxt tycls) $ mapM_ (checkTyFamEqnValidityInfo tycls) ax_validity_infos ; checkValidTyCl tycls } @@ -242,8 +586,10 @@ ; let deriv_info = datafam_deriv_info ++ data_deriv_info ; let gbl_env'' = gbl_env' { tcg_ksigs = tcg_ksigs gbl_env' `unionNameSet` kindless } - ; return (gbl_env'', inst_info, deriv_info, - th_bndrs' `plusNameEnv` th_bndrs) } + ; let acc = TcTyClGroupsAccum{ ttcga_inst_info = toOL inst_info + , ttcga_deriv_info = toOL deriv_info + , ttcga_th_bndrs = th_bndrs' `plusNameEnv` th_bndrs } + ; return (gbl_env'', acc) } -- Gives the kind for every TyCon that has a standalone kind signature type KindSigEnv = NameEnv Kind @@ -1135,7 +1481,7 @@ flav = tyConFlavour tc -- Eta expand - ; (eta_tcbs, tc_res_kind) <- etaExpandAlgTyCon flav skol_info all_tcbs tc_res_kind + ; (eta_tcbs, tc_res_kind) <- maybeEtaExpandAlgTyCon flav skol_info all_tcbs tc_res_kind -- Step 6: Make the result TcTyCon ; let final_tcbs = all_tcbs `chkAppend` eta_tcbs @@ -1252,7 +1598,7 @@ Note that neither code path worries about point (4) above, as this is nicely handled by not mangling the res_kind. (Mangling res_kinds is done -*after* all this stuff, in tcDataDefn's call to etaExpandAlgTyCon.) +*after* all this stuff, in tcDataDefn's call to maybeEtaExpandAlgTyCon.) We can tell Inferred apart from Specified by looking at the scoped tyvars; Specified are always included there. @@ -1759,7 +2105,9 @@ -- - In this function, those TcTyVars are unified with other kind variables during -- kind inference (see GHC.Tc.TyCl Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon]) -kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } }) tycon +kcTyClDecl (DataDecl { tcdLName = (L _ _name) + , tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } }) + tycon = tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ -- NB: binding these tyvars isn't necessary for GADTs, but it does no -- harm. For GADTs, each data con brings its own tyvars into scope, @@ -1767,7 +2115,7 @@ -- (conceivably) shadowed. do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) ; _ <- tcHsContext ctxt - ; kcConDecls (dataDefnConsNewOrData cons) (tyConResKind tycon) cons + ; kcConDecls (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon @@ -1799,117 +2147,163 @@ -- This includes doing kind unification if the type is a newtype. -- See Note [Implementation of UnliftedNewtypes] for why we need -- the first two arguments. -kcConArgTys :: NewOrData -> TcKind -> [HsScaled GhcRn (LHsType GhcRn)] -> TcM () -kcConArgTys new_or_data res_kind arg_tys = do - { let exp_kind = getArgExpKind new_or_data res_kind - ; forM_ arg_tys (\(HsScaled mult ty) -> do _ <- tcCheckLHsTypeInContext (getBangType ty) exp_kind - tcMult mult) +kcConArgTys :: ConArgKind -- Expected kind of the argument(s) + -> [HsConDeclField GhcRn] -- User-written argument types + -> TcM () +kcConArgTys exp_kind arg_tys + = forM_ arg_tys $ \(CDF { cdf_multiplicity, cdf_type }) -> + do { _ <- tcCheckLHsTypeInContext cdf_type exp_kind + ; maybe (pure ()) (void . tcMult) (multAnnToHsType cdf_multiplicity) } -- See Note [Implementation of UnliftedNewtypes], STEP 2 - } -- Kind-check the types of arguments to a Haskell98 data constructor. -kcConH98Args :: NewOrData -> TcKind -> HsConDeclH98Details GhcRn -> TcM () -kcConH98Args new_or_data res_kind con_args = case con_args of - PrefixCon _ tys -> kcConArgTys new_or_data res_kind tys - InfixCon ty1 ty2 -> kcConArgTys new_or_data res_kind [ty1, ty2] - RecCon (L _ flds) -> kcConArgTys new_or_data res_kind $ - map (hsLinear . cd_fld_type . unLoc) flds +kcConH98Args :: ConArgKind -- Expected kind of the argument(s) + -> HsConDeclH98Details GhcRn + -> TcM () +kcConH98Args exp_kind con_args = case con_args of + PrefixCon tys -> kcConArgTys exp_kind tys + InfixCon ty1 ty2 -> kcConArgTys exp_kind [ty1, ty2] + RecCon (L _ flds) -> kcConArgTys exp_kind $ + map (cdrf_spec . unLoc) flds -- Kind-check the types of arguments to a GADT data constructor. -kcConGADTArgs :: NewOrData -> TcKind -> HsConDeclGADTDetails GhcRn -> TcM () -kcConGADTArgs new_or_data res_kind con_args = case con_args of - PrefixConGADT _ tys -> kcConArgTys new_or_data res_kind tys - RecConGADT _ (L _ flds) -> kcConArgTys new_or_data res_kind $ - map (hsLinear . cd_fld_type . unLoc) flds +kcConGADTArgs :: ConArgKind -- Expected kind of the argument(s) + -> HsConDeclGADTDetails GhcRn + -> TcM () +kcConGADTArgs exp_kind con_args = case con_args of + PrefixConGADT _ tys -> kcConArgTys exp_kind tys + RecConGADT _ (L _ flds) -> kcConArgTys exp_kind $ + map (cdrf_spec . unLoc) flds -kcConDecls :: Foldable f - => NewOrData - -> TcKind -- The result kind signature - -- Used only in H98 case - -> f (LConDecl GhcRn) -- The data constructors - -> TcM () +kcConDecls :: TcKind -- Result kind of tycon + -- Used only in H98 case + -> DataDefnCons (LConDecl GhcRn) -> TcM () -- See Note [kcConDecls: kind-checking data type decls] -kcConDecls new_or_data tc_res_kind = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) +kcConDecls tc_res_kind cons + = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) cons + where + new_or_data = dataDefnConsNewOrData cons -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was -- declared with data or newtype, and we need to know the result kind of -- this type. See Note [Implementation of UnliftedNewtypes] for why -- we need the first two arguments. -kcConDecl :: NewOrData - -> TcKind -- Result kind of the type constructor - -- Usually Type but can be TYPE UnliftedRep - -- or even TYPE r, in the case of unlifted newtype - -- Used only in H98 case - -> ConDecl GhcRn - -> TcM () -kcConDecl new_or_data tc_res_kind (ConDeclH98 - { con_name = name, con_ex_tvs = ex_tvs - , con_mb_cxt = ex_ctxt, con_args = args }) - = addErrCtxt (dataConCtxt (NE.singleton name)) $ +kcConDecl :: NewOrData -> TcKind -> ConDecl GhcRn -> TcM () +kcConDecl new_or_data tc_res_kind + (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs + , con_mb_cxt = ex_ctxt, con_args = args }) + = addErrCtxt (DataConDefCtxt (NE.singleton name)) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsContext ex_ctxt - ; kcConH98Args new_or_data tc_res_kind args + ; let arg_exp_kind = getArgExpKind new_or_data tc_res_kind + -- getArgExpKind: for newtypes, check that the argument kind + -- is the same as the tc_res_kind. See (KCD1) + -- in Note [kcConDecls: kind-checking data type decls] + ; kcConH98Args arg_exp_kind args -- We don't need to check the telescope here, -- because that's done in tcConDecl } -kcConDecl new_or_data - _tc_res_kind -- Not used in GADT case (and doesn't make sense) - (ConDeclGADT - { con_names = names, con_bndrs = L _ outer_bndrs, con_mb_cxt = cxt - , con_g_args = args, con_res_ty = res_ty }) +kcConDecl new_or_data _tc_res_kind + -- NB: _tc_res_kind is unused. See (KCD3) in + -- Note [kcConDecls: kind-checking data type decls] + (ConDeclGADT { con_names = names + , con_outer_bndrs = L _ outer_bndrs + , con_inner_bndrs = inner_bndrs + , con_mb_cxt = cxt + , con_g_args = args + , con_res_ty = res_ty }) = -- See Note [kcConDecls: kind-checking data type decls] - addErrCtxt (dataConCtxt names) $ - discardResult $ + addErrCtxt (DataConDefCtxt names) $ -- Not sure this is right, should just extend rather than skolemise but no test - bindOuterSigTKBndrs_Tv outer_bndrs $ - -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] + bind_con_tvbs outer_bndrs inner_bndrs $ do { _ <- tcHsContext cxt ; traceTc "kcConDecl:GADT {" (ppr names $$ ppr res_ty) ; con_res_kind <- newOpenTypeKind ; _ <- tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) - ; kcConGADTArgs new_or_data con_res_kind args - ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr con_res_kind) + + ; let arg_exp_kind = getArgExpKind new_or_data con_res_kind + -- getArgExpKind: for newtypes, check that the argument kind + -- is the same the kind of `res_ty`, the data con's return type + -- See (KCD2) in Note [kcConDecls: kind-checking data type decls] + ; kcConGADTArgs arg_exp_kind args + + ; traceTc "kcConDecl:GADT }" (ppr names $$ ppr arg_exp_kind) ; return () } + where + bind_con_tvbs outer_bndrs inner_bndrs thing_inside + -- Why "_Tv"? See Note [Using TyVarTvs for kind-checking GADTs] + = discardResult $ bindOuterSigTKBndrs_Tv outer_bndrs $ + bindExplicitTKBndrs_Tv (concatMap hsForAllTelescopeBndrs inner_bndrs) $ + thing_inside {- Note [kcConDecls: kind-checking data type decls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ kcConDecls is used when we are inferring the kind of the type -constructor in a data type declaration. E.g. - data T f a = MkT (f a) -we want to infer the kind of 'f' and 'a'. The basic plan is described -in Note [Inferring kinds for type declarations]; here we are doing Step 2. +constructor in a data type declaration. The basic plan is described in +Note [Inferring kinds for type declarations]; here we are doing Step 2. -In the GADT case we may have this: - data T f a where - MkT :: forall g b. g b -> T g b +We are kind-checking the data constructors /only/ to compute the kind of +the type construtor. For example + data T f a = MkT (f a) +The (f a) in the data construtor constrains the kinds of `f` and `a`, and hence +of `T`. -Notice that the variables f,a, and g,b are quite distinct. -Nevertheless, the type signature for MkT must still influence the kind -T which is (remember Step 1) something like - T :: kappa1 -> kappa2 -> Type -Otherwise we'd infer the bogus kind - T :: forall k1 k2. k1 -> k2 -> Type. +There are two cases to consider in `kcConDecl` -The type signature for MkT influences the kind of T simply by -kind-checking the result type (T g b), which will force 'f' and 'g' to -have the same kinds. This is the call to - tcCheckLHsTypeInContext res_ty (TheKind con_res_kind) -Because this is the result type of an arrow, we know the kind must be -of form (TYPE rr), and we get better error messages if we enforce that -here (e.g. test gadt10). +* Haskell 98 data constructors, as above. We simply bring `f` and `a` + into scope and kind-check the data constructors. -For unlifted newtypes only, we must ensure that the argument kind -and result kind are the same: -* In the H98 case, we need the result kind of the TyCon, to unify with - the argument kind. +* GADT data type decls e.g. + data S f a where + MkS :: g b -> S g b + Here `f` and `a` don't scope over the data constructor signatures. + Instead, we just kind-check the entire signature (including the result `S g b`), + relying on the fact that `S` is in scope with its initial kind `k1 -> k2 -> Type`; + doing so will constrain `k1` and `k2` appropriately. -* In GADT syntax, this unification happens via the result kind passed - to kcConGADTArgs. The tycon's result kind is not used at all in the - GADT case. +The arguments of each data constructor are always of kind (TYPE r) for some +r :: RuntimeRep. But in the case of a newytype, the argument kind must be +the same as the tycon result kind. Since we are trying to figure out the +tycon kind, kcConDecls must account for this, which is surprisingly tricky. +Again there are two cases to consider in `kcConDecl`: +* Haskell 98 data type decls, e.g. + data T f a = MkT (f a) + * In the header, all the tycon binders are specified (here `f` and `a`) + and there is no result kind signature. + * The binders from the header scope over the data construtors. + * In the case of unlifted newtypes, the argument kind affects the tycon kind + newtype N = MkN Int# + Here `getInitialKind` will give `N` the result kind `TYPE r`, where `r` is + a unification variable, and `kcConDecls` should unify that `r` with + `IntRep` becuase of the `Int#` + + Solution (KCD1): just check that the argumet type has the same kind as the result + kind of the tycon. + +* GADT data type decls e.g. + data S f :: Type -> Type where + MkS :: g a -> S g a + * In the header, not all the tycon binders are specified (here just `f`), + and there can be a kind signature + * The kind signature may describe some, all, or none of the tycon binders. + Regardless, in the TcTyCon constructed by `getInitialKind`, the tyConResKind + is the signature, not the "ultimate" result type of the tycon (which is + usually Type) + * In the case of unlifted newtypes, we again want the argument kind to be the + same as the result kind of the tycon; but it's not so clear what /is/ the + result kind of the tycon, because of the signature stuff in the previous bullet. + + Solution (KCD2): kind-check the result type of the data constructor (here + `S g a`) and, for newtypes, ensure that the arugment has that same kind. + + (KCD3) The tycon's result kind `tc_res_kind` is not used at all in the GADT + case; rather it is accessed via looking up S's kind in the type environment + when kind-checking the result type of the data constructor. + Note [Using TyVarTvs for kind-checking GADTs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -2083,7 +2477,7 @@ data T a :: Type -> Type where ... we really mean for T to have two parameters. The second parameter - is produced by processing the return kind in etaExpandAlgTyCon, + is produced by processing the return kind in maybeEtaExpandAlgTyCon, called in tcDataDefn. See also Note [splitTyConKind] in GHC.Tc.Gen.HsType. @@ -2178,14 +2572,20 @@ Type. This assumption is in getInitialKind for CUSKs or get_fam_decl_initial_kind for non-signature & non-CUSK cases. - Instances: The data family already has a known kind. The return kind - of an instance is then calculated by applying the data family tycon - to the patterns provided, as computed by the typeKind lhs_ty in the - end of tcDataFamInstHeader. In the case of an instance written in GADT - syntax, there are potentially *two* return kinds: the one computed from - applying the data family tycon to the patterns, and the one given by - the user. This second kind is checked by the tc_kind_sig function within - tcDataFamInstHeader. See also DF3, below. + Instances: There are potentially *two* return kinds: + * Master kind: + The data family already has a known kind. The return kind of an instance + is then calculated by applying the data family tycon to the patterns + provided, as computed by the `tcFamTyPats fam_tc hs_pats` in the + tcDataFamInstHeader. + * Instance kind: + The kind specified by the user in GADT syntax. If H98 syntax is used, + with UnliftedNewtypes/UnliftedDatatypes, it defaults to newOpenTypeKind + for newtypes/datatypes, otherwise it defaults to liftedTypeKind. + This is checked or defaulted by the tc_kind_sig function within + tcDataFamInstHeader. Defaulting can be tricky for some cases, + See Note [Defaulting result kind of newtype/data family instance]. + See also DF3, below. DF1 In a data/newtype instance, we treat the kind of the /data family/, once instantiated, as the "master kind" for the representation @@ -2653,9 +3053,9 @@ -- and concrete class with no methods (maybe by -- specifying a trailing where or not - ; mindef <- tcClassMinimalDef class_name sigs sig_stuff + ; mindef <- tcClassMinimalDef class_name sigs sig_stuff ; is_boot <- tcIsHsBootOrSig - ; let body | is_boot, isNothing hs_ctxt, null at_stuff, null sig_stuff + ; let abstract_class = is_boot && isNothing hs_ctxt && null at_stuff && null sig_stuff -- We use @isNothing hs_ctxt@ rather than @null ctxt@, -- so that a declaration in an hs-boot file such as: -- @@ -2664,11 +3064,19 @@ -- is not considered abstract; it's sometimes useful -- to be able to declare such empty classes in hs-boot files. -- See #20661. - = Nothing - | otherwise - = Just (ctxt, at_stuff, sig_stuff, mindef) - ; clas <- buildClass class_name bndrs roles fds body + unary_class = case ctxt ++ map sndOf3 sig_stuff of + [ty] -> isBoxedType ty + _ -> False + -- Use a unary class if the data constructor + -- has exactly one, boxed value field + -- i.e. exactly one operation or superclass taken together + -- See (UCM10) in Note [Unary class magic] in GHC.Core.TyCon + + ; clas <- if abstract_class + then buildAbstractClass class_name bndrs roles fds + else buildClass class_name bndrs roles fds ctxt + at_stuff sig_stuff mindef unary_class ; traceTc "tcClassDecl" (ppr fundeps $$ ppr bndrs $$ ppr fds) ; return clas } @@ -2752,8 +3160,15 @@ , feqn_pats = hs_pats , feqn_rhs = hs_rhs_ty }})] = -- See Note [Type-checking default assoc decls] + let + inst_flav = + TyConInstFlavour + { tyConInstFlavour = tyConFlavour fam_tc + , tyConInstIsDefault = True + } + in setSrcSpanA loc $ - tcAddFamInstCtxt (text "default type instance") tc_name $ + tcAddFamInstCtxt inst_flav tc_name $ do { traceTc "tcDefaultAssocDecl 1" (ppr tc_name) ; let fam_tc_name = tyConName fam_tc vis_arity = length (tyConVisibleTyVars fam_tc) @@ -3075,7 +3490,7 @@ where skol_info = TyConSkol TypeSynonymFlavour tc_name -tcDataDefn :: SDoc -> RolesInfo -> Name +tcDataDefn :: ErrCtxtMsg -> RolesInfo -> Name -> HsDataDefn GhcRn -> TcM (TyCon, [DerivInfo]) -- NB: not used for newtype/data instances (whether associated or not) tcDataDefn err_ctxt roles_info tc_name @@ -3320,7 +3735,7 @@ no role. See also Note [Re-quantify type variables in rules] in -GHC.Tc.Gen.Rule, which explains a /very/ similar design when +GHC.Tc.Gen.Sig, which explains a /very/ similar design when generalising over the type of a rewrite rule. -} @@ -3606,7 +4021,7 @@ , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args }) - = addErrCtxt (dataConCtxt (NE.singleton lname)) $ + = addErrCtxt (DataConDefCtxt (NE.singleton lname)) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables @@ -3626,7 +4041,7 @@ do { ctxt <- tcHsContext hs_ctxt ; let exp_kind = getArgExpKind new_or_data res_kind ; btys <- tcConH98Args exp_kind hs_args - ; field_lbls <- lookupConstructorFields name + ; field_lbls <- lookupConstructorFields $ noUserRdr name ; let (arg_tys, stricts) = unzip btys ; return (ctxt, arg_tys, field_lbls, stricts) } @@ -3677,7 +4092,7 @@ -- For H98 datatypes, the user-written tyvar binders are precisely -- the universals followed by the existentials. -- See Note [DataCon user type variable binders] in GHC.Core.DataCon. - user_tvbs = univ_tvbs ++ ex_tvbs + user_tvbs = tyVarSpecToBinders $ univ_tvbs ++ ex_tvbs user_res_ty = mkDDHeaderTy dd_info rep_tycon tc_bndrs ; traceTc "tcConDecl 2" (ppr name) @@ -3701,16 +4116,17 @@ -- NB: don't use res_kind here, as it's ill-scoped. Instead, -- we get the res_kind by typechecking the result type. (ConDeclGADT { con_names = names - , con_bndrs = L _ outer_hs_bndrs + , con_outer_bndrs = L _ outer_bndrs + , con_inner_bndrs = inner_bndrs , con_mb_cxt = cxt, con_g_args = hs_args , con_res_ty = hs_res_ty }) - = addErrCtxt (dataConCtxt names) $ + = addErrCtxt (DataConDefCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names) ; let L _ name :| _ = names ; skol_info <- mkSkolemInfo (DataConSkol name) - ; (tclvl, wanted, (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) + ; (tclvl, wanted, (tvbs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $ - tcOuterTKBndrs skol_info outer_hs_bndrs $ + tcGadtConTyVarBndrs skol_info outer_bndrs inner_bndrs $ do { ctxt <- tcHsContext cxt ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] @@ -3724,8 +4140,8 @@ do { (subst, _meta_tvs) <- newMetaTyVars (binderVars tc_bndrs) ; let head_shape = substTy subst hdr_ty ; discardResult $ - popErrCtxt $ -- Drop dataConCtxt - addErrCtxt (dataConResCtxt names) $ + popErrCtxt $ -- Drop DataConDefCtxt + addErrCtxt (DataConResTyCtxt names) $ unifyType Nothing res_ty head_shape } -- See Note [Datatype return kinds] @@ -3733,22 +4149,19 @@ ; btys <- tcConGADTArgs exp_kind hs_args ; let (arg_tys, stricts) = unzip btys - ; field_lbls <- lookupConstructorFields name + ; field_lbls <- lookupConstructorFields $ noUserRdr name ; return (ctxt, arg_tys, res_ty, field_lbls, stricts) } - ; outer_bndrs <- scopedSortOuter outer_bndrs - ; let outer_tv_bndrs = outerTyVarBndrs outer_bndrs - ; tkvs <- kindGeneralizeAll skol_info - (mkInvisForAllTys outer_tv_bndrs $ - tcMkPhiTy ctxt $ - tcMkScaledFunTys arg_tys $ + (mkForAllTys tvbs $ + tcMkPhiTy ctxt $ + tcMkScaledFunTys arg_tys $ res_ty) ; traceTc "tcConDecl:GADT" (ppr names $$ ppr res_ty $$ ppr tkvs) ; reportUnsolvedEqualities skol_info tkvs tclvl wanted - ; let tvbndrs = mkTyVarBinders InferredSpec tkvs ++ outer_tv_bndrs + ; let tvbndrs = mkTyVarBinders Inferred tkvs ++ tvbs -- Zonk to Types ; (tvbndrs, arg_tys, ctxt, res_ty) <- initZonkEnv NoFlexi $ @@ -3866,13 +4279,21 @@ tcInferLHsTypeKind doesn't any gratuitous top-level casts. -} + +type ConArgKind = ContextKind + -- The expected kind of the argument(s) of a constructor + -- For data types this is always OpenKind + -- For newtypes it is (TheKind ki) + -- where `ki` is the result kind of the newtype + -- With NoUnliftedNewtype, ki=Type, but with UnliftedNewtypes it can be a variable + -- | Produce an "expected kind" for the arguments of a data/newtype. -- If the declaration is indeed for a newtype, -- then this expected kind will be the kind provided. Otherwise, -- it is OpenKind for datatypes and liftedTypeKind. -- Why do we not check for -XUnliftedNewtypes? See point -- in Note [Implementation of UnliftedNewtypes] -getArgExpKind :: NewOrData -> TcKind -> ContextKind +getArgExpKind :: NewOrData -> TcKind -> ConArgKind getArgExpKind NewType res_ki = TheKind res_ki getArgExpKind DataType _ = OpenKind @@ -3893,65 +4314,77 @@ RecConGADT{} -> return False PrefixConGADT _ arg_tys -- See Note [Infix GADT constructors] | isSymOcc (getOccName con) - , [_ty1,_ty2] <- map hsScaledThing arg_tys + , [_ty1,_ty2] <- arg_tys -> do { fix_env <- getFixityEnv ; return (con `elemNameEnv` fix_env) } | otherwise -> return False -tcConH98Args :: ContextKind -- expected kind of arguments +tcConH98Args :: ConArgKind -- expected kind of arguments -- always OpenKind for datatypes, but unlifted newtypes -- might have a specific kind -> HsConDeclH98Details GhcRn -> TcM [(Scaled TcType, HsSrcBang)] -tcConH98Args exp_kind (PrefixCon _ btys) - = mapM (tcConArg exp_kind) btys +tcConH98Args exp_kind (PrefixCon btys) + = mapM (tcConArg exp_kind IsNotPrefixConGADT) btys tcConH98Args exp_kind (InfixCon bty1 bty2) - = do { bty1' <- tcConArg exp_kind bty1 - ; bty2' <- tcConArg exp_kind bty2 + = do { bty1' <- tcConArg exp_kind IsNotPrefixConGADT bty1 + ; bty2' <- tcConArg exp_kind IsNotPrefixConGADT bty2 ; return [bty1', bty2'] } tcConH98Args exp_kind (RecCon fields) - = tcRecConDeclFields exp_kind fields + = tcRecHsConDeclRecFields exp_kind fields -tcConGADTArgs :: ContextKind -- expected kind of arguments +tcConGADTArgs :: ConArgKind -- expected kind of arguments -- always OpenKind for datatypes, but unlifted newtypes -- might have a specific kind -> HsConDeclGADTDetails GhcRn -> TcM [(Scaled TcType, HsSrcBang)] tcConGADTArgs exp_kind (PrefixConGADT _ btys) - = mapM (tcConArg exp_kind) btys + = mapM (tcConArg exp_kind IsPrefixConGADT) btys tcConGADTArgs exp_kind (RecConGADT _ fields) - = tcRecConDeclFields exp_kind fields + = tcRecHsConDeclRecFields exp_kind fields -tcConArg :: ContextKind -- expected kind for args; always OpenKind for datatypes, +tcConArg :: ConArgKind -- expected kind for args; always OpenKind for datatypes, -- but might be an unlifted type with UnliftedNewtypes - -> HsScaled GhcRn (LHsType GhcRn) -> TcM (Scaled TcType, HsSrcBang) -tcConArg exp_kind (HsScaled w bty) + -> IsPrefixConGADT + -> HsConDeclField GhcRn -> TcM (Scaled TcType, HsSrcBang) +tcConArg exp_kind isPrefixConGADT (CDF (_, src) unp str w bty _) = do { traceTc "tcConArg 1" (ppr bty) - ; arg_ty <- tcCheckLHsTypeInContext (getBangType bty) exp_kind - ; w' <- tcDataConMult w + ; arg_ty <- tcCheckLHsTypeInContext bty exp_kind + ; w' <- tcDataConMult isPrefixConGADT w ; traceTc "tcConArg 2" (ppr bty) - ; return (Scaled w' arg_ty, getBangStrictness bty) } + ; return (Scaled w' arg_ty, HsSrcBang src unp str) } -tcRecConDeclFields :: ContextKind - -> LocatedL [LConDeclField GhcRn] +tcRecHsConDeclRecFields :: ConArgKind + -> LocatedL [LHsConDeclRecField GhcRn] -> TcM [(Scaled TcType, HsSrcBang)] -tcRecConDeclFields exp_kind fields - = mapM (tcConArg exp_kind) btys +tcRecHsConDeclRecFields exp_kind fields + = mapM (tcConArg exp_kind IsNotPrefixConGADT) btys where -- We need a one-to-one mapping from field_names to btys - combined = map (\(L _ f) -> (cd_fld_names f,hsLinear (cd_fld_type f))) + combined = map (\(L _ f) -> (cdrf_names f, cdrf_spec f)) (unLoc fields) explode (ns,ty) = zip ns (repeat ty) exploded = concatMap explode combined (_,btys) = unzip exploded -tcDataConMult :: HsArrow GhcRn -> TcM Mult -tcDataConMult arr@(HsUnrestrictedArrow _) = do - -- See Note [Function arrows in GADT constructors] - linearEnabled <- xoptM LangExt.LinearTypes - if linearEnabled then tcMult arr else return oneDataConTy -tcDataConMult arr = tcMult arr +data IsPrefixConGADT = IsPrefixConGADT | IsNotPrefixConGADT deriving (Eq) +-- See Note [Function arrows in GADT constructors] +unannotatedMultIsLinear :: IsPrefixConGADT -> TcRnIf gbl lcl Bool +unannotatedMultIsLinear isPrefixConGADT = do + if isPrefixConGADT == IsPrefixConGADT then do + linearEnabled <- xoptM LangExt.LinearTypes + return $ not linearEnabled + else + return True + +tcDataConMult :: IsPrefixConGADT -> HsMultAnn GhcRn -> TcM Mult +tcDataConMult isPrefixConGADT arr = case multAnnToHsType arr of + Nothing -> do + isLinear <- unannotatedMultIsLinear isPrefixConGADT + return $ if isLinear then oneDataConTy else manyDataConTy + Just ty -> tcMult ty + {- Note [Function arrows in GADT constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -4015,11 +4448,11 @@ rejigConRes :: [KnotTied TyConBinder] -- Template for result type; e.g. -> KnotTied Type -- data instance T [a] b c ... -- gives template ([a,b,c], T [a] b c) - -> [InvisTVBinder] -- The constructor's type variables (both inferred and user-written) + -> [TyVarBinder] -- The constructor's type variables (both inferred and user-written) -> KnotTied Type -- res_ty -> ([TyVar], -- Universal [TyVar], -- Existential (distinct OccNames from univs) - [InvisTVBinder], -- The constructor's rejigged, user-written + [TyVarBinder], -- The constructor's rejigged, user-written -- type variables [EqSpec], -- Equality predicates Subst) -- Substitution to apply to argument types @@ -4232,7 +4665,7 @@ = choose [] [] empty_subst empty_subst tmpl_tvs where in_scope = mkInScopeSet (mkVarSet tmpl_tvs `unionVarSet` mkVarSet dc_tvs) - `unionInScope` getSubstInScope subst + `unionInScope` substInScopeSet subst empty_subst = mkEmptySubst in_scope choose :: [TyVar] -- accumulator of univ tvs, reversed @@ -4507,7 +4940,7 @@ | Just fam_flav <- famTyConFlav_maybe tc -> case fam_flav of { ClosedSynFamilyTyCon (Just ax) - -> tcAddClosedTypeFamilyDeclCtxt tc $ + -> addErrCtxt (ClosedFamEqnCtxt tc) $ checkValidCoAxiom ax ; ClosedSynFamilyTyCon Nothing -> return () ; AbstractClosedSynFamilyTyCon -> @@ -4608,13 +5041,13 @@ ; checkTc (isJust mb_subst2) (TcRnCommonFieldTypeMismatch con1 con2 fld) } where mb_subst1 = tcMatchTy res1 res2 - mb_subst2 = tcMatchTyX (expectJust "checkFieldCompat" mb_subst1) fty1 fty2 + mb_subst2 = tcMatchTyX (expectJust mb_subst1) fty1 fty2 ------------------------------- checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con = setSrcSpan con_loc $ - addErrCtxt (dataConCtxt (NE.singleton (L (noAnnSrcSpan con_loc) con_name))) $ + addErrCtxt (DataConDefCtxt (NE.singleton (L (noAnnSrcSpan con_loc) con_name))) $ do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) arg_tys = dataConOrigArgTys con @@ -4690,38 +5123,38 @@ -- See Note [Type data declarations] in GHC.Rename.Module, -- restriction (R4). ; when (isTypeDataCon con) $ - checkTc (all isEqPred (dataConOtherTheta con)) + checkTc (all isEqClassPred (dataConOtherTheta con)) (TcRnConstraintInKind (dataConRepType con)) ; hsc_env <- getTopEnv ; let check_bang :: Type -> HsSrcBang -> HsImplBang -> Int -> TcM () check_bang orig_arg_ty bang rep_bang n - | HsSrcBang _ (HsBang _ SrcLazy) <- bang + | HsSrcBang _ _ SrcLazy <- bang , not (bang_opt_strict_data bang_opts) = addErrTc (bad_bang n LazyFieldsDisabled) -- Warn about UNPACK without "!" -- e.g. data T = MkT {-# UNPACK #-} Int - | HsSrcBang _ (HsBang want_unpack strict_mark) <- bang + | HsSrcBang _ want_unpack strict_mark <- bang , isSrcUnpacked want_unpack, not (is_strict strict_mark) , not (isUnliftedType orig_arg_ty) = addDiagnosticTc (bad_bang n UnpackWithoutStrictness) -- Warn about a redundant ! on an unlifted type -- e.g. data T = MkT !Int# - | HsSrcBang _ (HsBang _ SrcStrict) <- bang + | HsSrcBang _ _ SrcStrict <- bang , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnBangOnUnliftedType orig_arg_ty -- Warn about a ~ on an unlifted type (#21951) -- e.g. data T = MkT ~Int# - | HsSrcBang _ (HsBang _ SrcLazy) <- bang + | HsSrcBang _ _ SrcLazy <- bang , isUnliftedType orig_arg_ty = addDiagnosticTc $ TcRnLazyBangOnUnliftedType orig_arg_ty -- Warn about unusable UNPACK pragmas -- e.g. data T a = MkT {-# UNPACK #-} !a -- Can't unpack - | HsSrcBang _ (HsBang want_unpack _) <- bang + | HsSrcBang _ want_unpack _ <- bang -- See Note [Detecting useless UNPACK pragmas] in GHC.Core.DataCon. , isSrcUnpacked want_unpack -- this means the user wrote {-# UNPACK #-} @@ -4734,7 +5167,7 @@ -- warn in this case (it gives users the wrong idea about whether -- or not UNPACK on abstract types is supported; it is!) , isHomeUnitDefinite (hsc_home_unit hsc_env) - = addDiagnosticTc (bad_bang n BackpackUnpackAbstractType) + = addDiagnosticTc (bad_bang n UnusableUnpackPragma) | otherwise = return () @@ -4820,9 +5253,9 @@ (_univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig con - ok_bang (HsSrcBang _ (HsBang _ SrcStrict)) = False - ok_bang (HsSrcBang _ (HsBang _ SrcLazy)) = False - ok_bang _ = True + ok_bang (HsSrcBang _ _ SrcStrict) = False + ok_bang (HsSrcBang _ _ SrcLazy) = False + ok_bang _ = True ok_mult OneTy = True ok_mult _ = False @@ -4872,7 +5305,7 @@ check_op constrained_class_methods (sel_id, dm) = setSrcSpan (getSrcSpan sel_id) $ - addErrCtxt (classOpCtxt sel_id op_ty) $ do + addErrCtxt (ClassOpCtxt sel_id op_ty) $ do { traceTc "class op type" (ppr op_ty) ; checkValidType ctxt op_ty -- This implements the ambiguity check, among other things @@ -4928,8 +5361,15 @@ , vi_non_user_tvs = non_user_tvs , vi_pats = pats , vi_rhs = orig_rhs } -> + let + inst_flav = + TyConInstFlavour + { tyConInstFlavour = tyConFlavour fam_tc + , tyConInstIsDefault = True + } + in setSrcSpan loc $ - tcAddFamInstCtxt (text "default type instance") (getName fam_tc) $ + tcAddFamInstCtxt inst_flav (getName fam_tc) $ do { checkValidAssocTyFamDeflt fam_tc pats ; checkFamPatBinders fam_tc qtvs non_user_tvs pats orig_rhs ; checkValidTyFamEqn fam_tc pats orig_rhs }} @@ -5001,9 +5441,10 @@ -- -- foo2 :: a -> Int -- default foo2 :: a -> b - unless (isJust $ tcMatchTys [dm_phi_ty, vanilla_phi_ty] - [vanilla_phi_ty, dm_phi_ty]) $ addErrTc $ - TcRnDefaultSigMismatch sel_id dm_ty + unless (isJust (tcMatchTy dm_phi_ty vanilla_phi_ty) && + isJust (tcMatchTy vanilla_phi_ty dm_phi_ty)) $ + addErrTc $ + TcRnDefaultSigMismatch sel_id dm_ty -- Now do an ambiguity check on the default type signature. checkValidType ctxt (mkDefaultMethodType cls sel_id dm_spec) @@ -5260,7 +5701,7 @@ warnIf (not (isClassTyCon tc) && not (null vis_roles)) $ TcRnMissingRoleAnnotation name vis_roles Just (decl@(L loc (RoleAnnotDecl _ _ the_role_annots))) -> - addRoleAnnotCtxt name $ + addErrCtxt (RoleAnnotErrCtxt name) $ setSrcSpanA loc $ do { role_annots_ok <- xoptM LangExt.RoleAnnotations ; unless role_annots_ok $ addErrTc $ TcRnRoleAnnotationsDisabled tc @@ -5405,9 +5846,9 @@ ************************************************************************ -} -tcMkDeclCtxt :: TyClDecl GhcRn -> SDoc -tcMkDeclCtxt decl = hsep [text "In the", pprTyClDeclFlavour decl, - text "declaration for", quotes (ppr (tcdName decl))] +tcMkDeclCtxt :: TyClDecl GhcRn -> ErrCtxtMsg +tcMkDeclCtxt decl = + TyConDeclCtxt (tcdName decl) (tyClDeclFlavour decl) addVDQNote :: TcTyCon -> TcM a -> TcM a -- See Note [Inferring visible dependent quantification] @@ -5415,7 +5856,7 @@ addVDQNote tycon thing_inside | assertPpr (isMonoTcTyCon tycon) (ppr tycon $$ ppr tc_kind) has_vdq - = addLandmarkErrCtxt vdq_warning thing_inside + = addLandmarkErrCtxt (VDQWarningCtxt tycon) thing_inside | otherwise = thing_inside where @@ -5432,62 +5873,41 @@ is_vdq_tcb tcb = (binderVar tcb `elemVarSet` kind_fvs) && isVisibleTyConBinder tcb - vdq_warning = vcat - [ text "NB: Type" <+> quotes (ppr tycon) <+> - text "was inferred to use visible dependent quantification." - , text "Most types with visible dependent quantification are" - , text "polymorphically recursive and need a standalone kind" - , text "signature. Perhaps supply one, with StandaloneKindSignatures." - ] - tcAddDeclCtxt :: TyClDecl GhcRn -> TcM a -> TcM a tcAddDeclCtxt decl thing_inside = addErrCtxt (tcMkDeclCtxt decl) thing_inside -tcAddTyFamInstCtxt :: TyFamInstDecl GhcRn -> TcM a -> TcM a -tcAddTyFamInstCtxt decl - = tcAddFamInstCtxt (text "type instance") (tyFamInstDeclName decl) - -tcMkDataFamInstCtxt :: DataFamInstDecl GhcRn -> SDoc -tcMkDataFamInstCtxt decl@(DataFamInstDecl { dfid_eqn = eqn }) - = tcMkFamInstCtxt (pprDataFamInstFlavour decl <+> text "instance") - (unLoc (feqn_tycon eqn)) - -tcAddDataFamInstCtxt :: DataFamInstDecl GhcRn -> TcM a -> TcM a -tcAddDataFamInstCtxt decl - = addErrCtxt (tcMkDataFamInstCtxt decl) - -tcMkFamInstCtxt :: SDoc -> Name -> SDoc -tcMkFamInstCtxt flavour tycon - = hsep [ text "In the" <+> flavour <+> text "declaration for" - , quotes (ppr tycon) ] - -tcAddFamInstCtxt :: SDoc -> Name -> TcM a -> TcM a -tcAddFamInstCtxt flavour tycon thing_inside - = addErrCtxt (tcMkFamInstCtxt flavour tycon) thing_inside - -tcAddClosedTypeFamilyDeclCtxt :: TyCon -> TcM a -> TcM a -tcAddClosedTypeFamilyDeclCtxt tc - = addErrCtxt ctxt +tcAddOpenTyFamInstCtxt :: AssocInstInfo -> TyFamInstDecl GhcRn -> TcM a -> TcM a +tcAddOpenTyFamInstCtxt mb_assoc decl + = tcAddFamInstCtxt flav (tyFamInstDeclName decl) where - ctxt = text "In the equations for closed type family" <+> - quotes (ppr tc) - -dataConCtxt :: NonEmpty (LocatedN Name) -> SDoc -dataConCtxt cons = text "In the definition of data constructor" <> plural (toList cons) - <+> ppr_cons (toList cons) + assoc = case mb_assoc of + NotAssociated -> Nothing + InClsInst { ai_class = cls } -> Just $ classTyCon cls + flav = TyConInstFlavour + { tyConInstFlavour = OpenFamilyFlavour IAmType assoc + , tyConInstIsDefault = False + } -dataConResCtxt :: NonEmpty (LocatedN Name) -> SDoc -dataConResCtxt cons = text "In the result type of data constructor" <> plural (toList cons) - <+> ppr_cons (toList cons) +tcMkDataFamInstCtxt :: AssocInstInfo -> NewOrData -> DataFamInstDecl GhcRn -> ErrCtxtMsg +tcMkDataFamInstCtxt mb_assoc new_or_data (DataFamInstDecl { dfid_eqn = eqn }) + = TyConInstCtxt (unLoc (feqn_tycon eqn)) + (TyConInstFlavour + { tyConInstFlavour = OpenFamilyFlavour (IAmData new_or_data) assoc + , tyConInstIsDefault = False + }) + where + assoc = case mb_assoc of + NotAssociated -> Nothing + InClsInst { ai_class = cls } -> Just $ classTyCon cls -ppr_cons :: [LocatedN Name] -> SDoc -ppr_cons [con] = quotes (ppr con) -ppr_cons cons = interpp'SP cons +tcAddDataFamInstCtxt :: AssocInstInfo -> NewOrData -> DataFamInstDecl GhcRn -> TcM a -> TcM a +tcAddDataFamInstCtxt assoc new_or_data decl + = addErrCtxt (tcMkDataFamInstCtxt assoc new_or_data decl) -classOpCtxt :: Var -> Type -> SDoc -classOpCtxt sel_id tau = sep [text "When checking the class method:", - nest 2 (pprPrefixOcc sel_id <+> dcolon <+> ppr tau)] +tcAddFamInstCtxt :: TyConInstFlavour -> Name -> TcM a -> TcM a +tcAddFamInstCtxt flavour tycon thing_inside + = addErrCtxt (TyConInstCtxt tycon flavour) thing_inside illegalRoleAnnotDecl :: LRoleAnnotDecl GhcRn -> TcM () illegalRoleAnnotDecl (L loc role) @@ -5496,12 +5916,7 @@ addErrTc $ TcRnIllegalRoleAnnotation role addTyConCtxt :: TyCon -> TcM a -> TcM a -addTyConCtxt tc = addTyConFlavCtxt name flav +addTyConCtxt tc = addErrCtxt (TyConDeclCtxt name flav) where name = getName tc flav = tyConFlavour tc - -addRoleAnnotCtxt :: Name -> TcM a -> TcM a -addRoleAnnotCtxt name - = addErrCtxt $ - text "while checking a role annotation for" <+> quotes (ppr name) diff --git a/GHC/Tc/TyCl/Build.hs b/GHC/Tc/TyCl/Build.hs --- a/GHC/Tc/TyCl/Build.hs +++ b/GHC/Tc/TyCl/Build.hs @@ -9,7 +9,8 @@ module GHC.Tc.TyCl.Build ( buildDataCon, buildPatSyn, - TcMethInfo, MethInfo, buildClass, + TcMethInfo, MethInfo, + buildClass, buildAbstractClass, mkNewTyConRhs, newImplicitBinder, newTyConRepName ) where @@ -154,7 +155,7 @@ -> [FieldLabel] -- Field labels -> [TyVar] -- Universals -> [TyCoVar] -- Existentials - -> [InvisTVBinder] -- User-written 'TyVarBinder's + -> [TyVarBinder] -- User-written 'TyVarBinder's -> [EqSpec] -- Equality spec -> KnotTied ThetaType -- Does not include the "stupid theta" -- or the GADT equalities @@ -183,14 +184,15 @@ tag = lookupNameEnv_NF tag_map src_name -- See Note [Constructor tag allocation], fixes #14657 data_con = mkDataCon src_name declared_infix prom_info - src_bangs field_lbls + src_bangs impl_bangs str_marks field_lbls univ_tvs ex_tvs noConcreteTyVars user_tvbs eq_spec ctxt arg_tys res_ty NoPromInfo rep_tycon tag stupid_ctxt dc_wrk dc_rep dc_wrk = mkDataConWorkId work_name data_con - dc_rep = initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) + (dc_rep, impl_bangs, str_marks) = + initUs_ us (mkDataConRep dc_bang_opts fam_envs wrap_name data_con) ; traceIf (text "buildDataCon 2" <+> ppr src_name) ; return data_con } @@ -290,26 +292,14 @@ -> [TyConBinder] -- Of the tycon -> [Role] -> [FunDep TyVar] -- Functional dependencies - -- Super classes, associated types, method info, minimal complete def. - -- This is Nothing if the class is abstract. - -> Maybe (KnotTied ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef) + -> KnotTied ThetaType -- Superclasess + -> [ClassATItem] -- Associated types + -> [KnotTied MethInfo] -- Methods + -> ClassMinimalDef -- Minimal complete definition + -> Bool -- True <=> is a unary class -> TcRnIf m n Class -buildClass tycon_name binders roles fds Nothing - = fixM $ \ rec_clas -> -- Only name generation inside loop - do { traceIf (text "buildClass") - - ; tc_rep_name <- newTyConRepName tycon_name - ; let univ_tvs = binderVars binders - tycon = mkClassTyCon tycon_name binders roles - AbstractTyCon - rec_clas tc_rep_name - result = mkAbstractClass tycon_name univ_tvs fds tycon - ; traceIf (text "buildClass" <+> ppr tycon) - ; return result } - -buildClass tycon_name binders roles fds - (Just (sc_theta, at_items, sig_stuff, mindef)) +buildClass tycon_name binders roles fds sc_theta at_items sig_stuff mindef unary_class = fixM $ \ rec_clas -> -- Only name generation inside loop do { traceIf (text "buildClass") @@ -332,22 +322,11 @@ -- (We used to call them D_C, but now we can have two different -- superclasses both called C!) - ; let use_newtype = isSingleton (sc_theta ++ op_tys) - -- Use a newtype if the data constructor - -- (a) has exactly one value field - -- i.e. exactly one operation or superclass taken together - -- (b) that value is of lifted type (which they always are, because - -- we box equality superclasses) - -- See Note [Class newtypes and equality predicates] - -- - -- In the case of - -- class C a => D a - -- we use a newtype, but with one superclass and no arguments - args = sc_sel_names ++ op_names + ; let args = sc_sel_names ++ op_names op_tys = [ty | (_,ty,_) <- sig_stuff] op_names = [op | (op,_,_) <- sig_stuff] rec_tycon = classTyCon rec_clas - univ_bndrs = tyConInvisTVBinders binders + univ_bndrs = tyVarSpecToBinders $ tyConInvisTVBinders binders univ_tvs = binderVars univ_bndrs bang_opts = FixedBangOpts (map (const HsLazy) args) @@ -369,17 +348,16 @@ rec_tycon (mkTyConTagMap rec_tycon) - ; rhs <- case () of - _ | use_newtype - -> mkNewTyConRhs tycon_name rec_tycon dict_con - | isCTupleTyConName tycon_name - -> return (TupleTyCon { data_con = dict_con - , tup_sort = ConstraintTuple }) - | otherwise - -> return (mkDataTyConRhs [dict_con]) + ; let rhs | unary_class + = UnaryClassTyCon dict_con + | isCTupleTyConName tycon_name + = TupleTyCon { data_con = dict_con + , tup_sort = ConstraintTuple } + | otherwise + = mkDataTyConRhs [dict_con] - ; let { tycon = mkClassTyCon tycon_name binders roles - rhs rec_clas tc_rep_name + tycon = mkClassTyCon tycon_name binders roles + rhs rec_clas tc_rep_name -- A class can be recursive, and in the case of newtypes -- this matters. For example -- class C a where { op :: C b => a -> b -> Int } @@ -389,14 +367,14 @@ -- newtype like a synonym, but that will lead to an infinite -- type] - ; result = mkClass tycon_name univ_tvs fds - sc_theta sc_sel_ids at_items - op_items mindef tycon - } + result = mkClass tycon_name univ_tvs fds + sc_theta sc_sel_ids at_items + op_items mindef tycon + ; traceIf (text "buildClass" <+> ppr tycon) ; return result } where - no_bang = mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict + no_bang = HsSrcBang NoSourceText NoSrcUnpack NoSrcStrict mk_op_item :: Class -> TcMethInfo -> TcRnIf n m ClassOpItem mk_op_item rec_clas (op_name, _, dm_spec) @@ -414,23 +392,24 @@ = do { dm_name <- newImplicitBinderLoc op_name mkDefaultMethodOcc loc ; return (Just (dm_name, GenericDM dm_ty)) } -{- -Note [Class newtypes and equality predicates] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - class (a ~ F b) => C a b where - op :: a -> b +buildAbstractClass :: Name + -> [TyConBinder] + -> [Role] + -> [FunDep TyVar] + -> TcRnIf m n Class -We cannot represent this by a newtype, even though it's not -existential, because there are two value fields (the equality -predicate and op. See #2238 +buildAbstractClass tycon_name binders roles fds + = fixM $ \ rec_clas -> -- Only name generation inside loop + do { traceIf (text "buildClass") -Moreover, - class (a ~ F b) => C a b where {} -Here we can't use a newtype either, even though there is only -one field, because equality predicates are unboxed, and classes -are boxed. --} + ; tc_rep_name <- newTyConRepName tycon_name + ; let univ_tvs = binderVars binders + tycon = mkClassTyCon tycon_name binders roles + AbstractTyCon + rec_clas tc_rep_name + result = mkAbstractClass tycon_name univ_tvs fds tycon + ; traceIf (text "buildClass" <+> ppr tycon) + ; return result } newImplicitBinder :: Name -- Base name -> (OccName -> OccName) -- Occurrence name modifier diff --git a/GHC/Tc/TyCl/Class.hs b/GHC/Tc/TyCl/Class.hs --- a/GHC/Tc/TyCl/Class.hs +++ b/GHC/Tc/TyCl/Class.hs @@ -53,7 +53,6 @@ import GHC.Driver.DynFlags -import GHC.Types.Error import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env @@ -344,7 +343,7 @@ where -- By default require all methods without a default implementation defMindef :: ClassMinimalDef - defMindef = mkAnd [ noLocA (mkVar name) + defMindef = mkAnd [ noLocA (mkVar (noLocA name)) | (name, _, Nothing) <- op_info ] instantiateMethod :: Class -> TcId -> [TcType] -> TcType @@ -402,8 +401,8 @@ findMinimalDef = firstJusts . map toMinimalDef where toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef - toMinimalDef (L _ (MinimalSig _ (L _ bf))) = Just (fmap unLoc bf) - toMinimalDef _ = Nothing + toMinimalDef (L _ (MinimalSig _ (L _ bf))) = Just bf + toMinimalDef _ = Nothing {- Note [Polymorphic methods] @@ -464,23 +463,19 @@ badDmPrag sel_id prag = addErrTc (TcRnDefaultMethodForPragmaLacksBinding sel_id prag) -instDeclCtxt1 :: LHsSigType GhcRn -> SDoc +instDeclCtxt1 :: LHsSigType GhcRn -> ErrCtxtMsg instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + = InstDeclErrCtxt (Left $ getLHsInstDeclHead hs_inst_ty) -instDeclCtxt2 :: Type -> SDoc +instDeclCtxt2 :: Type -> ErrCtxtMsg instDeclCtxt2 dfun_ty = instDeclCtxt3 cls tys where (_,_,cls,tys) = tcSplitDFunTy dfun_ty -instDeclCtxt3 :: Class -> [Type] -> SDoc +instDeclCtxt3 :: Class -> [Type] -> ErrCtxtMsg instDeclCtxt3 cls cls_tys - = inst_decl_ctxt (ppr (mkClassPred cls cls_tys)) - -inst_decl_ctxt :: SDoc -> SDoc -inst_decl_ctxt doc = hang (text "In the instance declaration for") - 2 (quotes doc) + = InstDeclErrCtxt (Right $ mkClassPred cls cls_tys) tcATDefault :: SrcSpan -> Subst diff --git a/GHC/Tc/TyCl/Instance.hs b/GHC/Tc/TyCl/Instance.hs --- a/GHC/Tc/TyCl/Instance.hs +++ b/GHC/Tc/TyCl/Instance.hs @@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -43,48 +44,53 @@ import GHC.Tc.TyCl.Build import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Class( AssocInstInfo(..), isNotAssociated ) -import GHC.Core.Multiplicity -import GHC.Core.InstEnv import GHC.Tc.Instance.Family -import GHC.Core.FamInstEnv + import GHC.Tc.Deriv import GHC.Tc.Utils.Env import GHC.Tc.Gen.HsType import GHC.Tc.Utils.Unify +import GHC.Tc.Types.Evidence + import GHC.Builtin.Names ( unsatisfiableIdName ) -import GHC.Core ( Expr(..), mkApps, mkVarApps, mkLams ) + +import GHC.Core ( Expr(..), mkVarApps ) import GHC.Core.Make ( nO_METHOD_BINDING_ERROR_ID ) -import GHC.Core.Unfold.Make ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) +import GHC.Core.Unfold.Make ( mkDFunUnfolding ) +import GHC.Core.FamInstEnv import GHC.Core.Type -import GHC.Core.SimpleOpt +import GHC.Core.Multiplicity +import GHC.Core.InstEnv import GHC.Core.Predicate( classMethodInstTy ) -import GHC.Tc.Types.Evidence import GHC.Core.TyCon import GHC.Core.Coercion.Axiom import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.Class -import GHC.Types.Error + import GHC.Types.Var as Var import GHC.Types.Var.Env import GHC.Types.Var.Set -import GHC.Data.Bag import GHC.Types.Basic import GHC.Types.Fixity -import GHC.Driver.DynFlags -import GHC.Driver.Ppr -import GHC.Utils.Logger -import GHC.Data.FastString import GHC.Types.Id import GHC.Types.SourceFile import GHC.Types.SourceText -import GHC.Data.List.SetOps import GHC.Types.Name import GHC.Types.Name.Set +import GHC.Types.SrcLoc + +import GHC.Driver.DynFlags +import GHC.Driver.Ppr + +import GHC.Utils.Logger import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Types.SrcLoc import GHC.Utils.Misc + +import GHC.Data.FastString +import GHC.Data.List.SetOps +import GHC.Data.Bag import GHC.Data.BooleanFormula ( isUnsatisfied ) import qualified GHC.LanguageExtensions as LangExt @@ -184,6 +190,8 @@ Note [ClassOp/DFun selection] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This important Note explains how DFunIds and ClassOps work. + One thing we see a lot is stuff like op2 (df d1 d2) where 'op2' is a ClassOp and 'df' is DFun. Now, we could inline *both* @@ -218,6 +226,12 @@ let d = df d1 d2 in ...(op2 d)...(op1 d)... + * ClassOps have no unfolding; they work /only/ through their RULE. + But a ClassOp might be called with no arguments, or with an argument that + the rule doesn't fire on. So each ClassOp does get an executable top-level + definition, injected by GHC.Iface.Tidy.getClassImplicitBinds, which uses + `GHC.Types.Id.Make.mkDictSelRhs` to make the code. + Note [Single-method classes] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the class has just one method (or, more accurately, just one element @@ -352,10 +366,9 @@ Conclusion: when typechecking the methods in a C [a] instance, we want to treat the 'a' as an *existential* type variable, in the sense described -by Note [Binding when looking up instances]. That is why isOverlappableTyVar -responds True to an InstSkol, which is the kind of skolem we use in -tcInstDecl2. - +by Note [Super skolems: binding when looking up instances] in GHC.Core.InstEnv +That is why isOverlappableTyVar responds True to an InstSkol, which is the kind +of skolem we use in tcInstDecl2. Note [Tricky type variable scoping] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -419,8 +432,8 @@ -> [LDerivDecl GhcRn] -> TcM (TcGblEnv, [InstInfo GhcRn], HsValBinds GhcRn) tcInstDeclsDeriv deriv_infos derivds - = do th_stage <- getStage -- See Note [Deriving inside TH brackets] - if isBrackStage th_stage + = do th_lvl <- getThLevel -- See Note [Deriving inside TH brackets] + if isBrackLevel th_lvl then do { gbl_env <- getGblEnv ; return (gbl_env, bagToList emptyBag, emptyValBindsOut) } else do { (tcg_env, info_bag, valbinds) <- tcDeriving deriv_infos derivds @@ -496,7 +509,8 @@ do { dfun_ty <- tcHsClsInstType (InstDeclCtxt False) hs_ty ; let (tyvars, theta, clas, inst_tys) = tcSplitDFunTy dfun_ty -- NB: tcHsClsInstType does checkValidInstance - ; skol_info <- mkSkolemInfo (mkClsInstSkol clas inst_tys) + ; skol_info <- mkSkolemInfo (InstSkol IsClsInst pSizeZero) + -- pSizeZero: here the size part of InstSkol is irrelevant ; (subst, skol_tvs) <- tcInstSkolTyVars skol_info tyvars ; let tv_skol_prs = [ (tyVarName tv, skol_tv) | (tv, skol_tv) <- tyvars `zip` skol_tvs ] @@ -507,7 +521,7 @@ fst $ splitForAllForAllTyBinders dfun_ty visible_skol_tvs = drop n_inferred skol_tvs - ; traceTc "tcLocalInstDecl 1" (ppr dfun_ty $$ ppr (invisibleTyBndrCount dfun_ty) $$ ppr skol_tvs) + ; traceTc "tcLocalInstDecl 1" (ppr dfun_ty $$ ppr (invisibleBndrCount dfun_ty) $$ ppr skol_tvs) -- Next, process any associated types. ; (datafam_stuff, tyfam_insts) @@ -591,8 +605,8 @@ -- "type instance"; open type families only -- See Note [Associated type instances] tcTyFamInstDecl mb_clsinfo (L loc decl@(TyFamInstDecl { tfid_eqn = eqn })) - = setSrcSpanA loc $ - tcAddTyFamInstCtxt decl $ + = setSrcSpanA loc $ + tcAddOpenTyFamInstCtxt mb_clsinfo decl $ do { let fam_lname = feqn_tycon eqn ; fam_tc <- tcLookupLocatedTyCon fam_lname ; tcFamInstDeclChecks mb_clsinfo IAmType fam_tc @@ -700,11 +714,11 @@ , dd_cons = hs_cons , dd_kindSig = m_ksig , dd_derivs = derivs } }})) - = setSrcSpanA loc $ - tcAddDataFamInstCtxt decl $ + = setSrcSpanA loc $ + tcAddDataFamInstCtxt mb_clsinfo new_or_data decl $ do { fam_tc <- tcLookupLocatedTyCon lfam_name - ; tcFamInstDeclChecks mb_clsinfo IAmData fam_tc + ; tcFamInstDeclChecks mb_clsinfo (IAmData new_or_data) fam_tc -- Check that the family declaration is for the right kind ; checkTc (isDataFamilyTyCon fam_tc) $ @@ -714,10 +728,9 @@ -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; skol_info <- mkSkolemInfo FamInstSkol - ; let new_or_data = dataDefnConsNewOrData hs_cons ; (qtvs, non_user_tvs, pats, tc_res_kind, stupid_theta) <- tcDataFamInstHeader mb_clsinfo skol_info fam_tc outer_bndrs fixity - hs_ctxt hs_pats m_ksig new_or_data + hs_ctxt hs_pats m_ksig hs_cons -- Eta-reduce the axiom if possible -- Quite tricky: see Note [Implementing eta reduction for data families] @@ -742,8 +755,7 @@ -- we did it before the "extra" tvs from etaExpandAlgTyCon -- would always be eta-reduced -- - ; let flav = newOrDataToFlavour new_or_data - ; (extra_tcbs, tc_res_kind) <- etaExpandAlgTyCon flav skol_info full_tcbs tc_res_kind + ; (extra_tcbs, tc_res_kind) <- etaExpandAlgTyCon skol_info full_tcbs tc_res_kind -- Check the result kind; it may come from a user-written signature. -- See Note [Datatype return kinds] in GHC.Tc.TyCl point 4(a) @@ -845,11 +857,15 @@ Just $ DerivInfo { di_rep_tc = rep_tc , di_scoped_tvs = scoped_tvs , di_clauses = preds - , di_ctxt = tcMkDataFamInstCtxt decl } + , di_ctxt = tcMkDataFamInstCtxt mb_clsinfo new_or_data decl + } ; fam_inst <- newFamInst (DataFamilyInst rep_tc) axiom ; return (fam_inst, m_deriv_info) } where + + new_or_data = dataDefnConsNewOrData hs_cons + eta_reduce :: TyCon -> [Type] -> ([Type], [TyConBinder]) -- See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom -- Splits the incoming patterns into two: the [TyVar] @@ -917,8 +933,7 @@ tcDataFamInstHeader :: AssocInstInfo -> SkolemInfo -> TyCon -> HsOuterFamEqnTyVarBndrs GhcRn -> LexicalFixity -> Maybe (LHsContext GhcRn) - -> HsFamEqnPats GhcRn -> Maybe (LHsKind GhcRn) - -> NewOrData + -> HsFamEqnPats GhcRn -> Maybe (LHsKind GhcRn) -> DataDefnCons (LConDecl GhcRn) -> TcM ([TcTyVar], TyVarSet, [TcType], TcKind, TcThetaType) -- All skolem TcTyVars, all zonked so it's clear what the free vars are -- The "header" of a data family instance is the part other than @@ -926,7 +941,7 @@ -- e.g. data instance D [a] :: * -> * where ... -- Here the "header" is the bit before the "where" tcDataFamInstHeader mb_clsinfo skol_info fam_tc hs_outer_bndrs fixity - hs_ctxt hs_pats m_ksig new_or_data + hs_ctxt hs_pats m_ksig hs_cons = do { traceTc "tcDataFamInstHeader {" (ppr fam_tc <+> ppr hs_pats) ; (tclvl, wanted, (outer_bndrs, (stupid_theta, lhs_ty, master_res_kind, instance_res_kind))) <- pushLevelAndSolveEqualitiesX "tcDataFamInstHeader" $ @@ -942,16 +957,17 @@ -- with its parent class ; addConsistencyConstraints mb_clsinfo lhs_ty - -- Add constraints from the result signature - ; res_kind <- tc_kind_sig m_ksig - - -- Do not add constraints from the data constructors - -- See Note [Kind inference for data family instances] + -- Add constraints from the data constructors + -- Fix #25611 + -- See DESIGN CHOICE in Note [Kind inference for data family instances] + ; when is_H98_or_newtype $ kcConDecls lhs_applied_kind hs_cons -- Check that the result kind of the TyCon applied to its args -- is compatible with the explicit signature (or Type, if there -- is none) - ; let hs_lhs = nlHsTyConApp NotPromoted fixity (getName fam_tc) hs_pats + ; let hs_lhs = nlHsTyConApp NotPromoted fixity (noUserRdr $ getName fam_tc) hs_pats + -- Add constraints from the result signature + ; res_kind <- tc_kind_sig m_ksig ; _ <- unifyKind (Just . HsTypeRnThing $ unLoc hs_lhs) lhs_applied_kind res_kind ; traceTc "tcDataFamInstHeader" $ @@ -1003,9 +1019,16 @@ where fam_name = tyConName fam_tc data_ctxt = DataKindCtxt fam_name + new_or_data = dataDefnConsNewOrData hs_cons + is_H98_or_newtype = case hs_cons of + NewTypeCon{} -> True + DataTypeCons _ cons -> all isH98 cons + isH98 (L _ (ConDeclH98 {})) = True + isH98 _ = False -- See Note [Implementation of UnliftedNewtypes] in GHC.Tc.TyCl, families (2), - -- and Note [Implementation of UnliftedDatatypes]. + -- Note [Implementation of UnliftedDatatypes] + -- and Note [Defaulting result kind of newtype/data family instance]. tc_kind_sig Nothing = do { unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes ; unlifted_datatypes <- xoptM LangExt.UnliftedDatatypes @@ -1031,6 +1054,21 @@ Thus: skolemise away. cf. GHC.Tc.Utils.Unify.tcTopSkolemise Examples in indexed-types/should_compile/T12369 +Note [Defaulting result kind of newtype/data family instance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It is tempting to let `tc_kind_sig` just return `newOpenTypeKind` +even without `-XUnliftedNewtypes`, but we rely on `tc_kind_sig` to +constrain the result kind of a newtype instance to `Type`. +Consider the following example: + + -- no UnliftedNewtypes + data family D :: k -> k + newtype instance D a = MkIntD a + +`tc_kind_sig` defaulting to `newOpenTypeKind` would result in `D a` +having kind `forall r. TYPE r` instead of `Type`, which would be +rejected validity checking. The same applies to Data Instances. + Note [Implementing eta reduction for data families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider @@ -1185,32 +1223,49 @@ by the data instances -- and hence we /can/ specialise T's kind differently in different GADT data constructors. -SHORT SUMMARY: in a data instance decl, it's not clear whether kind +SHORT SUMMARY: In a data instance decl, it's not clear whether kind constraints arising from the data constructors should be considered local to the (GADT) data /constructor/ or should apply to the entire data instance. -DESIGN CHOICE: in data/newtype family instance declarations, we ignore -the /data constructor/ declarations altogether, looking only at the -data instance /header/. +DESIGN CHOICE: In a data/newtype family instance declaration: +* We take account of the data constructors (via `kcConDecls`) for: + * Haskell-98 style data instance declarations + * All newtype instance declarations + For Haskell-98 style declarations, there is no GADT refinement. And for + GADT-style newtype declarations, no GADT matching is allowed anyway, + so it's just a syntactic difference from Haskell-98. +* We /ignore/ the data constructors for: + * GADT-style data instance declarations + Here, the instance kinds are influenced only by the header. + +This choice is implemented by the guarded call to `kcConDecls` in +`tcDataFamInstHeader`. + Observations: -* This choice is simple to describe, as well as simple to implement. - For a data/newtype instance decl, the instance kinds are influenced - /only/ by the header. +* With `UnliftedNewtypes` or `UnliftedDatatypes`, looking at the data + constructors is necessary to infer the kind of the result type for + certain cases. Otherwise, additional kind signatures are required. + Consider the following example in #25611: -* We could treat Haskell-98 style data-instance decls differently, by - taking the data constructors into account, since there are no GADT - issues. But we don't, for simplicity, and because it means you can - understand the data type instance by looking only at the header. + data family Fix :: (k -> Type) -> k + newtype instance Fix f = In { out :: f (Fix f) } -* Newtypes can be declared in GADT syntax, but they can't do GADT-style - specialisation, so like Haskell-98 definitions we could take the - data constructors into account. Again we don't, for the same reason. + If we are not looking at the data constructors: + * Without `UnliftedNewtypes`, it is accepted since `Fix f` is defaulted + to `Type`. + * But with `UnliftedNewtypes`, `Fix f` is defaulted to `TYPE r` where + `r` is not scoped over the data constructor. Then the header `Fix f :: TYPE r` + will fail to kind unify with `f (Fix f) :: Type`. -So for now at least, we keep the simplest choice. See #18891 and !4419 -for more discussion of this issue. + Hence, we need to look at the data constructor to infer `Fix f :: Type` + for this newtype instance. +This DESIGN CHOICE strikes a balance between well-rounded kind inference +and implementation simplicity. See #25611, #18891, and !4419 for more +discussion of this issue. + Kind inference for data types (Xie et al) https://arxiv.org/abs/1911.06153 takes a slightly different approach. -} @@ -1338,13 +1393,8 @@ inst_tv_tys = mkTyVarTys inst_tyvars arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps inst_tv_tys - is_newtype = isNewTyCon class_tc dfun_id_w_prags = addDFunPrags dfun_id sc_meth_ids - dfun_spec_prags - | is_newtype = SpecPrags [] - | otherwise = SpecPrags spec_inst_prags - -- Newtype dfuns just inline unconditionally, - -- so don't attempt to specialise them + dfun_spec_prags = SpecPrags spec_inst_prags export = ABE { abe_wrap = idHsWrapper , abe_poly = dfun_id_w_prags @@ -1377,18 +1427,10 @@ -- the DFunId rather than from the skolem pieces that the typechecker -- is messing with. addDFunPrags dfun_id sc_meth_ids - | is_newtype - = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity defaultSimpleOpts StableSystemSrc 0 con_app - `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 } - | otherwise = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args `setInlinePragma` dfunInlinePragma + -- NB: mkDFunUnfolding takes care of unary classes where - con_app = mkLams dfun_bndrs $ - mkApps (Var (dataConWrapId dict_con)) dict_args - -- This application will satisfy the Core invariants - -- from Note [Representation polymorphism invariants] in GHC.Core, - -- because typeclass method types are never unlifted. dict_args = map Type inst_tys ++ [mkVarApps (Var id) dfun_bndrs | id <- sc_meth_ids] @@ -1397,10 +1439,9 @@ dfun_bndrs = dfun_tvs ++ ev_ids clas_tc = classTyCon clas dict_con = tyConSingleDataCon clas_tc - is_newtype = isNewTyCon clas_tc wrapId :: HsWrapper -> Id -> HsExpr GhcTc -wrapId wrapper id = mkHsWrap wrapper (HsVar noExtField (noLocA id)) +wrapId wrapper id = mkHsWrap wrapper (mkHsVar (noLocA id)) {- Note [Typechecking plan for instance declarations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1776,7 +1817,7 @@ -> TcM ([Id], LHsBinds GhcTc, Bag Implication) -- The returned inst_meth_ids all have types starting -- forall tvs. theta => ... -tcMethods skol_info dfun_id clas tyvars dfun_ev_vars inst_tys +tcMethods _skol_info dfun_id clas tyvars dfun_ev_vars inst_tys dfun_ev_binds (spec_inst_prags, prag_fn) op_items (InstBindings { ib_binds = binds , ib_tyvars = lexical_tvs @@ -1812,7 +1853,7 @@ tc_item :: ClassOpItem -> TcM (Id, LHsBind GhcTc, Maybe Implication) tc_item (sel_id, dm_info) | Just (user_bind, bndr_loc, prags) <- findMethodBind (idName sel_id) binds prag_fn - = tcMethodBody skol_info clas tyvars dfun_ev_vars inst_tys + = tcMethodBody False clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived hs_sig_fn spec_inst_prags prags sel_id user_bind bndr_loc @@ -1848,7 +1889,8 @@ Just (dm_name, dm_spec) -> do { (meth_bind, inline_prags) <- mkDefMethBind inst_loc dfun_id clas sel_id dm_name dm_spec - ; tcMethodBody skol_info clas tyvars dfun_ev_vars inst_tys + ; tcMethodBody (is_vanilla_dm dm_spec) + clas tyvars dfun_ev_vars inst_tys dfun_ev_binds is_derived hs_sig_fn spec_inst_prags inline_prags sel_id meth_bind inst_loc } @@ -1889,7 +1931,7 @@ -- -- See Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors, -- point (D). - whenIsJust (isUnsatisfied methodExists (classMinimalDef clas)) $ + whenIsJust (isUnsatisfied (methodExists . unLoc) (classMinimalDef clas)) $ warnUnsatisfiedMinimalDefinition methodExists meth = isJust (findMethodBind meth binds prag_fn) @@ -1904,6 +1946,12 @@ cls_meth_nms = map (idName . fst) op_items mismatched_meths = bind_nms `minusList` cls_meth_nms + is_vanilla_dm :: DefMethSpec ty -> Bool + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve + is_vanilla_dm VanillaDM = True + is_vanilla_dm (GenericDM {}) = False + {- Note [Mismatched class methods and associated type families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1973,25 +2021,28 @@ -} ------------------------ -tcMethodBody :: SkolemInfoAnon +tcMethodBody :: Bool -- True <=> This is a vanilla default method + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve -> Class -> [TcTyVar] -> [EvVar] -> [TcType] -> TcEvBinds -> Bool -> HsSigFun -> [LTcSpecPrag] -> [LSig GhcRn] -> Id -> LHsBind GhcRn -> SrcSpan -> TcM (TcId, LHsBind GhcTc, Maybe Implication) -tcMethodBody skol_info clas tyvars dfun_ev_vars inst_tys - dfun_ev_binds is_derived - sig_fn spec_inst_prags prags - sel_id (L bind_loc meth_bind) bndr_loc +tcMethodBody is_vanilla_dm clas tyvars dfun_ev_vars inst_tys + dfun_ev_binds is_derived + sig_fn spec_inst_prags prags + sel_id (L bind_loc meth_bind) bndr_loc = add_meth_ctxt $ do { traceTc "tcMethodBody" (ppr sel_id <+> ppr (idType sel_id) $$ ppr bndr_loc) + ; let skol_info = MethSkol meth_name is_vanilla_dm ; (global_meth_id, local_meth_id) <- setSrcSpan bndr_loc $ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id ; let lm_bind = meth_bind { fun_id = L (noAnnSrcSpan bndr_loc) - (idName local_meth_id) } + (idName local_meth_id) } -- Substitute the local_meth_name for the binder -- NB: the binding is always a FunBind @@ -2002,7 +2053,17 @@ tcMethodBodyHelp sig_fn sel_id local_meth_id (L bind_loc lm_bind) ; global_meth_id <- addInlinePrags global_meth_id prags - ; spec_prags <- tcSpecPrags global_meth_id prags + ; spec_prags <- tcExtendIdEnv1 meth_name global_meth_id $ + -- tcExtendIdEnv1: tricky point: a SPECIALISE pragma in prags + -- mentions sel_name but the pragma is really for global_meth_id. + -- So we bind sel_name to global_meth_id, just in the pragmas. + -- Example: + -- instance C [a] where + -- op :: forall b. Ord b => b -> a -> a + -- {-# SPECIALISE op @Int #-} + -- The specialisation is for the `op` for this instance decl, not + -- for the global selector-id, of course. + tcSpecPrags global_meth_id prags ; let specs = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags export = ABE { abe_poly = global_meth_id @@ -2021,11 +2082,13 @@ ; return (global_meth_id, L bind_loc full_bind, Just meth_implic) } where + meth_name = idName sel_id + -- For instance decls that come from deriving clauses -- we want to print out the full source code if there's an error -- because otherwise the user won't see the code at all add_meth_ctxt thing - | is_derived = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys) thing + | is_derived = addLandmarkErrCtxt (DerivBindCtxt sel_id clas inst_tys) thing | otherwise = thing tcMethodBodyHelp :: HsSigFun -> Id -> TcId @@ -2114,15 +2177,11 @@ poly_meth_ty = mkSpecSigmaTy tyvars theta local_meth_ty theta = map idType dfun_ev_vars -methSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> ZonkM (TidyEnv, SDoc) +methSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) methSigCtxt sel_name sig_ty meth_ty env0 = do { (env1, sig_ty) <- zonkTidyTcType env0 sig_ty ; (env2, meth_ty) <- zonkTidyTcType env1 meth_ty - ; let msg = hang (text "When checking that instance signature for" <+> quotes (ppr sel_name)) - 2 (vcat [ text "is more general than its signature in the class" - , text "Instance sig:" <+> ppr sig_ty - , text " Class sig:" <+> ppr meth_ty ]) - ; return (env2, msg) } + ; return (env2, MethSigCtxt sel_name sig_ty meth_ty) } {- Note [Instance method signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2178,7 +2237,7 @@ -- * spec_prags_from_inst: derived from {-# SPECIALISE instance :: #-} -- These ones have the dfun inside, but [perhaps surprisingly] -- the correct wrapper. - -- See Note [Handling SPECIALISE pragmas] in GHC.Tc.Gen.Bind + -- See Note [Handling old-form SPECIALISE pragmas] in GHC.Tc.Gen.Bind mk_meth_spec_prags meth_id spec_inst_prags spec_prags_for_me = SpecPrags (spec_prags_for_me ++ spec_prags_from_inst) where @@ -2272,12 +2331,6 @@ type_to_hs_type = parenthesizeHsType appPrec . noLocA . XHsType ---------------------- -derivBindCtxt :: Id -> Class -> [Type ] -> SDoc -derivBindCtxt sel_id clas tys - = vcat [ text "When typechecking the code for" <+> quotes (ppr sel_id) - , nest 2 (text "in a derived instance for" - <+> quotes (pprClassPred clas tys) <> colon) - , nest 2 $ text "To see the code I am typechecking, use -ddump-deriv" ] warnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM () warnUnsatisfiedMinimalDefinition mindef @@ -2612,12 +2665,10 @@ ------------------------------ tcSpecInst :: Id -> Sig GhcRn -> TcM TcSpecPrag tcSpecInst dfun_id prag@(SpecInstSig _ hs_ty) - = addErrCtxt (spec_ctxt prag) $ + = addErrCtxt (SpecPragmaCtxt prag) $ do { spec_dfun_ty <- tcHsClsInstType SpecInstCtxt hs_ty ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty ; return (SpecPrag dfun_id co_fn defaultInlinePragma) } - where - spec_ctxt prag = hang (text "In the pragma:") 2 (ppr prag) tcSpecInst _ _ = panic "tcSpecInst" @@ -2629,16 +2680,12 @@ ************************************************************************ -} -instDeclCtxt1 :: LHsSigType GhcRn -> SDoc +instDeclCtxt1 :: LHsSigType GhcRn -> ErrCtxtMsg instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + = InstDeclErrCtxt $ Left $ getLHsInstDeclHead hs_inst_ty -instDeclCtxt2 :: Type -> SDoc +instDeclCtxt2 :: Type -> ErrCtxtMsg instDeclCtxt2 dfun_ty - = inst_decl_ctxt (ppr head_ty) + = InstDeclErrCtxt $ Right $ head_ty where (_,_,head_ty) = tcSplitQuantPredTy dfun_ty - -inst_decl_ctxt :: SDoc -> SDoc -inst_decl_ctxt doc = hang (text "In the instance declaration for") - 2 (quotes doc) diff --git a/GHC/Tc/TyCl/PatSyn.hs b/GHC/Tc/TyCl/PatSyn.hs --- a/GHC/Tc/TyCl/PatSyn.hs +++ b/GHC/Tc/TyCl/PatSyn.hs @@ -37,11 +37,13 @@ import GHC.Tc.TyCl.Build import GHC.Core.Multiplicity -import GHC.Core.Type ( typeKind, tidyForAllTyBinders, tidyTypes, tidyType, isManyTy, mkTYPEapp ) +import GHC.Core.Type ( typeKind, isManyTy, mkTYPEapp ) import GHC.Core.TyCo.Subst( extendTvSubstWithClone ) +import GHC.Core.TyCo.Tidy( tidyForAllTyBinders, tidyTypes, tidyType ) import GHC.Core.Predicate import GHC.Types.Name +import GHC.Types.Name.Reader import GHC.Types.Name.Set import GHC.Types.SrcLoc import GHC.Core.PatSyn @@ -85,9 +87,7 @@ -> TcM (LHsBinds GhcTc, TcGblEnv) tcPatSynDecl (L loc psb@(PSB { psb_id = L _ name })) sig_fn prag_fn = setSrcSpanA loc $ - addErrCtxt (text "In the declaration for pattern synonym" - <+> quotes (ppr name)) $ - -- See Note [Pattern synonym error recovery] + addErrCtxt (PatSynDeclCtxt name) $ case sig_fn name of Nothing -> tcInferPatSynDecl psb prag_fn Just (TcPatSynSig patsig) -> tcCheckPatSynDecl psb patsig prag_fn @@ -154,7 +154,7 @@ ; ((univ_tvs, req_dicts, ev_binds, _), residual) <- captureConstraints $ - simplifyInfer tclvl NoRestrictions [] named_taus wanted + simplifyInfer TopLevel tclvl NoRestrictions [] named_taus wanted ; top_ev_binds <- checkNoErrs (simplifyTop residual) ; addTopEvBinds top_ev_binds $ @@ -184,7 +184,7 @@ ; doNotQuantifyTyVars dvs err_ctx ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs) - ; rec_fields <- lookupConstructorFields name + ; rec_fields <- lookupConstructorFields $ noUserRdr name ; tc_patsyn_finish lname dir is_infix lpat' prag_fn (mkTyVarBinders InferredSpec univ_tvs , req_theta, ev_binds, req_dicts) @@ -204,15 +204,15 @@ hetero_tys = [k1, k2, ty1, ty2] = case r of ReprEq | is_homo - -> Just ( mkClassPred coercibleClass homo_tys - , evDataConApp coercibleDataCon homo_tys eq_con_args ) + -> Just ( mkClassPred coercibleClass homo_tys + , evDictApp coercibleClass homo_tys eq_con_args ) | otherwise -> Nothing NomEq | is_homo - -> Just ( mkClassPred eqClass homo_tys - , evDataConApp eqDataCon homo_tys eq_con_args ) + -> Just ( mkClassPred eqClass homo_tys + , evDictApp eqClass homo_tys eq_con_args ) | otherwise - -> Just ( mkClassPred heqClass hetero_tys - , evDataConApp heqDataCon hetero_tys eq_con_args ) + -> Just ( mkClassPred heqClass hetero_tys + , evDictApp heqClass hetero_tys eq_con_args ) | otherwise = Just (pred, EvExpr (evId ev_id)) @@ -294,7 +294,7 @@ $bP :: forall a b. (a ~# Maybe b, Eq b) => [b] -> X a and that is bad because (a ~# Maybe b) is not a predicate type -(see Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep +(see Note [Types for coercions, predicates, and evidence] in GHC.Core.Predicate and is not implicitly instantiated. So in mkProvEvidence we lift (a ~# b) to (a ~ b). Tiresome, and @@ -454,7 +454,7 @@ ; traceTc "tcCheckPatSynDecl }" $ ppr name - ; rec_fields <- lookupConstructorFields name + ; rec_fields <- lookupConstructorFields $ noUserRdr name ; tc_patsyn_finish lname dir is_infix lpat' prag_fn (skol_univ_bndrs, skol_req_theta, ev_binds, req_dicts) (skol_ex_bndrs, mkTyVarTys ex_tvs', skol_prov_theta, prov_dicts) @@ -642,7 +642,7 @@ -> ([Name], Bool) collectPatSynArgInfo details = case details of - PrefixCon _ names -> (map unLoc names, False) + PrefixCon names -> (map unLoc names, False) InfixCon name1 name2 -> (map unLoc [name1, name2], True) RecCon names -> (map (unLoc . recordPatSynPatVar) names, False) @@ -954,7 +954,7 @@ (EmptyLocalBinds noExtField) args = case details of - PrefixCon _ args -> args + PrefixCon args -> args InfixCon arg1 arg2 -> [arg1, arg2] RecCon args -> map recordPatSynPatVar args @@ -1000,7 +1000,8 @@ lhsVars = mkNameSet (map unLoc args) -- Make a prefix con for prefix and infix patterns for simplicity - mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn] + mkPrefixConExpr :: LocatedN (WithUserRdr Name) + -> [LPat GhcRn] -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkPrefixConExpr lcon@(L loc _) pats = do { exprs <- mapM go pats @@ -1008,7 +1009,8 @@ ; return (unLoc $ mkHsApps con exprs) } - mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn) + mkRecordConExpr :: LocatedN (WithUserRdr Name) + -> HsRecFields GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (HsExpr GhcRn) mkRecordConExpr con (HsRecFields x fields dd) = do { exprFields <- mapM go' fields @@ -1023,7 +1025,7 @@ go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn) go1 (ConPat NoExtField con info) = case info of - PrefixCon _ ps -> mkPrefixConExpr con ps + PrefixCon ps -> mkPrefixConExpr con ps InfixCon l r -> mkPrefixConExpr con [l,r] RecCon fields -> mkRecordConExpr con fields @@ -1032,7 +1034,7 @@ go1 (VarPat _ (L l var)) | var `elemNameSet` lhsVars - = return $ HsVar noExtField (L l var) + = return $ mkHsVar (L l var) | otherwise = Left (PatSynUnboundVar var) go1 (ParPat _ pat) = fmap (HsPar noExtField) (go pat) @@ -1248,7 +1250,7 @@ go1 _ = empty goConDetails :: HsConPatDetails GhcTc -> ([TyVar], [EvVar]) - goConDetails (PrefixCon _ ps) = mergeMany . map go $ ps + goConDetails (PrefixCon ps) = mergeMany . map go $ ps goConDetails (InfixCon p1 p2) = go p1 `merge` go p2 goConDetails (RecCon HsRecFields{ rec_flds = flds }) = mergeMany . map goRecFd $ flds diff --git a/GHC/Tc/TyCl/Utils.hs b/GHC/Tc/TyCl/Utils.hs --- a/GHC/Tc/TyCl/Utils.hs +++ b/GHC/Tc/TyCl/Utils.hs @@ -1,8 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1999 @@ -736,13 +734,14 @@ updateRoleEnv name n role = RM $ \_ _ _ state@(RIS { role_env = role_env }) -> ((), case lookupNameEnv role_env name of - Nothing -> pprPanic "updateRoleEnv" (ppr name) - Just roles -> let (before, old_role : after) = splitAt n roles in - if role `ltRole` old_role + Just roles + | (before, old_role : after) <- splitAt n roles + -> if role `ltRole` old_role then let roles' = before ++ role : after role_env' = extendNameEnv role_env name roles' in RIS { role_env = role_env', update = True } - else state ) + else state + _ -> pprPanic "updateRoleEnv" (ppr name)) {- ********************************************************************* @@ -802,14 +801,6 @@ -- (#13998) {- -************************************************************************ -* * - Building record selectors -* * -************************************************************************ --} - -{- Note [Default method Ids and Template Haskell] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this (#4169): @@ -835,10 +826,25 @@ ************************************************************************ -} +{- Note [Record selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +Record selectors are injected as ordianry functions definitions, very +early in the pipeline. + +* `mkRecSelBinds` produces /un-typechecked/ bindings, rather like 'deriving' + This makes life easier, because the later type checking will add + all necessary type abstractions and applications; and handling for + UNPACK pragmas etc + +* Record selectors are not treated as "implicit". See + See Note [Implicit TyThings] in GHC.Types.TyThing and + Note [Injecting implicit bindings] in GHC.CoreToStg.AddImplicitBinds +-} + tcRecSelBinds :: [(Id, LHsBind GhcRn)] -> TcM TcGblEnv tcRecSelBinds sel_bind_prs = tcExtendGlobalValEnv [sel_id | (L _ (XSig (IdSig sel_id))) <- sigs] $ - do { (rec_sel_binds, _, tcg_env) <- discardWarnings $ + do { (rec_sel_binds, tcg_env) <- discardWarnings $ -- See Note [Impredicative record selectors] setXOptM LangExt.ImpredicativeTypes $ tcValBinds TopLevel binds sigs getGblEnv @@ -850,9 +856,7 @@ binds = [(NonRecursive, [bind]) | (_, bind) <- sel_bind_prs] mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)] --- NB We produce *un-typechecked* bindings, rather like 'deriving' --- This makes life easier, because the later type checking will add --- all necessary type abstractions and applications +-- See Note [Record selectors] mkRecSelBinds tycons = map mkRecSelBind [ (tc,fld) | tc <- tycons , fld <- tyConFieldLabels tc ] @@ -881,15 +885,17 @@ sel_id = mkExportedLocalId rec_details sel_name sel_ty -- Find a representative constructor, con1 - cons_partitioned@(cons_w_field, _) = conLikesWithFields all_cons [lbl] + rec_sel_info@(RSI { rsi_def = cons_w_field }) + = conLikesRecSelInfo all_cons [lbl] con1 = assert (not (null cons_w_field)) $ head cons_w_field -- Construct the IdDetails rec_details = RecSelId { sel_tycon = idDetails , sel_naughty = is_naughty , sel_fieldLabel = fl - , sel_cons = cons_partitioned } - -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + , sel_cons = rec_sel_info } + -- See (IRS1) in Note [Detecting incomplete record selectors] + -- in GHC.HsToCore.Pmc -- Selector type; Note [Polymorphic selectors] @@ -916,7 +922,7 @@ -- A slight hack! sel_ty | is_naughty = unitTy -- See Note [Naughty record selectors] - | otherwise = mkForAllTys (tyVarSpecToBinders sel_tvbs) $ + | otherwise = mkForAllTys sel_tvbs $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ -- req_theta is empty for normal DataCon @@ -936,8 +942,10 @@ | otherwise = map mk_match cons_w_field ++ deflt mk_match con = mkSimpleMatch match_ctxt (L (l2l loc') [L loc' (mk_sel_pat con)]) - (L loc' (HsVar noExtField (L locn field_var))) - mk_sel_pat con = ConPat NoExtField (L locn (getName con)) (RecCon rec_fields) + (L loc' (mkHsVar (L locn field_var))) + mk_sel_pat con = + let con_lname = L locn (noUserRdr (getName con)) + in ConPat NoExtField con_lname (RecCon rec_fields) rec_fields = HsRecFields { rec_ext = noExtField, rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLocA (HsFieldBind { hfbAnn = noAnn diff --git a/GHC/Tc/Types.hs b/GHC/Tc/Types.hs --- a/GHC/Tc/Types.hs +++ b/GHC/Tc/Types.hs @@ -59,9 +59,15 @@ CompleteMatch, CompleteMatches, -- Template Haskell - ThStage(..), SpliceType(..), SpliceOrBracket(..), PendingStuff(..), - topStage, topAnnStage, topSpliceStage, - ThLevel, impLevel, outerLevel, thLevel, + ThLevel(..), SpliceType(..), SpliceOrBracket(..), PendingStuff(..), + topLevel, topAnnLevel, topSpliceLevel, + ThLevelIndex, + topLevelIndex, + spliceLevelIndex, + quoteLevelIndex, + + thLevelIndex, + ForeignSrcLang(..), THDocs, DocLoc(..), ThBindEnv, @@ -154,7 +160,6 @@ import GHC.Types.Unique.FM import GHC.Types.Basic import GHC.Types.CostCentre.State -import GHC.Types.HpcInfo import GHC.Data.IOEnv import GHC.Data.Bag @@ -206,7 +211,11 @@ data ImpUserList = ImpUserAll -- ^ no user import list - | ImpUserExplicit !GlobalRdrEnv + | ImpUserExplicit + { iul_avails :: ![AvailInfo] + , iul_non_explicit_parents :: !NameSet + -- ^ The @T@s in import list items of the form @T(..)@ + } | ImpUserEverythingBut !NameSet -- | A 'NameShape' is a substitution on 'Name's that can be used @@ -498,6 +507,9 @@ tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances -- NB. BangPattern is to fix a leak, see #15111 tcg_ann_env :: AnnEnv, -- ^ And for annotations + tcg_complete_match_env :: CompleteMatches, + -- ^ The complete matches for all /home-package/ modules; + -- Includes the complete matches in tcg_complete_matches -- Now a bunch of things about this module that are simply -- accumulated, but never consulted until the end. @@ -556,11 +568,6 @@ -- is implicit rather than explicit, so we have to zap a -- mutable variable. - tcg_th_splice_used :: TcRef Bool, - -- ^ @True@ \<=> A Template Haskell splice was used. - -- - -- Splices disable recompilation avoidance (see #481) - tcg_th_needed_deps :: TcRef ([Linkable], PkgsLoaded), -- ^ The set of runtime dependencies required by this module -- See Note [Object File Dependencies] @@ -646,10 +653,6 @@ tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)), -- ^ Maybe Haddock header docs and Maybe located module name - tcg_hpc :: !AnyHpcUsage, -- ^ @True@ if any part of the - -- prog uses hpc instrumentation. - -- NB. BangPattern is to fix a leak, see #15111 - tcg_self_boot :: SelfBootInfo, -- ^ Whether this module has a -- corresponding hi-boot file @@ -689,9 +692,10 @@ -- ^ Wanted constraints of static forms. -- See Note [Constraints in static forms]. tcg_complete_matches :: !CompleteMatches, + -- ^ Complete matches defined in this module. - -- ^ Tracking indices for cost centre annotations tcg_cc_st :: TcRef CostCentreState, + -- ^ Tracking indices for cost centre annotations tcg_next_wrapper_num :: TcRef (ModuleEnv Int) -- ^ See Note [Generating fresh names for FFI wrappers] @@ -908,6 +912,20 @@ where add env (uid, elt) = extendInstalledModuleEnv env (mkModule uid (gwib_mod elt)) elt +plusDirectModDeps :: InstalledModuleEnv (S.Set ImportLevel, ModuleNameWithIsBoot) + -> InstalledModuleEnv (S.Set ImportLevel, ModuleNameWithIsBoot) + -> InstalledModuleEnv (S.Set ImportLevel, ModuleNameWithIsBoot) +plusDirectModDeps = plusInstalledModuleEnv plus_mod_dep + where + plus_mod_dep (st1, r1@(GWIB { gwib_mod = m1, gwib_isBoot = boot1 })) + (st2, r2@(GWIB {gwib_mod = m2, gwib_isBoot = boot2})) + | assertPpr (m1 == m2) ((ppr m1 <+> ppr m2) $$ (ppr (boot1 == IsBoot) <+> ppr (boot2 == IsBoot))) + boot1 == IsBoot = (st1 `S.union` st2, r2) + | otherwise = (st1 `S.union` st2, r1) + -- If either side can "see" a non-hi-boot interface, use that + -- Reusing existing tuples saves 10% of allocations on test + -- perf/compiler/MultiLayerModules + plusModDeps :: InstalledModuleEnv ModuleNameWithIsBoot -> InstalledModuleEnv ModuleNameWithIsBoot -> InstalledModuleEnv ModuleNameWithIsBoot @@ -955,7 +973,7 @@ imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2, imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = M.unionWith (++) mods1 mods2, - imp_direct_dep_mods = ddmods1 `plusModDeps` ddmods2, + imp_direct_dep_mods = ddmods1 `plusDirectModDeps` ddmods2, imp_dep_direct_pkgs = ddpkgs1 `S.union` ddpkgs2, imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, imp_trust_own_pkg = tself1 || tself2, diff --git a/GHC/Tc/Types/Constraint.hs b/GHC/Tc/Types/Constraint.hs --- a/GHC/Tc/Types/Constraint.hs +++ b/GHC/Tc/Types/Constraint.hs @@ -1,5 +1,5 @@ - {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -17,7 +17,7 @@ isUnsatisfiableCt_maybe, ctEvidence, updCtEvidence, ctLoc, ctPred, ctFlavour, ctEqRel, ctOrigin, - ctRewriters, + ctRewriters, ctHasNoRewriters, wantedCtHasNoRewriters, ctEvId, wantedEvId_maybe, mkTcEqPredLikeEv, mkNonCanonical, mkGivens, tyCoVarsOfCt, tyCoVarsOfCts, @@ -38,7 +38,7 @@ CtIrredReason(..), isInsolubleReason, CheckTyEqResult, CheckTyEqProblem, cteProblem, cterClearOccursCheck, - cteOK, cteImpredicative, cteTypeFamily, cteCoercionHole, + cteOK, cteImpredicative, cteTypeFamily, cteInsolubleOccurs, cteSolubleOccurs, cterSetOccursCheckSoluble, cteConcrete, cteSkolemEscape, impredicativeProblem, insolubleOccursProblem, solubleOccursProblem, @@ -46,26 +46,28 @@ cterHasNoProblem, cterHasProblem, cterHasOnlyProblem, cterHasOnlyProblems, cterRemoveProblem, cterHasOccursCheck, cterFromKind, - + -- Equality left-hand sides, re-exported from GHC.Core.Predicate CanEqLHS(..), canEqLHS_maybe, canTyFamEqLHS_maybe, canEqLHSKind, canEqLHSType, eqCanEqLHS, + -- Holes Hole(..), HoleSort(..), isOutOfScopeHole, DelayedError(..), NotConcreteError(..), - NotConcreteReason(..), WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC, isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC, addInsols, dropMisleading, addSimples, addImplics, addHoles, - addNotConcreteError, addDelayedErrors, + addNotConcreteError, addMultiplicityCoercionError, addDelayedErrors, tyCoVarsOfWC, tyCoVarsOfWCList, insolubleWantedCt, insolubleCt, insolubleIrredCt, insolubleImplic, nonDefaultableTyVarsOfWC, + approximateWCX, approximateWC, Implication(..), implicationPrototype, checkTelescopeSkol, ImplicStatus(..), isInsolubleStatus, isSolvedStatus, UserGiven, getUserGivensFromImplics, HasGivenEqs(..), checkImplicationInvariants, + EvNeedSet(..), emptyEvNeedSet, unionEvNeedSet, extendEvNeedSet, delGivensFromEvNeedSet, -- CtLocEnv CtLocEnv(..), setCtLocEnvLoc, setCtLocEnvLvl, getCtLocEnvLoc, getCtLocEnvLvl, ctLocEnvInGeneratedCode, @@ -74,11 +76,16 @@ CtEvidence(..), TcEvDest(..), isWanted, isGiven, ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel, - ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId, - ctEvRewriters, ctEvUnique, tcEvDestUnique, + ctEvExpr, ctEvTerm, + ctEvCoercion, givenCtEvCoercion, + ctEvEvId, wantedCtEvEvId, + ctEvRewriters, setWantedCtEvRewriters, ctEvUnique, tcEvDestUnique, ctEvRewriteRole, ctEvRewriteEqRel, setCtEvPredType, setCtEvLoc, tyCoVarsOfCtEvList, tyCoVarsOfCtEv, tyCoVarsOfCtEvsList, + -- CtEvidence constructors + GivenCtEvidence(..), WantedCtEvidence(..), + -- RewriterSet RewriterSet(..), emptyRewriterSet, isEmptyRewriterSet, -- exported concretely only for zonkRewriterSet @@ -99,11 +106,14 @@ import GHC.Prelude +import GHC.Core import GHC.Core.Predicate import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.Class import GHC.Core.TyCon +import GHC.Core.TyCo.Ppr + import GHC.Types.Name import GHC.Types.Var @@ -112,26 +122,24 @@ import GHC.Tc.Types.Origin import GHC.Tc.Types.CtLoc -import GHC.Core +import GHC.Builtin.Names -import GHC.Core.TyCo.Ppr -import GHC.Utils.FV import GHC.Types.Var.Set -import GHC.Builtin.Names import GHC.Types.Unique.Set +import GHC.Types.Name.Reader +import GHC.Utils.FV import GHC.Utils.Outputable -import GHC.Data.Bag import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Constants (debugIsOn) -import GHC.Types.Name.Reader +import GHC.Data.Bag + import Data.Coerce import qualified Data.Semigroup as S import Control.Monad ( msum, when ) import Data.Maybe ( mapMaybe, isJust ) -import Data.List.NonEmpty ( NonEmpty ) -- these are for CheckTyEqResult import Data.Word ( Word8 ) @@ -189,15 +197,24 @@ {-# INLINE assertFuelPreconditionStrict #-} assertFuelPreconditionStrict fuel = assertPpr (pendingFuel fuel) insufficientFuelError +-- | Constraint data Ct + -- | A dictionary constraint (canonical) = CDictCan DictCt - | CIrredCan IrredCt -- A "irreducible" constraint (non-canonical) - | CEqCan EqCt -- A canonical equality constraint - | CQuantCan QCInst -- A quantified constraint - | CNonCanonical CtEvidence -- See Note [NonCanonical Semantics] in GHC.Tc.Solver.Monad + -- | An irreducible constraint (non-canonical) + | CIrredCan IrredCt + -- | An equality constraint (canonical) + | CEqCan EqCt + -- | A quantified constraint (canonical) + | CQuantCan QCInst + -- | A non-canonical constraint + -- + -- See Note [NonCanonical Semantics] in GHC.Tc.Solver.Monad + | CNonCanonical CtEvidence --------------- DictCt -------------- +-- | A canonical dictionary constraint data DictCt -- e.g. Num ty = DictCt { di_ev :: CtEvidence -- See Note [Ct/evidence invariant] @@ -226,20 +243,26 @@ {- Note [Canonical equalities] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ An EqCt is a canonical equality constraint, one that can live in the inert set, -and that can be used to rewrite other constrtaints. It satisfies these invariants: +and that can be used to rewrite other constraints. It satisfies these invariants: + * (TyEq:OC) lhs does not occur in rhs (occurs check) Note [EqCt occurs check] + * (TyEq:F) rhs has no foralls (this avoids substituting a forall for the tyvar in other types) + * (TyEq:K) typeKind lhs `tcEqKind` typeKind rhs; Note [Ct kind invariant] + * (TyEq:N) If the equality is representational, rhs is not headed by a saturated application of a newtype TyCon. See GHC.Tc.Solver.Equality Note [No top-level newtypes on RHS of representational equalities]. (Applies only when constructor of newtype is in scope.) + * (TyEq:U) An EqCt is not immediately unifiable. If we can unify a:=ty, we will not form an EqCt (a ~ ty). + * (TyEq:CH) rhs does not mention any coercion holes that resulted from fixing up - a hetero-kinded equality. See Note [Equalities with incompatible kinds] in + a hetero-kinded equality. See Note [Equalities with heterogeneous kinds] in GHC.Tc.Solver.Equality, wrinkle (EIK2) These invariants ensure that the EqCts in inert_eqs constitute a terminating @@ -257,10 +280,10 @@ * For type variables, the occurs-check looks deeply including kinds of type variables. This is because a CEqCan over a meta-variable is - also used to inform unification, in - GHC.Tc.Solver.Monad.checkTouchableTyVarEq. If the LHS appears - anywhere in the RHS, at all, unification will create an infinite - structure which is bad. + also used to inform unification, via `checkTyEqRhs`, called in + `canEqCanLHSFinish_try_unification`. + If the LHS appears anywhere in the RHS, at all, unification will create + an infinite structure, which is bad. * For type family applications, the occurs-check is shallow; it looks only in places where we might rewrite. (Specifically, it does not @@ -279,7 +302,10 @@ in GHC.Tc.Solver.InertSet. -} -data EqCt -- An equality constraint; see Note [Canonical equalities] +-- | A canonical equality constraint. +-- +-- See Note [Canonical equalities] in GHC.Tc.Types.Constraint. +data EqCt = EqCt { -- CanEqLHS ~ rhs eq_ev :: CtEvidence, -- See Note [Ct/evidence invariant] eq_lhs :: CanEqLHS, @@ -287,17 +313,6 @@ eq_eq_rel :: EqRel -- INVARIANT: cc_eq_rel = ctEvEqRel cc_ev } --- | A 'CanEqLHS' is a type that can appear on the left of a canonical --- equality: a type variable or /exactly-saturated/ type family application. -data CanEqLHS - = TyVarLHS TcTyVar - | TyFamLHS TyCon -- ^ TyCon of the family - [Xi] -- ^ Arguments, /exactly saturating/ the family - -instance Outputable CanEqLHS where - ppr (TyVarLHS tv) = ppr tv - ppr (TyFamLHS fam_tc fam_args) = ppr (mkTyConApp fam_tc fam_args) - eqCtEvidence :: EqCt -> CtEvidence eqCtEvidence = eq_ev @@ -330,18 +345,24 @@ --------------- QCInst -------------- -data QCInst -- A much simplified version of ClsInst - -- See Note [Quantified constraints] in GHC.Tc.Solver.Solve - = QCI { qci_ev :: CtEvidence -- Always of type forall tvs. context => ty - -- Always Given - , qci_tvs :: [TcTyVar] -- The tvs - , qci_pred :: TcPredType -- The ty +-- | A quantified constraint, also called a "local instance" +-- (a simplified version of 'ClsInst'). +-- +-- See Note [Quantified constraints] in GHC.Tc.Solver.Solve +data QCInst + -- | A quantified constraint, of type @forall tvs. context => ty@ + = QCI { qci_ev :: CtEvidence -- See Note [Ct/evidence invariant] + , qci_tvs :: [TcTyVar] -- ^ @tvs@ + , qci_theta :: TcThetaType + , qci_body :: TcPredType -- ^ the body of the @forall@, i.e. @ty@ , qci_pend_sc :: ExpansionFuel - -- Invariants: qci_pend_sc > 0 => - -- (a) qci_pred is a ClassPred - -- (b) this class has superclass(es), and - -- (c) the superclass(es) are not explored yet - -- Same as di_pend_sc flag in DictCt + -- ^ Invariants: qci_pend_sc > 0 => + -- + -- (a) 'qci_body' is a ClassPred + -- (b) this class has superclass(es), and + -- (c) the superclass(es) are not explored yet + -- + -- Same as 'di_pend_sc' flag in 'DictCt' -- See Note [Expanding Recursive Superclasses and ExpansionFuel] in GHC.Tc.Solver } @@ -360,20 +381,26 @@ = DE_Hole Hole -- ^ A hole (in a type or in a term). -- - -- See Note [Holes]. + -- See Note [Holes in expressions]. | DE_NotConcrete NotConcreteError -- ^ A type could not be ensured to be concrete. -- -- See Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete. + | DE_Multiplicity TcCoercion CtLoc + -- ^ An error if the TcCoercion isn't a reflexivity constraint. + -- + -- See Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify. + instance Outputable DelayedError where ppr (DE_Hole hole) = ppr hole ppr (DE_NotConcrete err) = ppr err + ppr (DE_Multiplicity co _) = ppr co -- | A hole stores the information needed to report diagnostics -- about holes in terms (unbound identifiers or underscores) or -- in types (also called wildcards, as used in partial type --- signatures). See Note [Holes]. +-- signatures). See Note [Holes in expressions] for holes in terms. data Hole = Hole { hole_sort :: HoleSort -- ^ What flavour of hole is this? , hole_occ :: RdrName -- ^ The name of this hole @@ -428,30 +455,8 @@ -- ^ Where did this check take place? , nce_frr_origin :: FixedRuntimeRepOrigin -- ^ Which representation-polymorphism check did we perform? - , nce_reasons :: NonEmpty NotConcreteReason - -- ^ Why did the check fail? } --- | Why did we decide that a type was not concrete? -data NotConcreteReason - -- | The type contains a 'TyConApp' of a non-concrete 'TyCon'. - -- - -- See Note [Concrete types] in GHC.Tc.Utils.Concrete. - = NonConcreteTyCon TyCon [TcType] - - -- | The type contains a type variable that could not be made - -- concrete (e.g. a skolem type variable). - | NonConcretisableTyVar TyVar - - -- | The type contains a cast. - | ContainsCast TcType TcCoercionN - - -- | The type contains a forall. - | ContainsForall ForAllTyBinder TcType - - -- | The type contains a 'CoercionTy'. - | ContainsCoercionTy TcCoercion - instance Outputable NotConcreteError where ppr (NCE_FRR { nce_frr_origin = frr_orig }) = text "NCE_FRR" <+> parens (ppr (frr_type frr_orig)) @@ -527,7 +532,7 @@ newtype CheckTyEqProblem = CTEP Word8 cteImpredicative, cteTypeFamily, cteInsolubleOccurs, - cteSolubleOccurs, cteCoercionHole, cteConcrete, + cteSolubleOccurs, cteConcrete, cteSkolemEscape :: CheckTyEqProblem cteImpredicative = CTEP (bit 0) -- Forall or (=>) encountered cteTypeFamily = CTEP (bit 1) -- Type family encountered @@ -539,9 +544,11 @@ -- cteSolubleOccurs must be one bit to the left of cteInsolubleOccurs -- See also Note [Insoluble mis-match] in GHC.Tc.Errors -cteCoercionHole = CTEP (bit 4) -- Coercion hole encountered +-- NB: CTEP (bit 4) currently unused + cteConcrete = CTEP (bit 5) -- Type variable that can't be made concrete -- e.g. alpha[conc] ~ Maybe beta[tv] + cteSkolemEscape = CTEP (bit 6) -- Skolem escape e.g. alpha[2] ~ b[sk,4] cteProblem :: CheckTyEqProblem -> CheckTyEqResult @@ -628,8 +635,7 @@ , (cteInsolubleOccurs, "cteInsolubleOccurs") , (cteSolubleOccurs, "cteSolubleOccurs") , (cteConcrete, "cteConcrete") - , (cteSkolemEscape, "cteSkolemEscape") - , (cteCoercionHole, "cteCoercionHole") ] + , (cteSkolemEscape, "cteSkolemEscape") ] {- Note [CIrredCan constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -662,44 +668,6 @@ of the rhs. This is necessary because these constraints are used for substitutions during solving. If the kinds differed, then the substitution would take a well-kinded type to an ill-kinded one. - -Note [Holes] -~~~~~~~~~~~~ -This Note explains how GHC tracks *holes*. - -A hole represents one of two conditions: - - A missing bit of an expression. Example: foo x = x + _ - - A missing bit of a type. Example: bar :: Int -> _ - -What these have in common is that both cause GHC to emit a diagnostic to the -user describing the bit that is left out. - -When a hole is encountered, a new entry of type Hole is added to the ambient -WantedConstraints. The type (hole_ty) of the hole is then simplified during -solving (with respect to any Givens in surrounding implications). It is -reported with all the other errors in GHC.Tc.Errors. - -For expression holes, the user has the option of deferring errors until runtime -with -fdefer-type-errors. In this case, the hole actually has evidence: this -evidence is an erroring expression that prints an error and crashes at runtime. -The ExprHole variant of holes stores an IORef EvTerm that will contain this evidence; -during constraint generation, this IORef was stored in the HsUnboundVar extension -field by the type checker. The desugarer simply dereferences to get the CoreExpr. - -Prior to fixing #17812, we used to invent an Id to hold the erroring -expression, and then bind it during type-checking. But this does not support -representation-polymorphic out-of-scope identifiers. See -typecheck/should_compile/T17812. We thus use the mutable-CoreExpr approach -described above. - -You might think that the type in the HoleExprRef is the same as the type of the -hole. However, because the hole type (hole_ty) is rewritten with respect to -givens, this might not be the case. That is, the hole_ty is always (~) to the -type of the HoleExprRef, but they might not be `eqType`. We need the type of the generated -evidence to match what is expected in the context of the hole, and so we must -store these types separately. - -Type-level holes have no evidence at all. -} mkNonCanonical :: CtEvidence -> Ct @@ -709,9 +677,9 @@ mkGivens loc ev_ids = map mk ev_ids where - mk ev_id = mkNonCanonical (CtGiven { ctev_evar = ev_id - , ctev_pred = evVarPred ev_id - , ctev_loc = loc }) + mk ev_id = mkNonCanonical (CtGiven (GivenCt { ctev_evar = ev_id + , ctev_pred = evVarPred ev_id + , ctev_loc = loc })) ctEvidence :: Ct -> CtEvidence ctEvidence (CQuantCan (QCI { qci_ev = ev })) = ev @@ -764,8 +732,8 @@ mkTcEqPredLikeEv :: CtEvidence -> TcType -> TcType -> TcType mkTcEqPredLikeEv ev = case predTypeEqRel pred of - NomEq -> mkPrimEqPred - ReprEq -> mkReprPrimEqPred + NomEq -> mkNomEqPred + ReprEq -> mkReprEqPred where pred = ctEvPred ev @@ -794,45 +762,6 @@ instance Outputable EqCt where ppr (EqCt { eq_ev = ev }) = ppr ev ------------------------------------ --- | Is a type a canonical LHS? That is, is it a tyvar or an exactly-saturated --- type family application? --- Does not look through type synonyms. -canEqLHS_maybe :: Xi -> Maybe CanEqLHS -canEqLHS_maybe xi - | Just tv <- getTyVar_maybe xi - = Just $ TyVarLHS tv - - | otherwise - = canTyFamEqLHS_maybe xi - -canTyFamEqLHS_maybe :: Xi -> Maybe CanEqLHS -canTyFamEqLHS_maybe xi - | Just (tc, args) <- tcSplitTyConApp_maybe xi - , isTypeFamilyTyCon tc - , args `lengthIs` tyConArity tc - = Just $ TyFamLHS tc args - - | otherwise - = Nothing - --- | Convert a 'CanEqLHS' back into a 'Type' -canEqLHSType :: CanEqLHS -> TcType -canEqLHSType (TyVarLHS tv) = mkTyVarTy tv -canEqLHSType (TyFamLHS fam_tc fam_args) = mkTyConApp fam_tc fam_args - --- | Retrieve the kind of a 'CanEqLHS' -canEqLHSKind :: CanEqLHS -> TcKind -canEqLHSKind (TyVarLHS tv) = tyVarKind tv -canEqLHSKind (TyFamLHS fam_tc fam_args) = piResultTys (tyConKind fam_tc) fam_args - --- | Are two 'CanEqLHS's equal? -eqCanEqLHS :: CanEqLHS -> CanEqLHS -> Bool -eqCanEqLHS (TyVarLHS tv1) (TyVarLHS tv2) = tv1 == tv2 -eqCanEqLHS (TyFamLHS fam_tc1 fam_args1) (TyFamLHS fam_tc2 fam_args2) - = tcEqTyConApps fam_tc1 fam_args1 fam_tc2 fam_args2 -eqCanEqLHS _ _ = False - {- ************************************************************************ * * @@ -951,6 +880,7 @@ tyCoFVsOfDelayedError :: DelayedError -> FV tyCoFVsOfDelayedError (DE_Hole hole) = tyCoFVsOfHole hole tyCoFVsOfDelayedError (DE_NotConcrete {}) = emptyFV +tyCoFVsOfDelayedError (DE_Multiplicity co _) = tyCoFVsOfCo co tyCoFVsOfHole :: Hole -> FV tyCoFVsOfHole (Hole { hole_ty = ty }) = tyCoFVsOfType ty @@ -973,75 +903,6 @@ isGivenCt :: Ct -> Bool isGivenCt = isGiven . ctEvidence -{- Note [Custom type errors in constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -When GHC reports a type-error about an unsolved-constraint, we check -to see if the constraint contains any custom-type errors, and if so -we report them. Here are some examples of constraints containing type -errors: - -TypeError msg -- The actual constraint is a type error - -TypError msg ~ Int -- Some type was supposed to be Int, but ended up - -- being a type error instead - -Eq (TypeError msg) -- A class constraint is stuck due to a type error - -F (TypeError msg) ~ a -- A type function failed to evaluate due to a type err - -It is also possible to have constraints where the type error is nested deeper, -for example see #11990, and also: - -Eq (F (TypeError msg)) -- Here the type error is nested under a type-function - -- call, which failed to evaluate because of it, - -- and so the `Eq` constraint was unsolved. - -- This may happen when one function calls another - -- and the called function produced a custom type error. --} - --- | A constraint is considered to be a custom type error, if it contains --- custom type errors anywhere in it. --- See Note [Custom type errors in constraints] -getUserTypeErrorMsg :: PredType -> Maybe ErrorMsgType -getUserTypeErrorMsg pred = msum $ userTypeError_maybe pred - : map getUserTypeErrorMsg (subTys pred) - where - -- Richard thinks this function is very broken. What is subTys - -- supposed to be doing? Why are exactly-saturated tyconapps special? - -- What stops this from accidentally ripping apart a call to TypeError? - subTys t = case splitAppTys t of - (t,[]) -> - case splitTyConApp_maybe t of - Nothing -> [] - Just (_,ts) -> ts - (t,ts) -> t : ts - --- | Is this an user error message type, i.e. either the form @TypeError err@ or --- @Unsatisfiable err@? -isTopLevelUserTypeError :: PredType -> Bool -isTopLevelUserTypeError pred = - isJust (userTypeError_maybe pred) || isJust (isUnsatisfiableCt_maybe pred) - --- | Does this constraint contain an user error message? --- --- That is, the type is either of the form @Unsatisfiable err@, or it contains --- a type of the form @TypeError msg@, either at the top level or nested inside --- the type. -containsUserTypeError :: PredType -> Bool -containsUserTypeError pred = - isJust (getUserTypeErrorMsg pred) || isJust (isUnsatisfiableCt_maybe pred) - --- | Is this type an unsatisfiable constraint? --- If so, return the error message. -isUnsatisfiableCt_maybe :: Type -> Maybe ErrorMsgType -isUnsatisfiableCt_maybe t - | Just (tc, [msg]) <- splitTyConApp_maybe t - , tc `hasKey` unsatisfiableClassNameKey - = Just msg - | otherwise - = Nothing - isPendingScDict :: Ct -> Bool isPendingScDict (CDictCan dict_ct) = isPendingScDictCt dict_ct isPendingScDict _ = False @@ -1061,8 +922,9 @@ pendingScInst_maybe :: QCInst -> Maybe QCInst -- Same as isPendingScDict, but for QCInsts -pendingScInst_maybe qci@(QCI { qci_pend_sc = f }) - | pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) +pendingScInst_maybe qci@(QCI { qci_ev = ev, qci_pend_sc = f }) + | isGiven ev -- Do not expand Wanted QCIs + , pendingFuel f = Just (qci { qci_pend_sc = doNotExpand }) | otherwise = Nothing superClassesMightHelp :: WantedConstraints -> Bool @@ -1227,6 +1089,11 @@ addNotConcreteError wc err = wc { wc_errors = unitBag (DE_NotConcrete err) `unionBags` wc_errors wc } +-- See Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify. +addMultiplicityCoercionError :: WantedConstraints -> TcCoercion -> CtLoc -> WantedConstraints +addMultiplicityCoercionError wc mult_co loc + = wc { wc_errors = unitBag (DE_Multiplicity mult_co loc) `unionBags` wc_errors wc } + addDelayedErrors :: WantedConstraints -> Bag DelayedError -> WantedConstraints addDelayedErrors wc errs = wc { wc_errors = errs `unionBags` wc_errors wc } @@ -1248,12 +1115,16 @@ , wc_impl = mapBag drop_implic implics , wc_errors = filterBag keep_delayed_error errors } - keep_ct ct = case classifyPredType (ctPred ct) of - ClassPred {} -> False - _ -> True + keep_ct ct + = case classifyPredType (ctPred ct) of + ClassPred cls _ -> isEqualityClass cls + -- isEqualityClass: see (CERR2) in Note [Constraints and errors] + -- in GHC.Tc.Utils.Monad + _ -> True keep_delayed_error (DE_Hole hole) = isOutOfScopeHole hole keep_delayed_error (DE_NotConcrete {}) = True + keep_delayed_error (DE_Multiplicity {}) = True isSolvedStatus :: ImplicStatus -> Bool isSolvedStatus (IC_Solved {}) = True @@ -1313,6 +1184,7 @@ = case err of NCE_FRR { nce_frr_origin = frr } -> tyCoVarsOfType (frr_type frr) non_defaultable_tvs_of_err (DE_Hole {}) = emptyVarSet + non_defaultable_tvs_of_err (DE_Multiplicity {}) = emptyVarSet insolubleWC :: WantedConstraints -> Bool insolubleWC (WC { wc_impl = implics, wc_simple = simples, wc_errors = errors }) @@ -1323,6 +1195,7 @@ where is_insoluble (DE_Hole hole) = isOutOfScopeHole hole -- See Note [Insoluble holes] is_insoluble (DE_NotConcrete {}) = True + is_insoluble (DE_Multiplicity {}) = False insolubleWantedCt :: Ct -> Bool -- Definitely insoluble, in particular /excluding/ type-hole constraints @@ -1336,7 +1209,7 @@ | CIrredCan ir_ct <- ct -- CIrredCan: see (IW1) in Note [Insoluble Wanteds] , IrredCt { ir_ev = ev } <- ir_ct - , CtWanted { ctev_loc = loc, ctev_rewriters = rewriters } <- ev + , CtWanted (WantedCt { ctev_loc = loc, ctev_rewriters = rewriters }) <- ev -- It's a Wanted , insolubleIrredCt ir_ct -- It's insoluble @@ -1471,6 +1344,93 @@ insoluble, so that it trumps other errors during error reporting. Yuk! +-} + +{- ********************************************************************* +* * + Custom type errors: Unsatisfiable and TypeError +* * +********************************************************************* -} + +{- Note [Custom type errors in constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When GHC reports a type-error about an unsolved-constraint, we check +to see if the constraint contains any custom-type errors, and if so +we report them. Here are some examples of constraints containing type +errors: + + TypeError msg -- The actual constraint is a type error + + TypError msg ~ Int -- Some type was supposed to be Int, but ended up + -- being a type error instead + + Eq (TypeError msg) -- A class constraint is stuck due to a type error + + F (TypeError msg) ~ a -- A type function failed to evaluate due to a type err + +It is also possible to have constraints where the type error is nested deeper, +for example see #11990, and also: + + Eq (F (TypeError msg)) -- Here the type error is nested under a type-function + -- call, which failed to evaluate because of it, + -- and so the `Eq` constraint was unsolved. + -- This may happen when one function calls another + -- and the called function produced a custom type error. + +A good use-case is described in "Detecting the undetectable" + https://blog.csongor.co.uk/report-stuck-families/ +which features + type family Assert (err :: Constraint) (break :: Type -> Type) (a :: k) :: k where + Assert _ Dummy _ = Any + Assert _ _ k = k +and an unsolved constraint like + Assert (TypeError ...) (F ty1) ty1 ~ ty2 +that reports that (F ty1) remains stuck. +-} + +-- | A constraint is considered to be a custom type error, if it contains +-- custom type errors anywhere in it. +-- See Note [Custom type errors in constraints] +getUserTypeErrorMsg :: PredType -> Maybe ErrorMsgType +getUserTypeErrorMsg pred = msum $ userTypeError_maybe pred + : map getUserTypeErrorMsg (subTys pred) + where + -- Richard thinks this function is very broken. What is subTys + -- supposed to be doing? Why are exactly-saturated tyconapps special? + -- What stops this from accidentally ripping apart a call to TypeError? + subTys t = case splitAppTys t of + (t,[]) -> + case splitTyConApp_maybe t of + Nothing -> [] + Just (_,ts) -> ts + (t,ts) -> t : ts + +-- | Is this an user error message type, i.e. either the form @TypeError err@ or +-- @Unsatisfiable err@? +isTopLevelUserTypeError :: PredType -> Bool +isTopLevelUserTypeError pred = + isJust (userTypeError_maybe pred) || isJust (isUnsatisfiableCt_maybe pred) + +-- | Does this constraint contain an user error message? +-- +-- That is, the type is either of the form @Unsatisfiable err@, or it contains +-- a type of the form @TypeError msg@, either at the top level or nested inside +-- the type. +containsUserTypeError :: PredType -> Bool +containsUserTypeError pred = + isJust (getUserTypeErrorMsg pred) || isJust (isUnsatisfiableCt_maybe pred) + +-- | Is this type an unsatisfiable constraint? +-- If so, return the error message. +isUnsatisfiableCt_maybe :: Type -> Maybe ErrorMsgType +isUnsatisfiableCt_maybe t + | Just (tc, [msg]) <- splitTyConApp_maybe t + , tc `hasKey` unsatisfiableClassNameKey + = Just msg + | otherwise + = Nothing + +{- ************************************************************************ * * Implication constraints @@ -1519,18 +1479,43 @@ -- The ic_need fields keep track of which Given evidence -- is used by this implication or its children - -- NB: including stuff used by nested implications that have since - -- been discarded - -- See Note [Needed evidence variables] - -- and (RC2) in Note [Tracking redundant constraints]a - ic_need_inner :: VarSet, -- Includes all used Given evidence - ic_need_outer :: VarSet, -- Includes only the free Given evidence - -- i.e. ic_need_inner after deleting - -- (a) givens (b) binders of ic_binds + -- See Note [Tracking redundant constraints] + -- NB: these sets include stuff used by fully-solved nested implications + -- that have since been discarded + ic_need :: EvNeedSet, -- All needed Given evidence, from this implication + -- or outer ones + -- That is, /after/ deleting the binders of ic_binds, + -- but /before/ deleting ic_givens + ic_need_implic :: EvNeedSet, -- Union of of the ic_need of all implications in ic_wanted + -- /including/ any fully-solved implications that have been + -- discarded by `pruneImplications`. This discarding is why + -- we need to keep this field in the first place. + ic_status :: ImplicStatus } +data EvNeedSet = ENS { ens_dms :: VarSet -- Needed only by default methods + , ens_fvs :: VarSet -- Needed by things /other than/ default methods + -- See (TRC5) in Note [Tracking redundant constraints] + } + +emptyEvNeedSet :: EvNeedSet +emptyEvNeedSet = ENS { ens_dms = emptyVarSet, ens_fvs = emptyVarSet } + +unionEvNeedSet :: EvNeedSet -> EvNeedSet -> EvNeedSet +unionEvNeedSet (ENS { ens_dms = dm1, ens_fvs = fv1 }) + (ENS { ens_dms = dm2, ens_fvs = fv2 }) + = ENS { ens_dms = dm1 `unionVarSet` dm2, ens_fvs = fv1 `unionVarSet` fv2 } + +extendEvNeedSet :: EvNeedSet -> Var -> EvNeedSet +extendEvNeedSet ens@(ENS { ens_fvs = fvs }) v = ens { ens_fvs = fvs `extendVarSet` v } + +delGivensFromEvNeedSet :: EvNeedSet -> [Var] -> EvNeedSet +delGivensFromEvNeedSet (ENS { ens_dms = dms, ens_fvs = fvs }) givens + = ENS { ens_dms = dms `delVarSetList` givens + , ens_fvs = fvs `delVarSetList` givens } + implicationPrototype :: CtLocEnv -> Implication implicationPrototype ct_loc_env = Implic { -- These fields must be initialised @@ -1539,15 +1524,17 @@ , ic_info = panic "newImplic:info" , ic_warn_inaccessible = panic "newImplic:warn_inaccessible" - , ic_env = ct_loc_env + -- Given by caller + , ic_env = ct_loc_env + -- The rest have sensible default values - , ic_skols = [] - , ic_given = [] - , ic_wanted = emptyWC - , ic_given_eqs = MaybeGivenEqs - , ic_status = IC_Unsolved - , ic_need_inner = emptyVarSet - , ic_need_outer = emptyVarSet } + , ic_skols = [] + , ic_given = [] + , ic_wanted = emptyWC + , ic_given_eqs = MaybeGivenEqs + , ic_status = IC_Unsolved + , ic_need = emptyEvNeedSet + , ic_need_implic = emptyEvNeedSet } data ImplicStatus = IC_Solved -- All wanteds in the tree are solved, all the way down @@ -1623,7 +1610,7 @@ , ic_given = given, ic_given_eqs = given_eqs , ic_wanted = wanted, ic_status = status , ic_binds = binds - , ic_need_inner = need_in, ic_need_outer = need_out + , ic_need = need, ic_need_implic = need_implic , ic_info = info }) = hang (text "Implic" <+> lbrace) 2 (sep [ text "TcLevel =" <+> ppr tclvl @@ -1633,10 +1620,15 @@ , hang (text "Given =") 2 (pprEvVars given) , hang (text "Wanted =") 2 (ppr wanted) , text "Binds =" <+> ppr binds - , whenPprDebug (text "Needed inner =" <+> ppr need_in) - , whenPprDebug (text "Needed outer =" <+> ppr need_out) + , text "need =" <+> ppr need + , text "need_implic =" <+> ppr need_implic , pprSkolInfo info ] <+> rbrace) +instance Outputable EvNeedSet where + ppr (ENS { ens_dms = dms, ens_fvs = fvs }) + = text "ENS" <> braces (sep [text "ens_dms =" <+> ppr dms + , text "ens_fvs =" <+> ppr fvs]) + instance Outputable ImplicStatus where ppr IC_Insoluble = text "Insoluble" ppr IC_BadTelescope = text "Bad telescope" @@ -1724,18 +1716,6 @@ implication. TL;DR: an explicit forall should generate an implication quantified only over those explicitly quantified variables. -Note [Needed evidence variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Th ic_need_evs field holds the free vars of ic_binds, and all the -ic_binds in nested implications. - - * Main purpose: if one of the ic_givens is not mentioned in here, it - is redundant. - - * solveImplication may drop an implication altogether if it has no - remaining 'wanteds'. But we still track the free vars of its - evidence binds, even though it has now disappeared. - Note [Shadowing in a constraint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We assume NO SHADOWING in a constraint. Specifically @@ -1799,8 +1779,222 @@ will be able to report a more informative error: 'Can't construct the infinite type beta ~ F alpha beta' + ************************************************************************ * * + approximateWC +* * +************************************************************************ +-} + +type ApproxWC = ( Bag Ct -- Free quantifiable constraints + , TcTyCoVarSet ) -- Free vars of non-quantifiable constraints + -- due to shape, or enclosing equality + -- Why do we need that TcTyCoVarSet of non-quantifiable constraints? + -- See (DP1) in Note [decideAndPromoteTyVars] in GHC.Tc.Solver +approximateWC :: Bool -> WantedConstraints -> Bag Ct +approximateWC include_non_quantifiable cts + = fst (approximateWCX include_non_quantifiable cts) + +approximateWCX :: Bool -> WantedConstraints -> ApproxWC +-- The "X" means "extended"; +-- we return both quantifiable and non-quantifiable constraints +-- See Note [ApproximateWC] +-- See Note [floatKindEqualities vs approximateWC] +approximateWCX include_non_quantifiable wc + = float_wc False emptyVarSet wc (emptyBag, emptyVarSet) + where + float_wc :: Bool -- True <=> there are enclosing equalities + -> TcTyCoVarSet -- Enclosing skolem binders + -> WantedConstraints + -> ApproxWC -> ApproxWC + float_wc encl_eqs trapping_tvs (WC { wc_simple = simples, wc_impl = implics }) acc + = foldBag_flip (float_ct encl_eqs trapping_tvs) simples $ + foldBag_flip (float_implic encl_eqs trapping_tvs) implics $ + acc + + float_implic :: Bool -> TcTyCoVarSet -> Implication + -> ApproxWC -> ApproxWC + float_implic encl_eqs trapping_tvs imp + = float_wc new_encl_eqs new_trapping_tvs (ic_wanted imp) + where + new_trapping_tvs = trapping_tvs `extendVarSetList` ic_skols imp + new_encl_eqs = encl_eqs || ic_given_eqs imp == MaybeGivenEqs + + float_ct :: Bool -> TcTyCoVarSet -> Ct + -> ApproxWC -> ApproxWC + float_ct encl_eqs skol_tvs ct acc@(quant, no_quant) + | isGivenCt ct = acc + -- There can be (insoluble) Given constraints in wc_simple, + -- there so that we get error reports for unreachable code + -- See `given_insols` in GHC.Tc.Solver.Solve.solveImplication + | insolubleCt ct = acc + | pred_tvs `intersectsVarSet` skol_tvs = acc + | include_non_quantifiable = add_to_quant + | is_quantifiable encl_eqs (ctPred ct) = add_to_quant + | otherwise = add_to_no_quant + where + pred = ctPred ct + pred_tvs = tyCoVarsOfType pred + add_to_quant = (ct `consBag` quant, no_quant) + add_to_no_quant = (quant, no_quant `unionVarSet` pred_tvs) + + is_quantifiable encl_eqs pred + = case classifyPredType pred of + -- See the classification in Note [ApproximateWC] + EqPred eq_rel ty1 ty2 + | encl_eqs -> False -- encl_eqs: See Wrinkle (W1) + | otherwise -> quantify_equality eq_rel ty1 ty2 + + ClassPred cls tys + | Just {} <- isCallStackPred cls tys + -- NEVER infer a CallStack constraint. Otherwise we let + -- the constraints bubble up to be solved from the outer + -- context, or be defaulted when we reach the top-level. + -- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence + -> False + + | otherwise + -> True -- See Wrinkle (W2) + + IrredPred {} -> True -- See Wrinkle (W2) + + ForAllPred {} -> warnPprTrace True "Unexpected ForAllPred" (ppr pred) $ + False -- See Wrinkle (W4) + + -- See Note [Quantifying over equality constraints] + quantify_equality NomEq ty1 ty2 = quant_fun ty1 || quant_fun ty2 + quantify_equality ReprEq _ _ = True + + quant_fun ty + = case tcSplitTyConApp_maybe ty of + Just (tc, _) -> isTypeFamilyTyCon tc + _ -> False + +{- Note [ApproximateWC] +~~~~~~~~~~~~~~~~~~~~~~~ +approximateWC takes a constraint, typically arising from the RHS of a +let-binding whose type we are *inferring*, and extracts from it some *simple* +constraints that we might plausibly abstract over. Of course the top-level +simple constraints are plausible, but we also float constraints out from inside, +if they are not captured by skolems. + +The same function is used when doing type-class defaulting (see the call +to applyDefaultingRules) to extract constraints that might be defaulted. + +We proceed by classifying the constraint: + * ClassPred: + * Never pick a CallStack constraint. + See Note [Overview of implicit CallStacks] + * Always pick an implicit-parameter constraint. + Note [Inheriting implicit parameters] + See wrinkle (W2) + + * EqPred: see Note [Quantifying over equality constraints] + + * IrredPred: we allow anything. + + * ForAllPred: never quantify over these + +Wrinkle (W1) + When inferring most-general types (in simplifyInfer), we + do *not* quantify over equality constraint if the implication binds + equality constraints, because that defeats the OutsideIn story. + Consider data T a where { TInt :: T Int; MkT :: T a } + f TInt = 3::Int + We get the implication (a ~ Int => res ~ Int), where so far we've decided + f :: T a -> res + We don't want to float (res~Int) out because then we'll infer + f :: T a -> Int + which is only on of the possible types. (GHC 7.6 accidentally *did* + float out of such implications, which meant it would happily infer + non-principal types.) + +Wrinkle (W2) + We do allow /class/ constraints to float, even if the implication binds + equalities. This is a subtle point: see #23224. In principle, a class + constraint might ultimately be satisfiable from a constraint bound by an + implication (see #19106 for an example of this kind), but it's extremely + obscure and I was unable to construct a concrete example. In any case, in + super-subtle cases where this might make a difference, you would be much + better advised to simply write a type signature. + +Wrinkle (W3) + In findDefaultableGroups we are not worried about the most-general type; and + we /do/ want to float out of equalities (#12797). Hence we just union the two + returned lists. + +Wrinkle (W4) + In #26376 we had constraints + [W] d1 : Functor f[tau:1] + [W] d2 : Functor p[tau:1] + [W] d3 : forall a. Functor (p[tau:1]) a -- A quantified constraint + We certainly don't want to /quantify/ over d3; but we /do/ want to + quantify over `p`, so it would be a mistake to make the function monomorphic + in `p` just because `p` is mentioned in this quantified constraint. + + Happily this problem cannot happen any more. That quantified constraint `d3` + dates from a time when we flirted with an all-or-nothing strategy for + quantified constraints Nowadays we'll never see this: we'll have simplified + that quantified constraint into a implication constraint. (Exception: + SPECIALISE pragmas: see (WFA4) in Note [Solving a Wanted forall-constraint]. + But there we don't use approximateWC.) + +------ Historical note ----------- +There used to be a second caveat, driven by #8155 + + 2. We do not float out an inner constraint that shares a type variable + (transitively) with one that is trapped by a skolem. Eg + forall a. F a ~ beta, Integral beta + We don't want to float out (Integral beta). Doing so would be bad + when defaulting, because then we'll default beta:=Integer, and that + makes the error message much worse; we'd get + Can't solve F a ~ Integer + rather than + Can't solve Integral (F a) + + Moreover, floating out these "contaminated" constraints doesn't help + when generalising either. If we generalise over (Integral b), we still + can't solve the retained implication (forall a. F a ~ b). Indeed, + arguably that too would be a harder error to understand. + +But this transitive closure stuff gives rise to a complex rule for +when defaulting actually happens, and one that was never documented. +Moreover (#12923), the more complex rule is sometimes NOT what +you want. So I simply removed the extra code to implement the +contamination stuff. There was zero effect on the testsuite (not even #8155). +------ End of historical note ----------- + +Note [Quantifying over equality constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Should we quantify over an equality constraint (s ~ t) +in pickQuantifiablePreds? + +* It is always /sound/ to quantify over a constraint -- those + quantified constraints will need to be proved at each call site. + +* We definitely don't want to quantify over (Maybe a ~ Bool), to get + f :: forall a. (Maybe a ~ Bool) => blah + That simply postpones a type error from the function definition site to + its call site. Fortunately we have already filtered out insoluble + constraints: see `definite_error` in `simplifyInfer`. + +* What about (a ~ T alpha b), where we are about to quantify alpha, `a` and + `b` are in-scope skolems, and `T` is a data type. It's pretty unlikely + that this will be soluble at a call site, so we don't quantify over it. + +* What about `(F beta ~ Int)` where we are going to quantify `beta`? + Should we quantify over the (F beta ~ Int), to get + f :: forall b. (F b ~ Int) => blah + Aha! Perhaps yes, because at the call site we will instantiate `b`, and + perhaps we have `instance F Bool = Int`. So we *do* quantify over a + type-family equality where the arguments mention the quantified variables. + +This is all a bit ad-hoc. + + +************************************************************************ +* * Invariant checking (debug only) * * ************************************************************************ @@ -1876,9 +2070,11 @@ go (TyConSkol f1 n1) (TyConSkol f2 n2) = f1==f2 && n1==n2 go (DataConSkol n1) (DataConSkol n2) = n1==n2 go (InstSkol {}) (InstSkol {}) = True + go (MethSkol n1 d1) (MethSkol n2 d2) = n1==n2 && d1==d2 go FamInstSkol FamInstSkol = True go BracketSkol BracketSkol = True go (RuleSkol n1) (RuleSkol n2) = n1==n2 + go (SpecESkol n1) (SpecESkol n2) = n1==n2 go (PatSkol c1 _) (PatSkol c2 _) = getName c1 == getName c2 -- Too tedious to compare the HsMatchContexts go (InferSkol ids1) (InferSkol ids2) = equalLength ids1 ids2 && @@ -2039,24 +2235,32 @@ -- See Note [Coercion holes] in GHC.Core.TyCo.Rep data CtEvidence - = CtGiven -- Truly given, not depending on subgoals - { ctev_pred :: TcPredType -- See Note [Ct/evidence invariant] - , ctev_evar :: EvVar -- See Note [CtEvidence invariants] - , ctev_loc :: CtLoc } + = CtGiven GivenCtEvidence + | CtWanted WantedCtEvidence +-- | Evidence for a Given constraint +data GivenCtEvidence = + GivenCt + { ctev_pred :: TcPredType -- See Note [Ct/evidence invariant] + , ctev_evar :: EvVar -- See Note [CtEvidence invariants] + , ctev_loc :: CtLoc } - | CtWanted -- Wanted goal - { ctev_pred :: TcPredType -- See Note [Ct/evidence invariant] - , ctev_dest :: TcEvDest -- See Note [CtEvidence invariants] - , ctev_loc :: CtLoc - , ctev_rewriters :: RewriterSet } -- See Note [Wanteds rewrite Wanteds] +-- | Evidence for a Wanted constraint +data WantedCtEvidence = + WantedCt + { ctev_pred :: TcPredType -- See Note [Ct/evidence invariant] + , ctev_dest :: TcEvDest -- See Note [CtEvidence invariants] + , ctev_loc :: CtLoc + , ctev_rewriters :: RewriterSet } -- See Note [Wanteds rewrite Wanteds] ctEvPred :: CtEvidence -> TcPredType -- The predicate of a flavor -ctEvPred = ctev_pred +ctEvPred (CtGiven (GivenCt { ctev_pred = pred })) = pred +ctEvPred (CtWanted (WantedCt { ctev_pred = pred })) = pred ctEvLoc :: CtEvidence -> CtLoc -ctEvLoc = ctev_loc +ctEvLoc (CtGiven (GivenCt { ctev_loc = loc })) = loc +ctEvLoc (CtWanted (WantedCt { ctev_loc = loc })) = loc ctEvOrigin :: CtEvidence -> CtOrigin ctEvOrigin = ctLocOrigin . ctEvLoc @@ -2084,18 +2288,40 @@ -- If the provided CtEvidence is not for a Wanted, just -- return an empty set. ctEvRewriters :: CtEvidence -> RewriterSet -ctEvRewriters (CtWanted { ctev_rewriters = rewriters }) = rewriters -ctEvRewriters (CtGiven {}) = emptyRewriterSet +ctEvRewriters (CtWanted (WantedCt { ctev_rewriters = rws })) = rws +ctEvRewriters (CtGiven {}) = emptyRewriterSet +ctHasNoRewriters :: Ct -> Bool +ctHasNoRewriters ev + = case ctEvidence ev of + CtWanted wev -> wantedCtHasNoRewriters wev + CtGiven {} -> True + +wantedCtHasNoRewriters :: WantedCtEvidence -> Bool +wantedCtHasNoRewriters (WantedCt { ctev_rewriters = rws }) + = isEmptyRewriterSet rws + +-- | Set the rewriter set of a Wanted constraint. +setWantedCtEvRewriters :: WantedCtEvidence -> RewriterSet -> WantedCtEvidence +setWantedCtEvRewriters ev rs = ev { ctev_rewriters = rs } + ctEvExpr :: HasDebugCallStack => CtEvidence -> EvExpr -ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ }) - = Coercion $ ctEvCoercion ev +ctEvExpr (CtWanted ev@(WantedCt { ctev_dest = HoleDest _ })) + = Coercion $ ctEvCoercion (CtWanted ev) ctEvExpr ev = evId (ctEvEvId ev) +givenCtEvCoercion :: GivenCtEvidence -> TcCoercion +givenCtEvCoercion _given@(GivenCt { ctev_evar = ev_id }) + = assertPpr (isCoVar ev_id) + (text "givenCtEvCoercion used on non-equality Given constraint:" <+> ppr _given) + $ mkCoVarCo ev_id + ctEvCoercion :: HasDebugCallStack => CtEvidence -> TcCoercion -ctEvCoercion (CtGiven { ctev_evar = ev_id }) - = mkCoVarCo ev_id -ctEvCoercion (CtWanted { ctev_dest = dest }) +ctEvCoercion (CtGiven _given@(GivenCt { ctev_evar = ev_id })) + = assertPpr (isCoVar ev_id) + (text "ctEvCoercion used on non-equality Given constraint:" <+> ppr (CtGiven _given)) + $ mkCoVarCo ev_id +ctEvCoercion (CtWanted (WantedCt { ctev_dest = dest })) | HoleDest hole <- dest = -- ctEvCoercion is only called on type equalities -- and they always have HoleDests @@ -2104,20 +2330,24 @@ = pprPanic "ctEvCoercion" (ppr ev) ctEvEvId :: CtEvidence -> EvVar -ctEvEvId (CtWanted { ctev_dest = EvVarDest ev }) = ev -ctEvEvId (CtWanted { ctev_dest = HoleDest h }) = coHoleCoVar h -ctEvEvId (CtGiven { ctev_evar = ev }) = ev +ctEvEvId (CtWanted wtd) = wantedCtEvEvId wtd +ctEvEvId (CtGiven (GivenCt { ctev_evar = ev })) = ev +wantedCtEvEvId :: WantedCtEvidence -> EvVar +wantedCtEvEvId (WantedCt { ctev_dest = EvVarDest ev }) = ev +wantedCtEvEvId (WantedCt { ctev_dest = HoleDest h }) = coHoleCoVar h + ctEvUnique :: CtEvidence -> Unique -ctEvUnique (CtGiven { ctev_evar = ev }) = varUnique ev -ctEvUnique (CtWanted { ctev_dest = dest }) = tcEvDestUnique dest +ctEvUnique (CtGiven (GivenCt { ctev_evar = ev })) = varUnique ev +ctEvUnique (CtWanted (WantedCt { ctev_dest = dest })) = tcEvDestUnique dest tcEvDestUnique :: TcEvDest -> Unique tcEvDestUnique (EvVarDest ev_var) = varUnique ev_var tcEvDestUnique (HoleDest co_hole) = varUnique (coHoleCoVar co_hole) setCtEvLoc :: CtEvidence -> CtLoc -> CtEvidence -setCtEvLoc ctev loc = ctev { ctev_loc = loc } +setCtEvLoc (CtGiven (GivenCt pred evar _)) loc = CtGiven (GivenCt pred evar loc) +setCtEvLoc (CtWanted (WantedCt pred dest _ rwrs)) loc = CtWanted (WantedCt pred dest loc rwrs) -- | Set the type of CtEvidence. -- @@ -2125,13 +2355,13 @@ -- the evidence and the ctev_pred in sync with each other. -- See Note [CtEvidence invariants]. setCtEvPredType :: HasDebugCallStack => CtEvidence -> Type -> CtEvidence -setCtEvPredType old_ctev@(CtGiven { ctev_evar = ev }) new_pred - = old_ctev { ctev_pred = new_pred - , ctev_evar = setVarType ev new_pred } +setCtEvPredType (CtGiven old_ev@(GivenCt { ctev_evar = ev })) new_pred + = CtGiven (old_ev { ctev_pred = new_pred + , ctev_evar = setVarType ev new_pred }) -setCtEvPredType old_ctev@(CtWanted { ctev_dest = dest }) new_pred - = old_ctev { ctev_pred = new_pred - , ctev_dest = new_dest } +setCtEvPredType (CtWanted old_ev@(WantedCt { ctev_dest = dest })) new_pred + = CtWanted (old_ev { ctev_pred = new_pred + , ctev_dest = new_dest }) where new_dest = case dest of EvVarDest ev -> EvVarDest (setVarType ev new_pred) @@ -2141,15 +2371,20 @@ ppr (HoleDest h) = text "hole" <> ppr h ppr (EvVarDest ev) = ppr ev +instance Outputable GivenCtEvidence where + ppr = ppr . CtGiven +instance Outputable WantedCtEvidence where + ppr = ppr . CtWanted + instance Outputable CtEvidence where ppr ev = ppr (ctEvFlavour ev) - <+> pp_ev <+> braces (ppr (ctl_depth (ctEvLoc ev)) <> pp_rewriters) + <+> hang (pp_ev <+> braces (ppr (ctl_depth (ctEvLoc ev)) <> pp_rewriters)) -- Show the sub-goal depth too - <> dcolon <+> ppr (ctEvPred ev) + 2 (dcolon <+> pprPredType (ctEvPred ev)) where pp_ev = case ev of - CtGiven { ctev_evar = v } -> ppr v - CtWanted {ctev_dest = d } -> ppr d + CtGiven ev -> ppr (ctev_evar ev) + CtWanted ev -> ppr (ctev_dest ev) rewriters = ctEvRewriters ev pp_rewriters | isEmptyRewriterSet rewriters = empty @@ -2196,9 +2431,10 @@ rewriterSetFromCts cts = foldr add emptyRewriterSet cts where - add ct rw_set = case ctEvidence ct of - CtWanted { ctev_dest = HoleDest hole } -> rw_set `addRewriter` hole - _ -> rw_set + add ct rw_set = + case ctEvidence ct of + CtWanted (WantedCt { ctev_dest = HoleDest hole }) -> rw_set `addRewriter` hole + _ -> rw_set {- ************************************************************************ @@ -2289,19 +2525,38 @@ but we don't want Wanteds to rewrite Wanteds because doing so can create inscrutable error messages. To solve this dilemma: -* We allow Wanteds to rewrite Wanteds, but... +* We allow Wanteds to rewrite Wanteds, but each Wanted tracks the set of Wanteds + it has been rewritten by, in its RewriterSet, stored in the ctev_rewriters + field of the CtWanted constructor of CtEvidence. (Only Wanteds have + RewriterSets.) -* Each Wanted tracks the set of Wanteds it has been rewritten by, in its - RewriterSet, stored in the ctev_rewriters field of the CtWanted - constructor of CtEvidence. (Only Wanteds have RewriterSets.) +* A RewriterSet is just a set of unfilled CoercionHoles. This is sufficient + because only equalities (evidenced by coercion holes) are used for rewriting; + other (dictionary) constraints cannot ever rewrite. +* The rewriter (in e.g. GHC.Tc.Solver.Rewrite.rewrite) tracks and returns a RewriterSet, + consisting of the evidence (a CoercionHole) for any Wanted equalities used in + rewriting. + +* Then GHC.Tc.Solver.Solve.rewriteEvidence and GHC.Tc.Solver.Equality.rewriteEqEvidence + add this RewriterSet to the rewritten constraint's rewriter set. + +* We prevent the unifier from unifying any equality with a non-empty rewriter set; + unification effectively turns a Wanted into a Given, and we lose all tracking. + See (REWRITERS) in Note [Unification preconditions] in GHC.Tc.Utils.Unify and + Note [Unify only if the rewriter set is empty] in GHC.Solver.Equality. + * In error reporting, we simply suppress any errors that have been rewritten by /unsolved/ wanteds. This suppression happens in GHC.Tc.Errors.mkErrorItem, - which uses GHC.Tc.Zonk.Type.zonkRewriterSet to look through any filled + which uses `GHC.Tc.Zonk.Type.zonkRewriterSet` to look through any filled coercion holes. The idea is that we wish to report the "root cause" -- the error that rewrote all the others. -* We prioritise Wanteds that have an empty RewriterSet: +* In `selectNextWorkItem`, priorities equalities with no rewiters. See + Note [Prioritise Wanteds with empty RewriterSet] in GHC.Tc.Types.Constraint + wrinkle (PER1). + +* In error reporting, we prioritise Wanteds that have an empty RewriterSet: see Note [Prioritise Wanteds with empty RewriterSet]. Let's continue our first example above: @@ -2316,19 +2571,26 @@ The {w1} in the second line of output is the RewriterSet of w1. -A RewriterSet is just a set of unfilled CoercionHoles. This is sufficient -because only equalities (evidenced by coercion holes) are used for rewriting; -other (dictionary) constraints cannot ever rewrite. The rewriter (in -e.g. GHC.Tc.Solver.Rewrite.rewrite) tracks and returns a RewriterSet, -consisting of the evidence (a CoercionHole) for any Wanted equalities used in -rewriting. Then GHC.Tc.Solver.Solve.rewriteEvidence and -GHC.Tc.Solver.Equality.rewriteEqEvidence add this RewriterSet to the rewritten -constraint's rewriter set. +Wrinkles: +(WRW1) When we find a constraint identical to one already in the inert set, + we solve one from the other. Other things being equal, keep the one + that has fewer (better still no) rewriters. + See (CE4) in Note [Combining equalities] in GHC.Tc.Solver.Equality. + + To this accurately we should use `zonkRewriterSet` during canonicalisation, + to eliminate rewriters that have now been solved. Currently we only do so + during error reporting; but perhaps we should change that. + +(WRW2) When zonking a constraint (with `zonkCt` and `zonkCtEvidence`) we take + the opportunity to zonk its `RewriterSet`, which eliminates solved ones. + This doesn't guarantee that rewriter sets are always up to date -- see + (WRW1) -- but it helps, and it de-clutters debug output. + Note [Prioritise Wanteds with empty RewriterSet] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When extending the WorkList, in GHC.Tc.Solver.InertSet.extendWorkListEq, -we priorities constraints that have no rewriters. Here's why. +we prioritise constraints that have no rewriters. Here's why. Consider this, which came up in T22793: inert: {} @@ -2366,17 +2628,17 @@ been well if we'd started with the (not-rewritten) co_ayb and gotten it into the inert set. -With that in mind, we /prioritise/ the work-list to put constraints -with no rewriters first. This prioritisation is done in -GHC.Tc.Solver.InertSet.extendWorkListEq, and extendWorkListEqs. +With that in mind, we /prioritise/ the work-list to put +constraints with no rewriters first. This prioritisation +is done in `GHC.Tc.Solver.Monad.selectNextWorkItem`. Wrinkles -(WRW1) Before checking for an empty RewriterSet, we zonk the RewriterSet, - because some of those CoercionHoles may have been filled in since we last - looked: see GHC.Tc.Solver.Monad.emitWork. +(PER1) When picking the next work item, before checking for an empty RewriterSet + in GHC.Tc.Solver.Monad.selectNextWorkItem, we zonk the RewriterSet, because + some of those CoercionHoles may have been filled in since we last looked. -(WRW2) Despite the prioritisation, it is hard to be /certain/ that we can't end up +(PER2) Despite the prioritisation, it is hard to be /certain/ that we can't end up in a situation where all of the Wanteds have rewritten each other. In order to report /some/ error in this case, we simply report all the Wanteds. The user will get a perhaps-confusing error message, but they've @@ -2475,4 +2737,3 @@ eqCanRewriteFR (Wanted, NomEq) (Wanted, ReprEq) = False eqCanRewriteFR (Wanted, r1) (Wanted, r2) = eqCanRewrite r1 r2 eqCanRewriteFR (Wanted, _) (Given, _) = False - diff --git a/GHC/Tc/Types/CtLoc.hs b/GHC/Tc/Types/CtLoc.hs --- a/GHC/Tc/Types/CtLoc.hs +++ b/GHC/Tc/Types/CtLoc.hs @@ -231,7 +231,6 @@ , ctl_in_gen_code :: !Bool , ctl_rdr :: !LocalRdrEnv } - getCtLocEnvLoc :: CtLocEnv -> RealSrcSpan getCtLocEnvLoc = ctl_loc diff --git a/GHC/Tc/Types/ErrCtxt.hs b/GHC/Tc/Types/ErrCtxt.hs --- a/GHC/Tc/Types/ErrCtxt.hs +++ b/GHC/Tc/Types/ErrCtxt.hs @@ -1,16 +1,223 @@ -module GHC.Tc.Types.ErrCtxt where +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE UndecidableInstances #-} +module GHC.Tc.Types.ErrCtxt + ( ErrCtxt, ErrCtxtMsg(..) + , UserSigType(..), FunAppCtxtFunArg(..) + , TyConInstFlavour(..) + ) + where + import GHC.Prelude -import GHC.Types.Var.Env -import GHC.Tc.Zonk.Monad (ZonkM) -import GHC.Utils.Outputable +import GHC.Hs.Expr +import GHC.Hs.Extension +import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA ) + +import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt ) +import GHC.Tc.Types.Origin ( CtOrigin, UserTypeCtxt, ExpectedFunTyOrigin ) +import GHC.Tc.Utils.TcType ( TcType, TcTyCon ) +import GHC.Tc.Zonk.Monad ( ZonkM ) + +import GHC.Types.Basic ( TyConFlavour ) +import GHC.Types.Name ( Name ) +import GHC.Types.SrcLoc ( SrcSpan ) +import GHC.Types.Var ( Id, TyCoVar ) +import GHC.Types.Var.Env ( TidyEnv ) + +import GHC.Unit.Types ( Module, InstantiatedModule ) + +import GHC.Core.Class ( Class ) +import GHC.Core.ConLike ( ConLike ) +import GHC.Core.PatSyn ( PatSyn ) +import GHC.Core.TyCon ( TyCon ) +import GHC.Core.TyCo.Rep ( Type, ThetaType, PredType ) + +import GHC.Unit.State ( UnitState ) + +import GHC.Data.FastString ( FastString ) +import GHC.Utils.Outputable ( Outputable(..) ) + +import Language.Haskell.Syntax.Basic ( FieldLabelString(..) ) +import Language.Haskell.Syntax +import GHC.Boot.TH.Syntax qualified as TH + +import qualified Data.List.NonEmpty as NE + +-------------------------------------------------------------------------------- + -- | Additional context to include in an error message, e.g. -- "In the type signature ...", "In the ambiguity check for ...", etc. -type ErrCtxt = (Bool, TidyEnv -> ZonkM (TidyEnv, SDoc)) +type ErrCtxt = (Bool, TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -- Monadic so that we have a chance -- to deal with bound type variables just before error -- message construction -- Bool: True <=> this is a landmark context; do not -- discard it when trimming for display + +-------------------------------------------------------------------------------- +-- Error message contexts + +data UserSigType p + = UserLHsSigType !(LHsSigType p) + | UserLHsType !(LHsType p) + +instance OutputableBndrId p => Outputable (UserSigType (GhcPass p)) where + ppr (UserLHsSigType ty) = ppr ty + ppr (UserLHsType ty) = ppr ty + +data FunAppCtxtFunArg + = FunAppCtxtExpr !(HsExpr GhcRn) !(HsExpr GhcRn) + | FunAppCtxtTy !(LHsType GhcRn) !(LHsType GhcRn) + +-- | Like 'TyConFlavour' but for instance declarations, with +-- the additional information of whether this we are dealing with +-- a default declaration. +data TyConInstFlavour + = TyConInstFlavour + { tyConInstFlavour :: !(TyConFlavour TyCon) + , tyConInstIsDefault :: !Bool + } + +-- | The "context" of an error message, e.g. "In the expression <...>", +-- "In the pattern <...>", or "In the equations for closed type family <...>". +data ErrCtxtMsg + -- | In an expression. + = ExprCtxt !(HsExpr GhcRn) + -- | In a user-written context. + | ThetaCtxt !UserTypeCtxt !ThetaType + -- | In a quantified constraint. + | QuantifiedCtCtxt !PredType + -- | When checking an inferred type. + | InferredTypeCtxt !Name !TcType + -- | In an inline pragma, or a fixity signature, + -- or a type signature, or... (see 'Sig'). + | SigCtxt !(Sig GhcRn) + -- | In a user-written type signature. + | UserSigCtxt !UserTypeCtxt !(UserSigType GhcRn) + -- | In a record update. + | RecordUpdCtxt !(NE.NonEmpty ConLike) ![Name] ![TyCoVar] + -- | In a class method. + | ClassOpCtxt !Id !Type + -- | In the instance type signature of a class method. + | MethSigCtxt !Name !TcType !TcType + -- | In a pattern type signature. + | PatSigErrCtxt !TcType !TcType + -- | In a pattern. + | PatCtxt !(Pat GhcRn) + -- | In a pattern synonym declaration. + | PatSynDeclCtxt !Name + -- | In a pattern matching context, e.g. a equation for a function binding, + -- or a case alternative, ... + | MatchCtxt !HsMatchContextRn + -- | In a match in a pattern matching context, + -- either for an expression or for an arrow command. + | forall body. (Outputable body) + => MatchInCtxt !(Match GhcRn body) + -- | In a function application. + | FunAppCtxt !FunAppCtxtFunArg !Int + -- | In a function call. + | FunTysCtxt !ExpectedFunTyOrigin !Type !Int !Int + -- | In the result of a function call. + | FunResCtxt !(HsExpr GhcTc) !Int !Type !Type !Int !Int + -- | In the declaration of a type constructor. + | TyConDeclCtxt !Name !(TyConFlavour TyCon) + -- | In a type or data family instance (or default instance). + | TyConInstCtxt !Name !TyConInstFlavour + -- | In the declaration of a data constructor. + | DataConDefCtxt !(NE.NonEmpty (LocatedN Name)) + -- | In the result type of a data constructor. + | DataConResTyCtxt !(NE.NonEmpty (LocatedN Name)) + -- | In the equations for a closed type family. + | ClosedFamEqnCtxt !TyCon + -- | In the expansion of a type synonym. + | TySynErrCtxt !TyCon + -- | In a role annotation. + | RoleAnnotErrCtxt !Name + -- | In an arrow command. + | CmdCtxt !(HsCmd GhcRn) + -- | In an instance declaration. + | InstDeclErrCtxt !(Either (LHsType GhcRn) PredType) + -- | In a default declaration. + | DefaultDeclErrCtxt { ddec_in_type_list :: !Bool } + -- | In the body of a static form. + | StaticFormCtxt !(LHsExpr GhcRn) + -- | In a pattern binding. + | forall p. OutputableBndrId p + => PatMonoBindsCtxt !(LPat (GhcPass p)) !(GRHSs GhcRn (LHsExpr GhcRn)) + -- | In a foreign import/export declaration. + | ForeignDeclCtxt !(ForeignDecl GhcRn) + -- | In a record field. + | FieldCtxt !FieldLabelString + -- | In a type. + | TypeCtxt !(LHsType GhcRn) + -- | In a kind. + | KindCtxt !(LHsKind GhcRn) + -- | In an ambiguity check. + | AmbiguityCheckCtxt !UserTypeCtxt !Bool + + -- | In a term-level use of a 'Name'. + | TermLevelUseCtxt !Name !TermLevelUseCtxt + + -- | When checking the type of the @main@ function. + | MainCtxt !Name + -- | Warning emitted when inferring use of visible dependent quantification. + | VDQWarningCtxt !TcTyCon + + -- | In a statement. + | forall body. + ( Anno (StmtLR GhcRn GhcRn body) ~ SrcSpanAnnA + , Outputable body + ) => StmtErrCtxt !HsStmtContextRn !(StmtLR GhcRn GhcRn body) + + -- | In an rebindable syntax expression. + | SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan + -- | In a RULE. + | RuleCtxt !FastString + -- | In a subtype check. + | SubTypeCtxt !TcType !TcType + + -- | In an export. + | forall p. OutputableBndrId p + => ExportCtxt (IE (GhcPass p)) + -- | In an export of a pattern synonym. + | PatSynExportCtxt !PatSyn + -- | In an export of a pattern synonym record field. + | PatSynRecSelExportCtxt !PatSyn !Name + + -- | In an annotation. + | forall p. OutputableBndrId p + => AnnCtxt (AnnDecl (GhcPass p)) + + -- | In a specialise pragma. + | SpecPragmaCtxt !(Sig GhcRn) + + -- | In a deriving clause. + | DerivInstCtxt !PredType + -- | In a standalone deriving clause. + | StandaloneDerivCtxt !(LHsSigWcType GhcRn) + -- | When typechecking the body of a derived instance. + | DerivBindCtxt !Id !Class ![Type] + + -- | In an untyped Template Haskell quote. + | UntypedTHBracketCtxt !(HsQuote GhcPs) + -- | In a typed Template Haskell quote. + | forall p. OutputableBndrId p + => TypedTHBracketCtxt !(LHsExpr (GhcPass p)) + -- | In an untyped Template Haskell splice or quasi-quote. + | UntypedSpliceCtxt !(HsUntypedSplice GhcPs) + -- | In a typed Template Haskell splice. + | forall p. OutputableBndrId p + => TypedSpliceCtxt !(Maybe SplicePointName) !(HsTypedSplice (GhcPass p)) + -- | In the result of a typed Template Haskell splice. + | TypedSpliceResultCtxt !(LHsExpr GhcTc) + -- | In an argument to the Template Haskell @reifyInstances@ function. + | ReifyInstancesCtxt !TH.Name ![TH.Type] + + -- | While merging Backpack signatures. + | MergeSignaturesCtxt !UnitState !ModuleName ![InstantiatedModule] + -- | While checking that a module implements a Backpack signature. + | CheckImplementsCtxt !UnitState !Module !InstantiatedModule diff --git a/GHC/Tc/Types/EvTerm.hs b/GHC/Tc/Types/EvTerm.hs deleted file mode 100644 --- a/GHC/Tc/Types/EvTerm.hs +++ /dev/null @@ -1,72 +0,0 @@ - --- (those who have too heavy dependencies for GHC.Tc.Types.Evidence) -module GHC.Tc.Types.EvTerm - ( evDelayedError, evCallStack ) -where - -import GHC.Prelude - -import GHC.Driver.DynFlags - -import GHC.Tc.Types.Evidence - -import GHC.Unit - -import GHC.Builtin.Names -import GHC.Builtin.Types ( unitTy ) - -import GHC.Core.Type -import GHC.Core -import GHC.Core.Make -import GHC.Core.Utils - -import GHC.Types.SrcLoc -import GHC.Types.TyThing - --- Used with Opt_DeferTypeErrors --- See Note [Deferring coercion errors to runtime] --- in GHC.Tc.Solver -evDelayedError :: Type -> String -> EvTerm -evDelayedError ty msg - = EvExpr $ - let fail_expr = mkRuntimeErrorApp tYPE_ERROR_ID unitTy msg - in mkWildCase fail_expr (unrestricted unitTy) ty [] - -- See Note [Incompleteness and linearity] in GHC.HsToCore.Utils - -- c.f. mkErrorAppDs in GHC.HsToCore.Utils - --- Dictionary for CallStack implicit parameters -evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) => - EvCallStack -> m EvExpr --- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -evCallStack EvCsEmpty = - Var <$> lookupId emptyCallStackName -evCallStack (EvCsPushCall fs loc tm) = do - df <- getDynFlags - let platform = targetPlatform df - m <- getModule - srcLocDataCon <- lookupDataCon srcLocDataConName - let mkSrcLoc l = mkCoreConApps srcLocDataCon <$> - sequence [ mkStringExprFS (unitFS $ moduleUnit m) - , mkStringExprFS (moduleNameFS $ moduleName m) - , mkStringExprFS (srcSpanFile l) - , return $ mkIntExprInt platform (srcSpanStartLine l) - , return $ mkIntExprInt platform (srcSpanStartCol l) - , return $ mkIntExprInt platform (srcSpanEndLine l) - , return $ mkIntExprInt platform (srcSpanEndCol l) - ] - - pushCSVar <- lookupId pushCallStackName - let pushCS name loc rest = - mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest] - - let mkPush name loc tm = do - nameExpr <- mkStringExprFS name - locExpr <- mkSrcLoc loc - -- at this point tm :: IP sym CallStack - -- but we need the actual CallStack to pass to pushCS, - -- so we use unwrapIP to strip the dictionary wrapper - -- See Note [Overview of implicit CallStacks] - let ip_co = unwrapIP (exprType tm) - return (pushCS nameExpr locExpr (Cast tm ip_co)) - - mkPush fs loc tm diff --git a/GHC/Tc/Types/Evidence.hs b/GHC/Tc/Types/Evidence.hs --- a/GHC/Tc/Types/Evidence.hs +++ b/GHC/Tc/Types/Evidence.hs @@ -15,7 +15,7 @@ -- * Evidence bindings TcEvBinds(..), EvBindsVar(..), - EvBindMap(..), emptyEvBindMap, extendEvBinds, + EvBindMap(..), emptyEvBindMap, extendEvBinds, unionEvBindMap, lookupEvBind, evBindMapBinds, foldEvBindMap, nonDetStrictFoldEvBindMap, filterEvBindMap, @@ -27,10 +27,14 @@ -- * EvTerm (already a CoreExpr) EvTerm(..), EvExpr, - evId, evCoercion, evCast, evDFunApp, evDataConApp, evSelector, - mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, findNeededEvVars, + evId, evCoercion, evCast, evCastE, evDFunApp, evDictApp, evSelector, evDelayedError, + mkEvScSelectors, evTypeable, + evWrapIPE, evUnwrapIPE, evUnaryDictAppE, + mkEvCast, + nestedEvIdsOfTerm, evTermFVs, evTermCoercion, evTermCoercion_maybe, + evExprCoercion, evExprCoercion_maybe, EvCallStack(..), EvTypeable(..), @@ -39,10 +43,9 @@ -- * TcCoercion TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole, - TcMCoercion, TcMCoercionN, TcMCoercionR, MultiplicityCheckCoercions, + TcMCoercion, TcMCoercionN, TcMCoercionR, Role(..), LeftOrRight(..), pickLR, maybeSymCo, - unwrapIP, wrapIP, -- * QuoteWrapper QuoteWrapper(..), applyQuoteWrapper, quoteWrapperTyVarTy @@ -50,29 +53,35 @@ import GHC.Prelude -import GHC.Types.Unique.DFM -import GHC.Types.Unique.FM -import GHC.Types.Var -import GHC.Types.Id( idScaledType ) +import GHC.Tc.Utils.TcType + +import GHC.Core import GHC.Core.Coercion.Axiom import GHC.Core.Coercion -import GHC.Core.Utils( mkCast ) import GHC.Core.Ppr () -- Instance OutputableBndr TyVar -import GHC.Tc.Utils.TcType +import GHC.Core.Predicate import GHC.Core.Type import GHC.Core.TyCon -import GHC.Core.DataCon ( DataCon, dataConWrapId ) -import GHC.Builtin.Names +import GHC.Core.Make ( mkWildCase, mkRuntimeErrorApp, tYPE_ERROR_ID ) +import GHC.Core.Class ( classTyCon ) +import GHC.Core.DataCon ( dataConWrapId ) +import GHC.Core.Class (Class, classSCSelId ) +import GHC.Core.FVs +import GHC.Core.InstEnv ( CanonicalEvidence(..) ) + +import GHC.Types.Unique.DFM +import GHC.Types.Unique.FM +import GHC.Types.Name( isInternalName ) +import GHC.Types.Var +import GHC.Types.Id( idScaledType ) import GHC.Types.Var.Env import GHC.Types.Var.Set -import GHC.Core.Predicate import GHC.Types.Basic -import GHC.Core -import GHC.Core.Class (Class, classSCSelId ) -import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( CanonicalEvidence(..) ) +import GHC.Builtin.Names +import GHC.Builtin.Types( unitTy ) +import GHC.Utils.FV import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Outputable @@ -111,11 +120,7 @@ type TcMCoercionN = MCoercionN -- nominal type TcMCoercionR = MCoercionR -- representational -type MultiplicityCheckCoercions = [TcCoercion] --- Coercions which must all be reflexivity after zonking. --- See Note [Coercions returned from tcSubMult] in GHC.Tc.Utils.Unify. - -- | If a 'SwapFlag' is 'IsSwapped', flip the orientation of a coercion maybeSymCo :: SwapFlag -> TcCoercion -> TcCoercion maybeSymCo IsSwapped co = mkSymCo co @@ -177,10 +182,6 @@ | WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, -- so that the identity coercion is always exactly WpHole - - | WpMultCoercion Coercion -- Require that a Coercion be reflexive; otherwise, - -- error in the desugarer. See GHC.Tc.Utils.Unify - -- Note [Coercions returned from tcSubMult] deriving Data.Data -- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data @@ -203,28 +204,44 @@ mempty = WpHole (<.>) :: HsWrapper -> HsWrapper -> HsWrapper -WpHole <.> c = c -c <.> WpHole = c -c1 <.> c2 = c1 `WpCompose` c2 +WpHole <.> c = c +c <.> WpHole = c +WpCast c1 <.> WpCast c2 = WpCast (c1 `mkTransCo` c2) + -- If we can represent the HsWrapper as a cast, try to do so: this may avoid + -- unnecessary eta-expansion (see 'mkWpFun'). +c1 <.> c2 = c1 `WpCompose` c2 --- | Smart constructor to create a 'WpFun' 'HsWrapper'. +-- | Smart constructor to create a 'WpFun' 'HsWrapper', which avoids introducing +-- a lambda abstraction if the two supplied wrappers are either identities or +-- casts. -- --- PRECONDITION: the "from" type of the first wrapper must have a syntactically --- fixed RuntimeRep (see Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete). +-- PRECONDITION: either: +-- +-- 1. both of the 'HsWrapper's are identities or casts, or +-- 2. both the "from" and "to" types of the first wrapper have a syntactically +-- fixed RuntimeRep (see Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete). mkWpFun :: HsWrapper -> HsWrapper -> Scaled TcTypeFRR -- ^ the "from" type of the first wrapper - -- MUST have a fixed RuntimeRep -> TcType -- ^ Either "from" type or "to" type of the second wrapper -- (used only when the second wrapper is the identity) -> HsWrapper - -- NB: we can't check that the argument type has a fixed RuntimeRep with an assertion, - -- because of [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] - -- in GHC.Tc.Utils.Concrete. mkWpFun WpHole WpHole _ _ = WpHole mkWpFun WpHole (WpCast co2) (Scaled w t1) _ = WpCast (mk_wp_fun_co w (mkRepReflCo t1) co2) mkWpFun (WpCast co1) WpHole (Scaled w _) t2 = WpCast (mk_wp_fun_co w (mkSymCo co1) (mkRepReflCo t2)) mkWpFun (WpCast co1) (WpCast co2) (Scaled w _) _ = WpCast (mk_wp_fun_co w (mkSymCo co1) co2) -mkWpFun co1 co2 t1 _ = WpFun co1 co2 t1 +mkWpFun w_arg w_res t1 _ = + -- In this case, we will desugar to a lambda + -- + -- \x. w_res[ e w_arg[x] ] + -- + -- To satisfy Note [Representation polymorphism invariants] in GHC.Core, + -- it must be the case that both the lambda bound variable x and the function + -- argument w_arg[x] have a fixed runtime representation, i.e. that both the + -- "from" and "to" types of the first wrapper "w_arg" have a fixed runtime representation. + -- + -- Unfortunately, we can't check this with an assertion here, because of + -- [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. + WpFun w_arg w_res t1 mkWpEta :: [Id] -> HsWrapper -> HsWrapper -- (mkWpEta [x1, x2] wrap) [e] @@ -272,12 +289,7 @@ -- but in that case we refrain from calling it. mkWpForAllCast :: [ForAllTyBinder] -> Type -> HsWrapper mkWpForAllCast bndrs res_ty - = mkWpCastR (go bndrs) - where - go [] = mkRepReflCo res_ty - go (Bndr tv vis : bs) = mkForAllCo tv coreTyLamForAllTyFlag vis kind_co (go bs) - where - kind_co = mkNomReflCo (varType tv) + = mkWpCastR (mkForAllVisCos bndrs (mkRepReflCo res_ty)) mkWpEvLams :: [Var] -> HsWrapper mkWpEvLams ids = mk_co_lam_fn WpEvLam ids @@ -322,7 +334,6 @@ go (WpTyLam {}) = emptyBag go (WpTyApp {}) = emptyBag go (WpLet {}) = emptyBag - go (WpMultCoercion {}) = emptyBag collectHsWrapBinders :: HsWrapper -> ([Var], HsWrapper) -- Collect the outer lambda binders of a HsWrapper, @@ -367,11 +378,13 @@ -- (dictionaries etc) -- Some Given, some Wanted - ebv_tcvs :: IORef CoVarSet - -- The free Given coercion vars needed by Wanted coercions that - -- are solved by filling in their HoleDest in-place. Since they - -- don't appear in ebv_binds, we keep track of their free - -- variables so that we can report unused given constraints + ebv_tcvs :: IORef [TcCoercion] + -- When we solve a Wanted by filling in a CoercionHole, it is as + -- if we were adding an evidence binding + -- co_hole := coercion + -- We keep all these RHS coercions in a list, alongside `ebv_binds`, + -- so that we can report unused given constraints, + -- in GHC.Tc.Solver.neededEvVars -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } @@ -379,14 +392,19 @@ -- See above for comments on ebv_uniq, ebv_tcvs ebv_uniq :: Unique, - ebv_tcvs :: IORef CoVarSet + ebv_tcvs :: IORef [TcCoercion] } instance Data.Data TcEvBinds where - -- Placeholder; we can't travers into TcEvBinds + -- Placeholder; we can't traverse into TcEvBinds toConstr _ = abstractConstr "TcEvBinds" gunfold _ _ = error "gunfold" dataTypeOf _ = Data.mkNoRepType "TcEvBinds" +instance Data.Data EvBind where + -- Placeholder; we can't traverse into EvBind + toConstr _ = abstractConstr "TcEvBind" + gunfold _ _ = error "gunfold" + dataTypeOf _ = Data.mkNoRepType "EvBind" {- Note [Coercion evidence only] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -438,6 +456,11 @@ (eb_lhs ev_bind) ev_bind } +-- | Union two evidence binding maps +unionEvBindMap :: EvBindMap -> EvBindMap -> EvBindMap +unionEvBindMap (EvBindMap env1) (EvBindMap env2) = + EvBindMap { ev_bind_varenv = plusDVarEnv env1 env2 } + isEmptyEvBindMap :: EvBindMap -> Bool isEmptyEvBindMap (EvBindMap m) = isEmptyDVarEnv m @@ -506,17 +529,14 @@ | EvFun -- /\as \ds. let binds in v { et_tvs :: [TyVar] , et_given :: [EvVar] - , et_binds :: TcEvBinds -- This field is why we need an EvFun - -- constructor, and can't just use EvExpr + , et_binds :: TcEvBinds -- This field is why we need an EvFun + -- constructor, and can't just use EvExpr , et_body :: EvVar } deriving Data.Data type EvExpr = CoreExpr --- An EvTerm is (usually) constructed by any of the constructors here --- and those more complicated ones who were moved to module GHC.Tc.Types.EvTerm - -- | Any sort of evidence Id, including coercions evId :: EvId -> EvExpr evId = Var @@ -526,18 +546,63 @@ evCoercion :: TcCoercion -> EvTerm evCoercion co = EvExpr (Coercion co) --- | d |> co +{-# DEPRECATED mkEvCast "Please use evCast instead" #-} +-- We had gotten duplicate functions; let's get rid of mkEvCast in due course +mkEvCast :: EvExpr -> TcCoercion -> EvTerm +mkEvCast = evCast + evCast :: EvExpr -> TcCoercion -> EvTerm -evCast et tc | isReflCo tc = EvExpr et - | otherwise = EvExpr (mkCast et tc) +evCast et tc = EvExpr (evCastE et tc) --- Dictionary instance application +-- | d |> co +evCastE :: EvExpr -> TcCoercion -> EvExpr +evCastE ee co + | assertPpr (coercionRole co == Representational) + (vcat [text "Coercion of wrong role passed to evCastE:", ppr ee, ppr co]) $ + isReflCo co = ee + | otherwise = Cast ee co + evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm -evDFunApp df tys ets = EvExpr $ Var df `mkTyApps` tys `mkApps` ets +-- Dictionary instance application, including when the "dictionary function" +-- is actually the data construtor for a dictionary +evDFunApp df tys ets = EvExpr (evDFunAppE df tys ets) -evDataConApp :: DataCon -> [Type] -> [EvExpr] -> EvTerm -evDataConApp dc tys ets = evDFunApp (dataConWrapId dc) tys ets +evDFunAppE :: DFunId -> [Type] -> [EvExpr] -> EvExpr +evDFunAppE df tys ets = Var df `mkTyApps` tys `mkApps` ets +evDictApp :: Class -> [Type] -> [EvExpr] -> EvTerm +evDictApp cls tys args = EvExpr (evDictAppE cls tys args) + +evDictAppE :: Class -> [Type] -> [EvExpr] -> EvExpr +evDictAppE cls tys args + = case tyConSingleDataCon_maybe (classTyCon cls) of + Just dc -> evDFunAppE (dataConWrapId dc) tys args + Nothing -> pprPanic "evDictApp" (ppr cls) + +evUnaryDictAppE :: Class -> [Type] -> EvExpr -> EvExpr +-- See (UCM6) in Note [Unary class magic] in GHC.Core.TyCon +evUnaryDictAppE cls tys meth + = evDictAppE cls tys [meth] + +evWrapIPE :: PredType -> EvExpr -> EvExpr +-- Given pred = IP s ty + -- et_tm :: ty +-- Return an EvTerm of type (IP s ty) +evWrapIPE pred ev_tm + = evUnaryDictAppE cls tys ev_tm + where + (cls, tys) = getClassPredTys pred + +evUnwrapIPE :: PredType -> EvExpr -> EvExpr +-- Given pred = IP s ty + -- et_tm :: (IP s ty) +-- Return an EvTerm of type ty +evUnwrapIPE pred ev_tm + = mkApps (Var ip_sel) (map Type tys ++ [ev_tm]) + where + (ip_sel, tys) = decomposeIPPred pred + + -- Selector id plus the types at which it -- should be instantiated, used for HasField -- dictionaries; see Note [HasField instances] @@ -595,7 +660,7 @@ -} -- | Where to store evidence for expression holes --- See Note [Holes] in GHC.Tc.Types.Constraint +-- See Note [Holes in expressions] in GHC.Hs.Expr. data HoleExprRef = HER (IORef EvTerm) -- ^ where to write the erroring expression TcType -- ^ expected type of that expression Unique -- ^ for debug output only @@ -665,7 +730,6 @@ [Notice though that evidence variables that bind coercion terms from super classes will be "given" and hence rigid] - Note [Overview of implicit CallStacks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (See https://gitlab.haskell.org/ghc/ghc/wikis/explicit-call-stack/implicit-locations) @@ -677,12 +741,13 @@ type HasCallStack = (?callStack :: CallStack) -Implicit parameters of type GHC.Stack.Types.CallStack (the name is not -important) are solved in three steps: +Implicit parameters of type GHC.Stack.Types.CallStack (the /name/ of the +implicit parameter is not important, see (CS5) below) are solved as follows: -1. Explicit, user-written occurrences of `?stk :: CallStack` - which have IPOccOrigin, are solved directly from the given IP, - just like a regular IP; see GHC.Tc.Solver.Dict.tryInertDicts. +1. Plan NORMAL. Explicit, user-written occurrences of `?stk :: CallStack`, which + have IPOccOrigin, are solved directly from the given IP, just like any other + implicit-parameter constraint; see GHC.Tc.Solver.Dict.tryInertDicts. We can + solve it from a Given or from another Wanted, if the two have the same type. For example, the occurrence of `?stk` in @@ -691,44 +756,33 @@ will be solved for the `?stk` in `error`s context as before. -2. In a function call, instead of simply passing the given IP, we first - append the current call-site to it. For example, consider a - call to the callstack-aware `error` above. - - foo :: (?stk :: CallStack) => a - foo = error "undefined!" - - Here we want to take the given `?stk` and append the current - call-site, before passing it to `error`. In essence, we want to - rewrite `foo "undefined!"` to - - let ?stk = pushCallStack ?stk - in foo "undefined!" +2. Plan PUSH. A /function call/ with a CallStack constraint, such as + a call to `foo` where + foo :: (?stk :: CallStack) => a + will give rise to a Wanted constraint + [W] d :: (?stk :: CallStack) CtOrigin = OccurrenceOf "foo" - We achieve this as follows: + We do /not/ solve this constraint from Givens, or from other + Wanteds. Rather, have a built-in mechanism in that solves it thus: + d := EvCsPushCall "foo"
d2 + [W] d2 :: (?stk :: CallStack) CtOrigin = IPOccOrigin - * At a call of foo :: (?stk :: CallStack) => blah - we emit a Wanted - [W] d1 : IP "stk" CallStack - with CtOrigin = OccurrenceOf "foo" + That is, `d` is a call-stack that has the `foo` call-site pushed on top of + `d2`, which can now be solved normally (as in (1) above). This is done as follows: + - In GHC.Tc.Solver.Dict.canDictCt we do the pushing. + - We only look up canonical constraints in the inert set - * We /solve/ this constraint, in GHC.Tc.Solver.Dict.canDictNC - by emitting a NEW Wanted - [W] d2 :: IP "stk" CallStack - with CtOrigin = IPOccOrigin +3. For a CallStack constraint, we choose how to solve it based on its CtOrigin: - and solve d1 = EvCsPushCall "foo" (EvId d1) + * solve it normally (plan NORMAL above) + - IPOccOrigin (discussed above) + - GivenOrigin (see (CS1) below) - * The new Wanted, for `d2` will be solved per rule (1), ie as a regular IP. + * push an item on the stack and emit a new constraint (plan PUSH above) + - OccurrenceOf "foo" (discused above) + - anything else (see (CS1) below) -3. We use the predicate isPushCallStackOrigin to identify whether we - want to do (1) solve directly, or (2) push and then solve directly. - Key point (see #19918): the CtOrigin where we want to push an item on the - call stack can include IfThenElseOrigin etc, when RebindableSyntax is - involved. See the defn of fun_orig in GHC.Tc.Gen.App.tcInstFun; it is - this CtOrigin that is pinned on the constraints generated by functions - in the "expansion" for rebindable syntax. c.f. GHC.Rename.Expr - Note [Handling overloaded and rebindable constructs] + This choice is by the predicate isPushCallStackOrigin_maybe 4. We default any insoluble CallStacks to the empty CallStack. Suppose `undefined` did not request a CallStack, ie @@ -764,21 +818,38 @@ in `g`, because `head` did not explicitly request a CallStack. -Important Details: -- GHC should NEVER report an insoluble CallStack constraint. +Wrinkles -- GHC should NEVER infer a CallStack constraint unless one was requested +(CS1) Which CtOrigins should qualify for plan PUSH? Certainly ones that arise + from a function call like (f a b). + + But (see #19918) when RebindableSyntax is involved we can function call whose + CtOrigin is somethign like `IfThenElseOrigin`. See the defn of fun_orig in + GHC.Tc.Gen.App.tcInstFun; it is this CtOrigin that is pinned on the + constraints generated by functions in the "expansion" for rebindable + syntax. c.f. GHC.Rename.Expr Note [Handling overloaded and rebindable + constructs]. + + So isPushCallStackOrigin_maybe has a fall-through for "anything else", and + assumes that we should adopt plan PUSH for it. + + However we should /not/ take this fall-through for Given constraints + (#25675). So isPushCallStackOrigin_maybe identifies Givens as plan NORMAL. + +(CS2) GHC should NEVER report an insoluble CallStack constraint. + +(CS3) GHC should NEVER infer a CallStack constraint unless one was requested with a partial type signature (See GHC.Tc.Solver..pickQuantifiablePreds). -- A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)], +(CS4) A CallStack (defined in GHC.Stack.Types) is a [(String, SrcLoc)], where the String is the name of the binder that is used at the SrcLoc. SrcLoc is also defined in GHC.Stack.Types and contains the package/module/file name, as well as the full source-span. Both CallStack and SrcLoc are kept abstract so only GHC can construct new values. -- We will automatically solve any wanted CallStack regardless of the - name of the IP, i.e. +(CS5) We will automatically solve any wanted CallStack regardless of the + /name/ of the IP, i.e. f = show (?stk :: CallStack) g = show (?loc :: CallStack) @@ -792,27 +863,18 @@ the printed CallStack will NOT include head's call-site. This reflects the standard scoping rules of implicit-parameters. -- An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`. +(CS6) An EvCallStack term desugars to a CoreExpr of type `IP "some str" CallStack`. The desugarer will need to unwrap the IP newtype before pushing a new call-site onto a given stack (See GHC.HsToCore.Binds.dsEvCallStack) -- When we emit a new wanted CallStack from rule (2) we set its origin to +(CS7) When we emit a new wanted CallStack in plan PUSH we set its origin to `IPOccOrigin ip_name` instead of the original `OccurrenceOf func` (see GHC.Tc.Solver.Dict.tryInertDicts). This is a bit shady, but is how we ensure that the new wanted is solved like a regular IP. - -} -mkEvCast :: EvExpr -> TcCoercion -> EvTerm -mkEvCast ev lco - | assertPpr (coercionRole lco == Representational) - (vcat [text "Coercion of wrong role passed to mkEvCast:", ppr ev, ppr lco]) $ - isReflCo lco = EvExpr ev - | otherwise = evCast ev lco - - mkEvScSelectors -- Assume class (..., D ty, ...) => C a b :: Class -> [TcType] -- C ty1 ty2 -> [(TcPredType, -- D ty[ty1/a,ty2/b] @@ -832,25 +894,42 @@ isEmptyTcEvBinds (EvBinds b) = isEmptyBag b isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds" +evExprCoercion_maybe :: EvExpr -> Maybe TcCoercion +-- Applied only to EvExprs of type (s~t) +-- See Note [Coercion evidence terms] +evExprCoercion_maybe (Var v) = return (mkCoVarCo v) +evExprCoercion_maybe (Coercion co) = return co +evExprCoercion_maybe (Cast tm co) = do { co' <- evExprCoercion_maybe tm + ; return (mkCoCast co' co) } +evExprCoercion_maybe _ = Nothing + +evExprCoercion :: EvExpr -> TcCoercion +evExprCoercion tm = case evExprCoercion_maybe tm of + Just co -> co + Nothing -> pprPanic "evExprCoercion" (ppr tm) + evTermCoercion_maybe :: EvTerm -> Maybe TcCoercion -- Applied only to EvTerms of type (s~t) -- See Note [Coercion evidence terms] evTermCoercion_maybe ev_term - | EvExpr e <- ev_term = go e + | EvExpr e <- ev_term = evExprCoercion_maybe e | otherwise = Nothing - where - go :: EvExpr -> Maybe TcCoercion - go (Var v) = return (mkCoVarCo v) - go (Coercion co) = return co - go (Cast tm co) = do { co' <- go tm - ; return (mkCoCast co' co) } - go _ = Nothing evTermCoercion :: EvTerm -> TcCoercion evTermCoercion tm = case evTermCoercion_maybe tm of Just co -> co Nothing -> pprPanic "evTermCoercion" (ppr tm) +-- Used with Opt_DeferTypeErrors +-- See Note [Deferring coercion errors to runtime] +-- in GHC.Tc.Solver +evDelayedError :: Type -> String -> EvTerm +evDelayedError ty msg + = EvExpr $ + let fail_expr = mkRuntimeErrorApp tYPE_ERROR_ID unitTy msg + in mkWildCase fail_expr (unrestricted unitTy) ty [] + -- See Note [Incompleteness and linearity] in GHC.HsToCore.Utils + -- c.f. mkErrorAppDs in GHC.HsToCore.Utils {- ********************************************************************* * * @@ -858,41 +937,38 @@ * * ********************************************************************* -} -findNeededEvVars :: EvBindMap -> VarSet -> VarSet --- Find all the Given evidence needed by seeds, --- looking transitively through binds -findNeededEvVars ev_binds seeds - = transCloVarSet also_needs seeds - where - also_needs :: VarSet -> VarSet - also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs - -- It's OK to use a non-deterministic fold here because we immediately - -- forget about the ordering by creating a set +isNestedEvId :: Var -> Bool +-- Just returns /nested/ free evidence variables; i.e ones with Internal Names +-- Top-level ones (DFuns, dictionary selectors and the like) don't count +-- Evidence variables are always Ids; do not pick TyVars +isNestedEvId v = isId v && isInternalName (varName v) - add :: Var -> VarSet -> VarSet - add v needs - | Just ev_bind <- lookupEvBind ev_binds v - , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind - = evVarsOfTerm rhs `unionVarSet` needs - | otherwise - = needs +nestedEvIdsOfTerm :: EvTerm -> VarSet +-- Returns only EvIds satisfying relevantEvId +nestedEvIdsOfTerm tm = fvVarSet (filterFV isNestedEvId (evTermFVs tm)) -evVarsOfTerm :: EvTerm -> VarSet -evVarsOfTerm (EvExpr e) = exprSomeFreeVars isEvVar e -evVarsOfTerm (EvTypeable _ ev) = evVarsOfTypeable ev -evVarsOfTerm (EvFun {}) = emptyVarSet -- See Note [Free vars of EvFun] +evTermFVs :: EvTerm -> FV +evTermFVs (EvExpr e) = exprFVs e +evTermFVs (EvTypeable _ ev) = evFVsOfTypeable ev +evTermFVs (EvFun { et_tvs = tvs, et_given = given + , et_binds = tc_ev_binds, et_body = v }) + = case tc_ev_binds of + TcEvBinds {} -> emptyFV -- See Note [Free vars of EvFun] + EvBinds binds -> addBndrsFV bndrs fvs + where + fvs = foldr (unionFV . evTermFVs . eb_rhs) (unitFV v) binds + bndrs = foldr ((:) . eb_lhs) (tvs ++ given) binds -evVarsOfTerms :: [EvTerm] -> VarSet -evVarsOfTerms = mapUnionVarSet evVarsOfTerm +evTermFVss :: [EvTerm] -> FV +evTermFVss = mapUnionFV evTermFVs -evVarsOfTypeable :: EvTypeable -> VarSet -evVarsOfTypeable ev = +evFVsOfTypeable :: EvTypeable -> FV +evFVsOfTypeable ev = case ev of - EvTypeableTyCon _ e -> mapUnionVarSet evVarsOfTerm e - EvTypeableTyApp e1 e2 -> evVarsOfTerms [e1,e2] - EvTypeableTrFun em e1 e2 -> evVarsOfTerms [em,e1,e2] - EvTypeableTyLit e -> evVarsOfTerm e - + EvTypeableTyCon _ e -> mapUnionFV evTermFVs e + EvTypeableTyApp e1 e2 -> evTermFVss [e1,e2] + EvTypeableTrFun em e1 e2 -> evTermFVss [em,e1,e2] + EvTypeableTyLit e -> evTermFVs e {- Note [Free vars of EvFun] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -900,19 +976,22 @@ bindings et_binds may be a mutable variable. Fortunately, we can just squeeze by. Here's how. -* evVarsOfTerm is used only by GHC.Tc.Solver.neededEvVars. -* Each EvBindsVar in an et_binds field of an EvFun is /also/ in the - ic_binds field of an Implication -* So we can track usage via the processing for that implication, - (see Note [Tracking redundant constraints] in GHC.Tc.Solver). - We can ignore usage from the EvFun altogether. +* /During/ typechecking, `evTermFVs` is used only by `GHC.Tc.Solver.neededEvVars` + * Each EvBindsVar in an et_binds field of an EvFun is /also/ in the + ic_binds field of an Implication + * So we can track usage via the processing for that implication, + (see Note [Tracking redundant constraints] in GHC.Tc.Solver). + We can ignore usage from the EvFun altogether. -************************************************************************ +* /After/ typechecking `evTermFVs` is used by `GHC.Iface.Ext.Ast`, but by + then it has been zonked so we can get at the bindings. +-} + +{- ********************************************************************* * * Pretty printing * * -************************************************************************ --} +********************************************************************* -} instance Outputable HsWrapper where ppr co_fn = pprHsWrapper co_fn (no_parens (text "<>")) @@ -941,8 +1020,6 @@ help it (WpEvLam id) = add_parens $ sep [ text "\\" <> pprLamBndr id <> dot, it False] help it (WpTyLam tv) = add_parens $ sep [text "/\\" <> pprLamBndr tv <> dot, it False] help it (WpLet binds) = add_parens $ sep [text "let" <+> braces (ppr binds), it False] - help it (WpMultCoercion co) = add_parens $ sep [it False, nest 2 (text "" - <+> pprParendCo co)] pprLamBndr :: Id -> SDoc pprLamBndr v = pprBndr LambdaBind v @@ -995,30 +1072,6 @@ ppr (EvTypeableTrFun tm t1 t2) = parens (ppr t1 <+> arr <+> ppr t2) where arr = pprArrowWithMultiplicity visArgTypeLike (Right (ppr tm)) - - ----------------------------------------------------------------------- --- Helper functions for dealing with IP newtype-dictionaries ----------------------------------------------------------------------- - --- | Create a 'Coercion' that unwraps an implicit-parameter --- dictionary to expose the underlying value. --- We expect the 'Type' to have the form `IP sym ty`, --- and return a 'Coercion' `co :: IP sym ty ~ ty` -unwrapIP :: Type -> CoercionR -unwrapIP ty = - case unwrapNewTyCon_maybe tc of - Just (_,_,ax) -> mkUnbranchedAxInstCo Representational ax tys [] - Nothing -> pprPanic "unwrapIP" $ - text "The dictionary for" <+> quotes (ppr tc) - <+> text "is not a newtype!" - where - (tc, tys) = splitTyConApp ty - --- | Create a 'Coercion' that wraps a value in an implicit-parameter --- dictionary. See 'unwrapIP'. -wrapIP :: Type -> CoercionR -wrapIP ty = mkSymCo (unwrapIP ty) ---------------------------------------------------------------------- -- A datatype used to pass information when desugaring quotations diff --git a/GHC/Tc/Types/LclEnv.hs b/GHC/Tc/Types/LclEnv.hs --- a/GHC/Tc/Types/LclEnv.hs +++ b/GHC/Tc/Types/LclEnv.hs @@ -11,13 +11,13 @@ , getLclEnvLoc , getLclEnvRdrEnv , getLclEnvTcLevel - , getLclEnvThStage + , getLclEnvThLevel , setLclEnvTcLevel , setLclEnvLoc , setLclEnvRdrEnv , setLclEnvBinderStack , setLclEnvErrCtxt - , setLclEnvThStage + , setLclEnvThLevel , setLclEnvTypeEnv , modifyLclEnvTcLevel @@ -108,7 +108,7 @@ -- we can look up record field names - tcl_th_ctxt :: ThStage, -- Template Haskell context + tcl_th_ctxt :: ThLevel, -- Template Haskell context tcl_th_bndrs :: ThBindEnv, -- and binder info -- The ThBindEnv records the TH binding level of in-scope Names -- defined in this module (not imported) @@ -119,14 +119,13 @@ tcl_env :: TcTypeEnv -- The local type environment: -- Ids and TyVars defined in this module - } -getLclEnvThStage :: TcLclEnv -> ThStage -getLclEnvThStage = tcl_th_ctxt . tcl_lcl_ctxt +getLclEnvThLevel :: TcLclEnv -> ThLevel +getLclEnvThLevel = tcl_th_ctxt . tcl_lcl_ctxt -setLclEnvThStage :: ThStage -> TcLclEnv -> TcLclEnv -setLclEnvThStage s = modifyLclCtxt (\env -> env { tcl_th_ctxt = s }) +setLclEnvThLevel :: ThLevel -> TcLclEnv -> TcLclEnv +setLclEnvThLevel l = modifyLclCtxt (\env -> env { tcl_th_ctxt = l }) getLclEnvThBndrs :: TcLclEnv -> ThBindEnv getLclEnvThBndrs = tcl_th_bndrs . tcl_lcl_ctxt @@ -188,7 +187,7 @@ type TcTypeEnv = NameEnv TcTyThing -type ThBindEnv = NameEnv (TopLevelFlag, ThLevel) +type ThBindEnv = NameEnv (TopLevelFlag, ThLevelIndex) -- Domain = all Ids bound in this module (ie not imported) -- The TopLevelFlag tells if the binding is syntactically top level. -- We need to know this, because the cross-stage persistence story allows @@ -196,6 +195,7 @@ -- -- Nota bene: a ThLevel of 'outerLevel' is *not* the same as being -- bound at top level! See Note [Template Haskell levels] in GHC.Tc.Gen.Splice + --------------------------- -- Arrow-notation context diff --git a/GHC/Tc/Types/Origin.hs b/GHC/Tc/Types/Origin.hs --- a/GHC/Tc/Types/Origin.hs +++ b/GHC/Tc/Types/Origin.hs @@ -1,9 +1,10 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} -- | Describes the provenance of types as they flow through the type-checker. -- The datatypes here are mainly used for error message generation. @@ -15,19 +16,22 @@ -- * SkolemInfo SkolemInfo(..), SkolemInfoAnon(..), mkSkolemInfo, getSkolemInfo, pprSigSkolInfo, pprSkolInfo, - unkSkol, unkSkolAnon, mkClsInstSkol, + unkSkol, unkSkolAnon, -- * CtOrigin CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, isVisibleOrigin, toInvisibleOrigin, - pprCtOrigin, isGivenOrigin, isWantedWantedFunDepOrigin, + pprCtOrigin, pprCtOriginBriefly, + isGivenOrigin, isWantedWantedFunDepOrigin, isWantedSuperclassOrigin, ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..), + HsImplicitLiftSplice(..), + StandaloneDeriv, TypedThing(..), TyVarBndrs(..), -- * CallStack - isPushCallStackOrigin, callStackOriginFS, + isPushCallStackOrigin_maybe, -- * FixedRuntimeRep origin FixedRuntimeRepOrigin(..), @@ -37,7 +41,7 @@ mkFRRUnboxedTuple, mkFRRUnboxedSum, -- ** FixedRuntimeRep origin for rep-poly 'Id's - RepPolyId(..), Polarity(..), Position(..), + RepPolyId(..), Polarity(..), Position(..), mkArgPos, -- ** Arrow command FixedRuntimeRep origin FRRArrowContext(..), pprFRRArrowContext, @@ -58,7 +62,6 @@ import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon -import GHC.Core.Class import GHC.Core.InstEnv import GHC.Core.PatSyn import GHC.Core.Multiplicity ( scaledThing ) @@ -77,13 +80,14 @@ import GHC.Utils.Panic import GHC.Stack import GHC.Utils.Monad -import GHC.Utils.Misc( HasDebugCallStack ) +import GHC.Utils.Misc( HasDebugCallStack, nTimes ) import GHC.Types.Unique import GHC.Types.Unique.Supply import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import qualified Data.Kind as Hs +import Data.List.NonEmpty (NonEmpty (..)) {- ********************************************************************* * * @@ -129,8 +133,6 @@ | PatSigCtxt -- Type sig in pattern -- eg f (x::t) = ... -- or (x::t, y) = e - | RuleSigCtxt FastString Name -- LHS of a RULE forall - -- RULE "foo" forall (x :: a -> a). f (Just x) = ... | ForSigCtxt Name -- Foreign import or export signature | DefaultDeclCtxt -- Class or types in a default declaration | InstDeclCtxt Bool -- An instance declaration @@ -153,6 +155,9 @@ -- data => T a = MkT a | DerivClauseCtxt -- A 'deriving' clause | TyVarBndrKindCtxt Name -- The kind of a type variable being bound + | RuleBndrTypeCtxt Name -- The type of a term variable being bound in a RULE + -- or SPECIALISE pragma + -- RULE "foo" forall (x :: a -> a). f (Just x) = ... | DataKindCtxt Name -- The kind of a data/newtype (instance) | TySynKindCtxt Name -- The kind of the RHS of a type synonym | TyFamResKindCtxt Name -- The result kind of a type family @@ -194,11 +199,10 @@ pprUserTypeCtxt :: UserTypeCtxt -> SDoc -pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (ppr n) -pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n) -pprUserTypeCtxt (RuleSigCtxt _ n) = text "the type signature for" <+> quotes (ppr n) -pprUserTypeCtxt (ExprSigCtxt _) = text "an expression type signature" -pprUserTypeCtxt KindSigCtxt = text "a kind signature" +pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (ppr n) +pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n) +pprUserTypeCtxt (ExprSigCtxt _) = text "an expression type signature" +pprUserTypeCtxt KindSigCtxt = text "a kind signature" pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n) pprUserTypeCtxt TypeAppCtxt = text "a type argument" pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) @@ -217,6 +221,7 @@ pprUserTypeCtxt (PatSynCtxt n) = text "the signature for pattern synonym" <+> quotes (ppr n) pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause" pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n) +pprUserTypeCtxt (RuleBndrTypeCtxt n) = text "the type signature for" <+> quotes (ppr n) pprUserTypeCtxt (DataKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n) pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n) pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n) @@ -286,7 +291,14 @@ ClsInstOrQC -- Whether class instance or quantified constraint PatersonSize -- Head has the given PatersonSize + | MethSkol Name Bool -- Bound by the type of class method op + -- True <=> it's a vanilla default method + -- False <=> it's a user-written, or generic-default, method + -- See (TRC5) in Note [Tracking redundant constraints] + -- in GHC.Tc.Solver.Solve + | FamInstSkol -- Bound at a family instance decl + | PatSkol -- An existential type variable bound by a pattern for ConLike -- a data constructor with an existential type. HsMatchContextRn @@ -298,6 +310,7 @@ | IPSkol [HsIPName] -- Binding site of an implicit parameter | RuleSkol RuleName -- The LHS of a RULE + | SpecESkol Name -- A SPECIALISE pragma | InferSkol [(Name,TcType)] -- We have inferred a type for these (mutually recursive) @@ -345,9 +358,6 @@ getSkolemInfo :: SkolemInfo -> SkolemInfoAnon getSkolemInfo (SkolemInfo _ skol_anon) = skol_anon -mkClsInstSkol :: Class -> [Type] -> SkolemInfoAnon -mkClsInstSkol cls tys = InstSkol IsClsInst (pSizeClassPred cls tys) - instance Outputable SkolemInfo where ppr (SkolemInfo _ sk_info ) = ppr sk_info @@ -364,11 +374,14 @@ pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred) pprSkolInfo (InstSkol IsClsInst sz) = vcat [ text "the instance declaration" , whenPprDebug (braces (ppr sz)) ] -pprSkolInfo (InstSkol (IsQC {}) sz) = vcat [ text "a quantified context" +pprSkolInfo (InstSkol (IsQC {}) sz) = vcat [ text "a quantified constraint" , whenPprDebug (braces (ppr sz)) ] +pprSkolInfo (MethSkol name d) = text "the" <+> ppWhen d (text "default") + <+> text "method declaration for" <+> ppr name pprSkolInfo FamInstSkol = text "a family instance declaration" pprSkolInfo BracketSkol = text "a Template Haskell bracket" pprSkolInfo (RuleSkol name) = text "the RULE" <+> pprRuleName name +pprSkolInfo (SpecESkol name) = text "a SPECIALISE pragma for" <+> quotes (ppr name) pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl , text "in" <+> pprMatchContext mc ] pprSkolInfo (InferSkol ids) = hang (text "the inferred type" <> plural ids <+> text "of") @@ -509,11 +522,11 @@ ----------- Below here, all are Origins for Wanted constraints ------------ - | OccurrenceOf Name -- Occurrence of an overloaded identifier - | OccurrenceOfRecSel RdrName -- Occurrence of a record selector - | AppOrigin -- An application of some kind + | OccurrenceOf Name -- ^ Occurrence of an overloaded identifier + | OccurrenceOfRecSel RdrName -- ^ Occurrence of a record selector + | AppOrigin -- ^ An application of some kind - | SpecPragOrigin UserTypeCtxt -- Specialisation pragma for + | SpecPragOrigin UserTypeCtxt -- ^ Specialisation pragma for -- function or instance @@ -544,7 +557,7 @@ -- IMPORTANT: These constraints will never cause errors; -- See Note [Constraints to ignore] in GHC.Tc.Errors | SectionOrigin - | HasFieldOrigin FastString + | GetFieldOrigin FastString | TupleOrigin -- (..,..) | ExprSigOrigin -- e :: ty | PatSigOrigin -- p :: ty @@ -561,9 +574,9 @@ ClsInstOrQC -- Whether class instance or quantified constraint NakedScFlag - | DerivClauseOrigin -- Typechecking a deriving clause (as opposed to - -- standalone deriving). - | DerivOriginDC DataCon Int Bool + | DerivOrigin StandaloneDeriv + -- Typechecking a `deriving` clause, or a standalone `deriving` declaration + | DerivOriginDC DataCon Int StandaloneDeriv -- Checking constraints arising from this data con and field index. The -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if -- standalong deriving (with a wildcard constraint) is being used. This @@ -571,14 +584,10 @@ -- the argument is True, then don't recommend "use standalone deriving", -- but rather "fill in the wildcard constraint yourself"). -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer - | DerivOriginCoerce Id Type Type Bool - -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from - -- `ty1` to `ty2`. - | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for - -- constraints coming from a wildcard constraint, - -- e.g., deriving instance _ => Eq (Foo a) - -- See Note [Inferring the instance context] - -- in GHC.Tc.Deriv.Infer + | DerivOriginCoerce Id Type Type StandaloneDeriv + -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from + -- `ty1` to `ty2`. + | DefaultOrigin -- Typechecking a default decl | DoOrigin -- Arising from a do expression | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in @@ -626,10 +635,10 @@ | OmittedFieldOrigin (Maybe FieldLabel) | UsageEnvironmentOf Name + -- | See Detail (7) of Note [Type equality cycles] in GHC.Tc.Solver.Equality | CycleBreakerOrigin CtOrigin -- origin of the original constraint - -- See Detail (7) of Note [Type equality cycles] in GHC.Tc.Solver.Equality | FRROrigin FixedRuntimeRepOrigin @@ -643,6 +652,7 @@ Type -- the instance-sig type Type -- the instantiated type of the method | AmbiguityCheckOrigin UserTypeCtxt + | ImplicitLiftOrigin HsImplicitLiftSplice data NonLinearPatternReason = LazyPatternReason @@ -651,13 +661,22 @@ | ViewPatternReason | OtherPatternReason +type StandaloneDeriv = Bool + -- False <=> a `deriving` clause on a data/newtype declaration + -- e.g. data T a = MkT a deriving( Eq ) + -- True <=> a standalone `deriving` clause with a wildcard constraint + -- e.g deriving instance _ => Eq (T a) + -- See Note [Inferring the instance context] + -- in GHC.Tc.Deriv.Infer + -- | The number of superclass selections needed to get this Given. -- If @d :: C ty@ has @ScDepth=2@, then the evidence @d@ will look -- like @sc_sel (sc_sel dg)@, where @dg@ is a Given. type ScDepth = Int -data ClsInstOrQC = IsClsInst - | IsQC CtOrigin +data ClsInstOrQC + = IsClsInst + | IsQC PredType CtOrigin -- The PredType is the forall-constraint we are trying to solve data NakedScFlag = NakedSc | NotNakedSc -- The NakedScFlag affects only GHC.Tc.Solver.InertSet.prohibitedSuperClassSolve @@ -707,17 +726,13 @@ instance Outputable CtOrigin where ppr = pprCtOrigin -ctoHerald :: SDoc -ctoHerald = text "arising from" - -- | Extract a suitable CtOrigin from a HsExpr lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin lexprCtOrigin (L _ e) = exprCtOrigin e exprCtOrigin :: HsExpr GhcRn -> CtOrigin -exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name -exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (field_label $ unLoc $ dfoLabel f) -exprCtOrigin (HsUnboundVar {}) = Shouldn'tHappenOrigin "unbound variable" +exprCtOrigin (HsVar _ (L _ (WithUserRdr _ name))) = OccurrenceOf name +exprCtOrigin (HsGetField _ _ (L _ f)) = GetFieldOrigin (field_label $ unLoc $ dfoLabel f) exprCtOrigin (HsOverLabel _ l) = OverLabelOrigin l exprCtOrigin (ExplicitList {}) = ListOrigin exprCtOrigin (HsIPVar _ ip) = IPOccOrigin ip @@ -751,6 +766,7 @@ exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" exprCtOrigin (HsEmbTy {}) = Shouldn'tHappenOrigin "type expression" +exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression" exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms] exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms] exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms] @@ -775,12 +791,15 @@ grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss -- | Extract a suitable CtOrigin from a list of guarded RHSs -lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin -lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e +lGRHSCtOrigin :: NonEmpty (LGRHS GhcRn (LHsExpr GhcRn)) -> CtOrigin +lGRHSCtOrigin (L _ (GRHS _ _ (L _ e)) :| []) = exprCtOrigin e lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS" +ctoHerald :: SDoc +ctoHerald = text "arising from" + pprCtOrigin :: CtOrigin -> SDoc --- "arising from ..." + pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk @@ -789,8 +808,9 @@ , whenPprDebug (braces (text "given-sc:" <+> ppr d <> comma <> ppr blk)) ] pprCtOrigin (SpecPragOrigin ctxt) - = case ctxt of - FunSigCtxt n _ -> text "for" <+> quotes (ppr n) + = ctoHerald <+> + case ctxt of + FunSigCtxt n _ -> text "a SPECIALISE pragma for" <+> quotes (ppr n) SpecInstCtxt -> text "a SPECIALISE INSTANCE pragma" _ -> text "a SPECIALISE pragma" -- Never happens I think @@ -812,7 +832,7 @@ , hang (quotes (ppr pred2)) 2 (pprCtOrigin orig2 <+> text "at" <+> ppr loc2) ]) pprCtOrigin AssocFamPatOrigin - = text "when matching a family LHS with its class instance head" + = ctoHerald <+> text "matching a family LHS with its class instance head" pprCtOrigin (TypeEqOrigin { uo_actual = t1, uo_expected = t2, uo_visible = vis }) = hang (ctoHerald <+> text "a type equality" <> whenPprDebug (brackets (ppr vis))) @@ -856,13 +876,13 @@ 2 (text "the signature of" <+> quotes (ppr name)) pprCtOrigin (InstProvidedOrigin mod cls_inst) - = vcat [ text "arising when attempting to show that" + = vcat [ ctoHerald <+> text "attempting to show that" , ppr cls_inst , text "is provided by" <+> quotes (ppr mod)] pprCtOrigin (ImpedanceMatching x) - = vcat [ text "arising when matching required constraints" - , text "in a group involving" <+> quotes (ppr x)] + = vcat [ ctoHerald <+> text "matching required constraints" + , text "in a binding group involving" <+> quotes (ppr x)] pprCtOrigin (CycleBreakerOrigin orig) = pprCtOrigin orig @@ -887,85 +907,91 @@ = vcat [ ctoHerald <+> text "the superclasses of an instance declaration" , whenPprDebug (braces (text "sc-origin:" <> ppr nkd)) ] -pprCtOrigin (ScOrigin (IsQC orig) nkd) - = vcat [ ctoHerald <+> text "the head of a quantified constraint" - , whenPprDebug (braces (text "sc-origin:" <> ppr nkd)) - , pprCtOrigin orig ] +pprCtOrigin (ScOrigin (IsQC pred orig) nkd) + = vcat [ whenPprDebug (text "IsQC" <> braces (text "sc-origin:" <> ppr nkd) <+> ppr pred) + , hang (text "arising (via a quantified constraint) from") + 2 (pprCtOriginBriefly orig) ] + -- Print `orig` briefly with pprCtOriginBriefly. We'll print it more + -- voluminously later: see GHC.Tc.Errors.Ppr.pprQCOriginExtra pprCtOrigin (NonLinearPatternOrigin reason pat) = hang (ctoHerald <+> text "a non-linear pattern" <+> quotes (ppr pat)) 2 (pprNonLinearPatternReason reason) pprCtOrigin simple_origin - = ctoHerald <+> pprCtO simple_origin + = ctoHerald <+> pprCtOriginBriefly simple_origin --- | Short one-liners -pprCtO :: HasDebugCallStack => CtOrigin -> SDoc -pprCtO (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] -pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] -pprCtO AppOrigin = text "an application" -pprCtO (IPOccOrigin name) = hsep [text "a use of implicit parameter", quotes (ppr name)] -pprCtO (OverLabelOrigin l) = hsep [text "the overloaded label" +-- | Print CtOrigin briefly, with a one-liner +pprCtOriginBriefly :: CtOrigin -> SDoc +pprCtOriginBriefly = ppr_br -- ppr_br is a local function with a short name! + +ppr_br :: CtOrigin -> SDoc +ppr_br (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] +ppr_br (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] +ppr_br AppOrigin = text "an application" +ppr_br (IPOccOrigin name) = hsep [text "a use of implicit parameter", quotes (ppr name)] +ppr_br (OverLabelOrigin l) = hsep [text "the overloaded label" ,quotes (char '#' <> ppr l)] -pprCtO RecordUpdOrigin = text "a record update" -pprCtO ExprSigOrigin = text "an expression type signature" -pprCtO PatSigOrigin = text "a pattern type signature" -pprCtO PatOrigin = text "a pattern" -pprCtO ViewPatOrigin = text "a view pattern" -pprCtO (LiteralOrigin lit) = hsep [text "the literal", quotes (ppr lit)] -pprCtO (ArithSeqOrigin seq) = hsep [text "the arithmetic sequence", quotes (ppr seq)] -pprCtO SectionOrigin = text "an operator section" -pprCtO (HasFieldOrigin f) = hsep [text "selecting the field", quotes (ppr f)] -pprCtO AssocFamPatOrigin = text "the LHS of a family instance" -pprCtO TupleOrigin = text "a tuple" -pprCtO NegateOrigin = text "a use of syntactic negation" -pprCtO (ScOrigin IsClsInst _) = text "the superclasses of an instance declaration" -pprCtO (ScOrigin (IsQC {}) _) = text "the head of a quantified constraint" -pprCtO DerivClauseOrigin = text "the 'deriving' clause of a data type declaration" -pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration" -pprCtO DefaultOrigin = text "a 'default' declaration" -pprCtO DoOrigin = text "a do statement" -pprCtO MCompOrigin = text "a statement in a monad comprehension" -pprCtO ProcOrigin = text "a proc expression" -pprCtO ArrowCmdOrigin = text "an arrow command" -pprCtO AnnOrigin = text "an annotation" -pprCtO (ExprHoleOrigin Nothing) = text "an expression hole" -pprCtO (ExprHoleOrigin (Just occ)) = text "a use of" <+> quotes (ppr occ) -pprCtO (TypeHoleOrigin occ) = text "a use of wildcard" <+> quotes (ppr occ) -pprCtO PatCheckOrigin = text "a pattern-match completeness check" -pprCtO ListOrigin = text "an overloaded list" -pprCtO IfThenElseOrigin = text "an if-then-else expression" -pprCtO StaticOrigin = text "a static form" -pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)] -pprCtO (OmittedFieldOrigin Nothing) = text "an omitted anonymous field" -pprCtO (OmittedFieldOrigin (Just fl)) = hsep [text "omitted field" <+> quotes (ppr fl)] -pprCtO BracketOrigin = text "a quotation bracket" +ppr_br RecordUpdOrigin = text "a record update" +ppr_br ExprSigOrigin = text "an expression type signature" +ppr_br PatSigOrigin = text "a pattern type signature" +ppr_br PatOrigin = text "a pattern" +ppr_br ViewPatOrigin = text "a view pattern" +ppr_br (LiteralOrigin lit) = hsep [text "the literal", quotes (ppr lit)] +ppr_br (ArithSeqOrigin seq) = hsep [text "the arithmetic sequence", quotes (ppr seq)] +ppr_br SectionOrigin = text "an operator section" +ppr_br (GetFieldOrigin f) = hsep [text "selecting the field", quotes (ppr f)] +ppr_br AssocFamPatOrigin = text "the LHS of a family instance" +ppr_br TupleOrigin = text "a tuple" +ppr_br NegateOrigin = text "a use of syntactic negation" +ppr_br (ScOrigin IsClsInst _) = text "the superclasses of an instance declaration" +ppr_br (ScOrigin (IsQC {}) _) = text "the head of a quantified constraint" +ppr_br (DerivOrigin standalone) + | standalone = text "a 'deriving' declaration" + | otherwise = text "the 'deriving' clause of a data type declaration" +ppr_br DefaultOrigin = text "a 'default' declaration" +ppr_br DoOrigin = text "a do statement" +ppr_br MCompOrigin = text "a statement in a monad comprehension" +ppr_br ProcOrigin = text "a proc expression" +ppr_br ArrowCmdOrigin = text "an arrow command" +ppr_br AnnOrigin = text "an annotation" +ppr_br (ExprHoleOrigin Nothing) = text "an expression hole" +ppr_br (ExprHoleOrigin (Just occ)) = text "a use of" <+> quotes (ppr occ) +ppr_br (TypeHoleOrigin occ) = text "a use of wildcard" <+> quotes (ppr occ) +ppr_br PatCheckOrigin = text "a pattern-match completeness check" +ppr_br ListOrigin = text "an overloaded list" +ppr_br IfThenElseOrigin = text "an if-then-else expression" +ppr_br StaticOrigin = text "a static form" +ppr_br (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)] +ppr_br (OmittedFieldOrigin Nothing) = text "an omitted anonymous field" +ppr_br (OmittedFieldOrigin (Just fl)) = hsep [text "omitted field" <+> quotes (ppr fl)] +ppr_br BracketOrigin = text "a quotation bracket" +ppr_br (ImplicitLiftOrigin isp) = text "an implicit lift of" <+> quotes (ppr (implicit_lift_lid isp)) -- These ones are handled by pprCtOrigin, but we nevertheless sometimes --- get here via callStackOriginFS, when doing ambiguity checks --- A bit silly, but no great harm -pprCtO (GivenOrigin {}) = text "a given constraint" -pprCtO (GivenSCOrigin {}) = text "the superclass of a given constraint" -pprCtO (SpecPragOrigin {}) = text "a SPECIALISE pragma" -pprCtO (FunDepOrigin1 {}) = text "a functional dependency" -pprCtO (FunDepOrigin2 {}) = text "a functional dependency" -pprCtO (InjTFOrigin1 {}) = text "an injective type family" -pprCtO (TypeEqOrigin {}) = text "a type equality" -pprCtO (KindEqOrigin {}) = text "a kind equality" -pprCtO (DerivOriginDC {}) = text "a deriving clause" -pprCtO (DerivOriginCoerce {}) = text "a derived method" -pprCtO (DoPatOrigin {}) = text "a do statement" -pprCtO (MCompPatOrigin {}) = text "a monad comprehension pattern" -pprCtO (Shouldn'tHappenOrigin note) = text note -pprCtO (ProvCtxtOrigin {}) = text "a provided constraint" -pprCtO (InstProvidedOrigin {}) = text "a provided constraint" -pprCtO (CycleBreakerOrigin orig) = pprCtO orig -pprCtO (FRROrigin {}) = text "a representation-polymorphism check" -pprCtO (WantedSuperclassOrigin {}) = text "a superclass constraint" -pprCtO (InstanceSigOrigin {}) = text "a type signature in an instance" -pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check" -pprCtO (ImpedanceMatching {}) = text "combining required constraints" -pprCtO (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] +-- we call pprCtOriginBriefly directly (e.g. in callStackOriginFS) +ppr_br (GivenOrigin {}) = text "a given constraint" +ppr_br (GivenSCOrigin {}) = text "the superclass of a given constraint" +ppr_br (SpecPragOrigin {}) = text "a SPECIALISE pragma" +ppr_br (FunDepOrigin1 {}) = text "a functional dependency" +ppr_br (FunDepOrigin2 {}) = text "a functional dependency" +ppr_br (InjTFOrigin1 {}) = text "an injective type family" +ppr_br (TypeEqOrigin {}) = text "a type equality" +ppr_br (KindEqOrigin {}) = text "a kind equality" +ppr_br (DerivOriginDC {}) = text "a deriving clause" +ppr_br (DerivOriginCoerce m _ _ _) = text "the coercion of derived method" <+> quotes (ppr m) +ppr_br (DoPatOrigin {}) = text "a do statement" +ppr_br (MCompPatOrigin {}) = text "a monad comprehension pattern" +ppr_br (Shouldn'tHappenOrigin note) = text note +ppr_br (ProvCtxtOrigin {}) = text "a provided constraint" +ppr_br (InstProvidedOrigin {}) = text "a provided constraint" +ppr_br (CycleBreakerOrigin orig) = ppr_br orig +ppr_br (FRROrigin {}) = text "a representation-polymorphism check" +ppr_br (WantedSuperclassOrigin {}) = text "a superclass constraint" +ppr_br (InstanceSigOrigin {}) = text "a type signature in an instance" +ppr_br (AmbiguityCheckOrigin {}) = text "a type ambiguity check" +ppr_br (ImpedanceMatching {}) = text "combining required constraints" +ppr_br (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear") @@ -983,18 +1009,22 @@ * * ********************************************************************* -} -isPushCallStackOrigin :: CtOrigin -> Bool --- Do we want to solve this IP constraint directly (return False) --- or push the call site (return True) --- See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence -isPushCallStackOrigin (IPOccOrigin {}) = False -isPushCallStackOrigin _ = True - - -callStackOriginFS :: CtOrigin -> FastString --- This is the string that appears in the CallStack -callStackOriginFS (OccurrenceOf fun) = occNameFS (getOccName fun) -callStackOriginFS orig = mkFastString (showSDocUnsafe (pprCtO orig)) +isPushCallStackOrigin_maybe :: CtOrigin -> Maybe FastString +-- Do we want to solve this IP constraint normally (return Nothing) +-- or push the call site (returning the name of the function being called) +-- See Note [Overview of implicit CallStacks] esp (CS1) in GHC.Tc.Types.Evidence +isPushCallStackOrigin_maybe (GivenOrigin {}) = Nothing +isPushCallStackOrigin_maybe (GivenSCOrigin {}) = Nothing +isPushCallStackOrigin_maybe (IPOccOrigin {}) = Nothing +isPushCallStackOrigin_maybe (OccurrenceOf fun) = Just (occNameFS (getOccName fun)) +isPushCallStackOrigin_maybe orig = Just orig_fs + -- This fall-through case is important to deal with call stacks + -- that arise from rebindable syntax (#19919) + -- Here the "name of the function being called" is approximated as + -- the result of prettty-printing the CtOrigin; a bit messy, + -- but we can perhaps improve it in the light of user feedback + where + orig_fs = mkFastString (showSDocUnsafe (pprCtOriginBriefly orig)) {- ************************************************************************ @@ -1169,7 +1199,7 @@ -- See 'FRRArrowContext' for more details. | FRRArrow !FRRArrowContext - -- | A representation-polymorphic check arising from a call + -- | A representation-polymorphism check arising from a call -- to 'matchExpectedFunTys' or 'matchActualFunTy'. -- -- See 'ExpectedFunTyOrigin' for more details. @@ -1178,6 +1208,13 @@ !Int -- ^ argument position (1-indexed) + -- | A representation-polymorphism check arising from eta-expansion + -- performed as part of deep subsumption. + | forall p. FRRDeepSubsumption + { frrDSExpected :: Bool + , frrDSPosition :: Position p + } + -- | The description of a representation-polymorphic 'Id'. data RepPolyId -- | A representation-polymorphic 'PrimOp'. @@ -1215,8 +1252,8 @@ pprFixedRuntimeRepContext (FRRBinder binder) = sep [ text "The binder" , quotes (ppr binder) ] -pprFixedRuntimeRepContext (FRRRepPolyId nm id what) - = pprFRRRepPolyId id nm what +pprFixedRuntimeRepContext (FRRRepPolyId nm id pos) + = text "The" <+> ppr pos <+> text "of" <+> pprRepPolyId id nm pprFixedRuntimeRepContext FRRPatBind = text "The pattern binding" pprFixedRuntimeRepContext FRRPatSynArg @@ -1258,6 +1295,13 @@ = pprFRRArrowContext arrowContext pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig arg_pos) = pprExpectedFunTyOrigin funTyOrig arg_pos +pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos) + = hsep [ text "The", what, text "type of the" + , ppr (Argument pos) + , text "of the eta-expansion" + ] + where + what = if is_exp then text "expected" else text "actual" instance Outputable FixedRuntimeRepContext where ppr = pprFixedRuntimeRepContext @@ -1286,34 +1330,117 @@ * * ********************************************************************* -} +{- Note [Positional information in representation-polymorphism errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider an invalid instantiation of the 'catch#' primop: + + catch# + :: forall {q :: RuntimeRep} {k :: Levity} (a :: TYPE q) + (b :: TYPE (BoxedRep k)). + (State# RealWorld -> (# State# RealWorld, a #)) + -> (b -> State# RealWorld -> (# State# RealWorld, a #)) + -> State# RealWorld + -> (# State# RealWorld, a #) + + boo :: forall r (a :: TYPE r). ... + boo = catch# @a + +The instantiation is invalid because we insist that the quantified RuntimeRep +type variable 'q' be instantiated to a concrete RuntimeRep, as per +Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete. + +We report this as the following error message: + + The result of the first argument of the primop ‘catch#’ does not have a fixed runtime representation. + Its type is: (a :: TYPE r). + +The positional information in this message, namely "The result of the first argument", +is produced by using the 'Position' datatype. In this case: + + pos :: Position Neg + pos = Result (Argument Top) + ppr pos = "result of the first argument" + +Other examples: + + pos2 :: Position Neg + pos2 = Argument (Result (Result Top)) + ppr pos2 = "3rd argument" + + pos3 :: Position Pos + pos3 = Argument (Result (Argument (Result Top))) + ppr pos3 = "2nd argument of the 2nd argument" + +It's useful to keep track at the type-level whether we are in a positive or +negative position in the type, as for primops we can usually tolerate +representation-polymorphism in positive positions, but not in negative ones; +for example + + ($) :: forall {r} (a :: Type) (b :: TYPE r). (a -> b) -> a -> b + + +This positional information is (currently) used to report representation-polymorphism +errors in precisely the following two situations: + + 1. Representation-polymorphic Ids with no binding, as described in + Note [Representation-polymorphic Ids with no binding] in GHC.Tc.Utils.Concrete. + + This uses the 'FRRRepPolyId' constructor of 'FixedRuntimeRepContext'. + + 2. When inserting eta-expansions for deep subsumption. + See Wrinkle [Representation-polymorphism checking during subtyping] in + Note [FunTy vs FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify. + + This uses the 'FRRDeepSubsumption' constructor of 'FixedRuntimeRepContext'. +-} + +-- | Are we in a positive (covariant) or negative (contravariant) position? +-- +-- See Note [Positional information in representation-polymorphism errors]. data Polarity = Pos | Neg +-- | Flip the 'Polarity': turn positive into negative and vice-versa. type FlipPolarity :: Polarity -> Polarity -type family FlipPolarity p where +type family FlipPolarity p = r | r -> p where FlipPolarity Pos = Neg FlipPolarity Neg = Pos -- | A position in which a type variable appears in a type; -- in particular, whether it appears in a positive or a negative position. +-- +-- See Note [Positional information in representation-polymorphism errors]. type Position :: Polarity -> Hs.Type data Position p where - -- | In the @i@-th argument of a function arrow - Argument :: Int -> Position (FlipPolarity p) -> Position p + -- | In the argument of a function arrow + Argument :: Position p -> Position (FlipPolarity p) -- | In the result of a function arrow Result :: Position p -> Position p -- | At the top level of a type Top :: Position Pos +deriving stock instance Show (Position p) +instance Outputable (Position p) where + ppr = go 1 + where + go :: Int -> Position q -> SDoc + go i (Argument (Result pos)) = go (i+1) (Argument pos) + go i (Argument pos) = speakNth i <+> text "argument" <+> aux 1 pos + go i (Result (Result pos)) = go i (Result pos) + go i (Result pos) = text "result" <+> aux i pos + go _ Top = text "top-level" -pprFRRRepPolyId :: RepPolyId -> Name -> Position Neg -> SDoc -pprFRRRepPolyId id nm (Argument i pos) = - text "The" <+> what <+> speakNth i <+> text "argument of" <+> pprRepPolyId id nm + aux :: Int -> Position q -> SDoc + aux i pos = case pos of { Top -> empty; _ -> text "of the" <+> go i pos } + +-- | @'mkArgPos' i p@ makes the 'Position' @p@ relative to the @ith@ argument. +-- +-- Example: @ppr (mkArgPos 3 (Result Top)) == "in the result of the 3rd argument"@. +mkArgPos :: Int -> Position p -> Position (FlipPolarity p) +mkArgPos i = go where - what = case pos of - Top -> empty - Result {} -> text "return type of the" - _ -> text "nested return type inside the" -pprFRRRepPolyId id nm (Result {}) = - text "The result of" <+> pprRepPolyId id nm + go :: Position p -> Position (FlipPolarity p) + go Top = Argument $ nTimes (i-1) Result Top + go (Result p) = Result $ go p + go (Argument p) = Argument $ go p pprRepPolyId :: RepPolyId -> Name -> SDoc pprRepPolyId id nm = id_desc <+> quotes (ppr nm) @@ -1525,7 +1652,7 @@ -- See GHC.Tc.Solver.InertSet Note [Solved dictionaries] | BuiltinTypeableInstance TyCon -- Built-in solver for Typeable (T t1 .. tn) - -- See Note [Well-staged instance evidence] + -- See Note [Well-levelled instance evidence] | BuiltinInstance -- Built-in solver for (C t1 .. tn) where C is -- KnownNat, .. etc (classes with no top-level evidence) diff --git a/GHC/Tc/Types/TH.hs b/GHC/Tc/Types/TH.hs --- a/GHC/Tc/Types/TH.hs +++ b/GHC/Tc/Types/TH.hs @@ -1,25 +1,30 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Tc.Types.TH ( SpliceType(..) , SpliceOrBracket(..) - , ThStage(..) + , ThLevel(.., TypedBrack, UntypedBrack) , PendingStuff(..) - , ThLevel - , topStage - , topAnnStage - , topSpliceStage - , thLevel - , impLevel - , outerLevel + , ThLevelIndex + , topLevel + , topAnnLevel + , topSpliceLevel + , thLevelIndex + , topLevelIndex + , spliceLevelIndex + , quoteLevelIndex + , thLevelIndexFromImportLevel ) where +import GHC.Prelude import GHCi.RemoteTypes import qualified GHC.Boot.TH.Syntax as TH import GHC.Tc.Types.Evidence import GHC.Utils.Outputable -import GHC.Prelude import GHC.Tc.Types.TcRef import GHC.Tc.Types.Constraint import GHC.Hs.Expr ( PendingTcSplice, PendingRnSplice ) +import GHC.Types.ThLevelIndex --------------------------- -- Template Haskell stages and levels @@ -28,16 +33,12 @@ data SpliceType = Typed | Untyped data SpliceOrBracket = IsSplice | IsBracket -data ThStage -- See Note [Template Haskell state diagram] +data ThLevel -- See Note [Template Haskell state diagram] -- and Note [Template Haskell levels] in GHC.Tc.Gen.Splice -- Start at: Comp -- At bracket: wrap current stage in Brack - -- At splice: currently Brack: return to previous stage - -- currently Comp/Splice: compile and run - = Splice SpliceType -- Inside a top-level splice - -- This code will be run *at compile time*; - -- the result replaces the splice - -- Binding level = 0 + -- At splice: wrap current stage in Splice + = Splice SpliceType ThLevel -- Inside a splice | RunSplice (TcRef [ForeignRef (TH.Q ())]) -- Set when running a splice, i.e. NOT when renaming or typechecking the @@ -55,14 +56,14 @@ -- See Note [Collecting modFinalizers in typed splices] in "GHC.Tc.Gen.Splice". | Comp -- Ordinary Haskell code - -- Binding level = 1 + -- Binding level = 0 | Brack -- Inside brackets - ThStage -- Enclosing stage + ThLevel -- Enclosing level PendingStuff data PendingStuff - = RnPendingUntyped -- Renaming the inside of an *untyped* bracket + = RnPending -- Renaming the inside of a bracket (TcRef [PendingRnSplice]) -- Pending splices in here | RnPendingTyped -- Renaming the inside of a *typed* bracket @@ -77,44 +78,45 @@ -- variable is used for desugaring -- `lift`. +isTypedPending :: PendingStuff -> Bool +isTypedPending (RnPending _) = False +isTypedPending (RnPendingTyped) = True +isTypedPending (TcPending _ _ _) = True -topStage, topAnnStage, topSpliceStage :: ThStage -topStage = Comp -topAnnStage = Splice Untyped -topSpliceStage = Splice Untyped +pattern UntypedBrack :: ThLevel -> TcRef [PendingRnSplice] -> ThLevel +pattern UntypedBrack lvl tc_ref = Brack lvl (RnPending tc_ref) +pattern TypedBrack :: ThLevel -> ThLevel +pattern TypedBrack lvl <- Brack lvl (isTypedPending -> True) -instance Outputable ThStage where - ppr (Splice _) = text "Splice" +topLevel, topAnnLevel, topSpliceLevel :: ThLevel +topLevel = Comp +topAnnLevel = Splice Untyped Comp +topSpliceLevel = Splice Untyped Comp + + +instance Outputable ThLevel where + ppr (Splice _ s) = text "Splice" <> parens (ppr s) ppr (RunSplice _) = text "RunSplice" ppr Comp = text "Comp" - ppr (Brack s _) = text "Brack" <> parens (ppr s) + ppr (Brack s _) = text "Brack" <> parens (ppr s) -type ThLevel = Int - -- NB: see Note [Template Haskell levels] in GHC.Tc.Gen.Splice - -- Incremented when going inside a bracket, - -- decremented when going inside a splice - -- NB: ThLevel is one greater than the 'n' in Fig 2 of the - -- original "Template meta-programming for Haskell" paper -impLevel, outerLevel :: ThLevel -impLevel = 0 -- Imported things; they can be used inside a top level splice -outerLevel = 1 -- Things defined outside brackets - -thLevel :: ThStage -> ThLevel -thLevel (Splice _) = 0 -thLevel Comp = 1 -thLevel (Brack s _) = thLevel s + 1 -thLevel (RunSplice _) = 0 -- previously: panic "thLevel: called when running a splice" +thLevelIndex :: ThLevel -> ThLevelIndex +thLevelIndex (Splice _ s) = decThLevelIndex (thLevelIndex s) +thLevelIndex Comp = topLevelIndex +thLevelIndex (Brack s _) = incThLevelIndex (thLevelIndex s) +thLevelIndex (RunSplice _) = thLevelIndex (Splice Untyped Comp) -- previously: panic "thLevel: called when running a splice" -- See Note [RunSplice ThLevel]. + {- Note [RunSplice ThLevel] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The 'RunSplice' stage is set when executing a splice, and only when running a +The 'RunSplice' level is set when executing a splice, and only when running a splice. In particular it is not set when the splice is renamed or typechecked. However, this is not true. `reifyInstances` for example does rename the given type, and these types may contain variables (#9262 allow free variables in reifyInstances). -Therefore here we assume that thLevel (RunSplice _) = 0. +Therefore here we assume that thLevel (RunSplice _) = 0 Proper fix would probably require renaming argument `reifyInstances` separately prior to evaluation of the overall splice. @@ -125,3 +127,4 @@ 'Brack' or 'Comp' are used instead. -} + diff --git a/GHC/Tc/Types/TcRef.hs b/GHC/Tc/Types/TcRef.hs --- a/GHC/Tc/Types/TcRef.hs +++ b/GHC/Tc/Types/TcRef.hs diff --git a/GHC/Tc/Utils/Backpack.hs b/GHC/Tc/Utils/Backpack.hs --- a/GHC/Tc/Utils/Backpack.hs +++ b/GHC/Tc/Utils/Backpack.hs @@ -1,4 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -97,7 +98,7 @@ -- implementation cases. checkBootDeclM Hsig sig_thing real_thing real_fixity <- lookupFixityRn name - let sig_fixity = case mi_fix_fn (mi_final_exts sig_iface) (occName name) of + let sig_fixity = case mi_fix_fn sig_iface (occName name) of Nothing -> defaultFixity Just f -> f when (real_fixity /= sig_fixity) $ @@ -221,7 +222,8 @@ (tclvl,cts) <- pushTcLevelM $ do given_ids <- mapM newEvVar inst_theta let given_loc = mkGivenLoc topTcLevel skol_info (mkCtLocEnv lcl_env) - givens = [ CtGiven { ctev_pred = idType given_id + givens = [ CtGiven $ + GivenCt { ctev_pred = idType given_id -- Doesn't matter, make something up , ctev_evar = given_id , ctev_loc = given_loc } @@ -297,14 +299,14 @@ -- than a transitive closure done here) all the free holes are still reachable. implicitRequirementsShallow :: HscEnv - -> [(PkgQual, Located ModuleName)] + -> [(ImportLevel, PkgQual, Located ModuleName)] -> IO ([ModuleName], [InstantiatedUnit]) implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports where mhome_unit = hsc_home_unit_maybe hsc_env go acc [] = pure acc - go (accL, accR) ((mb_pkg, L _ imp):imports) = do + go (accL, accR) ((_stage, mb_pkg, L _ imp):imports) = do found <- findImportedModule hsc_env imp mb_pkg let acc' = case found of Found _ mod | notHomeModuleMaybe mhome_unit mod -> @@ -484,15 +486,6 @@ -- logically "implicit" entities are defined indirectly in an interface -- file. #13151 gives a proposal to make these *truly* implicit. -merge_msg :: ModuleName -> [InstantiatedModule] -> SDoc -merge_msg mod_name [] = - text "while checking the local signature" <+> ppr mod_name <+> - text "for consistency" -merge_msg mod_name reqs = - hang (text "while merging the signatures from" <> colon) - 2 (vcat [ bullet <+> ppr req | req <- reqs ] $$ - bullet <+> text "...and the local signature for" <+> ppr mod_name) - -- | Given a local 'ModIface', merge all inherited requirements -- from 'requirementMerges' into this signature, producing -- a final 'TcGblEnv' that matches the local signature and @@ -542,7 +535,7 @@ -- we are going to merge in. let reqs = requirementMerges unit_state mod_name - addErrCtxt (pprWithUnitState unit_state $ merge_msg mod_name reqs) $ do + addErrCtxt (MergeSignaturesCtxt unit_state mod_name reqs) $ do -- STEP 2: Read in the RAW forms of all of these interfaces ireq_ifaces0 <- liftIO $ forM reqs $ \(Module iuid mod_name) -> do @@ -641,7 +634,8 @@ is_pkg_qual = NoPkgQual, is_qual = False, is_isboot = NotBoot, - is_dloc = locA loc + is_dloc = locA loc, + is_level = NormalLevel } ImpAll rdr_env = mkGlobalRdrEnv $ gresFromAvails hsc_env (Just ispec) as1 setGblEnv tcg_env { @@ -651,7 +645,7 @@ emptyImportAvails (tcg_semantic_mod tcg_env) case mb_r of - Just (_, as2, _) -> return (thinModIface as2 ireq_iface, as2) + Just (_, _, as2, _) -> return (thinModIface as2 ireq_iface, as2) Nothing -> addMessages msgs >> failM -- We can't thin signatures from non-signature packages _ -> return (ireq_iface, as1) @@ -708,8 +702,9 @@ -- Make sure we didn't refer to anything that doesn't actually exist -- pprTrace "mergeSignatures: exports_from_avail" (ppr exports) $ return () - (mb_lies, _, _) <- exports_from_avail mb_exports rdr_env - (tcg_imports tcg_env) (tcg_semantic_mod tcg_env) + (mb_lies, exp_dflts, _, _) <- + exports_from_avail mb_exports rdr_env + (tcg_imports tcg_env) (tcg_semantic_mod tcg_env) {- -- NB: This is commented out, because warns above is disabled. -- If you tried to explicitly export an identifier that has a warning @@ -729,8 +724,7 @@ failIfErrsM -- Save the exports - let drop_defaults (spans, _defaults, avails) = (spans, avails) - setGblEnv tcg_env { tcg_rn_exports = map drop_defaults <$> mb_lies } $ do + setGblEnv tcg_env { tcg_rn_exports = mb_lies, tcg_default_exports = exp_dflts } $ do tcg_env <- getGblEnv let home_unit = hsc_home_unit hsc_env @@ -859,7 +853,7 @@ if outer_mod == mi_module iface -- Don't add ourselves! then tcg_merged tcg_env - else (mi_module iface, mi_mod_hash (mi_final_exts iface)) : tcg_merged tcg_env + else (mi_module iface, mi_mod_hash iface) : tcg_merged tcg_env } -- Note [Signature merging DFuns] @@ -918,13 +912,6 @@ exportOccs :: [AvailInfo] -> [OccName] exportOccs = concatMap (map nameOccName . availNames) -impl_msg :: UnitState -> Module -> InstantiatedModule -> SDoc -impl_msg unit_state impl_mod (Module req_uid req_mod_name) - = pprWithUnitState unit_state $ - text "While checking that" <+> quotes (ppr impl_mod) <+> - text "implements signature" <+> quotes (ppr req_mod_name) <+> - text "in" <+> quotes (ppr req_uid) <> dot - -- | Check if module implements a signature. (The signature is -- always un-hashed, which is why its components are specified -- explicitly.) @@ -934,7 +921,7 @@ let unit_state = hsc_units hsc_env home_unit = hsc_home_unit hsc_env other_home_units = hsc_all_home_unit_ids hsc_env - addErrCtxt (impl_msg unit_state impl_mod req_mod) $ do + addErrCtxt (CheckImplementsCtxt unit_state impl_mod req_mod) $ do let insts = instUnitInsts uid -- STEP 1: Load the implementing interface, and make a RdrEnv diff --git a/GHC/Tc/Utils/Concrete.hs b/GHC/Tc/Utils/Concrete.hs --- a/GHC/Tc/Utils/Concrete.hs +++ b/GHC/Tc/Utils/Concrete.hs @@ -19,39 +19,35 @@ import GHC.Prelude import GHC.Builtin.Names ( unsafeCoercePrimName ) -import GHC.Builtin.Types ( liftedTypeKindTyCon, unliftedTypeKindTyCon ) +import GHC.Builtin.Types -import GHC.Core.Coercion ( coToMCo, mkCastTyMCo - , mkGReflRightMCo, mkNomReflCo ) -import GHC.Core.TyCo.Rep ( Type(..), MCoercion(..) ) -import GHC.Core.TyCon ( isConcreteTyCon ) -import GHC.Core.Type ( isConcreteType, typeKind, mkFunTy) +import GHC.Core.Coercion +import GHC.Core.TyCo.Rep +import GHC.Core.Type -import GHC.Tc.Types.Constraint ( NotConcreteError(..), NotConcreteReason(..) ) -import GHC.Tc.Types.Evidence ( Role(..), TcCoercionN, TcMCoercionN ) +import GHC.Data.Bag + +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.TcMType +import {-# SOURCE #-} GHC.Tc.Utils.Unify import GHC.Types.Basic ( TypeOrKind(KindLevel) ) import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Types.Var ( tyVarKind, tyVarName ) +import GHC.Types.Var import GHC.Utils.Misc ( HasDebugCallStack ) import GHC.Utils.Outputable +import GHC.Utils.Panic import GHC.Data.FastString ( FastString, fsLit ) - import Control.Monad ( void ) import Data.Functor ( ($>) ) -import Data.List.NonEmpty ( NonEmpty((:|)) ) -import Control.Monad.Trans.Class ( lift ) -import Control.Monad.Trans.Writer.CPS ( WriterT, runWriterT, tell ) {- Note [Concrete overview] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -221,7 +217,6 @@ only be unified with a concrete type (in the sense of Note [Concrete types]). INVARIANT: the kind of a concrete metavariable is concrete. - This invariant is upheld at the time of creation of a new concrete metavariable. Concrete metavariables are useful for representation-polymorphism checks: @@ -632,7 +627,7 @@ -- That is, @ty'@ has a syntactically fixed RuntimeRep -- in the sense of Note [Fixed RuntimeRep]. hasFixedRuntimeRep frr_ctxt ty = - checkFRR_with (unifyConcrete (fsLit "cx") . ConcreteFRR) frr_ctxt ty + checkFRR_with (fmap (fmap coToMCo) . unifyConcrete_kind (fsLit "cx") . ConcreteFRR) frr_ctxt ty -- | Like 'hasFixedRuntimeRep', but we perform an eager syntactic check. -- @@ -675,7 +670,7 @@ -- ^ Returns @(co, frr_ty)@ with @co :: ty ~# frr_ty@ -- and @frr_@ty has a fixed 'RuntimeRep'. checkFRR_with check_kind frr_ctxt ty - = do { th_stage <- getStage + = do { th_lvl <- getThLevel ; if -- Shortcut: check for 'Type' and 'UnliftedType' type synonyms. | TyConApp tc [] <- ki @@ -683,7 +678,7 @@ -> return refl -- See [Wrinkle: Typed Template Haskell] in Note [hasFixedRuntimeRep]. - | Brack _ (TcPending {}) <- th_stage + | TypedBrack {} <- th_lvl -> return refl -- Otherwise: ensure that the kind 'ki' of 'ty' is concrete. @@ -700,228 +695,88 @@ frr_orig :: FixedRuntimeRepOrigin frr_orig = FixedRuntimeRepOrigin { frr_type = ty, frr_context = frr_ctxt } --- | Ensure that the given type @ty@ can unify with a concrete type, +-- | Ensure that the given kind @ki@ can unify with a concrete type, -- in the sense of Note [Concrete types]. -- --- Returns a coercion @co :: ty ~# conc_ty@, where @conc_ty@ is +-- Returns a coercion @co :: ki ~# conc_ki@, where @conc_ki@ is -- concrete. -- --- If the type is already syntactically concrete, this +-- If the kind is already syntactically concrete, this -- immediately returns a reflexive coercion. Otherwise, -- it creates a new concrete metavariable @concrete_tv@ --- and emits an equality constraint @ty ~# concrete_tv@, +-- and emits an equality constraint @ki ~# concrete_tv@, -- to be handled by the constraint solver. -- +-- Precondition: @ki@ must be of the form @TYPE rep@ or @CONSTRAINT rep@. +unifyConcrete_kind :: HasDebugCallStack + => FastString -- ^ name to use when creating concrete metavariables + -> ConcreteTvOrigin + -> TcKind + -> TcM TcCoercionN +unifyConcrete_kind occ_fs conc_orig ki + | Just (torc, rep) <- sORTKind_maybe ki + = do { let tc = case torc of + TypeLike -> tYPETyCon + ConstraintLike -> cONSTRAINTTyCon + ; rep_co <- unifyConcrete occ_fs conc_orig rep + ; return $ mkTyConAppCo Nominal tc [rep_co] } + | otherwise + = pprPanic "unifyConcrete_kind: kind is not of the form 'TYPE rep' or 'CONSTRAINT rep'" $ + ppr ki <+> dcolon <+> ppr (typeKind ki) + + +-- | Ensure the given type can be unified with +-- a concrete type, in the sense of Note [Concrete types]. +-- +-- Returns a coercion @co :: ty ~# conc_ty@, where @conc_ty@ is +-- concrete. +-- +-- If the type is already syntactically concrete, this +-- immediately returns a reflexive coercion. +-- Otherwise, it will create new concrete metavariables and emit +-- new Wanted equality constraints, to be handled by the constraint solver. +-- -- Invariant: the kind of the supplied type must be concrete. -- -- We assume the provided type is already at the kind-level -- (this only matters for error messages). -unifyConcrete :: HasDebugCallStack - => FastString -> ConcreteTvOrigin -> TcType -> TcM TcMCoercionN +unifyConcrete :: FastString -> ConcreteTvOrigin -> TcType -> TcM TcCoercionN unifyConcrete occ_fs conc_orig ty - = do { (ty, errs) <- makeTypeConcrete conc_orig ty - ; case errs of - -- We were able to make the type fully concrete. - { [] -> return MRefl - -- The type could not be made concrete; perhaps it contains - -- a skolem type variable, a type family application, ... - -- - -- Create a new ConcreteTv metavariable @concrete_tv@ - -- and unify @ty ~# concrete_tv@. - ; _ -> - do { conc_tv <- newConcreteTyVar conc_orig occ_fs ki - -- NB: newConcreteTyVar asserts that 'ki' is concrete. - ; coToMCo <$> emitWantedEq orig KindLevel Nominal ty (mkTyVarTy conc_tv) } } } - where - ki :: TcKind - ki = typeKind ty - orig :: CtOrigin - orig = case conc_orig of - ConcreteFRR frr_orig -> FRROrigin frr_orig + = do { (co, cts) <- makeTypeConcrete occ_fs conc_orig ty + ; emitSimples cts + ; return co } --- | Ensure that the given type is concrete. +-- | Ensure that the given kind @ki@ is concrete. -- -- This is an eager syntactic check, and never defers --- any work to the constraint solver. --- --- Invariant: the kind of the supplied type must be concrete. --- Invariant: the output type is equal to the input type, --- up to zonking. +-- any work to the constraint solver. However, +-- it may perform unification. -- --- We assume the provided type is already at the kind-level --- (this only matters for error messages). +-- Invariant: the output type is equal to the input type, up to zonking. ensureConcrete :: HasDebugCallStack => FixedRuntimeRepOrigin - -> TcType - -> TcM TcType -ensureConcrete frr_orig ty - = do { traceTc "ensureConcrete {" (ppr frr_orig $$ ppr ty) - ; (ty', errs) <- makeTypeConcrete conc_orig ty - ; case errs of - { err:errs -> - do { traceTc "ensureConcrete } failure" $ - vcat [ text "ty:" <+> ppr ty - , text "ty':" <+> ppr ty' ] + -> TcKind + -> TcM TcKind +ensureConcrete frr_orig ki + = do { (co, cts) <- makeTypeConcrete (fsLit "cx") conc_orig ki + ; let trace_msg = vcat [ text "ty: " <+> ppr ki + , text "co:" <+> ppr co ] + ; if isEmptyBag cts + then traceTc "ensureConcrete } success" trace_msg + else do { traceTc "ensureConcrete } failure" trace_msg ; loc <- getCtLocM (FRROrigin frr_orig) (Just KindLevel) ; emitNotConcreteError $ NCE_FRR { nce_loc = loc - , nce_frr_origin = frr_orig - , nce_reasons = err :| errs } - } - ; [] -> - traceTc "ensureConcrete } success" $ - vcat [ text "ty: " <+> ppr ty - , text "ty':" <+> ppr ty' ] } - ; return ty' } + , nce_frr_origin = frr_orig } + } + ; return $ coercionRKind co } where conc_orig :: ConcreteTvOrigin conc_orig = ConcreteFRR frr_orig {-*********************************************************************** %* * - Making a type concrete -%* * -%************************************************************************ - -Note [Unifying concrete metavariables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Unifying concrete metavariables (as defined in Note [ConcreteTv]) is not -an all-or-nothing affair as it is for other sorts of metavariables. - -Consider the following unification problem in which all metavariables -are unfilled (and ignoring any TcLevel considerations): - - alpha[conc] ~# TYPE (TupleRep '[ beta[conc], IntRep, gamma[tau] ]) - -We can't immediately unify `alpha` with the RHS, because the RHS is not -a concrete type (in the sense of Note [Concrete types]). Instead, we -proceed as follows: - - - create a fresh concrete metavariable variable `gamma'[conc]`, - - write gamma[tau] := gamma'[conc], - - write alpha[conc] := TYPE (TupleRep '[ beta[conc], IntRep, gamma'[conc] ]). - -Thus, in general, to unify `alpha[conc] ~# rhs`, we first try to turn -`rhs` into a concrete type (see the 'makeTypeConcrete' function). -If this succeeds, resulting in a concrete type `rhs'`, we simply fill -`alpha[conc] := rhs'`. If it fails, then syntactic unification fails. - -Example 1: - - alpha[conc] ~# TYPE (TupleRep '[ beta[conc], IntRep, gamma[tau] ]) - - We proceed by filling metavariables: - - gamma[tau] := gamma[conc] - alpha[conc] := TYPE (TupleRep '[ beta[conc], IntRep, gamma[conc] ]) - - This successfully unifies alpha. - -Example 2: - - For a type family `F :: Type -> Type`: - - delta[conc] ~# TYPE (SumRep '[ zeta[tau], a[sk], F omega[tau] ]) - - We write zeta[tau] := zeta[conc], and then fail, providing the following - two reasons: - - - `a[sk]` is not a concrete type variable, so the overall type - cannot be concrete - - `F` is not a concrete type constructor, in the sense of - Note [Concrete types]. So we keep it as is; in particular, - we /should not/ try to make its argument `omega[tau]` into - a ConcreteTv. - - Note that making zeta concrete allows us to propagate information. - For example, after more typechecking, we might try to unify - `zeta ~# rr[sk]`. If we made zeta a ConcreteTv, we will report - this unsolved equality using the 'ConcreteTvOrigin' stored in zeta[conc]. - This allows us to report ALL the problems in a representation-polymorphism - check (instead of only a non-empty subset). --} - --- | Try to turn the provided type into a concrete type, by ensuring --- unfilled metavariables are appropriately marked as concrete. --- --- Returns a zonked type which is "as concrete as possible", and --- a list of problems encountered when trying to make it concrete. --- --- INVARIANT: the returned type is equal to the input type, up to zonking. --- INVARIANT: if this function returns an empty list of 'NotConcreteReasons', --- then the returned type is concrete, in the sense of Note [Concrete types]. -makeTypeConcrete :: ConcreteTvOrigin -> TcType -> TcM (TcType, [NotConcreteReason]) --- TODO: it could be worthwhile to return enough information to continue solving. --- Consider unifying `alpha[conc] ~# TupleRep '[ beta[tau], F Int ]` for --- a type family 'F'. --- This function will concretise `beta[tau] := beta[conc]` and return --- that `TupleRep '[ beta[conc], F Int ]` is not concrete because of the --- type family application `F Int`. But we could decompose by setting --- alpha := TupleRep '[ beta, gamma[conc] ] and emitting `[W] gamma[conc] ~ F Int`. -makeTypeConcrete conc_orig ty = - do { res@(ty', _) <- runWriterT $ go ty - ; traceTc "makeTypeConcrete" $ - vcat [ text "ty:" <+> ppr ty - , text "ty':" <+> ppr ty' ] - ; return res } - where - go :: TcType -> WriterT [NotConcreteReason] TcM TcType - go ty - | Just ty <- coreView ty - = go ty - | isConcreteType ty - = pure ty - go ty@(TyVarTy tv) -- not a ConcreteTv (already handled above) - = do { mb_filled <- lift $ isFilledMetaTyVar_maybe tv - ; case mb_filled of - { Just ty -> go ty - ; Nothing - | isMetaTyVar tv - , TauTv <- metaTyVarInfo tv - -> -- Change the MetaInfo to ConcreteTv, but retain the TcLevel - do { kind <- go (tyVarKind tv) - ; let occ_fs = occNameFS (getOccName tv) - -- occ_fs: preserve the occurrence name of the original tyvar - -- This helps in error messages - ; lift $ - do { conc_tv <- setTcLevel (tcTyVarLevel tv) $ - newConcreteTyVar conc_orig occ_fs kind - ; let conc_ty = mkTyVarTy conc_tv - ; liftZonkM $ writeMetaTyVar tv conc_ty - ; return conc_ty } } - | otherwise - -- Don't attempt to make other type variables concrete - -- (e.g. SkolemTv, TyVarTv, CycleBreakerTv, RuntimeUnkTv). - -> bale_out ty (NonConcretisableTyVar tv) } } - go ty@(TyConApp tc tys) - | isConcreteTyCon tc - = mkTyConApp tc <$> mapM go tys - | otherwise - = bale_out ty (NonConcreteTyCon tc tys) - go (FunTy af w ty1 ty2) - = do { w <- go w - ; ty1 <- go ty1 - ; ty2 <- go ty2 - ; return $ mkFunTy af w ty1 ty2 } - go (AppTy ty1 ty2) - = do { ty1 <- go ty1 - ; ty2 <- go ty2 - ; return $ mkAppTy ty1 ty2 } - go ty@(LitTy {}) - = return ty - go ty@(CastTy cast_ty kco) - = bale_out ty (ContainsCast cast_ty kco) - go ty@(ForAllTy tcv body) - = bale_out ty (ContainsForall tcv body) - go ty@(CoercionTy co) - = bale_out ty (ContainsCoercionTy co) - - bale_out :: TcType -> NotConcreteReason -> WriterT [NotConcreteReason] TcM TcType - bale_out ty reason = do { tell [reason]; return ty } - -{-*********************************************************************** -%* * Concrete type variables of Ids %* * %**********************************************************************-} @@ -948,7 +803,7 @@ = mkNameEnv [(tyVarName a_rep, ConcreteFRR $ FixedRuntimeRepOrigin (mkTyVarTy a) $ FRRRepPolyId unsafeCoercePrimName RepPolyFunction - $ Argument 1 Top)] + $ mkArgPos 1 Top)] | otherwise = idDetailsConcreteTvs $ idDetails id diff --git a/GHC/Tc/Utils/Env.hs b/GHC/Tc/Utils/Env.hs --- a/GHC/Tc/Utils/Env.hs +++ b/GHC/Tc/Utils/Env.hs @@ -29,7 +29,7 @@ tcLookupLocatedClass, tcLookupAxiom, lookupGlobal, lookupGlobal_maybe, addTypecheckedBinds, - failIllegalTyCon, failIllegalTyVal, + failIllegalTyCon, failIllegalTyVar, -- Local environment tcExtendKindEnv, tcExtendKindEnvList, @@ -60,9 +60,9 @@ tcGetDefaultTys, -- Template Haskell stuff - StageCheckReason(..), - checkWellStaged, tcMetaTy, thLevel, - topIdLvl, isBrackStage, + LevelCheckReason(..), + tcMetaTy, thLevelIndex, + isBrackLevel, -- New Ids newDFunName, @@ -93,7 +93,6 @@ import GHC.Tc.Utils.TcType import {-# SOURCE #-} GHC.Tc.Utils.TcMType ( tcCheckUsage ) import GHC.Tc.Types.LclEnv -import GHC.Tc.Types.Evidence (HsWrapper, idHsWrapper, (<.>)) import GHC.Core.InstEnv import GHC.Core.DataCon ( DataCon, dataConTyCon, flSelector ) @@ -109,7 +108,7 @@ import GHC.Unit.Module import GHC.Unit.Module.ModDetails import GHC.Unit.Home -import GHC.Unit.Env +import GHC.Unit.Home.Graph import GHC.Unit.Home.ModInfo import GHC.Unit.External @@ -120,7 +119,7 @@ import GHC.Data.FastString import GHC.Data.List.SetOps -import GHC.Data.Maybe( MaybeErr(..), orElse ) +import GHC.Data.Maybe( MaybeErr(..), orElse, maybeToList, fromMaybe ) import GHC.Types.SrcLoc import GHC.Types.Basic hiding( SuccessFlag(..) ) @@ -129,8 +128,8 @@ import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Name.Env -import GHC.Types.DefaultEnv ( DefaultEnv, ClassDefaults(..), - defaultEnv, emptyDefaultEnv, lookupDefaultEnv, unitDefaultEnv ) +import GHC.Types.DefaultEnv +import GHC.Types.Error import GHC.Types.Id import GHC.Types.Id.Info ( RecSelParent(..) ) import GHC.Types.Name.Reader @@ -138,12 +137,15 @@ import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import qualified GHC.LanguageExtensions as LangExt +import GHC.Iface.Errors.Types +import GHC.Rename.Unbound ( unknownNameSuggestions ) +import GHC.Tc.Errors.Types.PromotionErr +import {-# SOURCE #-} GHC.Tc.Errors.Hole (getHoleFitDispConfig) + +import Control.Monad import Data.IORef import Data.List ( intercalate ) -import Control.Monad -import GHC.Iface.Errors.Types -import GHC.Types.Error -import GHC.Rename.Unbound ( unknownNameSuggestions, WhatLooking(..) ) +import qualified Data.List.NonEmpty as NE {- ********************************************************************* * * @@ -279,12 +281,12 @@ AConLike (PatSynCon ps) -> return ps _ -> wrongThingErr WrongThingPatSyn (AGlobal thing) name -tcLookupConLike :: Name -> TcM ConLike -tcLookupConLike name = do +tcLookupConLike :: WithUserRdr Name -> TcM ConLike +tcLookupConLike qname@(WithUserRdr _ name) = do thing <- tcLookupGlobal name case thing of AConLike cl -> return cl - ATyCon {} -> failIllegalTyCon WL_Constructor name + ATyCon {} -> failIllegalTyCon WL_ConLike qname _ -> wrongThingErr WrongThingConLike (AGlobal thing) name tcLookupRecSelParent :: HsRecUpdParent GhcRn -> TcM RecSelParent @@ -354,9 +356,9 @@ lookupClsDefault :: HomeUnitGraph -> ModuleEnv DefaultEnv -> Module -> IO (Maybe DefaultEnv) lookupClsDefault hug module_env_defaults mod = - case lookupHugByModule mod hug of - Just hm -> pure $ Just $ md_defaults $ hm_details hm - Nothing -> pure $ lookupModuleEnv module_env_defaults mod + lookupHugByModule mod hug >>= \case + Just hm -> pure $ Just $ md_defaults $ hm_details hm + Nothing -> pure $ lookupModuleEnv module_env_defaults mod tcGetInstEnvs :: TcM InstEnvs -- Gets both the external-package inst-env @@ -371,46 +373,98 @@ lookupThing = tcLookupGlobal -- Illegal term-level use of type things -failIllegalTyCon :: WhatLooking -> Name -> TcM a -failIllegalTyVal :: Name -> TcM a -(failIllegalTyCon, failIllegalTyVal) = (fail_tycon, fail_tyvar) +failIllegalTyCon :: WhatLooking -> WithUserRdr Name -> TcM a +failIllegalTyVar :: WithUserRdr Name -> TcM a +(failIllegalTyCon, failIllegalTyVar) = (fail_tycon, fail_tyvar) where - fail_tycon what_looking tc_nm = do + fail_tycon what_looking (WithUserRdr rdr tc_nm) = do gre <- getGlobalRdrEnv let mb_gre = lookupGRE_Name gre tc_nm - pprov = case mb_gre of - Just gre -> nest 2 (pprNameProvenance gre) - Nothing -> empty err = case greInfo <$> mb_gre of Just (IAmTyCon ClassFlavour) -> ClassTE _ -> TyConTE - fail_with_msg what_looking dataName tc_nm pprov err + fail_with_msg what_looking dataName rdr tc_nm (TermLevelUseGRE <$> mb_gre) err - fail_tyvar nm = - let pprov = nest 2 (text "bound at" <+> ppr (getSrcLoc nm)) - in fail_with_msg WL_Anything varName nm pprov TyVarTE + fail_tyvar (WithUserRdr rdr nm) = + fail_with_msg WL_Term varName rdr nm (Just TermLevelUseTyVar) TyVarTE - fail_with_msg what_looking whatName nm pprov err = do - (import_errs, hints) <- get_suggestions what_looking whatName nm + fail_with_msg what_looking whatName rdr nm pprov err = do + required_type_arguments <- xoptM LangExt.RequiredTypeArguments + (imp_errs, hints) <- get_suggestions required_type_arguments what_looking whatName rdr + hfdc <- getHoleFitDispConfig unit_state <- hsc_units <$> getTopEnv let - -- TODO: unfortunate to have to convert to SDoc here. - -- This should go away once we refactor ErrInfo. - hint_msg = vcat $ map ppr hints - import_err_msg = vcat $ map ppr import_errs - info = ErrInfo { errInfoContext = pprov, errInfoSupplementary = import_err_msg $$ hint_msg } - failWithTc $ TcRnMessageWithInfo unit_state ( - mkDetailedMessage info (TcRnIllegalTermLevelUse nm err)) + want_simple = want_simple_msg hints + msg = TcRnIllegalTermLevelUse want_simple rdr nm err + info = ErrInfo { errInfoContext = + if want_simple + then [] + else maybeToList $ fmap (TermLevelUseCtxt nm) pprov + , errInfoSupplementary = + fmap ((hfdc,) . (:[]) . SupplementaryImportErrors) $ + NE.nonEmpty imp_errs + , errInfoHints = hints + } + failWithTc $ TcRnMessageWithInfo unit_state (mkDetailedMessage info msg) - get_suggestions what_looking ns nm = do - required_type_arguments <- xoptM LangExt.RequiredTypeArguments - if required_type_arguments && isVarNameSpace ns + get_suggestions required_type_arguments what_looking ns rdr = do + show_helpful_errors <- goptM Opt_HelpfulErrors + if not show_helpful_errors || (required_type_arguments && isVarNameSpace ns) then return ([], []) -- See Note [Suppress hints with RequiredTypeArguments] else do - let occ = mkOccNameFS ns (occNameFS (occName nm)) + let rdr' = fromMaybe rdr (demoteRdrName rdr) lcl_env <- getLocalRdrEnv - unknownNameSuggestions lcl_env what_looking (mkRdrUnqual occ) -{- + unknownNameSuggestions lcl_env what_looking rdr' + +-- | Should we display a simpler "out of scope" message to the user, instead of +-- a full-blown "illegal term-level use" message? +-- +-- See Note [Simpler "illegal term-level use" errors] +want_simple_msg :: [GhcHint] -> Bool +want_simple_msg hints = any relevant_suggestion hints + where + relevant_suggestion = \case + ImportSuggestion {} -> True + SuggestSimilarNames {} -> True + _ -> False + +{- Note [Simpler "illegal term-level use" errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we rename the occurrence of A in the definition of 'f' in the following program: + + module M1 where + data A = A Int + module M2 where + import M1 (A) + f x = A x + +we initially resolve 'A' to the type constructor 'A', in order to support +-XRequiredTypeArguments. Then we come to find out that a type is illegal in +this position. It is more user-friendly to report the problem as: + + Data constructor out of scope: A + +rather than: + + Illegal term-level use of type constructor A + +This was reported in #23982. + +To achieve this, in 'failIllegalTyCon' and 'failIllegalTyVar', we include a +little heuristic to decide whether to emit an "out of scope" message rather than +an "illegal term-level use" message: when we have a term to suggest to the user, +then give the simpler "out of scope" error message. + +For instance, in the example above, we suggest extending the import list to + + import M1 (A(A)) + +to bring the data constructor A into scope. We thus emit the following message: + + Data constructor out of scope: A + Suggested fix: + Add ‘A’ to the import list in the import of M1 + ************************************************************************ * * Extending the global environment @@ -466,9 +520,8 @@ -- See GHC ticket #17820 . tcTyThBinders :: [TyThing] -> TcM ThBindEnv tcTyThBinders implicit_things = do - stage <- getStage - let th_lvl = thLevel stage - th_bndrs = mkNameEnv + th_lvl <- thLevelIndex <$> getThLevel + let th_bndrs = mkNameEnv [ ( n , (TopLevel, th_lvl) ) | n <- names ] return th_bndrs where @@ -640,7 +693,7 @@ tcExtendLetEnv :: TopLevelFlag -> TcSigFun -> IsGroupClosed - -> [Scaled TcId] -> TcM a -> TcM (a, HsWrapper) + -> [Scaled TcId] -> TcM a -> TcM a -- Used for both top-level value bindings and nested let/where-bindings -- Adds to the TcBinderStack too tcExtendLetEnv top_lvl sig_fn (IsGroupClosed fvs fv_type_closed) @@ -650,7 +703,7 @@ [ (idName id, ATcId { tct_id = id , tct_info = mk_tct_info id }) | Scaled _ id <- ids ] $ - foldr check_usage ((, idHsWrapper) <$> thing_inside) scaled_names + foldr check_usage thing_inside scaled_names where mk_tct_info id | type_closed && isEmptyNameSet rhs_fvs = ClosedLet @@ -661,10 +714,9 @@ type_closed = isTypeClosedLetBndr id && (fv_type_closed || hasCompleteSig sig_fn name) scaled_names = [Scaled p (idName id) | Scaled p id <- ids ] - check_usage :: Scaled Name -> TcM (a, HsWrapper) -> TcM (a, HsWrapper) + check_usage :: Scaled Name -> TcM a -> TcM a check_usage (Scaled p id) thing_inside = do - ((res, inner_wrap), outer_wrap) <- tcCheckUsage id p thing_inside - return $ (res, outer_wrap <.> inner_wrap) + tcCheckUsage id p thing_inside tcExtendIdEnv :: [TcId] -> TcM a -> TcM a -- For lambda-bound and case-bound Ids @@ -705,7 +757,7 @@ = do { traceTc "tc_extend_local_env" (ppr extra_env) ; updLclCtxt upd_lcl_env thing_inside } where - upd_lcl_env env0@(TcLclCtxt { tcl_th_ctxt = stage + upd_lcl_env env0@(TcLclCtxt { tcl_th_ctxt = th_lvl , tcl_rdr = rdr_env , tcl_th_bndrs = th_bndrs , tcl_env = lcl_type_env }) @@ -722,7 +774,7 @@ -- Template Haskell staging env simultaneously. Reason for extending -- LocalRdrEnv: after running a TH splice we need to do renaming. where - thlvl = (top_lvl, thLevel stage) + thlvl = (top_lvl, thLevelIndex th_lvl) tcExtendLocalTypeEnv :: [(Name, TcTyThing)] -> TcLclCtxt -> TcLclCtxt @@ -869,34 +921,6 @@ ************************************************************************ -} -checkWellStaged :: StageCheckReason -- What the stage check is for - -> ThLevel -- Binding level (increases inside brackets) - -> ThLevel -- Use stage - -> TcM () -- Fail if badly staged, adding an error -checkWellStaged pp_thing bind_lvl use_lvl - | use_lvl >= bind_lvl -- OK! Used later than bound - = return () -- E.g. \x -> [| $(f x) |] - - | bind_lvl == outerLevel -- GHC restriction on top level splices - = failWithTc (TcRnStageRestriction pp_thing) - - | otherwise -- Badly staged - = failWithTc $ -- E.g. \x -> $(f x) - TcRnBadlyStaged pp_thing bind_lvl use_lvl - -topIdLvl :: Id -> ThLevel --- Globals may either be imported, or may be from an earlier "chunk" --- (separated by declaration splices) of this module. The former --- *can* be used inside a top-level splice, but the latter cannot. --- Hence we give the former impLevel, but the latter topLevel --- E.g. this is bad: --- x = [| foo |] --- $( f x ) --- By the time we are processing the $(f x), the binding for "x" --- will be in the global env, not the local one. -topIdLvl id | isLocalId id = outerLevel - | otherwise = impLevel - tcMetaTy :: Name -> TcM Type -- Given the name of a Template Haskell data type, -- return the type @@ -905,9 +929,9 @@ t <- tcLookupTyCon tc_name return (mkTyConTy t) -isBrackStage :: ThStage -> Bool -isBrackStage (Brack {}) = True -isBrackStage _other = False +isBrackLevel :: ThLevel -> Bool +isBrackLevel (Brack {}) = True +isBrackLevel _other = False {- ************************************************************************ @@ -917,21 +941,28 @@ ************************************************************************ -} -{- Note [Default class defaults] +{- Note [Builtin class defaults] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In absence of user-defined `default` declarations, the set of class defaults in -effect (i.e. `DefaultEnv`) is determined by the absence or -presence of the `ExtendedDefaultRules` and `OverloadedStrings` extensions. In their -absence, the only rule in effect is `default Num (Integer, Double)` as specified by -Haskell Language Report. +In the absence of user-defined `default` declarations, the set of class defaults in +effect (i.e. the `DefaultEnv`) depends on whether the `ExtendedDefaultRules` and +`OverloadedStrings` extensions are enabled. In their absence, the only rule in effect +is `default Num (Integer, Double)`, as specified by the Haskell 2010 report. -In GHC's internal packages `DefaultEnv` is empty to minimize cross-module dependencies: -the `Num` class or `Integer` type may not even be available in low-level modules. If -you don't do this, attempted defaulting in package ghc-prim causes an actual crash -(attempting to look up the `Integer` type). +Remark [No built-in defaults in ghc-internal] -A user-defined `default` declaration overrides the defaults for the specified class, -and only for that class. + When typechecking the ghc-internal package, we **do not** include any built-in + defaults. This is because, in ghc-internal, types such as 'Num' or 'Integer' may + not even be available (they haven't been typechecked yet). + +Remark [default () in ghc-internal] + + Historically, modules inside ghc-internal have used a single default declaration, + of the form `default ()`, to work around the problem described in + Remark [No built-in defaults in ghc-internal]. + + When we typecheck such a default declaration, we must also make sure not to fail + if e.g. 'Num' is not in scope. We thus have special treatment for this case, + in 'GHC.Tc.Gen.Default.tcDefaultDecls'. -} tcGetDefaultTys :: TcM (DefaultEnv, -- Default classes and types @@ -943,16 +974,16 @@ -- See also #1974 builtinDefaults cls tys = ClassDefaults{ cd_class = cls , cd_types = tys - , cd_module = Nothing + , cd_provenance = DP_Builtin , cd_warn = Nothing } -- see Note [Named default declarations] in GHC.Tc.Gen.Default ; defaults <- getDeclaredDefaultTys -- User-supplied defaults ; this_module <- tcg_mod <$> getGblEnv ; let this_unit = moduleUnit this_module - is_internal_unit = this_unit `elem` [bignumUnit, ghcInternalUnit, primUnit] - ; if is_internal_unit - -- see Note [Default class defaults] + ; if this_unit == ghcInternalUnit + -- see Remark [No built-in defaults in ghc-internal] + -- in Note [Builtin class defaults] in GHC.Tc.Utils.Env then return (defaults, extended_defaults) else do -- not one of the built-in units @@ -984,6 +1015,8 @@ } -- The Num class is already user-defaulted, no need to construct the builtin default _ -> pure emptyDefaultEnv + -- Supply the built-in defaults, but make the user-supplied defaults + -- override them. ; let deflt_tys = mconcat [ extDef, numDef, ovlStr, defaults ] ; return (deflt_tys, extended_defaults) } } @@ -1180,14 +1213,8 @@ notFound :: Name -> TcM TyThing notFound name = do { lcl_env <- getLclEnv - ; let stage = getLclEnvThStage lcl_env - ; case stage of -- See Note [Out of scope might be a staging error] - Splice {} - | isUnboundName name -> failM -- If the name really isn't in scope - -- don't report it again (#11941) - | otherwise -> failWithTc (TcRnStageRestriction (StageCheckSplice name)) - - _ | isTermVarOrFieldNameSpace (nameNameSpace name) -> + ; if isTermVarOrFieldNameSpace (nameNameSpace name) + then -- This code path is only reachable with RequiredTypeArguments enabled -- via the following chain of calls: -- `notFound` called from @@ -1200,13 +1227,13 @@ -- See Note [Demotion of unqualified variables] (W1) in GHC.Rename.Env failWithTc $ TcRnUnpromotableThing name TermVariablePE - | otherwise -> failWithTc $ - mkTcRnNotInScope (getRdrName name) (NotInScopeTc (getLclEnvTypeEnv lcl_env)) - -- Take care: printing the whole gbl env can - -- cause an infinite loop, in the case where we - -- are in the middle of a recursive TyCon/Class group; - -- so let's just not print it! Getting a loop here is - -- very unhelpful, because it hides one compiler bug with another + else failWithTc $ + TcRnNotInScope (NotInScopeTc (getLclEnvTypeEnv lcl_env)) (getRdrName name) + -- Take care: printing the whole gbl env can + -- cause an infinite loop, in the case where we + -- are in the middle of a recursive TyCon/Class group; + -- so let's just not print it! Getting a loop here is + -- very unhelpful, because it hides one compiler bug with another } wrongThingErr :: WrongThingSort -> TcTyThing -> Name -> TcM a diff --git a/GHC/Tc/Utils/Instantiate.hs b/GHC/Tc/Utils/Instantiate.hs --- a/GHC/Tc/Utils/Instantiate.hs +++ b/GHC/Tc/Utils/Instantiate.hs @@ -55,6 +55,7 @@ import GHC.Core ( isOrphan ) -- For the Coercion constructor import GHC.Core.Type import GHC.Core.TyCo.Ppr ( debugPprType ) +import GHC.Core.TyCo.Tidy ( tidyType ) import GHC.Core.Class( Class ) import GHC.Core.Coercion.Axiom @@ -71,15 +72,17 @@ import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Monad ( ZonkM ) +import GHC.Rename.Utils( mkRnSyntaxExpr ) + import GHC.Types.Id.Make( mkDictFunId ) import GHC.Types.Basic ( TypeOrKind(..), Arity, VisArity ) -import GHC.Types.Error import GHC.Types.SourceText import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Name import GHC.Types.Name.Env +import GHC.Types.Name.Reader (WithUserRdr(..)) import GHC.Types.Var import qualified GHC.LanguageExtensions as LangExt @@ -130,7 +133,7 @@ ; wrap <- assert (not (isForAllTy ty) && isSingleton theta) $ instCall origin ty_args theta - ; return (mkHsWrap wrap (HsVar noExtField (noLocA id))) } + ; return (mkHsWrap wrap (mkHsVar (noLocA id))) } {- ************************************************************************ @@ -487,7 +490,11 @@ = do { (extra_args, kind') <- tcInstInvisibleTyBindersN n_invis kind ; return (mkAppTys ty extra_args, kind') } where - n_invis = invisibleTyBndrCount kind + n_invis = invisibleBndrCount kind + -- We are re-using tcInstInvisibleTyBindersN, which is + -- needed elsewhere; so all that matters is that n_invis + -- is big enough! Does not matter if it is too big. + -- 10,000 would do equally well :-) tcInstInvisibleTyBindersN :: Int -> TcKind -> TcM ([TcType], TcKind) -- Called only to instantiate kinds, in user-written type signatures @@ -574,9 +581,12 @@ ; (subst, inst_tvs) <- tcInstSuperSkolTyVars skol_info tvs -- We instantiate the dfun_tyd with superSkolems. -- See Note [Subtle interaction of recursion and overlap] - -- and Note [Binding when looking up instances] - ; let inst_tys = substTys subst tys - skol_info_anon = mkClsInstSkol cls inst_tys } + -- and Note [Super skolems: binding when looking up instances] + ; let inst_tys = substTys subst tys + skol_info_anon = InstSkol IsClsInst (pSizeClassPred cls inst_tys) + -- We need to take the size of `inst_tys` (not `tys`) because + -- Paterson sizes mention the free type variables + } ; let inst_theta = substTheta subst theta ; return (skol_info_anon, inst_tvs, inst_theta, cls, inst_tys) } @@ -585,7 +595,7 @@ -- Make skolem constants, but do *not* give them new names, as above -- As always, allocate them one level in -- Moreover, make them "super skolems"; see GHC.Core.InstEnv --- Note [Binding when looking up instances] +-- Note [Super skolems: binding when looking up instances] -- See Note [Kind substitution when instantiating] -- Precondition: tyvars should be ordered by scoping tcSuperSkolTyVars tc_lvl skol_info = mapAccumL do_one emptySubst @@ -807,15 +817,14 @@ orig = LiteralOrigin lit ------------ -mkOverLit :: OverLitVal -> TcM (HsLit (GhcPass p)) +mkOverLit :: OverLitVal -> TcM (HsLit GhcTc) mkOverLit (HsIntegral i) = do { integer_ty <- tcMetaTy integerTyConName - ; return (HsInteger (il_text i) - (il_value i) integer_ty) } + ; return (XLit $ HsInteger (il_text i) (il_value i) integer_ty) } mkOverLit (HsFractional r) = do { rat_ty <- tcMetaTy rationalTyConName - ; return (HsRat noExtField r rat_ty) } + ; return (XLit $ HsRat r rat_ty) } mkOverLit (HsIsString src s) = return (HsString src s) @@ -859,7 +868,7 @@ -- USED ONLY FOR CmdTop (sigh) *** -- See Note [CmdSyntaxTable] in "GHC.Hs.Expr" -tcSyntaxName orig ty (std_nm, HsVar _ (L _ user_nm)) +tcSyntaxName orig ty (std_nm, HsVar _ (L _ (WithUserRdr _ user_nm))) | std_nm == user_nm = do rhs <- newMethodFromName orig std_nm [ty] return (std_nm, rhs) @@ -882,15 +891,10 @@ hasFixedRuntimeRepRes std_nm user_nm_expr sigma1 return (std_nm, unLoc expr) -syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> SrcSpan -> TidyEnv - -> ZonkM (TidyEnv, SDoc) -syntaxNameCtxt name orig ty loc tidy_env = return (tidy_env, msg) - where - msg = vcat [ text "When checking that" <+> quotes (ppr name) - <+> text "(needed by a syntactic construct)" - , nest 2 (text "has the required type:" - <+> ppr (tidyType tidy_env ty)) - , nest 2 (sep [ppr orig, text "at" <+> ppr loc])] +syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> SrcSpan + -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) +syntaxNameCtxt name orig ty loc tidy_env = + return (tidy_env, SyntaxNameCtxt name orig (tidyType tidy_env ty) loc) {- ************************************************************************ diff --git a/GHC/Tc/Utils/Monad.hs b/GHC/Tc/Utils/Monad.hs --- a/GHC/Tc/Utils/Monad.hs +++ b/GHC/Tc/Utils/Monad.hs @@ -15,12 +15,13 @@ -- * Simple accessors discardResult, - getTopEnv, updTopEnv, getGblEnv, updGblEnv, + getTopEnv, updTopEnv, updTopEnvIO, getGblEnv, updGblEnv, setGblEnv, getLclEnv, updLclEnv, updLclCtxt, setLclEnv, restoreLclEnv, updTopFlags, getEnvs, setEnvs, updEnvs, restoreEnvs, xoptM, doptM, goptM, woptM, - setXOptM, unsetXOptM, unsetGOptM, unsetWOptM, + setXOptM, setWOptM, + unsetXOptM, unsetGOptM, unsetWOptM, whenDOptM, whenGOptM, whenWOptM, whenXOptM, unlessXOptM, getGhcMode, @@ -75,7 +76,9 @@ -- * Shared error message stuff: renamer and typechecker recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM, attemptM, tryTc, - askNoErrs, discardErrs, tryTcDiscardingErrs, + askNoErrs, discardErrs, + tryTcDiscardingErrs, + tryTcDiscardingErrs', checkNoErrs, whenNoErrs, ifErrsM, failIfErrsM, @@ -88,8 +91,9 @@ addErrTcM, failWithTc, failWithTcM, checkTc, checkTcM, + checkJustTc, checkJustTcM, failIfTc, failIfTcM, - mkErrInfo, + mkErrCtxt, addTcRnDiagnostic, addDetailedDiagnostic, mkTcRnMessage, reportDiagnostic, reportDiagnostics, warnIf, diagnosticTc, diagnosticTcM, @@ -97,12 +101,12 @@ -- * Type constraints newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar, - addTcEvBind, addTopEvBinds, - getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap, - chooseUniqueOccTc, + addTcEvBind, addTcEvBinds, addTopEvBinds, + getTcEvBindsMap, setTcEvBindsMap, updTcEvBinds, + getTcEvTyCoVars, chooseUniqueOccTc, getConstraintVar, setConstraintVar, emitConstraints, emitStaticConstraints, emitSimple, emitSimples, - emitImplication, emitImplications, + emitImplication, emitImplications, ensureReflMultiplicityCo, emitDelayedErrors, emitHole, emitHoles, emitNotConcreteError, discardConstraints, captureConstraints, tryCaptureConstraints, pushLevelAndCaptureConstraints, @@ -113,8 +117,8 @@ emitNamedTypeHole, IsExtraConstraint(..), emitAnonTypeHole, -- * Template Haskell context - recordThUse, recordThSpliceUse, recordThNeededRuntimeDeps, - keepAlive, getStage, getStageAndBindLevel, setStage, + recordThUse, recordThNeededRuntimeDeps, + keepAlive, getThLevel, getCurrentAndBindLevel, setThLevel, addModFinalizersWithLclEnv, -- * Safe Haskell context @@ -163,8 +167,10 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Types.CtLoc import GHC.Tc.Types.Evidence +import GHC.Tc.Types.LclEnv import GHC.Tc.Types.Origin import GHC.Tc.Types.TcRef +import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType import GHC.Tc.Zonk.TcType @@ -174,7 +180,7 @@ import GHC.Unit.Env import GHC.Unit.External import GHC.Unit.Module.Warnings -import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable import GHC.Core.UsageEnv import GHC.Core.Multiplicity @@ -183,9 +189,15 @@ import GHC.Core.Type( mkNumLitTy ) import GHC.Driver.Env +import GHC.Driver.Env.KnotVars import GHC.Driver.Session import GHC.Driver.Config.Diagnostic +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr + +import GHC.Linker.Types + import GHC.Runtime.Context import GHC.Data.IOEnv -- Re-export all @@ -199,6 +211,7 @@ import GHC.Utils.Constants (debugIsOn) import GHC.Utils.Logger import qualified GHC.Data.Strict as Strict +import qualified Data.Set as Set import GHC.Types.Error import GHC.Types.DefaultEnv ( DefaultEnv, emptyDefaultEnv ) @@ -208,16 +221,16 @@ import GHC.Types.SafeHaskell import GHC.Types.Id import GHC.Types.TypeEnv -import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.SrcLoc import GHC.Types.Name.Env import GHC.Types.Name.Set import GHC.Types.Name.Ppr import GHC.Types.Unique.FM ( emptyUFM ) +import GHC.Types.Unique.DFM import GHC.Types.Unique.Supply import GHC.Types.Annotations -import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) ) +import GHC.Types.Basic( TopLevelFlag(..), TypeOrKind(..) ) import GHC.Types.CostCentre.State import GHC.Types.SourceFile @@ -227,13 +240,9 @@ import Control.Monad import qualified Data.Map as Map -import GHC.Driver.Env.KnotVars -import GHC.Linker.Types -import GHC.Types.Unique.DFM -import GHC.Iface.Errors.Types -import GHC.Iface.Errors.Ppr -import GHC.Tc.Types.LclEnv +import GHC.Core.Coercion (isReflCo) + {- ************************************************************************ * * @@ -257,7 +266,6 @@ = do { keep_var <- newIORef emptyNameSet ; used_gre_var <- newIORef [] ; th_var <- newIORef False ; - th_splice_var<- newIORef False ; infer_var <- newIORef True ; infer_reasons_var <- newIORef emptyMessages ; dfun_n_var <- newIORef emptyOccSet ; @@ -319,8 +327,8 @@ tcg_inst_env = emptyInstEnv, tcg_fam_inst_env = emptyFamInstEnv, tcg_ann_env = emptyAnnEnv, + tcg_complete_match_env = [], tcg_th_used = th_var, - tcg_th_splice_used = th_splice_var, tcg_th_needed_deps = th_needed_deps_var, tcg_exports = [], tcg_imports = emptyImportAvails, @@ -355,7 +363,6 @@ tcg_zany_n = zany_n_var, tcg_keep = keep_var, tcg_hdr_info = (Nothing,Nothing), - tcg_hpc = False, tcg_main = Nothing, tcg_self_boot = NoSelfBoot, tcg_safe_infer = infer_var, @@ -394,7 +401,7 @@ tcl_in_gen_code = False, tcl_ctxt = [], tcl_rdr = emptyLocalRdrEnv, - tcl_th_ctxt = topStage, + tcl_th_ctxt = topLevel, tcl_th_bndrs = emptyNameEnv, tcl_arrow_ctxt = NoArrowCtxt, tcl_env = emptyNameEnv, @@ -472,6 +479,11 @@ updTopEnv upd = updEnv (\ env@(Env { env_top = top }) -> env { env_top = upd top }) +updTopEnvIO :: (HscEnv -> IO HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +updTopEnvIO upd = updEnvIO (\ env@(Env { env_top = top }) -> + upd top >>= \t' -> + pure env{ env_top = t' }) + getGblEnv :: TcRnIf gbl lcl gbl getGblEnv = do { Env{..} <- getEnv; return env_gbl } @@ -570,6 +582,9 @@ setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updTopFlags (\dflags -> xopt_set dflags flag) +setWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +setWOptM flag = updTopFlags (\dflags -> wopt_set dflags flag) + unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetXOptM flag = updTopFlags (\dflags -> xopt_unset dflags flag) @@ -1058,11 +1073,11 @@ -- work doesn't matter addErrAt loc msg = do { ctxt <- getErrCtxt ; tidy_env <- liftZonkM $ tcInitTidyEnv - ; err_info <- mkErrInfo tidy_env ctxt - ; let detailed_msg = mkDetailedMessage (ErrInfo err_info Outputable.empty) msg + ; err_ctxt <- mkErrCtxt tidy_env ctxt + ; let detailed_msg = mkDetailedMessage (ErrInfo err_ctxt Nothing noHints) msg ; add_long_err_at loc detailed_msg } -mkDetailedMessage :: ErrInfo -> TcRnMessage -> TcRnMessageDetailed +mkDetailedMessage :: ErrInfo-> TcRnMessage -> TcRnMessageDetailed mkDetailedMessage err_info msg = TcRnMessageDetailed err_info msg @@ -1217,12 +1232,12 @@ -- | Add a fixed message to the error context. This message should not -- do any tidying. -addErrCtxt :: SDoc -> TcM a -> TcM a +addErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a {-# INLINE addErrCtxt #-} -- Note [Inlining addErrCtxt] addErrCtxt msg = addErrCtxtM (\env -> return (env, msg)) -- | Add a message to the error context. This message may do tidying. -addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, SDoc)) -> TcM a -> TcM a +addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a {-# INLINE addErrCtxtM #-} -- Note [Inlining addErrCtxt] addErrCtxtM ctxt = pushCtxt (False, ctxt) @@ -1230,13 +1245,13 @@ -- message is always sure to be reported, even if there is a lot of -- context. It also doesn't count toward the maximum number of contexts -- reported. -addLandmarkErrCtxt :: SDoc -> TcM a -> TcM a +addLandmarkErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a {-# INLINE addLandmarkErrCtxt #-} -- Note [Inlining addErrCtxt] addLandmarkErrCtxt msg = addLandmarkErrCtxtM (\env -> return (env, msg)) -- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations -- and tidying. -addLandmarkErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, SDoc)) -> TcM a -> TcM a +addLandmarkErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a {-# INLINE addLandmarkErrCtxtM #-} -- Note [Inlining addErrCtxt] addLandmarkErrCtxtM ctxt = pushCtxt (True, ctxt) @@ -1370,11 +1385,13 @@ tcTryM thing_inside -- See Note [Constraints and errors] - ; let lie_to_keep = case mb_res of - Nothing -> dropMisleading lie - Just {} -> lie - - ; return (mb_res, lie_to_keep) } + ; case mb_res of + Just {} -> return (mb_res, lie) + Nothing -> do { let pruned_lie = dropMisleading lie + ; traceTc "tryCaptureConstraints" $ + vcat [ text "lie:" <+> ppr lie + , text "dropMisleading lie:" <+> ppr pruned_lie ] + ; return (Nothing, pruned_lie) } } captureConstraints :: TcM a -> TcM (a, WantedConstraints) -- (captureConstraints m) runs m, and returns the type constraints it generates @@ -1510,21 +1527,37 @@ -- if 'main' succeeds with no error messages, it's the answer -- otherwise discard everything from 'main', including errors, -- and try 'recover' instead. -tryTcDiscardingErrs recover thing_inside +tryTcDiscardingErrs recover = + tryTcDiscardingErrs' + (\_ _ _ -> True) -- No validation + recover recover -- Discard all errors and warnings + -- and unsolved constraints entirely + +tryTcDiscardingErrs' :: (WantedConstraints -> Messages TcRnMessage -> r -> Bool) -- Validation + -> TcM r -- Recover from validation error + -> TcM r -- Recover from failure + -> TcM r -- Action to try + -> TcM r +-- (tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside) tries 'thing_inside'; +-- if 'thing_inside' succeeds and validation produces no errors, it's the answer +-- otherwise discard everything from 'thing_inside', including errors, +-- and try 'recover' instead. +tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside = do { ((mb_res, lie), msgs) <- capture_messages $ capture_constraints $ tcTryM thing_inside ; case mb_res of Just res | not (errorsFound msgs) , not (insolubleWC lie) - -> -- 'main' succeeded with no errors - do { addMessages msgs -- msgs might still have warnings - ; emitConstraints lie - ; return res } + -- 'thing_inside' succeeded with no errors + -> if validate lie msgs res + then do { addMessages msgs -- msgs might still have warnings + ; emitConstraints lie + ; return res } + else recover_invalid - _ -> -- 'main' failed, or produced an error message - recover -- Discard all errors and warnings - -- and unsolved constraints entirely + _ -> -- 'thing_inside' failed, or produced an error message + recover_error } {- @@ -1578,6 +1611,12 @@ checkTcM True _ = return () checkTcM False err = failWithTcM err +checkJustTc :: TcRnMessage -> Maybe a -> TcM a +checkJustTc err = maybe (failWithTc err) pure + +checkJustTcM :: (TidyEnv, TcRnMessage) -> Maybe a -> TcM a +checkJustTcM err = maybe (failWithTcM err) pure + failIfTc :: Bool -> TcRnMessage -> TcM () -- Check that the boolean is false failIfTc False _ = return () failIfTc True err = failWithTc err @@ -1595,9 +1634,6 @@ warnIf is_bad msg -- No need to check any flag here, it will be done in 'diagReasonSeverity'. = when is_bad (addDiagnostic msg) -no_err_info :: ErrInfo -no_err_info = ErrInfo Outputable.empty Outputable.empty - -- | Display a warning if a condition is met. diagnosticTc :: Bool -> TcRnMessage -> TcM () diagnosticTc should_report warn_msg @@ -1620,22 +1656,23 @@ addDiagnosticTcM :: (TidyEnv, TcRnMessage) -> TcM () addDiagnosticTcM (env0, msg) = do { ctxt <- getErrCtxt - ; extra <- mkErrInfo env0 ctxt - ; let err_info = ErrInfo extra Outputable.empty - detailed_msg = mkDetailedMessage err_info msg + ; extra <- mkErrCtxt env0 ctxt + ; let detailed_msg = mkDetailedMessage (ErrInfo extra Nothing noHints) msg ; add_diagnostic detailed_msg } -- | A variation of 'addDiagnostic' that takes a function to produce a 'TcRnDsMessage' -- given some additional context about the diagnostic. -addDetailedDiagnostic :: (ErrInfo -> TcRnMessage) -> TcM () +addDetailedDiagnostic :: ([ErrCtxtMsg] -> TcRnMessage) -> TcM () addDetailedDiagnostic mkMsg = do loc <- getSrcSpanM name_ppr_ctx <- getNamePprCtx !diag_opts <- initDiagOpts <$> getDynFlags env0 <- liftZonkM tcInitTidyEnv ctxt <- getErrCtxt - err_info <- mkErrInfo env0 ctxt - reportDiagnostic (mkMsgEnvelope diag_opts loc name_ppr_ctx (mkMsg (ErrInfo err_info empty))) + err_info <- mkErrCtxt env0 ctxt + reportDiagnostic $ + mkMsgEnvelope diag_opts loc name_ppr_ctx $ + mkMsg err_info addTcRnDiagnostic :: TcRnMessage -> TcM () addTcRnDiagnostic msg = do @@ -1645,13 +1682,13 @@ -- | Display a diagnostic for the current source location, taken from -- the 'TcRn' monad. addDiagnostic :: TcRnMessage -> TcRn () -addDiagnostic msg = add_diagnostic (mkDetailedMessage no_err_info msg) +addDiagnostic msg = add_diagnostic (mkDetailedMessage (ErrInfo [] Nothing noHints) msg) -- | Display a diagnostic for a given source location. addDiagnosticAt :: SrcSpan -> TcRnMessage -> TcRn () addDiagnosticAt loc msg = do unit_state <- hsc_units <$> getTopEnv - let detailed_msg = mkDetailedMessage no_err_info msg + let detailed_msg = mkDetailedMessage (ErrInfo [] Nothing noHints) msg mkTcRnMessage loc (TcRnMessageWithInfo unit_state detailed_msg) >>= reportDiagnostic -- | Display a diagnostic, with an optional flag, for the current source @@ -1663,7 +1700,6 @@ ; mkTcRnMessage loc (TcRnMessageWithInfo unit_state msg) >>= reportDiagnostic } - {- ----------------------------------- Other helper functions @@ -1673,12 +1709,13 @@ -> [ErrCtxt] -> TcM () add_err_tcm tidy_env msg loc ctxt - = do { err_info <- mkErrInfo tidy_env ctxt ; - add_long_err_at loc (mkDetailedMessage (ErrInfo err_info Outputable.empty) msg) } + = do { err_ctxt <- mkErrCtxt tidy_env ctxt + ; add_long_err_at loc $ + mkDetailedMessage (ErrInfo err_ctxt Nothing noHints) msg } -mkErrInfo :: TidyEnv -> [ErrCtxt] -> TcM SDoc +mkErrCtxt :: TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg] -- Tidy the error info, trimming excessive contexts -mkErrInfo env ctxts +mkErrCtxt env ctxts -- = do -- dbg <- hasPprDebug <$> getDynFlags -- if dbg -- In -dppr-debug style the output @@ -1686,14 +1723,14 @@ -- else go dbg 0 env ctxts = go False 0 env ctxts where - go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM SDoc - go _ _ _ [] = return empty + go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg] + go _ _ _ [] = return [] go dbg n env ((is_landmark, ctxt) : ctxts) | is_landmark || n < mAX_CONTEXTS -- Too verbose || dbg = do { (env', msg) <- liftZonkM $ ctxt env ; let n' = if is_landmark then n else n+1 ; rest <- go dbg n' env' ctxts - ; return (msg $$ rest) } + ; return (msg : rest) } | otherwise = go dbg n env ctxts @@ -1724,7 +1761,7 @@ newTcEvBinds :: TcM EvBindsVar newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindMap - ; tcvs_ref <- newTcRef emptyVarSet + ; tcvs_ref <- newTcRef [] ; uniq <- newUnique ; traceTc "newTcEvBinds" (text "unique =" <+> ppr uniq) ; return (EvBindsVar { ebv_binds = binds_ref @@ -1736,7 +1773,7 @@ -- must be made monadically newNoTcEvBinds :: TcM EvBindsVar newNoTcEvBinds - = do { tcvs_ref <- newTcRef emptyVarSet + = do { tcvs_ref <- newTcRef [] ; uniq <- newUnique ; traceTc "newNoTcEvBinds" (text "unique =" <+> ppr uniq) ; return (CoEvBindsVar { ebv_tcvs = tcvs_ref @@ -1747,14 +1784,14 @@ -- solving don't pollute the original cloneEvBindsVar ebv@(EvBindsVar {}) = do { binds_ref <- newTcRef emptyEvBindMap - ; tcvs_ref <- newTcRef emptyVarSet + ; tcvs_ref <- newTcRef [] ; return (ebv { ebv_binds = binds_ref , ebv_tcvs = tcvs_ref }) } cloneEvBindsVar ebv@(CoEvBindsVar {}) - = do { tcvs_ref <- newTcRef emptyVarSet + = do { tcvs_ref <- newTcRef [] ; return (ebv { ebv_tcvs = tcvs_ref }) } -getTcEvTyCoVars :: EvBindsVar -> TcM TyCoVarSet +getTcEvTyCoVars :: EvBindsVar -> TcM [TcCoercion] getTcEvTyCoVars ev_binds_var = readTcRef (ebv_tcvs ev_binds_var) @@ -1773,16 +1810,52 @@ | otherwise = pprPanic "setTcEvBindsMap" (ppr v $$ ppr ev_binds) +updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM () +updTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref, ebv_tcvs = old_tcv_ref }) + (EvBindsVar { ebv_binds = new_ebv_ref, ebv_tcvs = new_tcv_ref }) + = do { new_ebvs <- readTcRef new_ebv_ref + ; updTcRef old_ebv_ref (`unionEvBindMap` new_ebvs) + ; new_tcvs <- readTcRef new_tcv_ref + ; updTcRef old_tcv_ref (new_tcvs ++) } +updTcEvBinds (EvBindsVar { ebv_tcvs = old_tcv_ref }) + (CoEvBindsVar { ebv_tcvs = new_tcv_ref }) + = do { new_tcvs <- readTcRef new_tcv_ref + ; updTcRef old_tcv_ref (new_tcvs ++) } +updTcEvBinds (CoEvBindsVar { ebv_tcvs = old_tcv_ref }) + (CoEvBindsVar { ebv_tcvs = new_tcv_ref }) + = do { new_tcvs <- readTcRef new_tcv_ref + ; updTcRef old_tcv_ref (new_tcvs ++) } +updTcEvBinds old_var new_var + = pprPanic "updTcEvBinds" (ppr old_var $$ ppr new_var) + -- Terms inside types, no good + addTcEvBind :: EvBindsVar -> EvBind -> TcM () -- Add a binding to the TcEvBinds by side effect addTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) ev_bind - = do { traceTc "addTcEvBind" $ ppr u $$ - ppr ev_bind - ; bnds <- readTcRef ev_ref - ; writeTcRef ev_ref (extendEvBinds bnds ev_bind) } + = do { bnds <- readTcRef ev_ref + ; let bnds' = extendEvBinds bnds ev_bind + ; traceTc "addTcEvBind" $ + vcat [ text "EvBindsVar:" <+> ppr u + , text "ev_bind:" <+> ppr ev_bind + , text "bnds:" <+> ppr bnds + , text "bnds':" <+> ppr bnds' ] + ; writeTcRef ev_ref bnds' } addTcEvBind (CoEvBindsVar { ebv_uniq = u }) ev_bind = pprPanic "addTcEvBind CoEvBindsVar" (ppr ev_bind $$ ppr u) +addTcEvBinds :: EvBindsVar -> EvBindMap -> TcM () +-- ^ Add a collection of binding to the TcEvBinds by side effect +addTcEvBinds _ new_ev_binds + | isEmptyEvBindMap new_ev_binds + = return () +addTcEvBinds (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) new_ev_binds + = do { traceTc "addTcEvBinds" $ ppr u $$ + ppr new_ev_binds + ; old_bnds <- readTcRef ev_ref + ; writeTcRef ev_ref (old_bnds `unionEvBindMap` new_ev_binds) } +addTcEvBinds (CoEvBindsVar { ebv_uniq = u }) new_ev_binds + = pprPanic "addTcEvBinds CoEvBindsVar" (ppr new_ev_binds $$ ppr u) + chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName chooseUniqueOccTc fn = do { env <- getGblEnv @@ -1868,6 +1941,15 @@ ; lie_var <- getConstraintVar ; updTcRef lie_var (`addNotConcreteError` err) } +-- See Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify. +ensureReflMultiplicityCo :: TcCoercion -> CtOrigin -> TcM () +ensureReflMultiplicityCo mult_co origin + = do { traceTc "ensureReflMultiplicityCo" (ppr mult_co) + ; unless (isReflCo mult_co) $ do + { loc <- getCtLocM origin Nothing + ; lie_var <- getConstraintVar + ; updTcRef lie_var (\w -> addMultiplicityCoercionError w mult_co loc) } } + -- | Throw out any constraints emitted by the thing_inside discardConstraints :: TcM a -> TcM a discardConstraints thing_inside = fst <$> captureConstraints thing_inside @@ -2009,30 +2091,53 @@ emitted some constraints with skolem-escape problems. * If we discard too /few/ constraints, we may get the misleading - class constraints mentioned above. But we may /also/ end up taking - constraints built at some inner level, and emitting them at some - outer level, and then breaking the TcLevel invariants - See Note [TcLevel invariants] in GHC.Tc.Utils.TcType + class constraints mentioned above. -So dropMisleading has a horridly ad-hoc structure. It keeps only -/insoluble/ flat constraints (which are unlikely to very visibly trip -up on the TcLevel invariant, but all /implication/ constraints (except -the class constraints inside them). The implication constraints are -OK because they set the ambient level before attempting to solve any -inner constraints. Ugh! I hate this. But it seems to work. + We may /also/ end up taking constraints built at some inner level, and + emitting them (via the exception catching in `tryCaptureConstraints` at some + outer level, and then breaking the TcLevel invariants See Note [TcLevel + invariants] in GHC.Tc.Utils.TcType -However note that freshly-generated constraints like (Int ~ Bool), or -((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as -insoluble. The constraint solver does that. So they'll be discarded. -That's probably ok; but see th/5358 as a not-so-good example: - t1 :: Int - t1 x = x -- Manifestly wrong +So `dropMisleading` has a horridly ad-hoc structure: - foo = $(...raises exception...) -We report the exception, but not the bug in t1. Oh well. Possible -solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints. +* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly + trip up on the TcLevel invariant +* But it keeps all /implication/ constraints (except the class constraints + inside them). The implication constraints are OK because they set the ambient + level before attempting to solve any inner constraints. +Ugh! I hate this. But it seems to work. + +Other wrinkles + +(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or + ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as + insoluble. The constraint solver does that. So they'll be discarded. + That's probably ok; but see th/5358 as a not-so-good example: + t1 :: Int + t1 x = x -- Manifestly wrong + + foo = $(...raises exception...) + We report the exception, but not the bug in t1. Oh well. Possible + solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints. + +(CERR2) In #26015 I found that from the constraints + [W] alpha ~ Int -- A class constraint + [W] F alpha ~# Bool -- An equality constraint + we were dropping the first (becuase it's a class constraint) but not the + second, and then getting a misleading error message from the second. As + #25607 shows, we can get not just one but a zillion bogus messages, which + conceal the one genuine error. Boo. + + For now I have added an even more ad-hoc "drop class constraints except + equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can + down the road; but this problem seems somewhat rare anyway. The code in + `dropMisleading` hasn't changed for years. + +It would be great to have a more systematic solution to this entire mess. + + ************************************************************************ * * Template Haskell context @@ -2043,9 +2148,6 @@ recordThUse :: TcM () recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True } -recordThSpliceUse :: TcM () -recordThSpliceUse = do { env <- getGblEnv; writeTcRef (tcg_th_splice_used env) True } - recordThNeededRuntimeDeps :: [Linkable] -> PkgsLoaded -> TcM () recordThNeededRuntimeDeps new_links new_pkgs = do { env <- getGblEnv @@ -2061,19 +2163,39 @@ ; traceRn "keep alive" (ppr name) ; updTcRef (tcg_keep env) (`extendNameSet` name) } -getStage :: TcM ThStage -getStage = do { env <- getLclEnv; return (getLclEnvThStage env) } +getThLevel :: TcM ThLevel +getThLevel = do { env <- getLclEnv; return (getLclEnvThLevel env) } -getStageAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, ThLevel, ThStage)) -getStageAndBindLevel name +getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel)) +getCurrentAndBindLevel name = do { env <- getLclEnv; ; case lookupNameEnv (getLclEnvThBndrs env) name of - Nothing -> return Nothing - Just (top_lvl, bind_lvl) -> return (Just (top_lvl, bind_lvl, getLclEnvThStage env)) } + Nothing -> do + lvls <- getExternalBindLvl name + if Set.empty == lvls + -- This case happens when code is generated for identifiers which are not + -- in scope. + -- + -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||] + then do + return Nothing + else return (Just (TopLevel, lvls, getLclEnvThLevel env)) + Just (top_lvl, bind_lvl) -> return (Just (top_lvl, Set.singleton bind_lvl, getLclEnvThLevel env)) } -setStage :: ThStage -> TcM a -> TcRn a -setStage s = updLclEnv (setLclEnvThStage s) +getExternalBindLvl :: Name -> TcRn (Set.Set ThLevelIndex) +getExternalBindLvl name = do + env <- getGlobalRdrEnv + mod <- getModule + case lookupGRE_Name env name of + Just gre -> return $ (Set.map thLevelIndexFromImportLevel (greLevels gre)) + Nothing -> + if nameIsLocalOrFrom mod name + then return $ Set.singleton topLevelIndex + else return Set.empty +setThLevel :: ThLevel -> TcM a -> TcRn a +setThLevel l = updLclEnv (setLclEnvThLevel l) + -- | Adds the given modFinalizers to the global environment and set them to use -- the current local environment. addModFinalizersWithLclEnv :: ThModFinalizers -> TcM () @@ -2326,13 +2448,14 @@ getCompleteMatchesTcM :: TcM CompleteMatches getCompleteMatchesTcM = do { hsc_env <- getTopEnv - ; tcg_env <- getGblEnv ; eps <- liftIO $ hscEPS hsc_env - ; return $ localAndImportedCompleteMatches (tcg_complete_matches tcg_env) hsc_env eps + ; tcg_env <- getGblEnv + ; let tcg_comps = tcg_complete_match_env tcg_env + ; liftIO $ localAndImportedCompleteMatches tcg_comps eps } -localAndImportedCompleteMatches :: CompleteMatches -> HscEnv -> ExternalPackageState -> CompleteMatches -localAndImportedCompleteMatches tcg_comps hsc_env eps = - tcg_comps -- from the current module - ++ hptCompleteSigs hsc_env -- from the home package - ++ eps_complete_matches eps -- from imports +localAndImportedCompleteMatches :: CompleteMatches -> ExternalPackageState -> IO CompleteMatches +localAndImportedCompleteMatches tcg_comps eps = do + return $ + tcg_comps -- from the current modulea and from the home package + ++ eps_complete_matches eps -- from external packages diff --git a/GHC/Tc/Utils/TcMType.hs b/GHC/Tc/Utils/TcMType.hs --- a/GHC/Tc/Utils/TcMType.hs +++ b/GHC/Tc/Utils/TcMType.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecursiveDo #-} -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecursiveDo #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {- @@ -41,14 +42,13 @@ -- Creating new evidence variables newEvVar, newEvVars, newDict, newWantedWithLoc, newWanted, newWanteds, cloneWanted, cloneWC, cloneWantedCtEv, - emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEvVars, + emitWanted, emitWantedEq, emitWantedEvVar, emitWantedEqs, newTcEvBinds, newNoTcEvBinds, addTcEvBind, emitNewExprHole, - newCoercionHole, newCoercionHoleO, newVanillaCoercionHole, + newCoercionHole, fillCoercionHole, isFilledCoercionHole, - unpackCoercionHole, unpackCoercionHole_maybe, checkCoercionHole, newImplication, @@ -65,7 +65,7 @@ -- Expected types ExpType(..), ExpSigmaType, ExpRhoType, mkCheckExpType, newInferExpType, newInferExpTypeFRR, - tcInfer, tcInferFRR, + runInfer, runInferRho, runInferSigma, runInferKind, runInferRhoFRR, runInferSigmaFRR, readExpType, readExpType_maybe, readScaledExpType, expTypeToType, scaledExpTypeToType, checkingExpType_maybe, checkingExpType, @@ -78,13 +78,12 @@ --------------------------------- -- Promotion, defaulting, skolemisation defaultTyVar, promoteMetaTyVarTo, promoteTyVarSet, - quantifyTyVars, isQuantifiableTv, + quantifyTyVars, doNotQuantifyTyVars, zonkAndSkolemise, skolemiseQuantifiedTyVar, - doNotQuantifyTyVars, candidateQTyVarsOfType, candidateQTyVarsOfKind, candidateQTyVarsOfTypes, candidateQTyVarsOfKinds, - candidateQTyVarsWithBinders, + candidateQTyVarsWithBinders, weedOutCandidates, CandidatesQTvs(..), delCandidates, candidateKindVars, partitionCandidates, @@ -111,11 +110,10 @@ import GHC.Tc.Types.Origin import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence -import GHC.Tc.Types.CtLoc( CtLoc, ctLocOrigin ) +import GHC.Tc.Types.CtLoc( CtLoc ) import GHC.Tc.Utils.Monad -- TcType, amongst others import GHC.Tc.Utils.TcType import GHC.Tc.Errors.Types -import GHC.Tc.Zonk.Type import GHC.Tc.Zonk.TcType import GHC.Builtin.Names @@ -124,6 +122,7 @@ import GHC.Core.DataCon import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr +import GHC.Core.TyCo.Tidy import GHC.Core.Type import GHC.Core.TyCon import GHC.Core.Coercion @@ -201,12 +200,13 @@ newWantedWithLoc :: CtLoc -> PredType -> TcM CtEvidence newWantedWithLoc loc pty = do dst <- case classifyPredType pty of - EqPred {} -> HoleDest <$> newCoercionHole loc pty + EqPred {} -> HoleDest <$> newCoercionHole pty _ -> EvVarDest <$> newEvVar pty - return $ CtWanted { ctev_dest = dst - , ctev_pred = pty - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } + return $ CtWanted $ + WantedCt { ctev_dest = dst + , ctev_pred = pty + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet } -- | Create a new Wanted constraint with the given 'CtOrigin', and -- location information taken from the 'TcM' environment. @@ -226,10 +226,10 @@ ---------------------------------------------- cloneWantedCtEv :: CtEvidence -> TcM CtEvidence -cloneWantedCtEv ctev@(CtWanted { ctev_pred = pty, ctev_dest = HoleDest _, ctev_loc = loc }) - | isEqPrimPred pty - = do { co_hole <- newCoercionHole loc pty - ; return (ctev { ctev_dest = HoleDest co_hole }) } +cloneWantedCtEv (CtWanted ctev@(WantedCt { ctev_pred = pty, ctev_dest = HoleDest _ })) + | isEqPred pty + = do { co_hole <- newCoercionHole pty + ; return $ CtWanted (ctev { ctev_dest = HoleDest co_hole }) } | otherwise = pprPanic "cloneWantedCtEv" (ppr pty) cloneWantedCtEv ctev = return ctev @@ -276,16 +276,16 @@ -- | Emits a new equality constraint emitWantedEq :: CtOrigin -> TypeOrKind -> Role -> TcType -> TcType -> TcM Coercion emitWantedEq origin t_or_k role ty1 ty2 - = do { hole <- newCoercionHoleO origin pty + = do { hole <- newCoercionHole pty ; loc <- getCtLocM origin (Just t_or_k) - ; emitSimple $ mkNonCanonical $ - CtWanted { ctev_pred = pty - , ctev_dest = HoleDest hole - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } + ; emitSimple $ mkNonCanonical $ CtWanted $ + WantedCt { ctev_pred = pty + , ctev_dest = HoleDest hole + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet } ; return (HoleCo hole) } where - pty = mkPrimEqPredRole role ty1 ty2 + pty = mkEqPredRole role ty1 ty2 -- | Creates a new EvVar and immediately emits it as a Wanted. -- No equality predicates here. @@ -293,16 +293,13 @@ emitWantedEvVar origin ty = do { new_cv <- newEvVar ty ; loc <- getCtLocM origin Nothing - ; let ctev = CtWanted { ctev_pred = ty + ; let ctev = WantedCt { ctev_pred = ty , ctev_dest = EvVarDest new_cv , ctev_loc = loc , ctev_rewriters = emptyRewriterSet } - ; emitSimple $ mkNonCanonical ctev + ; emitSimple $ mkNonCanonical $ CtWanted ctev ; return new_cv } -emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar] -emitWantedEvVars orig = mapM (emitWantedEvVar orig) - -- | Emit a new wanted expression hole emitNewExprHole :: RdrName -- of the hole -> Type -> TcM HoleExprRef @@ -358,23 +355,13 @@ ************************************************************************ -} -newVanillaCoercionHole :: TcPredType -> TcM CoercionHole -newVanillaCoercionHole = new_coercion_hole False - -newCoercionHole :: CtLoc -> TcPredType -> TcM CoercionHole -newCoercionHole loc = newCoercionHoleO (ctLocOrigin loc) - -newCoercionHoleO :: CtOrigin -> TcPredType -> TcM CoercionHole -newCoercionHoleO (KindEqOrigin {}) pty = new_coercion_hole True pty -newCoercionHoleO _ pty = new_coercion_hole False pty - -new_coercion_hole :: Bool -> TcPredType -> TcM CoercionHole -new_coercion_hole hetero_kind pred_ty +newCoercionHole :: TcPredType -> TcM CoercionHole +-- For the Bool, see (EIK2) in Note [Equalities with heterogeneous kinds] +newCoercionHole pred_ty = do { co_var <- newEvVar pred_ty ; traceTc "New coercion hole:" (ppr co_var <+> dcolon <+> ppr pred_ty) ; ref <- newMutVar Nothing - ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref - , ch_hetero_kind = hetero_kind } } + ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } } -- | Put a value in a coercion hole fillCoercionHole :: CoercionHole -> Coercion -> TcM () @@ -451,30 +438,29 @@ -- actual data definition is in GHC.Tc.Utils.TcType -newInferExpType :: TcM ExpType -newInferExpType = new_inferExpType Nothing +newInferExpType :: InferInstFlag -> TcM ExpType +newInferExpType iif = new_inferExpType iif IFRR_Any -newInferExpTypeFRR :: FixedRuntimeRepContext -> TcM ExpTypeFRR -newInferExpTypeFRR frr_orig - = do { th_stage <- getStage - ; if - -- See [Wrinkle: Typed Template Haskell] - -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. - | Brack _ (TcPending {}) <- th_stage - -> new_inferExpType Nothing +newInferExpTypeFRR :: InferInstFlag -> FixedRuntimeRepContext -> TcM ExpTypeFRR +newInferExpTypeFRR iif frr_orig + = do { th_lvl <- getThLevel + ; let mb_frr = case th_lvl of + TypedBrack {} -> IFRR_Any + _ -> IFRR_Check frr_orig + -- mb_frr: see [Wrinkle: Typed Template Haskell] + -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. - | otherwise - -> new_inferExpType (Just frr_orig) } + ; new_inferExpType iif mb_frr } -new_inferExpType :: Maybe FixedRuntimeRepContext -> TcM ExpType -new_inferExpType mb_frr_orig +new_inferExpType :: InferInstFlag -> InferFRRFlag -> TcM ExpType +new_inferExpType iif ifrr = do { u <- newUnique ; tclvl <- getTcLevel ; traceTc "newInferExpType" (ppr u <+> ppr tclvl) ; ref <- newMutVar Nothing ; return (Infer (IR { ir_uniq = u, ir_lvl = tclvl - , ir_ref = ref - , ir_frr = mb_frr_orig })) } + , ir_inst = iif, ir_frr = ifrr + , ir_ref = ref })) } -- | Extract a type out of an ExpType, if one exists. But one should always -- exist. Unless you're quite sure you know what you're doing. @@ -528,12 +514,12 @@ where -- See Note [TcLevel of ExpType] new_meta = case mb_frr of - Nothing -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy + IFRR_Any -> do { rr <- newMetaTyVarTyAtLevel tc_lvl runtimeRepTy ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) } - Just frr -> mdo { rr <- newConcreteTyVarTyAtLevel conc_orig tc_lvl runtimeRepTy - ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) - ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr - ; return tau } + IFRR_Check frr -> mdo { rr <- newConcreteTyVarTyAtLevel conc_orig tc_lvl runtimeRepTy + ; tau <- newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) + ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr + ; return tau } {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -550,20 +536,31 @@ -- | Infer a type using a fresh ExpType -- See also Note [ExpType] in "GHC.Tc.Utils.TcMType" -- --- Use 'tcInferFRR' if you require the type to have a fixed +-- Use 'runInferFRR' if you require the type to have a fixed -- runtime representation. -tcInfer :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) -tcInfer = tc_infer Nothing +runInferSigma :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) +runInferSigma = runInfer IIF_Sigma IFRR_Any --- | Like 'tcInfer', except it ensures that the resulting type +runInferRho :: (ExpRhoType -> TcM a) -> TcM (a, TcRhoType) +runInferRho = runInfer IIF_DeepRho IFRR_Any + +runInferKind :: (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) +-- Used for kind-checking types, where we never want deep instantiation, +-- nor FRR checks +runInferKind = runInfer IIF_Sigma IFRR_Any + +-- | Like 'runInferRho', except it ensures that the resulting type -- has a syntactically fixed RuntimeRep as per Note [Fixed RuntimeRep] in -- GHC.Tc.Utils.Concrete. -tcInferFRR :: FixedRuntimeRepContext -> (ExpSigmaTypeFRR -> TcM a) -> TcM (a, TcSigmaTypeFRR) -tcInferFRR frr_orig = tc_infer (Just frr_orig) +runInferRhoFRR :: FixedRuntimeRepContext -> (ExpRhoTypeFRR -> TcM a) -> TcM (a, TcRhoTypeFRR) +runInferRhoFRR frr_orig = runInfer IIF_DeepRho (IFRR_Check frr_orig) -tc_infer :: Maybe FixedRuntimeRepContext -> (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) -tc_infer mb_frr tc_check - = do { res_ty <- new_inferExpType mb_frr +runInferSigmaFRR :: FixedRuntimeRepContext -> (ExpSigmaTypeFRR -> TcM a) -> TcM (a, TcSigmaTypeFRR) +runInferSigmaFRR frr_orig = runInfer IIF_Sigma (IFRR_Check frr_orig) + +runInfer :: InferInstFlag -> InferFRRFlag -> (ExpSigmaType -> TcM a) -> TcM (a, TcSigmaType) +runInfer iif mb_frr tc_check + = do { res_ty <- new_inferExpType iif mb_frr ; result <- tc_check res_ty ; res_ty <- readExpType res_ty ; return (result, res_ty) } @@ -756,7 +753,7 @@ = do { name <- newMetaTyVarName tyvar_name ; details <- newMetaDetails meta_info ; let tyvar = mkTcTyVar name kind details - ; traceTc "newAnonMetaTyVar" (ppr tyvar) + ; traceTc "newAnonMetaTyVar" (ppr tyvar <+> dcolon <+> ppr kind) ; return tyvar } -- makes a new skolem tv @@ -798,11 +795,11 @@ -> FastString -> TcKind -> TcM TcTyVar newConcreteTyVar reason fs kind = assertPpr (isConcreteType kind) assert_msg $ - do { th_stage <- getStage + do { th_lvl <- getThLevel ; if -- See [Wrinkle: Typed Template Haskell] -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. - | Brack _ (TcPending {}) <- th_stage + | TypedBrack _ <- th_lvl -> newNamedAnonMetaTyVar fs TauTv kind | otherwise @@ -831,8 +828,8 @@ ; traceTc "cloneAnonMetaTyVar" (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)) ; return tyvar } --- Make a new CycleBreakerTv. See Note [Type equality cycles] --- in GHC.Tc.Solver.Equality +-- | Make a new cycle-breaker type variable. See Note [Type equality cycles] +-- in GHC.Tc.Solver.Equality. newCycleBreakerTyVar :: TcKind -> TcM TcTyVar newCycleBreakerTyVar kind = do { details <- newMetaDetails CycleBreakerTv @@ -984,9 +981,9 @@ -- in GHC.Tc.Utils.Concrete. newOpenFlexiFRRTyVar :: FixedRuntimeRepContext -> TcM TcTyVar newOpenFlexiFRRTyVar frr_ctxt - = do { th_stage <- getStage - ; case th_stage of - { Brack _ (TcPending {}) -- See [Wrinkle: Typed Template Haskell] + = do { th_lvl <- getThLevel + ; case th_lvl of + { TypedBrack _ -- See [Wrinkle: Typed Template Haskell] -> newOpenFlexiTyVar -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. ; _ -> mdo { let conc_orig = ConcreteFRR $ @@ -1038,11 +1035,11 @@ -- | Like 'newMetaTyVarX', but for concrete type variables. newConcreteTyVarX :: ConcreteTvOrigin -> Subst -> TyVar -> TcM (Subst, TcTyVar) newConcreteTyVarX conc subst tv - = do { th_stage <- getStage + = do { th_lvl <- getThLevel ; if -- See [Wrinkle: Typed Template Haskell] -- in Note [hasFixedRuntimeRep] in GHC.Tc.Utils.Concrete. - | Brack _ (TcPending {}) <- th_stage + | TypedBrack _ <- th_lvl -> new_meta_tv_x TauTv subst tv | otherwise -> new_meta_tv_x (ConcreteTv conc) subst tv } @@ -1343,6 +1340,10 @@ , text "dv_tvs =" <+> ppr tvs , text "dv_cvs =" <+> ppr cvs ]) +weedOutCandidates :: (DTyVarSet -> DTyVarSet) -> CandidatesQTvs -> CandidatesQTvs +weedOutCandidates weed_out dv@(DV { dv_kvs = kvs, dv_tvs = tvs }) + = dv { dv_kvs = weed_out kvs, dv_tvs = weed_out tvs } + isEmptyCandidates :: CandidatesQTvs -> Bool isEmptyCandidates (DV { dv_kvs = kvs, dv_tvs = tvs }) = isEmptyDVarSet kvs && isEmptyDVarSet tvs @@ -1577,7 +1578,7 @@ go_co dv (SubCo co) = go_co dv co go_co dv (HoleCo hole) - = do m_co <- unpackCoercionHole_maybe hole + = do m_co <- liftZonkM (unpackCoercionHole_maybe hole) case m_co of Just co -> go_co dv co Nothing -> go_cv dv (coHoleCoVar hole) @@ -1788,15 +1789,6 @@ | otherwise = Just <$> skolemiseQuantifiedTyVar skol_info tkv -isQuantifiableTv :: TcLevel -- Level of the context, outside the quantification - -> TcTyVar - -> Bool -isQuantifiableTv outer_tclvl tcv - | isTcTyVar tcv -- Might be a CoVar; change this when gather covars separately - = tcTyVarLevel tcv `strictlyDeeperThan` outer_tclvl - | otherwise - = False - zonkAndSkolemise :: SkolemInfo -> TcTyCoVar -> ZonkM TcTyCoVar -- A tyvar binder is never a unification variable (TauTv), -- rather it is always a skolem. It *might* be a TyVarTv. @@ -2269,27 +2261,24 @@ -- | @tcCheckUsage name mult thing_inside@ runs @thing_inside@, checks that the -- usage of @name@ is a submultiplicity of @mult@, and removes @name@ from the --- usage environment. See also Note [Coercions returned from tcSubMult] in --- GHC.Tc.Utils.Unify, which applies to the wrapper returned from this function. -tcCheckUsage :: Name -> Mult -> TcM a -> TcM (a, HsWrapper) +-- usage environment. +tcCheckUsage :: Name -> Mult -> TcM a -> TcM a tcCheckUsage name id_mult thing_inside = do { (local_usage, result) <- tcCollectingUsage thing_inside - ; wrapper <- check_then_add_usage local_usage - ; return (result, wrapper) } + ; check_usage (lookupUE local_usage name) + ; tcEmitBindingUsage (deleteUE local_usage name) + ; return result } where - check_then_add_usage :: UsageEnv -> TcM HsWrapper + check_usage :: Usage -> TcM () -- Checks that the usage of the newly introduced binder is compatible with - -- its multiplicity, and combines the usage of non-new binders to |uenv| - check_then_add_usage uenv - = do { let actual_u = lookupUE uenv name - ; traceTc "check_then_add_usage" (ppr id_mult $$ ppr actual_u) - ; wrapper <- case actual_u of - Bottom -> return idHsWrapper + -- its multiplicity. + check_usage actual_u + = do { traceTc "check_usage" (ppr id_mult $$ ppr actual_u) + ; case actual_u of + Bottom -> return () Zero -> tcSubMult (UsageEnvironmentOf name) ManyTy id_mult MUsage m -> do { m <- promote_mult m - ; tcSubMult (UsageEnvironmentOf name) m id_mult } - ; tcEmitBindingUsage (deleteUE uenv name) - ; return wrapper } + ; tcSubMult (UsageEnvironmentOf name) m id_mult } } -- This is gross. The problem is in test case typecheck/should_compile/T18998: -- f :: a %1-> Id n a -> Id n a @@ -2371,7 +2360,7 @@ | isWordTy res_ty && platformInWordRange platform i = Just (mkLit wordDataCon (HsWordPrim src i)) | isIntegerTy res_ty - = Just (HsLit noExtField (HsInteger src i res_ty)) + = Just (HsLit noExtField (XLit $ HsInteger src i res_ty)) | otherwise = go_fractional (integralFractionalLit neg i) -- The 'otherwise' case is important @@ -2417,7 +2406,7 @@ -- invariant (WantedInv) in Note [TcLevel invariants] in GHC.Tc.Utils.TcType -- Return True <=> we did some promotion -- Also returns either the original tyvar (no promotion) or the new one --- See Note [Promoting unification variables] +-- See Note [Promote monomorphic tyvars] in GHC.Tc.Solver promoteMetaTyVarTo tclvl tv | assertPpr (isMetaTyVar tv) (ppr tv) $ tcTyVarLevel tv `strictlyDeeperThan` tclvl @@ -2462,14 +2451,11 @@ unless (typeHasFixedRuntimeRep ty) (addDetailedDiagnostic $ TcRnTypeDoesNotHaveFixedRuntimeRep ty prov) -{- -%************************************************************************ -%* * +{- ********************************************************************** +* * Error messages * * -************************************************************************* - --} +********************************************************************** -} -- See Note [Naughty quantification candidates] naughtyQuantification :: TcType -- original type user wanted to quantify diff --git a/GHC/Tc/Utils/TcMType.hs-boot b/GHC/Tc/Utils/TcMType.hs-boot --- a/GHC/Tc/Utils/TcMType.hs-boot +++ b/GHC/Tc/Utils/TcMType.hs-boot @@ -3,6 +3,5 @@ import GHC.Tc.Types import GHC.Types.Name import GHC.Core.TyCo.Rep -import GHC.Tc.Types.Evidence -tcCheckUsage :: Name -> Mult -> TcM a -> TcM (a, HsWrapper) +tcCheckUsage :: Name -> Mult -> TcM a -> TcM a diff --git a/GHC/Tc/Utils/TcType.hs b/GHC/Tc/Utils/TcType.hs --- a/GHC/Tc/Utils/TcType.hs +++ b/GHC/Tc/Utils/TcType.hs @@ -24,14 +24,14 @@ -------------------------------- -- Types TcType, TcSigmaType, TcTypeFRR, TcSigmaTypeFRR, - TcRhoType, TcTauType, TcPredType, TcThetaType, + TcRhoType, TcRhoTypeFRR, TcTauType, TcPredType, TcThetaType, TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet, TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder, TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied, - ExpType(..), ExpKind, InferResult(..), + ExpType(..), ExpKind, InferResult(..), InferInstFlag(..), InferFRRFlag(..), ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR, - ExpRhoType, + ExpRhoType, ExpRhoTypeFRR, mkCheckExpType, checkingExpType_maybe, checkingExpType, @@ -53,7 +53,7 @@ isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy, isTyVarTy, tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar, isTyConableTyVar, ConcreteTvOrigin(..), isConcreteTyVar_maybe, isConcreteTyVar, - isConcreteTyVarTy, isConcreteTyVarTy_maybe, isConcreteInfo, + isConcreteTyVarTy, isConcreteTyVarTy_maybe, concreteInfo_maybe, ConcreteTyVars, noConcreteTyVars, isAmbiguousTyVar, isCycleBreakerTyVar, metaTyVarRef, metaTyVarInfo, isFlexi, isIndirect, isRuntimeUnkSkol, @@ -88,9 +88,9 @@ isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingPrimTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, + isBoolTy, isUnitTy, isAnyTy, isZonkAnyTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, - isPredTy, isTyVarClassPred, + isPredTy, isSimplePredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, isRigidTy, anyTy_maybe, @@ -130,7 +130,7 @@ pSizeZero, pSizeOne, pSizeType, pSizeTypeX, pSizeTypes, pSizeClassPred, pSizeClassPredX, - pSizeTyConApp, + pSizeTyConApp, pSizeHead, noMoreTyVars, allDistinctTyVars, TypeSize, sizeType, sizeTypes, scopedSort, isTerminatingClass, isStuckTypeFamily, @@ -155,7 +155,7 @@ mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPLikePred, isEqPred, + isClassPred, isEqPred, couldBeIPLike, isEqClassPred, isEqualityClass, mkClassPred, tcSplitQuantPredTy, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isFixedRuntimeRepKind, @@ -166,7 +166,7 @@ TvSubstEnv, emptySubst, mkEmptySubst, zipTvSubst, mkTvSubstPrs, notElemSubst, unionSubst, - getTvSubstEnv, getSubstInScope, extendSubstInScope, + getTvSubstEnv, substInScopeSet, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, extendTvSubstAndInScope, Type.lookupTyVar, Type.extendTCvSubst, Type.substTyVarBndr, Type.extendTvSubst, @@ -380,6 +380,7 @@ -- See Note [Return arguments with a fixed RuntimeRep. type TcSigmaTypeFRR = TcSigmaType -- TODO: consider making this a newtype. +type TcRhoTypeFRR = TcRhoType type TcRhoType = TcType -- Note [TcRhoType] type TcTauType = TcType @@ -408,9 +409,13 @@ , ir_lvl :: TcLevel -- ^ See Note [TcLevel of ExpType] in GHC.Tc.Utils.TcMType - , ir_frr :: Maybe FixedRuntimeRepContext + , ir_frr :: InferFRRFlag -- ^ See Note [FixedRuntimeRep context in ExpType] in GHC.Tc.Utils.TcMType + , ir_inst :: InferInstFlag + -- ^ True <=> when DeepSubsumption is on, deeply instantiate before filling, + -- See Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify + , ir_ref :: IORef (Maybe TcType) } -- ^ The type that fills in this hole should be a @Type@, -- that is, its kind should be @TYPE rr@ for some @rr :: RuntimeRep@. @@ -419,26 +424,48 @@ -- @rr@ must be concrete, in the sense of Note [Concrete types] -- in GHC.Tc.Utils.Concrete. -type ExpSigmaType = ExpType +data InferFRRFlag + = IFRR_Check -- Check that the result type has a fixed runtime rep + FixedRuntimeRepContext -- Typically used for function arguments and lambdas + | IFRR_Any -- No need to check for fixed runtime-rep + +data InferInstFlag -- Specifies whether the inference should return an uninstantiated + -- SigmaType, or a (possibly deeply) instantiated RhoType + -- See Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify + + = IIF_Sigma -- Trying to infer a SigmaType + -- Don't instantiate at all, regardless of DeepSubsumption + -- Typically used when inferring the type of a pattern + + | IIF_ShallowRho -- Trying to infer a shallow RhoType (no foralls or => at the top) + -- Top-instantiate (only, regardless of DeepSubsumption) before filling the hole + -- Typically used when inferring the type of an expression + + | IIF_DeepRho -- Trying to infer a possibly-deep RhoType (depending on DeepSubsumption) + -- If DeepSubsumption is off, same as IIF_ShallowRho + -- If DeepSubsumption is on, instantiate deeply before filling the hole + +type ExpSigmaType = ExpType +type ExpRhoType = ExpType + -- Invariant: in ExpRhoType, if -XDeepSubsumption is on, + -- and we are in checking mode (i.e. the ExpRhoType is (Check rho)), + -- then the `rho` is deeply skolemised + -- | An 'ExpType' which has a fixed RuntimeRep. -- -- For a 'Check' 'ExpType', the stored 'TcType' must have -- a fixed RuntimeRep. For an 'Infer' 'ExpType', the 'ir_frr' --- field must be of the form @Just frr_orig@. -type ExpTypeFRR = ExpType +-- field must be of the form @IFRR_Check frr_orig@. +type ExpTypeFRR = ExpType -- | Like 'TcSigmaTypeFRR', but for an expected type. -- -- See 'ExpTypeFRR'. type ExpSigmaTypeFRR = ExpTypeFRR +type ExpRhoTypeFRR = ExpTypeFRR -- TODO: consider making this a newtype. -type ExpRhoType = ExpType - -- Invariant: if -XDeepSubsumption is on, - -- and we are checking (i.e. the ExpRhoType is (Check rho)), - -- then the `rho` is deeply skolemised - -- | Like 'ExpType', but on kind level type ExpKind = ExpType @@ -447,12 +474,17 @@ ppr (Infer ir) = ppr ir instance Outputable InferResult where - ppr (IR { ir_uniq = u, ir_lvl = lvl, ir_frr = mb_frr }) - = text "Infer" <> mb_frr_text <> braces (ppr u <> comma <> ppr lvl) + ppr (IR { ir_uniq = u, ir_lvl = lvl, ir_frr = mb_frr, ir_inst = inst }) + = text "Infer" <> parens (pp_inst <> pp_frr) + <> braces (ppr u <> comma <> ppr lvl) where - mb_frr_text = case mb_frr of - Just _ -> text "FRR" - Nothing -> empty + pp_inst = case inst of + IIF_Sigma -> text "Sigma" + IIF_ShallowRho -> text "ShallowRho" + IIF_DeepRho -> text "DeepRho" + pp_frr = case mb_frr of + IFRR_Check {} -> text ",FRR" + IFRR_Any -> empty -- | Make an 'ExpType' suitable for checking. mkCheckExpType :: TcType -> ExpType @@ -606,7 +638,8 @@ -- how this level number is used Bool -- True <=> this skolem type variable can be overlapped -- when looking up instances - -- See Note [Binding when looking up instances] in GHC.Core.InstEnv + -- See Note [Super skolems: binding when looking up instances] + -- in GHC.Core.InstEnv | RuntimeUnk -- Stands for an as-yet-unknown type in the GHCi -- interactive context @@ -648,7 +681,7 @@ | RuntimeUnkTv -- ^ A unification variable used in the GHCi debugger. -- It /is/ allowed to unify with a polytype, unlike TauTv - | CycleBreakerTv -- Used to fix occurs-check problems in Givens + | CycleBreakerTv -- ^ Used to fix occurs-check problems in Givens -- See Note [Type equality cycles] in -- GHC.Tc.Solver.Equality @@ -1266,9 +1299,9 @@ | otherwise = Nothing -isConcreteInfo :: MetaInfo -> Bool -isConcreteInfo (ConcreteTv {}) = True -isConcreteInfo _ = False +concreteInfo_maybe :: MetaInfo -> Maybe ConcreteTvOrigin +concreteInfo_maybe (ConcreteTv conc_orig) = Just conc_orig +concreteInfo_maybe _ = Nothing -- | Is this type variable a concrete type variable, i.e. -- it is a metavariable with 'ConcreteTv' 'MetaInfo'? @@ -1653,7 +1686,7 @@ = Left n tcSplitFunTy :: Type -> (Scaled Type, Type) -tcSplitFunTy ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty) +tcSplitFunTy ty = expectJust (tcSplitFunTy_maybe ty) tcFunArgTy :: Type -> Scaled Type tcFunArgTy ty = fst (tcSplitFunTy ty) @@ -1784,11 +1817,11 @@ evVarPred :: EvVar -> PredType evVarPred var = varType var -- Historical note: I used to have an ASSERT here, - -- checking (isEvVarType (varType var)). But with something like + -- checking (isPredTy (varType var)). But with something like -- f :: c => _ -> _ -- we end up with (c :: kappa), and (kappa ~ Constraint). Until -- we solve and zonk (which there is no particular reason to do for - -- partial signatures, (isEvVarType kappa) will return False. But + -- partial signatures, (isPredTy kappa) will return False. But -- nothing is wrong. So I just removed the ASSERT. --------------------------- @@ -1818,7 +1851,7 @@ pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = couldBeIPLike pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses @@ -1875,7 +1908,7 @@ -- These can arise when dealing with partial type signatures (e.g. T14715) eq_extras pred = case classifyPredType pred of - EqPred r t1 t2 -> [mkPrimEqPredRole (eqRelRole r) t2 t1] + EqPred r t1 t2 -> [mkEqPred r t2 t1] ClassPred cls [k1,k2,t1,t2] | cls `hasKey` heqTyConKey -> [mkClassPred cls [k2, k1, t2, t1]] ClassPred cls [k,t1,t2] @@ -2005,7 +2038,7 @@ isFloatPrimTy, isDoublePrimTy, isIntegerTy, isNaturalTy, isIntTy, isWordTy, isBoolTy, - isUnitTy, isCharTy :: Type -> Bool + isUnitTy, isAnyTy, isZonkAnyTy, isCharTy :: Type -> Bool isFloatTy = is_tc floatTyConKey isDoubleTy = is_tc doubleTyConKey isFloatPrimTy = is_tc floatPrimTyConKey @@ -2016,6 +2049,8 @@ isWordTy = is_tc wordTyConKey isBoolTy = is_tc boolTyConKey isUnitTy = is_tc unitTyConKey +isAnyTy = is_tc anyTyConKey +isZonkAnyTy = is_tc zonkAnyTyConKey isCharTy = is_tc charTyConKey -- | Check whether the type is of the form @Any :: k@, @@ -2056,6 +2091,7 @@ | Just (tc,_) <- tcSplitTyConApp_maybe ty = isGenerativeTyCon tc Nominal | Just {} <- tcSplitAppTy_maybe ty = True | isForAllTy ty = True + | Just {} <- isLitTy ty = True | otherwise = False {- @@ -2360,6 +2396,13 @@ pSizeTyFamApp tc | isStuckTypeFamily tc = pSizeZero | otherwise = PS_TyFam tc + +pSizeHead :: PredType -> PatersonSize +-- Getting the size of an instance head is a bit horrible +-- because of the special treament for class predicates +pSizeHead pred = case classifyPredType pred of + ClassPred cls tys -> pSizeClassPred cls tys + _ -> pSizeType pred pSizeClassPred :: Class -> [Type] -> PatersonSize pSizeClassPred = pSizeClassPredX emptyVarSet diff --git a/GHC/Tc/Utils/Unify.hs b/GHC/Tc/Utils/Unify.hs --- a/GHC/Tc/Utils/Unify.hs +++ b/GHC/Tc/Utils/Unify.hs @@ -1,3623 +1,4764 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE RecursiveDo #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} - -{- -(c) The University of Glasgow 2006 -(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 --} - --- | Type subsumption and unification -module GHC.Tc.Utils.Unify ( - -- Full-blown subsumption - tcWrapResult, tcWrapResultO, tcWrapResultMono, - tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS, - tcSubTypeAmbiguity, tcSubMult, tcSubMult', - checkConstraints, checkTvConstraints, - buildImplicationFor, buildTvImplication, emitResidualTvConstraint, - - -- Skolemisation - DeepSubsumptionFlag(..), getDeepSubsumptionFlag, isRhoTyDS, - tcSkolemise, tcSkolemiseCompleteSig, tcSkolemiseExpectedType, - - -- Various unifications - unifyType, unifyKind, unifyInvisibleType, unifyExpectedType, - unifyExprType, unifyTypeAndEmit, promoteTcType, - swapOverTyVars, touchabilityAndShapeTest, checkTopShape, lhsPriority, - UnifyEnv(..), updUEnvLoc, setUEnvRole, - uType, - - -------------------------------- - -- Holes - tcInfer, - matchExpectedListTy, - matchExpectedTyConApp, - matchExpectedAppTy, - matchExpectedFunTys, - matchExpectedFunKind, - matchActualFunTy, matchActualFunTys, - - checkTyEqRhs, recurseIntoTyConApp, - PuResult(..), failCheckWith, okCheckRefl, mapCheck, - TyEqFlags(..), TyEqFamApp(..), AreUnifying(..), LevelCheck(..), FamAppBreaker, - famAppArgFlags, checkPromoteFreeVars, - simpleUnifyCheck, UnifyCheckCaller(..), - - fillInferResult, - ) where - -import GHC.Prelude - -import GHC.Hs - -import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep, hasFixedRuntimeRep_syntactic ) -import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Instantiate -import GHC.Tc.Utils.Monad -import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.TcType -import GHC.Tc.Types.Evidence -import GHC.Tc.Types.Constraint -import GHC.Tc.Types.CtLoc( CtLoc, mkKindEqLoc, adjustCtLoc ) -import GHC.Tc.Types.Origin -import GHC.Tc.Zonk.TcType - -import GHC.Core.Type -import GHC.Core.TyCo.Rep -import GHC.Core.TyCo.FVs( isInjectiveInType ) -import GHC.Core.TyCo.Ppr( debugPprType {- pprTyVar -} ) -import GHC.Core.TyCon -import GHC.Core.Coercion -import GHC.Core.Multiplicity -import GHC.Core.Reduction - -import qualified GHC.LanguageExtensions as LangExt - -import GHC.Builtin.Types -import GHC.Types.Name -import GHC.Types.Id( idType ) -import GHC.Types.Var as Var -import GHC.Types.Var.Set -import GHC.Types.Var.Env -import GHC.Types.Basic -import GHC.Types.Unique.Set (nonDetEltsUniqSet) - -import GHC.Utils.Error -import GHC.Utils.Misc -import GHC.Utils.Outputable as Outputable -import GHC.Utils.Panic - -import GHC.Driver.DynFlags -import GHC.Data.Bag -import GHC.Data.FastString( fsLit ) - -import Control.Monad -import Data.Monoid as DM ( Any(..) ) -import qualified Data.Semigroup as S ( (<>) ) - -{- ********************************************************************* -* * - matchActualFunTys -* * -********************************************************************* -} - --- | 'matchActualFunTy' looks for just one function arrow, --- returning an uninstantiated sigma-type. --- --- Invariant: the returned argument type has a syntactically fixed --- RuntimeRep in the sense of Note [Fixed RuntimeRep] --- in GHC.Tc.Utils.Concrete. --- --- See Note [Return arguments with a fixed RuntimeRep]. -matchActualFunTy - :: ExpectedFunTyOrigin - -- ^ See Note [Herald for matchExpectedFunTys] - -> Maybe TypedThing - -- ^ The thing with type TcSigmaType - -> (Arity, TcType) - -- ^ Total number of value args in the call, and - -- the original function type - -- (Both are used only for error messages) - -> TcRhoType - -- ^ Type to analyse: a TcRhoType - -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) --- This function takes in a type to analyse (a RhoType) and returns --- an argument type and a result type (splitting apart a function arrow). --- The returned argument type is a SigmaType with a fixed RuntimeRep; --- as explained in Note [Return arguments with a fixed RuntimeRep]. --- --- See Note [matchActualFunTy error handling] for the first three arguments - --- If (wrap, arg_ty, res_ty) = matchActualFunTy ... fun_ty --- then wrap :: fun_ty ~> (arg_ty -> res_ty) --- and NB: res_ty is an (uninstantiated) SigmaType - -matchActualFunTy herald mb_thing err_info fun_ty - = assertPpr (isRhoTy fun_ty) (ppr fun_ty) $ - go fun_ty - where - -- Does not allocate unnecessary meta variables: if the input already is - -- a function, we just take it apart. Not only is this efficient, - -- it's important for higher rank: the argument might be of form - -- (forall a. ty) -> other - -- If allocated (fresh-meta-var1 -> fresh-meta-var2) and unified, we'd - -- hide the forall inside a meta-variable - go :: TcRhoType -- The type we're processing, perhaps after - -- expanding type synonyms - -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) - go ty | Just ty' <- coreView ty = go ty' - - go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty }) - = assert (isVisibleFunArg af) $ - do { hasFixedRuntimeRep_syntactic (FRRExpectedFunTy herald 1) arg_ty - ; return (idHsWrapper, Scaled w arg_ty, res_ty) } - - go ty@(TyVarTy tv) - | isMetaTyVar tv - = do { cts <- readMetaTyVar tv - ; case cts of - Indirect ty' -> go ty' - Flexi -> defer ty } - - -- In all other cases we bale out into ordinary unification - -- However unlike the meta-tyvar case, we are sure that the - -- number of arguments doesn't match arity of the original - -- type, so we can add a bit more context to the error message - -- (cf #7869). - -- - -- It is not always an error, because specialized type may have - -- different arity, for example: - -- - -- > f1 = f2 'a' - -- > f2 :: Monad m => m Bool - -- > f2 = undefined - -- - -- But in that case we add specialized type into error context - -- anyway, because it may be useful. See also #9605. - go ty = addErrCtxtM (mk_ctxt ty) (defer ty) - - ------------ - defer fun_ty - = do { arg_ty <- new_check_arg_ty herald 1 - ; res_ty <- newOpenFlexiTyVarTy - ; let unif_fun_ty = mkScaledFunTys [arg_ty] res_ty - ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, arg_ty, res_ty) } - - ------------ - mk_ctxt :: TcType -> TidyEnv -> ZonkM (TidyEnv, SDoc) - mk_ctxt _res_ty = mkFunTysMsg herald err_info - -{- Note [matchActualFunTy error handling] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -matchActualFunTy is made much more complicated by the -desire to produce good error messages. Consider the application - f @Int x y -In GHC.Tc.Gen.Head.tcInstFun we instantiate the function type, one -argument at a time. It must instantiate any type/dictionary args, -before looking for an arrow type. - -But if it doesn't find an arrow type, it wants to generate a message -like "f is applied to two arguments but its type only has one". -To do that, it needs to know about the args that tcArgs has already -munched up -- hence passing in n_val_args_in_call and arg_tys_so_far; -and hence also the accumulating so_far arg to 'go'. - -This allows us (in mk_ctxt) to construct f's /instantiated/ type, -with just the values-arg arrows, which is what we really want -in the error message. - -Ugh! --} - --- | Like 'matchExpectedFunTys', but used when you have an "actual" type, --- for example in function application. --- --- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep --- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. --- See Note [Return arguments with a fixed RuntimeRep]. -matchActualFunTys :: ExpectedFunTyOrigin -- ^ See Note [Herald for matchExpectedFunTys] - -> CtOrigin - -> Arity - -> TcSigmaType - -> TcM (HsWrapper, [Scaled TcSigmaTypeFRR], TcRhoType) --- If matchActualFunTys n ty = (wrap, [t1,..,tn], res_ty) --- then wrap : ty ~> (t1 -> ... -> tn -> res_ty) --- and res_ty is a RhoType --- NB: the returned type is top-instantiated; it's a RhoType -matchActualFunTys herald ct_orig n_val_args_wanted top_ty - = go n_val_args_wanted [] top_ty - where - go n so_far fun_ty - | not (isRhoTy fun_ty) - = do { (wrap1, rho) <- topInstantiate ct_orig fun_ty - ; (wrap2, arg_tys, res_ty) <- go n so_far rho - ; return (wrap2 <.> wrap1, arg_tys, res_ty) } - - go 0 _ fun_ty = return (idHsWrapper, [], fun_ty) - - go n so_far fun_ty - = do { (wrap_fun1, arg_ty1, res_ty1) <- matchActualFunTy - herald Nothing - (n_val_args_wanted, top_ty) - fun_ty - ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1 - ; let wrap_fun2 = mkWpFun idHsWrapper wrap_res arg_ty1 res_ty - -- NB: arg_ty1 comes from matchActualFunTy, so it has - -- a syntactically fixed RuntimeRep as needed to call mkWpFun. - ; return (wrap_fun2 <.> wrap_fun1, arg_ty1:arg_tys, res_ty) } - -{- -************************************************************************ -* * - Skolemisation and matchExpectedFunTys -* * -************************************************************************ - -Note [Skolemisation overview] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose f :: (forall a. a->a) -> blah, and we have the application (f e) -Then we want to typecheck `e` pushing in the type `forall a. a->a`. But we -need to be careful: - -* Roughly speaking, in (tcPolyExpr e (forall a b. rho)), we skolemise `a` and `b`, - and then call (tcExpr e rho) - -* But not quite! We must be careful if `e` is a type lambda (\ @p @q -> blah). - Then we want to line up the skolemised variables `a`,`b` - with `p`,`q`, so we can't just call (tcExpr (\ @p @q -> blah) rho) - -* A very similar situation arises with - (\ @p @q -> blah) :: forall a b. rho - Again, we must line up `p`, `q` with the skolemised `a` and `b`. - -* Another similar situation arises with - g :: forall a b. rho - g @p @q x y = .... - Here again when skolemising `a` and `b` we must be careful to match them up - with `p` and `q`. - -OK, so how exactly do we check @p binders in lambdas? First note that we only -we only attempt to deal with @p binders when /checking/. We don't do inference for -(\ @a -> blah), not yet anyway. - -For checking, there are two cases to consider: - * Function LHS, where the function has a type signature - f :: forall a. a -> forall b. [b] -> blah - f @p x @q y = ... - - * Lambda \ @p x @q y -> ... - \cases { @p x @q y -> ... } - (\case p behaves like \cases { p -> ... }, and p is always a term pattern.) - -Both ultimately handled by matchExpectedFunTys. - -* Function LHS case is handled by `GHC.Tc.Gen.Bind.tcPolyCheck`: - * It calls `tcSkolemiseCompleteSig` - * Passes the skolemised variables into `tcFunBindMatches` - * Which uses `matchExpectedFunTys` to decompose the function type to - match the arguments - * And then passes the (skolemised-variables ++ arg tys) on to `tcMatches` - -* For the Lambda case there are two sub-cases: - * An expression with a type signature: (\ @a x y -> blah) :: hs_ty - This is handled by `GHC.Tc.Gen.Head.tcExprWithSig`, which kind-checks - the signature and hands off to `tcExprPolyCheck` vai `tcPolyLExprSig` - Note that the foralls at the top of hs_ty scope over the expression. - - * A higher order call: h e, where h :: poly_ty -> blah - This is handlded by `GHC.Tc.Gen.Expr.tcPolyExpr`, which (in the - checking case) again hands off to `tcExprPolyCheck`. Here there is - no type-variable scoping to worry about. - - So both sub-cases end up in `GHC.Tc.Gen.Expr.tcPolyExprCheck` - * This skolemises the /top-level/ invisible binders, but remembers - the binders as [ExpPatType] - * Then it looks for a lambda, and if so, calls `tcLambdaMatches` passing in - the skolemised binders so they can be matched up with the lambda binders. - * Otherwise it does deep-skolemisation if DeepSubsumption is on, - and then calls tcExpr to typecheck `e` - - The outer skolemisation in tcPolyExprCheck is done using - * tcSkolemiseCompleteSig when there is a user-written signature - * tcSkolemiseGeneral when the polytype just comes from the context e.g. (f e) - The former just calls the latter, so the two cases differ only slightly: - * Both do shallow skolemisation - * Both go via checkConstraints, which uses implicationNeeded to decide whether - to build an implication constraint even if there /are/ no skolems. - See Note [When to build an implication] below. - - The difference between the two cases is that `tcSkolemiseCompleteSig` - also brings the outer type variables into scope. It would do no - harm to do so in both cases, but I found that (to my surprise) doing - so caused a non-trivial (1%-ish) perf hit on the compiler. - -* `tcFunBindMatches` and `tcLambdaMatches` both use `matchExpectedFunTys`, which - ensures that any trailing invisible binders are skolemised; and does so deeply - if DeepSubsumption is on. - - This corresponds to the plan: "skolemise at the '=' of a function binding or - at the '->' of a lambda binding". (See #17594 and "Plan B2".) - -Some wrinkles - -(SK1) tcSkolemiseGeneral and tcSkolemiseCompleteSig make fresh type variables - See Note [Instantiate sig with fresh variables] - -(SK2) All skolemisation (even without DeepSubsumption) builds just one implication - constraint for a nested forall like: - forall a. Eq a => forall b. Ord b => blah - The implication constraint will look like - forall a b. (Eq a, Ord b) => - See the loop in GHC.Tc.Utils.Instantiate.topSkolemise. - and Note [Skolemisation en-bloc] in that module - - -Some examples: - -* f :: forall a b. blah - f @p x = rhs - `tcPolyCheck` calls `tcSkolemiseCompleteSig` to skolemise the signature, and - then calls `tcFunBindMatches` passing in [a_sk, b_sk], the skolemsed - variables. The latter ultimately calls `tcMatches`, and thence `tcMatchPats`. - The latter matches up the `a_sk` with `@p`, and discards the `b_sk`. - -* f :: forall (a::Type) (b::a). blah - f @(p::b) x = rhs - `tcSkolemiseCompleteSig` brings `a` and `b` into scope, bound to `a_sk` and `b_sk` resp. - When `tcMatchPats` typechecks the pattern `@(p::b)` it'll find that `b` is in - scope (as a result of tcSkolemiseCompleteSig) which is a bit strange. But - it'll then unify the kinds `Type ~ b`, which will fail as it should. - -* f :: Int -> forall (a::Type) (b::a). blah - f x @p = rhs - `matchExpectedFunTys` does shallow skolemisation eagerly, so we'll skolemise the - forall a b. Then `tcMatchPats` will bind [p :-> a_sk], and discard `b_sk`. - Discarding the `b_sk` means that - f x @p = \ @q -> blah - or f x @p = let .. in \ @q -> blah - will both be rejected: this is Plan B2: skolemise at the "=". - -* Suppose DeepSubsumption is on - f :: forall a. a -> forall b. b -> b -> forall z. z - f @p x @q y = rhs - The `tcSkolemiseCompleteSig` uses shallow skolemisation, so it only skolemises - and brings into scope [a :-> a_sk]. Then `matchExpectedFunTys` skolemises the - forall b, because it needs to expose two value arguments. Finally - `matchExpectedFunTys` concludes with deeply skolemising the remaining type. - - So we end up with `[p :-> a_sk, q :-> b_sk]`. Notice that we must not - deeply-skolemise /first/ or we'd get the tyvars [a_sk, b_sk, c_sk] which would - not line up with the patterns [@p, x, @q, y] --} - -tcSkolemiseGeneral - :: DeepSubsumptionFlag - -> UserTypeCtxt - -> TcType -> TcType -- top_ty and expected_ty - -- Here, top_ty is the type we started to skolemise; used only in SigSkol - -- - expected_ty is the type we are actually skolemising - -- matchExpectedFunTys walks down the type, skolemising as it goes, - -- keeping the same top_ty, but successively smaller expected_tys - -> ([(Name, TcInvisTVBinder)] -> TcType -> TcM result) - -> TcM (HsWrapper, result) -tcSkolemiseGeneral ds_flag ctxt top_ty expected_ty thing_inside - | isRhoTyDS ds_flag expected_ty - -- Fast path for a very very common case: no skolemisation to do - -- But still call checkConstraints in case we need an implication regardless - = do { let sig_skol = SigSkol ctxt top_ty [] - ; (ev_binds, result) <- checkConstraints sig_skol [] [] $ - thing_inside [] expected_ty - ; return (mkWpLet ev_binds, result) } - - | otherwise - = do { -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] - -- in GHC.Tc.Utils.TcType - ; rec { (wrap, tv_prs, given, rho_ty) <- case ds_flag of - Deep -> deeplySkolemise skol_info expected_ty - Shallow -> topSkolemise skol_info expected_ty - ; let sig_skol = SigSkol ctxt top_ty (map (fmap binderVar) tv_prs) - ; skol_info <- mkSkolemInfo sig_skol } - - ; let skol_tvs = map (binderVar . snd) tv_prs - ; traceTc "tcSkolemiseGeneral" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given) - ; (ev_binds, result) <- checkConstraints sig_skol skol_tvs given $ - thing_inside tv_prs rho_ty - - ; return (wrap <.> mkWpLet ev_binds, result) } - -- The ev_binds returned by checkConstraints is very - -- often empty, in which case mkWpLet is a no-op - -tcSkolemiseCompleteSig :: TcCompleteSig - -> ([ExpPatType] -> TcRhoType -> TcM result) - -> TcM (HsWrapper, result) --- ^ The wrapper has type: spec_ty ~> expected_ty --- See Note [Skolemisation] for the differences between --- tcSkolemiseCompleteSig and tcTopSkolemise - -tcSkolemiseCompleteSig (CSig { sig_bndr = poly_id, sig_ctxt = ctxt, sig_loc = loc }) - thing_inside - = do { cur_loc <- getSrcSpanM - ; let poly_ty = idType poly_id - ; setSrcSpan loc $ -- Sets the location for the implication constraint - tcSkolemiseGeneral Shallow ctxt poly_ty poly_ty $ \tv_prs rho_ty -> - setSrcSpan cur_loc $ -- Revert to the original location - tcExtendNameTyVarEnv (map (fmap binderVar) tv_prs) $ - thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty } - -tcSkolemiseExpectedType :: TcSigmaType - -> ([ExpPatType] -> TcRhoType -> TcM result) - -> TcM (HsWrapper, result) --- Just like tcSkolemiseCompleteSig, except that we don't have a user-written --- type signature, we only have a type comimg from the context. --- Eg. f :: (forall a. blah) -> blah --- In the call (f e) we will call tcSkolemiseExpectedType on (forall a.blah) --- before typececking `e` -tcSkolemiseExpectedType exp_ty thing_inside - = tcSkolemiseGeneral Shallow GenSigCtxt exp_ty exp_ty $ \tv_prs rho_ty -> - thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty - -tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType - -> (TcRhoType -> TcM result) - -> TcM (HsWrapper, result) -tcSkolemise ds_flag ctxt expected_ty thing_inside - = tcSkolemiseGeneral ds_flag ctxt expected_ty expected_ty $ \_ rho_ty -> - thing_inside rho_ty - -checkConstraints :: SkolemInfoAnon - -> [TcTyVar] -- Skolems - -> [EvVar] -- Given - -> TcM result - -> TcM (TcEvBinds, result) --- checkConstraints is careful to build an implication even if --- `skol_tvs` and `given` are both empty, under certain circumstances --- See Note [When to build an implication] -checkConstraints skol_info skol_tvs given thing_inside - = do { implication_needed <- implicationNeeded skol_info skol_tvs given - - ; if implication_needed - then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside - ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted - ; traceTc "checkConstraints" (ppr tclvl $$ ppr skol_tvs) - ; emitImplications implics - ; return (ev_binds, result) } - - else -- Fast path. We check every function argument with tcCheckPolyExpr, - -- which uses tcTopSkolemise and hence checkConstraints. - -- So this fast path is well-exercised - do { res <- thing_inside - ; return (emptyTcEvBinds, res) } } - -checkTvConstraints :: SkolemInfo - -> [TcTyVar] -- Skolem tyvars - -> TcM result - -> TcM result - -checkTvConstraints skol_info skol_tvs thing_inside - = do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside - ; emitResidualTvConstraint skol_info skol_tvs tclvl wanted - ; return result } - -emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] - -> TcLevel -> WantedConstraints -> TcM () -emitResidualTvConstraint skol_info skol_tvs tclvl wanted - | not (isEmptyWC wanted) || - checkTelescopeSkol skol_info_anon - = -- checkTelescopeSkol: in this case, /always/ emit this implication - -- even if 'wanted' is empty. We need the implication so that we check - -- for a bad telescope. See Note [Skolem escape and forall-types] in - -- GHC.Tc.Gen.HsType - do { implic <- buildTvImplication skol_info_anon skol_tvs tclvl wanted - ; emitImplication implic } - - | otherwise -- Empty 'wanted', emit nothing - = return () - where - skol_info_anon = getSkolemInfo skol_info - -buildTvImplication :: SkolemInfoAnon -> [TcTyVar] - -> TcLevel -> WantedConstraints -> TcM Implication -buildTvImplication skol_info skol_tvs tclvl wanted - = assertPpr (all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs) (ppr skol_tvs) $ - do { ev_binds <- newNoTcEvBinds -- Used for equalities only, so all the constraints - -- are solved by filling in coercion holes, not - -- by creating a value-level evidence binding - ; implic <- newImplication - - ; let implic' = implic { ic_tclvl = tclvl - , ic_skols = skol_tvs - , ic_given_eqs = NoGivenEqs - , ic_wanted = wanted - , ic_binds = ev_binds - , ic_info = skol_info } - - ; checkImplicationInvariants implic' - ; return implic' } - -implicationNeeded :: SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> TcM Bool --- See Note [When to build an implication] -implicationNeeded skol_info skol_tvs given - | null skol_tvs - , null given - , not (alwaysBuildImplication skol_info) - = -- Empty skolems and givens - do { tc_lvl <- getTcLevel - ; if not (isTopTcLevel tc_lvl) -- No implication needed if we are - then return False -- already inside an implication - else - do { dflags <- getDynFlags -- If any deferral can happen, - -- we must build an implication - ; return (gopt Opt_DeferTypeErrors dflags || - gopt Opt_DeferTypedHoles dflags || - gopt Opt_DeferOutOfScopeVariables dflags) } } - - | otherwise -- Non-empty skolems or givens - = return True -- Definitely need an implication - -alwaysBuildImplication :: SkolemInfoAnon -> Bool --- See Note [When to build an implication] -alwaysBuildImplication _ = False - -{- Commmented out for now while I figure out about error messages. - See #14185 - -alwaysBuildImplication (SigSkol ctxt _ _) - = case ctxt of - FunSigCtxt {} -> True -- RHS of a binding with a signature - _ -> False -alwaysBuildImplication (RuleSkol {}) = True -alwaysBuildImplication (InstSkol {}) = True -alwaysBuildImplication (FamInstSkol {}) = True -alwaysBuildImplication _ = False --} - -buildImplicationFor :: TcLevel -> SkolemInfoAnon -> [TcTyVar] - -> [EvVar] -> WantedConstraints - -> TcM (Bag Implication, TcEvBinds) -buildImplicationFor tclvl skol_info skol_tvs given wanted - | isEmptyWC wanted && null given - -- Optimisation : if there are no wanteds, and no givens - -- don't generate an implication at all. - -- Reason for the (null given): we don't want to lose - -- the "inaccessible alternative" error check - = return (emptyBag, emptyTcEvBinds) - - | otherwise - = assertPpr (all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs) (ppr skol_tvs) $ - -- Why allow TyVarTvs? Because implicitly declared kind variables in - -- non-CUSK type declarations are TyVarTvs, and we need to bring them - -- into scope as a skolem in an implication. This is OK, though, - -- because TyVarTvs will always remain tyvars, even after unification. - do { ev_binds_var <- newTcEvBinds - ; implic <- newImplication - ; let implic' = implic { ic_tclvl = tclvl - , ic_skols = skol_tvs - , ic_given = given - , ic_wanted = wanted - , ic_binds = ev_binds_var - , ic_info = skol_info } - ; checkImplicationInvariants implic' - - ; return (unitBag implic', TcEvBinds ev_binds_var) } - -{- Note [When to build an implication] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have some 'skolems' and some 'givens', and we are -considering whether to wrap the constraints in their scope into an -implication. We must /always/ do so if either 'skolems' or 'givens' are -non-empty. But what if both are empty? You might think we could -always drop the implication. Other things being equal, the fewer -implications the better. Less clutter and overhead. But we must -take care: - -* If we have an unsolved [W] g :: a ~# b, and -fdefer-type-errors, - we'll make a /term-level/ evidence binding for 'g = error "blah"'. - We must have an EvBindsVar those bindings!, otherwise they end up as - top-level unlifted bindings, which are verboten. This only matters - at top level, so we check for that - See also Note [Deferred errors for coercion holes] in GHC.Tc.Errors. - cf #14149 for an example of what goes wrong. - -* This is /necessary/ for top level but may be /desirable/ even for - nested bindings, because if the deferred coercion is bound too far - out it will be reported even if that thunk (say) is not evaluated. - -* If you have - f :: Int; f = f_blah - g :: Bool; g = g_blah - If we don't build an implication for f or g (no tyvars, no givens), - the constraints for f_blah and g_blah are solved together. And that - can yield /very/ confusing error messages, because we can get - [W] C Int b1 -- from f_blah - [W] C Int b2 -- from g_blan - and fundeps can yield [W] b1 ~ b2, even though the two functions have - literally nothing to do with each other. #14185 is an example. - Building an implication keeps them separate. - -Note [Herald for matchExpectedFunTys] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The 'herald' always looks like: - "The equation(s) for 'f' have" - "The abstraction (\x.e) takes" - "The section (+ x) expects" - "The function 'f' is applied to" - -This is used to construct a message of form - - The abstraction `\Just 1 -> ...' takes two arguments - but its type `Maybe a -> a' has only one - - The equation(s) for `f' have two arguments - but its type `Maybe a -> a' has only one - - The section `(f 3)' requires 'f' to take two arguments - but its type `Int -> Int' has only one - - The function 'f' is applied to two arguments - but its type `Int -> Int' has only one - -When visible type applications (e.g., `f @Int 1 2`, as in #13902) enter the -picture, we have a choice in deciding whether to count the type applications as -proper arguments: - - The function 'f' is applied to one visible type argument - and two value arguments - but its type `forall a. a -> a` has only one visible type argument - and one value argument - -Or whether to include the type applications as part of the herald itself: - - The expression 'f @Int' is applied to two arguments - but its type `Int -> Int` has only one - -The latter is easier to implement and is arguably easier to understand, so we -choose to implement that option. - -Note [matchExpectedFunTys] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -matchExpectedFunTys checks that a sigma has the form -of an n-ary function. It passes the decomposed type to the -thing_inside, and returns a wrapper to coerce between the two types - -It's used wherever a language construct must have a functional type, -namely: - A lambda expression - A function definition - An operator section - -This function must be written CPS'd because it needs to fill in the -ExpTypes produced for arguments before it can fill in the ExpType -passed in. - -Note [Return arguments with a fixed RuntimeRep] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The functions - - - matchExpectedFunTys, - - matchActualFunTy, - - matchActualFunTys, - -peel off argument types, as explained in Note [matchExpectedFunTys]. -It's important that these functions return argument types that have -a fixed runtime representation, otherwise we would be in violation -of the representation-polymorphism invariants of -Note [Representation polymorphism invariants] in GHC.Core. - -This is why all these functions have an additional invariant, -that the argument types they return all have a syntactically fixed RuntimeRep, -in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. - -Example: - - Suppose we have - - type F :: Type -> RuntimeRep - type family F a where { F Int = LiftedRep } - - type Dual :: Type -> Type - type family Dual a where - Dual a = a -> () - - f :: forall (a :: TYPE (F Int)). Dual a - f = \ x -> () - - The body of `f` is a lambda abstraction, so we must be able to split off - one argument type from its type. This is handled by `matchExpectedFunTys` - (see 'GHC.Tc.Gen.Match.tcLambdaMatches'). We end up with desugared Core that - looks like this: - - f :: forall (a :: TYPE (F Int)). Dual (a |> (TYPE F[0])) - f = \ @(a :: TYPE (F Int)) -> - (\ (x :: (a |> (TYPE F[0]))) -> ()) - `cast` - (Sub (Sym (Dual[0] <(a |> (TYPE F[0]))>))) - - Two important transformations took place: - - 1. We inserted casts around the argument type to ensure that it has - a fixed runtime representation, as required by invariant (I1) from - Note [Representation polymorphism invariants] in GHC.Core. - 2. We inserted a cast around the whole lambda to make everything line up - with the type signature. --} - --- | Use this function to split off arguments types when you have an --- \"expected\" type. --- --- This function skolemises at each polytype. --- --- Invariant: this function only applies the provided function --- to a list of argument types which all have a syntactically fixed RuntimeRep --- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. --- See Note [Return arguments with a fixed RuntimeRep]. -matchExpectedFunTys :: forall a. - ExpectedFunTyOrigin -- See Note [Herald for matchExpectedFunTys] - -> UserTypeCtxt - -> VisArity - -> ExpSigmaType - -> ([ExpPatType] -> ExpRhoType -> TcM a) - -> TcM (HsWrapper, a) --- If matchExpectedFunTys n ty = (wrap, _) --- then wrap : (t1 -> ... -> tn -> ty_r) ~> ty, --- where [t1, ..., tn], ty_r are passed to the thing_inside --- --- Unconditionally concludes by skolemising any trailing invisible --- binders and, if DeepSubsumption is on, it does so deeply. --- --- Postcondition: --- If exp_ty is Check {}, then [ExpPatType] and ExpRhoType results are all Check{} --- If exp_ty is Infer {}, then [ExpPatType] and ExpRhoType results are all Infer{} -matchExpectedFunTys herald _ arity (Infer inf_res) thing_inside - = do { arg_tys <- mapM (new_infer_arg_ty herald) [1 .. arity] - ; res_ty <- newInferExpType - ; result <- thing_inside (map ExpFunPatTy arg_tys) res_ty - ; arg_tys <- mapM (\(Scaled m t) -> Scaled m <$> readExpType t) arg_tys - ; res_ty <- readExpType res_ty - -- Remarks: - -- 1. use tcMkScaledFunTys rather than mkScaledFunTys, as we might - -- have res_ty :: kappa[tau] for a meta ty-var kappa, in which case - -- mkScaledFunTys would crash. See #26277. - -- 2. tcMkScaledFunTys arg_tys res_ty does not contain any foralls - -- (even nested ones), so no need to instantiate. - -- NOTE: we do not backport fillInferResultNoInst so this stays - -- fillInferResult on the backported patch - ; co <- fillInferResult (tcMkScaledFunTys arg_tys res_ty) inf_res - ; return (mkWpCastN co, result) } - -matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside - = check arity [] top_ty - where - check :: VisArity -> [ExpPatType] -> TcSigmaType -> TcM (HsWrapper, a) - -- `check` is called only in the Check{} case - -- It collects rev_pat_tys in reversed order - -- n_req is the number of /visible/ arguments still needed - - ---------------------------- - -- Skolemise quantifiers, both visible (up to n_req) and invisible - -- See Note [Visible type application and abstraction] in GHC.Tc.Gen.App - check n_req rev_pat_tys ty - | isSigmaTy ty -- An invisible quantifier at the top - || (n_req > 0 && isForAllTy ty) -- A visible quantifier at top, and we need it - = do { rec { (n_req', wrap_gen, tv_nms, bndrs, given, inner_ty) <- skolemiseRequired skol_info n_req ty - ; let sig_skol = SigSkol ctx top_ty (tv_nms `zip` skol_tvs) - skol_tvs = binderVars bndrs - ; skol_info <- mkSkolemInfo sig_skol } - -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] - -- in GHC.Tc.Utils.TcType - ; (ev_binds, (wrap_res, result)) - <- checkConstraints (getSkolemInfo skol_info) skol_tvs given $ - check n_req' - (reverse (map ExpForAllPatTy bndrs) ++ rev_pat_tys) - inner_ty - ; assertPpr (not (null bndrs && null given)) (ppr ty) $ - -- The guard ensures that we made some progress - return (wrap_gen <.> mkWpLet ev_binds <.> wrap_res, result) } - - ---------------------------- - -- Base case: (n_req == 0): no more args - -- The earlier skolemisation ensurs that rho_ty has no top-level invisible quantifiers - -- If there is deep subsumption, do deep skolemisation now - check n_req rev_pat_tys rho_ty - | n_req == 0 - = do { let pat_tys = reverse rev_pat_tys - ; ds_flag <- getDeepSubsumptionFlag - ; case ds_flag of - Shallow -> do { res <- thing_inside pat_tys (mkCheckExpType rho_ty) - ; return (idHsWrapper, res) } - Deep -> tcSkolemiseGeneral Deep ctx top_ty rho_ty $ \_ rho_ty -> - -- "_" drop the /deeply/-skolemise binders - -- They do not line up with binders in the Match - thing_inside pat_tys (mkCheckExpType rho_ty) } - - ---------------------------- - -- Function types - check n_req rev_pat_tys (FunTy { ft_af = af, ft_mult = mult - , ft_arg = arg_ty, ft_res = res_ty }) - = assert (isVisibleFunArg af) $ - do { let arg_pos = arity - n_req + 1 -- 1 for the first argument etc - ; (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy herald arg_pos) arg_ty - ; (wrap_res, result) <- check (n_req - 1) - (mkCheckExpFunPatTy (Scaled mult arg_ty) : rev_pat_tys) - res_ty - ; let wrap_arg = mkWpCastN arg_co - fun_wrap = mkWpFun wrap_arg wrap_res (Scaled mult arg_ty) res_ty - ; return (fun_wrap, result) } - - ---------------------------- - -- Type variables - check n_req rev_pat_tys ty@(TyVarTy tv) - | isMetaTyVar tv - = do { cts <- readMetaTyVar tv - ; case cts of - Indirect ty' -> check n_req rev_pat_tys ty' - Flexi -> defer n_req rev_pat_tys ty } - - ---------------------------- - -- NOW do coreView. We didn't do it before, so that we do not unnecessarily - -- unwrap a synonym in the returned rho_ty - check n_req rev_pat_tys ty - | Just ty' <- coreView ty = check n_req rev_pat_tys ty' - - -- In all other cases we bale out into ordinary unification - -- However unlike the meta-tyvar case, we are sure that the - -- number of arguments doesn't match arity of the original - -- type, so we can add a bit more context to the error message - -- (cf #7869). - -- - -- It is not always an error, because specialized type may have - -- different arity, for example: - -- - -- > f1 = f2 'a' - -- > f2 :: Monad m => m Bool - -- > f2 = undefined - -- - -- But in that case we add specialized type into error context - -- anyway, because it may be useful. See also #9605. - check n_req rev_pat_tys res_ty - = addErrCtxtM (mkFunTysMsg herald (arity, top_ty)) $ - defer n_req rev_pat_tys res_ty - - ------------ - defer :: VisArity -> [ExpPatType] -> TcRhoType -> TcM (HsWrapper, a) - defer n_req rev_pat_tys fun_ty - = do { more_arg_tys <- mapM (new_check_arg_ty herald) [arity - n_req + 1 .. arity] - ; let all_pats = reverse rev_pat_tys ++ map mkCheckExpFunPatTy more_arg_tys - ; res_ty <- newOpenFlexiTyVarTy - ; result <- thing_inside all_pats (mkCheckExpType res_ty) - - ; co <- unifyType Nothing (mkScaledFunTys more_arg_tys res_ty) fun_ty - ; return (mkWpCastN co, result) } - -new_infer_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled ExpSigmaTypeFRR) -new_infer_arg_ty herald arg_pos -- position for error messages only - = do { mult <- newFlexiTyVarTy multiplicityTy - ; inf_hole <- newInferExpTypeFRR (FRRExpectedFunTy herald arg_pos) - ; return (mkScaled mult inf_hole) } - -new_check_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled TcType) -new_check_arg_ty herald arg_pos -- Position for error messages only, 1 for first arg - = do { mult <- newFlexiTyVarTy multiplicityTy - ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy herald arg_pos) - ; return (mkScaled mult arg_ty) } - -mkFunTysMsg :: ExpectedFunTyOrigin - -> (VisArity, TcType) - -> TidyEnv -> ZonkM (TidyEnv, SDoc) --- See Note [Reporting application arity errors] -mkFunTysMsg herald (n_vis_args_in_call, fun_ty) env - = do { (env', fun_ty) <- zonkTidyTcType env fun_ty - - ; let (pi_ty_bndrs, _) = splitPiTys fun_ty - n_fun_args = count isVisiblePiTyBinder pi_ty_bndrs - msg | n_vis_args_in_call <= n_fun_args -- Enough args, in the end - = text "In the result of a function call" - | otherwise - = hang (full_herald <> comma) - 2 (sep [ text "but its type" <+> quotes (pprSigmaType fun_ty) - , if n_fun_args == 0 then text "has none" - else text "has only" <+> speakN n_fun_args]) - - ; return (env', msg) } - where - full_herald = pprExpectedFunTyHerald herald - <+> speakNOf n_vis_args_in_call (text "visible argument") - -- What are "visible" arguments? See Note [Visibility and arity] in GHC.Types.Basic - - -{- Note [Reporting application arity errors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider f :: Int -> Int -> Int -and the call foo = f 3 4 5 -We'd like to get an error like: - - • Couldn't match expected type ‘t0 -> t’ with actual type ‘Int’ - • The function ‘f’ is applied to three visible arguments, -- What are "visible" arguments? - but its type ‘Int -> Int -> Int’ has only two -- See Note [Visibility and arity] in GHC.Types.Basic - -That is what `mkFunTysMsg` tries to do. But what is the "type of the function". -Most obviously, we can report its full, polymorphic type; that is simple and -explicable. But sometimes a bit odd. Consider - f :: Bool -> t Int Int - foo = f True 5 10 -We get this error: - • Couldn't match type ‘Int’ with ‘t0 -> t’ - Expected: Int -> t0 -> t - Actual: Int -> Int - • The function ‘f’ is applied to three visible arguments, - but its type ‘Bool -> t Int Int’ has only one - -That's not /quite/ right beause we can instantiate `t` to an arrow and get -two arrows (but not three!). With that in mind, one could consider reporting -the /instantiated/ type, and GHC used to do so. But it's more work, and in -some ways more confusing, especially when nested quantifiers are concerned, e.g. - f :: Bool -> forall t. t Int Int - -So we just keep it simple and report the original function type. - - -************************************************************************ -* * - Other matchExpected functions -* * -********************************************************************* -} - -matchExpectedListTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType) --- Special case for lists -matchExpectedListTy exp_ty - = do { (co, [elt_ty]) <- matchExpectedTyConApp listTyCon exp_ty - ; return (co, elt_ty) } - ---------------------- -matchExpectedTyConApp :: TyCon -- T :: forall kv1 ... kvm. k1 -> ... -> kn -> * - -> TcRhoType -- orig_ty - -> TcM (TcCoercionN, -- T k1 k2 k3 a b c ~N orig_ty - [TcSigmaType]) -- Element types, k1 k2 k3 a b c - --- It's used for wired-in tycons, so we call checkWiredInTyCon --- Precondition: never called with FunTyCon --- Precondition: input type :: * --- Postcondition: (T k1 k2 k3 a b c) is well-kinded - -matchExpectedTyConApp tc orig_ty - = assertPpr (isAlgTyCon tc) (ppr tc) $ - go orig_ty - where - go ty - | Just ty' <- coreView ty - = go ty' - - go ty@(TyConApp tycon args) - | tc == tycon -- Common case - = return (mkNomReflCo ty, args) - - go (TyVarTy tv) - | isMetaTyVar tv - = do { cts <- readMetaTyVar tv - ; case cts of - Indirect ty -> go ty - Flexi -> defer } - - go _ = defer - - -- If the common case does not occur, instantiate a template - -- T k1 .. kn t1 .. tm, and unify with the original type - -- Doing it this way ensures that the types we return are - -- kind-compatible with T. For example, suppose we have - -- matchExpectedTyConApp T (f Maybe) - -- where data T a = MkT a - -- Then we don't want to instantiate T's data constructors with - -- (a::*) ~ Maybe - -- because that'll make types that are utterly ill-kinded. - -- This happened in #7368 - defer - = do { (_, arg_tvs) <- newMetaTyVars (tyConTyVars tc) - ; traceTc "matchExpectedTyConApp" (ppr tc $$ ppr (tyConTyVars tc) $$ ppr arg_tvs) - ; let args = mkTyVarTys arg_tvs - tc_template = mkTyConApp tc args - ; co <- unifyType Nothing tc_template orig_ty - ; return (co, args) } - ----------------------- -matchExpectedAppTy :: TcRhoType -- orig_ty - -> TcM (TcCoercion, -- m a ~N orig_ty - (TcSigmaType, TcSigmaType)) -- Returns m, a --- If the incoming type is a mutable type variable of kind k, then --- matchExpectedAppTy returns a new type variable (m: * -> k); note the *. - -matchExpectedAppTy orig_ty - = go orig_ty - where - go ty - | Just ty' <- coreView ty = go ty' - - | Just (fun_ty, arg_ty) <- tcSplitAppTy_maybe ty - = return (mkNomReflCo orig_ty, (fun_ty, arg_ty)) - - go (TyVarTy tv) - | isMetaTyVar tv - = do { cts <- readMetaTyVar tv - ; case cts of - Indirect ty -> go ty - Flexi -> defer } - - go _ = defer - - -- Defer splitting by generating an equality constraint - defer - = do { ty1 <- newFlexiTyVarTy kind1 - ; ty2 <- newFlexiTyVarTy kind2 - ; co <- unifyType Nothing (mkAppTy ty1 ty2) orig_ty - ; return (co, (ty1, ty2)) } - - orig_kind = typeKind orig_ty - kind1 = mkVisFunTyMany liftedTypeKind orig_kind - kind2 = liftedTypeKind -- m :: * -> k - -- arg type :: * - -{- ********************************************************************** -* - fillInferResult -* -********************************************************************** -} - -{- Note [inferResultToType] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -expTypeToType and inferResultType convert an InferResult to a monotype. -It must be a monotype because if the InferResult isn't already filled in, -we fill it in with a unification variable (hence monotype). So to preserve -order-independence we check for mono-type-ness even if it *is* filled in -already. - -See also Note [TcLevel of ExpType] in GHC.Tc.Utils.TcType, and -Note [fillInferResult]. --} - --- | Fill an 'InferResult' with the given type. --- --- If @co = fillInferResult t1 infer_res@, then @co :: t1 ~# t2@, --- where @t2@ is the type stored in the 'ir_ref' field of @infer_res@. --- --- This function enforces the following invariants: --- --- - Level invariant. --- The stored type @t2@ is at the same level as given by the --- 'ir_lvl' field. --- - FRR invariant. --- Whenever the 'ir_frr' field is not @Nothing@, @t2@ is guaranteed --- to have a syntactically fixed RuntimeRep, in the sense of --- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. -fillInferResult :: TcType -> InferResult -> TcM TcCoercionN -fillInferResult act_res_ty (IR { ir_uniq = u - , ir_lvl = res_lvl - , ir_frr = mb_frr - , ir_ref = ref }) - = do { mb_exp_res_ty <- readTcRef ref - ; case mb_exp_res_ty of - Just exp_res_ty - -- We progressively refine the type stored in 'ref', - -- for example when inferring types across multiple equations. - -- - -- Example: - -- - -- \ x -> case y of { True -> x ; False -> 3 :: Int } - -- - -- When inferring the return type of this function, we will create - -- an 'Infer' 'ExpType', which will first be filled by the type of 'x' - -- after typechecking the first equation, and then filled again with - -- the type 'Int', at which point we want to ensure that we unify - -- the type of 'x' with 'Int'. This is what is happening below when - -- we are "joining" several inferred 'ExpType's. - -> do { traceTc "Joining inferred ExpType" $ - ppr u <> colon <+> ppr act_res_ty <+> char '~' <+> ppr exp_res_ty - ; cur_lvl <- getTcLevel - ; unless (cur_lvl `sameDepthAs` res_lvl) $ - ensureMonoType act_res_ty - ; unifyType Nothing act_res_ty exp_res_ty } - Nothing - -> do { traceTc "Filling inferred ExpType" $ - ppr u <+> text ":=" <+> ppr act_res_ty - - -- Enforce the level invariant: ensure the TcLevel of - -- the type we are writing to 'ref' matches 'ir_lvl'. - ; (prom_co, act_res_ty) <- promoteTcType res_lvl act_res_ty - - -- Enforce the FRR invariant: ensure the type has a syntactically - -- fixed RuntimeRep (if necessary, i.e. 'mb_frr' is not 'Nothing'). - ; (frr_co, act_res_ty) <- - case mb_frr of - Nothing -> return (mkNomReflCo act_res_ty, act_res_ty) - Just frr_orig -> hasFixedRuntimeRep frr_orig act_res_ty - - -- Compose the two coercions. - ; let final_co = prom_co `mkTransCo` frr_co - - ; writeTcRef ref (Just act_res_ty) - - ; return final_co } - } - -{- Note [fillInferResult] -~~~~~~~~~~~~~~~~~~~~~~~~~ -When inferring, we use fillInferResult to "fill in" the hole in InferResult - data InferResult = IR { ir_uniq :: Unique - , ir_lvl :: TcLevel - , ir_ref :: IORef (Maybe TcType) } - -There are two things to worry about: - -1. What if it is under a GADT or existential pattern match? - - GADTs: a unification variable (and Infer's hole is similar) is untouchable - - Existentials: be careful about skolem-escape - -2. What if it is filled in more than once? E.g. multiple branches of a case - case e of - T1 -> e1 - T2 -> e2 - -Our typing rules are: - -* The RHS of a existential or GADT alternative must always be a - monotype, regardless of the number of alternatives. - -* Multiple non-existential/GADT branches can have (the same) - higher rank type (#18412). E.g. this is OK: - case e of - True -> hr - False -> hr - where hr:: (forall a. a->a) -> Int - c.f. Section 7.1 of "Practical type inference for arbitrary-rank types" - We use choice (2) in that Section. - (GHC 8.10 and earlier used choice (1).) - - But note that - case e of - True -> hr - False -> \x -> hr x - will fail, because we still /infer/ both branches, so the \x will get - a (monotype) unification variable, which will fail to unify with - (forall a. a->a) - -For (1) we can detect the GADT/existential situation by seeing that -the current TcLevel is greater than that stored in ir_lvl of the Infer -ExpType. We bump the level whenever we go past a GADT/existential match. - -Then, before filling the hole use promoteTcType to promote the type -to the outer ir_lvl. promoteTcType does this - - create a fresh unification variable alpha at level ir_lvl - - emits an equality alpha[ir_lvl] ~ ty - - fills the hole with alpha -That forces the type to be a monotype (since unification variables can -only unify with monotypes); and catches skolem-escapes because the -alpha is untouchable until the equality floats out. - -For (2), we simply look to see if the hole is filled already. - - if not, we promote (as above) and fill the hole - - if it is filled, we simply unify with the type that is - already there - -There is one wrinkle. Suppose we have - case e of - T1 -> e1 :: (forall a. a->a) -> Int - G2 -> e2 -where T1 is not GADT or existential, but G2 is a GADT. Then suppose the -T1 alternative fills the hole with (forall a. a->a) -> Int, which is fine. -But now the G2 alternative must not *just* unify with that else we'd risk -allowing through (e2 :: (forall a. a->a) -> Int). If we'd checked G2 first -we'd have filled the hole with a unification variable, which enforces a -monotype. - -So if we check G2 second, we still want to emit a constraint that restricts -the RHS to be a monotype. This is done by ensureMonoType, and it works -by simply generating a constraint (alpha ~ ty), where alpha is a fresh -unification variable. We discard the evidence. - --} - - - -{- -************************************************************************ -* * - Subsumption checking -* * -************************************************************************ - -Note [Subsumption checking: tcSubType] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -All the tcSubType calls have the form - tcSubType actual_ty expected_ty -which checks - actual_ty <= expected_ty - -That is, that a value of type actual_ty is acceptable in -a place expecting a value of type expected_ty. I.e. that - - actual ty is more polymorphic than expected_ty - -It returns a wrapper function - co_fn :: actual_ty ~ expected_ty -which takes an HsExpr of type actual_ty into one of type -expected_ty. - -Note [Ambiguity check and deep subsumption] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - f :: (forall b. Eq b => a -> a) -> Int - -Does `f` have an ambiguous type? The ambiguity check usually checks -that this definition of f' would typecheck, where f' has the exact same -type as f: - f' :: (forall b. Eq b => a -> a) -> Intp - f' = f - -This will be /rejected/ with DeepSubsumption but /accepted/ with -ShallowSubsumption. On the other hand, this eta-expanded version f'' -would be rejected both ways: - f'' :: (forall b. Eq b => a -> a) -> Intp - f'' x = f x - -This is squishy in the same way as other examples in GHC.Tc.Validity -Note [The squishiness of the ambiguity check] - -The situation in June 2022. Since we have SimpleSubsumption at the moment, -we don't want introduce new breakage if you add -XDeepSubsumption, by -rejecting types as ambiguous that weren't ambiguous before. So, as a -holding decision, we /always/ use SimpleSubsumption for the ambiguity check -(erring on the side accepting more programs). Hence tcSubTypeAmbiguity. --} - - - ------------------ --- tcWrapResult needs both un-type-checked (for origins and error messages) --- and type-checked (for wrapping) expressions -tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType - -> TcM (HsExpr GhcTc) -tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr - -tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType - -> TcM (HsExpr GhcTc) -tcWrapResultO orig rn_expr expr actual_ty res_ty - = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty - , text "Expected:" <+> ppr res_ty ]) - ; wrap <- tcSubTypeNC orig GenSigCtxt (Just $ HsExprRnThing rn_expr) actual_ty res_ty - ; return (mkHsWrap wrap expr) } - -tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc - -> TcRhoType -- Actual -- a rho-type not a sigma-type - -> ExpRhoType -- Expected - -> TcM (HsExpr GhcTc) --- A version of tcWrapResult to use when the actual type is a --- rho-type, so nothing to instantiate; just go straight to unify. --- It means we don't need to pass in a CtOrigin -tcWrapResultMono rn_expr expr act_ty res_ty - = assertPpr (isRhoTy act_ty) (ppr act_ty $$ ppr rn_expr) $ - do { co <- unifyExpectedType rn_expr act_ty res_ty - ; return (mkHsWrapCo co expr) } - -unifyExpectedType :: HsExpr GhcRn - -> TcRhoType -- Actual -- a rho-type not a sigma-type - -> ExpRhoType -- Expected - -> TcM TcCoercionN -unifyExpectedType rn_expr act_ty exp_ty - = case exp_ty of - Infer inf_res -> fillInferResult act_ty inf_res - Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty - ------------------------- -tcSubTypePat :: CtOrigin -> UserTypeCtxt - -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper --- Used in patterns; polarity is backwards compared --- to tcSubType --- If wrap = tc_sub_type_et t1 t2 --- => wrap :: t1 ~> t2 -tcSubTypePat inst_orig ctxt (Check ty_actual) ty_expected - = tc_sub_type unifyTypeET inst_orig ctxt ty_actual ty_expected - -tcSubTypePat _ _ (Infer inf_res) ty_expected - = do { co <- fillInferResult ty_expected inf_res - -- In patterns we do not instantatiate - - ; return (mkWpCastN (mkSymCo co)) } - ---------------- -tcSubType :: CtOrigin -> UserTypeCtxt - -> TcSigmaType -- ^ Actual - -> ExpRhoType -- ^ Expected - -> TcM HsWrapper --- Checks that 'actual' is more polymorphic than 'expected' -tcSubType orig ctxt ty_actual ty_expected - = addSubTypeCtxt ty_actual ty_expected $ - do { traceTc "tcSubType" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected]) - ; tcSubTypeNC orig ctxt Nothing ty_actual ty_expected } - ---------------- -tcSubTypeDS :: HsExpr GhcRn - -> TcRhoType -- Actual type -- a rho-type not a sigma-type - -> TcRhoType -- Expected type - -- DeepSubsumption <=> when checking, this type - -- is deeply skolemised - -> TcM HsWrapper --- Similar signature to unifyExpectedType; does deep subsumption --- Only one call site, in GHC.Tc.Gen.App.tcApp -tcSubTypeDS rn_expr act_rho exp_rho - = tc_sub_type_deep (unifyExprType rn_expr) orig GenSigCtxt act_rho exp_rho - where - orig = exprCtOrigin rn_expr - ---------------- -tcSubTypeNC :: CtOrigin -- ^ Used when instantiating - -> UserTypeCtxt -- ^ Used when skolemising - -> Maybe TypedThing -- ^ The expression that has type 'actual' (if known) - -> TcSigmaType -- ^ Actual type - -> ExpRhoType -- ^ Expected type - -> TcM HsWrapper -tcSubTypeNC inst_orig ctxt m_thing ty_actual res_ty - = case res_ty of - Check ty_expected -> tc_sub_type (unifyType m_thing) inst_orig ctxt - ty_actual ty_expected - - Infer inf_res -> do { (wrap, rho) <- topInstantiate inst_orig ty_actual - -- See Note [Instantiation of InferResult] - ; co <- fillInferResult rho inf_res - ; return (mkWpCastN co <.> wrap) } - ---------------- -tcSubTypeSigma :: CtOrigin -- where did the actual type arise / why are we - -- doing this subtype check? - -> UserTypeCtxt -- where did the expected type arise? - -> TcSigmaType -> TcSigmaType -> TcM HsWrapper --- External entry point, but no ExpTypes on either side --- Checks that actual <= expected --- Returns HsWrapper :: actual ~ expected -tcSubTypeSigma orig ctxt ty_actual ty_expected - = tc_sub_type (unifyType Nothing) orig ctxt ty_actual ty_expected - ---------------- -tcSubTypeAmbiguity :: UserTypeCtxt -- Where did this type arise - -> TcSigmaType -> TcSigmaType -> TcM HsWrapper --- See Note [Ambiguity check and deep subsumption] -tcSubTypeAmbiguity ctxt ty_actual ty_expected - = tc_sub_type_ds Shallow (unifyType Nothing) - (AmbiguityCheckOrigin ctxt) - ctxt ty_actual ty_expected - ---------------- -addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a -addSubTypeCtxt ty_actual ty_expected thing_inside - | isRhoTy ty_actual -- If there is no polymorphism involved, the - , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions) - = thing_inside -- gives enough context by itself - | otherwise - = addErrCtxtM mk_msg thing_inside - where - mk_msg tidy_env - = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual - ; ty_expected <- readExpType ty_expected - -- A worry: might not be filled if we're debugging. Ugh. - ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected - ; let msg = vcat [ hang (text "When checking that:") - 4 (ppr ty_actual) - , nest 2 (hang (text "is more polymorphic than:") - 2 (ppr ty_expected)) ] - ; return (tidy_env, msg) } - - -{- Note [Instantiation of InferResult] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We now always instantiate before filling in InferResult, so that -the result is a TcRhoType: see #17173 for discussion. - -For example: - -1. Consider - f x = (*) - We want to instantiate the type of (*) before returning, else we - will infer the type - f :: forall {a}. a -> forall b. Num b => b -> b -> b - This is surely confusing for users. - - And worse, the monomorphism restriction won't work properly. The MR is - dealt with in simplifyInfer, and simplifyInfer has no way of - instantiating. This could perhaps be worked around, but it may be - hard to know even when instantiation should happen. - -2. Another reason. Consider - f :: (?x :: Int) => a -> a - g y = let ?x = 3::Int in f - Here want to instantiate f's type so that the ?x::Int constraint - gets discharged by the enclosing implicit-parameter binding. - -3. Suppose one defines plus = (+). If we instantiate lazily, we will - infer plus :: forall a. Num a => a -> a -> a. However, the monomorphism - restriction compels us to infer - plus :: Integer -> Integer -> Integer - (or similar monotype). Indeed, the only way to know whether to apply - the monomorphism restriction at all is to instantiate - -There is one place where we don't want to instantiate eagerly, -namely in GHC.Tc.Module.tcRnExpr, which implements GHCi's :type -command. See Note [Implementing :type] in GHC.Tc.Module. --} - ---------------- -tc_sub_type :: (TcType -> TcType -> TcM TcCoercionN) -- How to unify - -> CtOrigin -- Used when instantiating - -> UserTypeCtxt -- Used when skolemising - -> TcSigmaType -- Actual; a sigma-type - -> TcSigmaType -- Expected; also a sigma-type - -> TcM HsWrapper --- Checks that actual_ty is more polymorphic than expected_ty --- If wrap = tc_sub_type t1 t2 --- => wrap :: t1 ~> t2 --- --- The "how to unify argument" is always a call to `uType TypeLevel orig`, --- but with different ways of constructing the CtOrigin `orig` from --- the argument types and context. - ----------------------- -tc_sub_type unify inst_orig ctxt ty_actual ty_expected - = do { ds_flag <- getDeepSubsumptionFlag - ; tc_sub_type_ds ds_flag unify inst_orig ctxt ty_actual ty_expected } - ----------------------- -tc_sub_type_ds :: DeepSubsumptionFlag - -> (TcType -> TcType -> TcM TcCoercionN) - -> CtOrigin -> UserTypeCtxt -> TcSigmaType - -> TcSigmaType -> TcM HsWrapper --- tc_sub_type_ds is the main subsumption worker function --- It takes an explicit DeepSubsumptionFlag -tc_sub_type_ds ds_flag unify inst_orig ctxt ty_actual ty_expected - | definitely_poly ty_expected -- See Note [Don't skolemise unnecessarily] - , isRhoTyDS ds_flag ty_actual - = do { traceTc "tc_sub_type (drop to equality)" $ - vcat [ text "ty_actual =" <+> ppr ty_actual - , text "ty_expected =" <+> ppr ty_expected ] - ; mkWpCastN <$> - unify ty_actual ty_expected } - - | otherwise -- This is the general case - = do { traceTc "tc_sub_type (general case)" $ - vcat [ text "ty_actual =" <+> ppr ty_actual - , text "ty_expected =" <+> ppr ty_expected ] - - ; (sk_wrap, inner_wrap) - <- tcSkolemise ds_flag ctxt ty_expected $ \sk_rho -> - case ds_flag of - Deep -> tc_sub_type_deep unify inst_orig ctxt ty_actual sk_rho - Shallow -> tc_sub_type_shallow unify inst_orig ty_actual sk_rho - - ; return (sk_wrap <.> inner_wrap) } - ----------------------- -tc_sub_type_shallow :: (TcType -> TcType -> TcM TcCoercionN) - -> CtOrigin - -> TcSigmaType - -> TcRhoType -- Skolemised (shallow-ly) - -> TcM HsWrapper -tc_sub_type_shallow unify inst_orig ty_actual sk_rho - = do { (wrap, rho_a) <- topInstantiate inst_orig ty_actual - ; cow <- unify rho_a sk_rho - ; return (mkWpCastN cow <.> wrap) } - ----------------------- -definitely_poly :: TcType -> Bool --- A very conservative test: --- see Note [Don't skolemise unnecessarily] -definitely_poly ty - | (tvs, theta, tau) <- tcSplitSigmaTy ty - , (tv:_) <- tvs -- At least one tyvar - , null theta -- No constraints; see (DP1) - , tv `isInjectiveInType` tau - -- The tyvar actually occurs (DP2), - -- and occurs in an injective position (DP3). - = True - | otherwise - = False - -{- Note [Don't skolemise unnecessarily] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we are trying to solve - ty_actual <= ty_expected - (Char->Char) <= (forall a. a->a) -We could skolemise the 'forall a', and then complain -that (Char ~ a) is insoluble; but that's a pretty obscure -error. It's better to say that - (Char->Char) ~ (forall a. a->a) -fails. - -If we prematurely go to equality we'll reject a program we should -accept (e.g. #13752). So the test (which is only to improve error -message) is very conservative: - - * ty_actual is /definitely/ monomorphic: see `definitely_mono` - This definitely_mono test comes in "shallow" and "deep" variants - - * ty_expected is /definitely/ polymorphic: see `definitely_poly` - This definitely_poly test is more subtle than you might think. - Here are three cases where expected_ty looks polymorphic, but - isn't, and where it would be /wrong/ to switch to equality: - - (DP1) (Char->Char) <= (forall a. (a~Char) => a -> a) - - (DP2) (Char->Char) <= (forall a. Char -> Char) - - (DP3) (Char->Char) <= (forall a. F [a] Char -> Char) - where type instance F [x] t = t - - -Note [Coercions returned from tcSubMult] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -At the moment, we insist that all sub-multiplicity tests turn out -(once the typechecker has finished its work) to be equalities, -i.e. implementable by ReflCo. Why? Because our type system has -no way to express non-Refl sub-multiplicities. - -How can we check that every call to `tcSubMult` returns `Refl`? -It might not be `Refl` *yet*. - -[TODO: add counterexample #25130] - -So we take a two-stage approach: -* Generate a coercion now, and hang it in the HsSyn syntax tree -* In the desugarer, after zonking, check that it is Refl. - -We "hang it in the tree" in two different ways: -A) In a HsWrapper, in the WpMultCoercion alternative. The - desugarer checks that WpMultCoercions are Refl, and then - discards them. See `GHC.HsToCore.Binds.dsHsWrapper` -B) In an extension field. For example, in the extension - field of `HsRecFields`. See `check_omitted_fields_multiplicity` - in `GHC.Tc.Gen.Pat.tcDataConPat` - -The former mechanism (A) seemed convenient at the time, but has -turned out to add a lot of friction, so we plan to move towards -(B): see #25128 - -An alternative would be to have a kind of constraint which can -only produce trivial evidence. This would allow such checks to happen -in the constraint solver (#18756). -This would be similar to the existing setup for Concrete, see - Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete - (PHASE 1 in particular). - --} - -tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper -tcSubMult' :: CtOrigin -> Mult -> Mult -> TcM MultiplicityCheckCoercions -tcSubMult origin w_actual w_expected = - do { mult_cos <- tcSubMult' origin w_actual w_expected - ; return (foldMap WpMultCoercion mult_cos) } -tcSubMult' origin w_actual w_expected - | Just (w1, w2) <- isMultMul w_actual = - do { w1 <- tcSubMult' origin w1 w_expected - ; w2 <- tcSubMult' origin w2 w_expected - ; return (w1 ++ w2) } - -- Currently, we consider p*q and sup p q to be equal. Therefore, p*q <= r is - -- equivalent to p <= r and q <= r. For other cases, we approximate p <= q by p - -- ~ q. This is not complete, but it's sound. See also Note [Overapproximating - -- multiplicities] in Multiplicity. -tcSubMult' origin w_actual w_expected = - case submult w_actual w_expected of - Submult -> return [] - Unknown -> tcEqMult' origin w_actual w_expected - -tcEqMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper -tcEqMult' :: CtOrigin -> Mult -> Mult -> TcM MultiplicityCheckCoercions -tcEqMult origin w_actual w_expected = - do { mult_cos <- tcEqMult' origin w_actual w_expected - ; return (foldMap WpMultCoercion mult_cos) } -tcEqMult' origin w_actual w_expected = do - { - -- Note that here we do not call to `submult`, so we check - -- for strict equality. - ; coercion <- unifyTypeAndEmit TypeLevel origin w_actual w_expected - ; return $ if isReflCo coercion then [] else [coercion] } - - -{- ********************************************************************* -* * - Deep subsumption -* * -********************************************************************* -} - -{- Note [Deep subsumption] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -The DeepSubsumption extension, documented here - - https://github.com/ghc-proposals/ghc-proposals/pull/511. - -makes a best-efforts attempt implement deep subsumption as it was -prior to the Simplify Subsumption proposal: - - https://github.com/ghc-proposals/ghc-proposals/pull/287 - -The effects are in these main places: - -1. In the subsumption check, tcSubType, we must do deep skolemisation: - see the call to tcSkolemise Deep in tc_sub_type_deep - -2. In tcPolyExpr we must do deep skolemisation: - see the call to tcSkolemise in tcSkolemiseExpType - -3. for expression type signatures (e :: ty), and functions with type - signatures (e.g. f :: ty; f = e), we must deeply skolemise the type; - see the call to tcDeeplySkolemise in tcSkolemiseScoped. - -4. In GHC.Tc.Gen.App.tcApp we call tcSubTypeDS to match the result - type. Without deep subsumption, unifyExpectedType would be sufficent. - -In all these cases note that the deep skolemisation must be done /first/. -Consider (1) - (forall a. Int -> a -> a) <= Int -> (forall b. b -> b) -We must skolemise the `forall b` before instantiating the `forall a`. -See also Note [Deep skolemisation]. - -Wrinkles: - -(DS1) Note that we /always/ use shallow subsumption in the ambiguity check. - See Note [Ambiguity check and deep subsumption]. - -(DS2) Deep subsumption requires deep instantiation too. - See Note [The need for deep instantiation] - -(DS3) The interaction between deep subsumption and required foralls - (forall a -> ty) is a bit subtle. See #24696 and - Note [Deep subsumption and required foralls] - -Note [Deep skolemisation] -~~~~~~~~~~~~~~~~~~~~~~~~~ -deeplySkolemise decomposes and skolemises a type, returning a type -with all its arrows visible (ie not buried under foralls) - -Examples: - - deeplySkolemise (Int -> forall a. Ord a => blah) - = ( wp, [a], [d:Ord a], Int -> blah ) - where wp = \x:Int. /\a. \(d:Ord a). x - - deeplySkolemise (forall a. Ord a => Maybe a -> forall b. Eq b => blah) - = ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah ) - where wp = /\a.\(d1:Ord a).\(x:Maybe a)./\b.\(d2:Ord b). x - -In general, - if deeplySkolemise ty = (wrap, tvs, evs, rho) - and e :: rho - then wrap e :: ty - and 'wrap' binds tvs, evs - -ToDo: this eta-abstraction plays fast and loose with termination, - because it can introduce extra lambdas. Maybe add a `seq` to - fix this - -Note [Setting the argument context] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider we are doing the ambiguity check for the (bogus) - f :: (forall a b. C b => a -> a) -> Int - -We'll call - tcSubType ((forall a b. C b => a->a) -> Int ) - ((forall a b. C b => a->a) -> Int ) - -with a UserTypeCtxt of (FunSigCtxt "f"). Then we'll do the co/contra thing -on the argument type of the (->) -- and at that point we want to switch -to a UserTypeCtxt of GenSigCtxt. Why? - -* Error messages. If we stick with FunSigCtxt we get errors like - * Could not deduce: C b - from the context: C b0 - bound by the type signature for: - f :: forall a b. C b => a->a - But of course f does not have that type signature! - Example tests: T10508, T7220a, Simple14 - -* Implications. We may decide to build an implication for the whole - ambiguity check, but we don't need one for each level within it, - and TcUnify.alwaysBuildImplication checks the UserTypeCtxt. - See Note [When to build an implication] - -Note [Multiplicity in deep subsumption] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - t1 ->{mt} t2 <= s1 ->{ms} s2 - -At the moment we /unify/ ms~mt, via tcEqMult. - -Arguably we should use `tcSubMult`. But then if mt=m0 (a unification -variable) and ms=Many, `tcSubMult` is a no-op (since anything is a -sub-multiplicty of Many). But then `m0` may never get unified with -anything. It is then skolemised by the zonker; see GHC.HsToCore.Binds -Note [Free tyvars on rule LHS]. So we in RULE foldr/app in GHC.Base -we get this - - "foldr/app" [1] forall ys m1 m2. foldr (\x{m1} \xs{m2}. (:) x xs) ys - = \xs -> xs ++ ys - -where we eta-expanded that (:). But now foldr expects an argument -with ->{Many} and gets an argument with ->{m1} or ->{m2}, and Lint -complains. - -The easiest solution was to use tcEqMult in tc_sub_type_deep, and -insist on equality. This is only in the DeepSubsumption code anyway. - -Note [The need for deep instantiation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this, without Quick Look, but with Deep Subsumption: - f :: ∀a b c. a b c -> Int - g :: Bool -> ∀d. d -> d -Consider the application (f g). We need to do the subsumption test - - (Bool -> ∀ d. d->d) <= (alpha beta gamma) - -where alpha, beta, gamma are the unification variables that instantiate a,b,c, -respectively. We must not drop down to unification, or we will reject the call. -Rather we must deeply instantiate the LHS to get - - (Bool -> delta -> delta) <= (alpha beta gamma) - -and now we can unify to get - - alpha = (->) - beta = Bool - gamma = delta -> delta - -Hence the call to `deeplyInstantiate` in `tc_sub_type_deep`. - -See typecheck/should_compile/T11305 for an example of when this is important. - -Note [Deep subsumption and required foralls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A required forall, (forall a -> ty) behaves like a "rho-type", one with no -top-level quantification. In particular, it is neither implicitly instantiated nor -skolemised. So - - rid1 :: forall a -> a -> a - rid1 = id - - rid2 :: forall a -> a -> a - rid2 a = id - -Here `rid2` wll typecheck, but `rid1` will not, because we don't implicitly skolemise -the type. - -This "no implicit subsumption nor skolemisation" applies during subsumption. -For example - (forall a. a->a) <= (forall a -> a -> a) -- NOT! -does /not/ hold, because that would require implicitly skoleming the (forall a->). - -Note also that, in Core, `eqType` distinguishes between - (forall a. blah) and forall a -> blah) -See discussion on #22762 and these Notes in GHC.Core.TyCo.Compare - * Note [ForAllTy and type equality] - * Note [Comparing visibility] - -So during deep subsumption we simply stop (and drop down to equality) when we encounter -a (forall a->). This is a little odd: -* Deep subsumption looks inside invisible foralls (forall a. ty) -* Deep subsumption looks inside arrows (t1 -> t2) -* But it does not look inside required foralls (forall a -> ty) - -There is discussion on #24696. How is this implemented? - -* In `tc_sub_type_deep`, the calls to `topInstantiate` and `deeplyInstantiate` - instantiate only /invisible/ binders. -* In `tc_sub_type_ds`, the call to `tcSkolemise` skolemises only /invisible/ - binders. - -Here is a slightly more powerful alternative -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - In the story above, if we have - (forall a -> Eq a => a -> a) <= (forall a -> Ord a => a -> a) -we'll reject it, because both are rho-types but they aren't equal. But in the -"drop to equality" stage we could instead see if both rho-types are headed with -(forall a ->) and if so strip that off and go back into deep subsumption. - -This is a bit more powerful, but also a bit more complicated, so GHC -doesn't do it yet, awaiting credible user demand. See #24696. --} - -data DeepSubsumptionFlag = Deep | Shallow - -instance Outputable DeepSubsumptionFlag where - ppr Deep = text "Deep" - ppr Shallow = text "Shallow" - -getDeepSubsumptionFlag :: TcM DeepSubsumptionFlag -getDeepSubsumptionFlag = do { ds <- xoptM LangExt.DeepSubsumption - ; if ds then return Deep else return Shallow } - -tc_sub_type_deep :: HasDebugCallStack - => (TcType -> TcType -> TcM TcCoercionN) -- How to unify - -> CtOrigin -- Used when instantiating - -> UserTypeCtxt -- Used when skolemising - -> TcSigmaType -- Actual; a sigma-type - -> TcRhoType -- Expected; deeply skolemised - -> TcM HsWrapper - --- If wrap = tc_sub_type_deep t1 t2 --- => wrap :: t1 ~> t2 --- Here is where the work actually happens! --- Precondition: ty_expected is deeply skolemised - -tc_sub_type_deep unify inst_orig ctxt ty_actual ty_expected - = assertPpr (isDeepRhoTy ty_expected) (ppr ty_expected) $ - do { traceTc "tc_sub_type_deep" $ - vcat [ text "ty_actual =" <+> ppr ty_actual - , text "ty_expected =" <+> ppr ty_expected ] - ; go ty_actual ty_expected } - where - -- NB: 'go' is not recursive, except for doing coreView - go ty_a ty_e | Just ty_a' <- coreView ty_a = go ty_a' ty_e - | Just ty_e' <- coreView ty_e = go ty_a ty_e' - - go (TyVarTy tv_a) ty_e - = do { lookup_res <- isFilledMetaTyVar_maybe tv_a - ; case lookup_res of - Just ty_a' -> - do { traceTc "tc_sub_type_deep following filled meta-tyvar:" - (ppr tv_a <+> text "-->" <+> ppr ty_a') - ; tc_sub_type_deep unify inst_orig ctxt ty_a' ty_e } - Nothing -> just_unify ty_actual ty_expected } - - go ty_a@(FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) - ty_e@(FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res }) - | isVisibleFunArg af1, isVisibleFunArg af2 - = if (isTauTy ty_a && isTauTy ty_e) -- Short cut common case to avoid - then just_unify ty_actual ty_expected -- unnecessary eta expansion - else - -- This is where we do the co/contra thing, and generate a WpFun, which in turn - -- causes eta-expansion, which we don't like; hence encouraging NoDeepSubsumption - do { arg_wrap <- tc_sub_type_ds Deep unify given_orig GenSigCtxt exp_arg act_arg - -- GenSigCtxt: See Note [Setting the argument context] - ; res_wrap <- tc_sub_type_deep unify inst_orig ctxt act_res exp_res - ; mult_wrap <- tcEqMult inst_orig act_mult exp_mult - -- See Note [Multiplicity in deep subsumption] - ; return (mult_wrap <.> - mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res) } - -- arg_wrap :: exp_arg ~> act_arg - -- res_wrap :: act-res ~> exp_res - where - given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) - - go ty_a ty_e - | let (tvs, theta, _) = tcSplitSigmaTy ty_a - , not (null tvs && null theta) - = do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a - ; body_wrap <- tc_sub_type_deep unify inst_orig ctxt in_rho ty_e - ; return (body_wrap <.> in_wrap) } - - | otherwise -- Revert to unification - = do { -- It's still possible that ty_actual has nested foralls. Instantiate - -- these, as there's no way unification will succeed with them in. - -- See Note [The need for deep instantiation] - (inst_wrap, rho_a) <- deeplyInstantiate inst_orig ty_actual - ; unify_wrap <- just_unify rho_a ty_expected - ; return (unify_wrap <.> inst_wrap) } - - just_unify ty_a ty_e = do { cow <- unify ty_a ty_e - ; return (mkWpCastN cow) } - ------------------------ -deeplySkolemise :: SkolemInfo -> TcSigmaType - -> TcM ( HsWrapper - , [(Name,TcInvisTVBinder)] -- All skolemised variables - , [EvVar] -- All "given"s - , TcRhoType ) --- See Note [Deep skolemisation] -deeplySkolemise skol_info ty - = go init_subst ty - where - init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) - - go subst ty - | Just (arg_tys, bndrs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty - = do { let arg_tys' = substScaledTys subst arg_tys - ; ids1 <- newSysLocalIds (fsLit "dk") arg_tys' - ; (subst', bndrs1) <- tcInstSkolTyVarBndrsX skol_info subst bndrs - ; ev_vars1 <- newEvVars (substTheta subst' theta) - ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty' - ; let tvs = binderVars bndrs - tvs1 = binderVars bndrs1 - tv_prs1 = map tyVarName tvs `zip` bndrs1 - ; return ( mkWpEta ids1 (mkWpTyLams tvs1 - <.> mkWpEvLams ev_vars1 - <.> wrap) - , tv_prs1 ++ tvs_prs2 - , ev_vars1 ++ ev_vars2 - , mkScaledFunTys arg_tys' rho ) } - - | otherwise - = return (idHsWrapper, [], [], substTy subst ty) - -- substTy is a quick no-op on an empty substitution - -deeplyInstantiate :: CtOrigin -> TcType -> TcM (HsWrapper, Type) -deeplyInstantiate orig ty - = go init_subst ty - where - init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) - - go subst ty - | Just (arg_tys, bndrs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty - = do { let tvs = binderVars bndrs - ; (subst', tvs') <- newMetaTyVarsX subst tvs - ; let arg_tys' = substScaledTys subst' arg_tys - theta' = substTheta subst' theta - ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' - ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' - ; (wrap2, rho2) <- go subst' rho - ; return (mkWpEta ids1 (wrap2 <.> wrap1), - mkScaledFunTys arg_tys' rho2) } - - | otherwise - = do { let ty' = substTy subst ty - ; return (idHsWrapper, ty') } - -tcDeepSplitSigmaTy_maybe - :: TcSigmaType -> Maybe ([Scaled TcType], [TcInvisTVBinder], ThetaType, TcSigmaType) --- Looks for a *non-trivial* quantified type, under zero or more function arrows --- By "non-trivial" we mean either tyvars or constraints are non-empty -tcDeepSplitSigmaTy_maybe ty - = go ty - where - go ty | Just (arg_ty, res_ty) <- tcSplitFunTy_maybe ty - , Just (arg_tys, tvs, theta, rho) <- go res_ty - = Just (arg_ty:arg_tys, tvs, theta, rho) - - | (tvs, theta, rho) <- tcSplitSigmaTyBndrs ty - , not (null tvs && null theta) - = Just ([], tvs, theta, rho) - - | otherwise = Nothing - -isDeepRhoTy :: TcType -> Bool --- True if there are no foralls or (=>) at the top, or nested under --- arrows to the right. e.g --- forall a. a False --- Int -> forall a. a False --- (forall a. a) -> Int True --- Returns True iff tcDeepSplitSigmaTy_maybe returns Nothing -isDeepRhoTy ty - | not (isRhoTy ty) = False -- Foralls or (=>) at top - | Just (_, res) <- tcSplitFunTy_maybe ty = isDeepRhoTy res - | otherwise = True -- No forall, (=>), or (->) at top - -isRhoTyDS :: DeepSubsumptionFlag -> TcType -> Bool -isRhoTyDS ds_flag ty - = case ds_flag of - Shallow -> isRhoTy ty -- isRhoTy: no top level forall or (=>) - Deep -> isDeepRhoTy ty -- "deep" version: no nested forall or (=>) - -{- -************************************************************************ -* * - Boxy unification -* * -************************************************************************ - -The exported functions are all defined as versions of some -non-exported generic functions. --} - -unifyExprType :: HsExpr GhcRn -> TcType -> TcType -> TcM TcCoercionN -unifyExprType rn_expr ty1 ty2 - = unifyType (Just (HsExprRnThing rn_expr)) ty1 ty2 - -unifyType :: Maybe TypedThing -- ^ If present, the thing that has type ty1 - -> TcTauType -> TcTauType -- ty1 (actual), ty2 (expected) - -> TcM TcCoercionN -- :: ty1 ~# ty2 --- Actual and expected types --- Returns a coercion : ty1 ~ ty2 -unifyType thing ty1 ty2 - = unifyTypeAndEmit TypeLevel origin ty1 ty2 - where - origin = TypeEqOrigin { uo_actual = ty1 - , uo_expected = ty2 - , uo_thing = thing - , uo_visible = True } - -unifyInvisibleType :: TcTauType -> TcTauType -- ty1 (actual), ty2 (expected) - -> TcM TcCoercionN -- :: ty1 ~# ty2 --- Actual and expected types --- Returns a coercion : ty1 ~ ty2 -unifyInvisibleType ty1 ty2 - = unifyTypeAndEmit TypeLevel origin ty1 ty2 - where - origin = TypeEqOrigin { uo_actual = ty1 - , uo_expected = ty2 - , uo_thing = Nothing - , uo_visible = False } -- This is the "invisible" bit - -unifyTypeET :: TcTauType -> TcTauType -> TcM CoercionN --- Like unifyType, but swap expected and actual in error messages --- This is used when typechecking patterns -unifyTypeET ty1 ty2 - = unifyTypeAndEmit TypeLevel origin ty1 ty2 - where - origin = TypeEqOrigin { uo_actual = ty2 -- NB swapped - , uo_expected = ty1 -- NB swapped - , uo_thing = Nothing - , uo_visible = True } - - -unifyKind :: Maybe TypedThing -> TcKind -> TcKind -> TcM CoercionN -unifyKind mb_thing ty1 ty2 - = unifyTypeAndEmit KindLevel origin ty1 ty2 - where - origin = TypeEqOrigin { uo_actual = ty1 - , uo_expected = ty2 - , uo_thing = mb_thing - , uo_visible = True } - -unifyTypeAndEmit :: TypeOrKind -> CtOrigin -> TcType -> TcType -> TcM CoercionN --- Make a ref-cell, unify, emit the collected constraints -unifyTypeAndEmit t_or_k orig ty1 ty2 - = do { ref <- newTcRef emptyBag - ; loc <- getCtLocM orig (Just t_or_k) - ; let env = UE { u_loc = loc, u_role = Nominal - , u_rewriters = emptyRewriterSet -- ToDo: check this - , u_defer = ref, u_unified = Nothing } - - -- The hard work happens here - ; co <- uType env ty1 ty2 - - ; cts <- readTcRef ref - ; unless (null cts) (emitSimples cts) - ; return co } - -{- -%************************************************************************ -%* * - uType and friends -%* * -%************************************************************************ - -Note [The eager unifier] -~~~~~~~~~~~~~~~~~~~~~~~~ -The eager unifier, `uType`, is called by - - * The constraint generator (e.g. in GHC.Tc.Gen.Expr), - via the wrappers `unifyType`, `unifyKind` etc - - * The constraint solver (e.g. in GHC.Tc.Solver.Equality), - via `GHC.Tc.Solver.Monad.wrapUnifierTcS`. - -`uType` runs in the TcM monad, but it carries a UnifyEnv that tells it -what to do when unifying a variable or deferring a constraint. Specifically, - * it collects deferred constraints in `u_defer`, and - * it records which unification variables it has unified in `u_unified` -Then it is up to the wrappers (one for the constraint generator, one for -the constraint solver) to deal with these collected sets. - -Although `uType` runs in the TcM monad for convenience, really it could -operate just with the ability to - * write to the accumulators of deferred constraints - and unification variables in UnifyEnv. - * read and update existing unification variables - * zonk types befire unifying (`zonkTcType` in `uUnfilledVar`, and - `zonkTyCoVarKind` in `uUnfilledVar1` - * create fresh coercion holes (`newCoercionHole`) - * emit tracing info for debugging - * look at the ambient TcLevel: `getTcLevel` -A job for the future. --} - -data UnifyEnv - = UE { u_role :: Role - , u_loc :: CtLoc - , u_rewriters :: RewriterSet - - -- Deferred constraints - , u_defer :: TcRef (Bag Ct) - - -- Which variables are unified; - -- if Nothing, we don't care - , u_unified :: Maybe (TcRef [TcTyVar]) - } - -setUEnvRole :: UnifyEnv -> Role -> UnifyEnv -setUEnvRole uenv role = uenv { u_role = role } - -updUEnvLoc :: UnifyEnv -> (CtLoc -> CtLoc) -> UnifyEnv -updUEnvLoc uenv@(UE { u_loc = loc }) upd = uenv { u_loc = upd loc } - -mkKindEnv :: UnifyEnv -> TcType -> TcType -> UnifyEnv --- Modify the UnifyEnv to be right for unifing --- the kinds of these two types -mkKindEnv env@(UE { u_loc = ctloc }) ty1 ty2 - = env { u_role = Nominal, u_loc = mkKindEqLoc ty1 ty2 ctloc } - -uType, uType_defer - :: UnifyEnv - -> TcType -- ty1 is the *actual* type - -> TcType -- ty2 is the *expected* type - -> TcM CoercionN - --- It is always safe to defer unification to the main constraint solver --- See Note [Deferred unification] -uType_defer (UE { u_loc = loc, u_defer = ref - , u_role = role, u_rewriters = rewriters }) - ty1 ty2 -- ty1 is "actual", ty2 is "expected" - = do { let pred_ty = mkPrimEqPredRole role ty1 ty2 - ; hole <- newCoercionHole loc pred_ty - ; let ct = mkNonCanonical $ - CtWanted { ctev_pred = pred_ty - , ctev_dest = HoleDest hole - , ctev_loc = loc - , ctev_rewriters = rewriters } - co = HoleCo hole - ; updTcRef ref (`snocBag` ct) - -- snocBag: see Note [Work-list ordering] in GHC.Tc.Solver.Equality - - -- Error trace only - -- NB. do *not* call mkErrInfo unless tracing is on, - -- because it is hugely expensive (#5631) - ; whenDOptM Opt_D_dump_tc_trace $ - do { ctxt <- getErrCtxt - ; doc <- mkErrInfo emptyTidyEnv ctxt - ; traceTc "utype_defer" (vcat [ ppr role - , debugPprType ty1 - , debugPprType ty2 - , doc]) - ; traceTc "utype_defer2" (ppr co) } - - ; return co } - - --------------- -uType env@(UE { u_role = role }) orig_ty1 orig_ty2 - | Phantom <- role - = do { kind_co <- uType (mkKindEnv env orig_ty1 orig_ty2) - (typeKind orig_ty1) (typeKind orig_ty2) - ; return (mkPhantomCo kind_co orig_ty1 orig_ty2) } - - | otherwise - = do { tclvl <- getTcLevel - ; traceTc "u_tys" $ vcat - [ text "tclvl" <+> ppr tclvl - , sep [ ppr orig_ty1, text "~" <> ppr role, ppr orig_ty2] ] - ; co <- go orig_ty1 orig_ty2 - ; if isReflCo co - then traceTc "u_tys yields no coercion" Outputable.empty - else traceTc "u_tys yields coercion:" (ppr co) - ; return co } - where - go :: TcType -> TcType -> TcM CoercionN - -- The arguments to 'go' are always semantically identical - -- to orig_ty{1,2} except for looking through type synonyms - - -- Unwrap casts before looking for variables. This way, we can easily - -- recognize (t |> co) ~ (t |> co), which is nice. Previously, we - -- didn't do it this way, and then the unification above was deferred. - go (CastTy t1 co1) t2 - = do { co_tys <- uType env t1 t2 - ; return (mkCoherenceLeftCo role t1 co1 co_tys) } - - go t1 (CastTy t2 co2) - = do { co_tys <- uType env t1 t2 - ; return (mkCoherenceRightCo role t2 co2 co_tys) } - - -- Variables; go for uUnfilledVar - -- Note that we pass in *original* (before synonym expansion), - -- so that type variables tend to get filled in with - -- the most informative version of the type - go (TyVarTy tv1) ty2 - = do { lookup_res <- isFilledMetaTyVar_maybe tv1 - ; case lookup_res of - Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) - ; uType env ty1 orig_ty2 } - Nothing -> uUnfilledVar env NotSwapped tv1 ty2 } - - go ty1 (TyVarTy tv2) - = do { lookup_res <- isFilledMetaTyVar_maybe tv2 - ; case lookup_res of - Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) - ; uType env orig_ty1 ty2 } - Nothing -> uUnfilledVar env IsSwapped tv2 ty1 } - - -- See Note [Unifying type synonyms] in GHC.Core.Unify - go ty1@(TyConApp tc1 []) (TyConApp tc2 []) - | tc1 == tc2 - = return $ mkReflCo role ty1 - - -- Now expand synonyms - -- See Note [Expanding synonyms during unification] - -- - -- Also NB that we recurse to 'go' so that we don't push a - -- new item on the origin stack. As a result if we have - -- type Foo = Int - -- and we try to unify Foo ~ Bool - -- we'll end up saying "can't match Foo with Bool" - -- rather than "can't match "Int with Bool". See #4535. - go ty1 ty2 - | Just ty1' <- coreView ty1 = go ty1' ty2 - | Just ty2' <- coreView ty2 = go ty1 ty2' - - -- Functions (t1 -> t2) just check the two parts - go (FunTy { ft_af = af1, ft_mult = w1, ft_arg = arg1, ft_res = res1 }) - (FunTy { ft_af = af2, ft_mult = w2, ft_arg = arg2, ft_res = res2 }) - | isVisibleFunArg af1 -- Do not attempt (c => t); just defer - , af1 == af2 -- Important! See #21530 - = do { co_w <- uType (env { u_role = funRole role SelMult }) w1 w2 - ; co_l <- uType (env { u_role = funRole role SelArg }) arg1 arg2 - ; co_r <- uType (env { u_role = funRole role SelRes }) res1 res2 - ; return $ mkNakedFunCo role af1 co_w co_l co_r } - - -- Always defer if a type synonym family (type function) - -- is involved. (Data families behave rigidly.) - go ty1@(TyConApp tc1 _) ty2 - | isTypeFamilyTyCon tc1 = defer ty1 ty2 - go ty1 ty2@(TyConApp tc2 _) - | isTypeFamilyTyCon tc2 = defer ty1 ty2 - - go (TyConApp tc1 tys1) (TyConApp tc2 tys2) - -- See Note [Mismatched type lists and application decomposition] - | tc1 == tc2, equalLength tys1 tys2 - , isInjectiveTyCon tc1 role -- don't look under newtypes at Rep equality - = assertPpr (isGenerativeTyCon tc1 role) (ppr tc1) $ - do { traceTc "go-tycon" (ppr tc1 $$ ppr tys1 $$ ppr tys2 $$ ppr (take 10 (tyConRoleListX role tc1))) - ; cos <- zipWith4M u_tc_arg (tyConVisibilities tc1) -- Infinite - (tyConRoleListX role tc1) -- Infinite - tys1 tys2 - ; return $ mkTyConAppCo role tc1 cos } - - go (LitTy m) ty@(LitTy n) - | m == n - = return $ mkReflCo role ty - - -- See Note [Care with type applications] - -- Do not decompose FunTy against App; - -- it's often a type error, so leave it for the constraint solver - go ty1@(AppTy s1 t1) ty2@(AppTy s2 t2) - = go_app (isNextArgVisible s1) ty1 s1 t1 ty2 s2 t2 - - go ty1@(AppTy s1 t1) ty2@(TyConApp tc2 ts2) - | Just (ts2', t2') <- snocView ts2 - = assert (not (tyConMustBeSaturated tc2)) $ - go_app (isNextTyConArgVisible tc2 ts2') - ty1 s1 t1 ty2 (TyConApp tc2 ts2') t2' - - go ty1@(TyConApp tc1 ts1) ty2@(AppTy s2 t2) - | Just (ts1', t1') <- snocView ts1 - = assert (not (tyConMustBeSaturated tc1)) $ - go_app (isNextTyConArgVisible tc1 ts1') - ty1 (TyConApp tc1 ts1') t1' ty2 s2 t2 - - go ty1@(CoercionTy co1) ty2@(CoercionTy co2) - = do { kco <- uType (mkKindEnv env ty1 ty2) - (coercionType co1) (coercionType co2) - ; return $ mkProofIrrelCo role kco co1 co2 } - - -- Anything else fails - -- E.g. unifying for-all types, which is relative unusual - go ty1 ty2 = defer ty1 ty2 - - ------------------ - defer ty1 ty2 -- See Note [Check for equality before deferring] - | ty1 `tcEqType` ty2 = return (mkReflCo role ty1) - | otherwise = uType_defer env orig_ty1 orig_ty2 - - - ------------------ - u_tc_arg is_vis role ty1 ty2 - = do { traceTc "u_tc_arg" (ppr role $$ ppr ty1 $$ ppr ty2) - ; uType env_arg ty1 ty2 } - where - env_arg = env { u_loc = adjustCtLoc is_vis False (u_loc env) - , u_role = role } - - ------------------ - -- For AppTy, decompose only nominal equalities - -- See Note [Decomposing AppTy equalities] in GHC.Tc.Solver.Equality - go_app vis ty1 s1 t1 ty2 s2 t2 - | Nominal <- role - = -- Unify arguments t1/t2 before function s1/s2, because - -- the former have smaller kinds, and hence simpler error messages - -- c.f. GHC.Tc.Solver.Equality.can_eq_app - -- Example: test T8603 - do { let env_arg = env { u_loc = adjustCtLoc vis False (u_loc env) } - ; co_t <- uType env_arg t1 t2 - ; co_s <- uType env s1 s2 - ; return $ mkAppCo co_s co_t } - | otherwise - = defer ty1 ty2 - -{- Note [Check for equality before deferring] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Particularly in ambiguity checks we can get equalities like (ty ~ ty). -If ty involves a type function we may defer, which isn't very sensible. -An egregious example of this was in test T9872a, which has a type signature - Proxy :: Proxy (Solutions Cubes) -Doing the ambiguity check on this signature generates the equality - Solutions Cubes ~ Solutions Cubes -and currently the constraint solver normalises both sides at vast cost. -This little short-cut in 'defer' helps quite a bit. - -Note [Care with type applications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Note: type applications need a bit of care! -They can match FunTy and TyConApp, so use splitAppTy_maybe -NB: we've already dealt with type variables and Notes, -so if one type is an App the other one jolly well better be too - -Note [Mismatched type lists and application decomposition] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we find two TyConApps, you might think that the argument lists -are guaranteed equal length. But they aren't. Consider matching - w (T x) ~ Foo (T x y) -We do match (w ~ Foo) first, but in some circumstances we simply create -a deferred constraint; and then go ahead and match (T x ~ T x y). -This came up in #3950. - -So either - (a) either we must check for identical argument kinds - when decomposing applications, - - (b) or we must be prepared for ill-kinded unification sub-problems - -Currently we adopt (b) since it seems more robust -- no need to maintain -a global invariant. - -Note [Expanding synonyms during unification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We expand synonyms during unification, but: - * We expand *after* the variable case so that we tend to unify - variables with un-expanded type synonym. This just makes it - more likely that the inferred types will mention type synonyms - understandable to the user - - * Similarly, we expand *after* the CastTy case, just in case the - CastTy wraps a variable. - - * We expand *before* the TyConApp case. For example, if we have - type Phantom a = Int - and are unifying - Phantom Int ~ Phantom Char - it is *wrong* to unify Int and Char. - - * The problem case immediately above can happen only with arguments - to the tycon. So we check for nullary tycons *before* expanding. - This is particularly helpful when checking (* ~ *), because * is - now a type synonym. See Note [Unifying type synonyms] in GHC.Core.Unify. - -Note [Deferred unification] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We may encounter a unification ty1 ~ ty2 that cannot be performed syntactically, -and yet its consistency is undetermined. Previously, there was no way to still -make it consistent. So a mismatch error was issued. - -Now these unifications are deferred until constraint simplification, where type -family instances and given equations may (or may not) establish the consistency. -Deferred unifications are of the form - F ... ~ ... -or x ~ ... -where F is a type function and x is a type variable. -E.g. - id :: x ~ y => x -> y - id e = e - -involves the unification x = y. It is deferred until we bring into account the -context x ~ y to establish that it holds. - -If available, we defer original types (rather than those where closed type -synonyms have already been expanded via tcCoreView). This is, as usual, to -improve error messages. - -************************************************************************ -* * - uUnfilledVar and friends -* * -************************************************************************ - -@uunfilledVar@ is called when at least one of the types being unified is a -variable. It does {\em not} assume that the variable is a fixed point -of the substitution; rather, notice that @uVar@ (defined below) nips -back into @uTys@ if it turns out that the variable is already bound. --} - ----------- -uUnfilledVar, uUnfilledVar1 - :: UnifyEnv - -> SwapFlag - -> TcTyVar -- Tyvar 1: not necessarily a meta-tyvar - -- definitely not a /filled/ meta-tyvar - -> TcTauType -- Type 2 - -> TcM CoercionN --- "Unfilled" means that the variable is definitely not a filled-in meta tyvar --- It might be a skolem, or untouchable, or meta -uUnfilledVar env swapped tv1 ty2 - | Nominal <- u_role env - = do { ty2 <- liftZonkM $ zonkTcType ty2 - -- Zonk to expose things to the occurs check, and so - -- that if ty2 looks like a type variable then it - -- /is/ a type variable - ; uUnfilledVar1 env swapped tv1 ty2 } - - | otherwise -- See Note [Do not unify representational equalities] - -- in GHC.Tc.Solver.Equality - = unSwap swapped (uType_defer env) (mkTyVarTy tv1) ty2 - -uUnfilledVar1 env -- Precondition: u_role==Nominal - swapped - tv1 - ty2 -- ty2 is zonked - | Just tv2 <- getTyVar_maybe ty2 - = go tv2 - - | otherwise - = uUnfilledVar2 env swapped tv1 ty2 - - where - -- 'go' handles the case where both are - -- tyvars so we might want to swap - -- E.g. maybe tv2 is a meta-tyvar and tv1 is not - go tv2 | tv1 == tv2 -- Same type variable => no-op - = return (mkNomReflCo (mkTyVarTy tv1)) - - | swapOverTyVars False tv1 tv2 -- Distinct type variables - -- Swap meta tyvar to the left if poss - = do { tv1 <- liftZonkM $ zonkTyCoVarKind tv1 - -- We must zonk tv1's kind because that might - -- not have happened yet, and it's an invariant of - -- uUnfilledTyVar2 that ty2 is fully zonked - -- Omitting this caused #16902 - ; uUnfilledVar2 env (flipSwap swapped) tv2 (mkTyVarTy tv1) } - - | otherwise - = uUnfilledVar2 env swapped tv1 ty2 - ----------- -uUnfilledVar2 :: UnifyEnv -- Precondition: u_role==Nominal - -> SwapFlag - -> TcTyVar -- Tyvar 1: not necessarily a meta-tyvar - -- definitely not a /filled/ meta-tyvar - -> TcTauType -- Type 2, zonked - -> TcM CoercionN -uUnfilledVar2 env@(UE { u_defer = def_eq_ref }) swapped tv1 ty2 - = do { cur_lvl <- getTcLevel - -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles - -- Here we don't know about given equalities here; so we treat - -- /any/ level outside this one as untouchable. Hence cur_lvl. - ; if not (touchabilityAndShapeTest cur_lvl tv1 ty2 - && simpleUnifyCheck UC_OnTheFly tv1 ty2) - then not_ok_so_defer cur_lvl - else - do { def_eqs <- readTcRef def_eq_ref -- Capture current state of def_eqs - - -- Attempt to unify kinds - -- When doing so, be careful to preserve orientation; - -- see Note [Kind Equality Orientation] in GHC.Tc.Solver.Equality - -- and wrinkle (W2) in Note [Fundeps with instances, and equality orientation] - -- in GHC.Tc.Solver.Dict - -- Failing to preserve orientation led to #25597. - ; let kind_env = unSwap swapped (mkKindEnv env) ty1 ty2 - ; co_k <- unSwap swapped (uType kind_env) (tyVarKind tv1) (typeKind ty2) - - ; traceTc "uUnfilledVar2 ok" $ - vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) - , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) - , ppr (isReflCo co_k), ppr co_k ] - - ; if isReflCo co_k - -- Only proceed if the kinds match - -- NB: tv1 should still be unfilled, despite the kind unification - -- because tv1 is not free in ty2' (or, hence, in its kind) - then do { liftZonkM $ writeMetaTyVar tv1 ty2 - ; case u_unified env of - Nothing -> return () - Just uref -> updTcRef uref (tv1 :) - ; return (mkNomReflCo ty2) } -- Unification is always Nominal - - else -- The kinds don't match yet, so defer instead. - do { writeTcRef def_eq_ref def_eqs - -- Since we are discarding co_k, also discard any constraints - -- emitted by kind unification; they are just useless clutter. - -- Do this dicarding by simply restoring the previous state - -- of def_eqs; a bit imperative/yukky but works fine. - ; defer } - }} - where - ty1 = mkTyVarTy tv1 - defer = unSwap swapped (uType_defer env) ty1 ty2 - - not_ok_so_defer cur_lvl = - do { traceTc "uUnfilledVar2 not ok" $ - vcat [ text "tv1:" <+> ppr tv1 - , text "ty2:" <+> ppr ty2 - , text "simple-unify-chk:" <+> ppr (simpleUnifyCheck UC_OnTheFly tv1 ty2) - , text "touchability:" <+> ppr (touchabilityAndShapeTest cur_lvl tv1 ty2)] - -- Occurs check or an untouchable: just defer - -- NB: occurs check isn't necessarily fatal: - -- eg tv1 occurred in type family parameter - ; defer } - -swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool -swapOverTyVars is_given tv1 tv2 - -- See Note [Unification variables on the left] - | not is_given, pri1 == 0, pri2 > 0 = True - | not is_given, pri2 == 0, pri1 > 0 = False - - -- Level comparison: see Note [TyVar/TyVar orientation] - | lvl1 `strictlyDeeperThan` lvl2 = False - | lvl2 `strictlyDeeperThan` lvl1 = True - - -- Priority: see Note [TyVar/TyVar orientation] - | pri1 > pri2 = False - | pri2 > pri1 = True - - -- Names: see Note [TyVar/TyVar orientation] - | isSystemName tv2_name, not (isSystemName tv1_name) = True - - | otherwise = False - - where - lvl1 = tcTyVarLevel tv1 - lvl2 = tcTyVarLevel tv2 - pri1 = lhsPriority tv1 - pri2 = lhsPriority tv2 - tv1_name = Var.varName tv1 - tv2_name = Var.varName tv2 - - -lhsPriority :: TcTyVar -> Int --- Higher => more important to be on the LHS --- => more likely to be eliminated --- Only used when the levels are identical --- See Note [TyVar/TyVar orientation] -lhsPriority tv - = assertPpr (isTyVar tv) (ppr tv) $ - case tcTyVarDetails tv of - RuntimeUnk -> 0 - SkolemTv {} -> 0 - MetaTv { mtv_info = info, mtv_tclvl = lvl } - | QLInstVar <- lvl - -> 5 -- Eliminate instantiation variables first - | otherwise - -> case info of - CycleBreakerTv -> 0 - TyVarTv -> 1 - ConcreteTv {} -> 2 - TauTv -> 3 - RuntimeUnkTv -> 4 - -{- Note [Unification preconditions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Question: given a homogeneous equality (alpha ~# ty), when is it OK to -unify alpha := ty? - -This note only applied to /homogeneous/ equalities, in which both -sides have the same kind. - -There are five reasons not to unify: - -1. (SKOL-ESC) Skolem-escape - Consider the constraint - forall[2] a[2]. alpha[1] ~ Maybe a[2] - If we unify alpha := Maybe a, the skolem 'a' may escape its scope. - The level alpha[1] says that alpha may be used outside this constraint, - where 'a' is not in scope at all. So we must not unify. - - Bottom line: when looking at a constraint alpha[n] := ty, do not unify - if any free variable of 'ty' has level deeper (greater) than n - -2. (UNTOUCHABLE) Untouchable unification variables - Consider the constraint - forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int - There is no (SKOL-ESC) problem with unifying alpha := Int, but it might - not be the principal solution. Perhaps the "right" solution is alpha := b. - We simply can't tell. See "OutsideIn(X): modular type inference with local - assumptions", section 2.2. We say that alpha[1] is "untouchable" inside - this implication. - - Bottom line: at ambient level 'l', when looking at a constraint - alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities - between levels 'n' and 'l'. - - Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? - Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet - -3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs - This precondition looks at the MetaInfo of the unification variable: - - * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a - TyVarTv it can only unify with a type variable, not with a - structured type. So if 'ty' is a structured type, such as (Maybe x), - don't unify. - - * CycleBreakerTv: never unified, except by restoreTyVarCycles. - -4. (CONCRETE) A ConcreteTv can only unify with a concrete type, - by definition. - - That is, if we have `rr[conc] ~ F Int`, we can't unify - `rr` with `F Int`, so we hold off on unifying. - Note however that the equality might get rewritten; for instance - if we can rewrite `F Int` to a concrete type, say `FloatRep`, - then we will have `rr[conc] ~ FloatRep` and we can unify `rr ~ FloatRep`. - - Note that we can still make progress on unification even if - we can't fully solve an equality, e.g. - - alpha[conc] ~# TupleRep '[ beta[tau], F gamma[tau] ] - - we can fill beta[tau] := beta[conc]. This is why we call - 'makeTypeConcrete' in startSolvingByUnification. - -5. (COERCION-HOLE) Confusing coercion holes - Suppose our equality is - (alpha :: k) ~ (Int |> {co}) - where co :: Type ~ k is an unsolved wanted. Note that this equality - is homogeneous; both sides have kind k. We refrain from unifying here, because - of the coercion hole in the RHS -- see Wrinkle (EIK2) in - Note [Equalities with incompatible kinds] in GHC.Solver.Equality. - -Needless to say, all there are wrinkles: - -* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free - in 'ty', where beta is a unification variable, and k>n? 'beta' - stands for a monotype, and since it is part of a level-n type - (equal to alpha[n]), we must /promote/ beta to level n. Just make - up a fresh gamma[n], and unify beta[k] := gamma[n]. - -* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n - TyVarTv (see Note [TyVarTv] in GHC.Tc.Types.TcMType)? Now - consider alpha[tyv,n] ~ Bool. We don't want to unify because that - would break the TyVarTv invariant. - - What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary - TauTv? Again, don't unify, because beta might later be unified - with, say Bool. (If levels permit, we reverse the orientation here; - see Note [TyVar/TyVar orientation].) - -* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how - do we know whether there are any given equalities between level n - and the ambient level? We answer in two ways: - - * In the eager unifier, we only unify if l=n. If not, alpha may be - untouchable, and defer to the constraint solver. This check is - made in GHC.Tc.Utils.uUnifilledVar2, in the guard - isTouchableMetaTyVar. - - * In the constraint solver, we track where Given equalities occur - and use that to guard unification in - GHC.Tc.Utils.Unify.touchabilityAndShapeTest. More details in - Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet - - Historical note: in the olden days (pre 2021) the constraint solver - also used to unify only if l=n. Equalities were "floated" out of the - implication in a separate step, so that they would become touchable. - But the float/don't-float question turned out to be very delicate, - as you can see if you look at the long series of Notes associated with - GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier - to unify in-place, with no floating. - -Note [TyVar/TyVar orientation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also Note [Fundeps with instances, and equality orientation] -where the kind equality orientation is important - -Given (a ~ b), should we orient the equality as (a~b) or (b~a)? -This is a surprisingly tricky question! - -The question is answered by swapOverTyVars, which is used - - in the eager unifier, in GHC.Tc.Utils.Unify.uUnfilledVar1 - - in the constraint solver, in GHC.Tc.Solver.Equality.canEqCanLHS2 - -First note: only swap if you have to! - See Note [Avoid unnecessary swaps] - -So we look for a positive reason to swap, using a three-step test: - -* Level comparison. If 'a' has deeper level than 'b', - put 'a' on the left. See Note [Deeper level on the left] - -* Priority. If the levels are the same, look at what kind of - type variable it is, using 'lhsPriority'. - - Generally speaking we always try to put a MetaTv on the left in - preference to SkolemTv or RuntimeUnkTv, because the MetaTv may be - touchable and can be unified. - - Tie-breaking rules for MetaTvs: - - CycleBreakerTv: This is essentially a stand-in for another type; - it's untouchable and should have the same priority as a skolem: 0. - - - TyVarTv: These can unify only with another tyvar, but we can't unify - a TyVarTv with a TauTv, because then the TyVarTv could (transitively) - get a non-tyvar type. So give these a low priority: 1. - - - ConcreteTv: These are like TauTv, except they can only unify with - a concrete type. So we want to be able to write to them, but not quite - as much as TauTvs: 2. - - - TauTv: This is the common case; we want these on the left so that they - can be written to: 3. - - - RuntimeUnkTv: These aren't really meta-variables used in type inference, - but just a convenience in the implementation of the GHCi debugger. - Eagerly write to these: 4. See Note [RuntimeUnkTv] in - GHC.Runtime.Heap.Inspect. - -* Names. If the level and priority comparisons are all - equal, try to eliminate a TyVar with a System Name in - favour of ones with a Name derived from a user type signature - -* Age. At one point in the past we tried to break any remaining - ties by eliminating the younger type variable, based on their - Uniques. See Note [Eliminate younger unification variables] - (which also explains why we don't do this any more) - -Note [Unification variables on the left] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For wanteds, but not givens, swap (skolem ~ meta-tv) regardless of -level, so that the unification variable is on the left. - -* We /don't/ want this for Givens because if we ave - [G] a[2] ~ alpha[1] - [W] Bool ~ a[2] - we want to rewrite the wanted to Bool ~ alpha[1], - so we can float the constraint and solve it. - -* But for Wanteds putting the unification variable on - the left means an easier job when floating, and when - reporting errors -- just fewer cases to consider. - - In particular, we get better skolem-escape messages: - see #18114 - -Note [Deeper level on the left] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The most important thing is that we want to put tyvars with -the deepest level on the left. The reason to do so differs for -Wanteds and Givens, but either way, deepest wins! Simple. - -* Wanteds. Putting the deepest variable on the left maximise the - chances that it's a touchable meta-tyvar which can be solved. - -* Givens. Suppose we have something like - forall a[2]. b[1] ~ a[2] => beta[1] ~ a[2] - - If we orient the Given a[2] on the left, we'll rewrite the Wanted to - (beta[1] ~ b[1]), and that can float out of the implication. - Otherwise it can't. By putting the deepest variable on the left - we maximise our changes of eliminating skolem capture. - - See also GHC.Tc.Solver.InertSet Note [Let-bound skolems] for another reason - to orient with the deepest skolem on the left. - - IMPORTANT NOTE: this test does a level-number comparison on - skolems, so it's important that skolems have (accurate) level - numbers. - -See #15009 for an further analysis of why "deepest on the left" -is a good plan. - -Note [Avoid unnecessary swaps] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we swap without actually improving matters, we can get an infinite loop. -Consider - work item: a ~ b - inert item: b ~ c -We canonicalise the work-item to (a ~ c). If we then swap it before -adding to the inert set, we'll add (c ~ a), and therefore kick out the -inert guy, so we get - new work item: b ~ c - inert item: c ~ a -And now the cycle just repeats - -Historical Note [Eliminate younger unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Given a choice of unifying - alpha := beta or beta := alpha -we try, if possible, to eliminate the "younger" one, as determined -by `ltUnique`. Reason: the younger one is less likely to appear free in -an existing inert constraint, and hence we are less likely to be forced -into kicking out and rewriting inert constraints. - -This is a performance optimisation only. It turns out to fix -#14723 all by itself, but clearly not reliably so! - -It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). -But, to my surprise, it didn't seem to make any significant difference -to the compiler's performance, so I didn't take it any further. Still -it seemed too nice to discard altogether, so I'm leaving these -notes. SLPJ Jan 18. - -Note [Prevent unification with type families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We prevent unification with type families because of an uneasy compromise. -It's perfectly sound to unify with type families, and it even improves the -error messages in the testsuite. It also modestly improves performance, at -least in some cases. But it's disastrous for test case perf/compiler/T3064. -Here is the problem: Suppose we have (F ty) where we also have [G] F ty ~ a. -What do we do? Do we reduce F? Or do we use the given? Hard to know what's -best. GHC reduces. This is a disaster for T3064, where the type's size -spirals out of control during reduction. If we prevent -unification with type families, then the solver happens to use the equality -before expanding the type family. - -It would be lovely in the future to revisit this problem and remove this -extra, unnecessary check. But we retain it for now as it seems to work -better in practice. - -Revisited in Nov '20, along with removing flattening variables. Problem -is still present, and the solution is still the same. - -Note [Non-TcTyVars in GHC.Tc.Utils.Unify] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Because the same code is now shared between unifying types and unifying -kinds, we sometimes will see proper TyVars floating around the unifier. -Example (from test case polykinds/PolyKinds12): - - type family Apply (f :: k1 -> k2) (x :: k1) :: k2 - type instance Apply g y = g y - -When checking the instance declaration, we first *kind-check* the LHS -and RHS, discovering that the instance really should be - - type instance Apply k3 k4 (g :: k3 -> k4) (y :: k3) = g y - -During this kind-checking, all the tyvars will be TcTyVars. Then, however, -as a second pass, we desugar the RHS (which is done in functions prefixed -with "tc" in GHC.Tc.TyCl"). By this time, all the kind-vars are proper -TyVars, not TcTyVars, get some kind unification must happen. - -Thus, we always check if a TyVar is a TcTyVar before asking if it's a -meta-tyvar. - -This used to not be necessary for type-checking (that is, before * :: *) -because expressions get desugared via an algorithm separate from -type-checking (with wrappers, etc.). Types get desugared very differently, -causing this wibble in behavior seen here. --} - --- | Breaks apart a function kind into its pieces. -matchExpectedFunKind - :: TypedThing -- ^ type, only for errors - -> Arity -- ^ n: number of desired arrows - -> TcKind -- ^ fun_kind - -> TcM Coercion -- ^ co :: fun_kind ~ (arg1 -> ... -> argn -> res) - -matchExpectedFunKind hs_ty n k = go n k - where - go 0 k = return (mkNomReflCo k) - - go n k | Just k' <- coreView k = go n k' - - go n k@(TyVarTy kvar) - | isMetaTyVar kvar - = do { maybe_kind <- readMetaTyVar kvar - ; case maybe_kind of - Indirect fun_kind -> go n fun_kind - Flexi -> defer n k } - - go n (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res }) - | isVisibleFunArg af - = do { co <- go (n-1) res - ; return (mkNakedFunCo Nominal af (mkNomReflCo w) (mkNomReflCo arg) co) } - - go n other - = defer n other - - defer n k - = do { arg_kinds <- newMetaKindVars n - ; res_kind <- newMetaKindVar - ; let new_fun = mkVisFunTysMany arg_kinds res_kind - origin = TypeEqOrigin { uo_actual = k - , uo_expected = new_fun - , uo_thing = Just hs_ty - , uo_visible = True - } - ; unifyTypeAndEmit KindLevel origin k new_fun } - -{- ********************************************************************* -* * - Checking alpha ~ ty - for the on-the-fly unifier -* * -********************************************************************* -} - -data UnifyCheckCaller - = UC_OnTheFly -- Called from the on-the-fly unifier - | UC_QuickLook -- Called from Quick Look - | UC_Solver -- Called from constraint solver - | UC_Defaulting -- Called when doing top-level defaulting - -simpleUnifyCheck :: UnifyCheckCaller -> TcTyVar -> TcType -> Bool --- simpleUnifyCheck does a fast check: True <=> unification is OK --- If it says 'False' then unification might still be OK, but --- it'll take more work to do -- use the full checkTypeEq --- --- * Rejects if lhs_tv occurs in rhs_ty (occurs check) --- * Rejects foralls unless --- lhs_tv is RuntimeUnk (used by GHCi debugger) --- or is a QL instantiation variable --- * Rejects a non-concrete type if lhs_tv is concrete --- * Rejects type families unless fam_ok=True --- * Does a level-check for type variables, to avoid skolem escape --- --- This function is pretty heavily used, so it's optimised not to allocate -simpleUnifyCheck caller lhs_tv rhs - = go rhs - where - - !(occ_in_ty, occ_in_co) = mkOccFolders lhs_tv - - lhs_tv_lvl = tcTyVarLevel lhs_tv - lhs_tv_is_concrete = isConcreteTyVar lhs_tv - - forall_ok = case caller of - UC_QuickLook -> isQLInstTyVar lhs_tv - _ -> isRuntimeUnkTyVar lhs_tv - - -- This fam_ok thing relates to a very specific perf problem - -- See Note [Prevent unification with type families] - -- A couple of QuickLook regression tests rely on unifying with type - -- families, so we let it through there (not very principled, but let's - -- see if it bites us) - fam_ok = case caller of - UC_Solver -> True - UC_QuickLook -> True - UC_OnTheFly -> False - UC_Defaulting -> True - - go (TyVarTy tv) - | lhs_tv == tv = False - | tcTyVarLevel tv `strictlyDeeperThan` lhs_tv_lvl = False - | lhs_tv_is_concrete, not (isConcreteTyVar tv) = False - | occ_in_ty $! (tyVarKind tv) = False - | otherwise = True - - go (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) - | not forall_ok, isInvisibleFunArg af = False - | otherwise = go w && go a && go r - - go (TyConApp tc tys) - | lhs_tv_is_concrete, not (isConcreteTyCon tc) = False - | not forall_ok, not (isTauTyCon tc) = False - | not fam_ok, not (isFamFreeTyCon tc) = False - | otherwise = all go tys - - go (ForAllTy (Bndr tv _) ty) - | forall_ok = go (tyVarKind tv) && (tv == lhs_tv || go ty) - | otherwise = False - - go (AppTy t1 t2) = go t1 && go t2 - go (CastTy ty co) = not (occ_in_co co) && go ty - go (CoercionTy co) = not (occ_in_co co) - go (LitTy {}) = True - - -mkOccFolders :: TcTyVar -> (TcType -> Bool, TcCoercion -> Bool) --- These functions return True --- * if lhs_tv occurs (incl deeply, in the kind of variable) --- * if there is a coercion hole --- No expansion of type synonyms -mkOccFolders lhs_tv = (getAny . check_ty, getAny . check_co) - where - !(check_ty, _, check_co, _) = foldTyCo occ_folder emptyVarSet - occ_folder = TyCoFolder { tcf_view = noView -- Don't expand synonyms - , tcf_tyvar = do_tcv, tcf_covar = do_tcv - , tcf_hole = do_hole - , tcf_tycobinder = do_bndr } - - do_tcv is v = Any (not (v `elemVarSet` is) && v == lhs_tv) - `mappend` check_ty (varType v) - - do_bndr is tcv _faf = extendVarSet is tcv - do_hole _is _hole = DM.Any True -- Reject coercion holes - -{- ********************************************************************* -* * - Equality invariant checking -* * -********************************************************************* -} - - -{- Note [Checking for foralls] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We never want to unify - alpha ~ (forall a. a->a) -> Int -So we look for foralls hidden inside the type, and it's convenient -to do that at the same time as the occurs check (which looks for -occurrences of alpha). - -However, it's not just a question of looking for foralls /anywhere/! -Consider - (alpha :: forall k. k->*) ~ (beta :: forall k. k->*) -This is legal; e.g. dependent/should_compile/T11635. - -We don't want to reject it because of the forall in beta's kind, but -(see Note [Occurrence checking: look inside kinds] in GHC.Core.Type) -we do need to look in beta's kind. So we carry a flag saying if a -'forall' is OK, and switch the flag on when stepping inside a kind. - -Why is it OK? Why does it not count as impredicative polymorphism? -The reason foralls are bad is because we reply on "seeing" foralls -when doing implicit instantiation. But the forall inside the kind is -fine. We'll generate a kind equality constraint - (forall k. k->*) ~ (forall k. k->*) -to check that the kinds of lhs and rhs are compatible. If alpha's -kind had instead been - (alpha :: kappa) -then this kind equality would rightly complain about unifying kappa -with (forall k. k->*) - -Note [Forgetful synonyms in checkTyConApp] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - type S a b = b -- Forgets 'a' - - [W] alpha[2] ~ Maybe (S beta[4] gamma[2]) - -We don't want to promote beta to level 2; rather, we should -expand the synonym. (Currently, in checkTypeEqRhs promotion -is irrevocable, by side effect.) - -To avoid this risk we eagerly expand forgetful synonyms. -This also means we won't get an occurs check in - a ~ Maybe (S a b) - -The annoyance is that we might expand the synonym unnecessarily, -something we generally try to avoid. But for now, this seems -simple. - -In a forgetful case like a ~ Maybe (S a b), `checkTyEqRhs` returns -a Reduction that looks - Reduction { reductionCoercion = Refl - , reductionReducedType = Maybe b } -We must jolly well use that reductionReduced type, even though the -reductionCoercion is Refl. See `canEqCanLHSFinish_no_unification`. --} - -data PuResult a b = PuFail CheckTyEqResult - | PuOK (Bag a) b - -instance Functor (PuResult a) where - fmap _ (PuFail prob) = PuFail prob - fmap f (PuOK cts x) = PuOK cts (f x) - -instance Applicative (PuResult a) where - pure x = PuOK emptyBag x - PuFail p1 <*> PuFail p2 = PuFail (p1 S.<> p2) - PuFail p1 <*> PuOK {} = PuFail p1 - PuOK {} <*> PuFail p2 = PuFail p2 - PuOK c1 f <*> PuOK c2 x = PuOK (c1 `unionBags` c2) (f x) - -instance (Outputable a, Outputable b) => Outputable (PuResult a b) where - ppr (PuFail prob) = text "PuFail" <+> (ppr prob) - ppr (PuOK cts x) = text "PuOK" <> braces - (vcat [ text "redn:" <+> ppr x - , text "cts:" <+> ppr cts ]) - -pprPur :: PuResult a b -> SDoc --- For debugging -pprPur (PuFail prob) = text "PuFail:" <> ppr prob -pprPur (PuOK {}) = text "PuOK" - -okCheckRefl :: TcType -> TcM (PuResult a Reduction) -okCheckRefl ty = return (PuOK emptyBag (mkReflRedn Nominal ty)) - -failCheckWith :: CheckTyEqResult -> TcM (PuResult a b) -failCheckWith p = return (PuFail p) - -mapCheck :: (x -> TcM (PuResult a Reduction)) - -> [x] - -> TcM (PuResult a Reductions) -mapCheck f xs - = do { (ress :: [PuResult a Reduction]) <- mapM f xs - ; return (unzipRedns <$> sequenceA ress) } - -- sequenceA :: [PuResult a Reduction] -> PuResult a [Reduction] - -- unzipRedns :: [Reduction] -> Reductions - ------------------------------ --- | Options describing how to deal with a type equality --- in the pure unifier. See 'checkTyEqRhs' -data TyEqFlags a - = TEF { tef_foralls :: Bool -- Allow foralls - , tef_lhs :: CanEqLHS -- LHS of the constraint - , tef_unifying :: AreUnifying -- Always NotUnifying if tef_lhs is TyFamLHS - , tef_fam_app :: TyEqFamApp a - , tef_occurs :: CheckTyEqProblem } -- Soluble or insoluble occurs check - --- | What to do when encountering a type-family application while processing --- a type equality in the pure unifier. --- --- See Note [Family applications in canonical constraints] -data TyEqFamApp a - = TEFA_Fail -- Always fail - | TEFA_Recurse -- Just recurse - | TEFA_Break (FamAppBreaker a) -- Recurse, but replace with cycle breaker if fails, - -- using the FamAppBreaker - -data AreUnifying - = Unifying - MetaInfo -- MetaInfo of the LHS tyvar (which is a meta-tyvar) - TcLevel -- Level of the LHS tyvar - LevelCheck - - | NotUnifying -- Not attempting to unify - -data LevelCheck - = LC_None -- Level check not needed: we should never encounter - -- a tyvar at deeper level than the LHS - - | LC_Check -- Do a level check between the LHS tyvar and the occurrence tyvar - -- Fail if the level check fails - - | LC_Promote -- Do a level check between the LHS tyvar and the occurrence tyvar - -- If the level check fails, and the occurrence is a unification - -- variable, promote it - Bool -- False <=> don't promote under type families (the common case) - -- True <=> promote even under type families - -- see Note [Defaulting equalities] in GHC.Tc.Solver - -instance Outputable (TyEqFlags a) where - ppr (TEF { .. }) = text "TEF" <> braces ( - vcat [ text "tef_foralls =" <+> ppr tef_foralls - , text "tef_lhs =" <+> ppr tef_lhs - , text "tef_unifying =" <+> ppr tef_unifying - , text "tef_fam_app =" <+> ppr tef_fam_app - , text "tef_occurs =" <+> ppr tef_occurs ]) - -instance Outputable (TyEqFamApp a) where - ppr TEFA_Fail = text "TEFA_Fail" - ppr TEFA_Recurse = text "TEFA_Recurse" - ppr (TEFA_Break {}) = text "TEFA_Break" - -instance Outputable AreUnifying where - ppr NotUnifying = text "NotUnifying" - ppr (Unifying mi lvl lc) = text "Unifying" <+> - braces (ppr mi <> comma <+> ppr lvl <> comma <+> ppr lc) - -instance Outputable LevelCheck where - ppr LC_None = text "LC_None" - ppr LC_Check = text "LC_Check" - ppr (LC_Promote b) = text "LC_Promote" <> ppWhen b (text "(deep)") - -famAppArgFlags :: TyEqFlags a -> TyEqFlags a --- Adjust the flags when going undter a type family --- Only the outer family application gets the loop-breaker treatment --- Ditto tyvar promotion. E.g. --- [W] alpha[2] ~ Maybe (F beta[3]) --- Do not promote beta[3]; instead promote (F beta[3]) -famAppArgFlags flags@(TEF { tef_unifying = unifying }) - = flags { tef_fam_app = TEFA_Recurse - , tef_unifying = zap_promotion unifying - , tef_occurs = cteSolubleOccurs } - -- tef_occurs: under a type family, an occurs check is not definitely-insoluble - where - zap_promotion (Unifying info lvl (LC_Promote deeply)) - | not deeply = Unifying info lvl LC_Check - zap_promotion unifying = unifying - -type FamAppBreaker a = TcType -> TcM (PuResult a Reduction) - -- Given a family-application ty, return a Reduction :: ty ~ cvb - -- where 'cbv' is a fresh loop-breaker tyvar (for Given), or - -- just a fresh TauTv (for Wanted) - -checkTyEqRhs :: forall a. TyEqFlags a - -> TcType -- Already zonked - -> TcM (PuResult a Reduction) -checkTyEqRhs flags ty - = case ty of - LitTy {} -> okCheckRefl ty - TyConApp tc tys -> checkTyConApp flags ty tc tys - TyVarTy tv -> checkTyVar flags tv - -- Don't worry about foralls inside the kind; see Note [Checking for foralls] - -- Nor can we expand synonyms; see Note [Occurrence checking: look inside kinds] - -- in GHC.Core.FVs - - FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r} - | isInvisibleFunArg af -- e.g. Num a => blah - , not (tef_foralls flags) - -> failCheckWith impredicativeProblem -- Not allowed (TyEq:F) - | otherwise - -> do { w_res <- checkTyEqRhs flags w - ; a_res <- checkTyEqRhs flags a - ; r_res <- checkTyEqRhs flags r - ; return (mkFunRedn Nominal af <$> w_res <*> a_res <*> r_res) } - - AppTy fun arg -> do { fun_res <- checkTyEqRhs flags fun - ; arg_res <- checkTyEqRhs flags arg - ; return (mkAppRedn <$> fun_res <*> arg_res) } - - CastTy ty co -> do { ty_res <- checkTyEqRhs flags ty - ; co_res <- checkCo flags co - ; return (mkCastRedn1 Nominal ty <$> co_res <*> ty_res) } - - CoercionTy co -> do { co_res <- checkCo flags co - ; return (mkReflCoRedn Nominal <$> co_res) } - - ForAllTy {} - | tef_foralls flags -> okCheckRefl ty - | otherwise -> failCheckWith impredicativeProblem -- Not allowed (TyEq:F) - - -------------------- -checkCo :: TyEqFlags a -> Coercion -> TcM (PuResult a Coercion) --- See Note [checkCo] -checkCo (TEF { tef_lhs = TyFamLHS {} }) co - = return (pure co) - -checkCo (TEF { tef_lhs = TyVarLHS lhs_tv - , tef_unifying = unifying - , tef_occurs = occ_prob }) co - -- Check for coercion holes, if unifying - -- See (COERCION-HOLE) in Note [Unification preconditions] - | hasCoercionHoleCo co - = failCheckWith (cteProblem cteCoercionHole) - - -- Occurs check (can promote) - | Unifying _ lhs_tv_lvl (LC_Promote {}) <- unifying - = do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) - ; if cterHasNoProblem reason - then return (pure co) - else failCheckWith reason } - - -- Occurs check (no promotion) - | lhs_tv `elemVarSet` tyCoVarsOfCo co - = failCheckWith (cteProblem occ_prob) - - | otherwise - = return (pure co) - -{- Note [checkCo] -~~~~~~~~~~~~~~~~~ -We don't often care about the contents of coercions, so checking -coercions before making an equality constraint may be surprising. -But there are several cases we need to be wary of: - -(1) When we're unifying a variable, we must make sure that the variable - appears nowhere on the RHS -- even in a coercion. Otherwise, we'll - create a loop. - -(2) We must still make sure that no variable in a coercion is at too - high a level. But, when unifying, we can promote any variables we encounter. - -(3) We do not unify variables with a type with a free coercion hole. - See (COERCION-HOLE) in Note [Unification preconditions]. - - -Note [Promotion and level-checking] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -"Promotion" happens when we have this: - - [W] w1: alpha[2] ~ Maybe beta[4] - -Here we must NOT unify alpha := Maybe beta, because beta may turn out -to stand for a type involving some inner skolem. Yikes! -Skolem-escape. So instead we /promote/ beta, like this: - - beta[4] := beta'[2] - [W] w1: alpha[2] ~ Maybe beta'[2] - -Now we can unify alpha := Maybe beta', which might unlock other -constraints. But if some other constraint wants to unify beta with a -nested skolem, it'll get stuck with a skolem-escape error. - -Now consider `w2` where a type family is involved (#22194): - - [W] w2: alpha[2] ~ Maybe (F gamma beta[4]) - -In `w2`, it may or may not be the case that `beta` is level 2; suppose -we later discover gamma := Int, and type instance F Int _ = Int. -So, instead, we promote the entire funcion call: - - [W] w2': alpha[2] ~ Maybe gamma[2] - [W] w3: gamma[2] ~ F gamma beta[4] - -Now we can unify alpha := Maybe gamma, which is a Good Thng. - -Wrinkle (W1) - -There is an important wrinkle: /all this only applies when unifying/. -For example, suppose we have - [G] a[2] ~ Maybe b[4] -where 'a' is a skolem. This Given might arise from a GADT match, and -we can absolutely use it to rewrite locally. In fact we must do so: -that is how we exploit local knowledge about the outer skolem a[2]. -This applies equally for a Wanted [W] a[2] ~ Maybe b[4]. Using it for -local rewriting is fine. (It's not clear to me that it is /useful/, -but it's fine anyway.) - -So we only do the level-check in checkTyVar when /unifying/ not for -skolems (or untouchable unification variables). - -Note [Family applications in canonical constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A constraint with a type family application in the RHS needs special care. - -* First, occurs checks. If we have - [G] a ~ Maybe (F (Maybe a)) - [W] alpha ~ Maybe (F (Maybe alpha)) - it looks as if we have an occurs check. But go read - Note [Type equality cycles] in GHC.Tc.Solver.Equality - - The same considerations apply when the LHS is a type family: - [G] G a ~ Maybe (F (Maybe (G a))) - [W] G alpha ~ Maybe (F (Maybe (G alpha))) - -* Second, promotion. If we have (#22194) - [W] alpha[2] ~ Maybe (F beta[4]) - it is wrong to promote beta. Instead we want to split to - [W] alpha[2] ~ Maybe gamma[2] - [W] gamma[2] ~ F beta[4] - See Note [Promotion and level-checking] above. - -* Third, concrete type variables. If we have - [W] alpha[conc] ~ Maybe (F tys) - we want to add an extra variable thus: - [W] alpha[conc] ~ Maybe gamma[conc] - [W] gamma[conc] ~ F tys - Now we can unify alpha, and that might unlock something else. - -In all these cases we want to create a fresh type variable, and -emit a new equality connecting it to the type family application. - -The `tef_fam_app` field of `TypeEqFlags` says what to do at a type -family application in the RHS of the constraint. `TEFA_Fail` and -`TEFA_Recurse` are straightforward. `TEFA_Break` is the clever -one. As you can see in `checkFamApp`, it - * Checks the arguments, but using `famAppArgFlags` to record that - we are now "under" a type-family application. It `tef_fam_app` to - `TEFA_Recurse`. - * If any of the arguments fail (level-check error, occurs check) - use the `FamAppBreaker` to create the extra binding. - -Note that this always cycle-breaks the /outermost/ family application. -If we have [W] alpha ~ Maybe (F (G alpha)) -* We'll use checkFamApp on `(F (G alpha))` -* It will recurse into `(G alpha)` with TEFA_Recurse, but not cycle-break it -* The occurs check will fire when we hit `alpha` -* `checkFamApp` on `(F (G alpha))` will see the failure and invoke - the `FamAppBreaker`. --} - -------------------- -checkTyConApp :: TyEqFlags a - -> TcType -> TyCon -> [TcType] - -> TcM (PuResult a Reduction) -checkTyConApp flags@(TEF { tef_unifying = unifying, tef_foralls = foralls_ok }) - tc_app tc tys - | isTypeFamilyTyCon tc - , let arity = tyConArity tc - = if tys `lengthIs` arity - then checkFamApp flags tc_app tc tys -- Common case - else do { let (fun_args, extra_args) = splitAt (tyConArity tc) tys - fun_app = mkTyConApp tc fun_args - ; fun_res <- checkFamApp flags fun_app tc fun_args - ; extra_res <- mapCheck (checkTyEqRhs flags) extra_args - ; traceTc "Over-sat" (ppr tc <+> ppr tys $$ ppr arity $$ pprPur fun_res $$ pprPur extra_res) - ; return (mkAppRedns <$> fun_res <*> extra_res) } - - | Just ty' <- rewriterView tc_app - -- e.g. S a where type S a = F [a] - -- or type S a = Int - -- See Note [Forgetful synonyms in checkTyConApp] - = checkTyEqRhs flags ty' - - | not (isTauTyCon tc || foralls_ok) - = failCheckWith impredicativeProblem - - | Unifying info _ _ <- unifying - , isConcreteInfo info - , not (isConcreteTyCon tc) - = failCheckWith (cteProblem cteConcrete) - - | otherwise -- Recurse on arguments - = recurseIntoTyConApp flags tc tys - -recurseIntoTyConApp :: TyEqFlags a -> TyCon -> [TcType] -> TcM (PuResult a Reduction) -recurseIntoTyConApp flags tc tys - = do { tys_res <- mapCheck (checkTyEqRhs flags) tys - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } - -------------------- -checkFamApp :: TyEqFlags a - -> TcType -> TyCon -> [TcType] -- Saturated family application - -> TcM (PuResult a Reduction) --- See Note [Family applications in canonical constraints] -checkFamApp flags@(TEF { tef_unifying = unifying, tef_occurs = occ_prob - , tef_fam_app = fam_app_flag, tef_lhs = lhs }) - fam_app tc tys - = case fam_app_flag of - TEFA_Fail -> failCheckWith (cteProblem cteTypeFamily) - - -- Occurs check: F ty ~ ...(F ty)... - _ | TyFamLHS lhs_tc lhs_tys <- lhs - , tcEqTyConApps lhs_tc lhs_tys tc tys - -> case fam_app_flag of - TEFA_Recurse -> failCheckWith (cteProblem occ_prob) - TEFA_Break breaker -> breaker fam_app - - _ | Unifying lhs_info _ _ <- unifying - , isConcreteInfo lhs_info - -> case fam_app_flag of - TEFA_Recurse -> failCheckWith (cteProblem cteConcrete) - TEFA_Break breaker -> breaker fam_app - - TEFA_Recurse - -> do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys - ; traceTc "under" (ppr tc $$ pprPur tys_res $$ ppr flags) - ; return (mkTyConAppRedn Nominal tc <$> tys_res) } - - -- For TEFA_Break, try recursion; and break if there is a problem - -- e.g. alpha[2] ~ Maybe (F beta[2]) No problem: just unify - -- alpha[2] ~ Maybe (F beta[4]) Level-check problem: break - -- NB: in the latter case, don't promote beta[4]; hence arg_flags! - TEFA_Break breaker - -> do { tys_res <- mapCheck (checkTyEqRhs arg_flags) tys - ; case tys_res of - PuOK cts redns -> return (PuOK cts (mkTyConAppRedn Nominal tc redns)) - PuFail {} -> breaker fam_app } - where - arg_flags = famAppArgFlags flags - -------------------- -checkTyVar :: forall a. TyEqFlags a -> TcTyVar -> TcM (PuResult a Reduction) -checkTyVar (TEF { tef_lhs = lhs, tef_unifying = unifying, tef_occurs = occ_prob }) occ_tv - = case lhs of - TyFamLHS {} -> success -- Nothing to do if the LHS is a type-family - TyVarLHS lhs_tv -> check_tv unifying lhs_tv - where - lvl_occ = tcTyVarLevel occ_tv - success = okCheckRefl (mkTyVarTy occ_tv) - - --------------------- - check_tv NotUnifying lhs_tv - = simple_occurs_check lhs_tv - -- We need an occurs-check here, but no level check - -- See Note [Promotion and level-checking] wrinkle (W1) - - check_tv (Unifying info lvl prom) lhs_tv - = do { mb_done <- isFilledMetaTyVar_maybe occ_tv - ; case mb_done of - Just {} -> success - -- Already promoted; job done - -- Example alpha[2] ~ Maybe (beta[4], beta[4]) - -- We promote the first occurrence, and then encounter it - -- a second time; we don't want to re-promote it! - -- Remember, the entire process started with a fully zonked type - - Nothing -> check_unif info lvl prom lhs_tv } - - --------------------- - -- We are in the Unifying branch of AreUnifying; and occ_tv is unfilled - check_unif :: MetaInfo -> TcLevel -> LevelCheck - -> TcTyVar -> TcM (PuResult a Reduction) - check_unif lhs_tv_info lhs_tv_lvl prom lhs_tv - | isConcreteInfo lhs_tv_info - , not (isConcreteTyVar occ_tv) - = if can_make_concrete occ_tv - then promote lhs_tv lhs_tv_info lhs_tv_lvl - else failCheckWith (cteProblem cteConcrete) - - | lvl_occ `strictlyDeeperThan` lhs_tv_lvl - = case prom of - LC_None -> pprPanic "check_unif" (ppr lhs_tv $$ ppr occ_tv) - LC_Check -> failCheckWith (cteProblem cteSkolemEscape) - LC_Promote {} - | isSkolemTyVar occ_tv -> failCheckWith (cteProblem cteSkolemEscape) - | otherwise -> promote lhs_tv lhs_tv_info lhs_tv_lvl - - | otherwise - = simple_occurs_check lhs_tv - - --------------------- - simple_occurs_check lhs_tv - | lhs_tv == occ_tv || check_kind (tyVarKind occ_tv) - = failCheckWith (cteProblem occ_prob) - | otherwise - = success - where - (check_kind, _) = mkOccFolders lhs_tv - - --------------------- - can_make_concrete occ_tv = case tcTyVarDetails occ_tv of - MetaTv { mtv_info = info } -> case info of - ConcreteTv {} -> True - TauTv {} -> True - _ -> False - _ -> False -- Don't attempt to make other type variables concrete - -- (e.g. SkolemTv, TyVarTv, CycleBreakerTv, RuntimeUnkTv). - - --------------------- - -- occ_tv is definitely a MetaTyVar - promote lhs_tv lhs_tv_info lhs_tv_lvl - | MetaTv { mtv_info = info_occ, mtv_tclvl = lvl_occ } <- tcTyVarDetails occ_tv - = do { let new_info | isConcreteInfo lhs_tv_info = lhs_tv_info - | otherwise = info_occ - new_lvl = lhs_tv_lvl `minTcLevel` lvl_occ - -- c[conc,3] ~ p[tau,2]: want to clone p:=p'[conc,2] - -- c[tau,2] ~ p[tau,3]: want to clone p:=p'[tau,2] - - -- Check the kind of occ_tv - ; reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfType (tyVarKind occ_tv)) - - ; if cterHasNoProblem reason -- Successfully promoted - then do { new_tv_ty <- promote_meta_tyvar new_info new_lvl occ_tv - ; okCheckRefl new_tv_ty } - else failCheckWith reason } - - | otherwise = pprPanic "promote" (ppr occ_tv) - -------------------------- -checkPromoteFreeVars :: CheckTyEqProblem -- What occurs check problem to report - -> TcTyVar -> TcLevel - -> TyCoVarSet -> TcM CheckTyEqResult --- Check this set of TyCoVars for --- (a) occurs check --- (b) promote if necessary, or report skolem escape -checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl vs - = do { oks <- mapM do_one (nonDetEltsUniqSet vs) - ; return (mconcat oks) } - where - do_one :: TyCoVar -> TcM CheckTyEqResult - do_one v | isCoVar v = return cteOK - | lhs_tv == v = return (cteProblem occ_prob) - | no_promotion = return cteOK - | not (isMetaTyVar v) = return (cteProblem cteSkolemEscape) - | otherwise = promote_one v - where - no_promotion = not (tcTyVarLevel v `strictlyDeeperThan` lhs_tv_lvl) - - -- isCoVar case: coercion variables are not an escape risk - -- If an implication binds a coercion variable, it'll have equalities, - -- so the "intervening given equalities" test above will catch it - -- Coercion holes get filled with coercions, so again no problem. - - promote_one tv = do { _ <- promote_meta_tyvar TauTv lhs_tv_lvl tv - ; return cteOK } - -promote_meta_tyvar :: MetaInfo -> TcLevel -> TcTyVar -> TcM TcType -promote_meta_tyvar info dest_lvl occ_tv - = do { -- Check whether occ_tv is already unified. The rhs-type - -- started zonked, but we may have promoted one of its type - -- variables, and we then encounter it for the second time. - -- But if so, it'll definitely be another already-checked TyVar - mb_filled <- isFilledMetaTyVar_maybe occ_tv - ; case mb_filled of { - Just ty -> return ty ; - Nothing -> - - -- OK, not done already, so clone/promote it - do { new_tv <- cloneMetaTyVarWithInfo info dest_lvl occ_tv - ; liftZonkM $ writeMetaTyVar occ_tv (mkTyVarTy new_tv) - ; traceTc "promoteTyVar" (ppr occ_tv <+> text "-->" <+> ppr new_tv) - ; return (mkTyVarTy new_tv) } } } - - - -------------------------- -touchabilityAndShapeTest :: TcLevel -> TcTyVar -> TcType -> Bool --- This is the key test for untouchability: --- See Note [Unification preconditions] in GHC.Tc.Utils.Unify --- and Note [Solve by unification] in GHC.Tc.Solver.Equality --- True <=> touchability and shape are OK -touchabilityAndShapeTest given_eq_lvl tv rhs - | MetaTv { mtv_info = info, mtv_tclvl = tv_lvl } <- tcTyVarDetails tv - , tv_lvl `deeperThanOrSame` given_eq_lvl - , checkTopShape info rhs - = True - | otherwise - = False - -------------------------- --- | checkTopShape checks (TYVAR-TV) --- Note [Unification preconditions]; returns True if these conditions --- are satisfied. But see the Note for other preconditions, too. -checkTopShape :: MetaInfo -> TcType -> Bool -checkTopShape info xi - = case info of - TyVarTv -> - case getTyVar_maybe xi of -- Looks through type synonyms - Nothing -> False - Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle - SkolemTv {} -> True - RuntimeUnk -> True - MetaTv { mtv_info = TyVarTv } -> True - _ -> False - CycleBreakerTv -> False -- We never unify these - _ -> True +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE RecursiveDo #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +{- +(c) The University of Glasgow 2006 +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +-} + +-- | Type subsumption and unification +module GHC.Tc.Utils.Unify ( + -- Full-blown subsumption + tcWrapResult, tcWrapResultO, tcWrapResultMono, + tcSubType, tcSubTypeSigma, tcSubTypePat, tcSubTypeDS, + addSubTypeCtxt, + tcSubTypeAmbiguity, tcSubMult, + checkConstraints, checkTvConstraints, + buildImplicationFor, buildTvImplication, emitResidualTvConstraint, + + -- Skolemisation + DeepSubsumptionFlag(..), getDeepSubsumptionFlag, isRhoTyDS, + tcSkolemise, tcSkolemiseCompleteSig, tcSkolemiseExpectedType, + dsInstantiate, + + -- Various unifications + unifyType, unifyKind, unifyInvisibleType, + unifyExprType, unifyTypeAndEmit, promoteTcType, + swapOverTyVars, touchabilityTest, checkTopShape, lhsPriority, + UnifyEnv(..), updUEnvLoc, setUEnvRole, + uType, + mightEqualLater, + makeTypeConcrete, + + -------------------------------- + -- Holes + matchExpectedListTy, + matchExpectedTyConApp, + matchExpectedAppTy, + matchExpectedFunTys, + matchExpectedFunKind, + matchActualFunTy, matchActualFunTys, + + checkTyEqRhs, recurseIntoTyConApp, recurseIntoFamTyConApp, + PuResult(..), okCheckRefl, mapCheck, + TyEqFlags(..), + notUnifying_TEFTask, unifyingLHSMetaTyVar_TEFTask, defaulting_TEFTask, + pureTyEqFlags_LHSMetaTyVar, mkTEFA_Break, + + OccursCheck(..), LevelCheck(..), ConcreteCheck(..), + TyEqFamApp(..), FamAppBreaker(..), + checkPromoteFreeVars, + + simpleUnifyCheck, UnifyCheckCaller(..), SimpleUnifyResult(..), + + fillInferResult, fillInferResultNoInst + ) where + +import GHC.Prelude + +import GHC.Hs + +import GHC.Tc.Errors.Types ( ErrCtxtMsg(..) ) +import GHC.Tc.Errors.Ppr ( pprErrCtxtMsg ) +import GHC.Tc.Utils.Concrete +import GHC.Tc.Utils.Env +import GHC.Tc.Utils.Instantiate +import GHC.Tc.Utils.Monad +import GHC.Tc.Utils.TcMType +import GHC.Tc.Utils.TcType +import GHC.Tc.Types.Evidence +import GHC.Tc.Types.Constraint +import GHC.Tc.Types.CtLoc( CtLoc, mkKindEqLoc, adjustCtLoc, updateCtLocOrigin, ctLocOrigin ) +import GHC.Tc.Types.Origin +import GHC.Tc.Zonk.TcType +import GHC.Tc.Utils.TcMType qualified as TcM + +import GHC.Tc.Solver.InertSet + +import GHC.Core.Type +import GHC.Core.TyCo.Rep hiding (Refl) +import GHC.Core.TyCo.FVs( isInjectiveInType ) +import GHC.Core.TyCo.Ppr( debugPprType {- pprTyVar -} ) +import GHC.Core.TyCon +import GHC.Core.Coercion +import GHC.Core.Unify +import GHC.Core.Predicate( EqRel(..), mkEqPredRole, mkNomEqPred ) +import GHC.Core.Multiplicity +import GHC.Core.Reduction + +import qualified GHC.LanguageExtensions as LangExt + +import GHC.Builtin.Types +import GHC.Types.Name +import GHC.Types.Id( idType ) +import GHC.Types.Var as Var +import GHC.Types.Var.Set +import GHC.Types.Var.Env +import GHC.Types.Basic +import GHC.Types.Unique.Set (nonDetEltsUniqSet) + +import GHC.Utils.Misc +import GHC.Utils.Outputable as Outputable +import GHC.Utils.Panic + +import GHC.Driver.DynFlags + +import GHC.Data.Bag +import GHC.Data.FastString +import GHC.Data.Maybe (firstJusts) + +import Control.Monad +import Data.Functor.Identity (Identity(..)) +import qualified Data.List.NonEmpty as NE +import Data.Monoid as DM ( Any(..) ) +import qualified Data.Semigroup as S ( (<>) ) +import Data.Traversable (for) + +{- ********************************************************************* +* * + matchActualFunTys +* * +********************************************************************* -} + +-- | 'matchActualFunTy' looks for just one function arrow, +-- returning an uninstantiated sigma-type. +-- +-- Invariant: the returned argument type has a syntactically fixed +-- RuntimeRep in the sense of Note [Fixed RuntimeRep] +-- in GHC.Tc.Utils.Concrete. +-- +-- See Note [Return arguments with a fixed RuntimeRep]. +matchActualFunTy + :: ExpectedFunTyOrigin + -- ^ See Note [Herald for matchExpectedFunTys] + -> Maybe TypedThing + -- ^ The thing with type TcSigmaType + -> (Arity, TcType) + -- ^ Total number of value args in the call, and + -- the original function type + -- (Both are used only for error messages) + -> TcRhoType + -- ^ Type to analyse: a TcRhoType + -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) +-- This function takes in a type to analyse (a RhoType) and returns +-- an argument type and a result type (splitting apart a function arrow). +-- The returned argument type is a SigmaType with a fixed RuntimeRep; +-- as explained in Note [Return arguments with a fixed RuntimeRep]. +-- +-- See Note [matchActualFunTy error handling] for the first three arguments + +-- If (wrap, arg_ty, res_ty) = matchActualFunTy ... fun_ty +-- then wrap :: fun_ty ~> (arg_ty -> res_ty) +-- and NB: res_ty is an (uninstantiated) SigmaType + +matchActualFunTy herald mb_thing err_info fun_ty + = assertPpr (isRhoTy fun_ty) (ppr fun_ty) $ + go fun_ty + where + -- Does not allocate unnecessary meta variables: if the input already is + -- a function, we just take it apart. Not only is this efficient, + -- it's important for higher rank: the argument might be of form + -- (forall a. ty) -> other + -- If allocated (fresh-meta-var1 -> fresh-meta-var2) and unified, we'd + -- hide the forall inside a meta-variable + go :: TcRhoType -- The type we're processing, perhaps after + -- expanding type synonyms + -> TcM (HsWrapper, Scaled TcSigmaTypeFRR, TcSigmaType) + go ty | Just ty' <- coreView ty = go ty' + + go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty }) + = assert (isVisibleFunArg af) $ + do { hasFixedRuntimeRep_syntactic (FRRExpectedFunTy herald 1) arg_ty + ; return (idHsWrapper, Scaled w arg_ty, res_ty) } + + go ty@(TyVarTy tv) + | isMetaTyVar tv + = do { cts <- readMetaTyVar tv + ; case cts of + Indirect ty' -> go ty' + Flexi -> defer ty } + + -- In all other cases we bale out into ordinary unification + -- However unlike the meta-tyvar case, we are sure that the + -- number of arguments doesn't match arity of the original + -- type, so we can add a bit more context to the error message + -- (cf #7869). + -- + -- It is not always an error, because specialized type may have + -- different arity, for example: + -- + -- > f1 = f2 'a' + -- > f2 :: Monad m => m Bool + -- > f2 = undefined + -- + -- But in that case we add specialized type into error context + -- anyway, because it may be useful. See also #9605. + go ty = addErrCtxtM (mk_ctxt ty) (defer ty) + + ------------ + defer fun_ty + = do { arg_ty <- new_check_arg_ty herald 1 + ; res_ty <- newOpenFlexiTyVarTy + ; let unif_fun_ty = mkScaledFunTys [arg_ty] res_ty + ; co <- unifyType mb_thing fun_ty unif_fun_ty + ; return (mkWpCastN co, arg_ty, res_ty) } + + ------------ + mk_ctxt :: TcType -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) + mk_ctxt _res_ty = mkFunTysMsg herald err_info + +{- Note [matchActualFunTy error handling] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +matchActualFunTy is made much more complicated by the +desire to produce good error messages. Consider the application + f @Int x y +In GHC.Tc.Gen.Head.tcInstFun we instantiate the function type, one +argument at a time. It must instantiate any type/dictionary args, +before looking for an arrow type. + +But if it doesn't find an arrow type, it wants to generate a message +like "f is applied to two arguments but its type only has one". +To do that, it needs to know about the args that tcArgs has already +munched up -- hence passing in n_val_args_in_call and arg_tys_so_far; +and hence also the accumulating so_far arg to 'go'. + +This allows us (in mk_ctxt) to construct f's /instantiated/ type, +with just the values-arg arrows, which is what we really want +in the error message. + +Ugh! +-} + +-- | Like 'matchExpectedFunTys', but used when you have an "actual" type, +-- for example in function application. +-- +-- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep +-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. +-- See Note [Return arguments with a fixed RuntimeRep]. +matchActualFunTys :: ExpectedFunTyOrigin -- ^ See Note [Herald for matchExpectedFunTys] + -> CtOrigin + -> Arity + -> TcSigmaType + -> TcM (HsWrapper, [Scaled TcSigmaTypeFRR], TcRhoType) +-- If matchActualFunTys n ty = (wrap, [t1,..,tn], res_ty) +-- then wrap : ty ~> (t1 -> ... -> tn -> res_ty) +-- and res_ty is a RhoType +-- NB: the returned type is top-instantiated; it's a RhoType +matchActualFunTys herald ct_orig n_val_args_wanted top_ty + = go n_val_args_wanted [] top_ty + where + go n so_far fun_ty + | not (isRhoTy fun_ty) + = do { (wrap1, rho) <- topInstantiate ct_orig fun_ty + ; (wrap2, arg_tys, res_ty) <- go n so_far rho + ; return (wrap2 <.> wrap1, arg_tys, res_ty) } + + go 0 _ fun_ty = return (idHsWrapper, [], fun_ty) + + go n so_far fun_ty + = do { (wrap_fun1, arg_ty1, res_ty1) <- matchActualFunTy + herald Nothing + (n_val_args_wanted, top_ty) + fun_ty + ; (wrap_res, arg_tys, res_ty) <- go (n-1) (arg_ty1:so_far) res_ty1 + ; let wrap_fun2 = mkWpFun idHsWrapper wrap_res arg_ty1 res_ty + -- NB: arg_ty1 comes from matchActualFunTy, so it has + -- a syntactically fixed RuntimeRep as needed to call mkWpFun. + ; return (wrap_fun2 <.> wrap_fun1, arg_ty1:arg_tys, res_ty) } + +{- +************************************************************************ +* * + Skolemisation and matchExpectedFunTys +* * +************************************************************************ + +Note [Skolemisation overview] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose f :: (forall a. a->a) -> blah, and we have the application (f e) +Then we want to typecheck `e` pushing in the type `forall a. a->a`. But we +need to be careful: + +* Roughly speaking, in (tcPolyExpr e (forall a b. rho)), we skolemise `a` and `b`, + and then call (tcExpr e rho) + +* But not quite! We must be careful if `e` is a type lambda (\ @p @q -> blah). + Then we want to line up the skolemised variables `a`,`b` + with `p`,`q`, so we can't just call (tcExpr (\ @p @q -> blah) rho) + +* A very similar situation arises with + (\ @p @q -> blah) :: forall a b. rho + Again, we must line up `p`, `q` with the skolemised `a` and `b`. + +* Another similar situation arises with + g :: forall a b. rho + g @p @q x y = .... + Here again when skolemising `a` and `b` we must be careful to match them up + with `p` and `q`. + +OK, so how exactly do we check @p binders in lambdas? First note that we only +we only attempt to deal with @p binders when /checking/. We don't do inference for +(\ @a -> blah), not yet anyway. + +For checking, there are two cases to consider: + * Function LHS, where the function has a type signature + f :: forall a. a -> forall b. [b] -> blah + f @p x @q y = ... + + * Lambda \ @p x @q y -> ... + \cases { @p x @q y -> ... } + (\case p behaves like \cases { p -> ... }, and p is always a term pattern.) + +Both ultimately handled by matchExpectedFunTys. + +* Function LHS case is handled by `GHC.Tc.Gen.Bind.tcPolyCheck`: + * It calls `tcSkolemiseCompleteSig` + * Passes the skolemised variables into `tcFunBindMatches` + * Which uses `matchExpectedFunTys` to decompose the function type to + match the arguments + * And then passes the (skolemised-variables ++ arg tys) on to `tcMatches` + +* For the Lambda case there are two sub-cases: + * An expression with a type signature: (\ @a x y -> blah) :: hs_ty + This is handled by `GHC.Tc.Gen.Head.tcExprWithSig`, which kind-checks + the signature and hands off to `tcExprPolyCheck` via `tcPolyLExprSig`. + Note that the foralls at the top of hs_ty scope over the expression. + + * A higher order call: h e, where h :: poly_ty -> blah + This is handlded by `GHC.Tc.Gen.Expr.tcPolyExpr`, which (in the + checking case) again hands off to `tcExprPolyCheck`. Here there is + no type-variable scoping to worry about. + + So both sub-cases end up in `GHC.Tc.Gen.Expr.tcPolyExprCheck` + * This skolemises the /top-level/ invisible binders, but remembers + the binders as [ExpPatType] + * Then it looks for a lambda, and if so, calls `tcLambdaMatches` passing in + the skolemised binders so they can be matched up with the lambda binders. + * Otherwise it does deep-skolemisation if DeepSubsumption is on, + and then calls tcExpr to typecheck `e` + + The outer skolemisation in tcPolyExprCheck is done using + * tcSkolemiseCompleteSig when there is a user-written signature + * tcSkolemiseGeneral when the polytype just comes from the context e.g. (f e) + The former just calls the latter, so the two cases differ only slightly: + * Both do shallow skolemisation + * Both go via checkConstraints, which uses implicationNeeded to decide whether + to build an implication constraint even if there /are/ no skolems. + See Note [When to build an implication] below. + + The difference between the two cases is that `tcSkolemiseCompleteSig` + also brings the outer type variables into scope. It would do no + harm to do so in both cases, but I found that (to my surprise) doing + so caused a non-trivial (1%-ish) perf hit on the compiler. + +* `tcFunBindMatches` and `tcLambdaMatches` both use `matchExpectedFunTys`, which + ensures that any trailing invisible binders are skolemised; and does so deeply + if DeepSubsumption is on. + + This corresponds to the plan: "skolemise at the '=' of a function binding or + at the '->' of a lambda binding". (See #17594 and "Plan B2".) + +Some wrinkles + +(SK1) tcSkolemiseGeneral and tcSkolemiseCompleteSig make fresh type variables + See Note [Instantiate sig with fresh variables] + +(SK2) All skolemisation (even without DeepSubsumption) builds just one implication + constraint for a nested forall like: + forall a. Eq a => forall b. Ord b => blah + The implication constraint will look like + forall a b. (Eq a, Ord b) => + See the loop in GHC.Tc.Utils.Instantiate.topSkolemise. + and Note [Skolemisation en-bloc] in that module + + +Some examples: + +* f :: forall a b. blah + f @p x = rhs + `tcPolyCheck` calls `tcSkolemiseCompleteSig` to skolemise the signature, and + then calls `tcFunBindMatches` passing in [a_sk, b_sk], the skolemsed + variables. The latter ultimately calls `tcMatches`, and thence `tcMatchPats`. + The latter matches up the `a_sk` with `@p`, and discards the `b_sk`. + +* f :: forall (a::Type) (b::a). blah + f @(p::b) x = rhs + `tcSkolemiseCompleteSig` brings `a` and `b` into scope, bound to `a_sk` and `b_sk` resp. + When `tcMatchPats` typechecks the pattern `@(p::b)` it'll find that `b` is in + scope (as a result of tcSkolemiseCompleteSig) which is a bit strange. But + it'll then unify the kinds `Type ~ b`, which will fail as it should. + +* f :: Int -> forall (a::Type) (b::a). blah + f x @p = rhs + `matchExpectedFunTys` does shallow skolemisation eagerly, so we'll skolemise the + forall a b. Then `tcMatchPats` will bind [p :-> a_sk], and discard `b_sk`. + Discarding the `b_sk` means that + f x @p = \ @q -> blah + or f x @p = let .. in \ @q -> blah + will both be rejected: this is Plan B2: skolemise at the "=". + +* Suppose DeepSubsumption is on + f :: forall a. a -> forall b. b -> b -> forall z. z + f @p x @q y = rhs + The `tcSkolemiseCompleteSig` uses shallow skolemisation, so it only skolemises + and brings into scope [a :-> a_sk]. Then `matchExpectedFunTys` skolemises the + forall b, because it needs to expose two value arguments. Finally + `matchExpectedFunTys` concludes with deeply skolemising the remaining type. + + So we end up with `[p :-> a_sk, q :-> b_sk]`. Notice that we must not + deeply-skolemise /first/ or we'd get the tyvars [a_sk, b_sk, c_sk] which would + not line up with the patterns [@p, x, @q, y] +-} + +tcSkolemiseGeneral + :: DeepSubsumptionFlag + -> UserTypeCtxt + -> TcType -> TcType -- top_ty and expected_ty + -- Here, top_ty is the type we started to skolemise; used only in SigSkol + -- - expected_ty is the type we are actually skolemising + -- matchExpectedFunTys walks down the type, skolemising as it goes, + -- keeping the same top_ty, but successively smaller expected_tys + -> ([(Name, TcInvisTVBinder)] -> TcType -> TcM result) + -> TcM (HsWrapper, result) +tcSkolemiseGeneral ds_flag ctxt top_ty expected_ty thing_inside + | isRhoTyDS ds_flag expected_ty + -- Fast path for a very very common case: no skolemisation to do + -- But still call checkConstraints in case we need an implication regardless + = do { let sig_skol = SigSkol ctxt top_ty [] + ; (ev_binds, result) <- checkConstraints sig_skol [] [] $ + thing_inside [] expected_ty + ; return (mkWpLet ev_binds, result) } + + | otherwise + = do { -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] + -- in GHC.Tc.Utils.TcType + ; rec { (wrap, tv_prs, given, rho_ty) <- case ds_flag of + Deep -> deeplySkolemise skol_info expected_ty + Shallow -> topSkolemise skol_info expected_ty + ; let sig_skol = SigSkol ctxt top_ty (map (fmap binderVar) tv_prs) + ; skol_info <- mkSkolemInfo sig_skol } + + ; let skol_tvs = map (binderVar . snd) tv_prs + ; traceTc "tcSkolemiseGeneral" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given) + ; (ev_binds, result) <- checkConstraints sig_skol skol_tvs given $ + thing_inside tv_prs rho_ty + + ; return (wrap <.> mkWpLet ev_binds, result) } + -- The ev_binds returned by checkConstraints is very + -- often empty, in which case mkWpLet is a no-op + +tcSkolemiseCompleteSig :: TcCompleteSig + -> ([ExpPatType] -> TcRhoType -> TcM result) + -> TcM (HsWrapper, result) +-- ^ The wrapper has type: spec_ty ~> expected_ty +-- See Note [Skolemisation] for the differences between +-- tcSkolemiseCompleteSig and tcTopSkolemise + +tcSkolemiseCompleteSig (CSig { sig_bndr = poly_id, sig_ctxt = ctxt, sig_loc = loc }) + thing_inside + = do { cur_loc <- getSrcSpanM + ; let poly_ty = idType poly_id + ; setSrcSpan loc $ -- Sets the location for the implication constraint + tcSkolemiseGeneral Shallow ctxt poly_ty poly_ty $ \tv_prs rho_ty -> + setSrcSpan cur_loc $ -- Revert to the original location + tcExtendNameTyVarEnv (map (fmap binderVar) tv_prs) $ + thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty } + +tcSkolemiseExpectedType :: TcSigmaType + -> ([ExpPatType] -> TcRhoType -> TcM result) + -> TcM (HsWrapper, result) +-- Just like tcSkolemiseCompleteSig, except that we don't have a user-written +-- type signature, we only have a type comimg from the context. +-- Eg. f :: (forall a. blah) -> blah +-- In the call (f e) we will call tcSkolemiseExpectedType on (forall a.blah) +-- before typececking `e` +tcSkolemiseExpectedType exp_ty thing_inside + = tcSkolemiseGeneral Shallow GenSigCtxt exp_ty exp_ty $ \tv_prs rho_ty -> + thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty + +tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType + -> (TcRhoType -> TcM result) + -> TcM (HsWrapper, result) +tcSkolemise ds_flag ctxt expected_ty thing_inside + = tcSkolemiseGeneral ds_flag ctxt expected_ty expected_ty $ \_ rho_ty -> + thing_inside rho_ty + +checkConstraints :: SkolemInfoAnon + -> [TcTyVar] -- Skolems + -> [EvVar] -- Given + -> TcM result + -> TcM (TcEvBinds, result) +-- checkConstraints is careful to build an implication even if +-- `skol_tvs` and `given` are both empty, under certain circumstances +-- See Note [When to build an implication] +checkConstraints skol_info skol_tvs given thing_inside + = do { implication_needed <- implicationNeeded skol_info skol_tvs given + + ; if implication_needed + then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside + ; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted + ; traceTc "checkConstraints" (ppr tclvl $$ ppr skol_tvs) + ; emitImplications implics + ; return (ev_binds, result) } + + else -- Fast path. We check every function argument with tcCheckPolyExpr, + -- which uses tcTopSkolemise and hence checkConstraints. + -- So this fast path is well-exercised + do { res <- thing_inside + ; return (emptyTcEvBinds, res) } } + +checkTvConstraints :: SkolemInfo + -> [TcTyVar] -- Skolem tyvars + -> TcM result + -> TcM result + +checkTvConstraints skol_info skol_tvs thing_inside + = do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside + ; emitResidualTvConstraint skol_info skol_tvs tclvl wanted + ; return result } + +emitResidualTvConstraint :: SkolemInfo -> [TcTyVar] + -> TcLevel -> WantedConstraints -> TcM () +emitResidualTvConstraint skol_info skol_tvs tclvl wanted + | not (isEmptyWC wanted) || + checkTelescopeSkol skol_info_anon + = -- checkTelescopeSkol: in this case, /always/ emit this implication + -- even if 'wanted' is empty. We need the implication so that we check + -- for a bad telescope. See Note [Skolem escape and forall-types] in + -- GHC.Tc.Gen.HsType + do { implic <- buildTvImplication skol_info_anon skol_tvs tclvl wanted + ; emitImplication implic } + + | otherwise -- Empty 'wanted', emit nothing + = return () + where + skol_info_anon = getSkolemInfo skol_info + +buildTvImplication :: SkolemInfoAnon -> [TcTyVar] + -> TcLevel -> WantedConstraints -> TcM Implication +buildTvImplication skol_info skol_tvs tclvl wanted + = assertPpr (all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs) (ppr skol_tvs) $ + do { ev_binds <- newNoTcEvBinds -- Used for equalities only, so all the constraints + -- are solved by filling in coercion holes, not + -- by creating a value-level evidence binding + ; implic <- newImplication + + ; let implic' = implic { ic_tclvl = tclvl + , ic_skols = skol_tvs + , ic_given_eqs = NoGivenEqs + , ic_wanted = wanted + , ic_binds = ev_binds + , ic_info = skol_info } + + ; checkImplicationInvariants implic' + ; return implic' } + +implicationNeeded :: SkolemInfoAnon -> [TcTyVar] -> [EvVar] -> TcM Bool +-- See Note [When to build an implication] +implicationNeeded skol_info skol_tvs given + | null skol_tvs + , null given + , not (alwaysBuildImplication skol_info) + = -- Empty skolems and givens + do { tc_lvl <- getTcLevel + ; if not (isTopTcLevel tc_lvl) -- No implication needed if we are + then return False -- already inside an implication + else + do { dflags <- getDynFlags -- If any deferral can happen, + -- we must build an implication + ; return (gopt Opt_DeferTypeErrors dflags || + gopt Opt_DeferTypedHoles dflags || + gopt Opt_DeferOutOfScopeVariables dflags) } } + + | otherwise -- Non-empty skolems or givens + = return True -- Definitely need an implication + +alwaysBuildImplication :: SkolemInfoAnon -> Bool +-- See Note [When to build an implication] +alwaysBuildImplication _ = False + +{- Commmented out for now while I figure out about error messages. + See #14185 + +Caution: we get some duplication of errors if we build more implications. +Because we get one error for each function RHS, even if it's for +the same class constraint. + +alwaysBuildImplication (SigSkol ctxt _ _) + = case ctxt of + FunSigCtxt {} -> True -- RHS of a binding with a signature + _ -> False +alwaysBuildImplication (RuleSkol {}) = True +alwaysBuildImplication (InstSkol {}) = True +alwaysBuildImplication (FamInstSkol {}) = True +alwaysBuildImplication _ = False +-} + +buildImplicationFor :: TcLevel -> SkolemInfoAnon -> [TcTyVar] + -> [EvVar] -> WantedConstraints + -> TcM (Bag Implication, TcEvBinds) +buildImplicationFor tclvl skol_info skol_tvs given wanted + | isEmptyWC wanted && null given + -- Optimisation : if there are no wanteds, and no givens + -- don't generate an implication at all. + -- Reason for the (null given): we don't want to lose + -- the "inaccessible alternative" error check + = return (emptyBag, emptyTcEvBinds) + + | otherwise + = assertPpr (all (isSkolemTyVar <||> isTyVarTyVar) skol_tvs) (ppr skol_tvs) $ + -- Why allow TyVarTvs? Because implicitly declared kind variables in + -- non-CUSK type declarations are TyVarTvs, and we need to bring them + -- into scope as a skolem in an implication. This is OK, though, + -- because TyVarTvs will always remain tyvars, even after unification. + do { ev_binds_var <- newTcEvBinds + ; implic <- newImplication + ; let implic' = implic { ic_tclvl = tclvl + , ic_skols = skol_tvs + , ic_given = given + , ic_wanted = wanted + , ic_binds = ev_binds_var + , ic_info = skol_info } + ; checkImplicationInvariants implic' + + ; return (unitBag implic', TcEvBinds ev_binds_var) } + +{- Note [When to build an implication] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have some 'skolems' and some 'givens', and we are +considering whether to wrap the constraints in their scope into an +implication. We must /always/ do so if either 'skolems' or 'givens' are +non-empty. But what if both are empty? You might think we could +always drop the implication. Other things being equal, the fewer +implications the better. Less clutter and overhead. But we must +take care: + +* If we have an unsolved [W] g :: a ~# b, and -fdefer-type-errors, + we'll make a /term-level/ evidence binding for 'g = error "blah"'. + We must have an EvBindsVar those bindings!, otherwise they end up as + top-level unlifted bindings, which are verboten. This only matters + at top level, so we check for that + See also Note [Deferred errors for coercion holes] in GHC.Tc.Errors. + cf #14149 for an example of what goes wrong. + +* This is /necessary/ for top level but may be /desirable/ even for + nested bindings, because if the deferred coercion is bound too far + out it will be reported even if that thunk (say) is not evaluated. + +* If you have + f :: Int; f = f_blah + g :: Bool; g = g_blah + If we don't build an implication for f or g (no tyvars, no givens), + the constraints for f_blah and g_blah are solved together. And that + can yield /very/ confusing error messages, because we can get + [W] C Int b1 -- from f_blah + [W] C Int b2 -- from g_blan + and fundeps can yield [W] b1 ~ b2, even though the two functions have + literally nothing to do with each other. #14185 is an example. + Building an implication keeps them separate. + +Note [Herald for matchExpectedFunTys] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The 'herald' always looks like: + "The equation(s) for 'f' have" + "The abstraction (\x.e) takes" + "The section (+ x) expects" + "The function 'f' is applied to" + +This is used to construct a message of form + + The abstraction `\Just 1 -> ...' takes two arguments + but its type `Maybe a -> a' has only one + + The equation(s) for `f' have two arguments + but its type `Maybe a -> a' has only one + + The section `(f 3)' requires 'f' to take two arguments + but its type `Int -> Int' has only one + + The function 'f' is applied to two arguments + but its type `Int -> Int' has only one + +When visible type applications (e.g., `f @Int 1 2`, as in #13902) enter the +picture, we have a choice in deciding whether to count the type applications as +proper arguments: + + The function 'f' is applied to one visible type argument + and two value arguments + but its type `forall a. a -> a` has only one visible type argument + and one value argument + +Or whether to include the type applications as part of the herald itself: + + The expression 'f @Int' is applied to two arguments + but its type `Int -> Int` has only one + +The latter is easier to implement and is arguably easier to understand, so we +choose to implement that option. + +Note [matchExpectedFunTys] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +matchExpectedFunTys checks that a sigma has the form +of an n-ary function. It passes the decomposed type to the +thing_inside, and returns a wrapper to coerce between the two types + +It's used wherever a language construct must have a functional type, +namely: + A lambda expression + A function definition + An operator section + +This function must be written CPS'd because it needs to fill in the +ExpTypes produced for arguments before it can fill in the ExpType +passed in. + +Note [Return arguments with a fixed RuntimeRep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The functions + + - matchExpectedFunTys, + - matchActualFunTy, + - matchActualFunTys, + +peel off argument types, as explained in Note [matchExpectedFunTys]. +It's important that these functions return argument types that have +a fixed runtime representation, otherwise we would be in violation +of the representation-polymorphism invariants of +Note [Representation polymorphism invariants] in GHC.Core. + +This is why all these functions have an additional invariant, +that the argument types they return all have a syntactically fixed RuntimeRep, +in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. + +Example: + + Suppose we have + + type F :: Type -> RuntimeRep + type family F a where { F Int = LiftedRep } + + type Dual :: Type -> Type + type family Dual a where + Dual a = a -> () + + f :: forall (a :: TYPE (F Int)). Dual a + f = \ x -> () + + The body of `f` is a lambda abstraction, so we must be able to split off + one argument type from its type. This is handled by `matchExpectedFunTys` + (see 'GHC.Tc.Gen.Match.tcLambdaMatches'). We end up with desugared Core that + looks like this: + + f :: forall (a :: TYPE (F Int)). Dual (a |> (TYPE F[0])) + f = \ @(a :: TYPE (F Int)) -> + (\ (x :: (a |> (TYPE F[0]))) -> ()) + `cast` + (Sub (Sym (Dual[0] <(a |> (TYPE F[0]))>))) + + Two important transformations took place: + + 1. We inserted casts around the argument type to ensure that it has + a fixed runtime representation, as required by invariant (I1) from + Note [Representation polymorphism invariants] in GHC.Core. + 2. We inserted a cast around the whole lambda to make everything line up + with the type signature. +-} + +-- | Use this function to split off arguments types when you have an +-- \"expected\" type. +-- +-- This function skolemises at each polytype. +-- +-- Invariant: this function only applies the provided function +-- to a list of argument types which all have a syntactically fixed RuntimeRep +-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. +-- See Note [Return arguments with a fixed RuntimeRep]. +matchExpectedFunTys :: forall a. + ExpectedFunTyOrigin -- See Note [Herald for matchExpectedFunTys] + -> UserTypeCtxt + -> VisArity + -> ExpSigmaType + -> ([ExpPatType] -> ExpRhoType -> TcM a) + -> TcM (HsWrapper, a) +-- If matchExpectedFunTys n ty = (wrap, _) +-- then wrap : (t1 -> ... -> tn -> ty_r) ~> ty, +-- where [t1, ..., tn], ty_r are passed to the thing_inside +-- +-- Unconditionally concludes by skolemising any trailing invisible +-- binders and, if DeepSubsumption is on, it does so deeply. +-- +-- Postcondition: +-- If exp_ty is Check {}, then [ExpPatType] and ExpRhoType results are all Check{} +-- If exp_ty is Infer {}, then [ExpPatType] and ExpRhoType results are all Infer{} +matchExpectedFunTys herald _ctxt arity (Infer inf_res) thing_inside + = do { arg_tys <- mapM (new_infer_arg_ty herald) [1 .. arity] + ; res_ty <- newInferExpType (ir_inst inf_res) + ; result <- thing_inside (map ExpFunPatTy arg_tys) res_ty + ; arg_tys <- mapM (\(Scaled m t) -> Scaled m <$> readExpType t) arg_tys + ; res_ty <- readExpType res_ty + -- Remarks: + -- 1. use tcMkScaledFunTys rather than mkScaledFunTys, as we might + -- have res_ty :: kappa[tau] for a meta ty-var kappa, in which case + -- mkScaledFunTys would crash. See #26277. + -- 2. tcMkScaledFunTys arg_tys res_ty does not contain any foralls + -- (even nested ones), so no need to instantiate. + ; co <- fillInferResultNoInst (tcMkScaledFunTys arg_tys res_ty) inf_res + ; return (mkWpCastN co, result) } + +matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside + = check arity [] top_ty + where + check :: VisArity -> [ExpPatType] -> TcSigmaType -> TcM (HsWrapper, a) + -- `check` is called only in the Check{} case + -- It collects rev_pat_tys in reversed order + -- n_req is the number of /visible/ arguments still needed + + ---------------------------- + -- Skolemise quantifiers, both visible (up to n_req) and invisible + -- See Note [Visible type application and abstraction] in GHC.Tc.Gen.App + check n_req rev_pat_tys ty + | isSigmaTy ty -- An invisible quantifier at the top + || (n_req > 0 && isForAllTy ty) -- A visible quantifier at top, and we need it + = do { rec { (n_req', wrap_gen, tv_nms, bndrs, given, inner_ty) <- skolemiseRequired skol_info n_req ty + ; let sig_skol = SigSkol ctx top_ty (tv_nms `zip` skol_tvs) + skol_tvs = binderVars bndrs + ; skol_info <- mkSkolemInfo sig_skol } + -- rec {..}: see Note [Keeping SkolemInfo inside a SkolemTv] + -- in GHC.Tc.Utils.TcType + ; (ev_binds, (wrap_res, result)) + <- checkConstraints (getSkolemInfo skol_info) skol_tvs given $ + check n_req' + (reverse (map ExpForAllPatTy bndrs) ++ rev_pat_tys) + inner_ty + ; assertPpr (not (null bndrs && null given)) (ppr ty) $ + -- The guard ensures that we made some progress + return (wrap_gen <.> mkWpLet ev_binds <.> wrap_res, result) } + + ---------------------------- + -- Base case: (n_req == 0): no more args + -- The earlier skolemisation ensurs that rho_ty has no top-level invisible quantifiers + -- If there is deep subsumption, do deep skolemisation now + check n_req rev_pat_tys rho_ty + | n_req == 0 + = do { let pat_tys = reverse rev_pat_tys + ; ds_flag <- getDeepSubsumptionFlag + ; case ds_flag of + Shallow -> do { res <- thing_inside pat_tys (mkCheckExpType rho_ty) + ; return (idHsWrapper, res) } + Deep -> tcSkolemiseGeneral Deep ctx top_ty rho_ty $ \_ rho_ty -> + -- "_" drop the /deeply/-skolemise binders + -- They do not line up with binders in the Match + thing_inside pat_tys (mkCheckExpType rho_ty) } + + ---------------------------- + -- Function types + check n_req rev_pat_tys (FunTy { ft_af = af, ft_mult = mult + , ft_arg = arg_ty, ft_res = res_ty }) + = assert (isVisibleFunArg af) $ + do { let arg_pos = arity - n_req + 1 -- 1 for the first argument etc + ; (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy herald arg_pos) arg_ty + ; (wrap_res, result) <- check (n_req - 1) + (mkCheckExpFunPatTy (Scaled mult arg_ty) : rev_pat_tys) + res_ty + ; let wrap_arg = mkWpCastN arg_co + fun_wrap = mkWpFun wrap_arg wrap_res (Scaled mult arg_ty) res_ty + ; return (fun_wrap, result) } + + ---------------------------- + -- Type variables + check n_req rev_pat_tys ty@(TyVarTy tv) + | isMetaTyVar tv + = do { cts <- readMetaTyVar tv + ; case cts of + Indirect ty' -> check n_req rev_pat_tys ty' + Flexi -> defer n_req rev_pat_tys ty } + + ---------------------------- + -- NOW do coreView. We didn't do it before, so that we do not unnecessarily + -- unwrap a synonym in the returned rho_ty + check n_req rev_pat_tys ty + | Just ty' <- coreView ty = check n_req rev_pat_tys ty' + + -- In all other cases we bale out into ordinary unification + -- However unlike the meta-tyvar case, we are sure that the + -- number of arguments doesn't match arity of the original + -- type, so we can add a bit more context to the error message + -- (cf #7869). + -- + -- It is not always an error, because specialized type may have + -- different arity, for example: + -- + -- > f1 = f2 'a' + -- > f2 :: Monad m => m Bool + -- > f2 = undefined + -- + -- But in that case we add specialized type into error context + -- anyway, because it may be useful. See also #9605. + check n_req rev_pat_tys res_ty + = addErrCtxtM (mkFunTysMsg herald (arity, top_ty)) $ + defer n_req rev_pat_tys res_ty + + ------------ + defer :: VisArity -> [ExpPatType] -> TcRhoType -> TcM (HsWrapper, a) + defer n_req rev_pat_tys fun_ty + = do { more_arg_tys <- mapM (new_check_arg_ty herald) [arity - n_req + 1 .. arity] + ; let all_pats = reverse rev_pat_tys ++ map mkCheckExpFunPatTy more_arg_tys + ; res_ty <- newOpenFlexiTyVarTy + ; result <- thing_inside all_pats (mkCheckExpType res_ty) + + ; co <- unifyType Nothing (mkScaledFunTys more_arg_tys res_ty) fun_ty + ; return (mkWpCastN co, result) } + +new_infer_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled ExpRhoTypeFRR) +new_infer_arg_ty herald arg_pos -- position for error messages only + = do { mult <- newFlexiTyVarTy multiplicityTy + ; inf_hole <- newInferExpTypeFRR IIF_DeepRho (FRRExpectedFunTy herald arg_pos) + ; return (mkScaled mult inf_hole) } + +new_check_arg_ty :: ExpectedFunTyOrigin -> Int -> TcM (Scaled TcType) +new_check_arg_ty herald arg_pos -- Position for error messages only, 1 for first arg + = do { mult <- newFlexiTyVarTy multiplicityTy + ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy herald arg_pos) + ; return (mkScaled mult arg_ty) } + +mkFunTysMsg :: ExpectedFunTyOrigin + -> (VisArity, TcType) + -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) +-- See Note [Reporting application arity errors] +mkFunTysMsg herald (n_vis_args_in_call, fun_ty) env + = do { (env', fun_ty) <- zonkTidyTcType env fun_ty + + ; let (pi_ty_bndrs, _) = splitPiTys fun_ty + n_fun_args = count isVisiblePiTyBinder pi_ty_bndrs + + ; return (env', FunTysCtxt herald fun_ty n_vis_args_in_call n_fun_args) } + + +{- Note [Reporting application arity errors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider f :: Int -> Int -> Int +and the call foo = f 3 4 5 +We'd like to get an error like: + + • Couldn't match expected type ‘t0 -> t’ with actual type ‘Int’ + • The function ‘f’ is applied to three visible arguments, -- What are "visible" arguments? + but its type ‘Int -> Int -> Int’ has only two -- See Note [Visibility and arity] in GHC.Types.Basic + +That is what `mkFunTysMsg` tries to do. But what is the "type of the function". +Most obviously, we can report its full, polymorphic type; that is simple and +explicable. But sometimes a bit odd. Consider + f :: Bool -> t Int Int + foo = f True 5 10 +We get this error: + • Couldn't match type ‘Int’ with ‘t0 -> t’ + Expected: Int -> t0 -> t + Actual: Int -> Int + • The function ‘f’ is applied to three visible arguments, + but its type ‘Bool -> t Int Int’ has only one + +That's not /quite/ right beause we can instantiate `t` to an arrow and get +two arrows (but not three!). With that in mind, one could consider reporting +the /instantiated/ type, and GHC used to do so. But it's more work, and in +some ways more confusing, especially when nested quantifiers are concerned, e.g. + f :: Bool -> forall t. t Int Int + +So we just keep it simple and report the original function type. + + +************************************************************************ +* * + Other matchExpected functions +* * +********************************************************************* -} + +matchExpectedListTy :: TcRhoType -> TcM (TcCoercionN, TcRhoType) +-- Special case for lists +matchExpectedListTy exp_ty + = do { (co, [elt_ty]) <- matchExpectedTyConApp listTyCon exp_ty + ; return (co, elt_ty) } + +--------------------- +matchExpectedTyConApp :: TyCon -- T :: forall kv1 ... kvm. k1 -> ... -> kn -> * + -> TcRhoType -- orig_ty + -> TcM (TcCoercionN, -- T k1 k2 k3 a b c ~N orig_ty + [TcSigmaType]) -- Element types, k1 k2 k3 a b c + +-- It's used for wired-in tycons, so we call checkWiredInTyCon +-- Precondition: never called with FunTyCon +-- Precondition: input type :: * +-- Postcondition: (T k1 k2 k3 a b c) is well-kinded + +matchExpectedTyConApp tc orig_ty + = assertPpr (isAlgTyCon tc) (ppr tc) $ + go orig_ty + where + go ty + | Just ty' <- coreView ty + = go ty' + + go ty@(TyConApp tycon args) + | tc == tycon -- Common case + = return (mkNomReflCo ty, args) + + go (TyVarTy tv) + | isMetaTyVar tv + = do { cts <- readMetaTyVar tv + ; case cts of + Indirect ty -> go ty + Flexi -> defer } + + go _ = defer + + -- If the common case does not occur, instantiate a template + -- T k1 .. kn t1 .. tm, and unify with the original type + -- Doing it this way ensures that the types we return are + -- kind-compatible with T. For example, suppose we have + -- matchExpectedTyConApp T (f Maybe) + -- where data T a = MkT a + -- Then we don't want to instantiate T's data constructors with + -- (a::*) ~ Maybe + -- because that'll make types that are utterly ill-kinded. + -- This happened in #7368 + defer + = do { (_, arg_tvs) <- newMetaTyVars (tyConTyVars tc) + ; traceTc "matchExpectedTyConApp" (ppr tc $$ ppr (tyConTyVars tc) $$ ppr arg_tvs) + ; let args = mkTyVarTys arg_tvs + tc_template = mkTyConApp tc args + ; co <- unifyType Nothing tc_template orig_ty + ; return (co, args) } + +---------------------- +matchExpectedAppTy :: TcRhoType -- orig_ty + -> TcM (TcCoercion, -- m a ~N orig_ty + (TcSigmaType, TcSigmaType)) -- Returns m, a +-- If the incoming type is a mutable type variable of kind k, then +-- matchExpectedAppTy returns a new type variable (m: * -> k); note the *. + +matchExpectedAppTy orig_ty + = go orig_ty + where + go ty + | Just ty' <- coreView ty = go ty' + + | Just (fun_ty, arg_ty) <- tcSplitAppTy_maybe ty + = return (mkNomReflCo orig_ty, (fun_ty, arg_ty)) + + go (TyVarTy tv) + | isMetaTyVar tv + = do { cts <- readMetaTyVar tv + ; case cts of + Indirect ty -> go ty + Flexi -> defer } + + go _ = defer + + -- Defer splitting by generating an equality constraint + defer + = do { ty1 <- newFlexiTyVarTy kind1 + ; ty2 <- newFlexiTyVarTy kind2 + ; co <- unifyType Nothing (mkAppTy ty1 ty2) orig_ty + ; return (co, (ty1, ty2)) } + + orig_kind = typeKind orig_ty + kind1 = mkVisFunTyMany liftedTypeKind orig_kind + kind2 = liftedTypeKind -- m :: * -> k + -- arg type :: * + +{- ********************************************************************** +* + fillInferResult +* +********************************************************************** -} + +-- | Fill an 'InferResult' with the given type. +-- +-- If @co = fillInferResult t1 infer_res@, then @co :: t1 ~# t2@, +-- where @t2@ is the type stored in the 'ir_ref' field of @infer_res@. +-- +-- This function enforces the following invariants: +-- +-- - Level invariant. +-- The stored type @t2@ is at the same level as given by the +-- 'ir_lvl' field. +-- - FRR invariant. +-- Whenever the 'ir_frr' field is `IFRR_Check`, @t2@ is guaranteed +-- to have a syntactically fixed RuntimeRep, in the sense of +-- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. +fillInferResultNoInst :: TcType -> InferResult -> TcM TcCoercionN +fillInferResultNoInst act_res_ty (IR { ir_uniq = u + , ir_lvl = res_lvl + , ir_frr = mb_frr + , ir_ref = ref }) + = do { mb_exp_res_ty <- readTcRef ref + ; case mb_exp_res_ty of + Just exp_res_ty + -- We progressively refine the type stored in 'ref', + -- for example when inferring types across multiple equations. + -- + -- Example: + -- + -- \ x -> case y of { True -> x ; False -> 3 :: Int } + -- + -- When inferring the return type of this function, we will create + -- an 'Infer' 'ExpType', which will first be filled by the type of 'x' + -- after typechecking the first equation, and then filled again with + -- the type 'Int', at which point we want to ensure that we unify + -- the type of 'x' with 'Int'. This is what is happening below when + -- we are "joining" several inferred 'ExpType's. + -> do { traceTc "Joining inferred ExpType" $ + ppr u <> colon <+> ppr act_res_ty <+> char '~' <+> ppr exp_res_ty + ; cur_lvl <- getTcLevel + ; unless (cur_lvl `sameDepthAs` res_lvl) $ + ensureMonoType act_res_ty -- See (FIR1) + ; unifyType Nothing act_res_ty exp_res_ty } + Nothing + -> do { traceTc "Filling inferred ExpType" $ + ppr u <+> text ":=" <+> ppr act_res_ty + + -- Enforce the level invariant: ensure the TcLevel of + -- the type we are writing to 'ref' matches 'ir_lvl'. + ; (prom_co, act_res_ty) <- promoteTcType res_lvl act_res_ty + + -- Enforce the FRR invariant: ensure the type has a syntactically + -- fixed RuntimeRep (if necessary, i.e. 'mb_frr' is not 'Nothing'). + ; (frr_co, act_res_ty) <- + case mb_frr of + IFRR_Any -> return (mkNomReflCo act_res_ty, act_res_ty) + IFRR_Check frr_orig -> hasFixedRuntimeRep frr_orig act_res_ty + + -- Compose the two coercions. + ; let final_co = prom_co `mkTransCo` frr_co + + ; writeTcRef ref (Just act_res_ty) + + ; return final_co } } + +fillInferResult :: CtOrigin -> TcType -> InferResult -> TcM HsWrapper +-- See Note [Instantiation of InferResult] +fillInferResult ct_orig res_ty ires@(IR { ir_inst = iif }) + = case iif of + IIF_Sigma -> do { co <- fillInferResultNoInst res_ty ires + ; return (mkWpCastN co) } + IIF_ShallowRho -> do { (wrap, res_ty') <- topInstantiate ct_orig res_ty + ; co <- fillInferResultNoInst res_ty' ires + ; return (mkWpCastN co <.> wrap) } + IIF_DeepRho -> do { (wrap, res_ty') <- dsInstantiate ct_orig res_ty + ; co <- fillInferResultNoInst res_ty' ires + ; return (mkWpCastN co <.> wrap) } + +{- Note [fillInferResult] +~~~~~~~~~~~~~~~~~~~~~~~~~ +When inferring, we use fillInferResult to "fill in" the hole in InferResult + data InferResult = IR { ir_uniq :: Unique + , ir_lvl :: TcLevel + , ir_ref :: IORef (Maybe TcType) } + +There are two things to worry about: + +1. What if it is under a GADT or existential pattern match? + - GADTs: a unification variable (and Infer's hole is similar) is untouchable + - Existentials: be careful about skolem-escape + +2. What if it is filled in more than once? E.g. multiple branches of a case + case e of + T1 -> e1 + T2 -> e2 + +Our typing rules are: + +* The RHS of a existential or GADT alternative must always be a + monotype, regardless of the number of alternatives. + +* Multiple non-existential/GADT branches can have (the same) + higher rank type (#18412). E.g. this is OK: + case e of + True -> hr + False -> hr + where hr:: (forall a. a->a) -> Int + c.f. Section 7.1 of "Practical type inference for arbitrary-rank types" + We use choice (2) in that Section. + (GHC 8.10 and earlier used choice (1).) + + But note that + case e of + True -> hr + False -> \x -> hr x + will fail, because we still /infer/ both branches, so the \x will get + a (monotype) unification variable, which will fail to unify with + (forall a. a->a) + +For (1) we can detect the GADT/existential situation by seeing that +the current TcLevel is greater than that stored in ir_lvl of the Infer +ExpType. We bump the level whenever we go past a GADT/existential match. + +Then, before filling the hole use promoteTcType to promote the type +to the outer ir_lvl. promoteTcType does this + - create a fresh unification variable alpha at level ir_lvl + - emits an equality alpha[ir_lvl] ~ ty + - fills the hole with alpha +That forces the type to be a monotype (since unification variables can +only unify with monotypes); and catches skolem-escapes because the +alpha is untouchable until the equality floats out. + +For (2), we simply look to see if the hole is filled already. + - if not, we promote (as above) and fill the hole + - if it is filled, we simply unify with the type that is + already there + +(FIR1) There is one wrinkle. Suppose we have + case e of + T1 -> e1 :: (forall a. a->a) -> Int + G2 -> e2 + where T1 is not GADT or existential, but G2 is a GADT. Then suppose the + T1 alternative fills the hole with (forall a. a->a) -> Int, which is fine. + But now the G2 alternative must not *just* unify with that else we'd risk + allowing through (e2 :: (forall a. a->a) -> Int). If we'd checked G2 first + we'd have filled the hole with a unification variable, which enforces a + monotype. + + So if we check G2 second, we still want to emit a constraint that restricts + the RHS to be a monotype. This is done by ensureMonoType, and it works + by simply generating a constraint (alpha ~ ty), where alpha is a fresh +unification variable. We discard the evidence. + +Note [Instantiation of InferResult] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When typechecking expressions (not types, not patterns), we always almost +always instantiate before filling in `InferResult`, so that the result is a +TcRhoType. This behaviour is controlled by the `ir_inst :: InferInstFlag` +field of `InferResult`. + +If we do instantiate (ir_inst = IIF_DeepRho), and DeepSubsumption is enabled, +we instantiate deeply. See `tcInferResult`. + +Usually this field is `IIF_DeepRho` meaning "return a (possibly deep) rho-type". +Why is this the common case? See #17173 for discussion. Here are some examples +of why: + +1. Consider + f x = (*) + We want to instantiate the type of (*) before returning, else we + will infer the type + f :: forall {a}. a -> forall b. Num b => b -> b -> b + This is surely confusing for users. + + And worse, the monomorphism restriction won't work properly. The MR is + dealt with in simplifyInfer, and simplifyInfer has no way of + instantiating. This could perhaps be worked around, but it may be + hard to know even when instantiation should happen. + +2. Another reason. Consider + f :: (?x :: Int) => a -> a + g y = let ?x = 3::Int in f + Here want to instantiate f's type so that the ?x::Int constraint + gets discharged by the enclosing implicit-parameter binding. + +3. Suppose one defines plus = (+). If we instantiate lazily, we will + infer plus :: forall a. Num a => a -> a -> a. However, the monomorphism + restriction compels us to infer + plus :: Integer -> Integer -> Integer + (or similar monotype). Indeed, the only way to know whether to apply + the monomorphism restriction at all is to instantiate + +HOWEVER, not always! Here are places where we want `IIF_Sigma` meaning +"return a sigma-type": + +* IIF_Sigma: In GHC.Tc.Module.tcRnExpr, which implements GHCi's :type + command, we want to return a completely uninstantiated type. + See Note [Implementing :type] in GHC.Tc.Module. + +* IIF_Sigma: In types we can't lambda-abstract, so we must be careful not to instantiate + at all. See calls to `runInferHsType` + +* IIF_Sigma: in patterns we don't want to instantiate at all. See the use of + `runInferSigmaFRR` in GHC.Tc.Gen.Pat + +* IIF_ShallowRho: in the expression part of a view pattern, we must top-instantiate + but /not/ deeply instantiate (#26331). See Note [View patterns and polymorphism] + in GHC.Tc.Gen.Pat. This the only place we use IIF_ShallowRho. + +Why do we want to deeply instantiate, ever? Why isn't top-instantiation enough? +Answer: to accept the following program (T26225b) with -XDeepSubsumption, we +need to deeply instantiate when inferring in checkResultTy: + + f :: Int -> (forall a. a->a) + g :: Int -> Bool -> Bool + + test b = + case b of + True -> f + False -> g + +If we don't deeply instantiate in the branches of the case expression, we will +try to unify the type of 'f' with that of 'g', which fails. If we instead +deeply instantiate 'f', we will fill the 'InferResult' with 'Int -> alpha -> alpha' +which then successfully unifies with the type of 'g' when we come to fill the +'InferResult' hole a second time for the second case branch. +-} + +{- +************************************************************************ +* * + Subsumption checking +* * +************************************************************************ + +Note [Subsumption checking: tcSubType] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +All the tcSubType calls have the form + tcSubType actual_ty expected_ty +which checks + actual_ty <= expected_ty + +That is, that a value of type actual_ty is acceptable in +a place expecting a value of type expected_ty. I.e. that + + actual ty is more polymorphic than expected_ty + +It returns a wrapper function + co_fn :: actual_ty ~ expected_ty +which takes an HsExpr of type actual_ty into one of type +expected_ty. + +Note [Ambiguity check and deep subsumption] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + f :: (forall b. Eq b => a -> a) -> Int + +Does `f` have an ambiguous type? The ambiguity check usually checks +that this definition of f' would typecheck, where f' has the exact same +type as f: + f' :: (forall b. Eq b => a -> a) -> Intp + f' = f + +This will be /rejected/ with DeepSubsumption but /accepted/ with +ShallowSubsumption. On the other hand, this eta-expanded version f'' +would be rejected both ways: + f'' :: (forall b. Eq b => a -> a) -> Intp + f'' x = f x + +This is squishy in the same way as other examples in GHC.Tc.Validity +Note [The squishiness of the ambiguity check] + +The situation in June 2022. Since we have SimpleSubsumption at the moment, +we don't want introduce new breakage if you add -XDeepSubsumption, by +rejecting types as ambiguous that weren't ambiguous before. So, as a +holding decision, we /always/ use SimpleSubsumption for the ambiguity check +(erring on the side accepting more programs). Hence tcSubTypeAmbiguity. +-} + + + +----------------- +-- tcWrapResult needs both un-type-checked (for origins and error messages) +-- and type-checked (for wrapping) expressions +tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType + -> TcM (HsExpr GhcTc) +tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr + +tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType + -> TcM (HsExpr GhcTc) +tcWrapResultO orig rn_expr expr actual_ty res_ty + = do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty + , text "Expected:" <+> ppr res_ty ]) + ; wrap <- tcSubType orig GenSigCtxt (Just $ HsExprRnThing rn_expr) actual_ty res_ty + ; return (mkHsWrap wrap expr) } + +-- | A version of 'tcWrapResult' to use when the actual type is a +-- rho-type, so nothing to instantiate; just go straight to unify. +-- It means we don't need to pass in a CtOrigin. +tcWrapResultMono :: HasDebugCallStack + => HsExpr GhcRn -> HsExpr GhcTc + -> TcRhoType -- ^ Actual; a rho-type, not a sigma-type + -> ExpRhoType -- ^ Expected + -> TcM (HsExpr GhcTc) +tcWrapResultMono rn_expr expr act_ty res_ty + = do { co <- tcSubTypeMono rn_expr act_ty res_ty + ; return (mkHsWrapCo co expr) } + +-- | A version of 'tcSubType' to use when the actual type is a rho-type, +-- so that no instantiation is needed. +tcSubTypeMono :: HasDebugCallStack + => HsExpr GhcRn + -> TcRhoType -- ^ Actual; a rho-type, not a sigma-type + -> ExpRhoType -- ^ Expected + -> TcM TcCoercionN +tcSubTypeMono rn_expr act_ty exp_ty + = assertPpr (isDeepRhoTy act_ty) + (vcat [ text "Actual type is not a (deep) rho-type." + , text "act_ty:" <+> ppr act_ty + , text "rn_expr:" <+> ppr rn_expr]) $ + case exp_ty of + Infer inf_res -> fillInferResultNoInst act_ty inf_res + Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty + +------------------------ +tcSubTypePat :: CtOrigin -> UserTypeCtxt + -> ExpSigmaType -> TcSigmaType -> TcM HsWrapper +-- Used in patterns; polarity is backwards compared +-- to tcSubType +-- If wrap = tc_sub_type_et t1 t2 +-- => wrap :: t1 ~> t2 +tcSubTypePat inst_orig ctxt (Check ty_actual) ty_expected + = tc_sub_type unifyTypeET inst_orig ctxt ty_actual ty_expected + +tcSubTypePat _ _ (Infer inf_res) ty_expected + = do { co <- fillInferResultNoInst ty_expected inf_res + -- In patterns we do not instantatiate + + ; return (mkWpCastN (mkSymCo co)) } + +--------------- + +-- | A subtype check that performs deep subsumption. +-- See also 'tcSubTypeMono', for when no instantiation is required. +tcSubTypeDS :: HsExpr GhcRn + -> TcRhoType -- Actual type -- a rho-type not a sigma-type + -> TcRhoType -- Expected type + -- DeepSubsumption <=> when checking, this type + -- is deeply skolemised + -> TcM HsWrapper +-- Only one call site, in GHC.Tc.Gen.App.tcApp +tcSubTypeDS rn_expr act_rho exp_rho + = tc_sub_type_deep Top (unifyExprType rn_expr) orig GenSigCtxt act_rho exp_rho + where + orig = exprCtOrigin rn_expr + +--------------- + +-- | Checks that the 'actual' type is more polymorphic than the 'expected' type. +tcSubType :: CtOrigin -- ^ Used when instantiating + -> UserTypeCtxt -- ^ Used when skolemising + -> Maybe TypedThing -- ^ The expression that has type 'actual' (if known) + -> TcSigmaType -- ^ Actual type + -> ExpRhoType -- ^ Expected type + -> TcM HsWrapper +tcSubType inst_orig ctxt m_thing ty_actual res_ty + = case res_ty of + Check ty_expected -> tc_sub_type (unifyType m_thing) inst_orig ctxt + ty_actual ty_expected + + Infer inf_res -> fillInferResult inst_orig ty_actual inf_res + +--------------- +tcSubTypeSigma :: CtOrigin -- where did the actual type arise / why are we + -- doing this subtype check? + -> UserTypeCtxt -- where did the expected type arise? + -> TcSigmaType -> TcSigmaType -> TcM HsWrapper +-- External entry point, but no ExpTypes on either side +-- Checks that actual <= expected +-- Returns HsWrapper :: actual ~ expected +tcSubTypeSigma orig ctxt ty_actual ty_expected + = tc_sub_type (unifyType Nothing) orig ctxt ty_actual ty_expected + +--------------- +tcSubTypeAmbiguity :: UserTypeCtxt -- Where did this type arise + -> TcSigmaType -> TcSigmaType -> TcM HsWrapper +-- See Note [Ambiguity check and deep subsumption] +tcSubTypeAmbiguity ctxt ty_actual ty_expected + = tc_sub_type_ds Top Shallow (unifyType Nothing) + (AmbiguityCheckOrigin ctxt) + ctxt ty_actual ty_expected + +--------------- +addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a +addSubTypeCtxt ty_actual ty_expected thing_inside + | isRhoTy ty_actual -- If there is no polymorphism involved, the + , isRhoExpTy ty_expected -- TypeEqOrigin stuff (added by the _NC functions) + = thing_inside -- gives enough context by itself + | otherwise + = addErrCtxtM mk_msg thing_inside + where + mk_msg tidy_env + = do { (tidy_env, ty_actual) <- zonkTidyTcType tidy_env ty_actual + ; ty_expected <- readExpType ty_expected + -- A worry: might not be filled if we're debugging. Ugh. + ; (tidy_env, ty_expected) <- zonkTidyTcType tidy_env ty_expected + ; return (tidy_env, SubTypeCtxt ty_expected ty_actual) } + + +--------------- +tc_sub_type :: (TcType -> TcType -> TcM TcCoercionN) -- How to unify + -> CtOrigin -- Used when instantiating + -> UserTypeCtxt -- Used when skolemising + -> TcSigmaType -- Actual; a sigma-type + -> TcSigmaType -- Expected; also a sigma-type + -> TcM HsWrapper +-- Checks that actual_ty is more polymorphic than expected_ty +-- If wrap = tc_sub_type t1 t2 +-- => wrap :: t1 ~> t2 +-- +-- The "how to unify argument" is always a call to `uType TypeLevel orig`, +-- but with different ways of constructing the CtOrigin `orig` from +-- the argument types and context. + +---------------------- +tc_sub_type unify inst_orig ctxt ty_actual ty_expected + = do { ds_flag <- getDeepSubsumptionFlag + ; tc_sub_type_ds Top ds_flag unify inst_orig ctxt ty_actual ty_expected } + +---------------------- +tc_sub_type_ds :: Position p -- ^ position in the type (for error messages only) + -> DeepSubsumptionFlag + -> (TcType -> TcType -> TcM TcCoercionN) + -> CtOrigin -> UserTypeCtxt -> TcSigmaType + -> TcSigmaType -> TcM HsWrapper +-- tc_sub_type_ds is the main subsumption worker function +-- It takes an explicit DeepSubsumptionFlag +tc_sub_type_ds pos ds_flag unify inst_orig ctxt ty_actual ty_expected + | definitely_poly ty_expected -- See Note [Don't skolemise unnecessarily] + , isRhoTyDS ds_flag ty_actual + = do { traceTc "tc_sub_type (drop to equality)" $ + vcat [ text "ty_actual =" <+> ppr ty_actual + , text "ty_expected =" <+> ppr ty_expected ] + ; mkWpCastN <$> + unify ty_actual ty_expected } + + | otherwise -- This is the general case + = do { traceTc "tc_sub_type (general case)" $ + vcat [ text "ty_actual =" <+> ppr ty_actual + , text "ty_expected =" <+> ppr ty_expected ] + + ; (sk_wrap, inner_wrap) + <- tcSkolemise ds_flag ctxt ty_expected $ \sk_rho -> + case ds_flag of + Deep -> tc_sub_type_deep pos unify inst_orig ctxt ty_actual sk_rho + Shallow -> tc_sub_type_shallow unify inst_orig ty_actual sk_rho + + ; return (sk_wrap <.> inner_wrap) } + +---------------------- +tc_sub_type_shallow :: (TcType -> TcType -> TcM TcCoercionN) + -> CtOrigin + -> TcSigmaType + -> TcRhoType -- Skolemised (shallow-ly) + -> TcM HsWrapper +tc_sub_type_shallow unify inst_orig ty_actual sk_rho + = do { (wrap, rho_a) <- topInstantiate inst_orig ty_actual + ; cow <- unify rho_a sk_rho + ; return (mkWpCastN cow <.> wrap) } + +---------------------- +definitely_poly :: TcType -> Bool +-- A very conservative test: +-- see Note [Don't skolemise unnecessarily] +definitely_poly ty + | (tvs, theta, tau) <- tcSplitSigmaTy ty + , (tv:_) <- tvs -- At least one tyvar + , null theta -- No constraints; see (DP1) + , tv `isInjectiveInType` tau + -- The tyvar actually occurs (DP2), + -- and occurs in an injective position (DP3). + = True + | otherwise + = False + +{- Note [Don't skolemise unnecessarily] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we are trying to solve + ty_actual <= ty_expected + (Char->Char) <= (forall a. a->a) +We could skolemise the 'forall a', and then complain +that (Char ~ a) is insoluble; but that's a pretty obscure +error. It's better to say that + (Char->Char) ~ (forall a. a->a) +fails. + +If we prematurely go to equality we'll reject a program we should +accept (e.g. #13752). So the test (which is only to improve error +message) is very conservative: + + * ty_actual is /definitely/ monomorphic: see `definitely_mono` + This definitely_mono test comes in "shallow" and "deep" variants + + * ty_expected is /definitely/ polymorphic: see `definitely_poly` + This definitely_poly test is more subtle than you might think. + Here are three cases where expected_ty looks polymorphic, but + isn't, and where it would be /wrong/ to switch to equality: + + (DP1) (Char->Char) <= (forall a. (a~Char) => a -> a) + + (DP2) (Char->Char) <= (forall a. Char -> Char) + + (DP3) (Char->Char) <= (forall a. F [a] Char -> Char) + where type instance F [x] t = t + + +Note [Coercion errors in tcSubMult] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +At the moment, we insist that all sub-multiplicity tests turn out +(once the typechecker has finished its work) to be equalities, +i.e. implementable by ReflCo. Why? Because our type system has +no way to express non-Refl sub-multiplicities. + +How can we check that every call to `tcSubMult` returns `Refl`? +It might not be `Refl` *yet*. + +[TODO: add counterexample #25130] + +So we take the following approach + +* In `tcEqMult`: + - Emit a perfectly ordinary Wanted equality constraint for the equality, + returning a coercion. + + - Wrap that coercion with `DE_Multiplicity` to make a `DelayedError`, and put + that delayed error into `wc_errors` of the current WantedConstraints. This + is done by `ensureReflMultiplicityCo`. + +* When solving constraints, discard any `DE_Multiplicity` errors that wrap a + reflective coercion, of kind `ty ~ ty`. This is done in + `GHC.Tc.Solver.simplifyDelayedErrors` + +* After constraint solving is complete report an error if there are any + remaining `DE_Multiplicity` errors. See + `GHC.Tc.Errors.reportMultiplicityCoercionErrs` + +Wrinkles + +(DME1) If the multiplicity constraint is /solved/, but with a non-reflective + coercion, we'll have just a `DE_Multiplicity` error left over. + + But if the multiplicity constraint is /unsolved/ (e.g. ManyTy ~ OneTy), we + will have /both/ an unsolved Wanted in `wc_simple`, /and/ a `DE_Multiplicity` + in `wc_errors`. We don't want to report both. Solution: suppress all + `DE_Multiplicity` constraints if there are any unsolved wanted. + + This way, the delayed error is indeed only reported when the constraint is + solved with a non-reflexivity coercion. + +An alternative would be to have a kind of constraint which can only produce +trivial evidence. This would allow such checks to happen in the constraint +solver (#18756). This would be similar to the existing setup for Concrete, see +Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete (PHASE 1 in particular). + +-} + +tcSubMult :: CtOrigin -> Mult -> Mult -> TcM () +tcSubMult origin w_actual w_expected + | Just (w1, w2) <- isMultMul w_actual = + do { tcSubMult origin w1 w_expected + ; tcSubMult origin w2 w_expected } + -- Currently, we consider p*q and sup p q to be equal. Therefore, p*q <= r is + -- equivalent to p <= r and q <= r. For other cases, we approximate p <= q by p + -- ~ q. This is not complete, but it's sound. See also Note [Overapproximating + -- multiplicities] in Multiplicity. +tcSubMult origin w_actual w_expected = + case submult w_actual w_expected of + Submult -> return () + Unknown -> tcEqMult origin w_actual w_expected + +tcEqMult :: CtOrigin -> Mult -> Mult -> TcM () +tcEqMult origin w_actual w_expected = do + { + -- Note that here we do not call to `submult`, so we check + -- for strict equality. + ; coercion <- unifyTypeAndEmit TypeLevel origin w_actual w_expected + -- See Note [Coercion errors in tcSubMult]. + ; ensureReflMultiplicityCo coercion origin } + + +{- ********************************************************************* +* * + Deep subsumption +* * +********************************************************************* -} + +{- Note [Deep subsumption] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +The DeepSubsumption extension, documented here + + https://github.com/ghc-proposals/ghc-proposals/pull/511. + +makes a best-efforts attempt implement deep subsumption as it was +prior to the Simplify Subsumption proposal: + + https://github.com/ghc-proposals/ghc-proposals/pull/287 + +The effects are in these main places: + +1. In the subsumption check, tcSubType, we must do deep skolemisation: + see the call to tcSkolemise Deep in tc_sub_type_deep + +2. In tcPolyExpr we must do deep skolemisation: + see the call to tcSkolemise in tcSkolemiseExpType + +3. for expression type signatures (e :: ty), and functions with type + signatures (e.g. f :: ty; f = e), we must deeply skolemise the type; + see the call to tcDeeplySkolemise in tcSkolemiseScoped. + +4. In GHC.Tc.Gen.App.tcApp we call tcSubTypeDS to match the result + type. Without deep subsumption, tcSubTypeMono would be sufficent. + +In all these cases note that the deep skolemisation must be done /first/. +Consider (1) + (forall a. Int -> a -> a) <= Int -> (forall b. b -> b) +We must skolemise the `forall b` before instantiating the `forall a`. +See also Note [Deep skolemisation]. + +Wrinkles: + +(DS1) Note that we /always/ use shallow subsumption in the ambiguity check. + See Note [Ambiguity check and deep subsumption]. + +(DS2) When doing deep subsumption, we must be careful not to needlessly + drop down to unification, e.g. in cases such as: + (Bool -> ∀ d. d->d) <= alpha beta gamma + See Note [FunTy vs non-FunTy case in tc_sub_type_deep]. + +(DS3) The interaction between deep subsumption and required foralls + (forall a -> ty) is a bit subtle. See #24696 and + Note [Deep subsumption and required foralls] + +Note [Deep skolemisation] +~~~~~~~~~~~~~~~~~~~~~~~~~ +deeplySkolemise decomposes and skolemises a type, returning a type +with all its arrows visible (ie not buried under foralls) + +Examples: + + deeplySkolemise (Int -> forall a. Ord a => blah) + = ( wp, [a], [d:Ord a], Int -> blah ) + where wp = \x:Int. /\a. \(d:Ord a). x + + deeplySkolemise (forall a. Ord a => Maybe a -> forall b. Eq b => blah) + = ( wp, [a,b], [d1:Ord a,d2:Eq b], Maybe a -> blah ) + where wp = /\a.\(d1:Ord a).\(x:Maybe a)./\b.\(d2:Ord b). x + +In general, + if deeplySkolemise ty = (wrap, tvs, evs, rho) + and e :: rho + then wrap e :: ty + and 'wrap' binds tvs, evs + +ToDo: this eta-abstraction plays fast and loose with termination, + because it can introduce extra lambdas. Maybe add a `seq` to + fix this + +Note [FunTy vs FunTy case in tc_sub_type_deep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The goal of tc_sub_type_deep is to produce an HsWrapper that "proves" that the +actual type is a subtype of the expected type. The most important case is how +we deal with function arrows. Suppose we have: + + ty_actual = act_arg -> act_res + ty_expected = exp_arg -> exp_res + +To produce fun_wrap :: (act_arg -> act_res) ~> (exp_arg -> exp_res), we use +the fact that the function arrow is contravariant in its argument type and +covariant in its result type. Thus we recursively perform subtype checks +on the argument types (with actual/expected switched) and the result types, +to get: + + arg_wrap :: exp_arg ~> act_arg -- NB: expected/actual have switched sides + res_wrap :: act_res ~> exp_res + +Then fun_wrap = mkWpFun arg_wrap res_wrap. + +Wrinkle [Representation-polymorphism checking during subtyping] + + Inserting a WpFun HsWrapper amounts to impedance matching in deep subsumption + via eta-expansion: + + f ==> \ (x :: exp_arg) -> res_wrap [ f (arg_wrap [x]) ] + + As we produce a lambda, we must enforce the representation polymorphism + invariants described in Note [Representation polymorphism invariants] in GHC.Core. + That is, we must ensure that both x (the lambda binder) and (arg_wrap [x]) (the function argument) + have a fixed runtime representation. + + Note however that desugaring mkWpFun does not always introduce a lambda: if + both the argument and result HsWrappers are casts, then a FunCo cast suffices, + in which case we should not perform representation-polymorphism checking. + + This means that, in the FunTy/FunTy case of tc_sub_type_deep, we can skip + the representation-polymorphism checks if the produced argument and result + wrappers are identities or casts. + It is important to do so, otherwise we reject valid programs. + + Here's a contrived example (there are undoubtedly more natural examples) + (see testsuite/tests/rep-poly/NoEtaRequired): + + type Id :: k -> k + type family Id a where + + type T :: TYPE r -> TYPE (Id r) + type family T a where + + test :: forall r (a :: TYPE r). a :~~: T a -> () + test HRefl = + let + f :: (a -> a) -> () + f _ = () + g :: T a -> T a + g = undefined + in f g + + We don't need to eta-expand `g` to make `f g` typecheck; a cast suffices. + Hence we should not perform representation-polymorphism checks; they would + fail here. + +Note [Setting the argument context] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider we are doing the ambiguity check for the (bogus) + f :: (forall a b. C b => a -> a) -> Int + +We'll call + tcSubType ((forall a b. C b => a->a) -> Int ) + ((forall a b. C b => a->a) -> Int ) + +with a UserTypeCtxt of (FunSigCtxt "f"). Then we'll do the co/contra thing +on the argument type of the (->) -- and at that point we want to switch +to a UserTypeCtxt of GenSigCtxt. Why? + +* Error messages. If we stick with FunSigCtxt we get errors like + * Could not deduce: C b + from the context: C b0 + bound by the type signature for: + f :: forall a b. C b => a->a + But of course f does not have that type signature! + Example tests: T10508, T7220a, Simple14 + +* Implications. We may decide to build an implication for the whole + ambiguity check, but we don't need one for each level within it, + and TcUnify.alwaysBuildImplication checks the UserTypeCtxt. + See Note [When to build an implication] + +Note [Multiplicity in deep subsumption] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + t1 ->{mt} t2 <= s1 ->{ms} s2 + +At the moment we /unify/ ms~mt, via tcEqMult. + +Arguably we should use `tcSubMult`. But then if mt=m0 (a unification +variable) and ms=Many, `tcSubMult` is a no-op (since anything is a +sub-multiplicty of Many). But then `m0` may never get unified with +anything. It is then skolemised by the zonker; see GHC.HsToCore.Binds +Note [Free tyvars on rule LHS]. So we in RULE foldr/app in GHC.Base +we get this + + "foldr/app" [1] forall ys m1 m2. foldr (\x{m1} \xs{m2}. (:) x xs) ys + = \xs -> xs ++ ys + +where we eta-expanded that (:). But now foldr expects an argument +with ->{Many} and gets an argument with ->{m1} or ->{m2}, and Lint +complains. + +The easiest solution was to unify the multiplicities in tc_sub_type_deep, +insisting on equality. This is only in the DeepSubsumption code anyway. + +Note [FunTy vs non-FunTy case in tc_sub_type_deep] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this, without Quick Look, but with Deep Subsumption: + f :: ∀a b c. a b c -> Int + g :: Bool -> ∀d. d -> d +To typecheck the application (f g), we need to do the subsumption test + + (Bool -> ∀ d. d->d) <= alpha beta gamma + +where alpha, beta, gamma are the unification variables that instantiate a,b,c +(respectively). We must not drop down to unification, or we will reject the call. +Instead, we should only unify alpha := (->), in which case we end up with the +usual FunTy vs FunTy case of Note [FunTy vs FunTy case in tc_sub_type_deep]: + + (Bool -> ∀ d. d->d) <= beta -> gamma + +which is straightforwardly solved by beta := Bool, using covariance in the return +type of the function arrow, and instantiating the forall before unifying with gamma. + +The conclusion is this: when doing a deep subtype check (in tc_sub_type_deep), +if the LHS is a FunTy and the RHS is a rho-type which is not a FunTy, +then unify the RHS with a FunTy and continue by performing a sub-type check on +the LHS vs the new RHS. And vice-versa (if it's the RHS that is a FunTy). + +See T11305 and T26225 for examples of when this is important. + +Note [Deep subsumption and required foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A required forall, (forall a -> ty) behaves like a "rho-type", one with no +top-level quantification. In particular, it is neither implicitly instantiated nor +skolemised. So + + rid1 :: forall a -> a -> a + rid1 = id + + rid2 :: forall a -> a -> a + rid2 a = id + +Here `rid2` wll typecheck, but `rid1` will not, because we don't implicitly skolemise +the type. + +This "no implicit subsumption nor skolemisation" applies during subsumption. +For example + (forall a. a->a) <= (forall a -> a -> a) -- NOT! +does /not/ hold, because that would require implicitly skoleming the (forall a->). + +Note also that, in Core, `eqType` distinguishes between + (forall a. blah) and forall a -> blah) +See discussion on #22762 and these Notes in GHC.Core.TyCo.Compare + * Note [ForAllTy and type equality] + * Note [Comparing visibility] + +So during deep subsumption we simply stop (and drop down to equality) when we encounter +a (forall a->). This is a little odd: +* Deep subsumption looks inside invisible foralls (forall a. ty) +* Deep subsumption looks inside arrows (t1 -> t2) +* But it does not look inside required foralls (forall a -> ty) + +There is discussion on #24696. How is this implemented? + +* In `tc_sub_type_deep`, the calls to `topInstantiate` and `deeplyInstantiate` + instantiate only /invisible/ binders. +* In `tc_sub_type_ds`, the call to `tcSkolemise` skolemises only /invisible/ + binders. + +Here is a slightly more powerful alternative +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + In the story above, if we have + (forall a -> Eq a => a -> a) <= (forall a -> Ord a => a -> a) +we'll reject it, because both are rho-types but they aren't equal. But in the +"drop to equality" stage we could instead see if both rho-types are headed with +(forall a ->) and if so strip that off and go back into deep subsumption. + +This is a bit more powerful, but also a bit more complicated, so GHC +doesn't do it yet, awaiting credible user demand. See #24696. +-} + +data DeepSubsumptionFlag = Deep | Shallow + +instance Outputable DeepSubsumptionFlag where + ppr Deep = text "Deep" + ppr Shallow = text "Shallow" + +getDeepSubsumptionFlag :: TcM DeepSubsumptionFlag +getDeepSubsumptionFlag = do { ds <- xoptM LangExt.DeepSubsumption + ; if ds then return Deep else return Shallow } + +-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption. +-- +-- Given @ty_actual@ (a sigma-type) and @ty_expected@ (deeply skolemised, i.e. +-- a deep rho type), it returns an 'HsWrapper' @wrap :: ty_actual ~> ty_expected@. +tc_sub_type_deep :: HasDebugCallStack + => Position p -- ^ Position in the type (for error messages only) + -> (TcType -> TcType -> TcM TcCoercionN) -- ^ How to unify + -> CtOrigin -- ^ Used when instantiating + -> UserTypeCtxt -- ^ Used when skolemising + -> TcSigmaType -- ^ Actual; a sigma-type + -> TcRhoType -- ^ Expected; deeply skolemised + -> TcM HsWrapper + +-- If wrap = tc_sub_type_deep t1 t2 +-- => wrap :: t1 ~> t2 +-- Here is where the work actually happens! +-- Precondition: ty_expected is deeply skolemised + +tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected + = assertPpr (isDeepRhoTy ty_expected) (ppr ty_expected) $ + do { traceTc "tc_sub_type_deep" $ + vcat [ text "ty_actual =" <+> ppr ty_actual + , text "ty_expected =" <+> ppr ty_expected ] + ; go ty_actual ty_expected } + where + + -- 'unwrap' removes top-level type synonyms & looks through filled meta-tyvars + unwrap :: TcType -> TcM TcType + unwrap ty + | Just ty' <- coreView ty + = unwrap ty' + unwrap ty@(TyVarTy tv) + = do { lookup_res <- isFilledMetaTyVar_maybe tv + ; case lookup_res of + Just ty' -> unwrap ty' + Nothing -> return ty } + unwrap ty = return ty + + go, go1 :: TcType -> TcType -> TcM HsWrapper + go ty_a ty_e = + do { ty_a' <- unwrap ty_a + ; ty_e' <- unwrap ty_e + ; go1 ty_a' ty_e' } + + -- If ty_actual is not a rho-type, instantiate it first; otherwise + -- unification has no chance of succeeding. + go1 ty_a ty_e + | let (tvs, theta, _) = tcSplitSigmaTy ty_a + , not (null tvs && null theta) + = do { (in_wrap, in_rho) <- topInstantiate inst_orig ty_a + ; body_wrap <- go in_rho ty_e + ; return (body_wrap <.> in_wrap) } + + -- Main case: FunTy vs FunTy. go_fun does the work. + go1 (FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) + (FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res }) + | isVisibleFunArg af1 + , isVisibleFunArg af2 + = go_fun af1 act_mult act_arg act_res + af2 exp_mult exp_arg exp_res + + -- See Note [FunTy vs non-FunTy case in tc_sub_type_deep] + go1 (FunTy { ft_af = af1, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res }) ty_e + | isVisibleFunArg af1 + = do { exp_mult <- newMultiplicityVar + ; exp_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand + ; exp_res <- newOpenFlexiTyVarTy + ; let exp_funTy = FunTy { ft_af = af1, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res } + ; unify_wrap <- just_unify exp_funTy ty_e + ; fun_wrap <- go_fun af1 act_mult act_arg act_res af1 exp_mult exp_arg exp_res + ; return $ unify_wrap <.> fun_wrap + -- unify_wrap :: exp_funTy ~> ty_e + -- fun_wrap :: ty_a ~> exp_funTy + } + go1 ty_a (FunTy { ft_af = af2, ft_mult = exp_mult, ft_arg = exp_arg, ft_res = exp_res }) + | isVisibleFunArg af2 + = do { act_mult <- newMultiplicityVar + ; act_arg <- newOpenFlexiTyVarTy -- NB: no FRR check needed; we might not need to eta-expand + ; act_res <- newOpenFlexiTyVarTy + ; let act_funTy = FunTy { ft_af = af2, ft_mult = act_mult, ft_arg = act_arg, ft_res = act_res } + + ; unify_wrap <- just_unify ty_a act_funTy + ; fun_wrap <- go_fun af2 act_mult act_arg act_res af2 exp_mult exp_arg exp_res + ; return $ fun_wrap <.> unify_wrap + -- unify_wrap :: ty_a ~> act_funTy + -- fun_wrap :: act_funTy ~> ty_e + } + + -- Otherwise, revert to unification. + go1 ty_a ty_e = just_unify ty_a ty_e + + just_unify ty_a ty_e = do { cow <- unify ty_a ty_e + ; return (mkWpCastN cow) } + + -- FunTy/FunTy case: this is where we insert any necessary eta-expansions. + go_fun :: FunTyFlag -> Mult -> TcType -> TcType -- actual FunTy + -> FunTyFlag -> Mult -> TcType -> TcType -- expected FunTy + -> TcM HsWrapper + go_fun act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res + -- See Note [FunTy vs FunTy case in tc_sub_type_deep] + = do { arg_wrap <- tc_sub_type_ds (Argument pos) Deep unify given_orig GenSigCtxt exp_arg act_arg + -- GenSigCtxt: See Note [Setting the argument context] + ; res_wrap <- tc_sub_type_deep (Result pos) unify inst_orig ctxt act_res exp_res + + ; mkWpFun_FRR unify pos + act_af act_mult act_arg act_res + exp_af exp_mult exp_arg exp_res + arg_wrap res_wrap + } + where + given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) + +-- | Like 'mkWpFun', except that it performs the necessary +-- representation-polymorphism checks on the argument type in the case that +-- we introduce a lambda abstraction. +mkWpFun_FRR + :: (TcType -> TcType -> TcM TcCoercionN) -- ^ how to unify + -> Position p + -> FunTyFlag -> Type -> TcType -> Type -- actual FunTy + -> FunTyFlag -> Type -> TcType -> Type -- expected FunTy + -> HsWrapper -- ^ exp_arg ~> act_arg + -> HsWrapper -- ^ act_res ~> exp_res + -> TcM HsWrapper -- ^ act_funTy ~> exp_funTy +mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap + = do { ((exp_arg_co, exp_arg_frr), (act_arg_co, _act_arg_frr)) <- + if needs_frr_checks + -- See Wrinkle [Representation-polymorphism checking during subtyping] + then do { exp_frr_wrap <- hasFixedRuntimeRep (frr_ctxt True ) exp_arg + ; act_frr_wrap <- hasFixedRuntimeRep (frr_ctxt False) act_arg + ; return (exp_frr_wrap, act_frr_wrap) } + else return ((mkNomReflCo exp_arg, exp_arg), (mkNomReflCo act_arg, act_arg)) + + -- Enforce equality of multiplicities (not the more natural sub-multiplicity). + -- See Note [Multiplicity in deep subsumption] + ; act_arg_mult_co <- unify act_mult exp_mult + -- NB: don't use tcEqMult: that would require the evidence for + -- equality to be Refl, but it might well not be (#26332). + + ; let + exp_arg_fun_co = + mkFunCo Nominal exp_af + (mkReflCo Nominal exp_mult) + (mkSymCo exp_arg_co) + (mkReflCo Nominal exp_res) + act_arg_fun_co = + mkFunCo Nominal act_af + act_arg_mult_co + act_arg_co + (mkReflCo Nominal act_res) + arg_wrap_frr = + mkWpCastN (mkSymCo exp_arg_co) <.> arg_wrap <.> mkWpCastN act_arg_co + -- exp_arg_co :: exp_arg ~> exp_arg_frr + -- act_arg_co :: act_arg ~> act_arg_frr + -- arg_wrap :: exp_arg ~> act_arg + -- arg_wrap_frr :: exp_arg_frr ~> act_arg_frr + + ; return $ + mkWpCastN exp_arg_fun_co + <.> + mkWpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) exp_res + <.> + mkWpCastN act_arg_fun_co + } + where + needs_frr_checks :: Bool + needs_frr_checks = + not (hole_or_cast arg_wrap) + || + not (hole_or_cast res_wrap) + hole_or_cast :: HsWrapper -> Bool + hole_or_cast WpHole = True + hole_or_cast (WpCast {}) = True + hole_or_cast _ = False + frr_ctxt :: Bool -> FixedRuntimeRepContext + frr_ctxt is_exp_ty = + FRRDeepSubsumption + { frrDSExpected = is_exp_ty + , frrDSPosition = pos + } + +----------------------- +deeplySkolemise :: SkolemInfo -> TcSigmaType + -> TcM ( HsWrapper + , [(Name,TcInvisTVBinder)] -- All skolemised variables + , [EvVar] -- All "given"s + , TcRhoType ) +-- See Note [Deep skolemisation] +deeplySkolemise skol_info ty + = go init_subst ty + where + init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) + + go subst ty + | Just (arg_tys, bndrs, theta, ty') <- tcDeepSplitSigmaTy_maybe ty + = do { let arg_tys' = substScaledTys subst arg_tys + ; ids1 <- newSysLocalIds (fsLit "dk") arg_tys' + ; (subst', bndrs1) <- tcInstSkolTyVarBndrsX skol_info subst bndrs + ; ev_vars1 <- newEvVars (substTheta subst' theta) + ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty' + ; let tvs = binderVars bndrs + tvs1 = binderVars bndrs1 + tv_prs1 = map tyVarName tvs `zip` bndrs1 + ; return ( mkWpEta ids1 (mkWpTyLams tvs1 + <.> mkWpEvLams ev_vars1 + <.> wrap) + , tv_prs1 ++ tvs_prs2 + , ev_vars1 ++ ev_vars2 + , mkScaledFunTys arg_tys' rho ) } + + | otherwise + = return (idHsWrapper, [], [], substTy subst ty) + -- substTy is a quick no-op on an empty substitution + +dsInstantiate :: CtOrigin -> TcType -> TcM (HsWrapper, Type) +-- Do topInstantiate or deeplyInstantiate, depending on -XDeepSubsumption +dsInstantiate orig ty + = do { ds_flag <- getDeepSubsumptionFlag + ; case ds_flag of + Shallow -> topInstantiate orig ty + Deep -> deeplyInstantiate orig ty } + +deeplyInstantiate :: CtOrigin -> TcType -> TcM (HsWrapper, Type) +-- Instantiate invisible foralls, even ones nested +-- (to the right) under arrows +deeplyInstantiate orig ty + = go init_subst ty + where + init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) + + go subst ty + | Just (arg_tys, bndrs, theta, rho) <- tcDeepSplitSigmaTy_maybe ty + = do { let tvs = binderVars bndrs + ; (subst', tvs') <- newMetaTyVarsX subst tvs + ; let arg_tys' = substScaledTys subst' arg_tys + theta' = substTheta subst' theta + ; ids1 <- newSysLocalIds (fsLit "di") arg_tys' + ; wrap1 <- instCall orig (mkTyVarTys tvs') theta' + ; (wrap2, rho2) <- go subst' rho + ; return (mkWpEta ids1 (wrap2 <.> wrap1), + mkScaledFunTys arg_tys' rho2) } + + | otherwise + = do { let ty' = substTy subst ty + ; return (idHsWrapper, ty') } + +tcDeepSplitSigmaTy_maybe + :: TcSigmaType -> Maybe ([Scaled TcType], [TcInvisTVBinder], ThetaType, TcSigmaType) +-- Looks for a *non-trivial* quantified type, under zero or more function arrows +-- By "non-trivial" we mean either tyvars or constraints are non-empty +tcDeepSplitSigmaTy_maybe ty + = go ty + where + go ty | Just (arg_ty, res_ty) <- tcSplitFunTy_maybe ty + , Just (arg_tys, tvs, theta, rho) <- go res_ty + = Just (arg_ty:arg_tys, tvs, theta, rho) + + | (tvs, theta, rho) <- tcSplitSigmaTyBndrs ty + , not (null tvs && null theta) + = Just ([], tvs, theta, rho) + + | otherwise = Nothing + +isDeepRhoTy :: TcType -> Bool +-- True if there are no foralls or (=>) at the top, or nested under +-- arrows to the right. e.g +-- forall a. a False +-- Int -> forall a. a False +-- (forall a. a) -> Int True +-- Returns True iff tcDeepSplitSigmaTy_maybe returns Nothing +isDeepRhoTy ty + | not (isRhoTy ty) = False -- Foralls or (=>) at top + | Just (_, res) <- tcSplitFunTy_maybe ty = isDeepRhoTy res + | otherwise = True -- No forall, (=>), or (->) at top + +isRhoTyDS :: DeepSubsumptionFlag -> TcType -> Bool +isRhoTyDS ds_flag ty + = case ds_flag of + Shallow -> isRhoTy ty -- isRhoTy: no top level forall or (=>) + Deep -> isDeepRhoTy ty -- "deep" version: no nested forall or (=>) + +{- +************************************************************************ +* * + Boxy unification +* * +************************************************************************ + +The exported functions are all defined as versions of some +non-exported generic functions. +-} + +unifyExprType :: HsExpr GhcRn -> TcType -> TcType -> TcM TcCoercionN +unifyExprType rn_expr ty1 ty2 + = unifyType (Just (HsExprRnThing rn_expr)) ty1 ty2 + +unifyType :: Maybe TypedThing -- ^ If present, the thing that has type ty1 + -> TcTauType -> TcTauType -- ty1 (actual), ty2 (expected) + -> TcM TcCoercionN -- :: ty1 ~# ty2 +-- Actual and expected types +-- Returns a coercion : ty1 ~ ty2 +unifyType thing ty1 ty2 + = unifyTypeAndEmit TypeLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty1 + , uo_expected = ty2 + , uo_thing = thing + , uo_visible = True } + +unifyInvisibleType :: TcTauType -> TcTauType -- ty1 (actual), ty2 (expected) + -> TcM TcCoercionN -- :: ty1 ~# ty2 +-- Actual and expected types +-- Returns a coercion : ty1 ~ ty2 +unifyInvisibleType ty1 ty2 + = unifyTypeAndEmit TypeLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty1 + , uo_expected = ty2 + , uo_thing = Nothing + , uo_visible = False } -- This is the "invisible" bit + +unifyTypeET :: TcTauType -> TcTauType -> TcM CoercionN +-- Like unifyType, but swap expected and actual in error messages +-- This is used when typechecking patterns +unifyTypeET ty1 ty2 + = unifyTypeAndEmit TypeLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty2 -- NB swapped + , uo_expected = ty1 -- NB swapped + , uo_thing = Nothing + , uo_visible = True } + + +unifyKind :: Maybe TypedThing -> TcKind -> TcKind -> TcM CoercionN +unifyKind mb_thing ty1 ty2 + = unifyTypeAndEmit KindLevel origin ty1 ty2 + where + origin = TypeEqOrigin { uo_actual = ty1 + , uo_expected = ty2 + , uo_thing = mb_thing + , uo_visible = True } + +unifyTypeAndEmit :: TypeOrKind -> CtOrigin -> TcType -> TcType -> TcM CoercionN +-- Make a ref-cell, unify, emit the collected constraints +unifyTypeAndEmit t_or_k orig ty1 ty2 + = do { ref <- newTcRef emptyBag + ; loc <- getCtLocM orig (Just t_or_k) + ; let env = UE { u_loc = loc, u_role = Nominal + , u_rewriters = emptyRewriterSet -- ToDo: check this + , u_defer = ref, u_unified = Nothing } + + -- The hard work happens here + ; co <- uType env ty1 ty2 + + ; cts <- readTcRef ref + ; unless (null cts) (emitSimples cts) + ; return co } + +{- +%************************************************************************ +%* * + uType and friends +%* * +%************************************************************************ + +Note [The eager unifier] +~~~~~~~~~~~~~~~~~~~~~~~~ +The eager unifier, `uType`, is called by + + * The constraint generator (e.g. in GHC.Tc.Gen.Expr), + via the wrappers `unifyType`, `unifyKind` etc + + * The constraint solver (e.g. in GHC.Tc.Solver.Equality), + via `GHC.Tc.Solver.Monad.wrapUnifierTcS`. + +`uType` runs in the TcM monad, but it carries a UnifyEnv that tells it +what to do when unifying a variable or deferring a constraint. Specifically, + * it collects deferred constraints in `u_defer`, and + * it records which unification variables it has unified in `u_unified` +Then it is up to the wrappers (one for the constraint generator, one for +the constraint solver) to deal with these collected sets. + +Although `uType` runs in the TcM monad for convenience, really it could +operate just with the ability to + * write to the accumulators of deferred constraints + and unification variables in UnifyEnv. + * read and update existing unification variables + * zonk types befire unifying (`zonkTcType` in `uUnfilledVar`, and + `zonkTyCoVarKind` in `uUnfilledVar1` + * create fresh coercion holes (`newCoercionHole`) + * emit tracing info for debugging + * look at the ambient TcLevel: `getTcLevel` +A job for the future. +-} + +data UnifyEnv + = UE { u_role :: Role + , u_loc :: CtLoc + , u_rewriters :: RewriterSet + + -- Deferred constraints + , u_defer :: TcRef (Bag Ct) + + -- Which variables are unified; + -- if Nothing, we don't care + , u_unified :: Maybe (TcRef [TcTyVar]) + } + +setUEnvRole :: UnifyEnv -> Role -> UnifyEnv +setUEnvRole uenv role = uenv { u_role = role } + +updUEnvLoc :: UnifyEnv -> (CtLoc -> CtLoc) -> UnifyEnv +updUEnvLoc uenv@(UE { u_loc = loc }) upd = uenv { u_loc = upd loc } + +mkKindEnv :: UnifyEnv -> TcType -> TcType -> UnifyEnv +-- Modify the UnifyEnv to be right for unifing +-- the kinds of these two types +mkKindEnv env@(UE { u_loc = ctloc }) ty1 ty2 + = env { u_role = Nominal, u_loc = mkKindEqLoc ty1 ty2 ctloc } + +uType, uType_defer + :: UnifyEnv + -> TcType -- ty1 is the *actual* type + -> TcType -- ty2 is the *expected* type + -> TcM CoercionN + +-- It is always safe to defer unification to the main constraint solver +-- See Note [Deferred unification] +uType_defer (UE { u_loc = loc, u_defer = ref + , u_role = role, u_rewriters = rewriters }) + ty1 ty2 -- ty1 is "actual", ty2 is "expected" + = do { let pred_ty = mkEqPredRole role ty1 ty2 + ; hole <- newCoercionHole pred_ty + ; let ct = mkNonCanonical $ CtWanted $ + WantedCt { ctev_pred = pred_ty + , ctev_dest = HoleDest hole + , ctev_loc = loc + , ctev_rewriters = rewriters } + co = HoleCo hole + ; updTcRef ref (`snocBag` ct) + -- snocBag: see Note [Work-list ordering] in GHC.Tc.Solver.Equality + + -- Error trace only + -- NB. do *not* call mkErrCtxt unless tracing is on, + -- because it is hugely expensive (#5631) + ; whenDOptM Opt_D_dump_tc_trace $ + do { ctxt <- getErrCtxt + ; err_ctxt <- mkErrCtxt emptyTidyEnv ctxt + ; traceTc "utype_defer" $ + vcat ( ppr role + : debugPprType ty1 + : debugPprType ty2 + : map pprErrCtxtMsg err_ctxt ) + ; traceTc "utype_defer2" (ppr co) } + + ; return co } + + +-------------- +uType env@(UE { u_role = role }) orig_ty1 orig_ty2 + | Phantom <- role + = do { kind_co <- uType (mkKindEnv env orig_ty1 orig_ty2) + (typeKind orig_ty1) (typeKind orig_ty2) + ; return (mkPhantomCo kind_co orig_ty1 orig_ty2) } + + | otherwise + = do { tclvl <- getTcLevel + ; traceTc "u_tys" $ vcat + [ text "tclvl" <+> ppr tclvl + , sep [ ppr orig_ty1, text "~" <> ppr role, ppr orig_ty2] ] + ; co <- go orig_ty1 orig_ty2 + ; if isReflCo co + then traceTc "u_tys yields no coercion" Outputable.empty + else traceTc "u_tys yields coercion:" (ppr co) + ; return co } + where + go :: TcType -> TcType -> TcM CoercionN + -- The arguments to 'go' are always semantically identical + -- to orig_ty{1,2} except for looking through type synonyms + + -- Unwrap casts before looking for variables. This way, we can easily + -- recognize (t |> co) ~ (t |> co), which is nice. Previously, we + -- didn't do it this way, and then the unification above was deferred. + go (CastTy t1 co1) t2 + = do { co_tys <- uType env t1 t2 + ; return (mkCoherenceLeftCo role t1 co1 co_tys) } + + go t1 (CastTy t2 co2) + = do { co_tys <- uType env t1 t2 + ; return (mkCoherenceRightCo role t2 co2 co_tys) } + + -- Variables; go for uUnfilledVar + -- Note that we pass in *original* (before synonym expansion), + -- so that type variables tend to get filled in with + -- the most informative version of the type + go (TyVarTy tv1) ty2 + = do { lookup_res <- isFilledMetaTyVar_maybe tv1 + ; case lookup_res of + Just ty1 -> do { traceTc "found filled tyvar" (ppr tv1 <+> text ":->" <+> ppr ty1) + ; uType env ty1 orig_ty2 } + Nothing -> uUnfilledVar env NotSwapped tv1 ty2 } + + go ty1 (TyVarTy tv2) + = do { lookup_res <- isFilledMetaTyVar_maybe tv2 + ; case lookup_res of + Just ty2 -> do { traceTc "found filled tyvar" (ppr tv2 <+> text ":->" <+> ppr ty2) + ; uType env orig_ty1 ty2 } + Nothing -> uUnfilledVar env IsSwapped tv2 ty1 } + + -- See Note [Unifying type synonyms] in GHC.Core.Unify + go ty1@(TyConApp tc1 []) (TyConApp tc2 []) + | tc1 == tc2 + = return $ mkReflCo role ty1 + + -- Now expand synonyms + -- See Note [Expanding synonyms during unification] + -- + -- Also NB that we recurse to 'go' so that we don't push a + -- new item on the origin stack. As a result if we have + -- type Foo = Int + -- and we try to unify Foo ~ Bool + -- we'll end up saying "can't match Foo with Bool" + -- rather than "can't match "Int with Bool". See #4535. + go ty1 ty2 + | Just ty1' <- coreView ty1 = go ty1' ty2 + | Just ty2' <- coreView ty2 = go ty1 ty2' + + -- Functions (t1 -> t2) just check the two parts + go (FunTy { ft_af = af1, ft_mult = w1, ft_arg = arg1, ft_res = res1 }) + (FunTy { ft_af = af2, ft_mult = w2, ft_arg = arg2, ft_res = res2 }) + | isVisibleFunArg af1 -- Do not attempt (c => t); just defer + , af1 == af2 -- Important! See #21530 + = do { co_w <- uType (env { u_role = funRole role SelMult }) w1 w2 + ; co_l <- uType (env { u_role = funRole role SelArg }) arg1 arg2 + ; co_r <- uType (env { u_role = funRole role SelRes }) res1 res2 + ; return $ mkNakedFunCo role af1 co_w co_l co_r } + + -- Always defer if a type synonym family (type function) + -- is involved. (Data families behave rigidly.) + go ty1@(TyConApp tc1 _) ty2 + | isTypeFamilyTyCon tc1 = defer ty1 ty2 + go ty1 ty2@(TyConApp tc2 _) + | isTypeFamilyTyCon tc2 = defer ty1 ty2 + + go (TyConApp tc1 tys1) (TyConApp tc2 tys2) + -- See Note [Mismatched type lists and application decomposition] + | tc1 == tc2, equalLength tys1 tys2 + , isInjectiveTyCon tc1 role -- don't look under newtypes at Rep equality + = assertPpr (isGenerativeTyCon tc1 role) (ppr tc1) $ + do { traceTc "go-tycon" (ppr tc1 $$ ppr tys1 $$ ppr tys2 $$ ppr (take 10 (tyConRoleListX role tc1))) + ; cos <- zipWith4M u_tc_arg (tyConVisibilities tc1) -- Infinite + (tyConRoleListX role tc1) -- Infinite + tys1 tys2 + ; return $ mkTyConAppCo role tc1 cos } + + go (LitTy m) ty@(LitTy n) + | m == n + = return $ mkReflCo role ty + + -- See Note [Care with type applications] + -- Do not decompose FunTy against App; + -- it's often a type error, so leave it for the constraint solver + go ty1@(AppTy s1 t1) ty2@(AppTy s2 t2) + = go_app (isNextArgVisible s1) ty1 s1 t1 ty2 s2 t2 + + go ty1@(AppTy s1 t1) ty2@(TyConApp tc2 ts2) + | Just (ts2', t2') <- snocView ts2 + = assert (not (tyConMustBeSaturated tc2)) $ + go_app (isNextTyConArgVisible tc2 ts2') + ty1 s1 t1 ty2 (TyConApp tc2 ts2') t2' + + go ty1@(TyConApp tc1 ts1) ty2@(AppTy s2 t2) + | Just (ts1', t1') <- snocView ts1 + = assert (not (tyConMustBeSaturated tc1)) $ + go_app (isNextTyConArgVisible tc1 ts1') + ty1 (TyConApp tc1 ts1') t1' ty2 s2 t2 + + go ty1@(CoercionTy co1) ty2@(CoercionTy co2) + = do { kco <- uType (mkKindEnv env ty1 ty2) + (coercionType co1) (coercionType co2) + ; return $ mkProofIrrelCo role kco co1 co2 } + + -- Anything else fails + -- E.g. unifying for-all types, which is relative unusual + go ty1 ty2 = defer ty1 ty2 + + ------------------ + defer ty1 ty2 -- See Note [Check for equality before deferring] + | ty1 `tcEqType` ty2 = return (mkReflCo role ty1) + | otherwise = uType_defer env orig_ty1 orig_ty2 + + + ------------------ + u_tc_arg is_vis role ty1 ty2 + = do { traceTc "u_tc_arg" (ppr role $$ ppr ty1 $$ ppr ty2) + ; uType env_arg ty1 ty2 } + where + env_arg = env { u_loc = adjustCtLoc is_vis False (u_loc env) + , u_role = role } + + ------------------ + -- For AppTy, decompose only nominal equalities + -- See Note [Decomposing AppTy equalities] in GHC.Tc.Solver.Equality + go_app vis ty1 s1 t1 ty2 s2 t2 + | Nominal <- role + = -- Unify arguments t1/t2 before function s1/s2, because + -- the former have smaller kinds, and hence simpler error messages + -- c.f. GHC.Tc.Solver.Equality.can_eq_app + -- Example: test T8603 + do { let env_arg = env { u_loc = adjustCtLoc vis False (u_loc env) } + ; co_t <- uType env_arg t1 t2 + ; co_s <- uType env s1 s2 + ; return $ mkAppCo co_s co_t } + | otherwise + = defer ty1 ty2 + +{- Note [Check for equality before deferring] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Particularly in ambiguity checks we can get equalities like (ty ~ ty). +If ty involves a type function we may defer, which isn't very sensible. +An egregious example of this was in test T9872a, which has a type signature + Proxy :: Proxy (Solutions Cubes) +Doing the ambiguity check on this signature generates the equality + Solutions Cubes ~ Solutions Cubes +and currently the constraint solver normalises both sides at vast cost. +This little short-cut in 'defer' helps quite a bit. + +Note [Care with type applications] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note: type applications need a bit of care! +They can match FunTy and TyConApp, so use splitAppTy_maybe +NB: we've already dealt with type variables and Notes, +so if one type is an App the other one jolly well better be too + +Note [Mismatched type lists and application decomposition] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we find two TyConApps, you might think that the argument lists +are guaranteed equal length. But they aren't. Consider matching + w (T x) ~ Foo (T x y) +We do match (w ~ Foo) first, but in some circumstances we simply create +a deferred constraint; and then go ahead and match (T x ~ T x y). +This came up in #3950. + +So either + (a) either we must check for identical argument kinds + when decomposing applications, + + (b) or we must be prepared for ill-kinded unification sub-problems + +Currently we adopt (b) since it seems more robust -- no need to maintain +a global invariant. + +Note [Expanding synonyms during unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We expand synonyms during unification, but: + * We expand *after* the variable case so that we tend to unify + variables with un-expanded type synonym. This just makes it + more likely that the inferred types will mention type synonyms + understandable to the user + + * Similarly, we expand *after* the CastTy case, just in case the + CastTy wraps a variable. + + * We expand *before* the TyConApp case. For example, if we have + type Phantom a = Int + and are unifying + Phantom Int ~ Phantom Char + it is *wrong* to unify Int and Char. + + * The problem case immediately above can happen only with arguments + to the tycon. So we check for nullary tycons *before* expanding. + This is particularly helpful when checking (* ~ *), because * is + now a type synonym. See Note [Unifying type synonyms] in GHC.Core.Unify. + +Note [Deferred unification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We may encounter a unification ty1 ~ ty2 that cannot be performed syntactically, +and yet its consistency is undetermined. Previously, there was no way to still +make it consistent. So a mismatch error was issued. + +Now these unifications are deferred until constraint simplification, where type +family instances and given equations may (or may not) establish the consistency. +Deferred unifications are of the form + F ... ~ ... +or x ~ ... +where F is a type function and x is a type variable. +E.g. + id :: x ~ y => x -> y + id e = e + +involves the unification x = y. It is deferred until we bring into account the +context x ~ y to establish that it holds. + +If available, we defer original types (rather than those where closed type +synonyms have already been expanded via tcCoreView). This is, as usual, to +improve error messages. + +************************************************************************ +* * + uUnfilledVar and friends +* * +************************************************************************ + +@uunfilledVar@ is called when at least one of the types being unified is a +variable. It does {\em not} assume that the variable is a fixed point +of the substitution; rather, notice that @uVar@ (defined below) nips +back into @uTys@ if it turns out that the variable is already bound. +-} + +---------- +uUnfilledVar, uUnfilledVar1 + :: UnifyEnv + -> SwapFlag + -> TcTyVar -- Tyvar 1: not necessarily a meta-tyvar + -- definitely not a /filled/ meta-tyvar + -> TcTauType -- Type 2 + -> TcM CoercionN +-- "Unfilled" means that the variable is definitely not a filled-in meta tyvar +-- It might be a skolem, or untouchable, or meta +uUnfilledVar env swapped tv1 ty2 + | Nominal <- u_role env + = do { ty2 <- liftZonkM $ zonkTcType ty2 + -- Zonk to expose things to the occurs check, and so + -- that if ty2 looks like a type variable then it + -- /is/ a type variable + ; uUnfilledVar1 env swapped tv1 ty2 } + + | otherwise -- See Note [Do not unify representational equalities] + -- in GHC.Tc.Solver.Equality + = unSwap swapped (uType_defer env) (mkTyVarTy tv1) ty2 + +uUnfilledVar1 env -- Precondition: u_role==Nominal + swapped + tv1 + ty2 -- ty2 is zonked + | Just tv2 <- getTyVar_maybe ty2 + = go tv2 + + | otherwise + = uUnfilledVar2 env swapped tv1 ty2 + + where + -- 'go' handles the case where both are + -- tyvars so we might want to swap + -- E.g. maybe tv2 is a meta-tyvar and tv1 is not + go tv2 | tv1 == tv2 -- Same type variable => no-op + = return (mkNomReflCo (mkTyVarTy tv1)) + + | swapOverTyVars False tv1 tv2 -- Distinct type variables + -- Swap meta tyvar to the left if poss + = do { tv1 <- liftZonkM $ zonkTyCoVarKind tv1 + -- We must zonk tv1's kind because that might + -- not have happened yet, and it's an invariant of + -- uUnfilledTyVar2 that ty2 is fully zonked + -- Omitting this caused #16902 + ; uUnfilledVar2 env (flipSwap swapped) tv2 (mkTyVarTy tv1) } + + | otherwise + = uUnfilledVar2 env swapped tv1 ty2 + +---------- +uUnfilledVar2 :: UnifyEnv -- Precondition: u_role==Nominal + -> SwapFlag + -> TcTyVar -- Tyvar 1: not necessarily a meta-tyvar + -- definitely not a /filled/ meta-tyvar + -> TcTauType -- Type 2, zonked + -> TcM CoercionN +uUnfilledVar2 env@(UE { u_defer = def_eq_ref }) swapped tv1 ty2 + = do { cur_lvl <- getTcLevel + -- See Note [Unification preconditions], (UNTOUCHABLE) wrinkles + -- Here we don't know about given equalities; so we treat + -- /any/ level outside this one as untouchable. Hence cur_lvl. + ; if simpleUnifyCheck UC_OnTheFly cur_lvl tv1 ty2 /= SUC_CanUnify + then not_ok_so_defer cur_lvl + else + do { def_eqs <- readTcRef def_eq_ref -- Capture current state of def_eqs + + -- Attempt to unify kinds + -- When doing so, be careful to preserve orientation; + -- see Note [Kind Equality Orientation] in GHC.Tc.Solver.Equality + -- and wrinkle (W2) in Note [Fundeps with instances, and equality orientation] + -- in GHC.Tc.Solver.Dict + -- Failing to preserve orientation led to #25597. + ; let kind_env = unSwap swapped (mkKindEnv env) ty1 ty2 + ; co_k <- unSwap swapped (uType kind_env) (tyVarKind tv1) (typeKind ty2) + + ; traceTc "uUnfilledVar2 ok" $ + vcat [ ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1) + , ppr ty2 <+> dcolon <+> ppr (typeKind ty2) + , ppr (isReflCo co_k), ppr co_k ] + + ; if isReflCo co_k + -- Only proceed if the kinds match + -- NB: tv1 should still be unfilled, despite the kind unification + -- because tv1 is not free in ty2' (or, hence, in its kind) + then do { liftZonkM $ writeMetaTyVar tv1 ty2 + ; case u_unified env of + Nothing -> return () + Just uref -> updTcRef uref (tv1 :) + ; return (mkNomReflCo ty2) } -- Unification is always Nominal + + else -- The kinds don't match yet, so defer instead. + do { writeTcRef def_eq_ref def_eqs + -- Since we are discarding co_k, also discard any constraints + -- emitted by kind unification; they are just useless clutter. + -- Do this dicarding by simply restoring the previous state + -- of def_eqs; a bit imperative/yukky but works fine. + ; defer } + }} + where + ty1 = mkTyVarTy tv1 + defer = unSwap swapped (uType_defer env) ty1 ty2 + + not_ok_so_defer cur_lvl = + do { traceTc "uUnfilledVar2 not ok" $ + vcat [ text "tv1:" <+> ppr tv1 + , text "ty2:" <+> ppr ty2 + , text "simple-unify-chk:" <+> ppr (simpleUnifyCheck UC_OnTheFly cur_lvl tv1 ty2) + ] + -- Occurs check or an untouchable: just defer + -- NB: occurs check isn't necessarily fatal: + -- eg tv1 occurred in type family parameter + ; defer } + +swapOverTyVars :: Bool -> TcTyVar -> TcTyVar -> Bool +swapOverTyVars is_given tv1 tv2 + -- See Note [Unification variables on the left] + | not is_given, pri1 == 0, pri2 > 0 = True + | not is_given, pri2 == 0, pri1 > 0 = False + + -- Level comparison: see Note [TyVar/TyVar orientation] + | lvl1 `strictlyDeeperThan` lvl2 = False + | lvl2 `strictlyDeeperThan` lvl1 = True + + -- Priority: see Note [TyVar/TyVar orientation] + | pri1 > pri2 = False + | pri2 > pri1 = True + + -- Names: see Note [TyVar/TyVar orientation] + | isSystemName tv2_name, not (isSystemName tv1_name) = True + + | otherwise = False + + where + lvl1 = tcTyVarLevel tv1 + lvl2 = tcTyVarLevel tv2 + pri1 = lhsPriority tv1 + pri2 = lhsPriority tv2 + tv1_name = Var.varName tv1 + tv2_name = Var.varName tv2 + + +lhsPriority :: TcTyVar -> Int +-- Higher => more important to be on the LHS +-- => more likely to be eliminated +-- Only used when the levels are identical +-- See Note [TyVar/TyVar orientation] +lhsPriority tv + = assertPpr (isTyVar tv) (ppr tv) $ + case tcTyVarDetails tv of + RuntimeUnk -> 0 + SkolemTv {} -> 0 + MetaTv { mtv_info = info, mtv_tclvl = lvl } + | QLInstVar <- lvl + -> 5 -- Eliminate instantiation variables first + | otherwise + -> case info of + CycleBreakerTv -> 0 + TyVarTv -> 1 + ConcreteTv {} -> 2 + TauTv -> 3 + RuntimeUnkTv -> 4 + +{- Note [Unification preconditions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Question: given a homogeneous equality (alpha ~# ty), when is it OK to +unify alpha := ty? +(This note only applies to /homogeneous/ equalities, in which both +sides have the same kind.) + +There are five reasons not to unify: + +1. (SKOL-ESC) Skolem-escape + Consider the constraint + forall[2] a[2]. alpha[1] ~ Maybe a[2] + If we unify alpha := Maybe a, the skolem 'a' may escape its scope. + The level alpha[1] says that alpha may be used outside this constraint, + where 'a' is not in scope at all. So we must not unify. + + Bottom line: when looking at a constraint alpha[n] := ty, do not unify + if any free variable of 'ty' has level deeper (greater) than n + +2. (UNTOUCHABLE) Untouchable unification variables + Consider the constraint + forall[2] a[2]. b[1] ~ Int => alpha[1] ~ Int + There is no (SKOL-ESC) problem with unifying alpha := Int, but it might + not be the principal solution. Perhaps the "right" solution is alpha := b. + We simply can't tell. See "OutsideIn(X): modular type inference with local + assumptions", section 2.2. We say that alpha[1] is "untouchable" inside + this implication. + + Bottom line: at ambient level 'l', when looking at a constraint + alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities + between levels 'n' and 'l'. + + Exactly what is a "given equality" for the purpose of (UNTOUCHABLE)? + Answer: see Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet + +3. (TYVAR-TV) Unifying TyVarTvs and CycleBreakerTvs + This precondition looks at the MetaInfo of the unification variable: + + * TyVarTv: When considering alpha{tyv} ~ ty, if alpha{tyv} is a + TyVarTv it can only unify with a type variable, not with a + structured type. So if 'ty' is a structured type, such as (Maybe x), + don't unify. + + * CycleBreakerTv: never unified, except by restoreTyVarCycles. + +4. (CONCRETE) A ConcreteTv can only unify with a concrete type, + by definition. + + That is, if we have `rr[conc] ~ F Int`, we can't unify + `rr` with `F Int`, so we hold off on unifying. + Note however that the equality might get rewritten; for instance + if we can rewrite `F Int` to a concrete type, say `FloatRep`, + then we will have `rr[conc] ~ FloatRep` and we can unify `rr ~ FloatRep`. + + Note that we can still make progress on unification even if + we can't fully solve an equality, e.g. + + alpha[conc] ~# TupleRep '[ beta[tau], F gamma[tau] ] + + we can fill beta[tau] := beta[conc]. This is why we call + 'makeTypeConcrete' in startSolvingByUnification. + +5. (REWRITERS) the equality does not have any unsolved equalities in its rewriter + set. If those other equalities have not been solved, unifying this equality + will propagate strange-looking errors elswhere. That is the whole point of + rewriter sets. Suppose our equality is + [W] co1 {rew = {cok}} (alpha :: k) ~ (Int |> {cok}) + where co :: Type ~ k is an unsolved wanted. Note that this equality + is homogeneous; both sides have kind k. We refrain from unifying + here, because of `cok` in its rewriter set. See + Note [Unify only if the rewriter set is empty] in GHC.Solver.Equality. + +Needless to say, all there are wrinkles: + +* (SKOL-ESC) Promotion. Given alpha[n] ~ ty, what if beta[k] is free + in 'ty', where beta is a unification variable, and k>n? 'beta' + stands for a monotype, and since it is part of a level-n type + (equal to alpha[n]), we must /promote/ beta to level n. Just make + up a fresh gamma[n], and unify beta[k] := gamma[n]. + +* (TYVAR-TV) Unification variables. Suppose alpha[tyv,n] is a level-n + TyVarTv (see Note [TyVarTv] in GHC.Tc.Types.TcMType)? Now + consider alpha[tyv,n] ~ Bool. We don't want to unify because that + would break the TyVarTv invariant. + + What about alpha[tyv,n] ~ beta[tau,n], where beta is an ordinary + TauTv? Again, don't unify, because beta might later be unified + with, say Bool. (If levels permit, we reverse the orientation here; + see Note [TyVar/TyVar orientation].) + +* (UNTOUCHABLE) Untouchability. When considering (alpha[n] ~ ty), how + do we know whether there are any given equalities between level n + and the ambient level? We answer in two ways: + + * In the eager unifier, we only unify if l=n. If not, alpha may be + untouchable, and defer to the constraint solver. This check is + made in GHC.Tc.Utils.uUnifilledVar2, in the guard + isTouchableMetaTyVar. + + * In the constraint solver, we track where Given equalities occur + and use that to guard unification in + GHC.Tc.Utils.Unify.touchabilityTest. More details in + Note [Tracking Given equalities] in GHC.Tc.Solver.InertSet + + Historical note: in the olden days (pre 2021) the constraint solver + also used to unify only if l=n. Equalities were "floated" out of the + implication in a separate step, so that they would become touchable. + But the float/don't-float question turned out to be very delicate, + as you can see if you look at the long series of Notes associated with + GHC.Tc.Solver.floatEqualities, around Nov 2020. It's much easier + to unify in-place, with no floating. + +Note [TyVar/TyVar orientation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Fundeps with instances, and equality orientation] +where the kind equality orientation is important + +Given (a ~ b), should we orient the equality as (a~b) or (b~a)? +This is a surprisingly tricky question! + +The question is answered by swapOverTyVars, which is used + - in the eager unifier, in GHC.Tc.Utils.Unify.uUnfilledVar1 + - in the constraint solver, in GHC.Tc.Solver.Equality.canEqCanLHS2 + +First note: only swap if you have to! + See Note [Avoid unnecessary swaps] + +So we look for a positive reason to swap, using a three-step test: + +* Level comparison. If 'a' has deeper level than 'b', + put 'a' on the left. See Note [Deeper level on the left] + +* Priority. If the levels are the same, look at what kind of + type variable it is, using 'lhsPriority'. + + Generally speaking we always try to put a MetaTv on the left in + preference to SkolemTv or RuntimeUnkTv, because the MetaTv may be + touchable and can be unified. + + Tie-breaking rules for MetaTvs: + - CycleBreakerTv: This is essentially a stand-in for another type; + it's untouchable and should have the same priority as a skolem: 0. + + - TyVarTv: These can unify only with another tyvar, but we can't unify + a TyVarTv with a TauTv, because then the TyVarTv could (transitively) + get a non-tyvar type. So give these a low priority: 1. + + - ConcreteTv: These are like TauTv, except they can only unify with + a concrete type. So we want to be able to write to them, but not quite + as much as TauTvs: 2. + + - TauTv: This is the common case; we want these on the left so that they + can be written to: 3. + + - RuntimeUnkTv: These aren't really meta-variables used in type inference, + but just a convenience in the implementation of the GHCi debugger. + Eagerly write to these: 4. See Note [RuntimeUnkTv] in + GHC.Runtime.Heap.Inspect. + +* Names. If the level and priority comparisons are all + equal, try to eliminate a TyVar with a System Name in + favour of ones with a Name derived from a user type signature + +* Age. At one point in the past we tried to break any remaining + ties by eliminating the younger type variable, based on their + Uniques. See Note [Eliminate younger unification variables] + (which also explains why we don't do this any more) + +Note [Unification variables on the left] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For wanteds, but not givens, swap (skolem ~ meta-tv) regardless of +level, so that the unification variable is on the left. + +* We /don't/ want this for Givens because if we ave + [G] a[2] ~ alpha[1] + [W] Bool ~ a[2] + we want to rewrite the wanted to Bool ~ alpha[1], + so we can float the constraint and solve it. + +* But for Wanteds putting the unification variable on + the left means an easier job when floating, and when + reporting errors -- just fewer cases to consider. + + In particular, we get better skolem-escape messages: + see #18114 + +Note [Deeper level on the left] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The most important thing is that we want to put tyvars with +the deepest level on the left. The reason to do so differs for +Wanteds and Givens, but either way, deepest wins! Simple. + +* Wanteds. Putting the deepest variable on the left maximise the + chances that it's a touchable meta-tyvar which can be solved. + +* Givens. Suppose we have something like + forall a[2]. b[1] ~ a[2] => beta[1] ~ a[2] + + If we orient the Given a[2] on the left, we'll rewrite the Wanted to + (beta[1] ~ b[1]), and that can float out of the implication. + Otherwise it can't. By putting the deepest variable on the left + we maximise our changes of eliminating skolem capture. + + See also GHC.Tc.Solver.InertSet Note [Let-bound skolems] for another reason + to orient with the deepest skolem on the left. + + IMPORTANT NOTE: this test does a level-number comparison on + skolems, so it's important that skolems have (accurate) level + numbers. + +See #15009 for an further analysis of why "deepest on the left" +is a good plan. + +Note [Avoid unnecessary swaps] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we swap without actually improving matters, we can get an infinite loop. +Consider + work item: a ~ b + inert item: b ~ c +We canonicalise the work-item to (a ~ c). If we then swap it before +adding to the inert set, we'll add (c ~ a), and therefore kick out the +inert guy, so we get + new work item: b ~ c + inert item: c ~ a +And now the cycle just repeats + +Historical Note [Eliminate younger unification variables] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Given a choice of unifying + alpha := beta or beta := alpha +we try, if possible, to eliminate the "younger" one, as determined +by `ltUnique`. Reason: the younger one is less likely to appear free in +an existing inert constraint, and hence we are less likely to be forced +into kicking out and rewriting inert constraints. + +This is a performance optimisation only. It turns out to fix +#14723 all by itself, but clearly not reliably so! + +It's simple to implement (see nicer_to_update_tv2 in swapOverTyVars). +But, to my surprise, it didn't seem to make any significant difference +to the compiler's performance, so I didn't take it any further. Still +it seemed too nice to discard altogether, so I'm leaving these +notes. SLPJ Jan 18. + +Note [Prevent unification with type families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We prevent unification with type families because of an uneasy compromise. +It's perfectly sound to unify with type families, and it even improves the +error messages in the testsuite. It also modestly improves performance, at +least in some cases. But it's disastrous for test case perf/compiler/T3064. +Here is the problem: Suppose we have (F ty) where we also have [G] F ty ~ a. +What do we do? Do we reduce F? Or do we use the given? Hard to know what's +best. GHC reduces. This is a disaster for T3064, where the type's size +spirals out of control during reduction. If we prevent +unification with type families, then the solver happens to use the equality +before expanding the type family. + +It would be lovely in the future to revisit this problem and remove this +extra, unnecessary check. But we retain it for now as it seems to work +better in practice. + +Revisited in Nov '20, along with removing flattening variables. Problem +is still present, and the solution is still the same. + +Note [Non-TcTyVars in GHC.Tc.Utils.Unify] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Because the same code is now shared between unifying types and unifying +kinds, we sometimes will see proper TyVars floating around the unifier. +Example (from test case polykinds/PolyKinds12): + + type family Apply (f :: k1 -> k2) (x :: k1) :: k2 + type instance Apply g y = g y + +When checking the instance declaration, we first *kind-check* the LHS +and RHS, discovering that the instance really should be + + type instance Apply k3 k4 (g :: k3 -> k4) (y :: k3) = g y + +During this kind-checking, all the tyvars will be TcTyVars. Then, however, +as a second pass, we desugar the RHS (which is done in functions prefixed +with "tc" in GHC.Tc.TyCl"). By this time, all the kind-vars are proper +TyVars, not TcTyVars, get some kind unification must happen. + +Thus, we always check if a TyVar is a TcTyVar before asking if it's a +meta-tyvar. + +This used to not be necessary for type-checking (that is, before * :: *) +because expressions get desugared via an algorithm separate from +type-checking (with wrappers, etc.). Types get desugared very differently, +causing this wibble in behavior seen here. +-} + +-- | Breaks apart a function kind into its pieces. +matchExpectedFunKind + :: TypedThing -- ^ type, only for errors + -> Arity -- ^ n: number of desired arrows + -> TcKind -- ^ fun_kind + -> TcM Coercion -- ^ co :: fun_kind ~ (arg1 -> ... -> argn -> res) + +matchExpectedFunKind hs_ty n k = go n k + where + go 0 k = return (mkNomReflCo k) + + go n k | Just k' <- coreView k = go n k' + + go n k@(TyVarTy kvar) + | isMetaTyVar kvar + = do { maybe_kind <- readMetaTyVar kvar + ; case maybe_kind of + Indirect fun_kind -> go n fun_kind + Flexi -> defer n k } + + go n (FunTy { ft_af = af, ft_mult = w, ft_arg = arg, ft_res = res }) + | isVisibleFunArg af + = do { co <- go (n-1) res + ; return (mkNakedFunCo Nominal af (mkNomReflCo w) (mkNomReflCo arg) co) } + + go n other + = defer n other + + defer n k + = do { arg_kinds <- newMetaKindVars n + ; res_kind <- newMetaKindVar + ; let new_fun = mkVisFunTysMany arg_kinds res_kind + origin = TypeEqOrigin { uo_actual = k + , uo_expected = new_fun + , uo_thing = Just hs_ty + , uo_visible = True + } + ; unifyTypeAndEmit KindLevel origin k new_fun } + +{- ********************************************************************* +* * + Checking alpha ~ ty + for the on-the-fly unifier +* * +********************************************************************* -} + +data UnifyCheckCaller + = UC_OnTheFly -- Called from the on-the-fly unifier + | UC_QuickLook -- Called from Quick Look + | UC_Solver -- Called from constraint solver + +-- | The result type of 'simpleUnifyCheck'. +data SimpleUnifyResult + -- | Definitely cannot unify (untouchable variable or incompatible top-shape) + = SUC_CannotUnify + -- | The variable is touchable and the top-shape test passed, but + -- it may or may not be OK to unify + | SUC_NotSure + -- | Definitely OK to unify + | SUC_CanUnify + deriving stock (Eq, Ord, Show) +instance Semigroup SimpleUnifyResult where + no@SUC_CannotUnify <> _ = no + SUC_CanUnify <> r = r + _ <> no@SUC_CannotUnify = no + r <> SUC_CanUnify = r + ns@SUC_NotSure <> SUC_NotSure = ns + +instance Outputable SimpleUnifyResult where + ppr = \case + SUC_CannotUnify -> text "SUC_CannotUnify" + SUC_NotSure -> text "SUC_NotSure" + SUC_CanUnify -> text "SUC_CanUnify" + +simpleUnifyCheck :: UnifyCheckCaller -> TcLevel -> TcTyVar -> TcType -> SimpleUnifyResult +-- ^ A fast check for unification. May return "not sure", in which case +-- unification might still be OK, but it'll take more work to do +-- (use the full 'checkTypeEq'). +-- +-- * Rejects if lhs_tv occurs in rhs_ty (occurs check) +-- * Rejects foralls unless +-- lhs_tv is RuntimeUnk (used by GHCi debugger) +-- or is a QL instantiation variable +-- * Rejects a non-concrete type if lhs_tv is concrete +-- * Rejects type families unless fam_ok=True +-- * Does a level-check for type variables, to avoid skolem escape +-- +-- This function is pretty heavily used, so it's optimised not to allocate +simpleUnifyCheck caller given_eq_lvl lhs_tv rhs + | not $ touchabilityTest given_eq_lvl lhs_tv + = SUC_CannotUnify + | not $ checkTopShape lhs_info rhs + = SUC_CannotUnify + | rhs_is_ok rhs + = SUC_CanUnify + | otherwise + = SUC_NotSure + where + lhs_info = metaTyVarInfo lhs_tv + + !(occ_in_ty, occ_in_co) = mkOccFolders (tyVarName lhs_tv) + + lhs_tv_lvl = tcTyVarLevel lhs_tv + lhs_tv_is_concrete = isConcreteTyVar lhs_tv + + forall_ok = case caller of + UC_QuickLook -> isQLInstTyVar lhs_tv + _ -> isRuntimeUnkTyVar lhs_tv + + -- This fam_ok thing relates to a very specific perf problem + -- See Note [Prevent unification with type families] + -- A couple of QuickLook regression tests rely on unifying with type + -- families, so we let it through there (not very principled, but let's + -- see if it bites us) + fam_ok = case caller of + UC_Solver -> True + UC_QuickLook -> True + UC_OnTheFly -> False + + rhs_is_ok (TyVarTy tv) + | lhs_tv == tv = False + | tcTyVarLevel tv `strictlyDeeperThan` lhs_tv_lvl = False + | lhs_tv_is_concrete, not (isConcreteTyVar tv) = False + | occ_in_ty $! (tyVarKind tv) = False + | otherwise = True + + rhs_is_ok (FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r}) + | not forall_ok, isInvisibleFunArg af = False + | otherwise = rhs_is_ok w && rhs_is_ok a && rhs_is_ok r + + rhs_is_ok (TyConApp tc tys) + | lhs_tv_is_concrete, not (isConcreteTyCon tc) = False + | not forall_ok, not (isTauTyCon tc) = False + | not fam_ok, not (isFamFreeTyCon tc) = False + | otherwise = all rhs_is_ok tys + + rhs_is_ok (ForAllTy (Bndr tv _) ty) + | forall_ok = rhs_is_ok (tyVarKind tv) && (tv == lhs_tv || rhs_is_ok ty) + | otherwise = False + + rhs_is_ok (AppTy t1 t2) = rhs_is_ok t1 && rhs_is_ok t2 + rhs_is_ok (CastTy ty co) = not (occ_in_co co) && rhs_is_ok ty + rhs_is_ok (CoercionTy co) = not (occ_in_co co) + rhs_is_ok (LitTy {}) = True + + +mkOccFolders :: Name -> (TcType -> Bool, TcCoercion -> Bool) +-- These functions return True +-- * if lhs_tv occurs (incl deeply, in the kind of variable) +-- * if there is a coercion hole +-- No expansion of type synonyms +mkOccFolders lhs_tv = (getAny . check_ty, getAny . check_co) + where + !(check_ty, _, check_co, _) = foldTyCo occ_folder emptyVarSet + occ_folder = TyCoFolder { tcf_view = noView -- Don't expand synonyms + , tcf_tyvar = do_tcv, tcf_covar = do_tcv + , tcf_hole = do_hole + , tcf_tycobinder = do_bndr } + + do_tcv is v = Any (not (v `elemVarSet` is) && tyVarName v == lhs_tv) + `mappend` check_ty (varType v) + + do_bndr is tcv _faf = extendVarSet is tcv + do_hole _is _hole = DM.Any True -- Reject coercion holes + +{- ********************************************************************* +* * + Equality invariant checking +* * +********************************************************************* -} + + +{- Note [Checking for foralls] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We never want to unify + alpha ~ (forall a. a->a) -> Int +So we look for foralls hidden inside the type, and it's convenient +to do that at the same time as the occurs check (which looks for +occurrences of alpha). + +However, it's not just a question of looking for foralls /anywhere/! +Consider + (alpha :: forall k. k->*) ~ (beta :: forall k. k->*) +This is legal; e.g. dependent/should_compile/T11635. + +We don't want to reject it because of the forall in beta's kind, but +(see Note [Occurrence checking: look inside kinds] in GHC.Core.Type) +we do need to look in beta's kind. So we carry a flag saying if a +'forall' is OK, and switch the flag on when stepping inside a kind. + +Why is it OK? Why does it not count as impredicative polymorphism? +The reason foralls are bad is because we reply on "seeing" foralls +when doing implicit instantiation. But the forall inside the kind is +fine. We'll generate a kind equality constraint + (forall k. k->*) ~ (forall k. k->*) +to check that the kinds of lhs and rhs are compatible. If alpha's +kind had instead been + (alpha :: kappa) +then this kind equality would rightly complain about unifying kappa +with (forall k. k->*) + +Note [Forgetful synonyms in checkTyConApp] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + type S a b = b -- Forgets 'a' + + [W] alpha[2] ~ Maybe (S beta[4] gamma[2]) + +We don't want to promote beta to level 2; rather, we should +expand the synonym. (Currently, in checkTypeEqRhs promotion +is irrevocable, by side effect.) + +To avoid this risk we eagerly expand forgetful synonyms. +This also means we won't get an occurs check in + a ~ Maybe (S a b) + +The annoyance is that we might expand the synonym unnecessarily, +something we generally try to avoid. But for now, this seems +simple. + +In a forgetful case like a ~ Maybe (S a b), `checkTyEqRhs` returns +a Reduction that looks + Reduction { reductionCoercion = Refl + , reductionReducedType = Maybe b } +We must jolly well use that reductionReduced type, even though the +reductionCoercion is Refl. See `canEqCanLHSFinish_no_unification`. +-} + +data PuResult a b + -- | Pure unifier failure. + -- + -- Invariant: the CheckTyEqResult is not 'cteOK'; that it, it specifies a problem. + = PuFail CheckTyEqResult + -- | Pure unifier success. + | PuOK (Bag a) b + deriving stock (Functor, Foldable, Traversable) + +instance Applicative (PuResult a) where + pure x = PuOK emptyBag x + PuFail p1 <*> PuFail p2 = PuFail (p1 S.<> p2) + PuFail p1 <*> PuOK {} = PuFail p1 + PuOK {} <*> PuFail p2 = PuFail p2 + PuOK c1 f <*> PuOK c2 x = PuOK (c1 `unionBags` c2) (f x) + +instance (Outputable a, Outputable b) => Outputable (PuResult a b) where + ppr (PuFail prob) = text "PuFail" <+> (ppr prob) + ppr (PuOK cts x) = text "PuOK" <> braces + (vcat [ text "redn:" <+> ppr x + , text "cts:" <+> ppr cts ]) + +okCheckRefl :: TcType -> PuResult a Reduction +okCheckRefl ty = PuOK emptyBag (mkReflRedn Nominal ty) + +mapCheck :: Monad m + => (x -> m (PuResult a Reduction)) + -> [x] + -> m (PuResult a Reductions) +mapCheck f xs + = do { (ress :: [PuResult a Reduction]) <- mapM f xs + ; return (unzipRedns <$> sequenceA ress) } + -- sequenceA :: [PuResult a Reduction] -> PuResult a [Reduction] + -- unzipRedns :: [Reduction] -> Reductions +{-# INLINEABLE mapCheck #-} + +----------------------------- +-- | Options describing how to deal with a type equality +-- in the eager unifier. See 'checkTyEqRhs' +data TyEqFlags m a + = -- | TFTyFam: LHS is a type family application + -- Invariant: we are not unifying; see `notUnifying_TEFTask` + TEFTyFam + { tefTyFam_occursCheck :: CheckTyEqProblem + -- ^ The 'CheckTyEqProblem' to report for occurs-check failures + -- (soluble or insoluble) + , tefTyFam_tyCon :: TyCon + , tefTyFam_args :: [Type] + , tef_fam_app :: TyEqFamApp m a + -- ^ How to deal with type family applications + } + + -- | TEFTyVar: LHS is a 'TyVar'. + | TEFTyVar + -- NB: this constructor does not actually store a 'TyVar', in order to + -- support being called from 'makeTypeConcrete' (which works as if we + -- created a fresh 'ConcreteTv' metavariable; see (3) in Note [TyEqFlags]) + { tefTyVar_occursCheck :: OccursCheck + -- ^ Occurs check + , tefTyVar_levelCheck :: LevelCheck m + -- ^ Level check + , tefTyVar_concreteCheck :: ConcreteCheck m + -- ^ Concreteness check + , tef_fam_app :: TyEqFamApp m a + -- ^ How to deal with type family applications + } + +-- | What to do when encountering a type-family application while processing +-- a type equality in the pure unifier. +-- +-- See Note [Family applications in canonical constraints] +data TyEqFamApp m a where + -- | Just recurse + TEFA_Recurse :: TyEqFamApp m a + -- | Recurse, but replace with cycle breaker if that fails, + -- using the specified 'FamAppBreaker' + TEFA_Break :: FamAppBreaker a -> TyEqFamApp TcM a + +-- | A defunctionalisation of family application breaker functions. +-- Interpreter: `famAppBreaker` +data FamAppBreaker a where + BreakGiven :: FamAppBreaker (TcTyVar, TcType) + BreakWanted :: CtEvidence -> TcTyVar -> FamAppBreaker Ct + +data OccursCheck where + -- | No occurs check. + OC_None :: OccursCheck + -- | Do an occurs check between the LHS tyvar and the RHS. + OC_Check :: + { occurs_tv_name :: Name + -- ^ The 'Name' to perform an occurs-check on + , occurs_problem :: CheckTyEqProblem + -- ^ Which 'CheckTyEqProblem' to report for occurs-check failures + -- (soluble or insoluble) + } -> OccursCheck + +-- | What level check to perform, in a call to the pure unifier? +-- A defunctionalisation of the possible level-check functions +-- Interpreter: `tyVarLevelCheck` +data LevelCheck m where + -- | No level check. + LC_None :: LevelCheck m + -- | Do a level check between the LHS tyvar and the occurrence tyvar. + -- + -- Fail if the level check fails. + -- + -- True <=> lenient check, e.g. the levels have a chance of working out + -- after promotion. + LC_Check :: + { lc_lvlc :: TcLevel + , lc_lenient :: Bool + } -> LevelCheck m + + -- | Do a level check between the LHS tyvar and the occurrence tyvar. + -- + -- If the level check fails, and the occurrence is a unification + -- variable, promote it. + -- + -- - False <=> don't promote under type families (the common case) + -- - True <=> promote even under type families + -- (see Note [Defaulting equalities] in GHC.Tc.Solver) + LC_Promote + :: { lc_lvlp :: TcLevel + , lc_deep :: Bool + } -> LevelCheck TcM + +data ConcreteCheck m where + -- | No concreteness check. + CC_None :: ConcreteCheck m + -- | Simple check for concreteness, leniently returning 'OK' + -- if concreteness could be achieved after promotion. + CC_Check :: ConcreteCheck m + -- | Proper concreteness check: promote non-concrete metavariables, + -- failing if there are any problems. + CC_Promote :: ConcreteTvOrigin -> ConcreteCheck TcM + +{- Note [TyEqFlags] +~~~~~~~~~~~~~~~~~~~ +When we call the eager unifier, e.g. through 'checkTyEqRhs', we specify what +kind of checks the unifier performs via the 'TyEqFlags' argument. In particular, +when the LHS type in a unification is a type variable, we might want to perform +different checks; this is achieved using the 'TEFTyVar' constructor to 'TyEqFlags': + + 1. `notUnifying_TEFTask` + LHS is a skolem tyvar, or an untouchable meta-tyvar. + We are not unifying; we only want to perform occurs-checks. + + TEFTyVar + { tefTyVar_occursCheck = OC_Check ... + , tefTyVar_levelCheck = LC_None + , tefTyVar_concreteCheck = CC_None + , tef_fam_app = TEFA_Recurse + } + + 2a. `unifyingLHSMetaTyVar_TEFTask` + We are unifying; we want to perform an occurs check, a level check, + and a concreteness check (when the meta-tyvar is a ConcreteTv). + + TEFTyVar + { tefTyVar_occursCheck = OC_Check ... + , tefTyVar_levelCheck = LC_Promote ... + , tefTyVar_concreteCheck = CC_Promote or CC_None + -- depending on whether or not the lhs tv is concrete + , tef_fam_app = TEFA_Recurse + } + + 2b. `defaulting_TEFTask` + We are in the top-level defaulting code, considering unifying a + touchable meta-tyvar with a type. + + TEFTyVar + { tefTyVar_occursCheck = OC_None + , tefTyVar_levelCheck = LC_None + , tefTyVar_concreteCheck = CC_Promote or CC_None + -- depending on whether or not the lhs tv is concrete + , tef_fam_app = TEFA_Recurse + } + + 3. `makeTypeConcrete` + LHS is a fresh ConcreteTv meta-tyvar (see call to 'checkTyEqRhs' in + `makeTypeConcrete`). We are unifying; we only want to perform + a concreteness check. + + TEFTyVar + { tefTyVar_occursCheck = OC_None + , tefTyVar_levelCheck = LC_None + , tefTyVar_concreteCheck = CC_Promote conc_orig + , tef_fam_app = TEFA_Recurse + } + + 4. `pureTyEqFlags_LHSMetaTyVar` + We want to perform a non-monadic check, i.e. we want to know whether we are able + to unify 'lhs_tv' with 'rhs_ty', but don't want to actually perform + a side-effecting unification. This is used in 'mightEqualLater'. + + TEFTyVar + { tefTyVar_occursCheck = OC_Check ... + , tefTyVar_levelCheck = LC_Check ... + , tefTyVar_concreteCheck = CC_Check or CC_None + -- depending on whether or not the lhs tv is concrete + , tef_fam_app = TEFA_Recurse + } + + Here 'LC_Check True' and 'ConcreteSimpleCheck' make 'checkTyEqRhs' perform + conservative pure checks, without actually carrying out any promotion. +-} + +-- | Create a "not unifying" 'TyEqFlags' from a 'CanEqLHS'. +-- +-- See use-case (1) in Note [TyEqFlags]. +notUnifying_TEFTask :: CheckTyEqProblem -> CanEqLHS -> TyEqFlags m a +notUnifying_TEFTask occ_prob = \case + TyFamLHS tc tys -> + TEFTyFam + { tefTyFam_tyCon = tc + , tefTyFam_args = tys + , tefTyFam_occursCheck = occ_prob + , tef_fam_app = TEFA_Recurse + } + TyVarLHS tv -> + TEFTyVar + { tefTyVar_occursCheck = OC_Check (tyVarName tv) occ_prob + , tefTyVar_levelCheck = LC_None + , tefTyVar_concreteCheck = CC_None + , tef_fam_app = TEFA_Recurse + } + -- We need an occurs-check here, but no level check. + -- See Note [Promotion and level-checking] wrinkle (W1) + -- TEFA_Recurse: see Note [Don't cycle-break Wanteds when not unifying] + +-- | Create "unifying" 'TyEqFlags' from a 'TyVarLHS'. +-- +-- Invariant: the argument 'TcTyVar' is a 'MetaTv'. +unifyingLHSMetaTyVar_TEFTask :: CtEvidence -> TcTyVar -> TyEqFlags TcM Ct +unifyingLHSMetaTyVar_TEFTask ev lhs_tv = + TEFTyVar + { tefTyVar_occursCheck = OC_Check (tyVarName lhs_tv) cteInsolubleOccurs + , tefTyVar_levelCheck = LC_Promote { lc_lvlp = tcTyVarLevel lhs_tv + , lc_deep = False } + , tefTyVar_concreteCheck = mkConcreteCheck lhs_tv + , tef_fam_app = mkTEFA_Break ev NomEq (BreakWanted ev lhs_tv) + } + +defaulting_TEFTask :: TcTyVar -> TyEqFlags TcM a +-- Used during top-level defauting in GHC.Tc.Solver.Default.defaultEquality +-- Invariant: the argument 'TcTyVar' is a 'MetaTv'. +defaulting_TEFTask lhs_tv = + TEFTyVar + { tefTyVar_occursCheck = OC_Check (tyVarName lhs_tv) cteInsolubleOccurs + , tefTyVar_levelCheck = LC_Promote { lc_lvlp = tcTyVarLevel lhs_tv + , lc_deep = True } + -- LC_Promote: promote deeper unification variables (DE4) + -- lc_deep = True: ...including under type families (DE5) + , tefTyVar_concreteCheck = mkConcreteCheck lhs_tv + , tef_fam_app = TEFA_Recurse + } + +mkConcreteCheck :: TcTyVar -> ConcreteCheck TcM +mkConcreteCheck lhs_tv = case isConcreteTyVar_maybe lhs_tv of + Nothing -> CC_None + Just conc_orig -> CC_Promote conc_orig + +-- | 'TyEqFlags' for a pure call of 'checkTyEqRhs'. +-- +-- A call to 'checkTyEqRhs' with these 'TyEqFlags' will perform an optimistic +-- check: it will return 'PuFail' if there is definitely a problem, but it +-- might return 'PuOK' if it isn't entirely sure. +pureTyEqFlags_LHSMetaTyVar :: TyVar -> TyEqFlags Identity () +pureTyEqFlags_LHSMetaTyVar lhs_tv = + TEFTyVar + { tefTyVar_occursCheck = OC_Check (tyVarName lhs_tv) cteInsolubleOccurs + , tefTyVar_levelCheck = LC_Check { lc_lvlc = tcTyVarLevel lhs_tv + , lc_lenient = True } + , tefTyVar_concreteCheck = case isConcreteTyVar_maybe lhs_tv of + Nothing -> CC_None + Just {} -> CC_Check -- No promotion + , tef_fam_app = TEFA_Recurse } + + +mkTEFA_Break :: CtEvidence -> EqRel -> FamAppBreaker a -> TyEqFamApp TcM a +mkTEFA_Break ev eq_rel breaker + | NomEq <- eq_rel + , not cycle_breaker_origin + = TEFA_Break breaker + | otherwise + = TEFA_Recurse + where + -- cycle_breaker_origin: see Detail (7) of Note [Type equality cycles] + -- in GHC.Tc.Solver.Equality + cycle_breaker_origin = case ctLocOrigin (ctEvLoc ev) of + CycleBreakerOrigin {} -> True + _ -> False + +-- | Do we want to perform a concreteness check in 'checkTyEqRhs'? +tefConcrete :: TyEqFlags m a -> Bool +tefConcrete (TEFTyFam {}) = False +tefConcrete (TEFTyVar { tefTyVar_concreteCheck = conc }) = + wantConcreteCheck conc + +wantConcreteCheck :: ConcreteCheck m -> Bool +wantConcreteCheck = \case + CC_None -> False + CC_Check -> True + CC_Promote {} -> True + +-- | Given a family-application @ty@, return a @'Reduction' :: ty ~ cbv@ +-- where @cbv@ is a fresh loop-breaker tyvar (for Given), or +-- just a fresh 'TauTv' (for Wanted) +famAppBreaker :: FamAppBreaker a -> TcType -> TcM (PuResult a Reduction) +famAppBreaker BreakGiven fam_app + = do { new_tv <- TcM.newCycleBreakerTyVar (typeKind fam_app) + ; return (PuOK (unitBag (new_tv, fam_app)) + (mkReflRedn Nominal (mkTyVarTy new_tv))) } + -- Why reflexive? See Detail (4) of Note [Type equality cycles] + -- in GHC.Tc.Solver.Equality +famAppBreaker (BreakWanted ev lhs_tv) fam_app + -- Occurs check or skolem escape; so flatten + = do { reason <- checkPromoteFreeVars cteInsolubleOccurs + (tyVarName lhs_tv) lhs_tv_lvl + (tyCoVarsOfType fam_app_kind) + ; if not (cterHasNoProblem reason) -- Failed to promote free vars + then return $ PuFail reason + else + do { new_tv_ty <- + case lhs_tv_info of + ConcreteTv conc_info -> + -- Make a concrete tyvar if lhs_tv is concrete + -- e.g. alpha[2,conc] ~ Maybe (F beta[4]) + -- We want to flatten to + -- alpha[2,conc] ~ Maybe gamma[2,conc] + -- gamma[2,conc] ~ F beta[4] + TcM.newConcreteTyVarTyAtLevel conc_info lhs_tv_lvl fam_app_kind + _ -> TcM.newMetaTyVarTyAtLevel lhs_tv_lvl fam_app_kind + + ; let pty = mkNomEqPred fam_app new_tv_ty + ; hole <- TcM.newCoercionHole pty + ; let new_ev = WantedCt { ctev_pred = pty + , ctev_dest = HoleDest hole + , ctev_loc = cb_loc + , ctev_rewriters = ctEvRewriters ev } + ; return (PuOK (singleCt (mkNonCanonical $ CtWanted new_ev)) + (mkReduction (HoleCo hole) new_tv_ty)) } } + where + fam_app_kind = typeKind fam_app + (lhs_tv_info, lhs_tv_lvl) = + case tcTyVarDetails lhs_tv of + MetaTv { mtv_info = info, mtv_tclvl = lvl } -> (info,lvl) + -- lhs_tv should be a meta-tyvar + _ -> pprPanic "famAppBreaker BreakWanted: lhs_tv is not a meta-tyvar" + (ppr lhs_tv) + cb_loc = updateCtLocOrigin (ctEvLoc ev) CycleBreakerOrigin + -- CycleBreakerOrigin: see Detail (7) of Note [Type equality cycles] + +instance Outputable (TyEqFlags m a) where + ppr = \case + TEFTyFam occ tc tys fam_app -> + text "TEFTyFam" <> braces ( + hcat [ ppr occ + , ppr (mkTyConApp tc tys) + , ppr fam_app ] ) + TEFTyVar occ lc conc fam_app -> + text "TEFTyVar" <> braces (hcat (punctuate comma fields)) + where + fields = [ text "OccursCheck:" <+> ppr occ ] + ++ + [ text "LevelCheck:" <+> ppr lc ] + ++ + [ text "ConcreteCheck:" <+> ppr conc ] + ++ + [ text "FamApp:" <+> ppr fam_app ] + +instance Outputable (TyEqFamApp m a) where + ppr TEFA_Recurse = text "TEFA_Recurse" + ppr (TEFA_Break breaker) = text "TEFA_BreakGiven" <+> ppr breaker + +instance Outputable (FamAppBreaker a) where + ppr BreakGiven = text "BreakGiven" + ppr (BreakWanted ev tv) = parens $ text "BreakWanted" <+> ppr ev <+> ppr tv + +instance Outputable OccursCheck where + ppr OC_None = text "OC_None" + ppr (OC_Check { occurs_tv_name = nm }) = text "OC_Check" <+> ppr nm +instance Outputable (ConcreteCheck m) where + ppr CC_None = text "CC_None" + ppr CC_Check = text "CC_Check" + ppr (CC_Promote {}) = text "CC_Promote" +instance Outputable (LevelCheck m) where + ppr (LC_None) = text "LC_None" + ppr (LC_Check lvl lenient) = text "LC_Check" <+> ppr lvl <+> ppWhen lenient (text "(lenient)") + ppr (LC_Promote lvl deep) = text "LC_Promote" <+> ppr lvl <+> ppWhen deep (text "(deep)") + +-- | Adjust the 'TyEqFlags' when going under a type family: +-- +-- 1. Only the outer family application gets the loop-breaker treatment +-- 2. Weaken level checks for tyvar promotion. For example, in @[W] alpha[2] ~ Maybe (F beta[3])@, +-- do not promote @beta[3]@, instead promote @(F beta[3])@. +-- 3. Occurs checks become potentially soluble (after additional type family +-- reductions). +famAppArgFlags :: TyEqFlags m a -> TyEqFlags m a +famAppArgFlags flags = case flags of + TEFTyFam {} -> + flags + { tef_fam_app = TEFA_Recurse -- (1) + , tefTyFam_occursCheck = cteSolubleOccurs -- (3) + } + TEFTyVar { tefTyVar_occursCheck = occ, tefTyVar_levelCheck = mb_lc } -> + flags + { tef_fam_app = TEFA_Recurse -- (1) + , tefTyVar_levelCheck = zap_lc mb_lc -- (2) + , tefTyVar_occursCheck = soluble_occ occ -- (3) + } + where + soluble_occ = \case + OC_Check tv _ -> OC_Check tv cteSolubleOccurs + OC_None -> OC_None + zap_lc = \case + LC_Promote { lc_lvlp = lvl, lc_deep = deeply } + | not deeply + -> LC_Check { lc_lvlc = lvl, lc_lenient = False } + lc -> lc + +{- Note [checkTyEqRhs] +~~~~~~~~~~~~~~~~~~~~~~ +The key function `checkTyEqRhs ty_eq_flags rhs` is called on the +RHS of a type equality + lhs ~ rhs +and checks to see if `rhs` satisfies, or can be made to satisfy, +invariants described by `ty_eq_flags`. It can succeded or fail; in +the latter case it returns a `CheckTyEqResult` that describes why it +failed. + +When `lhs` is a touchable type variable, so unification might happen, then +`checkTyEqRhs` enforces the unification preconditions of Note [Unification preconditions]. + +Notably, it can check for things like: + * Insoluble occurs check + e.g. alpha[tau] ~ [alpha] + or F Int ~ [F Int] + * Potentially-soluble occurs check + e.g. alpha[tau] ~ [F alpha beta] + * Impredicativity error: + e.g. alpha[tau] ~ (forall a. a->a) + * Skolem escape + e.g alpha[1] ~ (b[sk:2], Int) + * Concreteness error + e.g. alpha[conc] ~ r[sk] + +Its specific behaviour is governed by the `TyEqFlags` that are passed +to it; see Note [TyEqFlags]. + +Note, however, that `checkTyEqRhs` specifically does /not/ check for: + * Touchability of the LHS (in the case of a unification variable) + * Shape of the LHS (e.g. we can't unify Int with a TyVarTv) +These things are checked by `simpleUnifyCheck`. +-} + + +-- | Perform the checks specified by the 'TyEqFlags' on the RHS, in order to +-- enforce the unification preconditions of Note [Unification preconditions]. +-- +-- See Note [checkTyEqRhs]. +checkTyEqRhs :: forall m a + . Monad m + => TyEqFlags m a + -> TcType -- Already zonked + -> m (PuResult a Reduction) +checkTyEqRhs flags rhs + -- Crucial special case for a top-level equality of the form 'alpha ~ F tys'. + -- We don't want to flatten that (F tys), as this gets us right back to where + -- we started! + -- + -- See also Note [Special case for top-level of Given equality] + | Just (TyFamLHS tc tys) <- canTyFamEqLHS_maybe rhs + , not $ tefConcrete flags + = recurseIntoFamTyConApp flags tc tys + | otherwise + = check_ty_eq_rhs flags rhs + +{- Note [Special case for top-level of Given equality] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We take care when examining + [G] F ty ~ G (...(F ty)...) +where both sides are TyFamLHSs. We don't want to flatten that RHS to + [G] F ty ~ cbv + [G] G (...(F ty)...) ~ cbv +Instead we'd like to say "occurs-check" and swap LHS and RHS, which yields a +canonical constraint + [G] G (...(F ty)...) ~ F ty +That tends to rewrite a big type to smaller one. This happens in T15703, +where we had: + [G] Pure g ~ From1 (To1 (Pure g)) +Making a loop breaker and rewriting left to right just makes much bigger +types than swapping it over. + +(We might hope to have swapped it over before getting to checkTypeEq, +but better safe than sorry.) + +NB: We never see a TyVarLHS here, such as + [G] a ~ F tys here +because we'd have swapped it to + [G] F tys ~ a +in canEqCanLHS2, before getting to checkTypeEq. +-} + +check_ty_eq_rhs :: forall m a + . Monad m + => TyEqFlags m a + -> TcType -- Already zonked + -> m (PuResult a Reduction) +check_ty_eq_rhs flags ty + = case ty of + LitTy {} -> return $ okCheckRefl ty + TyConApp tc tys -> checkTyConApp flags ty tc tys + TyVarTy tv -> checkTyVar flags tv + -- Don't worry about foralls inside the kind; see Note [Checking for foralls] + -- Nor can we expand synonyms; see Note [Occurrence checking: look inside kinds] + -- in GHC.Core.FVs + + FunTy {ft_af = af, ft_mult = w, ft_arg = a, ft_res = r} + | isInvisibleFunArg af -- e.g. Num a => blah + -> return $ PuFail impredicativeProblem -- Not allowed (TyEq:F) + | otherwise + -> do { w_res <- check_ty_eq_rhs flags w + ; a_res <- check_ty_eq_rhs flags a + ; r_res <- check_ty_eq_rhs flags r + ; return (mkFunRedn Nominal af <$> w_res <*> a_res <*> r_res) } + + AppTy fun arg -> do { fun_res <- check_ty_eq_rhs flags fun + ; arg_res <- check_ty_eq_rhs flags arg + ; return (mkAppRedn <$> fun_res <*> arg_res) } + + CastTy ty co -> do { ty_res <- check_ty_eq_rhs flags ty + ; co_res <- checkCo flags co + ; return (mkCastRedn1 Nominal ty <$> co_res <*> ty_res) } + + CoercionTy co -> do { co_res <- checkCo flags co + ; return (mkReflCoRedn Nominal <$> co_res) } + + ForAllTy {} -> return $ PuFail impredicativeProblem -- Not allowed (TyEq:F) +{-# INLINEABLE check_ty_eq_rhs #-} + +------------------- +checkCo :: Monad m => TyEqFlags m a -> Coercion -> m (PuResult a Coercion) +-- See Note [checkCo] +checkCo flags co = + case flags of + TEFTyFam {} -> + -- NB: 'TEFTyFam' case means we are not unifying. + return (pure co) + TEFTyVar + { tefTyVar_concreteCheck = conc + , tefTyVar_levelCheck = lc + , tefTyVar_occursCheck = occ + } + -- Coercions cannot appear in concrete types. + -- + -- See Note [Concrete types] in GHC.Tc.Utils.Concrete. + | case conc of { CC_None -> False; _ -> True } + -> return $ PuFail (cteProblem cteConcrete) + + -- Occurs check (can promote) + | OC_Check lhs_tv occ_prob <- occ + , LC_Promote { lc_lvlp = lhs_tv_lvl } <- lc + -> do { reason <- checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl (tyCoVarsOfCo co) + ; return $ + if cterHasNoProblem reason + then pure co + else PuFail reason } + + -- Occurs check (no promotion) + | OC_Check lhs_tv occ_prob <- occ + , nameUnique lhs_tv `elemVarSetByKey` tyCoVarsOfCo co + -> return $ PuFail (cteProblem occ_prob) + + | otherwise + -> return (pure co) + +{- Note [checkCo] +~~~~~~~~~~~~~~~~~ +We don't often care about the contents of coercions, so checking +coercions before making an equality constraint may be surprising. +But there are several cases we need to be wary of: + +(1) When we're unifying a variable, we must make sure that the variable + appears nowhere on the RHS -- even in a coercion. Otherwise, we'll + create a loop. + +(2) We must still make sure that no variable in a coercion is at too + high a level. But, when unifying, we can promote any variables we encounter. + +Note [Promotion and level-checking] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +"Promotion" happens when we have this: + + [W] w1: alpha[2] ~ Maybe beta[4] + +Here we must NOT unify alpha := Maybe beta, because beta may turn out +to stand for a type involving some inner skolem. Yikes! +Skolem-escape. So instead we /promote/ beta, like this: + + beta[4] := beta'[2] + [W] w1: alpha[2] ~ Maybe beta'[2] + +Now we can unify alpha := Maybe beta', which might unlock other +constraints. But if some other constraint wants to unify beta with a +nested skolem, it'll get stuck with a skolem-escape error. + +Now consider `w2` where a type family is involved (#22194): + + [W] w2: alpha[2] ~ Maybe (F gamma beta[4]) + +In `w2`, it may or may not be the case that `beta` is level 2; suppose +we later discover gamma := Int, and type instance F Int _ = Int. +So, instead, we promote the entire funcion call: + + [W] w2': alpha[2] ~ Maybe gamma[2] + [W] w3: gamma[2] ~ F gamma beta[4] + +Now we can unify alpha := Maybe gamma, which is a Good Thng. + +Wrinkle (W1) + +There is an important wrinkle: /all this only applies when unifying/. +For example, suppose we have + [G] a[2] ~ Maybe b[4] +where 'a' is a skolem. This Given might arise from a GADT match, and +we can absolutely use it to rewrite locally. In fact we must do so: +that is how we exploit local knowledge about the outer skolem a[2]. +This applies equally for a Wanted [W] a[2] ~ Maybe b[4]. Using it for +local rewriting is fine. (It's not clear to me that it is /useful/, +but it's fine anyway.) + +So we only do the level-check in checkTyVar when /unifying/ not for +skolems (or untouchable unification variables). + +Note [Family applications in canonical constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A constraint with a type family application in the RHS needs special care. +This is dealt with by `checkFamApp`. + +(CFA1) First, occurs checks. If we have + [G] a ~ Maybe (F (Maybe a)) + [W] alpha ~ Maybe (F (Maybe alpha)) + it looks as if we have an occurs check. But go read + Note [Type equality cycles] in GHC.Tc.Solver.Equality + + The same considerations apply when the LHS is a type family: + [G] G a ~ Maybe (F (Maybe (G a))) + [W] G alpha ~ Maybe (F (Maybe (G alpha))) + +(CFA2) Second, promotion. If we have (#22194) + [W] alpha[2] ~ Maybe (F beta[4]) + it is wrong to promote beta. Instead we want to split to + [W] alpha[2] ~ Maybe gamma[2] + [W] gamma[2] ~ F beta[4] + See Note [Promotion and level-checking] above. + +(CFA3) Third, concrete type variables. If we have + [W] alpha[conc] ~ Maybe (F tys) + we want to add an extra variable thus: + [W] alpha[conc] ~ Maybe gamma[conc] + [W] gamma[conc] ~ F tys + Now we can unify alpha, and that might unlock something else. + +In all these cases we want to create a fresh type variable, and +emit a new equality connecting it to the type family application. + +Once these three cases are dealt with, the `tef_fam_app` field of `TypeEqFlags` +says what to do: + +(CFA4) `TEFA_Recurse` is straightforward: just recurse into the arguments, + BUT use `recurseIntoFamTyConApp` to record that we are now "under" a + type-family application; see `famAppArgFlags`. + +(CFA5) `TEFA_Break` is the clever one. It does a two-step process: + + (1) Recurse into the arguments with `recurseIntoFamTyConApp`. + + (2) If any of the arguments fail (level-check error, occurs check, + concreteness failure), use the `FamAppBreaker` to create a cycle breaker. + + Remarks: + + * It would be possible to use Step (2) above always, skipping Step (1). + But this would create many unnecessary cycle-breaker variables. + This was the cause of #25933. + + * This always cycle-breaks the /outermost/ family application. + If we have [W] alpha ~ Maybe (F (G alpha)): + - We'll use checkFamApp on `(F (G alpha))` + - In Step (1), `recurseIntoFamTyConApp` sets `tef_fam_app := TEFA_Recurse`, + before looking at the argument `(G alpha)`. So we will not cycle-break + the latter + - The occurs check will fire when we hit `alpha` + - `checkFamApp` on `(F (G alpha))` will see the failure and invoke + the `FamAppBreaker`. + + * Step (1) may fail because of a level-check problem, which activates step (2). + This is what implements (CFA2). +-} + +------------------- +checkTyConApp :: Monad m + => TyEqFlags m a + -> TcType -> TyCon -> [TcType] + -> m (PuResult a Reduction) +checkTyConApp flags tc_app tc tys + | isTypeFamilyTyCon tc + , let arity = tyConArity tc + = if tys `lengthIs` arity + then checkFamApp flags tc_app tc tys -- Common case + else do { let (fun_args, extra_args) = splitAt (tyConArity tc) tys + fun_app = mkTyConApp tc fun_args + ; fun_res <- checkFamApp flags fun_app tc fun_args + ; extra_res <- mapCheck (check_ty_eq_rhs flags) extra_args + ; return (mkAppRedns <$> fun_res <*> extra_res) } + + | Just ty' <- rewriterView tc_app + -- e.g. S a where type S a = F [a] + -- or type S a = Int + -- See Note [Forgetful synonyms in checkTyConApp] + = check_ty_eq_rhs flags ty' + + | not (isTauTyCon tc) + = return $ PuFail impredicativeProblem + + | tefConcrete flags + , not (isConcreteTyCon tc) + = return $ PuFail (cteProblem cteConcrete) + + | otherwise -- Recurse on arguments + = recurseIntoTyConApp flags tc tys + +------------------- +recurseIntoTyConApp :: Monad m + => TyEqFlags m a + -> TyCon -> [TcType] + -> m (PuResult a Reduction) +recurseIntoTyConApp flags tc tys + = do { tys_res <- mapCheck (check_ty_eq_rhs flags) tys + ; return (mkTyConAppRedn Nominal tc <$> tys_res) } + +recurseIntoFamTyConApp :: Monad m + => TyEqFlags m a + -> TyCon -> [TcType] + -> m (PuResult a Reduction) +recurseIntoFamTyConApp flags tc tys + = recurseIntoTyConApp (famAppArgFlags flags) tc tys + -- famAppArgFlags: adjust flags when going under fam app + +------------------- + +-- | See Note [Family applications in canonical constraints] +checkFamApp :: forall m a. + Monad m + => TyEqFlags m a + -> TcType -> TyCon -> [TcType] -- Saturated family application + -> m (PuResult a Reduction) +checkFamApp flags fam_app tc tys = + case flags of + TEFTyFam { tefTyFam_tyCon = lhs_tc, tefTyFam_args = lhs_tys + , tefTyFam_occursCheck = occ_prob } + | tcEqTyConApps lhs_tc lhs_tys tc tys + -- There is an occurs check F ty ~ ...(F ty)... + -- Do not recurse; see (CFA1) in Note [Family applications in canonical constraints] + -> do_not_recurse occ_prob + TEFTyVar { tefTyVar_concreteCheck = conc } + | wantConcreteCheck conc + -- We are checking for concreteness, e.g. kappa[conc] ~ ...(F ty)... + -- Do not recurse: type family applications are not concrete. + -- See (CFA3) in Note [Family applications in canonical constraints] + -> do_not_recurse cteConcrete + _ -> + -- We can recurse into the arguments of the type family application. + case fam_flags of + TEFA_Recurse -> + -- Simply recurse into the arguments. + -- See (CFA4) in Note [Family applications in canonical constraints] + recurseIntoFamTyConApp flags tc tys + TEFA_Break brk -> + -- Recurse into the arguments, and cycle-break if that fails + -- + -- e.g. alpha[2] ~ Maybe (F beta[2]) No problem: just unify + -- alpha[2] ~ Maybe (F beta[4]) Level-check problem: break + -- + -- NB: in the latter case, don't promote beta[4]; use 'recurseIntoFamTyConApp' + -- which modifies the flags with 'famAppArgFlags'. + do { rec_res <- recurseIntoFamTyConApp flags tc tys + ; case rec_res of + PuOK {} -> return rec_res + PuFail {} -> famAppBreaker brk fam_app + } + where + fam_flags = tef_fam_app flags + do_not_recurse prob = + case fam_flags of + TEFA_Recurse -> return $ PuFail (cteProblem prob) + TEFA_Break brk -> famAppBreaker brk fam_app + +------------------- + +-- | The result of a single check in 'checkTyVar', such as a concreteness check +-- or a level check. +data TyVarCheckResult m where + -- | Check succeded; nothing else to do. + TyVarCheck_Success :: TyVarCheckResult m + -- | Check succeeded, but requires an additional promotion. + -- + -- Invariant: at least one of the fields is not 'Nothing'. + TyVarCheck_Promote + :: Maybe TcLevel + -- ^ @Just lvl@ <=> 'TyVar' needs to be promoted to @lvl@ + -> Maybe ConcreteTvOrigin + -- ^ @Just conc_orig@ <=> 'TyVar' needs to be make concrete + -> TyVarCheckResult TcM + + -- | Check failed with some 'CheckTyEqProblem's. + -- + -- Invariant: the 'CheckTyEqResult' is not 'cteOK'. + TyVarCheck_Error + :: CheckTyEqResult -> TyVarCheckResult m + +instance Semigroup (TyVarCheckResult m) where + TyVarCheck_Success <> r = r + r <> TyVarCheck_Success = r + TyVarCheck_Error e1 <> TyVarCheck_Error e2 = + TyVarCheck_Error (e1 S.<> e2) + e@(TyVarCheck_Error {}) <> _ = e + _ <> e@(TyVarCheck_Error {}) = e + TyVarCheck_Promote l1 c1 <> TyVarCheck_Promote l2 c2 = + TyVarCheck_Promote + (combineMaybe minTcLevel l1 l2) + (combineMaybe const c1 c2) -- pick one 'ConcreteTvOrigin' arbitrarily + +combineMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a +combineMaybe _ Nothing r = r +combineMaybe _ r Nothing = r +combineMaybe f (Just a) (Just b) = Just (f a b) +instance Monoid (TyVarCheckResult m) where + mempty = TyVarCheck_Success + +checkTyVar :: forall m a. Monad m => TyEqFlags m a -> TcTyVar -> m (PuResult a Reduction) +checkTyVar flags occ_tv + = case flags of + TEFTyFam {} + -> success -- Nothing to do if the LHS is a type-family + TEFTyVar { tefTyVar_occursCheck = occ, tefTyVar_levelCheck = lc + , tefTyVar_concreteCheck = conc } + -> do { already_promoted <- promotionDone occ_tv lc conc + + ; if already_promoted + then success + -- Already promoted; job done + -- Example alpha[2] ~ Maybe (beta[4], beta[4]) + -- We promote the first occurrence, and then encounter it + -- a second time; we don't want to re-promote it! + -- Remember, the entire process started with a fully zonked type + -- so the only reason for a filled meta-tyvar is promotion + + else do_rhs_checks + [ simpleOccursCheck occ occ_tv + , tyVarLevelCheck lc occ_tv + , tyVarConcretenessCheck conc occ_tv ] + } + where + success = return $ okCheckRefl (mkTyVarTy occ_tv) + + -- Combine the results of individual checks. See 'TyVarCheckResult'. + do_rhs_checks :: [TyVarCheckResult m] -> m (PuResult a Reduction) + do_rhs_checks checks = + case mconcat checks of + TyVarCheck_Success -> success + TyVarCheck_Promote mb_lvl mb_conc -> promote flags mb_lvl mb_conc + TyVarCheck_Error cte_prob -> return $ PuFail cte_prob + + --------------------- + -- occ_tv is definitely a MetaTyVar; we need to promote it/make it concrete + promote :: TyEqFlags TcM a -> Maybe TcLevel -> Maybe ConcreteTvOrigin + -> TcM (PuResult a Reduction) + promote flags mb_lhs_tv_lvl mb_conc + | MetaTv { mtv_info = info_occ, mtv_tclvl = lvl_occ } <- tcTyVarDetails occ_tv + = do { let new_info | Just conc <- mb_conc = ConcreteTv conc + | otherwise = info_occ + new_lvl = + case mb_lhs_tv_lvl of + Nothing -> lvl_occ + Just lhs_tv_lvl -> lhs_tv_lvl `minTcLevel` lvl_occ + -- c[conc,3] ~ p[tau,2]: want to clone p:=p'[conc,2] + -- c[tau,2] ~ p[tau,3]: want to clone p:=p'[tau,2] + + -- Check the kind of occ_tv + -- + -- This is important for several reasons: + -- + -- 1. To ensure there is no occurs check or skolem-escape + -- in the kind of occ_tv. + -- 2. If the LHS is a concrete type variable and the RHS is an + -- unfilled meta-tyvar, we need to ensure that the kind of + -- 'occ_tv' is concrete. Test cases: T23051, T23176. + ; let occ_kind = tyVarKind occ_tv + ; kind_result <- check_ty_eq_rhs flags occ_kind + ; for kind_result $ \ kind_redn -> + do { let kind_co = reductionCoercion kind_redn + new_kind = reductionReducedType kind_redn + occ_tv' = setTyVarKind occ_tv new_kind + ; new_tv_ty <- promote_meta_tyvar new_info new_lvl occ_tv' + ; return $ mkGReflLeftRedn Nominal new_tv_ty (mkSymCo kind_co) + } } + + | otherwise = pprPanic "promote" (ppr occ_tv) + +--------------------- +promotionDone :: Monad m => TcTyVar -> LevelCheck m -> ConcreteCheck m -> m Bool +promotionDone occ_tv (LC_Promote {}) _ = isFilledMetaTyVar occ_tv +promotionDone occ_tv _ (CC_Promote {}) = isFilledMetaTyVar occ_tv +promotionDone _ _ _ = return False + +--------------------- +simpleOccursCheck :: OccursCheck -> TcTyVar -> TyVarCheckResult m +-- ^ The "interpreter" for 'OccursCheck' +simpleOccursCheck OC_None _ + = TyVarCheck_Success +simpleOccursCheck (OC_Check lhs_tv occ_prob) occ_tv + | lhs_tv == tyVarName occ_tv || check_kind (tyVarKind occ_tv) + = TyVarCheck_Error (cteProblem occ_prob) + | otherwise + = TyVarCheck_Success + where + (check_kind, _) = mkOccFolders lhs_tv + +------------------------- +tyVarLevelCheck :: LevelCheck m -> TcTyVar -> TyVarCheckResult m +-- ^ The "interpreter" for 'LevelCheck' +tyVarLevelCheck LC_None _ = TyVarCheck_Success +tyVarLevelCheck lc occ_tv + | not occ_is_deeper + = TyVarCheck_Success + | isSkolemTyVar occ_tv + = TyVarCheck_Error (cteProblem cteSkolemEscape) + | otherwise + = case lc of + LC_Check { lc_lenient = lenient } -> + if lenient + then TyVarCheck_Success + else TyVarCheck_Error (cteProblem cteSkolemEscape) + LC_Promote { lc_lvlp = lhs_tv_lvl } -> + TyVarCheck_Promote (Just lhs_tv_lvl) Nothing + where + occ_is_deeper = + case lc of + LC_Check { lc_lvlc = lhs_tv_lvl } -> + tcTyVarLevel occ_tv `strictlyDeeperThan` lhs_tv_lvl + LC_Promote { lc_lvlp = lhs_tv_lvl } -> + tcTyVarLevel occ_tv `strictlyDeeperThan` lhs_tv_lvl + +------------------------- +tyVarConcretenessCheck :: ConcreteCheck m -> TcTyVar -> TyVarCheckResult m +-- ^ The "interpreter" for 'ConcreteCheck' +tyVarConcretenessCheck cc occ_tv + | CC_None <- cc -- No concreteness checks => ok + = TyVarCheck_Success + | isConcreteTyVar occ_tv -- It's concrete already => ok + = TyVarCheck_Success + | not (isMetaTyVar occ_tv) -- Not a meta-tyvar => error + = TyVarCheck_Error (cteProblem cteConcrete) + + | otherwise -- It's a non-concrete meta-tyvar + = case cc of + CC_Check -> TyVarCheck_Success + CC_Promote conc_orig -> TyVarCheck_Promote Nothing (Just conc_orig) + -- CC_None is dealt with at the top + +------------------------- +checkPromoteFreeVars :: CheckTyEqProblem -- What occurs check problem to report + -> Name -> TcLevel + -> TyCoVarSet -> TcM CheckTyEqResult +-- Check this set of TyCoVars for +-- (a) occurs check +-- (b) promote if necessary, or report skolem escape +checkPromoteFreeVars occ_prob lhs_tv lhs_tv_lvl vs + = do { oks <- mapM do_one (nonDetEltsUniqSet vs) + ; return (mconcat oks) } + where + do_one :: TyCoVar -> TcM CheckTyEqResult + do_one v | isCoVar v = return cteOK + | tyVarName v == lhs_tv = return (cteProblem occ_prob) + | no_promotion = return cteOK + | not (isMetaTyVar v) = return (cteProblem cteSkolemEscape) + | otherwise = promote_one v + where + no_promotion = not (tcTyVarLevel v `strictlyDeeperThan` lhs_tv_lvl) + + -- isCoVar case: coercion variables are not an escape risk + -- If an implication binds a coercion variable, it'll have equalities, + -- so the "intervening given equalities" test above will catch it + -- Coercion holes get filled with coercions, so again no problem. + + promote_one :: TyVar -> TcM CheckTyEqResult + promote_one tv = + do { _ <- promote_meta_tyvar TauTv lhs_tv_lvl tv + ; return cteOK } + +promote_meta_tyvar :: MetaInfo -> TcLevel -> TcTyVar -> TcM TcType +promote_meta_tyvar info dest_lvl occ_tv + = do { -- Check whether occ_tv is already unified. The rhs-type + -- started zonked, but we may have promoted one of its type + -- variables, and we then encounter it for the second time. + -- But if so, it'll definitely be another already-checked TyVar + mb_filled <- isFilledMetaTyVar_maybe occ_tv + ; case mb_filled of { + Just ty -> return ty ; + Nothing -> + + -- OK, not done already, so clone/promote it + do { new_tv <- cloneMetaTyVarWithInfo info dest_lvl occ_tv + ; liftZonkM $ writeMetaTyVar occ_tv (mkTyVarTy new_tv) + ; traceTc "promoteTyVar" (ppr occ_tv <+> text "-->" <+> ppr new_tv) + ; return (mkTyVarTy new_tv) } } } + + + +------------------------- +touchabilityTest :: TcLevel -> TcTyVar -> Bool +-- ^ This is the key test for untouchability: +-- See Note [Unification preconditions] in GHC.Tc.Utils.Unify +-- and Note [Solve by unification] in GHC.Tc.Solver.Equality +-- +-- @True@ <=> the variable is touchable +touchabilityTest given_eq_lvl tv + | MetaTv { mtv_tclvl = tv_lvl } <- tcTyVarDetails tv + = tv_lvl `deeperThanOrSame` given_eq_lvl + | otherwise + = False + +------------------------- +-- | checkTopShape checks (TYVAR-TV) +-- Note [Unification preconditions]; returns True if these conditions +-- are satisfied. But see the Note for other preconditions, too. +checkTopShape :: MetaInfo -> TcType -> Bool +checkTopShape info xi + = case info of + TyVarTv -> + case getTyVar_maybe xi of -- Looks through type synonyms + Nothing -> False + Just tv -> case tcTyVarDetails tv of -- (TYVAR-TV) wrinkle + SkolemTv {} -> True + RuntimeUnk -> True + MetaTv { mtv_info = TyVarTv } -> True + _ -> False + CycleBreakerTv -> False -- We never unify these + _ -> True + +-------------------------------------------------------------------------------- +-- Making a type concrete. + +-- | Try to turn the provided type into a concrete type, by ensuring +-- unfilled metavariables are appropriately marked as concrete. +-- +-- Returns a coercion whose RHS is a zonked type which is "as concrete as possible", +-- and a collection of Wanted equality constraints that are necessary to make +-- the type concrete. +-- +-- For example, for an input @TYPE a[sk]@ we will return a coercion with RHS +-- @TYPE gamma[conc]@ together with the Wanted equality constraint @a ~# gamma@. +-- +-- INVARIANT: the RHS type of the returned coercion is equal to the input type, +-- up to zonking and the returned Wanted equality constraints. +-- +-- INVARIANT: if this function returns an empty list of constraints +-- then the RHS type of the returned coercion is concrete, +-- in the sense of Note [Concrete types]. +makeTypeConcrete :: FastString -> ConcreteTvOrigin + -> TcType -> TcM (TcCoercion, Cts) +makeTypeConcrete occ_fs conc_orig ty = + do { traceTc "makeTypeConcrete {" $ + vcat [ text "ty:" <+> ppr ty ] + + -- To make a type 'ty' concrete, we query what would happen were we + -- to try unifying + -- + -- alpha[conc] ~# ty + -- + -- for a fresh concrete metavariable 'alpha'. + -- + -- We do this by calling 'checkTyEqRhs' with suitable 'TyEqFlags'. + -- NB: we don't actually need to create a fresh concrete metavariable + -- in order to call 'checkTyEqRhs'. + ; let ty_eq_flags = + TEFTyVar + { tefTyVar_occursCheck = OC_None + -- LHS is a fresh meta-tyvar: no occurs check needed + , tefTyVar_levelCheck = LC_None + , tefTyVar_concreteCheck = CC_Promote conc_orig + , tef_fam_app = TEFA_Recurse + } + + -- NB: 'checkTyEqRhs' expects a fully zonked type as input. + ; ty' <- liftZonkM $ zonkTcType ty + ; pu_res <- checkTyEqRhs @TcM @() ty_eq_flags ty' + -- NB: 'checkTyEqRhs' will also check the kind, thus upholding the + -- invariant that the kind of a concrete type must also be a concrete type. + + ; (cts, final_co) <- + case pu_res of + PuOK _ redn -> + do { traceTc "makeTypeConcrete: unifier success" $ + vcat [ text "ty:" <+> ppr ty <+> dcolon <+> ppr (typeKind ty) + , text "redn:" <+> ppr redn + ] + ; return (emptyBag, mkSymCo $ reductionCoercion redn) + -- NB: the unifier returns a 'Reduction' with the concrete + -- type on the left, but we want a coercion with it on the + -- right; so we use 'mkSymCo'. + } + PuFail _prob -> + do { traceTc "makeTypeConcrete: unifier failure" $ + vcat [ text "ty:" <+> ppr ty <+> dcolon <+> ppr (typeKind ty) + , text "problem:" <+> ppr _prob + ] + -- We failed to make 'ty' concrete. In order to continue + -- typechecking, we proceed as follows: + -- + -- - create a new concrete metavariable alpha[conc] + -- - emit the equality @ty ~# alpha[conc]@. + -- + -- This equality will eventually get reported as insoluble + -- to the user. + + -- The kind of a concrete metavariable must itself be concrete, + -- so we need to do a concreteness check on the kind first. + ; let ki = typeKind ty + ; (kind_co, kind_cts) <- + if isConcreteType ki + then return (mkNomReflCo ki, emptyBag) + else makeTypeConcrete occ_fs conc_orig ki + + -- Now create the new concrete metavariable. + ; conc_tv <- newConcreteTyVar conc_orig occ_fs (coercionRKind kind_co) + ; let conc_ty = mkTyVarTy conc_tv + pty = mkEqPredRole Nominal ty' conc_ty + ; hole <- newCoercionHole pty + ; loc <- getCtLocM orig (Just KindLevel) + ; let ct = mkNonCanonical $ CtWanted + $ WantedCt { ctev_pred = pty + , ctev_dest = HoleDest hole + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet } + ; return (kind_cts S.<> unitBag ct, HoleCo hole) + } + + ; traceTc "makeTypeConcrete }" $ + vcat [ text "ty :" <+> _ppr_ty ty + , text "ty':" <+> _ppr_ty ty' + , text "final_co:" <+> _ppr_co final_co ] + + ; return (final_co, cts) + } + where + + _ppr_ty ty = ppr ty <+> dcolon <+> ppr (typeKind ty) + _ppr_co co = ppr co <+> dcolon <+> parens (_ppr_ty (coercionLKind co)) <+> text "~#" <+> parens (_ppr_ty (coercionRKind co)) + + orig :: CtOrigin + orig = case conc_orig of + ConcreteFRR frr_orig -> FRROrigin frr_orig + + +{- ********************************************************************* +* * + mightEqualLater +* * +********************************************************************* -} + +{- Note [What might equal later?] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must determine whether a Given might later equal a Wanted: + see Note [Instance and Given overlap] in GHC.Tc.Solver.Dict + +We definitely need to account for the possibility that any metavariable might be +arbitrarily instantiated. Yet we do *not* want to allow skolems to be +instantiated, as we've already rewritten with respect to any Givens. (We're +solving a Wanted here, and so all Givens have already been processed.) + +This is best understood by example. + +1. C alpha[tau] ~? C Int + + That Given certainly might match later. + +2. C a[sk] ~? C Int + + No. No new givens are going to arise that will get the `a` to rewrite + to Int. Example: + f :: forall a. C a => blah + f = rhs -- Gives rise to [W] C Int + It would be silly to fail to solve ([W] C Int), just because we have + ([G] C a) in the Givens! + +3. C alpha[tv] ~? C Int + + In this variant of (1) that alpha[tv] is a TyVarTv, unifiable only with + other type /variables/. It cannot equal Int later. + +4. C (F alpha[tau]) ~? C Int + + Sure -- that can equal later, if we learn something useful about alpha. + +5. C (F alpha[tv]) ~? C Int + + This, too, might equal later. Perhaps we have [G] F b ~ Int elsewhere. + Or maybe we have C (F alpha[tv] beta[tv]), these unify with each other, + and F x x = Int. Remember: returning True doesn't commit ourselves to + anything. + +6. C (F a[sk]) ~? C Int. For example + f :: forall a. C (F a) => blah + f = rhs -- Gives rise to [W] C Int + + No, this won't match later. If we could rewrite (F a), we would + have by now. But see also Red Herring below. + + This arises in instance decls too. For example in GHC.Core.Ppr we see + instance Outputable (XTickishId pass) + => Outputable (GenTickish pass) where + If we have [W] Outputable Int in the body, we don't want to fail to solve + it because (XTickishId pass) might simplify to Int. + +7. C (Maybe alpha[tau]) ~? C alpha[tau] + + We say this cannot equal later, because it would require + alpha := Maybe (Maybe (Maybe ...)). While such a type can be contrived, + we choose not to worry about it. See Note [Infinitary substitution in lookup] + in GHC.Core.InstEnv. Getting this wrong led to #19107, tested in + typecheck/should_compile/T19107. + +8. C alpha[cbv] ~? C Int + where alpha[cbv] = F a + + The alpha[cbv] is a cycle-breaker var which stands for F a. See + Note [Type equality cycles] in GHC.Tc.Solver.Equality + This is just like case 6, and we say "no". Saying "no" here is + essential in getting the parser to type-check, with its use of DisambECP. + +9. C alpha[cbv] ~? C Int + where alpha[cbv] = F beta[tau] + + Here, we might indeed equal later. Distinguishing between + this case and Example 8 is why we need the InertSet in mightEqualLater. + +10. C (F alpha[tau], Int) ~? C (Bool, F alpha[tau]) + + This cannot equal later, because F alpha would have to equal both Bool and + Int. + +To deal with type family applications, we use the "fine-grained" Core unifier. +See Note [Apartness and type families] in GHC.Core.Unify, controlled +by the `bind_fam :: BindFamFun` function defined in `mightEqualLater`. + +One tricky point: a type family application that mentions only skolems (example +6) is settled: any skolems would have been rewritten w.r.t. Givens by now. These +type family applications match only themselves. However: a type family +application that mentions metavariables, on the other hand, can match +anything. So, if the original type family application contains a metavariable, +we use BindMe to tell the unifier to allow it in the substitution. On the other +hand, a type family application with only skolems is considered rigid. See the +use of `mentions_meta_ty_var` in `mightEqualLater`. + +This treatment fixes #18910 and is tested in +typecheck/should_compile/InstanceGivenOverlap{,2} + +Red Herring +~~~~~~~~~~~ +In #21208, we have this scenario: + + instance forall b. C b + [G] C a[sk] + [W] C (F a[sk]) + +What should we do with that wanted? According to the logic above, the Given +cannot match later (this is example 6), and so we use the global instance. +But wait, you say: What if we learn later (say by a future type instance F a = a) +that F a unifies with a? That looks like the Given might really match later! + +This mechanism described in this Note is *not* about this kind of situation, however. +It is all asking whether a Given might match the Wanted *in this run of the solver*. +It is *not* about whether a variable might be instantiated so that the Given matches, +or whether a type instance introduced in a downstream module might make the Given match. +The reason we care about what might match later is only about avoiding order-dependence. +That is, we don't want to commit to a course of action that depends on seeing constraints +in a certain order. But an instantiation of a variable and a later type instance +don't introduce order dependency in this way, and so mightMatchLater is right to ignore +these possibilities. + +Here is an example, with no type families, that is perhaps clearer: + + instance forall b. C (Maybe b) + [G] C (Maybe Int) + [W] C (Maybe a) + +What to do? We *might* say that the Given could match later and should thus block +us from using the global instance. But we don't do this. Instead, we rely on class +coherence to say that choosing the global instance is just fine, even if later we +call a function with (a := Int). After all, in this run of the solver, [G] C (Maybe Int) +will definitely never match [W] C (Maybe a). (Recall that we process Givens before +Wanteds, so there is no [G] a ~ Int hanging about unseen.) + +Interestingly, in the first case (from #21208), the behavior changed between +GHC 8.10.7 and GHC 9.2, with the latter behaving correctly and the former +reporting overlapping instances. + +Test case: typecheck/should_compile/T21208. + +-} + +-------------------------------------------------------------------------------- +-- mightEqualLater + +mightEqualLater :: InertSet -> TcPredType -> CtLoc -> TcPredType -> CtLoc -> Maybe Subst +-- See Note [What might equal later?] +-- Used to implement logic in Note [Instance and Given overlap] in GHC.Tc.Solver.Dict +mightEqualLater inert_set given_pred given_loc wanted_pred wanted_loc + | prohibitedSuperClassSolve given_loc wanted_loc + = Nothing + + | otherwise + = case tcUnifyTysFG bind_fam bind_tv [given_pred] [wanted_pred] of + Unifiable subst + -> Just subst + MaybeApart reason subst + | MARInfinite <- reason -- see Example 7 in the Note. + -> Nothing + | otherwise + -> Just subst + SurelyApart -> Nothing + + where + bind_tv :: BindTvFun + bind_tv tv rhs_ty + | MetaTv { mtv_info = info } <- tcTyVarDetails tv + , ok_shape tv info rhs_ty + , can_unify tv rhs_ty + = BindMe + + | otherwise + = DontBindMe + + bind_fam :: BindFamFun + -- See Examples (4), (5), and (6) from the Note, especially (6) + bind_fam _fam_tc fam_args _rhs + | anyFreeVarsOfTypes mentions_meta_ty_var fam_args = BindMe + | otherwise = DontBindMe + + can_unify :: TcTyVar -> TcType -> Bool + can_unify tv rhs_ty + -- See Note [Use checkTyEqRhs in mightEqualLater] + | PuOK {} <- runIdentity $ checkTyEqRhs (pureTyEqFlags_LHSMetaTyVar tv) rhs_ty + = True + | otherwise + = False + + -- True for TauTv and TyVarTv (and RuntimeUnkTv) meta-tyvars + -- (as they can be unified) + -- and also for CycleBreakerTvs that mentions meta-tyvars + mentions_meta_ty_var :: TyVar -> Bool + mentions_meta_ty_var tv + | isMetaTyVar tv + = case metaTyVarInfo tv of + -- See Examples 8 and 9 in the Note + CycleBreakerTv -> anyFreeVarsOfType mentions_meta_ty_var + (lookupCycleBreakerVar tv inert_set) + _ -> True + | otherwise + = False + + -- Like checkTopShape, but allows cbv variables to unify + ok_shape :: TcTyVar -> MetaInfo -> Type -> Bool + ok_shape _lhs_tv TyVarTv rhs_ty -- see Example 3 from the Note + | Just rhs_tv <- getTyVar_maybe rhs_ty + = case tcTyVarDetails rhs_tv of + MetaTv { mtv_info = TyVarTv } -> True + MetaTv {} -> False -- Could unify with anything + SkolemTv {} -> True + RuntimeUnk -> True + | otherwise -- not a var on the RHS + = False + ok_shape lhs_tv _other _rhs_ty = mentions_meta_ty_var lhs_tv + +{- Note [Use checkTyEqRhs in mightEqualLater] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In 'mightEqualLater', we are checking whether two types ty1 and ty2 might become +equal after further unifications. To do this, we call the pure unifier, via +the function 'tcUnifyTysFG'. However, it is important that we don't return +false positives: + + 1. Level check: ty1 = alpha[tau:1] /~ ty2 = k[sk:3] + 2. Occurs check: ty1 = beta[tau] /~ ty2 = Maybe beta[tau] + 3. Concreteness: ty1 = kappa[conc] /~ ty2 = k[sk]. + +In these examples, ty1 and ty2 cannot unify; to inform the pure unifier of this +fact, we use 'checkTyEqRhs' to provide the 'BindTvFun'. + +Failing to account for this caused #25744: + + work item = [W] w1: Eq (g[sk:1] x[sk:3]) + inerts = { [G] g1: Eq x[sk:3] + , [G] g2: forall y. Eq y => Eq (g[sk:1] y) + , [G] g3: Eq (f[tau:1] v[tau:1]) } + +We want to solve w1 using g1 and g2. The presence of g3 is irrelevant, because +we cannot unify 'f[tau:1] v[tau:1]' and 'g[sk:1] x[sk:3]' due to skolem escape. +-} + +-- | Return the type family application a CycleBreakerTv maps to. +lookupCycleBreakerVar :: TcTyVar -- ^ cbv, must be a CycleBreakerTv + -> InertSet + -> TcType -- ^ type family application the cbv maps to +lookupCycleBreakerVar cbv (IS { inert_cycle_breakers = cbvs_stack }) +-- This function looks at every environment in the stack. This is necessary +-- to avoid #20231. This function (and its one usage site) is the only reason +-- that we store a stack instead of just the top environment. + | Just tyfam_app <- assert (isCycleBreakerTyVar cbv) $ + firstJusts (NE.map (lookupBag cbv) cbvs_stack) + = tyfam_app + | otherwise + = pprPanic "lookupCycleBreakerVar found an unbound cycle breaker" (ppr cbv $$ ppr cbvs_stack) + +-------------------------------------------------------------------------------- diff --git a/GHC/Tc/Utils/Unify.hs-boot b/GHC/Tc/Utils/Unify.hs-boot --- a/GHC/Tc/Utils/Unify.hs-boot +++ b/GHC/Tc/Utils/Unify.hs-boot @@ -1,17 +1,24 @@ module GHC.Tc.Utils.Unify where import GHC.Prelude -import GHC.Core.Type ( Mult ) -import GHC.Tc.Utils.TcType ( TcTauType ) -import GHC.Tc.Types ( TcM ) -import GHC.Tc.Types.Evidence ( TcCoercion, HsWrapper ) -import GHC.Tc.Types.Origin ( CtOrigin, TypedThing ) +import GHC.Core.Type ( Mult ) +import GHC.Tc.Utils.TcType ( TcTauType ) +import GHC.Tc.Types ( TcM ) +import GHC.Tc.Types.Constraint ( Cts ) +import GHC.Tc.Types.Evidence ( TcCoercion ) +import GHC.Tc.Types.Origin ( CtOrigin, TypedThing ) +import GHC.Tc.Utils.TcType ( TcType, ConcreteTvOrigin ) +import GHC.Data.FastString ( FastString ) + -- This boot file exists only to tie the knot between -- GHC.Tc.Utils.Unify and GHC.Tc.Utils.Instantiate/GHC.Tc.Utils.TcMType unifyType :: Maybe TypedThing -> TcTauType -> TcTauType -> TcM TcCoercion unifyInvisibleType :: TcTauType -> TcTauType -> TcM TcCoercion -tcSubMult :: CtOrigin -> Mult -> Mult -> TcM HsWrapper +tcSubMult :: CtOrigin -> Mult -> Mult -> TcM () + +makeTypeConcrete :: FastString -> ConcreteTvOrigin + -> TcType -> TcM (TcCoercion, Cts) diff --git a/GHC/Tc/Validity.hs b/GHC/Tc/Validity.hs --- a/GHC/Tc/Validity.hs +++ b/GHC/Tc/Validity.hs @@ -1,9 +1,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - {- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -29,13 +26,13 @@ import GHC.Tc.Utils.Unify ( tcSubTypeAmbiguity ) import GHC.Tc.Solver ( simplifyAmbiguityCheck ) import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), AssocInstInfo(..) ) -import GHC.Tc.Utils.TcType +import GHC.Tc.Instance.FunDeps +import GHC.Tc.Instance.Family import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank import GHC.Tc.Errors.Types +import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad -import GHC.Tc.Instance.FunDeps -import GHC.Tc.Instance.Family import GHC.Tc.Zonk.TcType import GHC.Builtin.Types @@ -52,6 +49,7 @@ import GHC.Core.TyCo.FVs import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr +import GHC.Core.TyCo.Tidy import GHC.Core.FamInstEnv ( isDominatedBy, injectiveBranches , InjectivityCheckResult(..) ) @@ -241,7 +239,7 @@ -- tyvars are skolemised, we can safely use tcSimplifyTop ; allow_ambiguous <- xoptM LangExt.AllowAmbiguousTypes ; unless allow_ambiguous $ - do { (_wrap, wanted) <- addErrCtxt (mk_msg allow_ambiguous) $ + do { (_wrap, wanted) <- addErrCtxt (AmbiguityCheckCtxt ctxt allow_ambiguous) $ captureConstraints $ tcSubTypeAmbiguity ctxt ty ty -- See Note [Ambiguity check and deep subsumption] @@ -252,13 +250,6 @@ | otherwise = return () - where - mk_msg allow_ambiguous - = vcat [ text "In the ambiguity check for" <+> what - , ppUnless allow_ambiguous ambig_msg ] - ambig_msg = text "To defer the ambiguity check to use sites, enable AllowAmbiguousTypes" - what | Just n <- isSigMaybe ctxt = quotes (ppr n) - | otherwise = pprUserTypeCtxt ctxt wantAmbiguityCheck :: UserTypeCtxt -> Bool wantAmbiguityCheck ctxt @@ -381,7 +372,6 @@ = case ctxt of DefaultDeclCtxt-> MustBeMonoType PatSigCtxt -> rank0 - RuleSigCtxt {} -> rank1 TySynCtxt _ -> rank0 ExprSigCtxt {} -> rank1 @@ -405,10 +395,11 @@ SpecInstCtxt -> rank1 GhciCtxt {} -> ArbitraryRank - TyVarBndrKindCtxt _ -> rank0 - DataKindCtxt _ -> rank1 - TySynKindCtxt _ -> rank1 - TyFamResKindCtxt _ -> rank1 + TyVarBndrKindCtxt {} -> rank0 + RuleBndrTypeCtxt{} -> rank1 + DataKindCtxt _ -> rank1 + TySynKindCtxt _ -> rank1 + TyFamResKindCtxt _ -> rank1 _ -> panic "checkValidType" -- Can't happen; not used for *user* sigs @@ -542,7 +533,7 @@ typeOrKindCtxt (TypeAppCtxt {}) = OnlyTypeCtxt typeOrKindCtxt (PatSynCtxt {}) = OnlyTypeCtxt typeOrKindCtxt (PatSigCtxt {}) = OnlyTypeCtxt -typeOrKindCtxt (RuleSigCtxt {}) = OnlyTypeCtxt +typeOrKindCtxt (RuleBndrTypeCtxt {})= OnlyTypeCtxt typeOrKindCtxt (ForSigCtxt {}) = OnlyTypeCtxt typeOrKindCtxt (DefaultDeclCtxt {}) = OnlyTypeCtxt typeOrKindCtxt (InstDeclCtxt {}) = OnlyTypeCtxt @@ -880,10 +871,8 @@ check_expansion_only expand = assertPpr (isTypeSynonymTyCon tc) (ppr tc) $ case coreView ty of - Just ty' -> let err_ctxt = text "In the expansion of type synonym" - <+> quotes (ppr tc) - in addErrCtxt err_ctxt $ - check_type (ve{ve_expand = expand}) ty' + Just ty' -> addErrCtxt (TySynErrCtxt tc) $ + check_type (ve{ve_expand = expand}) ty' Nothing -> pprPanic "check_syn_tc_app" (ppr ty) {- @@ -1012,18 +1001,11 @@ -- | Check for a DataKinds violation in a kind context. -- See @Note [Checking for DataKinds]@. --- --- Note that emitting DataKinds errors from the typechecker is a fairly recent --- addition to GHC (introduced in GHC 9.10), and in order to prevent these new --- errors from breaking users' code, we temporarily downgrade these errors to --- warnings. (This is why we use 'diagnosticTcM' below.) See --- @Note [Checking for DataKinds] (Wrinkle: Migration story for DataKinds --- typechecker errors)@. checkDataKinds :: ValidityEnv -> Type -> TcM () checkDataKinds (ValidityEnv{ ve_ctxt = ctxt, ve_tidy_env = env }) ty = do data_kinds <- xoptM LangExt.DataKinds - diagnosticTcM - (not (data_kinds || typeLevelUserTypeCtxt ctxt)) $ + checkTcM + (data_kinds || typeLevelUserTypeCtxt ctxt) $ (env, TcRnDataKindsError KindLevel (Right (tidyType env ty))) {- Note [No constraints in kinds] @@ -1175,28 +1157,6 @@ synonym), so we also catch a subset of kind-level violations in the renamer to allow for earlier reporting of these errors. ------ --- Wrinkle: Migration story for DataKinds typechecker errors ------ - -As mentioned above, DataKinds is checked in two different places: the renamer -and the typechecker. The checks in the renamer have been around since DataKinds -was introduced. The checks in the typechecker, on the other hand, are a fairly -recent addition, having been introduced in GHC 9.10. As such, it is possible -that there are some programs in the wild that (1) do not enable DataKinds, and -(2) were accepted by a previous GHC version, but would now be rejected by the -new DataKinds checks in the typechecker. - -To prevent the new DataKinds checks in the typechecker from breaking users' -code, we temporarily allow programs to compile if they violate a DataKinds -check in the typechecker, but GHC will emit a warning if such a violation -occurs. Users can then silence the warning by enabling DataKinds in the module -where the affected code lives. It is fairly straightforward to distinguish -between DataKinds violations arising from the renamer versus the typechecker, -as TcRnDataKindsError (the error message type classifying all DataKinds errors) -stores an Either field that is Left when the error comes from the renamer and -Right when the error comes from the typechecker. - ************************************************************************ * * \subsection{Checking a theta or source type} @@ -1309,7 +1269,7 @@ check_quant_pred :: TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> ThetaType -> PredType -> TcM () check_quant_pred env dflags ctxt pred theta head_pred - = addErrCtxt (text "In the quantified constraint" <+> quotes (ppr pred)) $ + = addErrCtxt (QuantifiedCtCtxt pred) $ do { -- Check the instance head case classifyPredType head_pred of -- SigmaCtxt tells checkValidInstHead that @@ -1400,7 +1360,7 @@ -- (Coercible a b) to (a ~R# b) | otherwise - = do { result <- matchGlobalInst dflags False cls tys + = do { result <- matchGlobalInst dflags False cls tys Nothing ; case result of OneInst { cir_what = what } -> addDiagnosticTc (TcRnSimplifiableConstraint pred what) @@ -1466,7 +1426,7 @@ okIPCtxt (ClassSCCtxt {}) = False okIPCtxt (InstDeclCtxt {}) = False okIPCtxt (SpecInstCtxt {}) = False -okIPCtxt (RuleSigCtxt {}) = False +okIPCtxt (RuleBndrTypeCtxt {}) = False okIPCtxt DefaultDeclCtxt = False okIPCtxt DerivClauseCtxt = False okIPCtxt (TyVarBndrKindCtxt {}) = False @@ -1495,11 +1455,9 @@ generalized actually. -} -checkThetaCtxt :: UserTypeCtxt -> ThetaType -> TidyEnv -> ZonkM (TidyEnv, SDoc) +checkThetaCtxt :: UserTypeCtxt -> ThetaType -> TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg) checkThetaCtxt ctxt theta env - = return ( env - , vcat [ text "In the context:" <+> pprTheta (tidyTypes env theta) - , text "While checking" <+> pprUserTypeCtxt ctxt ] ) + = return (env, ThetaCtxt ctxt (tidyTypes env theta)) tyConArityErr :: TyCon -> [TcType] -> TcRnMessage -- For type-constructor arity errors, be careful to report @@ -1577,7 +1535,7 @@ | isAbstractClass clas , hs_src == HsSrcFile = fail_with_inst_err $ IllegalInstanceHead - $ InstHeadAbstractClass clas + $ InstHeadAbstractClass (noUserRdr $ className clas) -- Complain about hand-written instances of built-in classes -- Typeable, KnownNat, KnownSymbol, Coercible, HasField. @@ -2124,9 +2082,10 @@ ; traceTc "End checkValidInstance }" empty } | otherwise -> failWithTc $ mk_err $ IllegalInstanceHead - $ InstHeadNonClass (Just tc) + $ InstHeadNonClassHead + $ InstNonClassTyCon (noUserRdr $ tyConName tc) (fmap tyConName $ tyConFlavour tc) _ -> failWithTc $ mk_err $ IllegalInstanceHead - $ InstHeadNonClass Nothing + $ InstHeadNonClassHead InstNonTyCon where (theta, tau) = splitInstTyForValidity ty @@ -2625,7 +2584,7 @@ -- The /scoped/ type variables from the class-instance header -- should not be alpha-renamed. Inferred ones can be. no_bind_set = mkVarSet inst_tvs - bind_me tv _ty | tv `elemVarSet` no_bind_set = Apart + bind_me tv _ty | tv `elemVarSet` no_bind_set = DontBindMe | otherwise = BindMe diff --git a/GHC/Tc/Zonk/Env.hs b/GHC/Tc/Zonk/Env.hs --- a/GHC/Tc/Zonk/Env.hs +++ b/GHC/Tc/Zonk/Env.hs @@ -61,10 +61,14 @@ -- -- See Note [Un-unified unification variables] data ZonkFlexi - = DefaultFlexi -- ^ Default unbound unification variables to Any - | SkolemiseFlexi -- ^ Skolemise unbound unification variables - -- See Note [Zonking the LHS of a RULE] + = DefaultFlexi -- ^ Default unbound unification variables to Any + + | SkolemiseFlexi -- ^ Skolemise unbound unification variables + (IORef [TyVar]) -- See Note [Zonking the LHS of a RULE] + -- Records the tyvars thus skolemised + | RuntimeUnkFlexi -- ^ Used in the GHCi debugger + | NoFlexi -- ^ Panic on unfilled meta-variables -- See Note [Error on unconstrained meta-variables] -- in GHC.Tc.Utils.TcMType diff --git a/GHC/Tc/Zonk/TcType.hs b/GHC/Tc/Zonk/TcType.hs --- a/GHC/Tc/Zonk/TcType.hs +++ b/GHC/Tc/Zonk/TcType.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {- (c) The University of Glasgow 2006 @@ -37,6 +38,13 @@ -- ** Zonking constraints , zonkCt, zonkWC, zonkSimples, zonkImplication + -- * Rewriter sets + , zonkRewriterSet, zonkCtRewriterSet, zonkCtEvRewriterSet + + -- * Coercion holes + , isFilledCoercionHole, unpackCoercionHole, unpackCoercionHole_maybe + + -- * Tidying , tcInitTidyEnv, tcInitOpenTidyEnv , tidyCt, tidyEvVar, tidyDelayedError @@ -75,13 +83,14 @@ import GHC.Core.InstEnv (ClsInst(is_tys)) import GHC.Core.TyCo.Rep +import GHC.Core.TyCo.Tidy import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.Predicate import GHC.Utils.Constants -import GHC.Utils.Outputable +import GHC.Utils.Outputable as Outputable import GHC.Utils.Misc import GHC.Utils.Monad ( mapAccumLM ) import GHC.Utils.Panic @@ -89,6 +98,9 @@ import GHC.Data.Bag import GHC.Data.Pair +import Data.Semigroup +import Data.Maybe + {- ********************************************************************* * * Writing to metavariables @@ -354,8 +366,9 @@ ************************************************************************ -} --- | Check that a coercion is appropriate for filling a hole. (The hole --- itself is needed only for printing.) +-- | Debugging-only! Check that a coercion is appropriate for filling a +-- hole. (The hole itself is needed only for printing.) +-- -- Always returns the checked coercion, but this return value is necessary -- so that the input coercion is forced only when the output is forced. checkCoercionHole :: CoVar -> Coercion -> ZonkM Coercion @@ -366,8 +379,8 @@ ; return $ assertPpr (ok cv_ty) (text "Bad coercion hole" <+> - ppr cv <> colon <+> vcat [ ppr t1, ppr t2, ppr role - , ppr cv_ty ]) + ppr cv Outputable.<> colon + <+> vcat [ ppr t1, ppr t2, ppr role, ppr cv_ty ]) co } | otherwise = return co @@ -429,6 +442,8 @@ = DE_Hole <$> zonkHole hole zonkDelayedError (DE_NotConcrete err) = DE_NotConcrete <$> zonkNotConcreteError err +zonkDelayedError (DE_Multiplicity mult_co loc) + = DE_Multiplicity <$> zonkCo mult_co <*> pure loc zonkHole :: Hole -> ZonkM Hole zonkHole hole@(Hole { hole_ty = ty }) @@ -492,10 +507,15 @@ ; return (mkNonCanonical fl') } zonkCtEvidence :: CtEvidence -> ZonkM CtEvidence -zonkCtEvidence ctev - = do { let pred = ctev_pred ctev - ; pred' <- zonkTcType pred - ; return (setCtEvPredType ctev pred') } +-- Zonks the ctev_pred and the ctev_rewriters; but not ctev_evar +-- For ctev_rewriters, see (WRW2) in Note [Wanteds rewrite Wanteds] +zonkCtEvidence (CtGiven (GivenCt { ctev_pred = pred, ctev_evar = var, ctev_loc = loc })) + = do { pred' <- zonkTcType pred + ; return (CtGiven (GivenCt { ctev_pred = pred', ctev_evar = var, ctev_loc = loc })) } +zonkCtEvidence (CtWanted wanted@(WantedCt { ctev_pred = pred, ctev_rewriters = rws })) + = do { pred' <- zonkTcType pred + ; rws' <- zonkRewriterSet rws + ; return (CtWanted (wanted { ctev_pred = pred', ctev_rewriters = rws' })) } zonkSkolemInfo :: SkolemInfo -> ZonkM SkolemInfo zonkSkolemInfo (SkolemInfo u sk) = SkolemInfo u <$> zonkSkolemInfoAnon sk @@ -531,6 +551,103 @@ %************************************************************************ %* * + Zonking rewriter sets +* * +************************************************************************ +-} + +zonkCtRewriterSet :: Ct -> ZonkM Ct +zonkCtRewriterSet ct + | isGivenCt ct + = return ct + | otherwise + = case ct of + CEqCan eq@(EqCt { eq_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CEqCan (eq { eq_ev = ev' })) } + CIrredCan ir@(IrredCt { ir_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CIrredCan (ir { ir_ev = ev' })) } + CDictCan di@(DictCt { di_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CDictCan (di { di_ev = ev' })) } + CQuantCan {} -> return ct + CNonCanonical ev -> do { ev' <- zonkCtEvRewriterSet ev + ; return (CNonCanonical ev') } + +zonkCtEvRewriterSet :: CtEvidence -> ZonkM CtEvidence +zonkCtEvRewriterSet ev@(CtGiven {}) + = return ev +zonkCtEvRewriterSet ev@(CtWanted wtd) + = do { rewriters' <- zonkRewriterSet (ctEvRewriters ev) + ; return (CtWanted $ setWantedCtEvRewriters wtd rewriters') } + +-- | Zonk a rewriter set; if a coercion hole in the set has been filled, +-- find all the free un-filled coercion holes in the coercion that fills it +zonkRewriterSet :: RewriterSet -> ZonkM RewriterSet +zonkRewriterSet (RewriterSet set) + = nonDetStrictFoldUniqSet go (return emptyRewriterSet) set + -- This does not introduce non-determinism, because the only + -- monadic action is to read, and the combining function is + -- commutative + where + go :: CoercionHole -> ZonkM RewriterSet -> ZonkM RewriterSet + go hole m_acc = unionRewriterSet <$> check_hole hole <*> m_acc + + check_hole :: CoercionHole -> ZonkM RewriterSet + check_hole hole + = do { m_co <- unpackCoercionHole_maybe hole + ; case m_co of + Nothing -> return (unitRewriterSet hole) -- Not filled + Just co -> unUCHM (check_co co) } -- Filled: look inside + + check_ty :: Type -> UnfilledCoercionHoleMonoid + check_co :: Coercion -> UnfilledCoercionHoleMonoid + (check_ty, _, check_co, _) = foldTyCo folder () + + folder :: TyCoFolder () UnfilledCoercionHoleMonoid + folder = TyCoFolder { tcf_view = noView + , tcf_tyvar = \ _ tv -> check_ty (tyVarKind tv) + , tcf_covar = \ _ cv -> check_ty (varType cv) + , tcf_hole = \ _ -> UCHM . check_hole + , tcf_tycobinder = \ _ _ _ -> () } + +newtype UnfilledCoercionHoleMonoid = UCHM { unUCHM :: ZonkM RewriterSet } + +instance Semigroup UnfilledCoercionHoleMonoid where + UCHM l <> UCHM r = UCHM (unionRewriterSet <$> l <*> r) + +instance Monoid UnfilledCoercionHoleMonoid where + mempty = UCHM (return emptyRewriterSet) + + +{- +************************************************************************ +* * + Checking for coercion holes +* * +************************************************************************ +-} + +-- | Is a coercion hole filled in? +isFilledCoercionHole :: CoercionHole -> ZonkM Bool +isFilledCoercionHole (CoercionHole { ch_ref = ref }) + = isJust <$> readTcRef ref + +-- | Retrieve the contents of a coercion hole. Panics if the hole +-- is unfilled +unpackCoercionHole :: CoercionHole -> ZonkM Coercion +unpackCoercionHole hole + = do { contents <- unpackCoercionHole_maybe hole + ; case contents of + Just co -> return co + Nothing -> pprPanic "Unfilled coercion hole" (ppr hole) } + +-- | Retrieve the contents of a coercion hole, if it is filled +unpackCoercionHole_maybe :: CoercionHole -> ZonkM (Maybe Coercion) +unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref + + +{- +%************************************************************************ +%* * Tidying * * ************************************************************************ @@ -586,6 +703,9 @@ = do { skol_info1 <- zonkSkolemInfoAnon skol_info ; let skol_info2 = tidySkolemInfoAnon env skol_info1 ; return (env, GivenSCOrigin skol_info2 sc_depth blocked) } +zonkTidyOrigin env (ScOrigin (IsQC pred orig) nkd) + = do { (env1, pred') <- zonkTidyTcType env pred + ; return (env1, ScOrigin (IsQC pred' orig) nkd) } zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual = act , uo_expected = exp }) = do { (env1, act') <- zonkTidyTcType env act @@ -636,11 +756,18 @@ where go zs env [] = return (env, reverse zs) go zs env (FRR_Info { frr_info_origin = FixedRuntimeRepOrigin ty orig - , frr_info_not_concrete = mb_not_conc } : tys) + , frr_info_not_concrete = mb_not_conc + , frr_info_other_origin = mb_other_orig + } : tys) = do { (env, ty) <- zonkTidyTcType env ty ; (env, mb_not_conc) <- go_mb_not_conc env mb_not_conc + ; (env, mb_other_orig) <- + case mb_other_orig of + Nothing -> return (env, Nothing) + Just o -> do { (env', o') <- zonkTidyOrigin env o; return (env', Just o') } ; let info = FRR_Info { frr_info_origin = FixedRuntimeRepOrigin ty orig - , frr_info_not_concrete = mb_not_conc } + , frr_info_not_concrete = mb_not_conc + , frr_info_other_origin = mb_other_orig } ; go (info:zs) env tys } go_mb_not_conc env Nothing = return (env, Nothing) @@ -658,7 +785,7 @@ -- NB: we do not tidy the ctev_evar field because we don't -- show it in error messages tidyCtEvidence env ctev - = ctev { ctev_pred = tidyOpenType env $ ctev_pred ctev } + = setCtEvPredType ctev (tidyOpenType env (ctEvPred ctev)) -- tidyOpenType: for (beta ~ (forall a. a->a), don't gratuitously -- rename the 'forall a' just because of an 'a' in scope somewhere -- else entirely. @@ -673,6 +800,8 @@ tidyDelayedError :: TidyEnv -> DelayedError -> DelayedError tidyDelayedError env (DE_Hole hole) = DE_Hole $ tidyHole env hole tidyDelayedError env (DE_NotConcrete err) = DE_NotConcrete $ tidyConcreteError env err +tidyDelayedError env (DE_Multiplicity mult_co loc) + = DE_Multiplicity (tidyCo env mult_co) loc tidyConcreteError :: TidyEnv -> NotConcreteError -> NotConcreteError tidyConcreteError env err@(NCE_FRR { nce_frr_origin = frr_orig }) diff --git a/GHC/Tc/Zonk/Type.hs b/GHC/Tc/Zonk/Type.hs --- a/GHC/Tc/Zonk/Type.hs +++ b/GHC/Tc/Zonk/Type.hs @@ -28,12 +28,6 @@ -- ** 'ZonkEnv', and the 'ZonkT' and 'ZonkBndrT' monad transformers module GHC.Tc.Zonk.Env, - -- * Coercion holes - isFilledCoercionHole, unpackCoercionHole, unpackCoercionHole_maybe, - - -- * Rewriter sets - zonkRewriterSet, zonkCtRewriterSet, zonkCtEvRewriterSet, - -- * Tidying tcInitTidyEnv, tcInitOpenTidyEnv, @@ -55,7 +49,6 @@ import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad ( newZonkAnyType, setSrcSpanA, liftZonkM, traceTc, addErr ) -import GHC.Tc.Types.Constraint import GHC.Tc.Types.Evidence import GHC.Tc.Errors.Types import GHC.Tc.Zonk.Env @@ -88,7 +81,6 @@ import GHC.Types.TypeEnv import GHC.Types.Basic import GHC.Types.SrcLoc -import GHC.Types.Unique.Set import GHC.Types.Unique.FM import GHC.Types.TyThing @@ -99,8 +91,8 @@ import Control.Monad import Control.Monad.Trans.Class ( lift ) -import Data.Semigroup import Data.List.NonEmpty ( NonEmpty ) +import Data.Foldable ( toList ) {- Note [What is zonking?] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -380,7 +372,7 @@ zonkTyVarOcc :: HasDebugCallStack => TcTyVar -> ZonkTcM Type zonkTyVarOcc tv - = do { ZonkEnv { ze_tv_env = tv_env } <- getZonkEnv + = do { ZonkEnv { ze_tv_env = tv_env, ze_flexi = zonk_flexi } <- getZonkEnv ; let lookup_in_tv_env -- Look up in the env just as we do for Ids = case lookupVarEnv tv_env tv of @@ -394,7 +386,7 @@ zonk_meta ref Flexi = do { kind <- zonkTcTypeToTypeX (tyVarKind tv) - ; ty <- commitFlexi tv kind + ; ty <- lift $ commitFlexi zonk_flexi tv kind ; lift $ liftZonkM $ writeMetaTyVarRef tv ref ty -- Belt and braces ; finish_meta ty } @@ -442,50 +434,47 @@ Nothing -> pprPanic "lookupTyVarOcc" (ppr tv $$ ppr tv_env) ; return res } -commitFlexi :: TcTyVar -> Kind -> ZonkTcM Type -commitFlexi tv zonked_kind - = do { flexi <- ze_flexi <$> getZonkEnv - ; lift $ case flexi of - SkolemiseFlexi -> return (mkTyVarTy (mkTyVar name zonked_kind)) - - DefaultFlexi - -- Normally, RuntimeRep variables are defaulted in GHC.Tc.Utils.TcMType.defaultTyVar - -- But that sees only type variables that appear in, say, an inferred type. - -- Defaulting here, in the zonker, is needed to catch e.g. - -- y :: Bool - -- y = (\x -> True) undefined - -- We need *some* known RuntimeRep for the x and undefined, but no one - -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } - | isMultiplicityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) - ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; return (anyTypeOfKind zonked_kind) } - | otherwise - -> do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) - -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) - ; newZonkAnyType zonked_kind } - - RuntimeUnkFlexi - -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) - ; return (mkTyVarTy (mkTcTyVar name zonked_kind RuntimeUnk)) } - -- This is where RuntimeUnks are born: - -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnks as they leave the - -- typechecker's monad +commitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type +commitFlexi NoFlexi tv zonked_kind + = pprPanic "NoFlexi" (ppr tv <+> dcolon <+> ppr zonked_kind) - NoFlexi -> pprPanic "NoFlexi" (ppr tv <+> dcolon <+> ppr zonked_kind) } +commitFlexi (SkolemiseFlexi tvs_ref) tv zonked_kind + = do { let skol_tv = mkTyVar (tyVarName tv) zonked_kind + ; updTcRef tvs_ref (skol_tv :) + ; return (mkTyVarTy skol_tv) } - where - name = tyVarName tv +commitFlexi RuntimeUnkFlexi tv zonked_kind + = do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) + ; return (mkTyVarTy (mkTcTyVar (tyVarName tv) zonked_kind RuntimeUnk)) } + -- This is where RuntimeUnks are born: + -- otherwise-unconstrained unification variables are + -- turned into RuntimeUnks as they leave the + -- typechecker's monad +commitFlexi DefaultFlexi tv zonked_kind + -- Normally, RuntimeRep variables are defaulted in GHC.Tc.Utils.TcMType.defaultTyVar + -- But that sees only type variables that appear in, say, an inferred type. + -- Defaulting here, in the zonker, is needed to catch e.g. + -- y :: Bool + -- y = (\x -> True) undefined + -- We need *some* known RuntimeRep for the x and undefined, but no one + -- will choose it until we get here, in the zonker. + | isRuntimeRepTy zonked_kind + = do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) + ; return liftedRepTy } + | isLevityTy zonked_kind + = do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) + ; return liftedDataConTy } + | isMultiplicityTy zonked_kind + = do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) + ; return manyDataConTy } + | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv + = do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) + ; return (anyTypeOfKind zonked_kind) } + | otherwise + = do { traceTc "Defaulting flexi tyvar to ZonkAny:" (pprTyVar tv) + -- See Note [Any types] in GHC.Builtin.Types, esp wrinkle (Any4) + ; newZonkAnyType zonked_kind } zonkCoVarOcc :: CoVar -> ZonkTcM Coercion zonkCoVarOcc cv @@ -757,8 +746,12 @@ runZonkBndrT (zonkTyBndrsX tyvars ) $ \ new_tyvars -> runZonkBndrT (zonkEvBndrsX evs ) $ \ new_evs -> runZonkBndrT (zonkTcEvBinds_s ev_binds) $ \ new_ev_binds -> - do { (new_val_bind, new_exports) <- mfix $ \ ~(new_val_binds, _) -> - runZonkBndrT (extendIdZonkEnvRec $ collectHsBindsBinders CollNoDictBinders new_val_binds) $ \ _ -> + do { (new_val_bind, new_exports) <- mfix $ \ ~(new_val_binds, new_exports) -> + let new_bndrs = collectHsBindsBinders CollNoDictBinders new_val_binds + ++ map abe_poly new_exports + -- Tie the knot with the `abe_poly` binders too, since they + -- may be mentioned in the `abe_prags` of the `exports` + in runZonkBndrT (extendIdZonkEnvRec new_bndrs) $ \ _ -> do { new_val_binds <- mapM zonk_val_bind val_binds ; new_exports <- mapM zonk_export exports ; return (new_val_binds, new_exports) @@ -815,20 +808,20 @@ , psb_dir = dir' } } } zonkMultAnn :: HsMultAnn GhcTc -> ZonkTcM (HsMultAnn GhcTc) -zonkMultAnn (HsNoMultAnn mult) +zonkMultAnn (HsUnannotated mult) = do { mult' <- zonkTcTypeToTypeX mult - ; return (HsNoMultAnn mult') } -zonkMultAnn (HsPct1Ann mult) + ; return (HsUnannotated mult') } +zonkMultAnn (HsLinearAnn mult) = do { mult' <- zonkTcTypeToTypeX mult - ; return (HsPct1Ann mult') } -zonkMultAnn (HsMultAnn mult hs_ty) + ; return (HsLinearAnn mult') } +zonkMultAnn (HsExplicitMult mult hs_ty) = do { mult' <- zonkTcTypeToTypeX mult - ; return (HsMultAnn mult' hs_ty) } + ; return (HsExplicitMult mult' hs_ty) } zonkPatSynDetails :: HsPatSynDetails GhcTc -> ZonkTcM (HsPatSynDetails GhcTc) -zonkPatSynDetails (PrefixCon _ as) - = PrefixCon noTypeArgs <$> traverse zonkLIdOcc as +zonkPatSynDetails (PrefixCon as) + = PrefixCon <$> traverse zonkLIdOcc as zonkPatSynDetails (InfixCon a1 a2) = InfixCon <$> zonkLIdOcc a1 <*> zonkLIdOcc a2 zonkPatSynDetails (RecCon flds) @@ -854,10 +847,27 @@ = mapM zonk_prag ps where zonk_prag (L loc (SpecPrag id co_fn inl)) - = do { co_fn' <- don'tBind $ zonkCoFn co_fn - ; id' <- zonkIdOcc id - ; return (L loc (SpecPrag id' co_fn' inl)) } + = do { co_fn' <- don'tBind $ zonkCoFn co_fn + ; id' <- zonkIdOcc id + ; return (L loc (SpecPrag id' co_fn' inl)) } + zonk_prag (L loc prag@(SpecPragE { spe_fn_id = poly_id + , spe_bndrs = bndrs + , spe_call = spec_e })) + = do { poly_id' <- zonkIdOcc poly_id + ; skol_tvs_ref <- lift $ newTcRef [] + ; setZonkType (SkolemiseFlexi skol_tvs_ref) $ + -- SkolemiseFlexi: see Note [Free tyvars on rule LHS] + + runZonkBndrT (zonkCoreBndrsX bndrs) $ \ bndrs' -> + do { spec_e' <- zonkLExpr spec_e + ; skol_tvs <- lift $ readTcRef skol_tvs_ref + ; return (L loc (prag { spe_fn_id = poly_id' + , spe_bndrs = skol_tvs ++ bndrs' + , spe_call = spec_e' + })) + }} + {- ************************************************************************ * * @@ -925,9 +935,9 @@ do { id' <- zonkIdOcc id ; return (HsVar x (L l id')) } -zonkExpr (HsUnboundVar her occ) +zonkExpr (HsHole (h, her)) = do her' <- zonk_her her - return (HsUnboundVar her' occ) + return (HsHole (h, her')) where zonk_her :: HoleExprRef -> ZonkTcM HoleExprRef zonk_her (HER ref ty u) @@ -935,14 +945,13 @@ ty' <- zonkTcTypeToTypeX ty return (HER ref ty' u) - zonkExpr (HsIPVar x _) = dataConCantHappen x zonkExpr (HsOverLabel x _) = dataConCantHappen x -zonkExpr (HsLit x (HsRat e f ty)) +zonkExpr (HsLit x (XLit (HsRat f ty))) = do new_ty <- zonkTcTypeToTypeX ty - return (HsLit x (HsRat e f new_ty)) + return (HsLit x (XLit $ HsRat f new_ty)) zonkExpr (HsLit x lit) = return (HsLit x lit) @@ -1233,7 +1242,6 @@ WpTyLam <$> zonkTyBndrX tv zonkCoFn (WpTyApp ty) = WpTyApp <$> noBinders (zonkTcTypeToTypeX ty) zonkCoFn (WpLet bs) = WpLet <$> zonkTcEvBinds bs -zonkCoFn (WpMultCoercion co) = WpMultCoercion <$> noBinders (zonkCoToCo co) ------------------------------------------------------------------------- zonkOverLit :: HsOverLit GhcTc -> ZonkTcM (HsOverLit GhcTc) @@ -1302,7 +1310,7 @@ ; new_stmts_w_bndrs <- noBinders $ mapM zonk_branch stmts_w_bndrs -- Add in the binders after we're done with all the branches. - ; let new_binders = [ b | ParStmtBlock _ _ bs _ <- new_stmts_w_bndrs + ; let new_binders = [ b | ParStmtBlock _ _ bs _ <- toList new_stmts_w_bndrs , b <- bs ] ; extendIdZonkEnvRec new_binders ; new_mzip <- noBinders $ zonkExpr mzip_op @@ -1440,7 +1448,7 @@ zonk_args args = do { new_args_rev <- zonk_args_rev (reverse args) ; new_pats <- zonkPats (map get_pat args) - ; return $ zipWithEqual "zonkStmt" replace_pat + ; return $ zipWithEqual replace_pat new_pats (reverse new_args_rev) } -- these need to go backward, because if any operators are higher-rank, @@ -1622,9 +1630,9 @@ --------------------------- zonkConStuff :: HsConPatDetails GhcTc -> ZonkBndrTcM (HsConPatDetails GhcTc) -zonkConStuff (PrefixCon tyargs pats) +zonkConStuff (PrefixCon pats) = do { pats' <- zonkPats pats - ; return (PrefixCon tyargs pats') } + ; return (PrefixCon pats') } zonkConStuff (InfixCon p1 p2) = do { p1' <- zonkPat p1 @@ -1633,11 +1641,10 @@ zonkConStuff (RecCon (HsRecFields x rpats dd)) = do { pats' <- zonkPats (map (hfbRHS . unLoc) rpats) - ; x' <- mapM (noBinders . zonkCoToCo) x ; let rpats' = zipWith (\(L l rp) p' -> L l (rp { hfbRHS = p' })) rpats pats' - ; return (RecCon (HsRecFields x' rpats' dd)) } + ; return (RecCon (HsRecFields x rpats' dd)) } -- Field selectors have declared types; hence no zonking --------------------------- @@ -1672,31 +1679,74 @@ zonkRules rs = mapM (wrapLocZonkMA zonkRule) rs zonkRule :: RuleDecl GhcTc -> ZonkTcM (RuleDecl GhcTc) -zonkRule rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} +zonkRule rule@(HsRule { rd_bndrs = bndrs , rd_lhs = lhs , rd_rhs = rhs }) - = runZonkBndrT (traverse zonk_tm_bndr tm_bndrs) $ \ new_tm_bndrs -> - do { -- See Note [Zonking the LHS of a RULE] - ; new_lhs <- setZonkType SkolemiseFlexi $ zonkLExpr lhs - ; new_rhs <- zonkLExpr rhs - ; return $ rule { rd_tmvs = new_tm_bndrs - , rd_lhs = new_lhs - , rd_rhs = new_rhs } } + = do { skol_tvs_ref <- lift $ newTcRef [] + ; setZonkType (SkolemiseFlexi skol_tvs_ref) $ + -- setZonkType: see Note [Free tyvars on rule LHS] + zonkRuleBndrs bndrs $ \ new_bndrs -> + do { new_lhs <- zonkLExpr lhs + ; skol_tvs <- lift $ readTcRef skol_tvs_ref + ; new_rhs <- setZonkType DefaultFlexi $ zonkLExpr rhs + ; return $ rule { rd_bndrs = add_tvs skol_tvs new_bndrs + , rd_lhs = new_lhs + , rd_rhs = new_rhs } } } + where + add_tvs :: [TyVar] -> RuleBndrs GhcTc -> RuleBndrs GhcTc + add_tvs tvs rbs@(RuleBndrs { rb_ext = bndrs }) = rbs { rb_ext = tvs ++ bndrs } + + +zonkRuleBndrs :: RuleBndrs GhcTc -> (RuleBndrs GhcTc -> ZonkTcM a) -> ZonkTcM a +zonkRuleBndrs rb@(RuleBndrs { rb_ext = bndrs }) thing_inside + = runZonkBndrT (traverse zonk_it bndrs) $ \ new_bndrs -> + thing_inside (rb { rb_ext = new_bndrs }) where - zonk_tm_bndr :: LRuleBndr GhcTc -> ZonkBndrTcM (LRuleBndr GhcTc) - zonk_tm_bndr (L l (RuleBndr x (L loc v))) - = do { v' <- zonk_it v - ; return (L l (RuleBndr x (L loc v'))) } - zonk_tm_bndr (L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig" + zonk_it v + | isId v = zonkIdBndrX v + | otherwise = assert (isImmutableTyVar v) $ + zonkTyBndrX v + -- We may need to go inside the kind of v and zonk there! - zonk_it v - | isId v = zonkIdBndrX v - | otherwise = assert (isImmutableTyVar v) - zonkTyBndrX v - -- DV: used to be "return v", but that is plain - -- wrong because we may need to go inside the kind - -- of v and zonk there! +{- Note [Free tyvars on rule LHS] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + data T a = C + foo :: T a -> Int + foo C = 1 + + {-# RULES "myrule" foo C = 1 #-} + +After type checking the LHS becomes (foo alpha (C alpha)), where alpha +is an unbound meta-tyvar. The zonker in GHC.Tc.Zonk.Type is careful not to +turn the free alpha into Any (as it usually does). Instead we want to quantify +over it. Here is how: + +* We set the ze_flexi field of ZonkEnv to (SkolemiseFlexi ref), to tell the + zonker to zonk a Flexi meta-tyvar to a TyVar, not to Any. See the + SkolemiseFlexi case of `commitFlexi`. + +* Here (ref :: TcRef [TyVar]) collects the type variables thus skolemised; + again see `commitFlexi`. + +* When zonking a RULE, in `zonkRule` we + - make a fresh ref-cell to collect the skolemised type variables, + - zonk the binders and LHS with ze_flexi = SkolemiseFlexi ref + - read the ref-cell to get all the skolemised TyVars + - add them to the binders + +All this applies for SPECIALISE pragmas too. + +Wrinkles: + +(FTV1) We just add the new tyvars to the front of the binder-list, but + that may make the list not be in dependency order. Example (T12925): + the existing list is [k:Type, b:k], and we add (a:k) to the front. + Also we just collect the new skolemised type variables in any old order, + so they may not be ordered with respect to each other. +-} + {- ************************************************************************ * * @@ -1902,89 +1952,3 @@ operation. (consider /\a -> f @ b, where b is side-effected to a) -} -{- -************************************************************************ -* * - Checking for coercion holes -* * -************************************************************************ --} - --- | Is a coercion hole filled in? -isFilledCoercionHole :: CoercionHole -> TcM Bool -isFilledCoercionHole (CoercionHole { ch_ref = ref }) - = isJust <$> readTcRef ref - --- | Retrieve the contents of a coercion hole. Panics if the hole --- is unfilled -unpackCoercionHole :: CoercionHole -> TcM Coercion -unpackCoercionHole hole - = do { contents <- unpackCoercionHole_maybe hole - ; case contents of - Just co -> return co - Nothing -> pprPanic "Unfilled coercion hole" (ppr hole) } - --- | Retrieve the contents of a coercion hole, if it is filled -unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion) -unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref - -zonkCtRewriterSet :: Ct -> TcM Ct -zonkCtRewriterSet ct - | isGivenCt ct - = return ct - | otherwise - = case ct of - CEqCan eq@(EqCt { eq_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev - ; return (CEqCan (eq { eq_ev = ev' })) } - CIrredCan ir@(IrredCt { ir_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev - ; return (CIrredCan (ir { ir_ev = ev' })) } - CDictCan di@(DictCt { di_ev = ev }) -> do { ev' <- zonkCtEvRewriterSet ev - ; return (CDictCan (di { di_ev = ev' })) } - CQuantCan {} -> return ct - CNonCanonical ev -> do { ev' <- zonkCtEvRewriterSet ev - ; return (CNonCanonical ev') } - -zonkCtEvRewriterSet :: CtEvidence -> TcM CtEvidence -zonkCtEvRewriterSet ev@(CtGiven {}) - = return ev -zonkCtEvRewriterSet ev@(CtWanted { ctev_rewriters = rewriters }) - = do { rewriters' <- zonkRewriterSet rewriters - ; return (ev { ctev_rewriters = rewriters' }) } - --- | Check whether any coercion hole in a RewriterSet is still unsolved. --- Does this by recursively looking through filled coercion holes until --- one is found that is not yet filled in, at which point this aborts. -zonkRewriterSet :: RewriterSet -> TcM RewriterSet -zonkRewriterSet (RewriterSet set) - = nonDetStrictFoldUniqSet go (return emptyRewriterSet) set - -- this does not introduce non-determinism, because the only - -- monadic action is to read, and the combining function is - -- commutative - where - go :: CoercionHole -> TcM RewriterSet -> TcM RewriterSet - go hole m_acc = unionRewriterSet <$> check_hole hole <*> m_acc - - check_hole :: CoercionHole -> TcM RewriterSet - check_hole hole = do { m_co <- unpackCoercionHole_maybe hole - ; case m_co of - Nothing -> return (unitRewriterSet hole) - Just co -> unUCHM (check_co co) } - - check_ty :: Type -> UnfilledCoercionHoleMonoid - check_co :: Coercion -> UnfilledCoercionHoleMonoid - (check_ty, _, check_co, _) = foldTyCo folder () - - folder :: TyCoFolder () UnfilledCoercionHoleMonoid - folder = TyCoFolder { tcf_view = noView - , tcf_tyvar = \ _ tv -> check_ty (tyVarKind tv) - , tcf_covar = \ _ cv -> check_ty (varType cv) - , tcf_hole = \ _ -> UCHM . check_hole - , tcf_tycobinder = \ _ _ _ -> () } - -newtype UnfilledCoercionHoleMonoid = UCHM { unUCHM :: TcM RewriterSet } - -instance Semigroup UnfilledCoercionHoleMonoid where - UCHM l <> UCHM r = UCHM (unionRewriterSet <$> l <*> r) - -instance Monoid UnfilledCoercionHoleMonoid where - mempty = UCHM (return emptyRewriterSet) diff --git a/GHC/ThToHs.hs b/GHC/ThToHs.hs --- a/GHC/ThToHs.hs +++ b/GHC/ThToHs.hs @@ -3,6 +3,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DerivingVia #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} @@ -27,6 +28,7 @@ import GHC.Hs as Hs import GHC.Tc.Errors.Types +import GHC.Types.Name.Cache import GHC.Types.Name.Reader import qualified GHC.Types.Name as Name import GHC.Unit.Module @@ -47,11 +49,14 @@ import GHC.Data.FastString import GHC.Utils.Panic +import GHC.Data.EnumSet (EnumSet) +import qualified GHC.Data.EnumSet as EnumSet +import qualified GHC.LanguageExtensions as LangExt + import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import qualified Data.ByteString as BS -import Control.Monad( unless, ap ) -import Control.Applicative( (<|>) ) +import Control.Monad( unless ) import Data.Bifunctor (first) import Data.Foldable (for_) import Data.List.NonEmpty( NonEmpty (..), nonEmpty ) @@ -63,32 +68,44 @@ import Foreign.Ptr import System.IO.Unsafe +import Control.Monad.Trans.Reader +import Control.Monad.Trans.State.Strict + ------------------------------------------------------------------- -- The external interface -convertToHsDecls :: Origin -> SrcSpan -> [TH.Dec] -> Either RunSpliceFailReason [LHsDecl GhcPs] -convertToHsDecls origin loc ds = - initCvt origin loc $ fmap catMaybes (mapM cvt_dec ds) +convertToHsDecls :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> [TH.Dec] -> Either RunSpliceFailReason [LHsDecl GhcPs] +convertToHsDecls exts origin loc ds = + initCvt exts origin loc $ fmap catMaybes (mapM cvt_dec ds) where cvt_dec d = wrapMsg (ConvDec d) $ cvtDec d -convertToHsExpr :: Origin -> SrcSpan -> TH.Exp -> Either RunSpliceFailReason (LHsExpr GhcPs) -convertToHsExpr origin loc e - = initCvt origin loc $ wrapMsg (ConvExp e) $ cvtl e +convertToHsExpr :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> TH.Exp -> Either RunSpliceFailReason (LHsExpr GhcPs) +convertToHsExpr exts origin loc e + = initCvt exts origin loc $ wrapMsg (ConvExp e) $ cvtl e -convertToPat :: Origin -> SrcSpan -> TH.Pat -> Either RunSpliceFailReason (LPat GhcPs) -convertToPat origin loc p - = initCvt origin loc $ wrapMsg (ConvPat p) $ cvtPat p +convertToPat :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> TH.Pat -> Either RunSpliceFailReason (LPat GhcPs) +convertToPat exts origin loc p + = initCvt exts origin loc $ wrapMsg (ConvPat p) $ cvtPat p -convertToHsType :: Origin -> SrcSpan -> TH.Type -> Either RunSpliceFailReason (LHsType GhcPs) -convertToHsType origin loc t - = initCvt origin loc $ wrapMsg (ConvType t) $ cvtType t +convertToHsType :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> TH.Type -> Either RunSpliceFailReason (LHsType GhcPs) +convertToHsType exts origin loc t + = initCvt exts origin loc $ wrapMsg (ConvType t) $ cvtType t ------------------------------------------------------------------- -newtype CvtM' err a = CvtM { unCvtM :: Origin -> SrcSpan -> Either err (SrcSpan, a) } - deriving (Functor) + +-- Reader context for CvtM +data CvtCtx = + CvtCtx { cvt_origin :: !Origin + , cvt_listTuplePuns :: !Bool } + +-- State of CvtM +type CvtSt = SrcSpan + +newtype CvtM' err a = CvtM { unCvtM :: CvtCtx -> CvtSt -> Either err (a, SrcSpan) } + deriving (Functor, Applicative, Monad) via ReaderT CvtCtx (StateT CvtSt (Either err)) -- Push down the Origin (that is configurable by -- -fenable-th-splice-warnings) and source location; -- Can fail, with a single error message @@ -103,21 +120,12 @@ -- Use the SrcSpan everywhere, for lack of anything better. -- See Note [Source locations within TH splices]. -instance Applicative (CvtM' err) where - pure x = CvtM $ \_ loc -> Right (loc,x) - (<*>) = ap - -instance Monad (CvtM' err) where - (CvtM m) >>= k = CvtM $ \origin loc -> case m origin loc of - Left err -> Left err - Right (loc',v) -> unCvtM (k v) origin loc' - -- | Return first success or first error. -- -- Primary case should be the first because it -- would determine returned error message orOnFail :: CvtM' err a -> CvtM' err a -> CvtM' err a -(CvtM m1) `orOnFail` (CvtM m2) = CvtM $ \origin l -> choose (m1 origin l) (m2 origin l) +m1 `orOnFail` m2 = CvtM $ \ctx l -> choose (unCvtM m1 ctx l) (unCvtM m2 ctx l) where choose r@Right{} _ = r choose _ r@Right{} = r @@ -126,10 +134,13 @@ infixl 3 `orOnFail` -- The same fixity as for <|> mapCvtMError :: (err1 -> err2) -> CvtM' err1 a -> CvtM' err2 a -mapCvtMError f (CvtM m) = CvtM $ \origin loc -> first f $ m origin loc +mapCvtMError f m = CvtM $ \origin loc -> first f $ unCvtM m origin loc -initCvt :: Origin -> SrcSpan -> CvtM' err a -> Either err a -initCvt origin loc (CvtM m) = fmap snd (m origin loc) +initCvt :: EnumSet LangExt.Extension -> Origin -> SrcSpan -> CvtM' err a -> Either err a +initCvt exts origin loc m = fmap fst (unCvtM m ctx loc) + where ctx = CvtCtx { cvt_origin = origin + , cvt_listTuplePuns = listTuplePuns } + listTuplePuns = EnumSet.member LangExt.ListTuplePuns exts force :: a -> CvtM () force a = a `seq` return () @@ -138,42 +149,46 @@ failWith m = CvtM (\_ _ -> Left m) getOrigin :: CvtM Origin -getOrigin = CvtM (\origin loc -> Right (loc,origin)) +getOrigin = CvtM (\ctx s -> Right (cvt_origin ctx,s)) +getListTuplePuns :: CvtM Bool +getListTuplePuns = CvtM (\ctx s -> Right (cvt_listTuplePuns ctx,s)) + getL :: CvtM SrcSpan getL = CvtM (\_ loc -> Right (loc,loc)) -- NB: This is only used in conjunction with LineP pragmas. -- See Note [Source locations within TH splices]. setL :: SrcSpan -> CvtM () -setL loc = CvtM (\_ _ -> Right (loc, ())) +setL loc = CvtM (\_ _ -> Right ((), loc)) returnLA :: (NoAnn ann) => e -> CvtM (LocatedAn ann e) -returnLA x = CvtM (\_ loc -> Right (loc, L (noAnnSrcSpan loc) x)) +returnLA x = CvtM (\_ loc -> Right (L (noAnnSrcSpan loc) x, loc)) returnJustLA :: a -> CvtM (Maybe (LocatedA a)) returnJustLA = fmap Just . returnLA wrapParLA :: (NoAnn ann) => (LocatedAn ann a -> b) -> a -> CvtM b -wrapParLA add_par x = CvtM (\_ loc -> Right (loc, add_par (L (noAnnSrcSpan loc) x))) +wrapParLA add_par x = CvtM (\_ loc -> Right (add_par (L (noAnnSrcSpan loc) x), loc)) wrapMsg :: ThingBeingConverted -> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a wrapMsg what = mapCvtMError (ConversionFail what) wrapL :: CvtM a -> CvtM (Located a) -wrapL (CvtM m) = CvtM $ \origin loc -> case m origin loc of - Left err -> Left err - Right (loc', v) -> Right (loc', L loc v) +wrapL m = do + loc <- getL + fmap (L loc) m +wrapGL :: HasAnnotation e => CvtM a -> CvtM (GenLocated e a) +wrapGL m = do + loc <- getL + fmap (L (noAnnSrcSpan loc)) m + wrapLN :: CvtM a -> CvtM (LocatedN a) -wrapLN (CvtM m) = CvtM $ \origin loc -> case m origin loc of - Left err -> Left err - Right (loc', v) -> Right (loc', L (noAnnSrcSpan loc) v) +wrapLN = wrapGL wrapLA :: CvtM a -> CvtM (LocatedA a) -wrapLA (CvtM m) = CvtM $ \origin loc -> case m origin loc of - Left err -> Left err - Right (loc', v) -> Right (loc', L (noAnnSrcSpan loc) v) +wrapLA = wrapGL {- Note [Source locations within TH splices] @@ -230,7 +245,7 @@ PatBind { pat_lhs = pat' , pat_rhs = GRHSs emptyComments body' ds' , pat_ext = noExtField - , pat_mult = HsNoMultAnn noExtField + , pat_mult = HsUnannotated EpPatBind } } cvtDec (TH.FunD nm cls) @@ -452,7 +467,7 @@ ; returnJustLA $ Hs.ValD noExtField $ PatSynBind noExtField $ PSB noAnn nm' args' pat' dir' } where - cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon noTypeArgs <$> mapM vNameN args + cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameN args cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameN a1 <*> vNameN a2 cvtArgs (TH.RecordPatSyn sels) = do { let mk_fld = fldNameN (nameBase nm) @@ -689,7 +704,7 @@ cvtConstr _ do_con_name (NormalC c strtys) = do { c' <- do_con_name c ; tys' <- mapM cvt_arg strtys - ; returnLA $ mkConDeclH98 noAnn c' Nothing Nothing (PrefixCon noTypeArgs (map hsLinear tys')) } + ; returnLA $ mkConDeclH98 noAnn c' Nothing Nothing (PrefixCon tys') } cvtConstr parent_con do_con_name (RecC c varstrtys) = do { c' <- do_con_name c @@ -702,7 +717,7 @@ ; st1' <- cvt_arg st1 ; st2' <- cvt_arg st2 ; returnLA $ mkConDeclH98 noAnn c' Nothing Nothing - (InfixCon (hsLinear st1') (hsLinear st2')) } + (InfixCon st1' st2') } cvtConstr parent_con do_con_name (ForallC tvs ctxt con) = do { tvs' <- cvtTvs tvs @@ -714,10 +729,15 @@ add_cxt (L loc cxt1) (Just (L _ cxt2)) = Just (L loc (cxt1 ++ cxt2)) + -- Nested foralls end up flattened (see tests/th/GadtConSigs_th_dump1.stderr) + -- but it doesn't seem to matter. add_forall :: [LHsTyVarBndr Hs.Specificity GhcPs] -> LHsContext GhcPs -> ConDecl GhcPs -> ConDecl GhcPs - add_forall tvs' cxt' con@(ConDeclGADT { con_bndrs = L l outer_bndrs, con_mb_cxt = cxt }) - = con { con_bndrs = L l outer_bndrs' + add_forall tvs' cxt' con@(ConDeclGADT { con_outer_bndrs = L l outer_bndrs + , con_inner_bndrs = inner_bndrs + , con_mb_cxt = cxt }) + = con { con_outer_bndrs = L l outer_bndrs' + , con_inner_bndrs = inner_bndrs , con_mb_cxt = add_cxt cxt' cxt } where outer_bndrs' @@ -741,7 +761,7 @@ { c' <- mapM do_con_name c ; args <- mapM cvt_arg strtys ; ty' <- cvtType ty - ; mk_gadt_decl c' (PrefixConGADT noExtField $ map hsLinear args) ty'} + ; mk_gadt_decl c' (PrefixConGADT noExtField args) ty'} cvtConstr parent_con do_con_name (RecGadtC c varstrtys ty) = case nonEmpty c of Nothing -> failWith RecGadtNoCons @@ -755,11 +775,12 @@ mk_gadt_decl :: NonEmpty (LocatedN RdrName) -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs -> CvtM (LConDecl GhcPs) mk_gadt_decl names args res_ty - = do bndrs <- returnLA mkHsOuterImplicit + = do outer_bndrs <- returnLA mkHsOuterImplicit returnLA $ ConDeclGADT { con_g_ext = noAnn , con_names = names - , con_bndrs = bndrs + , con_outer_bndrs = outer_bndrs + , con_inner_bndrs = [] , con_mb_cxt = Nothing , con_g_args = args , con_res_ty = res_ty @@ -775,25 +796,24 @@ cvtSrcStrictness SourceLazy = SrcLazy cvtSrcStrictness SourceStrict = SrcStrict -cvt_arg :: (TH.Bang, TH.Type) -> CvtM (LHsType GhcPs) +cvt_arg :: (TH.Bang, TH.Type) -> CvtM (HsConDeclField GhcPs) cvt_arg (Bang su ss, ty) = do { ty'' <- cvtType ty ; let ty' = parenthesizeHsType appPrec ty'' su' = cvtSrcUnpackedness su ss' = cvtSrcStrictness ss - ; returnLA $ HsBangTy (noAnn, NoSourceText) (HsBang su' ss') ty' } + ; return $ CDF noAnn su' ss' (HsUnannotated (EpColon noAnn)) ty' Nothing } cvt_id_arg :: TH.Name -- ^ parent constructor name - -> (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs) + -> (TH.Name, TH.Bang, TH.Type) -> CvtM (LHsConDeclRecField GhcPs) cvt_id_arg parent_con (i, str, ty) = do { L li i' <- fldNameN (nameBase parent_con) i ; ty' <- cvt_arg (str,ty) - ; returnLA $ ConDeclField - { cd_fld_ext = noAnn - , cd_fld_names + ; returnLA $ HsConDeclRecField + { cdrf_ext = noExtField + , cdrf_names = [L (l2l li) $ FieldOcc noExtField (L li i')] - , cd_fld_type = ty' - , cd_fld_doc = Nothing} } + , cdrf_spec = ty' } } cvtDerivs :: [TH.DerivClause] -> CvtM (HsDeriving GhcPs) cvtDerivs cs = do { mapM cvtDerivClause cs } @@ -895,31 +915,21 @@ srcTxt = SourceText $ fsLit "{-# OPAQUE" ; returnJustLA $ Hs.SigD noExtField $ InlineSig noAnn nm' ip } -cvtPragmaD (SpecialiseP nm ty inline phases) - = do { nm' <- vNameN nm - ; ty' <- cvtSigType ty - ; let src TH.NoInline = fsLit "{-# SPECIALISE NOINLINE" - src TH.Inline = fsLit "{-# SPECIALISE INLINE" - src TH.Inlinable = fsLit "{-# SPECIALISE INLINE" - ; let (inline', dflt, srcText) = case inline of - Just inline1 -> (cvtInline inline1 (toSrcTxt inline1), dfltActivation inline1, - toSrcTxt inline1) - Nothing -> (NoUserInlinePrag, AlwaysActive, - SourceText $ fsLit "{-# SPECIALISE") - where - toSrcTxt a = SourceText $ src a - ; let ip = InlinePragma { inl_src = srcText - , inl_inline = inline' - , inl_rule = Hs.FunLike - , inl_act = cvtPhases phases dflt - , inl_sat = Nothing } - ; returnJustLA $ Hs.SigD noExtField $ SpecSig noAnn nm' [ty'] ip } - cvtPragmaD (SpecialiseInstP ty) = do { ty' <- cvtSigType ty ; returnJustLA $ Hs.SigD noExtField $ SpecInstSig (noAnn, (SourceText $ fsLit "{-# SPECIALISE")) ty' } +cvtPragmaD (SpecialiseEP ty_bndrs tm_bndrs exp inline phases) + = do { ty_bndrs' <- traverse cvtTvs ty_bndrs + ; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs + ; let ip = cvtInlinePhases inline phases + ; exp' <- cvtl exp + ; let bndrs' = RuleBndrs { rb_ext = noAnn, rb_tyvs = ty_bndrs', rb_tmvs = tm_bndrs' } + ; returnJustLA $ Hs.SigD noExtField $ + SpecSigE noAnn bndrs' exp' ip + } + cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases) = do { let nm' = mkFastString nm ; rd_name' <- returnLA nm' @@ -932,8 +942,7 @@ HsRule { rd_ext = (noAnn, quotedSourceText nm) , rd_name = rd_name' , rd_act = act - , rd_tyvs = ty_bndrs' - , rd_tmvs = tm_bndrs' + , rd_bndrs = RuleBndrs { rb_ext = noAnn, rb_tyvs = ty_bndrs', rb_tmvs = tm_bndrs' } , rd_lhs = lhs' , rd_rhs = rhs' } ; returnJustLA $ Hs.RuleD noExtField @@ -1001,6 +1010,24 @@ ; ty' <- cvtType ty ; returnLA $ Hs.RuleBndrSig noAnn n' $ mkHsPatSigType noAnn ty' } +cvtInlinePhases :: Maybe Inline -> Phases -> InlinePragma +cvtInlinePhases inline phases = + let src TH.NoInline = fsLit "{-# SPECIALISE NOINLINE" + src TH.Inline = fsLit "{-# SPECIALISE INLINE" + src TH.Inlinable = fsLit "{-# SPECIALISE INLINE" + (inline', dflt, srcText) = case inline of + Just inline1 -> (cvtInline inline1 (toSrcTxt inline1), dfltActivation inline1, + toSrcTxt inline1) + Nothing -> (NoUserInlinePrag, AlwaysActive, + SourceText $ fsLit "{-# SPECIALISE") + where + toSrcTxt a = SourceText $ src a + in InlinePragma { inl_src = srcText + , inl_inline = inline' + , inl_rule = Hs.FunLike + , inl_act = cvtPhases phases dflt + , inl_sat = Nothing } + --------------------------------------------------- -- Declarations --------------------------------------------------- @@ -1043,8 +1070,8 @@ cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs) cvtl e = wrapLA (cvt e) where - cvt (VarE s) = do { s' <- vName s; wrapParLA (HsVar noExtField) s' } - cvt (ConE s) = do { s' <- dName s; wrapParLA (HsVar noExtField) s' } + cvt (VarE s) = do { s' <- vName s; wrapParLA mkHsVar s' } + cvt (ConE s) = do { s' <- dName s; wrapParLA mkHsVar s' } cvt (LitE l) | overloadedLit l = go cvtOverLit (HsOverLit noExtField) (hsOverLitNeedsParens appPrec) @@ -1092,10 +1119,9 @@ ; return $ ExplicitSum noAnn alt arity e'} cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; ; return $ mkHsIf x' y' z' noAnn } - cvt (MultiIfE alts) - | null alts = failWith MultiWayIfWithoutAlts - | otherwise = do { alts' <- mapM cvtpair alts - ; return $ HsMultiIf noAnn alts' } + cvt (MultiIfE alts) = case nonEmpty alts of + Nothing -> failWith MultiWayIfWithoutAlts + Just alts -> HsMultiIf noAnn <$> traverse cvtpair alts cvt (LetE ds e) = do { ds' <- cvtLocalDecs LetExpression ds ; e' <- cvtl e; return $ HsLet noAnn ds' e'} cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms @@ -1170,7 +1196,7 @@ -- important, because UnboundVarE may contain -- constructor names - see #14627. { s' <- vcName s - ; wrapParLA (HsVar noExtField) s' } + ; wrapParLA mkHsVar s' } cvt (LabelE s) = return $ HsOverLabel NoSourceText (fsLit s) cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' } cvt (GetFieldE exp f) = do { e' <- cvtl exp @@ -1179,7 +1205,7 @@ cvt (ProjectionE xs) = return $ HsProjection noAnn $ fmap (DotFieldOcc noAnn . L noSrcSpanA . FieldLabelString . fsLit) xs cvt (TypedSpliceE e) = do { e' <- parenthesizeHsExpr appPrec <$> cvtl e - ; return $ HsTypedSplice noAnn e' } + ; return $ HsTypedSplice noExtField (HsTypedSpliceExpr noAnn e') } cvt (TypedBracketE e) = do { e' <- cvtl e ; return $ HsTypedBracket noAnn e' } cvt (TypeE t) = do { t' <- cvtType t @@ -1351,8 +1377,11 @@ cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnLA $ mkPsBindStmt noAnn p' e' } cvtStmt (TH.LetS ds) = do { ds' <- cvtLocalDecs LetBinding ds ; returnLA $ LetStmt noAnn ds' } -cvtStmt (TH.ParS dss) = do { dss' <- mapM cvt_one dss - ; returnLA $ ParStmt noExtField dss' noExpr noSyntaxExpr } +cvtStmt (TH.ParS dss) = case nonEmpty dss of + Nothing -> failWith EmptyParStmt + Just dss -> do + { dss' <- mapM cvt_one dss + ; returnLA $ ParStmt noExtField dss' noExpr noSyntaxExpr } where cvt_one ds = do { ds' <- cvtStmts ds ; return (ParStmtBlock noExtField ds' undefined noSyntaxExpr) } @@ -1370,10 +1399,12 @@ ; decs' <- cvtLocalDecs WhereClause decs ; returnLA $ Hs.Match noExtField ctxt (noLocA [lp]) (GRHSs emptyComments g' decs') } -cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)] -cvtGuard (GuardedB pairs) = mapM cvtpair pairs +cvtGuard :: TH.Body -> CvtM (NonEmpty (LGRHS GhcPs (LHsExpr GhcPs))) +cvtGuard (GuardedB pairs) = case nonEmpty pairs of + Nothing -> failWith EmptyGuard + Just pairs -> traverse cvtpair pairs cvtGuard (NormalB e) = do { e' <- cvtl e - ; g' <- returnLA $ GRHS noAnn [] e'; return [g'] } + ; g' <- returnLA $ GRHS noAnn [] e'; return (g' :| []) } cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs)) cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs @@ -1471,14 +1502,12 @@ ; unboxedSumChecks alt arity ; return $ SumPat noAnn p' alt arity } cvtp (ConP s ts ps) = do { s' <- dNameN s - ; ps' <- cvtPats ps - ; ts' <- mapM cvtType ts + ; ps' <- cvtPats (map InvisP ts ++ ps) ; let pps = map (parenthesizePat appPrec) ps' - pts = map (\t -> HsConPatTyArg noAnn (mkHsTyPat t)) ts' ; return $ ConPat { pat_con_ext = noAnn , pat_con = s' - , pat_args = PrefixCon pts pps + , pat_args = PrefixCon pps } } cvtp (InfixP p1 s p2) = do { s' <- dNameN s; p1' <- cvtPat p1; p2' <- cvtPat p2 @@ -1690,7 +1719,7 @@ _ -> return $ parenthesizeHsType sigPrec x' let y'' = parenthesizeHsType sigPrec y' - returnLA (HsFunTy noExtField (HsUnrestrictedArrow noAnn) x'' y'') + returnLA (HsFunTy noExtField (HsUnannotated (EpArrow noAnn)) x'' y'') | otherwise -> do { fun_tc <- returnLA $ getRdrName unrestrictedFunTyCon ; mk_apps (HsTyVar noAnn NotPromoted fun_tc) tys' } @@ -1853,12 +1882,12 @@ _ -> failWith (MalformedType typeOrKind ty) } -hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs +hsTypeToArrow :: LHsType GhcPs -> HsMultAnn GhcPs hsTypeToArrow w = case unLoc w of HsTyVar _ _ (L _ (isExact_maybe -> Just n)) - | n == oneDataConName -> HsLinearArrow noAnn - | n == manyDataConName -> HsUnrestrictedArrow noAnn - _ -> HsExplicitMult noAnn w + | n == oneDataConName -> HsLinearAnn noAnn + | n == manyDataConName -> HsUnannotated (EpArrow noAnn) + _ -> HsExplicitMult (noAnn, EpArrow noAnn) w -- ConT/InfixT can contain both data constructor (i.e., promoted) names and -- other (i.e, unpromoted) names, as opposed to PromotedT, which can only @@ -2165,7 +2194,8 @@ | not (okOcc ctxt_ns occ_str) = failWith (IllegalOccName ctxt_ns occ_str) | otherwise = do { loc <- getL - ; let rdr_name = thRdrName loc ctxt_ns occ_str flavour + ; listTuplePuns <- getListTuplePuns + ; let rdr_name = thRdrName listTuplePuns loc ctxt_ns occ_str flavour ; force rdr_name ; return rdr_name } where @@ -2185,7 +2215,7 @@ "" -> False (c:_) -> startsVarId c || startsVarSym c -thRdrName :: SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName +thRdrName :: Bool -> SrcSpan -> OccName.NameSpace -> String -> TH.NameFlavour -> RdrName -- This turns a TH Name into a RdrName; used for both binders and occurrences -- See Note [Binders in Template Haskell] -- The passed-in name space tells what the context is expecting; @@ -2201,35 +2231,105 @@ -- which will give confusing error messages later -- -- The strict applications ensure that any buried exceptions get forced -thRdrName loc ctxt_ns th_occ th_name +thRdrName listTuplePuns loc ctxt_ns th_occ th_name = case th_name of - TH.NameG th_ns pkg mod -> thOrigRdrName th_occ th_ns pkg mod + TH.NameG th_ns pkg mod -> thOrigOrExactRdrName th_occ th_ns pkg mod TH.NameQ mod -> (mkRdrQual $! mk_mod mod) $! occ TH.NameL uniq -> nameRdrName $! (((Name.mkInternalName $! mk_uniq (fromInteger uniq)) $! occ) loc) TH.NameU uniq -> nameRdrName $! (((Name.mkSystemNameAt $! mk_uniq (fromInteger uniq)) $! occ) loc) - TH.NameS | Just name <- isBuiltInOcc_maybe occ -> nameRdrName $! name - | otherwise -> mkRdrUnqual $! occ - -- We check for built-in syntax here, because the TH - -- user might have written a (NameS "(,,)"), for example + TH.NameS -> thUnqualRdrName listTuplePuns occ where occ :: OccName.OccName occ = mk_occ ctxt_ns th_occ --- Return an unqualified exact RdrName if we're dealing with built-in syntax. --- See #13776. +{- thOrigRdrName converts /original names/ in TH to their GHC representation. + +An original name is the canonical (Module, OccName) pair (where Module also +includes package/unit info) that (a) uniquely and (b) unambiguously identifies a +top-level binding. For example, ghc-prim:GHC.Types.List is the original name of +the list type []. + +To be more precise, + a) "uniquely" means that there's exactly one original name for each top-level + binding, which makes it different from a qualified name. + Qualified names permit reexports and module aliases: + + import Data.List as L + + xs :: L.List a -- L is a module alias for Data.List + xs :: Data.List.List a -- Data.List reexports GHC.Types.List + + Only ghc-prim:GHC.Types.List constitutes List's original name because + GHC.Types is the original module where we find the type declaration: + + data List a = [] | a : List a -- in ghc-prim:GHC.Types + + b) "unambiguously" means that the original name contains sufficient + information to identify the top-level binding in all possible contexts. + + For example, ghc-prim:GHC.Types.List remains valid even if the user + declares their own List type. + +In TH, original names arise from name quotation, e.g. + + 'Just ==> ghc-internal:GHC.Internal.Maybe.Just + ''ReaderT ==> transformers:Control.Monad.Trans.Reader.ReaderT + ''[] ==> ghc-prim:GHC.Types.List (with ListTuplePuns) + +NB. You likely want to use thOrigOrExactRdrName instead of thOrigRdrName. +-} thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName -thOrigRdrName occ th_ns pkg mod = - let occ' = mk_occ (mk_ghc_ns th_ns) occ - mod' = mkModule (mk_pkg pkg) (mk_mod mod) - in case isBuiltInOcc_maybe occ' <|> isPunOcc_maybe mod' occ' of - Just name -> nameRdrName name - Nothing -> (mkOrig $! mod') $! occ' +thOrigRdrName occ th_ns pkg mod = (mkOrig $! mod') $! occ' + where + occ' = mk_occ (mk_ghc_ns th_ns) occ + mod' = mkModule (mk_pkg pkg) (mk_mod mod) -thRdrNameGuesses :: TH.Name -> [RdrName] -thRdrNameGuesses (TH.Name occ flavour) +{- Note [Pretty-printing known original names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An original name is a pair (Module, OccName), and normally we would pretty-print +it using the M.x syntax, e.g. "GHC.Types.Int" or "GHC.Internal.Base.ord". +However, this approach creates two problems (test case: th/T13776): + + 1) Illegal quantification of built-in syntax, e.g. the nil data constructor [] + would be printed as GHC.Types.[], which is not valid Haskell syntax + + 2) Ignoring ListTuplePuns. e.g. the type constructor (,) would be + printed as GHC.Tuple.Tuple2, even though the user would prefer to see (,) + +The pretty-printer for Name has special cases to deal with this, but the one for +Orig RdrNames does not. Trying to fix this directly in the Outputable RdrName instance +creates nasty module cycles. Instead, we work around the issue by avoiding the +problematic Orig names altogether, converting them to Exact names as early as +possible. +-} + +-- thOrigOrExactRdrName is a variant of thOrigRdrName that returns Exact names +-- instead of known Orig names. +-- +-- See Note [Pretty-printing known original names] for the rationale. +thOrigOrExactRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName +thOrigOrExactRdrName occ th_ns pkg mod = knownOrigToExactRdrName (thOrigRdrName occ th_ns pkg mod) + +-- Convert known Orig names to Exact names, leaving all other names intact. +knownOrigToExactRdrName :: RdrName -> RdrName +knownOrigToExactRdrName (Orig mod occ) + | Just name <- isKnownOrigName_maybe mod occ + = Exact name +knownOrigToExactRdrName rdr = rdr + +-- Return an exact RdrName if we're dealing with built-in syntax. +-- The user might have written (NameS "(,,)"), for example. +thUnqualRdrName :: Bool -> OccName.OccName -> RdrName +thUnqualRdrName listTuplePuns occ = + case isBuiltInOcc_maybe listTuplePuns occ of + Just name -> nameRdrName $! name + Nothing -> mkRdrUnqual $! occ + +thRdrNameGuesses :: Bool -> TH.Name -> [RdrName] +thRdrNameGuesses listTuplePuns (TH.Name occ flavour) -- This special case for NameG ensures that we don't generate duplicates in the output list - | TH.NameG th_ns pkg mod <- flavour = [ thOrigRdrName occ_str th_ns pkg mod] - | otherwise = [ thRdrName noSrcSpan gns occ_str flavour + | TH.NameG th_ns pkg mod <- flavour = [ thOrigOrExactRdrName occ_str th_ns pkg mod ] + | otherwise = [ thRdrName listTuplePuns noSrcSpan gns occ_str flavour | gns <- guessed_nss] where -- guessed_ns are the name spaces guessed from looking at the TH name diff --git a/GHC/Types/Annotations.hs b/GHC/Types/Annotations.hs --- a/GHC/Types/Annotations.hs +++ b/GHC/Types/Annotations.hs @@ -31,7 +31,7 @@ import Data.Maybe import Data.Typeable import Data.Word ( Word8 ) - +import Control.DeepSeq -- | Represents an annotation after it has been sufficiently desugared from -- it's initial form of 'GHC.Hs.Decls.AnnDecl' @@ -70,6 +70,10 @@ case h of 0 -> liftM NamedTarget $ get bh _ -> liftM ModuleTarget $ get bh + +instance NFData name => NFData (AnnTarget name) where + rnf (NamedTarget n) = rnf n + rnf (ModuleTarget m) = rnf m instance Outputable Annotation where ppr ann = ppr (ann_target ann) diff --git a/GHC/Types/Avail.hs b/GHC/Types/Avail.hs --- a/GHC/Types/Avail.hs +++ b/GHC/Types/Avail.hs @@ -22,7 +22,8 @@ filterAvails, nubAvails, sortAvails, - DetOrdAvails(DetOrdAvails, DefinitelyDeterministicAvails) + DetOrdAvails(DetOrdAvails, getDetOrdAvails, DefinitelyDeterministicAvails), + emptyDetOrdAvails ) where import GHC.Prelude @@ -74,9 +75,25 @@ -- We guarantee a deterministic order by either using the order explicitly -- given by the user (e.g. in an explicit constructor export list) or instead -- by sorting the avails with 'sortAvails'. -newtype DetOrdAvails = DefinitelyDeterministicAvails Avails +newtype DetOrdAvails = DefinitelyDeterministicAvails { getDetOrdAvails :: Avails } deriving newtype (Binary, Outputable, NFData) +instance Eq DetOrdAvails where + a1 == a2 = compare a1 a2 == EQ +instance Ord DetOrdAvails where + compare (DetOrdAvails a1) (DetOrdAvails a2) = go a1 a2 + where + go [] [] = EQ + go _ [] = LT + go [] _ = GT + go (a:as) (b:bs) = + case (a, b) of + (Avail {}, AvailTC {}) -> LT + (AvailTC{}, Avail {}) -> GT + (Avail n1, Avail n2) -> stableNameCmp n1 n2 S.<> go as bs + (AvailTC n1 m1s, AvailTC n2 m2s) -> + stableNameCmp n1 n2 S.<> foldMap (uncurry stableNameCmp) (zip m1s m2s) S.<> go as bs + -- | It's always safe to match on 'DetOrdAvails' pattern DetOrdAvails :: Avails -> DetOrdAvails pattern DetOrdAvails x <- DefinitelyDeterministicAvails x @@ -245,3 +262,7 @@ instance NFData AvailInfo where rnf (Avail n) = rnf n rnf (AvailTC a b) = rnf a `seq` rnf b + +-- | Create an empty DetOrdAvails +emptyDetOrdAvails :: DetOrdAvails +emptyDetOrdAvails = DefinitelyDeterministicAvails [] diff --git a/GHC/Types/Basic.hs b/GHC/Types/Basic.hs --- a/GHC/Types/Basic.hs +++ b/GHC/Types/Basic.hs @@ -21,6 +21,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} module GHC.Types.Basic ( LeftOrRight(..), @@ -85,7 +87,7 @@ CompilerPhase(..), PhaseNum, beginPhase, nextPhase, laterPhase, Activation(..), isActive, competesWith, - isNeverActive, isAlwaysActive, activeInFinalPhase, + isNeverActive, isAlwaysActive, activeInFinalPhase, activeInInitialPhase, activateAfterInitial, activateDuringFinal, activeAfter, RuleMatchInfo(..), isConLike, isFunLike, @@ -114,12 +116,14 @@ Levity(..), mightBeLifted, mightBeUnlifted, TypeOrConstraint(..), - TyConFlavour(..), TypeOrData(..), tyConFlavourAssoc_maybe, + TyConFlavour(..), TypeOrData(..), NewOrData(..), tyConFlavourAssoc_maybe, NonStandardDefaultingStrategy(..), DefaultingStrategy(..), defaultNonStandardTyVars, - ForeignSrcLang (..) + ForeignSrcLang (..), + + ImportLevel(..), convImportLevel, convImportLevelSpec, allImportLevels ) where import GHC.Prelude @@ -134,12 +138,12 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted) import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag) import {-# SOURCE #-} Language.Haskell.Syntax.Expr (HsDoFlavour) - import Control.DeepSeq ( NFData(..) ) import Data.Data import Data.Maybe import qualified Data.Semigroup as Semi +import Language.Haskell.Syntax.ImpExp {- ************************************************************************ * * @@ -167,7 +171,12 @@ 0 -> return CLeft _ -> return CRight } +instance NFData LeftOrRight where + rnf CLeft = () + rnf CRight = () + + {- ************************************************************************ * * @@ -529,6 +538,10 @@ 1 -> return IsData _ -> panic "Binary FunctionOrData" +instance NFData FunctionOrData where + rnf IsFunction = () + rnf IsData = () + {- ************************************************************************ * * @@ -612,6 +625,11 @@ 1 -> return MarkedCbv _ -> panic "Invalid binary format" +instance NFData CbvMark where + rnf MarkedCbv = () + rnf NotMarkedCbv = () + + isMarkedCbv :: CbvMark -> Bool isMarkedCbv MarkedCbv = True isMarkedCbv NotMarkedCbv = False @@ -871,6 +889,9 @@ instance Outputable OverlapFlag where ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag) +instance NFData OverlapFlag where + rnf (OverlapFlag mode safe) = rnf mode `seq` rnf safe + instance Outputable OverlapMode where ppr (NoOverlap _) = empty ppr (Overlappable _) = text "[overlappable]" @@ -879,6 +900,14 @@ ppr (Incoherent _) = text "[incoherent]" ppr (NonCanonical _) = text "[noncanonical]" +instance NFData OverlapMode where + rnf (NoOverlap s) = rnf s + rnf (Overlappable s) = rnf s + rnf (Overlapping s) = rnf s + rnf (Overlaps s) = rnf s + rnf (Incoherent s) = rnf s + rnf (NonCanonical s) = rnf s + instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s @@ -1032,7 +1061,12 @@ 1 -> return UnboxedTuple _ -> return ConstraintTuple +instance NFData TupleSort where + rnf BoxedTuple = () + rnf UnboxedTuple = () + rnf ConstraintTuple = () + tupleSortBoxity :: TupleSort -> Boxity tupleSortBoxity BoxedTuple = Boxed tupleSortBoxity UnboxedTuple = Unboxed @@ -1755,12 +1789,7 @@ inlinePragmaSpec = inl_inline inlinePragmaSource :: InlinePragma -> SourceText -inlinePragmaSource prag = case inl_inline prag of - Inline x -> x - Inlinable y -> y - NoInline z -> z - Opaque q -> q - NoUserInlinePrag -> NoSourceText +inlinePragmaSource prag = inlineSpecSource (inl_inline prag) inlineSpecSource :: InlineSpec -> SourceText inlineSpecSource spec = case spec of @@ -1860,6 +1889,14 @@ ab <- get bh return (ActiveAfter src ab) +instance NFData Activation where + rnf = \case + AlwaysActive -> () + NeverActive -> () + ActiveBefore src aa -> rnf src `seq` rnf aa + ActiveAfter src ab -> rnf src `seq` rnf ab + FinalActive -> () + instance Outputable RuleMatchInfo where ppr ConLike = text "CONLIKE" ppr FunLike = text "FUNLIKE" @@ -1872,6 +1909,11 @@ if h == 1 then return ConLike else return FunLike +instance NFData RuleMatchInfo where + rnf = \case + ConLike -> () + FunLike -> () + instance Outputable InlineSpec where ppr (Inline src) = text "INLINE" <+> pprWithSourceText src empty ppr (NoInline src) = text "NOINLINE" <+> pprWithSourceText src empty @@ -1906,6 +1948,14 @@ s <- get bh return (Opaque s) +instance NFData InlineSpec where + rnf = \case + Inline s -> rnf s + NoInline s -> rnf s + Inlinable s -> rnf s + Opaque s -> rnf s + NoUserInlinePrag -> () + instance Outputable InlinePragma where ppr = pprInline @@ -1925,6 +1975,9 @@ d <- get bh return (InlinePragma s a b c d) +instance NFData InlinePragma where + rnf (InlinePragma s a b c d) = rnf s `seq` rnf a `seq` rnf b `seq` rnf c `seq` rnf d + -- | Outputs string for pragma name for any of INLINE/INLINABLE/NOINLINE. This -- differs from the Outputable instance for the InlineSpec type where the pragma -- name string as well as the accompanying SourceText (if any) is printed. @@ -2017,6 +2070,13 @@ 2 -> return StableSystemSrc _ -> return VanillaSrc +instance NFData UnfoldingSource where + rnf = \case + CompulsorySrc -> () + StableUserSrc -> () + StableSystemSrc -> () + VanillaSrc -> () + instance Outputable UnfoldingSource where ppr CompulsorySrc = text "Compulsory" ppr StableUserSrc = text "StableUser" @@ -2161,7 +2221,20 @@ = TypeLike | ConstraintLike deriving( Eq, Ord, Data ) +instance Binary TypeOrConstraint where + put_ bh = \case + TypeLike -> putByte bh 0 + ConstraintLike -> putByte bh 1 + get bh = getByte bh >>= \case + 0 -> pure TypeLike + 1 -> pure ConstraintLike + _ -> panic "TypeOrConstraint.get: invalid value" +instance NFData TypeOrConstraint where + rnf = \case + TypeLike -> () + ConstraintLike -> () + {- ********************************************************************* * * TyConFlavour @@ -2198,24 +2271,17 @@ = assoc ++ t_or_d ++ " family" where assoc = if isJust mb_par then "associated " else "" - t_or_d = case type_or_data of { IAmType -> "type"; IAmData -> "data" } + t_or_d = case type_or_data of + IAmType -> "type" + IAmData new_or_data -> + case new_or_data of + DataType -> "data" + NewType -> "newtype" go ClosedTypeFamilyFlavour = "type family" go TypeSynonymFlavour = "type synonym" go BuiltInTypeFlavour = "built-in type" go PromotedDataConFlavour = "promoted data constructor" -instance NFData tc => NFData (TyConFlavour tc) where - rnf ClassFlavour = () - rnf (TupleFlavour !_) = () - rnf SumFlavour = () - rnf DataTypeFlavour = () - rnf NewtypeFlavour = () - rnf AbstractTypeFlavour = () - rnf (OpenFamilyFlavour !_ mb_tc) = rnf mb_tc - rnf ClosedTypeFamilyFlavour = () - rnf TypeSynonymFlavour = () - rnf BuiltInTypeFlavour = () - rnf PromotedDataConFlavour = () -- | Get the enclosing class TyCon (if there is one) for the given TyConFlavour tyConFlavourAssoc_maybe :: TyConFlavour tc -> Maybe tc @@ -2225,14 +2291,26 @@ -- | Whether something is a type or a data declaration, -- e.g. a type family or a data family. data TypeOrData - = IAmData + = IAmData !NewOrData | IAmType deriving (Eq, Data) +-- | When we only care whether a data-type declaration is `data` or `newtype`, +-- but not what constructors it has. +data NewOrData + = NewType -- ^ @newtype Blah ...@ + | DataType -- ^ @data Blah ...@ + deriving ( Eq, Data ) -- Needed because Demand derives Eq + instance Outputable TypeOrData where - ppr IAmData = text "data" + ppr (IAmData newOrData) = ppr newOrData ppr IAmType = text "type" +instance Outputable NewOrData where + ppr = \case + NewType -> text "newtype" + DataType -> text "data" + {- ********************************************************************* * * Defaulting options @@ -2361,3 +2439,26 @@ instance Outputable DefaultingStrategy where ppr DefaultKindVars = text "DefaultKindVars" ppr (NonStandardDefaulting ns) = text "NonStandardDefaulting" <+> ppr ns + +-- | ImportLevel + +data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (Eq, Ord, Data, Show, Enum, Bounded) + +instance Outputable ImportLevel where + ppr NormalLevel = text "normal" + ppr SpliceLevel = text "splice" + ppr QuoteLevel = text "quote" + +deriving via (EnumBinary ImportLevel) instance Binary ImportLevel + +allImportLevels :: [ImportLevel] +allImportLevels = [minBound..maxBound] + +convImportLevel :: ImportDeclLevelStyle -> ImportLevel +convImportLevel (LevelStylePre level) = convImportLevelSpec level +convImportLevel (LevelStylePost level) = convImportLevelSpec level +convImportLevel NotLevelled = NormalLevel + +convImportLevelSpec :: ImportDeclLevel -> ImportLevel +convImportLevelSpec ImportDeclQuote = QuoteLevel +convImportLevelSpec ImportDeclSplice = SpliceLevel diff --git a/GHC/Types/Breakpoint.hs b/GHC/Types/Breakpoint.hs deleted file mode 100644 --- a/GHC/Types/Breakpoint.hs +++ /dev/null @@ -1,53 +0,0 @@ --- | Breakpoint related types -module GHC.Types.Breakpoint - ( BreakpointId (..) - , InternalBreakpointId (..) - , toBreakpointId - ) -where - -import GHC.Prelude -import GHC.Unit.Module - --- | Breakpoint identifier. --- --- See Note [Breakpoint identifiers] -data BreakpointId = BreakpointId - { bi_tick_mod :: !Module -- ^ Breakpoint tick module - , bi_tick_index :: !Int -- ^ Breakpoint tick index - } - --- | Internal breakpoint identifier --- --- See Note [Breakpoint identifiers] -data InternalBreakpointId = InternalBreakpointId - { ibi_tick_mod :: !Module -- ^ Breakpoint tick module - , ibi_tick_index :: !Int -- ^ Breakpoint tick index - , ibi_info_mod :: !Module -- ^ Breakpoint info module - , ibi_info_index :: !Int -- ^ Breakpoint info index - } - -toBreakpointId :: InternalBreakpointId -> BreakpointId -toBreakpointId ibi = BreakpointId - { bi_tick_mod = ibi_tick_mod ibi - , bi_tick_index = ibi_tick_index ibi - } - - --- Note [Breakpoint identifiers] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- --- Before optimization a breakpoint is identified uniquely with a tick module --- and a tick index. See BreakpointId. A tick module contains an array, indexed --- with the tick indexes, which indicates breakpoint status. --- --- When we generate ByteCode, we collect information for every breakpoint at --- their *occurrence sites* (see CgBreakInfo in GHC.ByteCode.Types) and these info --- are stored in the ModIface of the occurrence module. Because of inlining, we --- can't reuse the tick index to uniquely identify an occurrence; because of --- cross-module inlining, we can't assume that the occurrence module is the same --- as the tick module (#24712). --- --- So every breakpoint occurrence gets assigned a module-unique *info index* and --- we store it alongside the occurrence module (*info module*) in the --- InternalBreakpointId datatype. diff --git a/GHC/Types/CostCentre.hs b/GHC/Types/CostCentre.hs --- a/GHC/Types/CostCentre.hs +++ b/GHC/Types/CostCentre.hs @@ -36,6 +36,7 @@ import GHC.Types.SrcLoc import GHC.Data.FastString import GHC.Types.CostCentre.State +import Control.DeepSeq import Data.Data @@ -394,6 +395,21 @@ -- ok, because we only need the SrcSpan when declaring the -- CostCentre in the original module, it is not used by importing -- modules. + +instance NFData CostCentre where + rnf (NormalCC aa ab ac ad) = rnf aa `seq` rnf ab `seq` rnf ac `seq` rnf ad + rnf (AllCafsCC ae ad) = rnf ae `seq` rnf ad + +instance NFData CCFlavour where + rnf CafCC = () + rnf (IndexedCC flav i) = rnf flav `seq` rnf i + +instance NFData IndexedCCFlavour where + rnf ExprCC = () + rnf DeclCC = () + rnf HpcCC = () + rnf LateCC = () + rnf CallerCC = () getAllCAFsCC :: Module -> (CostCentre, CostCentreStack) getAllCAFsCC this_mod = diff --git a/GHC/Types/CostCentre/State.hs b/GHC/Types/CostCentre/State.hs --- a/GHC/Types/CostCentre/State.hs +++ b/GHC/Types/CostCentre/State.hs @@ -15,6 +15,7 @@ import Data.Data import GHC.Utils.Binary +import Control.DeepSeq -- | Per-module state for tracking cost centre indices. -- @@ -28,6 +29,9 @@ -- | An index into a given cost centre module,name,flavour set newtype CostCentreIndex = CostCentreIndex { unCostCentreIndex :: Int } deriving (Eq, Ord, Data, Binary) + +instance NFData CostCentreIndex where + rnf (CostCentreIndex i) = rnf i -- | Get a new index for a given cost centre name. getCCIndex :: FastString diff --git a/GHC/Types/DefaultEnv.hs b/GHC/Types/DefaultEnv.hs --- a/GHC/Types/DefaultEnv.hs +++ b/GHC/Types/DefaultEnv.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.DefaultEnv ( ClassDefaults (..) + , DefaultProvenance (..) , DefaultEnv , emptyDefaultEnv , isEmptyDefaultEnv @@ -12,6 +14,8 @@ , defaultList , plusDefaultEnv , mkDefaultEnv + , insertDefaultEnv + , isHaskell2010Default ) where @@ -22,6 +26,7 @@ import GHC.Types.Name (Name, nameUnique, stableNameCmp) import GHC.Types.Name.Env import GHC.Types.Unique.FM (lookupUFM_Directly) +import GHC.Types.SrcLoc (SrcSpan) import GHC.Unit.Module.Warnings (WarningTxt) import GHC.Unit.Types (Module) import GHC.Utils.Outputable @@ -37,13 +42,73 @@ -- NB: this includes Haskell98 default declarations, at the 'Num' key. type DefaultEnv = NameEnv ClassDefaults +{- Note [DefaultProvenance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Each `ClassDefault` is annotated with its `DefaultProvenance`, which +says where the default came from. Specifically +* `DP_Local loc h98`: the default came from an explicit `default` declaration in the module + being compiled, at location `loc`, and the boolean `h98` indicates whether + it was from a Haskell 98 default declaration (e.g. `default (Int, Double)`). +* `DP_Imported M`: the default was imported, it is explicitly exported by module `M`. +* `DP_Builtin`: the default was automatically provided by GHC. + see Note [Builtin class defaults] in GHC.Tc.Utils.Env + +These annotations are used to disambiguate multiple defaults for the same class. +For example, consider the following modules: + + module M( default C ) where { default C( ... ) } + module M2( default C) where { import M } + module N( default C () where { default C(... ) } + + module A where { import M2 } + module B where { import M2; import N } + module A1 where { import N; default C ( ... ) } + module B2 where { default C ( ... ); default C ( ... ) } + +When compiling N, the default for C is annotated with DP_Local loc. +When compiling M2, the default for C is annotated with DP_Local M. +When compiling A, the default for C is annotated with DP_Imported M2. + +Cases we needed to disambiguate: + * Compiling B, two defaults for C: DP_Imported M2, DP_Imported N. + * Compiling A1, two defaults for C: DP_Imported N, DP_Local loc. + * Compiling B2, two defaults for C: DP_Local loc1, DP_Local loc2. + +For how we disambiguate these cases, +See Note [Disambiguation of multiple default declarations] in GHC.Tc.Module. +-} + +-- | The provenance of a collection of default types for a class. +-- see Note [DefaultProvenance] for more details +data DefaultProvenance + -- | A locally defined default declaration. + = DP_Local + { defaultDeclLoc :: SrcSpan -- ^ The 'SrcSpan' of the default declaration + , defaultDeclH98 :: Bool -- ^ Is this a Haskell 98 default declaration? + } + -- | Built-in class defaults. + | DP_Builtin + -- | Imported class defaults. + | DP_Imported Module -- ^ The module from which the defaults were imported + deriving (Eq, Data) + +instance Outputable DefaultProvenance where + ppr (DP_Local loc h98) = ppr loc <> (if h98 then text " (H98)" else empty) + ppr DP_Builtin = text "built-in" + ppr (DP_Imported mod) = ppr mod + +isHaskell2010Default :: DefaultProvenance -> Bool +isHaskell2010Default = \case + DP_Local { defaultDeclH98 = isH98 } -> isH98 + DP_Builtin -> True + DP_Imported {} -> False + -- | Defaulting type assignments for the given class. data ClassDefaults = ClassDefaults { cd_class :: Class -- ^ The class whose defaults are being defined , cd_types :: [Type] - , cd_module :: Maybe Module - -- ^ @Nothing@ for built-in, - -- @Just@ the current module or the module whence the default was imported + , cd_provenance :: DefaultProvenance + -- ^ Where the defaults came from -- see Note [Default exports] in GHC.Tc.Gen.Export , cd_warn :: Maybe (WarningTxt GhcRn) -- ^ Warning emitted when the default is used @@ -69,6 +134,9 @@ defaultList :: DefaultEnv -> [ClassDefaults] defaultList = sortBy (stableNameCmp `on` className . cd_class) . nonDetNameEnvElts -- sortBy recovers determinism + +insertDefaultEnv :: ClassDefaults -> DefaultEnv -> DefaultEnv +insertDefaultEnv d env = extendNameEnv env (className $ cd_class d) d lookupDefaultEnv :: DefaultEnv -> Name -> Maybe ClassDefaults lookupDefaultEnv env = lookupUFM_Directly env . nameUnique diff --git a/GHC/Types/Demand.hs b/GHC/Types/Demand.hs --- a/GHC/Types/Demand.hs +++ b/GHC/Types/Demand.hs @@ -981,18 +981,10 @@ strictifyDictDmd :: Type -> Demand -> Demand strictifyDictDmd ty (n :* Prod b ds) | not (isAbs n) - , Just field_tys <- as_non_newtype_dict ty - = C_1N :* mkProd b (zipWith strictifyDictDmd field_tys ds) + , isTerminatingType ty + , Just (_tc, _arg_tys, _data_con, field_tys) <- splitDataProductType_maybe ty + = C_1N :* mkProd b (zipWith strictifyDictDmd (map scaledThing field_tys) ds) -- main idea: ensure it's strict - where - -- Return a TyCon and a list of field types if the given - -- type is a non-newtype dictionary type - as_non_newtype_dict ty - | isTerminatingType ty - , Just (_tc, _arg_tys, _data_con, field_tys) <- splitDataProductType_maybe ty - = Just (map scaledThing field_tys) - | otherwise - = Nothing strictifyDictDmd _ dmd = dmd -- | Make a 'Demand' lazy. @@ -1389,33 +1381,16 @@ * it returns the demands on the arguments; in the above example that is [SL, A] -Nasty wrinkle. Consider this code (#22475 has more realistic examples but -assume this is what the demand analyser sees) - - data T = MkT !Int Bool - get :: T -> Bool - get (MkT _ b) = b - - foo = let v::Int = I# 7 - t::T = MkT v True - in get t - -Now `v` is unused by `get`, /but/ we can't give `v` an Absent demand, -else we'll drop the binding and replace it with an error thunk. -Then the code generator (more specifically GHC.Stg.InferTags.Rewrite) -will add an extra eval of MkT's argument to give - foo = let v::Int = error "absent" - t::T = case v of v' -> MkT v' True - in get t - -Boo! Because of this extra eval (added in STG-land), the truth is that `MkT` -may (or may not) evaluate its arguments (as established in #21497). Hence the -use of `bump` in dmdTransformDataConSig, which adds in a `C_01` eval. The -`C_01` says "may or may not evaluate" which is absolutely faithful to what -InferTags.Rewrite does. +When the data constructor worker has strict fields, an additional seq +will be inserted for each field (see (SFC3) in Note [Strict fields in Core]). +Hence we add an additional `seqDmd` for each strict field to emulate +field eval insertion. -In particular it is very important /not/ to make that a `C_11` eval, -see Note [Data-con worker strictness]. +For example, consider `data SP a b = MkSP !a !b` and expression `MkSP x y`, +with the same sub-demand P(SL,A). +The strict fields bump up the strictness; we'd get [SL,1!A] for the field +demands. Note that the first demand was unaffected by the seq, whereas +the second, previously absent demand became `seqDmd` exactly. -} {- ********************************************************************* @@ -1615,6 +1590,29 @@ expression may not throw a precise exception (increasing precision of the analysis), but that's just a favourable guess. +Note [Side-effects and strictness] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Due to historic reasons and the continued effort not to cause performance +regressions downstream, Strictness Analysis is currently prone to discarding +observable side-effects (other than precise exceptions, see +Note [Precise exceptions and strictness analysis]) in some cases. For example, + f :: MVar () -> Int -> IO Int + f mv x = putMVar mv () >> (x `seq` return x) +The call to `putMVar` is an observable side-effect. Yet, Strictness Analysis +currently concludes that `f` is strict in `x` and uses call-by-value. +That means `f mv (error "boom")` will error out with the imprecise exception +rather performing the side-effect. + +This is a conscious violation of the semantics described in the paper +"a semantics for imprecise exceptions"; so it would be great if we could +identify the offending primops and extend the idea in +Note [Which scrutinees may throw precise exceptions] to general side-effects. + +Unfortunately, the existing has-side-effects classification for primops is +too conservative, listing `writeMutVar#` and even `readMutVar#` as +side-effecting. That is due to #3207. A possible way forward is described in +#17900, but no effort has been so far towards a resolution. + Note [Exceptions and strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We used to smart about catching exceptions, but we aren't anymore. @@ -1792,8 +1790,7 @@ -- | 'DmdEnv' is a monoid via 'plusDmdEnv' and 'nopDmdEnv'; this is its 'msum' plusDmdEnvs :: [DmdEnv] -> DmdEnv -plusDmdEnvs [] = nopDmdEnv -plusDmdEnvs pdas = foldl1' plusDmdEnv pdas +plusDmdEnvs = foldl1WithDefault' nopDmdEnv plusDmdEnv multDmdEnv :: Card -> DmdEnv -> DmdEnv multDmdEnv C_11 env = env @@ -1836,7 +1833,7 @@ n = max (dmdTypeDepth d1) (dmdTypeDepth d2) (DmdType fv1 ds1) = etaExpandDmdType n d1 (DmdType fv2 ds2) = etaExpandDmdType n d2 - lub_ds = zipWithEqual "lubDmdType" lubDmd ds1 ds2 + lub_ds = zipWithEqual lubDmd ds1 ds2 lub_fv = lubDmdEnv fv1 fv2 discardArgDmds :: DmdType -> DmdEnv @@ -2397,26 +2394,30 @@ mk_body_ty n dmds = DmdType nopDmdEnv (zipWith (bump n) str_marks dmds) bump n str dmd | isMarkedStrict str = multDmd n (plusDmd str_field_dmd dmd) | otherwise = multDmd n dmd - str_field_dmd = C_01 :* seqSubDmd -- Why not C_11? See Note [Data-con worker strictness] + str_field_dmd = seqDmd -- See the bit about strict fields + -- in Note [Demand transformer for data constructors] -- | A special 'DmdTransformer' for dictionary selectors that feeds the demand -- on the result into the indicated dictionary component (if saturated). -- See Note [Demand transformer for a dictionary selector]. dmdTransformDictSelSig :: DmdSig -> DmdTransformer --- NB: This currently doesn't handle newtype dictionaries. --- It should simply apply call_sd directly to the dictionary, I suppose. -dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod])) call_sd + + +dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* dict_dmd])) call_sd + -- NB: dict_dmd comes from the demand signature of the class-op + -- which is created in GHC.Types.Id.Make.mkDictSelId | (n, sd') <- peelCallDmd call_sd - , Prod _ sig_ds <- prod + , Prod _ sig_ds <- dict_dmd = multDmdType n $ DmdType nopDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)] | otherwise = nopDmdType -- See Note [Demand transformer for a dictionary selector] where - enhance _ AbsDmd = AbsDmd - enhance _ BotDmd = BotDmd - enhance sd _dmd_var = C_11 :* sd -- This is the one! - -- C_11, because we multiply with n above + enhance _ AbsDmd = AbsDmd + enhance _ BotDmd = BotDmd + enhance sd' _dmd_var = C_11 :* sd' -- This is the one! + -- C_11, because we multiply with n above + dmdTransformDictSelSig sig sd = pprPanic "dmdTransformDictSelSig: no args" (ppr sig $$ ppr sd) {- @@ -2459,21 +2460,8 @@ the whole signature really means `\d. P(AAAdAAAAA)` for any incoming demand 'd'. -For single-method classes, which are represented by newtypes the signature -of 'op' won't look like P(...), so matching on Prod will fail. -That's fine: if we are doing strictness analysis we are also doing inlining, -so we'll have inlined 'op' into a cast. So we can bale out in a conservative -way, returning nopDmdType. SG: Although we then probably want to apply the eval -demand 'd' directly to 'op' rather than turning it into 'topSubDmd'... - -It is (just.. #8329) possible to be running strictness analysis *without* -having inlined class ops from single-method classes. Suppose you are using -ghc --make; and the first module has a local -O0 flag. So you may load a class -without interface pragmas, ie (currently) without an unfolding for the class -ops. Now if a subsequent module in the --make sweep has a local -O flag -you might do strictness analysis, but there is no inlining for the class op. -This is weird, so I'm not worried about whether this optimises brilliantly; but -it should not fall over. +NB: even unary classes behave as if there was a data constructor, and so do +not need special handling here. See Note [Unary class magic] in GHC.Core.TyCon. -} zapDmdEnv :: DmdEnv -> DmdEnv diff --git a/GHC/Types/Error.hs b/GHC/Types/Error.hs --- a/GHC/Types/Error.hs +++ b/GHC/Types/Error.hs @@ -30,13 +30,13 @@ , Severity (..) , Diagnostic (..) , UnknownDiagnostic (..) + , UnknownDiagnosticFor , mkSimpleUnknownDiagnostic , mkUnknownDiagnostic , embedUnknownDiagnostic , DiagnosticMessage (..) , DiagnosticReason (WarningWithFlag, ..) , ResolvedDiagnosticReason(..) - , DiagnosticHint (..) , mkPlainDiagnostic , mkPlainError , mkDecoratedDiagnostic @@ -171,7 +171,7 @@ pprDiagnostic (errMsgDiagnostic envelope) ] -instance Diagnostic e => ToJson (Messages e) where +instance (Diagnostic e) => ToJson (Messages e) where json msgs = JSArray . toList $ json <$> getMessages msgs {- Note [Discarding Messages] @@ -251,11 +251,16 @@ -- A 'Diagnostic' carries the /actual/ description of the message (which, in -- GHC's case, it can be an error or a warning) and the /reason/ why such -- message was generated in the first place. -class (HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where +class (Outputable (DiagnosticHint a), HasDefaultDiagnosticOpts (DiagnosticOpts a)) => Diagnostic a where -- | Type of configuration options for the diagnostic. type DiagnosticOpts a + -- | Type of hint this diagnostic can provide. + -- By default, this is 'GhcHint'. + type DiagnosticHint a + type DiagnosticHint a = GhcHint + -- | Extract the error message text from a 'Diagnostic'. diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc @@ -265,7 +270,7 @@ -- | Extract any hints a user might use to repair their -- code to avoid this diagnostic. - diagnosticHints :: a -> [GhcHint] + diagnosticHints :: a -> [DiagnosticHint a] -- | Get the 'DiagnosticCode' associated with this 'Diagnostic'. -- This can return 'Nothing' for at least two reasons: @@ -282,37 +287,45 @@ diagnosticCode :: a -> Maybe DiagnosticCode -- | An existential wrapper around an unknown diagnostic. -data UnknownDiagnostic opts where +data UnknownDiagnostic opts hint where UnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -- Inject the options of the outer context -- into the options for the wrapped diagnostic. + -> (DiagnosticHint a -> hint) -> a - -> UnknownDiagnostic opts + -> UnknownDiagnostic opts hint -instance HasDefaultDiagnosticOpts opts => Diagnostic (UnknownDiagnostic opts) where - type DiagnosticOpts (UnknownDiagnostic opts) = opts - diagnosticMessage opts (UnknownDiagnostic f diag) = diagnosticMessage (f opts) diag - diagnosticReason (UnknownDiagnostic _ diag) = diagnosticReason diag - diagnosticHints (UnknownDiagnostic _ diag) = diagnosticHints diag - diagnosticCode (UnknownDiagnostic _ diag) = diagnosticCode diag +type UnknownDiagnosticFor a = UnknownDiagnostic (DiagnosticOpts a) (DiagnosticHint a) +instance (HasDefaultDiagnosticOpts opts, Outputable hint) => Diagnostic (UnknownDiagnostic opts hint) where + type DiagnosticOpts (UnknownDiagnostic opts _) = opts + type DiagnosticHint (UnknownDiagnostic _ hint) = hint + diagnosticMessage opts (UnknownDiagnostic f _ diag) = diagnosticMessage (f opts) diag + diagnosticReason (UnknownDiagnostic _ _ diag) = diagnosticReason diag + diagnosticHints (UnknownDiagnostic _ f diag) = map f (diagnosticHints diag) + diagnosticCode (UnknownDiagnostic _ _ diag) = diagnosticCode diag + -- A fallback 'DiagnosticOpts' which can be used when there are no options -- for a particular diagnostic. data NoDiagnosticOpts = NoDiagnosticOpts instance HasDefaultDiagnosticOpts NoDiagnosticOpts where defaultOpts = NoDiagnosticOpts --- | Make a "simple" unknown diagnostic which doesn't have any configuration options. -mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) => a -> UnknownDiagnostic b -mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts) +-- | Make a "simple" unknown diagnostic which doesn't have any configuration options +-- and the same hint. +mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) => + a -> UnknownDiagnostic b (DiagnosticHint a) +mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts) id --- | Make an unknown diagnostic which uses the same options as the context it will be embedded into. -mkUnknownDiagnostic :: (Typeable a, Diagnostic a) => a -> UnknownDiagnostic (DiagnosticOpts a) -mkUnknownDiagnostic = UnknownDiagnostic id +-- | Make an unknown diagnostic which uses the same options and hint +-- as the context it will be embedded into. +mkUnknownDiagnostic :: (Typeable a, Diagnostic a) => + a -> UnknownDiagnosticFor a +mkUnknownDiagnostic = UnknownDiagnostic id id -- | Embed a more complicated diagnostic which requires a potentially different options type. -embedUnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts -embedUnknownDiagnostic = UnknownDiagnostic +embedUnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts (DiagnosticHint a) +embedUnknownDiagnostic f = UnknownDiagnostic f id -------------------------------------------------------------------------------- @@ -321,12 +334,7 @@ , nest 2 (vcat (unDecorated (diagnosticMessage opts e))) ] where opts = defaultDiagnosticOpts @e --- | A generic 'Hint' message, to be used with 'DiagnosticMessage'. -data DiagnosticHint = DiagnosticHint !SDoc -instance Outputable DiagnosticHint where - ppr (DiagnosticHint msg) = msg - -- | A generic 'Diagnostic' message, without any further classification or -- provenance: By looking at a 'DiagnosticMessage' we don't know neither -- /where/ it was generated nor how to interpret its payload (as it's just a @@ -594,8 +602,14 @@ where diag = errMsgDiagnostic m opts = defaultDiagnosticOpts @e - style = mkErrStyle (errMsgContext m) - ctx = defaultSDocContext {sdocStyle = style } + ctx = defaultSDocContext { + sdocStyle = mkErrStyle (errMsgContext m) + , sdocCanUseUnicode = True + -- Using Unicode makes it easier to consume the JSON output, + -- e.g. a suggestion to use foldl' will be displayed as + -- \u2018foldl'\u2019, which is not easily confused with + -- the quoted ‘foldl’ (note: no tick). + } diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag)) renderToJSString :: SDoc -> JsonDoc renderToJSString = JSString . (renderWithContext ctx) diff --git a/GHC/Types/Error/Codes.hs b/GHC/Types/Error/Codes.hs --- a/GHC/Types/Error/Codes.hs +++ b/GHC/Types/Error/Codes.hs @@ -16,23 +16,33 @@ -- A diagnostic code is a numeric unique identifier for a diagnostic. -- See Note [Diagnostic codes]. module GHC.Types.Error.Codes - ( GhcDiagnosticCode, constructorCode, constructorCodes ) + ( -- * General diagnostic code infrastructure + DiagnosticCodeNameSpace(NameSpaceTag, DiagnosticCodeFor, ConRecursIntoFor) + , Outdated + , constructorCode, constructorCodes + -- * GHC diagnostic codes + , GHC, GhcDiagnosticCode, ConRecursInto + ) where import GHC.Prelude -import GHC.Types.Error ( DiagnosticCode(..), UnknownDiagnostic (..), diagnosticCode, NoDiagnosticOpts ) -import GHC.Hs.Extension ( GhcRn ) +import GHC.Core.InstEnv ( LookupInstanceErrReason ) +import GHC.Hs.Extension ( GhcRn ) +import GHC.Types.Error ( DiagnosticCode(..), UnknownDiagnostic (..) + , diagnosticCode, UnknownDiagnosticFor ) -import GHC.Core.InstEnv (LookupInstanceErrReason) import GHC.Iface.Errors.Types -import GHC.Driver.Errors.Types ( DriverMessage, GhcMessageOpts, DriverMessageOpts ) +import GHC.Driver.Errors.Types ( DriverMessage ) import GHC.Parser.Errors.Types ( PsMessage, PsHeaderMessage ) -import GHC.HsToCore.Errors.Types ( DsMessage ) +import GHC.HsToCore.Errors.Types ( DsMessage, UselessSpecialisePragmaReason ) import GHC.Tc.Errors.Types import GHC.Unit.Module.Warnings ( WarningTxt ) import GHC.Utils.Panic.Plain +-- Import all the structured error data types +import GHC.Driver.Errors.Types ( GhcMessage ) + import Data.Kind ( Type, Constraint ) import GHC.Exts ( proxy# ) import GHC.Generics @@ -57,8 +67,12 @@ - a diagnostic code never gets deleted from the GhcDiagnosticCode type family in GHC.Types.Error.Codes, even if it is no longer used. Older versions of GHC might still display the code, and we don't want that - old code to get confused with the error code of a different, new, error message. + old code to get confused with the error code of a different, new, error message.* +Note that this module also provides a 'DiagnosticCodeNameSpace' typeclass which +allows diagnostic codes to be emitted in different namespaces than the GHC +namespace; see Note [Diagnostic code namespaces]. + [Instructions for adding a new diagnostic code] After adding a constructor to a diagnostic datatype, such as PsMessage, @@ -99,33 +113,94 @@ Never remove a return value from the 'GhcDiagnosticCode' type family! Outdated error messages must still be tracked to ensure uniqueness - of diagnostic codes across GHC versions. + of diagnostic codes across GHC versions. Instead, you should wrap the + return value in the 'Outdated' type synonym. The presence of this type synonym + is used by the 'codes' test to determine which diagnostic codes to check + for testsuite coverage. -} {- ********************************************************************* * * - The GhcDiagnosticCode type family + DiagnosticCode infrastructure * * ********************************************************************* -} --- | This function obtain a diagnostic code by looking up the constructor --- name using generics, and using the 'GhcDiagnosticCode' type family. -constructorCode :: (Generic diag, GDiagnosticCode (Rep diag)) +{- Note [Diagnostic code namespaces] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The machinery for GHC diagnostic codes described in Note [Diagnostic codes] +works for other namespaces than the GHC namespaces; one example is GHCi-specific +diagnostic codes. + +To achieve this, we parametrise all the machinery over a namespace type-level +argument, using the 'DiagnosticCodeNameSpace' class. +To provide diagnostic codes, one needs to supply an instance of this class, +which means supplying the following pieces of information: + + - a type that represents the namespace, e.g. `data GHC` can be used to + represent the GHC namespace, + - a type family equation for 'NameSpaceTag', e.g. 'NameSpaceTag GHC = "GHC"', + - a diagnostic code type family, e.g. 'DiagnosticCodeFor GHC con = GhcDiagnosticCode con', + - a type family that specifies how to recur into constructor arguments, + e.g. 'ConRecursIntoFor GHC con = ConRecursInto con'. + +This allows any tool that imports the GHC library to re-use the diagnostic +code machinery that GHC uses. +-} + +-- | A constraint for a namespace which has its own diagnostic codes. +-- +-- See Note [Diagnostic code namespaces]. +type DiagnosticCodeNameSpace :: Type -> Constraint +class DiagnosticCodeNameSpace namespace where + -- | The symbolic tag for a namespace. + type NameSpaceTag namespace = (r :: Symbol) | r -> namespace + -- NB: the injectivity annotation ensures uniqueness of namespaces, + -- e.g. it prevents two different namespaces from using the same symbolic tag. + -- | A diagnostic code in a given namespace. + type DiagnosticCodeFor namespace (c :: Symbol) :: Nat + -- | Specify that one should recur into an argument of a constructor + -- in order to obtain a diagnostic code. See Note [Diagnostic codes]. + type ConRecursIntoFor namespace (c :: Symbol) :: Maybe Type + +-- | Use this type synonym to mark a diagnostic code as outdated. +-- +-- The presence of this type synonym is used by the 'codes' test to determine +-- which diagnostic codes to check for testsuite coverage. +type Outdated a = a + +-- | This function obtains a diagnostic code by looking up the constructor +-- name using generics, and using the 'DiagnosticCode' type family. +constructorCode :: forall namespace diag + . (Generic diag, GDiagnosticCode namespace (Rep diag)) => diag -> Maybe DiagnosticCode -constructorCode diag = gdiagnosticCode (from diag) +constructorCode diag = gdiagnosticCode @namespace (from diag) -- | This function computes all diagnostic codes that occur inside a given --- type using generics and the 'GhcDiagnosticCode' type family. +-- type using generics and the 'DiagnosticCode' type family. -- -- For example, if @T = MkT1 | MkT2@, @GhcDiagnosticCode \"MkT1\" = 123@ and -- @GhcDiagnosticCode \"MkT2\" = 456@, then we will get --- > constructorCodes @T = fromList [ (123, \"MkT1\"), (456, \"MkT2\") ] -constructorCodes :: forall diag. (Generic diag, GDiagnosticCodes '[diag] (Rep diag)) +-- > constructorCodes @GHC @T = fromList [ (DiagnosticCode "GHC" 123, \"MkT1\"), (DiagnosticCode "GHC" 456, \"MkT2\") ] +constructorCodes :: forall namespace diag + . (Generic diag, GDiagnosticCodes namespace '[diag] (Rep diag)) => Map DiagnosticCode String -constructorCodes = gdiagnosticCodes @'[diag] @(Rep diag) +constructorCodes = gdiagnosticCodes @namespace @'[diag] @(Rep diag) -- See Note [diagnosticCodes: don't recur into already-seen types] -- for the @'[diag] type argument. +{- ********************************************************************* +* * + The GhcDiagnosticCode type family +* * +********************************************************************* -} + +-- | The GHC namespace for diagnostic codes. +data GHC +instance DiagnosticCodeNameSpace GHC where + type instance NameSpaceTag GHC = "GHC" + type instance DiagnosticCodeFor GHC con = GhcDiagnosticCode con + type instance ConRecursIntoFor GHC con = ConRecursInto con + -- | Type family computing the numeric diagnostic code for a given error message constructor. -- -- Its injectivity annotation ensures uniqueness of error codes. @@ -147,9 +222,6 @@ GhcDiagnosticCode "DsMaxPmCheckModelsReached" = 61505 GhcDiagnosticCode "DsNonExhaustivePatterns" = 62161 GhcDiagnosticCode "DsTopLevelBindsNotAllowed" = 48099 - GhcDiagnosticCode "DsUselessSpecialiseForClassMethodSelector" = 93315 - GhcDiagnosticCode "DsUselessSpecialiseForNoInlineFunction" = 38524 - GhcDiagnosticCode "DsMultiplicityCoercionsNotSupported" = 59840 GhcDiagnosticCode "DsOrphanRule" = 58181 GhcDiagnosticCode "DsRuleLhsTooComplicated" = 69441 GhcDiagnosticCode "DsRuleIgnoredDueToConstructor" = 00828 @@ -166,6 +238,10 @@ GhcDiagnosticCode "DsAnotherRuleMightFireFirst" = 87502 GhcDiagnosticCode "DsIncompleteRecordSelector" = 17335 + -- Constructors of 'UselessSpecialisePragmaReason' + GhcDiagnosticCode "UselessSpecialiseForClassMethodSelector" = 93315 + GhcDiagnosticCode "UselessSpecialiseForNoInlineFunction" = 38524 + GhcDiagnosticCode "UselessSpecialiseNoSpecialisation" = 66582 -- Parser diagnostic codes GhcDiagnosticCode "PsErrParseLanguagePragma" = 68686 @@ -219,6 +295,7 @@ GhcDiagnosticCode "PsErrUnallowedPragma" = 85314 GhcDiagnosticCode "PsErrImportPostQualified" = 87491 GhcDiagnosticCode "PsErrImportQualifiedTwice" = 05661 + GhcDiagnosticCode "PsErrSpliceOrQuoteTwice" = 26105 GhcDiagnosticCode "PsErrIllegalImportBundleForm" = 81284 GhcDiagnosticCode "PsErrInvalidRuleActivationMarker" = 50396 GhcDiagnosticCode "PsErrMissingBlock" = 16849 @@ -291,6 +368,9 @@ GhcDiagnosticCode "PsErrInvalidPun" = 52943 GhcDiagnosticCode "PsErrIllegalOrPat" = 29847 GhcDiagnosticCode "PsErrTypeSyntaxInPat" = 32181 + GhcDiagnosticCode "PsErrSpecExprMultipleTypeAscription" = 62037 + GhcDiagnosticCode "PsWarnSpecMultipleTypeAscription" = 73026 + GhcDiagnosticCode "PsWarnPatternNamespaceSpecifier" = 68383 -- Driver diagnostic codes GhcDiagnosticCode "DriverMissingHomeModules" = 32850 @@ -332,17 +412,15 @@ GhcDiagnosticCode "UnsatisfiableError" = 22250 GhcDiagnosticCode "ReportHoleError" = 88464 GhcDiagnosticCode "FixedRuntimeRepError" = 55287 - GhcDiagnosticCode "BlockedEquality" = 06200 GhcDiagnosticCode "ExpectingMoreArguments" = 81325 GhcDiagnosticCode "UnboundImplicitParams" = 91416 GhcDiagnosticCode "AmbiguityPreventsSolvingCt" = 78125 GhcDiagnosticCode "CannotResolveInstance" = 39999 GhcDiagnosticCode "OverlappingInstances" = 43085 GhcDiagnosticCode "UnsafeOverlap" = 36705 - + GhcDiagnosticCode "MultiplicityCoercionsNotSupported" = 59840 -- Type mismatch errors GhcDiagnosticCode "BasicMismatch" = 18872 - GhcDiagnosticCode "KindMismatch" = 89223 GhcDiagnosticCode "TypeEqMismatch" = 83865 GhcDiagnosticCode "CouldNotDeduce" = 05617 @@ -379,6 +457,7 @@ GhcDiagnosticCode "TcRnIllegalWildcardInType" = 65507 GhcDiagnosticCode "TcRnIllegalNamedWildcardInTypeArgument" = 93411 GhcDiagnosticCode "TcRnIllegalImplicitTyVarInTypeArgument" = 80557 + GhcDiagnosticCode "TcRnIllegalPunnedVarOccInTypeArgument" = 09591 GhcDiagnosticCode "TcRnDuplicateFieldName" = 85524 GhcDiagnosticCode "TcRnIllegalViewPattern" = 22406 GhcDiagnosticCode "TcRnCharLiteralOutOfRange" = 17268 @@ -429,6 +508,7 @@ GhcDiagnosticCode "TcRnExportHiddenComponents" = 94558 GhcDiagnosticCode "TcRnExportHiddenDefault" = 74775 GhcDiagnosticCode "TcRnDuplicateExport" = 47854 + GhcDiagnosticCode "TcRnDuplicateNamedDefaultExport" = 31584 GhcDiagnosticCode "TcRnExportedParentChildMismatch" = 88993 GhcDiagnosticCode "TcRnConflictingExports" = 69158 GhcDiagnosticCode "TcRnDuplicateFieldExport" = 97219 @@ -488,7 +568,7 @@ GhcDiagnosticCode "TcRnMatchesHaveDiffNumArgs" = 91938 GhcDiagnosticCode "TcRnCannotBindScopedTyVarInPatSig" = 46131 GhcDiagnosticCode "TcRnCannotBindTyVarsInPatBind" = 48361 - GhcDiagnosticCode "TcRnTooManyTyArgsInConPattern" = 01629 + GhcDiagnosticCode "TcRnTooManyTyArgsInConPattern" = Outdated 01629 GhcDiagnosticCode "TcRnMultipleInlinePragmas" = 96665 GhcDiagnosticCode "TcRnUnexpectedPragmas" = 88293 GhcDiagnosticCode "TcRnNonOverloadedSpecialisePragma" = 35827 @@ -526,11 +606,13 @@ GhcDiagnosticCode "TcRnMisplacedSigDecl" = 87866 GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700 GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346 + GhcDiagnosticCode "TcRnSpecSigShape" = 93944 GhcDiagnosticCode "TcRnLoopySuperclassSolve" = Outdated 36038 GhcDiagnosticCode "TcRnUnexpectedStandaloneDerivingDecl" = 95159 GhcDiagnosticCode "TcRnUnusedVariableInRuleDecl" = 65669 GhcDiagnosticCode "TcRnUnexpectedStandaloneKindSig" = 45906 GhcDiagnosticCode "TcRnIllegalRuleLhs" = 63294 + GhcDiagnosticCode "TcRnRuleLhsEqualities" = 53522 GhcDiagnosticCode "TcRnDuplicateRoleAnnot" = 97170 GhcDiagnosticCode "TcRnDuplicateKindSig" = 43371 GhcDiagnosticCode "TcRnIllegalDerivStrategy" = 87139 @@ -540,9 +622,9 @@ GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412 GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333 GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254 - GhcDiagnosticCode "TcRnBadlyStaged" = 28914 - GhcDiagnosticCode "TcRnBadlyStagedType" = 86357 - GhcDiagnosticCode "TcRnStageRestriction" = 18157 + GhcDiagnosticCode "TcRnBadlyLevelled" = 28914 + GhcDiagnosticCode "TcRnBadlyLevelledType" = 86357 + GhcDiagnosticCode "TcRnStageRestriction" = Outdated 18157 GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969 GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924 GhcDiagnosticCode "TcRnUninferrableTyVar" = 16220 @@ -605,24 +687,23 @@ GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 GhcDiagnosticCode "TcRnBadTyConTelescope" = 87279 GhcDiagnosticCode "TcRnPatersonCondFailure" = 22979 - GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = 69797 + GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = Outdated 69797 GhcDiagnosticCode "TcRnInvalidDefaultedTyVar" = 45625 GhcDiagnosticCode "TcRnIllegalTermLevelUse" = 01928 GhcDiagnosticCode "TcRnNamespacedWarningPragmaWithoutFlag" = 14995 - GhcDiagnosticCode "TcRnInvisPatWithNoForAll" = 14964 - GhcDiagnosticCode "TcRnIllegalInvisibleTypePattern" = 78249 GhcDiagnosticCode "TcRnNamespacedFixitySigWithoutFlag" = 78534 GhcDiagnosticCode "TcRnOutOfArityTyVar" = 84925 - GhcDiagnosticCode "TcRnMisplacedInvisPat" = 11983 GhcDiagnosticCode "TcRnIllformedTypePattern" = 88754 GhcDiagnosticCode "TcRnIllegalTypePattern" = 70206 GhcDiagnosticCode "TcRnIllformedTypeArgument" = 29092 GhcDiagnosticCode "TcRnIllegalTypeExpr" = 35499 GhcDiagnosticCode "TcRnUnexpectedTypeSyntaxInTerms" = 31244 + GhcDiagnosticCode "TcRnTypeApplicationsDisabled" = 23482 - -- TcRnTypeApplicationsDisabled - GhcDiagnosticCode "TypeApplication" = 23482 - GhcDiagnosticCode "TypeApplicationInPattern" = 17916 + -- TcRnIllegalInvisibleTypePattern + GhcDiagnosticCode "InvisPatWithoutFlag" = 78249 + GhcDiagnosticCode "InvisPatNoForall" = 14964 + GhcDiagnosticCode "InvisPatMisplaced" = 11983 -- PatSynInvalidRhsReason GhcDiagnosticCode "PatSynNotInvertible" = 69317 @@ -631,7 +712,7 @@ -- TcRnBadFieldAnnotation/BadFieldAnnotationReason GhcDiagnosticCode "LazyFieldsDisabled" = 81601 GhcDiagnosticCode "UnpackWithoutStrictness" = 10107 - GhcDiagnosticCode "BackpackUnpackAbstractType" = 40091 + GhcDiagnosticCode "UnusableUnpackPragma" = 40091 -- TcRnRoleValidationFailed/RoleInferenceFailedReason GhcDiagnosticCode "TyVarRoleMismatch" = 22221 @@ -676,6 +757,8 @@ GhcDiagnosticCode "BadImportNotExported" = 61689 GhcDiagnosticCode "BadImportAvailDataCon" = 35373 GhcDiagnosticCode "BadImportNotExportedSubordinates" = 10237 + GhcDiagnosticCode "BadImportNonTypeSubordinates" = 51433 + GhcDiagnosticCode "BadImportNonDataSubordinates" = 46557 GhcDiagnosticCode "BadImportAvailTyCon" = 56449 GhcDiagnosticCode "BadImportAvailVar" = 12112 @@ -706,6 +789,8 @@ GhcDiagnosticCode "InvalidImplicitParamBinding" = 51603 GhcDiagnosticCode "DefaultDataInstDecl" = 39639 GhcDiagnosticCode "FunBindLacksEquations" = 52078 + GhcDiagnosticCode "EmptyGuard" = 45149 + GhcDiagnosticCode "EmptyParStmt" = 95595 -- TcRnDodgyImports/DodgyImportsReason GhcDiagnosticCode "DodgyImportsEmptyParent" = 99623 @@ -728,7 +813,7 @@ -- IllegalInstanceHead GhcDiagnosticCode "InstHeadAbstractClass" = 51758 - GhcDiagnosticCode "InstHeadNonClass" = 53946 + GhcDiagnosticCode "InstHeadNonClassHead" = 53946 GhcDiagnosticCode "InstHeadTySynArgs" = 93557 GhcDiagnosticCode "InstHeadNonTyVarArgs" = 48406 GhcDiagnosticCode "InstHeadMultiParam" = 91901 @@ -883,7 +968,7 @@ GhcDiagnosticCode "NestedTHBrackets" = 59185 GhcDiagnosticCode "AddTopDeclsUnexpectedDeclarationSplice" = 17599 GhcDiagnosticCode "BadImplicitSplice" = 25277 - GhcDiagnosticCode "QuotedNameWrongStage" = 57695 + GhcDiagnosticCode "QuotedNameWrongStage" = Outdated 57695 GhcDiagnosticCode "IllegalStaticFormInSplice" = 12219 -- Zonker messages @@ -905,11 +990,13 @@ -- NB: never remove a return value from this type family! -- We need to ensure uniquess of diagnostic codes across GHC versions, -- and this includes outdated diagnostic codes for errors that GHC - -- no longer reports. These are collected below. + -- no longer reports. These are mostly collected below, but for ease + -- of rebasing it is often better to simply declare a constructor outdated + -- without moving it down here. GhcDiagnosticCode "TcRnIllegalInstanceHeadDecl" = Outdated 12222 GhcDiagnosticCode "TcRnNoClassInstHead" = Outdated 56538 - -- The above two are subsumed by InstHeadNonClass [GHC-53946] + -- The above two are subsumed by InstHeadNonClassHead [GHC-53946] GhcDiagnosticCode "TcRnNameByTemplateHaskellQuote" = Outdated 40027 GhcDiagnosticCode "TcRnIllegalBindingOfBuiltIn" = Outdated 69639 @@ -925,12 +1012,7 @@ GhcDiagnosticCode "TcRnHsigNoIface" = Outdated 93010 GhcDiagnosticCode "TcRnInterfaceLookupError" = Outdated 52243 GhcDiagnosticCode "TcRnForallIdentifier" = Outdated 64088 - --- | Use this type synonym to mark a diagnostic code as outdated. --- --- The presence of this type synonym is used by the 'codes' test to determine --- which diagnostic codes to check for testsuite coverage. -type Outdated a = a + GhcDiagnosticCode "TypeApplicationInPattern" = Outdated 17916 {- ********************************************************************* * * @@ -957,12 +1039,12 @@ ConRecursInto "GhcPsMessage" = 'Just PsMessage ConRecursInto "GhcTcRnMessage" = 'Just TcRnMessage ConRecursInto "GhcDsMessage" = 'Just DsMessage - ConRecursInto "GhcUnknownMessage" = 'Just (UnknownDiagnostic GhcMessageOpts) + ConRecursInto "GhcUnknownMessage" = 'Just (UnknownDiagnosticFor GhcMessage) ---------------------------------- -- Constructors of DriverMessage - ConRecursInto "DriverUnknownMessage" = 'Just (UnknownDiagnostic DriverMessageOpts) + ConRecursInto "DriverUnknownMessage" = 'Just (UnknownDiagnosticFor DriverMessage) ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage ConRecursInto "DriverInterfaceError" = 'Just IfaceMessage @@ -977,13 +1059,18 @@ ---------------------------------- -- Constructors of PsMessage - ConRecursInto "PsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts) + ConRecursInto "PsUnknownMessage" = 'Just (UnknownDiagnosticFor PsMessage) ConRecursInto "PsHeaderMessage" = 'Just PsHeaderMessage ---------------------------------- + -- Constructors of DsMessage + + ConRecursInto "DsUselessSpecialisePragma" = 'Just UselessSpecialisePragmaReason + + ---------------------------------- -- Constructors of TcRnMessage - ConRecursInto "TcRnUnknownMessage" = 'Just (UnknownDiagnostic TcRnMessageOpts) + ConRecursInto "TcRnUnknownMessage" = 'Just (UnknownDiagnosticFor TcRnMessage) -- Recur into TcRnMessageWithInfo to get the underlying TcRnMessage ConRecursInto "TcRnMessageWithInfo" = 'Just TcRnMessageDetailed @@ -1008,7 +1095,7 @@ ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason ConRecursInto "TcRnNonCanonicalDefinition" = 'Just NonCanonicalDefinition ConRecursInto "TcRnIllegalInstance" = 'Just IllegalInstanceReason - ConRecursInto "TcRnTypeApplicationsDisabled" = 'Just TypeApplication + ConRecursInto "TcRnIllegalInvisibleTypePattern" = 'Just BadInvisPatReason -- Illegal instance reasons ConRecursInto "IllegalClassInstance" = 'Just IllegalClassInstanceReason @@ -1078,7 +1165,7 @@ ---------------------------------- -- Constructors of DsMessage - ConRecursInto "DsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts) + ConRecursInto "DsUnknownMessage" = 'Just (UnknownDiagnosticFor DsMessage) ---------------------------------- -- Constructors of ImportLookupBad @@ -1099,7 +1186,7 @@ {- Note [Diagnostic codes using generics] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Diagnostic codes are specified at the type-level using the injective +Diagnostic codes for GHC are specified at the type-level using the injective type family 'GhcDiagnosticCode'. This ensures uniqueness of diagnostic codes, giving quick feedback (in the form of a type error). @@ -1136,7 +1223,12 @@ first, and decide whether to recur into it using the HasTypeQ type family. - The two different behaviours are controlled by two main instances (*) and (**). - - (*) recurses into a subtype, when we have a type family equation such as: + - (*) directly uses the constructor name, by using the 'DiagnosticCodeFor' + type family. The 'KnownConstructor' context (ERR2) on the instance provides + a custom error message in case of a missing diagnostic code, which points + GHC contributors to the documentation explaining how to add diagnostic codes + for their diagnostics. + - (**) recurses into a subtype, when we have a type family equation such as: ConRecursInto "TcRnCannotDeriveInstance" = 'Just DeriveInstanceErrReason @@ -1144,94 +1236,87 @@ type 'DeriveInstanceErrReason'. The overlapping instance (ERR1) provides an error message in case a constructor does not have the type specified by the 'ConRecursInto' type family. - - (**) directly uses the constructor name, by using the 'GhcDiagnosticCode' - type family. The 'KnownConstructor' context (ERR2) on the instance provides - a custom error message in case of a missing diagnostic code, which points - GHC contributors to the documentation explaining how to add diagnostic codes - for their diagnostics. -} -- | Use the generic representation of a type to retrieve the --- diagnostic code, using the 'GhcDiagnosticCode' type family. +-- diagnostic code, using 'DiagnosticCodeFor namespace' type family. -- -- See Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. -type GDiagnosticCode :: (Type -> Type) -> Constraint -class GDiagnosticCode f where +type GDiagnosticCode :: Type -> (Type -> Type) -> Constraint +class GDiagnosticCode namespace f where gdiagnosticCode :: f a -> Maybe DiagnosticCode -- | Use the generic representation of a type to retrieve the collection -- of all diagnostic codes it can give rise to. -type GDiagnosticCodes :: [Type] -> (Type -> Type) -> Constraint -class GDiagnosticCodes seen f where +type GDiagnosticCodes :: Type -> [Type] -> (Type -> Type) -> Constraint +class GDiagnosticCodes namespace seen f where gdiagnosticCodes :: Map DiagnosticCode String -type ConstructorCode :: Symbol -> (Type -> Type) -> Maybe Type -> Constraint -class ConstructorCode con f recur where +type ConstructorCode :: Type -> Symbol -> (Type -> Type) -> Maybe Type -> Constraint +class ConstructorCode namespace con f recur where gconstructorCode :: f a -> Maybe DiagnosticCode -type ConstructorCodes :: Symbol -> (Type -> Type) -> [Type] -> Maybe Type -> Constraint -class ConstructorCodes con f seen recur where +type ConstructorCodes :: Type -> Symbol -> (Type -> Type) -> [Type] -> Maybe Type -> Constraint +class ConstructorCodes namespace con f seen recur where gconstructorCodes :: Map DiagnosticCode String -instance (KnownConstructor con, KnownSymbol con) => ConstructorCode con f 'Nothing where - gconstructorCode _ = Just $ DiagnosticCode "GHC" $ natVal' @(GhcDiagnosticCode con) proxy# -instance (KnownConstructor con, KnownSymbol con) => ConstructorCodes con f seen 'Nothing where - gconstructorCodes = - Map.singleton - (DiagnosticCode "GHC" $ natVal' @(GhcDiagnosticCode con) proxy#) - (symbolVal' @con proxy#) - -- If we recur into the 'UnknownDiagnostic' existential datatype, -- unwrap the existential and obtain the error code. instance {-# OVERLAPPING #-} - ( ConRecursInto con ~ 'Just (UnknownDiagnostic opts) - , HasType (UnknownDiagnostic opts) con f ) - => ConstructorCode con f ('Just (UnknownDiagnostic opts)) where - gconstructorCode diag = case getType @(UnknownDiagnostic opts) @con @f diag of - UnknownDiagnostic _ diag -> diagnosticCode diag + ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts hint) + , HasType namespace (UnknownDiagnostic opts hint) con f ) + => ConstructorCode namespace con f ('Just (UnknownDiagnostic opts hint)) where + gconstructorCode diag = case getType @namespace @(UnknownDiagnostic opts hint) @con @f diag of + UnknownDiagnostic _ _ diag -> diagnosticCode diag instance {-# OVERLAPPING #-} - ( ConRecursInto con ~ 'Just (UnknownDiagnostic opts) ) - => ConstructorCodes con f seen ('Just (UnknownDiagnostic opts)) where + ( ConRecursIntoFor namespace con ~ 'Just (UnknownDiagnostic opts hint) ) + => ConstructorCodes namespace con f seen ('Just (UnknownDiagnostic opts hint)) where gconstructorCodes = Map.empty --- (*) Recursive instance: Recur into the given type. -instance ( ConRecursInto con ~ 'Just ty, HasType ty con f - , Generic ty, GDiagnosticCode (Rep ty) ) - => ConstructorCode con f ('Just ty) where - gconstructorCode diag = gdiagnosticCode (from $ getType @ty @con @f diag) -instance ( ConRecursInto con ~ 'Just ty, HasType ty con f - , Generic ty, GDiagnosticCodes (Insert ty seen) (Rep ty) +-- | (*) Base instance: use the diagnostic code for this constructor in this namespace. +instance (KnownNameSpace namespace, KnownConstructor namespace con, KnownSymbol con) + => ConstructorCode namespace con f 'Nothing where + gconstructorCode _ = Just $ DiagnosticCode (symbolVal' @(NameSpaceTag namespace) proxy#) $ natVal' @(DiagnosticCodeFor namespace con) proxy# +instance ( KnownNameSpace namespace, KnownConstructor namespace con, KnownSymbol con) => ConstructorCodes namespace con f seen 'Nothing where + gconstructorCodes = + Map.singleton + (DiagnosticCode (symbolVal' @(NameSpaceTag namespace) proxy#) $ natVal' @(DiagnosticCodeFor namespace con) proxy#) + (symbolVal' @con proxy#) + +-- | (**) Recursive instance: recur into the given type. +instance ( ConRecursIntoFor namespace con ~ 'Just ty, HasType namespace ty con f + , Generic ty, GDiagnosticCode namespace (Rep ty) ) + => ConstructorCode namespace con f ('Just ty) where + gconstructorCode diag = gdiagnosticCode @namespace (from $ getType @namespace @ty @con @f diag) +instance ( ConRecursIntoFor namespace con ~ 'Just ty, HasType namespace ty con f + , Generic ty, GDiagnosticCodes namespace (Insert ty seen) (Rep ty) , Seen seen ty ) - => ConstructorCodes con f seen ('Just ty) where + => ConstructorCodes namespace con f seen ('Just ty) where gconstructorCodes = -- See Note [diagnosticCodes: don't recur into already-seen types] if wasSeen @seen @ty then Map.empty - else gdiagnosticCodes @(Insert ty seen) @(Rep ty) + else gdiagnosticCodes @namespace @(Insert ty seen) @(Rep ty) --- (**) Constructor instance: handle constructors directly. --- --- Obtain the code from the 'GhcDiagnosticCode' --- type family, applied to the name of the constructor. -instance (ConstructorCode con f recur, recur ~ ConRecursInto con, KnownSymbol con) - => GDiagnosticCode (M1 i ('MetaCons con x y) f) where - gdiagnosticCode (M1 x) = gconstructorCode @con @f @recur x -instance (ConstructorCodes con f seen recur, recur ~ ConRecursInto con, KnownSymbol con) - => GDiagnosticCodes seen (M1 i ('MetaCons con x y) f) where - gdiagnosticCodes = gconstructorCodes @con @f @seen @recur +instance (ConstructorCode namespace con f recur, recur ~ ConRecursIntoFor namespace con, KnownSymbol con) + => GDiagnosticCode namespace (M1 i ('MetaCons con x y) f) where + gdiagnosticCode (M1 x) = gconstructorCode @namespace @con @f @recur x +instance (ConstructorCodes namespace con f seen recur, recur ~ ConRecursIntoFor namespace con, KnownSymbol con) + => GDiagnosticCodes namespace seen (M1 i ('MetaCons con x y) f) where + gdiagnosticCodes = gconstructorCodes @namespace @con @f @seen @recur -- Handle sum types (the diagnostic types are sums of constructors). -instance (GDiagnosticCode f, GDiagnosticCode g) => GDiagnosticCode (f :+: g) where - gdiagnosticCode (L1 x) = gdiagnosticCode @f x - gdiagnosticCode (R1 y) = gdiagnosticCode @g y -instance (GDiagnosticCodes seen f, GDiagnosticCodes seen g) => GDiagnosticCodes seen (f :+: g) where - gdiagnosticCodes = Map.union (gdiagnosticCodes @seen @f) (gdiagnosticCodes @seen @g) +instance (GDiagnosticCode namespace f, GDiagnosticCode namespace g) => GDiagnosticCode namespace (f :+: g) where + gdiagnosticCode (L1 x) = gdiagnosticCode @namespace @f x + gdiagnosticCode (R1 y) = gdiagnosticCode @namespace @g y +instance (GDiagnosticCodes namespace seen f, GDiagnosticCodes namespace seen g) => GDiagnosticCodes namespace seen (f :+: g) where + gdiagnosticCodes = Map.union (gdiagnosticCodes @namespace @seen @f) (gdiagnosticCodes @namespace @seen @g) -- Discard metadata we don't need. -instance GDiagnosticCode f - => GDiagnosticCode (M1 i ('MetaData nm mod pkg nt) f) where - gdiagnosticCode (M1 x) = gdiagnosticCode @f x -instance GDiagnosticCodes seen f - => GDiagnosticCodes seen (M1 i ('MetaData nm mod pkg nt) f) where - gdiagnosticCodes = gdiagnosticCodes @seen @f +instance GDiagnosticCode namespace f + => GDiagnosticCode namespace (M1 i ('MetaData nm mod pkg nt) f) where + gdiagnosticCode (M1 x) = gdiagnosticCode @namespace @f x +instance GDiagnosticCodes namespace seen f + => GDiagnosticCodes namespace seen (M1 i ('MetaData nm mod pkg nt) f) where + gdiagnosticCodes = gdiagnosticCodes @namespace @seen @f -- | Decide whether to pick the left or right branch -- when deciding how to recurse into a product. @@ -1258,30 +1343,30 @@ Alt ('Just a) _ = 'Just a Alt _ b = b -type HasType :: Type -> Symbol -> (Type -> Type) -> Constraint -class HasType ty orig f where +type HasType :: Type -> Type -> Symbol -> (Type -> Type) -> Constraint +class HasType namespace ty orig f where getType :: f a -> ty -instance HasType ty orig (M1 i s (K1 x ty)) where +instance HasType namespace ty orig (M1 i s (K1 x ty)) where getType (M1 (K1 x)) = x -instance HasTypeProd ty (HasTypeQ ty f) orig f g => HasType ty orig (f :*: g) where - getType = getTypeProd @ty @(HasTypeQ ty f) @orig +instance HasTypeProd namespace ty (HasTypeQ ty f) orig f g => HasType namespace ty orig (f :*: g) where + getType = getTypeProd @namespace @ty @(HasTypeQ ty f) @orig -- The lr parameter tells us whether to pick the left or right -- branch in a product, and is computed using 'HasTypeQ'. -- -- If it's @Just l@, then we have found the type in the left branch, -- so use that. Otherwise, look in the right branch. -class HasTypeProd ty lr orig f g where +class HasTypeProd namespace ty lr orig f g where getTypeProd :: (f :*: g) a -> ty -- Pick the left branch. -instance HasType ty orig f => HasTypeProd ty ('Just l) orig f g where - getTypeProd (x :*: _) = getType @ty @orig @f x +instance HasType namespace ty orig f => HasTypeProd namespace ty ('Just l) orig f g where + getTypeProd (x :*: _) = getType @namespace @ty @orig @f x -- Pick the right branch. -instance HasType ty orig g => HasTypeProd ty 'Nothing orig f g where - getTypeProd (_ :*: y) = getType @ty @orig @g y +instance HasType namespace ty orig g => HasTypeProd namespace ty 'Nothing orig f g where + getTypeProd (_ :*: y) = getType @namespace @ty @orig @g y {- Note [diagnosticCodes: don't recur into already-seen types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1305,7 +1390,7 @@ This would cause an infinite loop. We thus keep track of a list of types we have already encountered, and when we recur into a type we have already -encountered, we simply skip taking that union (see (*)). +encountered, we simply skip taking that union (see (**)). Note that 'constructorCodes' starts by marking the initial type itself as "seen", which precisely avoids the loop above when calling 'constructorCodes @TcRnMessage'. @@ -1340,27 +1425,42 @@ ':$$: 'Text "does not have any argument of type '" ':<>: 'ShowType ty ':<>: 'Text "'." ':$$: 'Text "" ':$$: 'Text "This is likely due to an incorrect type family equation:" - ':$$: 'Text " ConRecursInto \"" ':<>: 'Text orig ':<>: 'Text "\" = " ':<>: 'ShowType ty ) - => HasType ty orig f where + ':$$: 'Text " ConRecursIntoFor " ':<>: 'ShowType namespace ':<>: Text " \"" ':<>: 'Text orig ':<>: 'Text "\" = " ':<>: 'ShowType ty ) + => HasType namespace ty orig f where getType = panic "getType: unreachable" -- (ERR2) Improve error messages for missing 'GhcDiagnosticCode' equations. -type KnownConstructor :: Symbol -> Constraint -type family KnownConstructor con where - KnownConstructor con = +type KnownConstructor :: Type -> Symbol -> Constraint +type family KnownConstructor namespace con where + KnownConstructor namespace con = KnownNatOrErr ( TypeError - ( 'Text "Missing diagnostic code for constructor " + ( 'Text "Missing " ':<>: 'ShowType namespace ':<>: Text " diagnostic code for constructor " ':<>: 'Text "'" ':<>: 'Text con ':<>: 'Text "'." ':$$: 'Text "" ':$$: 'Text "Note [Diagnostic codes] in GHC.Types.Error.Codes" ':$$: 'Text "contains instructions for adding a new diagnostic code." ) ) - (GhcDiagnosticCode con) + (DiagnosticCodeFor namespace con) type KnownNatOrErr :: Constraint -> Nat -> Constraint type KnownNatOrErr err n = (Assert err n, KnownNat n) + +-- (ERR3) Improve error messages for invalid namespaces. +type KnownNameSpace :: Type -> Constraint +type family KnownNameSpace namespace where + KnownNameSpace namespace = + ValidNameSpaceOrErr + ( TypeError + ( 'Text "Please provide a 'DiagnosticCodeNameSpace' instance for " ':<>: 'ShowType namespace ':<>: Text "," + ':$$: 'Text "including an associated type family equation for 'NameSpaceTag'." + ) + ) + (NameSpaceTag namespace) + +type ValidNameSpaceOrErr :: Constraint -> Symbol -> Constraint +type ValidNameSpaceOrErr err s = (Assert err s, KnownSymbol s) -- Detecting a stuck type family using a data family. -- See https://blog.csongor.co.uk/report-stuck-families/. diff --git a/GHC/Types/ForeignCall.hs b/GHC/Types/ForeignCall.hs --- a/GHC/Types/ForeignCall.hs +++ b/GHC/Types/ForeignCall.hs @@ -30,6 +30,8 @@ import Data.Char import Data.Data +import Control.DeepSeq (NFData(..)) + {- ************************************************************************ * * @@ -156,7 +158,7 @@ | StdCallConv | PrimCallConv | JavaScriptCallConv - deriving (Eq, Data, Enum) + deriving (Show, Eq, Data, Enum) instance Outputable CCallConv where ppr StdCallConv = text "stdcall" @@ -344,3 +346,31 @@ get bh = do s <- get bh h <- get bh return (Header s h) + +instance NFData ForeignCall where + rnf (CCall c) = rnf c + +instance NFData Safety where + rnf PlaySafe = () + rnf PlayInterruptible = () + rnf PlayRisky = () + +instance NFData CCallSpec where + rnf (CCallSpec t c s) = rnf t `seq` rnf c `seq` rnf s + +instance NFData CCallTarget where + rnf (StaticTarget s a b c) = rnf s `seq` rnf a `seq` rnf b `seq` rnf c + rnf DynamicTarget = () + +instance NFData CCallConv where + rnf CCallConv = () + rnf StdCallConv = () + rnf PrimCallConv = () + rnf CApiConv = () + rnf JavaScriptCallConv = () + +instance NFData CType where + rnf (CType s mh fs) = rnf s `seq` rnf mh `seq` rnf fs + +instance NFData Header where + rnf (Header s h) = rnf s `seq` rnf h diff --git a/GHC/Types/GREInfo.hs b/GHC/Types/GREInfo.hs --- a/GHC/Types/GREInfo.hs +++ b/GHC/Types/GREInfo.hs @@ -111,7 +111,7 @@ -- -- See Note [GREInfo] data GREInfo - -- | No particular information... e.g. a function + -- | A variable (an 'Id' or a 'TyVar') = Vanilla -- | An unbound GRE... could be anything | UnboundGRE @@ -126,12 +126,6 @@ deriving Data -instance NFData GREInfo where - rnf Vanilla = () - rnf UnboundGRE = () - rnf (IAmTyCon tc) = rnf tc - rnf (IAmConLike info) = rnf info - rnf (IAmRecField info) = rnf info plusGREInfo :: GREInfo -> GREInfo -> GREInfo plusGREInfo Vanilla Vanilla = Vanilla @@ -263,7 +257,7 @@ rnf ConHasPositionalArgs = () rnf (ConHasRecordFields flds) = rnf flds -mkConInfo :: ConLikeInfo -> Arity -> [FieldLabel] -> ConInfo +mkConInfo :: ConLikeInfo -> VisArity -> [FieldLabel] -> ConInfo mkConInfo con_ty n flds = ConInfo { conLikeInfo = con_ty , conFieldInfo = mkConFieldInfo n flds } @@ -305,6 +299,9 @@ = DataConName { conLikeName_Name :: !Name } | PatSynName { conLikeName_Name :: !Name } deriving (Eq, Data) + +instance NamedThing ConLikeName where + getName = conLikeName_Name instance Outputable ConLikeName where ppr = ppr . conLikeName_Name diff --git a/GHC/Types/Hint.hs b/GHC/Types/Hint.hs --- a/GHC/Types/Hint.hs +++ b/GHC/Types/Hint.hs @@ -5,12 +5,14 @@ , AvailableBindings(..) , InstantiationSuggestion(..) , LanguageExtensionHint(..) + , ImportItemSuggestion(..) , ImportSuggestion(..) , HowInScope(..) , SimilarName(..) , StarIsType(..) , UntickedPromotedThing(..) , AssumedDerivingStrategy(..) + , SigLike(..) , pprUntickedConstructor, isBareSymbol , suggestExtension , suggestExtensionWithInfo @@ -23,7 +25,7 @@ ) where import Language.Haskell.Syntax.Expr (LHsExpr) -import Language.Haskell.Syntax (LPat, LIdP, LHsSigType, LHsSigWcType) +import Language.Haskell.Syntax (LPat, LIdP, LHsSigType, LHsSigWcType, Sig) import GHC.Prelude @@ -32,7 +34,7 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Unit.Module (ModuleName, Module) import GHC.Unit.Module.Imported (ImportedModsVal) -import GHC.Hs.Extension (GhcTc, GhcRn) +import GHC.Hs.Extension (GhcTc, GhcRn, GhcPs) import GHC.Core.Class (Class) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) @@ -382,8 +384,7 @@ Test cases: T495, T8485, T2713, T5533. -} | SuggestMoveToDeclarationSite - -- TODO: remove the SDoc argument. - SDoc -- ^ fixity declaration, role annotation, type signature, ... + SigLike -- ^ fixity declaration, role annotation, type signature, ... RdrName -- ^ the 'RdrName' for the declaration site {-| Suggest a similar name that the user might have meant, @@ -505,6 +506,14 @@ {-| Suggest add parens to pattern `e -> p :: t` -} | SuggestParenthesizePatternRHS + {-| Suggest splitting up a SPECIALISE pragmas with multiple type ascriptions + into several individual SPECIALISE pragmas. + -} + | SuggestSplittingIntoSeveralSpecialisePragmas + + {-| Suggest using the `data` keyword -} + | SuggestDataKeyword + -- | The deriving strategy that was assumed when not explicitly listed in the -- source. This is used solely by the missing-deriving-strategies warning. -- There's no `Via` case because we never assume that. @@ -532,24 +541,32 @@ -- replacing as necessary.) data InstantiationSuggestion = InstantiationSuggestion !ModuleName !Module +data ImportItemSuggestion = + ImportItemRemoveType + | ImportItemRemoveData + | ImportItemRemovePattern + | ImportItemRemoveSubordinateType (NE.NonEmpty OccName) + | ImportItemRemoveSubordinateData (NE.NonEmpty OccName) + | ImportItemAddType + -- Why no 'ImportItemAddData'? Because the suggestion to add 'data' is + -- represented by the 'ImportDataCon' constructor of 'ImportSuggestion'. + -- | Suggest how to fix an import. data ImportSuggestion -- | Some module exports what we want, but we aren't explicitly importing it. = CouldImportFrom (NE.NonEmpty (Module, ImportedModsVal)) -- | Some module exports what we want, but we are explicitly hiding it. | CouldUnhideFrom (NE.NonEmpty (Module, ImportedModsVal)) - -- | The module exports what we want, but it isn't a type. - | CouldRemoveTypeKeyword ModuleName - -- | The module exports what we want, but it's a type and we have @ExplicitNamespaces@ on. - | CouldAddTypeKeyword ModuleName + -- | The module exports what we want, but the import item requires modification. + | CouldChangeImportItem ModuleName ImportItemSuggestion -- | Suggest importing a data constructor to bring it into scope | ImportDataCon -- | Where to suggest importing the 'DataCon' from. - -- - -- The 'Bool' tracks whether to suggest using an import of the form - -- @import (pattern Foo)@, depending on whether @-XPatternSynonyms@ - -- was enabled. - { ies_suggest_import_from :: Maybe (ModuleName, Bool) + { ies_suggest_import_from :: Maybe ModuleName + -- | Whether to suggest the use of the 'pattern' keyword. + , ies_suggest_pattern_keyword :: Bool + -- | Whether to suggest the use of the 'data' keyword. + , ies_suggest_data_keyword :: Bool -- | The 'OccName' of the parent of the data constructor. , ies_parent :: OccName } @@ -563,6 +580,15 @@ data SimilarName = SimilarName Name | SimilarRdrName RdrName (Maybe HowInScope) + +-- | Some kind of signature, such as a fixity signature, standalone +-- kind signature, COMPLETE pragma, role annotation, etc. +data SigLike + = SigLikeSig (Sig GhcPs) + | SigLikeStandaloneKindSig + | SigLikeFixitySig + | SigLikeDeprecation + | SigLikeRoleAnnotation -- | Something is promoted to the type-level without a promotion tick. data UntickedPromotedThing diff --git a/GHC/Types/Hint/Ppr.hs b/GHC/Types/Hint/Ppr.hs --- a/GHC/Types/Hint/Ppr.hs +++ b/GHC/Types/Hint/Ppr.hs @@ -4,7 +4,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} {- instance Outputable GhcHint -} module GHC.Types.Hint.Ppr ( - perhapsAsPat + perhapsAsPat, pprSigLike -- also, and more interesting: instance Outputable GhcHint ) where @@ -31,6 +31,7 @@ import qualified Data.Map.Strict as Map import qualified GHC.LanguageExtensions as LangExt +import GHC.Hs.Binds (hsSigDoc) instance Outputable GhcHint where ppr = \case @@ -187,8 +188,8 @@ SuggestAddTick UntickedExplicitList -> text "Add a promotion tick, e.g." <+> text "'[x,y,z]" <> dot - SuggestMoveToDeclarationSite what rdr_name - -> text "Move the" <+> what <+> text "to the declaration site of" + SuggestMoveToDeclarationSite sig rdr_name + -> text "Move the" <+> pprSigLike sig <+> text "to the declaration site of" <+> quotes (ppr rdr_name) <> dot SuggestSimilarNames tried_rdr_name similar_names -> case similar_names of @@ -288,6 +289,10 @@ (hsep [text "deriving", ppr strat, text "instance", ppr deriv_sig]) SuggestParenthesizePatternRHS -> text "Parenthesize the RHS of the view pattern" + SuggestSplittingIntoSeveralSpecialisePragmas + -> text "Split the SPECIALISE pragma into multiple pragmas, one for each type signature" + SuggestDataKeyword + -> text "Use the" <+> quotes (text "data") <+> "keyword instead." perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" @@ -337,43 +342,66 @@ [ quotes (ppr mod) <+> parens (text "at" <+> ppr (imv_span imv)) | (mod,imv) <- NE.toList mods ]) -pprImportSuggestion occ_name (CouldAddTypeKeyword mod) - = vcat [ text "Add the" <+> quotes (text "type") - <+> text "keyword to the import statement:" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) - ] - where - parens_sp d = parens (space <> d <> space) -pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod) - = vcat [ text "Remove the" <+> quotes (text "type") - <+> text "keyword from the import statement:" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (pprPrefixOcc occ_name) ] +pprImportSuggestion occ_name (CouldChangeImportItem mod kw) + = case kw of + ImportItemRemoveType -> remove "type" + ImportItemRemoveData -> remove "data" + ImportItemRemovePattern -> remove "pattern" + ImportItemRemoveSubordinateType nontype1 -> remove_subordinate "type" (NE.toList nontype1) + ImportItemRemoveSubordinateData nondata1 -> remove_subordinate "data" (NE.toList nondata1) + ImportItemAddType -> add "type" where parens_sp d = parens (space <> d <> space) -pprImportSuggestion dc_occ (ImportDataCon Nothing parent_occ) + remove kw = + vcat [ text "Remove the" <+> quotes (text kw) + <+> text "keyword from the import statement:" + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + import_list = parens_sp (pprPrefixOcc occ_name) + add kw = + vcat [ text "Add the" <+> quotes (text kw) + <+> text "keyword to the import statement:" + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + import_list = parens_sp (text kw <+> pprPrefixOcc occ_name) + remove_subordinate kw sub_occs = + vcat [ text "Remove the" <+> quotes (text kw) + <+> text "keyword" <> plural sub_occs + <+> text "from the subordinate import item" <> plural sub_occs <> colon + , nest 2 $ text "import" <+> ppr mod <+> import_list ] + where + parent_item + | isSymOcc occ_name = text "type" <+> pprPrefixOcc occ_name + | otherwise = pprPrefixOcc occ_name + import_list = parens_sp (parent_item <+> sub_import_list) + sub_import_list = parens_sp (hsep (punctuate comma (map pprPrefixOcc sub_occs))) +pprImportSuggestion dc_occ (ImportDataCon { ies_suggest_import_from = Nothing + , ies_parent = parent_occ} ) = text "Import the data constructor" <+> quotes (ppr dc_occ) <+> text "of" <+> quotes (ppr parent_occ) -pprImportSuggestion dc_occ (ImportDataCon (Just (mod, patsyns_enabled)) parent_occ) - = vcat $ [ text "Use" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (pprPrefixOcc parent_occ <> parens_sp (pprPrefixOcc dc_occ)) - , text "or" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (pprPrefixOcc parent_occ <> text "(..)") - ] ++ if patsyns_enabled - then [ text "or" - , nest 2 $ text "import" - <+> ppr mod - <+> parens_sp (text "pattern" <+> pprPrefixOcc dc_occ) - ] - else [] +pprImportSuggestion dc_occ (ImportDataCon { ies_suggest_import_from = Just mod + , ies_suggest_pattern_keyword = suggest_pattern + , ies_suggest_data_keyword = suggest_data + , ies_parent = parent_occ }) + = vcat $ basic_suggestion + ++ (if suggest_pattern then pattern_suggestion else []) + ++ (if suggest_data then data_suggestion else []) where + basic_suggestion = + [ text "Use" + , nest 2 $ import_stmt (pprPrefixOcc parent_occ <> parens_sp (pprPrefixOcc dc_occ)) + , text "or" + , nest 2 $ import_stmt (pprPrefixOcc parent_occ <> text "(..)") + ] + pattern_suggestion = + [ text "or" + , nest 2 $ import_stmt (text "pattern" <+> pprPrefixOcc dc_occ) + ] + data_suggestion = + [ text "or" + , nest 2 $ import_stmt (text "data" <+> pprPrefixOcc dc_occ) + ] + import_stmt sub = text "import" <+> ppr mod <+> parens_sp sub parens_sp d = parens (space <> d <> space) -- | Pretty-print a 'SimilarName'. @@ -403,10 +431,21 @@ xs -> parens $ "implied by" <+> unquotedListWith "and" xs where implied = map (quotes . ppr) . filter (\ext -> extensionDeprecation ext == ExtensionNotDeprecated) - . map (\(impl, _, _) -> impl) - . filter (\(_, t, orig) -> orig == extension && t == turnOn) - $ impliedXFlags + $ [impl | (impl, On orig) <- impliedXFlags, orig == extension] pprPrefixUnqual :: Name -> SDoc pprPrefixUnqual name = pprPrefixOcc (getOccName name) + +pprSigLike :: SigLike -> SDoc +pprSigLike = \case + SigLikeSig sig -> + hsSigDoc sig + SigLikeStandaloneKindSig -> + text "standalone kind signature" + SigLikeDeprecation -> + text "deprecation" + SigLikeFixitySig -> + text "fixity signature" + SigLikeRoleAnnotation -> + text "role annotation" diff --git a/GHC/Types/HpcInfo.hs b/GHC/Types/HpcInfo.hs --- a/GHC/Types/HpcInfo.hs +++ b/GHC/Types/HpcInfo.hs @@ -1,9 +1,7 @@ -- | Haskell Program Coverage (HPC) support module GHC.Types.HpcInfo ( HpcInfo (..) - , AnyHpcUsage , emptyHpcInfo - , isHpcUsed ) where @@ -16,19 +14,8 @@ , hpcInfoHash :: Int } | NoHpcInfo - { hpcUsed :: AnyHpcUsage -- ^ Is hpc used anywhere on the module \*tree\*? - } --- | This is used to signal if one of my imports used HPC instrumentation --- even if there is no module-local HPC usage -type AnyHpcUsage = Bool -emptyHpcInfo :: AnyHpcUsage -> HpcInfo +emptyHpcInfo :: HpcInfo emptyHpcInfo = NoHpcInfo - --- | Find out if HPC is used by this module or any of the modules --- it depends upon -isHpcUsed :: HpcInfo -> AnyHpcUsage -isHpcUsed (HpcInfo {}) = True -isHpcUsed (NoHpcInfo { hpcUsed = used }) = used diff --git a/GHC/Types/Id.hs b/GHC/Types/Id.hs --- a/GHC/Types/Id.hs +++ b/GHC/Types/Id.hs @@ -71,7 +71,7 @@ isPrimOpId, isPrimOpId_maybe, isFCallId, isFCallId_maybe, isDataConWorkId, isDataConWorkId_maybe, - isDataConWrapId, isDataConWrapId_maybe, + isDataConWrapId, isDataConWrapId_maybe, dataConWrapUnfolding_maybe, isDataConId, isDataConId_maybe, idDataCon, isConLikeId, isWorkerLikeId, isDeadEndId, idIsFrom, @@ -129,10 +129,6 @@ import GHC.Prelude -import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding - , isCompulsoryUnfolding, Unfolding( NoUnfolding ) - , IdUnfoldingFun, isEvaldUnfolding, hasSomeUnfolding, noUnfolding ) - import GHC.Types.Id.Info import GHC.Types.Basic @@ -140,11 +136,14 @@ import GHC.Types.Var( Id, CoVar, JoinId, InId, InVar, OutId, OutVar, - idInfo, idDetails, setIdDetails, globaliseId, + idInfo, idDetails, setIdDetails, globaliseId, idMult, isId, isLocalId, isGlobalId, isExportedId, setIdMult, updateIdTypeAndMult, updateIdTypeButNotMult, updateIdTypeAndMultM) import qualified GHC.Types.Var as Var +import GHC.Core ( CoreExpr, CoreRule, Unfolding(..), IdUnfoldingFun + , isStableUnfolding, isCompulsoryUnfolding, isEvaldUnfolding + , hasSomeUnfolding, noUnfolding, evaldUnfolding ) import GHC.Core.Type import GHC.Core.Predicate( isCoVarType ) import GHC.Core.DataCon @@ -158,13 +157,13 @@ import GHC.Types.ForeignCall import GHC.Types.SrcLoc import GHC.Types.Unique +import GHC.Types.Unique.Supply -import GHC.Stg.InferTags.TagSig +import GHC.Stg.EnforceEpt.TagSig import GHC.Unit.Module import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) import GHC.Builtin.Uniques (mkBuiltinUnique) -import GHC.Types.Unique.Supply import GHC.Data.Maybe import GHC.Data.FastString @@ -210,9 +209,6 @@ idType :: Id -> Kind idType = Var.varType -idMult :: Id -> Mult -idMult = Var.varMult - idScaledType :: Id -> Scaled Type idScaledType id = Scaled (idMult id) (idType id) @@ -250,7 +246,7 @@ | assert (isId id) $ isLocalId id && isInternalName name = id | otherwise - = Var.mkLocalVar (idDetails id) (localiseName name) (Var.varMult id) (idType id) (idInfo id) + = Var.mkLocalVar (idDetails id) (localiseName name) (Var.idMult id) (idType id) (idInfo id) where name = idName id @@ -544,6 +540,14 @@ DataConWrapId con -> Just con _ -> Nothing +dataConWrapUnfolding_maybe :: Id -> Maybe CoreExpr +dataConWrapUnfolding_maybe id + | DataConWrapId {} <- idDetails id + , CoreUnfolding { uf_tmpl = unf } <- realIdUnfolding id + = Just unf + | otherwise + = Nothing + isDataConId_maybe :: Id -> Maybe DataCon isDataConId_maybe id = case Var.idDetails id of DataConWorkId con -> Just con @@ -605,7 +609,11 @@ -- PrimOpId _ lev_poly -> lev_poly -- TEMPORARILY commented out FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc + DataConWorkId dc -> isUnboxedTupleDataCon dc + || isUnboxedSumDataCon dc + || isUnaryClassDataCon dc + -- Unary class dictionary constructors are eliminated + -- See Note [Unary class magic] in GHC.Core.TyCon _ -> isCompulsoryUnfolding (realIdUnfolding id) -- Note: this function must be very careful not to force -- any of the fields that aren't the 'uf_src' field of diff --git a/GHC/Types/Id/Info.hs b/GHC/Types/Id/Info.hs --- a/GHC/Types/Id/Info.hs +++ b/GHC/Types/Id/Info.hs @@ -21,8 +21,10 @@ -- * The IdDetails type IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails, JoinArity, isJoinIdDetails_maybe, + RecSelParent(..), recSelParentName, recSelFirstConName, recSelParentCons, idDetailsConcreteTvs, + RecSelInfo(..), conLikesRecSelInfo, -- * The IdInfo type IdInfo, -- Abstract @@ -111,11 +113,12 @@ import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Stg.InferTags.TagSig +import GHC.Stg.EnforceEpt.TagSig import GHC.StgToCmm.Types (LambdaFormInfo) import Data.Data ( Data ) import Data.Word +import Data.List as List( partition ) -- infixl so you can say (id `set` a `set` b) infixl 1 `setRuleInfo`, @@ -151,12 +154,9 @@ , sel_naughty :: Bool -- True <=> a "naughty" selector which can't actually exist, for example @x@ in: -- data T = forall a. MkT { x :: a } -- See Note [Naughty record selectors] in GHC.Tc.TyCl - , sel_cons :: ([ConLike], [ConLike]) - -- If record selector is not defined for all constructors - -- of a parent type, this is the pair of lists of constructors that - -- it is and is not defined for. Otherwise, it's Nothing. - -- Cached here based on the RecSelParent. - } -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc + , sel_cons :: RecSelInfo + -- Partiality info, cached here based on the RecSelParent. + } | DataConWorkId DataCon -- ^ The 'Id' is for a data constructor /worker/ | DataConWrapId DataCon -- ^ The 'Id' is for a data constructor /wrapper/ @@ -220,10 +220,15 @@ -- Worker like functions are create by W/W and SpecConstr and we can expect that they -- aren't used unapplied. -- See Note [CBV Function Ids] - -- See Note [Tag Inference] + -- See Note [EPT enforcement] -- The [CbvMark] is always empty (and ignored) until after Tidy for ids from the current -- module. +data RecSelInfo + = RSI { rsi_def :: [ConLike] -- Record selector defined for these + , rsi_undef :: [ConLike] -- Record selector not defined for these + } + idDetailsConcreteTvs :: IdDetails -> ConcreteTyVars idDetailsConcreteTvs = \ case PrimOpId _ conc_tvs -> conc_tvs @@ -232,16 +237,26 @@ DataConWrapId dc -> dataConConcreteTyVars dc _ -> noConcreteTyVars +-- | The ConLikes that have *all* the given fields +conLikesRecSelInfo :: [ConLike] -> [FieldLabelString] -> RecSelInfo +conLikesRecSelInfo con_likes lbls + = RSI { rsi_def = defs, rsi_undef = undefs } + where + !(defs,undefs) = List.partition has_flds con_likes + has_flds dc = all (has_fld dc) lbls + has_fld dc lbl = any (\ fl -> flLabel fl == lbl) (conLikeFieldLabels dc) + + {- Note [CBV Function Ids] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~ A WorkerLikeId essentially allows us to constrain the calling convention for the given Id. Each such Id carries with it a list of CbvMarks with each element representing a value argument. Arguments who have a matching `MarkedCbv` entry in the list need to be passed evaluated+*properly tagged*. CallByValueFunIds give us additional expressiveness which we use to improve -runtime. This is all part of the TagInference work. See also Note [Tag Inference]. +runtime. This is all part of the EPT enforcement work. See also Note [EPT enforcement]. They allows us to express the fact that an argument is not only evaluated to WHNF once we entered it's RHS but also that an lifted argument is already *properly tagged* once we jump @@ -261,7 +276,7 @@ * Any `WorkerLikeId` * Some `JoinId` bindings. -This works analogous to the Strict Field Invariant. See also Note [Strict Field Invariant]. +This works analogous to the EPT Invariant. See also Note [EPT enforcement]. To make this work what we do is: * During W/W and SpecConstr any worker/specialized binding we introduce @@ -568,12 +583,7 @@ -- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is -- (a) always inlined; that is, with an `UnfWhen` guidance, or -- (b) a DFunUnfolding which never needs to be inlined --- --- Very important that this work with `realUnfoldingInfo` and so returns --- True even for a loop-breaker that has an INLINE pragma. --- See (CWW4) in Note [Cast worker/wrapper] in GHC.Core.Opt.Simplify.Iteration --- for discussion, and #26903 for the dire consequences of getting this wrong. -hasInlineUnfolding info = isInlineUnfolding (realUnfoldingInfo info) +hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info) setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = diff --git a/GHC/Types/Id/Make.hs b/GHC/Types/Id/Make.hs --- a/GHC/Types/Id/Make.hs +++ b/GHC/Types/Id/Make.hs @@ -20,7 +20,7 @@ mkFCallId, - unwrapNewTypeBody, wrapFamInstBody, + wrapNewTypeBody, unwrapNewTypeBody, wrapFamInstBody, DataConBoxer(..), vanillaDataConBoxer, mkDataConRep, mkDataConWorkId, DataConBangOpts (..), BangOpts (..), @@ -54,11 +54,12 @@ import GHC.Core.Multiplicity import GHC.Core.TyCo.Rep import GHC.Core.FamInstEnv +import GHC.Core.Predicate( isUnaryClass ) import GHC.Core.Coercion import GHC.Core.Reduction import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo ) -import GHC.Core.Utils ( exprType, mkCast, mkDefaultCase, coreAltsType ) +import GHC.Core.Utils ( exprType, mkCast, coreAltsType ) import GHC.Core.Unfold.Make import GHC.Core.SimpleOpt import GHC.Core.TyCon @@ -475,12 +476,12 @@ mkDictSelId :: Name -- Name of one of the *value* selectors -- (dictionary superclass or method) -> Class -> Id +-- Important: see Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance mkDictSelId name clas = mkGlobalId (ClassOpId clas terminating) name sel_ty info where tycon = classTyCon clas sel_names = map idName (classAllSelIds clas) - new_tycon = isNewTyCon tycon [data_con] = tyConDataCons tycon tyvars = dataConUserTyVarBinders data_con n_ty_args = length tyvars @@ -489,7 +490,7 @@ pred_ty = mkClassPred clas (mkTyVarTys (binderVars tyvars)) res_ty = scaledThing (getNth arg_tys val_index) - sel_ty = mkInvisForAllTys tyvars $ + sel_ty = mkForAllTys tyvars $ mkFunctionType ManyTy pred_ty res_ty -- See Note [Type classes and linear types] @@ -502,23 +503,9 @@ `setDmdSigInfo` strict_sig `setCprSigInfo` topCprSig - info | new_tycon - = base_info `setInlinePragInfo` alwaysInlinePragma - `setUnfoldingInfo` mkInlineUnfoldingWithArity defaultSimpleOpts - StableSystemSrc 1 - (mkDictSelRhs clas val_index) - -- See Note [Single-method classes] in GHC.Tc.TyCl.Instance - -- for why alwaysInlinePragma - - | otherwise - = base_info `setRuleInfo` mkRuleInfo [rule] - `setInlinePragInfo` neverInlinePragma - `setUnfoldingInfo` mkInlineUnfoldingWithArity defaultSimpleOpts - StableSystemSrc 1 - (mkDictSelRhs clas val_index) - -- Add a magic BuiltinRule, but no unfolding - -- so that the rule is always available to fire. - -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance + info = base_info `setRuleInfo` mkRuleInfo [rule] + -- No unfolding for a dictionary selector; the RULE does the work, + -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance -- This is the built-in rule that goes -- op (dfT d1 d2) ---> opT d1 d2 @@ -531,11 +518,10 @@ -- The strictness signature is of the form U(AAAVAAAA) -> T -- where the V depends on which item we are selecting -- It's worth giving one, so that absence info etc is generated - -- even if the selector isn't inlined + -- even if the selector isn't inlined, which of course it isn't! strict_sig = mkClosedDmdSig [arg_dmd] topDiv - arg_dmd | new_tycon = evalDmd - | otherwise = C_1N :* mkProd Unboxed dict_field_dmds + arg_dmd = C_1N :* mkProd Unboxed dict_field_dmds where -- The evalDmd below is just a placeholder and will be replaced in -- GHC.Types.Demand.dmdTransformDictSel @@ -545,24 +531,29 @@ mkDictSelRhs :: Class -> Int -- 0-indexed selector among (superclasses ++ methods) -> CoreExpr +-- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance mkDictSelRhs clas val_index = mkLams tyvars (Lam dict_id rhs_body) where - tycon = classTyCon clas - new_tycon = isNewTyCon tycon - [data_con] = tyConDataCons tycon - tyvars = dataConUnivTyVars data_con - arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses + tycon = classTyCon clas + [data_con] = tyConDataCons tycon + tyvars = dataConUnivTyVars data_con + arg_tys = dataConRepArgTys data_con -- Includes the dictionary superclasses - the_arg_id = getNth arg_ids val_index - pred = mkClassPred clas (mkTyVarTys tyvars) - dict_id = mkTemplateLocal 1 pred - arg_ids = mkTemplateLocalsNum 2 (map scaledThing arg_tys) + the_arg_id = getNth arg_ids val_index + pred = mkClassPred clas (mkTyVarTys tyvars) + dict_id = mkTemplateLocal 1 pred + arg_ids = mkTemplateLocalsNum 2 (map scaledThing arg_tys) - rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars) - (Var dict_id) - | otherwise = mkSingleAltCase (Var dict_id) dict_id (DataAlt data_con) - arg_ids (varToCoreExpr the_arg_id) + rhs_body | isUnaryClass clas -- Just having one sel_id isn't enough! + -- E.g. class (a ~# b) => a ~ b where {} + , let sel_ids = classAllSelIds clas + = assertPpr (val_index == 0) (ppr clas) $ + assertPpr (length sel_ids == 1) (ppr clas) $ + Var (head sel_ids) `mkTyApps` mkTyVarTys tyvars `App` Var dict_id + | otherwise + = mkSingleAltCase (Var dict_id) dict_id (DataAlt data_con) + arg_ids (varToCoreExpr the_arg_id) -- varToCoreExpr needed for equality superclass selectors -- sel a b d = case x of { MkC _ (g:a~b) _ -> CO g } @@ -572,9 +563,11 @@ -- from it -- sel_i t1..tk (D t1..tk op1 ... opm) = opi -- -dictSelRule val_index n_ty_args _ id_unf _ args +-- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance +dictSelRule val_index n_ty_args _ in_scope_env _ args | (dict_arg : _) <- drop n_ty_args args - , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe id_unf dict_arg + , Just (_, floats, _, _, con_args) + <- exprIsConApp_maybe in_scope_env dict_arg = Just (wrapFloats floats $ getNth con_args val_index) | otherwise = Nothing @@ -589,16 +582,19 @@ mkDataConWorkId :: Name -> DataCon -> Id mkDataConWorkId wkr_name data_con - | isNewTyCon tycon - = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info - -- See Note [Newtype workers] + | isNewTyCon tycon -- See Note [Newtype workers] + = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_info | otherwise = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info where - tycon = dataConTyCon data_con -- The representation TyCon - wkr_ty = dataConRepType data_con + tycon = dataConTyCon data_con -- The representation TyCon + wkr_ty = dataConRepType data_con + univ_tvs = dataConUnivTyVars data_con + ex_tcvs = dataConExTyCoVars data_con + arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys + str_marks = dataConRepStrictness data_con ----------- Workers for data types -------------- alg_wkr_info = noCafIdInfo @@ -606,12 +602,19 @@ `setInlinePragInfo` wkr_inline_prag `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated, -- even if arity = 0 + `setDmdSigInfo` wkr_sig + -- Workers eval their strict fields + -- See Note [Strict fields in Core] `setLFInfo` wkr_lf_info - -- No strictness: see Note [Data-con worker strictness] in GHC.Core.DataCon wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike } wkr_arity = dataConRepArity data_con + wkr_sig = mkClosedDmdSig wkr_dmds topDiv + wkr_dmds = map mk_dmd str_marks + mk_dmd MarkedStrict = evalDmd + mk_dmd NotMarkedStrict = topDmd + -- See Note [LFInfo of DataCon workers and wrappers] wkr_lf_info | wkr_arity == 0 = LFCon data_con @@ -619,21 +622,17 @@ -- LFInfo stores post-unarisation arity ----------- Workers for newtypes -------------- - univ_tvs = dataConUnivTyVars data_con - ex_tcvs = dataConExTyCoVars data_con - arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys - nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo - `setArityInfo` 1 -- Arity 1 - `setInlinePragInfo` dataConWrapperInlinePragma - `setUnfoldingInfo` newtype_unf - -- See W1 in Note [LFInfo of DataCon workers and wrappers] - `setLFInfo` (panic "mkDataConWorkId: we shouldn't look at LFInfo for newtype worker ids") - id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) - res_ty_args = mkTyCoVarTys univ_tvs - newtype_unf = assertPpr (null ex_tcvs && isSingleton arg_tys) - (ppr data_con) + nt_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo + `setArityInfo` 1 -- Arity 1 + `setInlinePragInfo` dataConWrapperInlinePragma + `setUnfoldingInfo` mkCompulsoryUnfolding newtype_rhs + `setLFInfo` (panic "mkDataConWorkId: no LFInfo for newtype worker ids") + -- See W1 in Note [LFInfo of DataCon workers and wrappers] + + id_arg1 = mkScaledTemplateLocal 1 (head arg_tys) + res_ty_args = mkTyCoVarTys univ_tvs + newtype_rhs = assertPpr (null ex_tcvs && isSingleton arg_tys) (ppr data_con) $ -- Note [Newtype datacons] - mkCompulsoryUnfolding $ mkLams univ_tvs $ Lam id_arg1 $ wrapNewTypeBody tycon res_ty_args (Var id_arg1) @@ -656,18 +655,18 @@ (Remember: `LFCon` means "a saturated constructor application") (1) Data constructor workers and wrappers with arity > 0 are unambiguously -functions and should be given `LFReEntrant`, regardless of the runtime -relevance of the arguments. - - For example, `Just :: a -> Maybe a` is given `LFReEntrant`, - and `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. + functions and should be given `LFReEntrant`, regardless of the runtime + relevance of the arguments. For example: + `Just :: a -> Maybe a` is given `LFReEntrant`, + `HNil :: (a ~# '[]) -> HList a` is given `LFReEntrant` too. (2) A datacon /worker/ with zero arity is trivially fully saturated -- it takes -no arguments whatsoever (not even zero-width args), so it is given `LFCon`. + no arguments whatsoever (not even zero-width args), so it is given `LFCon`. (3) Perhaps surprisingly, a datacon /wrapper/ can be an `LFCon`. See Wrinkle (W1) below. -A datacon /wrapper/ with zero arity must be a fully saturated application of -the worker to zero-width arguments only (which are dropped after unarisation), -and therefore is also given `LFCon`. + A datacon /wrapper/ with zero arity must be a fully saturated application of + the worker to zero-width arguments only (which are dropped after unarisation), + and therefore is also given `LFCon`. For example, consider the following data constructors: @@ -789,10 +788,10 @@ -> FamInstEnvs -> Name -> DataCon - -> UniqSM DataConRep + -> UniqSM (DataConRep, [HsImplBang], [StrictnessMark]) mkDataConRep dc_bang_opts fam_envs wrap_name data_con | not wrapper_reqd - = return NoDataConRep + = return (NoDataConRep, arg_ibangs, rep_strs) | otherwise = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys @@ -849,24 +848,21 @@ wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding wrap_rhs -- See Note [Compulsory newtype unfolding] | otherwise = mkDataConUnfolding wrap_rhs - wrap_rhs = mkLams wrap_tvs $ - mkLams wrap_args $ + wrap_rhs = mkCoreTyLams wrap_tvbs $ + mkCoreLams wrap_args $ wrapFamInstBody tycon res_ty_args $ wrap_body ; return (DCR { dcr_wrap_id = wrap_id , dcr_boxer = mk_boxer boxers - , dcr_arg_tys = rep_tys - , dcr_stricts = rep_strs - -- For newtypes, dcr_bangs is always [HsLazy]. - -- See Note [HsImplBangs for newtypes]. - , dcr_bangs = arg_ibangs }) } + , dcr_arg_tys = rep_tys } + , arg_ibangs, rep_strs) } where (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty) = dataConFullSig data_con stupid_theta = dataConStupidTheta data_con - wrap_tvs = dataConUserTyVars data_con + wrap_tvbs = dataConUserTyVarBinders data_con res_ty_args = dataConResRepTyArgs data_con tycon = dataConTyCon data_con -- The representation TyCon (not family) @@ -913,17 +909,20 @@ -- See wrinkle (W0) in Note [Type data declarations] in GHC.Rename.Module. = False + | isUnaryClassTyCon tycon -- See (UCM8) in Note [Unary class magic] + = False -- in GHC.Core.TyCon + | otherwise = (not new_tycon -- (Most) newtypes have only a worker, with the exception -- of some newtypes written with GADT syntax. -- See dataConUserTyVarsNeedWrapper below. - && (any isBanged (ev_ibangs ++ arg_ibangs))) - -- Some forcing/unboxing (includes eq_spec) + && (any isUnpacked (ev_ibangs ++ arg_ibangs))) + -- Some unboxing (includes eq_spec) || isFamInstTyCon tycon -- Cast result - || dataConUserTyVarsNeedWrapper data_con + || dataConUserTyVarBindersNeedWrapper data_con -- If the data type was written with GADT syntax and -- orders the type variables differently from what the -- worker expects, it needs a data con wrapper to reorder @@ -1139,18 +1138,18 @@ -> HsImplBang dataConSrcToImplBang bang_opts fam_envs arg_ty - (HsSrcBang ann (HsBang unpk NoSrcStrict)) + (HsSrcBang ann unpk NoSrcStrict) | bang_opt_strict_data bang_opts -- StrictData => strict field = dataConSrcToImplBang bang_opts fam_envs arg_ty - (mkHsSrcBang ann unpk SrcStrict) + (HsSrcBang ann unpk SrcStrict) | otherwise -- no StrictData => lazy field = HsLazy -dataConSrcToImplBang _ _ _ (HsSrcBang _ (HsBang _ SrcLazy)) +dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy) = HsLazy dataConSrcToImplBang bang_opts fam_envs arg_ty - (HsSrcBang _ (HsBang unpk_prag SrcStrict)) + (HsSrcBang _ unpk_prag SrcStrict) | isUnliftedType (scaledThing arg_ty) -- NB: non-newtype data constructors can't have representation-polymorphic fields -- so this is OK. @@ -1185,7 +1184,7 @@ = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer)) dataConArgRep arg_ty (HsStrict _) - = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer)) + = ([(arg_ty, MarkedStrict)], (unitUnboxer, unitBoxer)) -- Seqs are inserted in STG dataConArgRep arg_ty (HsUnpack Nothing) = dataConArgUnpack arg_ty @@ -1215,9 +1214,6 @@ ; return (rep_ids, rep_expr `Cast` mkSymCo sco) } ------------------------ -seqUnboxer :: Unboxer -seqUnboxer v = return ([v], mkDefaultCase (Var v) v) - unitUnboxer :: Unboxer unitUnboxer v = return ([v], \e -> e) @@ -1468,7 +1464,7 @@ -- We'd get a black hole if we used dataConImplBangs ok_arg :: NameSet -> (Scaled Type, HsSrcBang) -> Bool - ok_arg dcs (Scaled _ ty, HsSrcBang _ (HsBang unpack_prag str_prag)) + ok_arg dcs (Scaled _ ty, HsSrcBang _ unpack_prag str_prag) | strict_field str_prag , Just data_cons <- unpackable_type_datacons (topNormaliseType fam_envs ty) , should_unpack_conservative unpack_prag data_cons -- Wrinkle (W3) @@ -1849,12 +1845,12 @@ -- See Note [Dict funs and default methods] mkDictFunId dfun_name tvs theta clas tys - = mkExportedLocalId (DFunId is_nt) + = mkExportedLocalId (DFunId is_unary) dfun_name dfun_ty where - is_nt = isNewTyCon (classTyCon clas) - dfun_ty = TcType.tcMkDFunSigmaTy tvs theta (mkClassPred clas tys) + is_unary = isUnaryClass clas + dfun_ty = TcType.tcMkDFunSigmaTy tvs theta (mkClassPred clas tys) {- ************************************************************************ @@ -1948,7 +1944,7 @@ Case (Var x) x openBetaTy [Alt DEFAULT [] (Var y)] concs = mkRepPolyIdConcreteTyVars - [ ((openBetaTy, Argument 2 Top), runtimeRep2TyVar)] + [ ((openBetaTy, mkArgPos 2 Top), runtimeRep2TyVar)] arity = 2 @@ -2007,7 +2003,7 @@ arity = 2 concs = mkRepPolyIdConcreteTyVars - [((openAlphaTy, Argument 2 Top), runtimeRep1TyVar)] + [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)] ---------------------------------------------------------------------- {- Note [Wired-in Ids for rebindable syntax] @@ -2052,7 +2048,7 @@ arity = 2 concs = mkRepPolyIdConcreteTyVars - [((openAlphaTy, Argument 2 Top), runtimeRep1TyVar)] + [((openAlphaTy, mkArgPos 2 Top), runtimeRep1TyVar)] -- See Note [Left and right sections] in GHC.Rename.Expr -- See Note [Wired-in Ids for rebindable syntax] @@ -2086,8 +2082,8 @@ concs = mkRepPolyIdConcreteTyVars - [ ((openAlphaTy, Argument 3 Top), runtimeRep1TyVar) - , ((openBetaTy , Argument 2 Top), runtimeRep2TyVar)] + [ ((openAlphaTy, mkArgPos 3 Top), runtimeRep1TyVar) + , ((openBetaTy , mkArgPos 2 Top), runtimeRep2TyVar)] -------------------------------------------------------------------------------- @@ -2117,7 +2113,7 @@ [Alt (DataAlt coercibleDataCon) [eq] (Cast (Var x) (mkCoVarCo eq))] concs = mkRepPolyIdConcreteTyVars - [((mkTyVarTy av, Argument 1 Top), rv)] + [((mkTyVarTy av, mkArgPos 1 Top), rv)] {- Note [seqId magic] @@ -2247,7 +2243,7 @@ Solution: in the desugarer, rewrite noinline (f x y) ==> noinline f x y - This is done in GHC.HsToCore.Utils.mkCoreAppDs. + This is done in the `noinlineId` case of `GHC.HsToCore.Expr.ds_app_var` This is only needed for noinlineId, not noInlineConstraintId (wrinkle (W1) below), because the latter never shows up in user code. diff --git a/GHC/Types/Literal.hs b/GHC/Types/Literal.hs --- a/GHC/Types/Literal.hs +++ b/GHC/Types/Literal.hs @@ -9,8 +9,6 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE AllowAmbiguousTypes #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- | Core literals module GHC.Types.Literal ( @@ -86,6 +84,7 @@ import Data.Data ( Data ) import GHC.Exts( isTrue#, dataToTag#, (<#) ) import Numeric ( fromRat ) +import Control.DeepSeq {- ************************************************************************ @@ -206,6 +205,20 @@ h <- getByte bh return (toEnum (fromIntegral h)) +instance NFData LitNumType where + rnf (LitNumBigNat) = () + rnf (LitNumInt) = () + rnf (LitNumInt8) = () + rnf (LitNumInt16) = () + rnf (LitNumInt32) = () + rnf (LitNumInt64) = () + rnf (LitNumWord) = () + rnf (LitNumWord8) = () + rnf (LitNumWord16) = () + rnf (LitNumWord32) = () + rnf (LitNumWord64) = () + + {- Note [BigNum literals] ~~~~~~~~~~~~~~~~~~~~~~ @@ -290,6 +303,16 @@ return (LitNumber nt i) _ -> pprPanic "Binary:Literal" (int (fromIntegral h)) +instance NFData Literal where + rnf (LitChar c) = rnf c + rnf (LitNumber nt i) = rnf nt `seq` rnf i + rnf (LitString s) = rnf s + rnf LitNullAddr = () + rnf (LitFloat r) = rnf r + rnf (LitDouble r) = rnf r + rnf (LitLabel l1 k2) = rnf l1 `seq` rnf k2 + rnf (LitRubbish {}) = () -- LitRubbish is not contained within interface files. + -- See Note [Rubbish literals]. instance Outputable Literal where ppr = pprLiteral id @@ -328,7 +351,12 @@ -- | Make a literal number using wrapping semantics if the value is out of -- bound. mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal -mkLitNumberWrap platform nt i = case nt of +mkLitNumberWrap platform nt i = LitNumber nt $ mkLitNumberWrap' platform nt i + +-- | Make a literal number using wrapping semantics if the value is out of +-- bound. +mkLitNumberWrap' :: Platform -> LitNumType -> Integer -> Integer +mkLitNumberWrap' platform nt i = case nt of LitNumInt -> case platformWordSize platform of PW4 -> wrap @Int32 PW8 -> wrap @Int64 @@ -345,10 +373,10 @@ LitNumWord64 -> wrap @Word64 LitNumBigNat | i < 0 -> panic "mkLitNumberWrap: trying to create a negative BigNat" - | otherwise -> LitNumber nt i + | otherwise -> i where - wrap :: forall a. (Integral a, Num a) => Literal - wrap = LitNumber nt (toInteger (fromIntegral i :: a)) + wrap :: forall a. (Integral a, Num a) => Integer + wrap = toInteger (fromIntegral i :: a) -- | Wrap a literal number according to its type using wrapping semantics. litNumWrap :: Platform -> Literal -> Literal @@ -364,9 +392,7 @@ -- converting it back to its original type. litNumNarrow :: LitNumType -> Platform -> Literal -> Literal litNumNarrow pt platform (LitNumber nt i) - = case mkLitNumberWrap platform pt i of - LitNumber _ j -> mkLitNumberWrap platform nt j - l -> pprPanic "litNumNarrow: got invalid literal" (ppr l) + = mkLitNumberWrap platform nt . mkLitNumberWrap' platform pt $ i litNumNarrow _ _ l = pprPanic "litNumNarrow: invalid literal" (ppr l) @@ -429,9 +455,9 @@ -- the argument is wrapped and the overflow flag will be set. -- See Note [Word/Int underflow/overflow] mkLitIntWrapC :: Platform -> Integer -> (Literal, Bool) -mkLitIntWrapC platform i = (n, i /= i') +mkLitIntWrapC platform i = (LitNumber LitNumInt i', i /= i') where - n@(LitNumber _ i') = mkLitIntWrap platform i + i' = mkLitNumberWrap' platform LitNumInt i -- | Creates a 'Literal' of type @Word#@ mkLitWord :: Platform -> Integer -> Literal @@ -453,9 +479,9 @@ -- the argument is wrapped and the carry flag will be set. -- See Note [Word/Int underflow/overflow] mkLitWordWrapC :: Platform -> Integer -> (Literal, Bool) -mkLitWordWrapC platform i = (n, i /= i') +mkLitWordWrapC platform i = (LitNumber LitNumWord i', i /= i') where - n@(LitNumber _ i') = mkLitWordWrap platform i + i' = mkLitNumberWrap' platform LitNumWord i -- | Creates a 'Literal' of type @Int8#@ mkLitInt8 :: Integer -> Literal diff --git a/GHC/Types/Meta.hs b/GHC/Types/Meta.hs --- a/GHC/Types/Meta.hs +++ b/GHC/Types/Meta.hs @@ -16,6 +16,8 @@ import GHC.Serialized ( Serialized ) import GHC.Hs +import GHC.Utils.Outputable +import GHC.Utils.Panic -- | The supported metaprogramming result types @@ -28,11 +30,42 @@ -- | data constructors not exported to ensure correct result type data MetaResult - = MetaResE { unMetaResE :: LHsExpr GhcPs } - | MetaResP { unMetaResP :: LPat GhcPs } - | MetaResT { unMetaResT :: LHsType GhcPs } - | MetaResD { unMetaResD :: [LHsDecl GhcPs] } - | MetaResAW { unMetaResAW :: Serialized } + = MetaResE (LHsExpr GhcPs) + | MetaResP (LPat GhcPs) + | MetaResT (LHsType GhcPs) + | MetaResD [LHsDecl GhcPs] + | MetaResAW Serialized + +instance Outputable MetaResult where + ppr (MetaResE e) = text "MetaResE" <> braces (ppr e) + ppr (MetaResP p) = text "MetaResP" <> braces (ppr p) + ppr (MetaResT t) = text "MetaResT" <> braces (ppr t) + ppr (MetaResD d) = text "MetaResD" <> braces (ppr d) + ppr (MetaResAW aw) = text "MetaResAW" <> braces (ppr aw) + +-- These unMetaResE ext panics will triger if the MetaHook doesn't +-- take an expression to an expression, pattern to pattern etc. +-- +-- ToDo: surely this could be expressed in the type system? +unMetaResE :: MetaResult -> LHsExpr GhcPs +unMetaResE (MetaResE e) = e +unMetaResE mr = pprPanic "unMetaResE" (ppr mr) + +unMetaResP :: MetaResult -> LPat GhcPs +unMetaResP (MetaResP p) = p +unMetaResP mr = pprPanic "unMetaResP" (ppr mr) + +unMetaResT :: MetaResult -> LHsType GhcPs +unMetaResT (MetaResT t) = t +unMetaResT mr = pprPanic "unMetaResT" (ppr mr) + +unMetaResD :: MetaResult -> [LHsDecl GhcPs] +unMetaResD (MetaResD d) = d +unMetaResD mr = pprPanic "unMetaResD" (ppr mr) + +unMetaResAW :: MetaResult -> Serialized +unMetaResAW (MetaResAW aw) = aw +unMetaResAW mr = pprPanic "unMetaResAW" (ppr mr) type MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult diff --git a/GHC/Types/Name.hs b/GHC/Types/Name.hs --- a/GHC/Types/Name.hs +++ b/GHC/Types/Name.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} -- instance NFData FieldLabel @@ -58,9 +59,9 @@ localiseName, namePun_maybe, - pprName, + pprName, pprName_userQual, nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt, - pprFullName, pprTickyName, + pprFullName, pprFullNameWithUnique, pprTickyName, -- ** Predicates on 'Name's isSystemName, isInternalName, isExternalName, @@ -110,7 +111,8 @@ import Data.Data import qualified Data.Semigroup as S import GHC.Types.Basic (Boxity(Boxed, Unboxed)) -import GHC.Builtin.Uniques (isTupleTyConUnique, isSumTyConUnique, isTupleDataConLikeUnique) +import GHC.Builtin.Uniques ( isTupleTyConUnique, isCTupleTyConUnique, + isSumTyConUnique, isTupleDataConLikeUnique ) {- ************************************************************************ @@ -221,7 +223,7 @@ Note [About the NameSorts] ~~~~~~~~~~~~~~~~~~~~~~~~~~ 1. Initially: - * All types, classes, data constructors get Extenal Names + * All types, classes, data constructors get External Names * Top-level Ids (including locally-defined ones) get External Names, * All other local (non-top-level) Ids get Internal names @@ -263,7 +265,7 @@ A WiredIn Name contains contains a TyThing, so we don't have to look it up. The BuiltInSyntax flag => It's a syntactic form, not "in scope" (e.g. []) - All built-in syntax thigs are WiredIn. + All built-in syntax things are WiredIn. -} instance HasOccName Name where @@ -384,14 +386,17 @@ | getUnique name == getUnique listTyCon = Just (fsLit "[]") | Just (boxity, ar) <- isTupleTyConUnique (getUnique name) - , ar /= 1 = - let - (lpar, rpar) = - case boxity of + , ar /= 1 + = let (lpar, rpar) = case boxity of Boxed -> ("(", ")") Unboxed -> ("(#", "#)") in Just (fsLit $ lpar ++ commas ar ++ rpar) + | Just ar <- isCTupleTyConUnique (getUnique name) + , ar /= 1 + = Just (fsLit $ "(" ++ commas ar ++ ")") + -- constraint tuples look just like boxed tuples + | Just ar <- isSumTyConUnique (getUnique name) = Just (fsLit $ "(# " ++ bars ar ++ " #)") where @@ -687,7 +692,10 @@ pprPrefixOcc = pprPrefixName pprName :: forall doc. IsLine doc => Name -> doc -pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ}) +pprName = pprName_userQual Nothing + +pprName_userQual :: forall doc. IsLine doc => Maybe ModuleName -> Name -> doc +pprName_userQual user_qual name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ}) = docWithStyle codeDoc normalDoc where codeDoc = case sort of @@ -705,8 +713,8 @@ sdocOption sdocListTuplePuns $ \listTuplePuns -> handlePuns listTuplePuns (namePun_maybe name) $ case sort of - WiredIn mod _ builtin -> pprExternal debug sty uniq mod occ True builtin - External mod -> pprExternal debug sty uniq mod occ False UserSyntax + WiredIn mod _ builtin -> pprExternal debug sty uniq mod user_qual occ True builtin + External mod -> pprExternal debug sty uniq mod user_qual occ False UserSyntax System -> pprSystem debug sty uniq occ Internal -> pprInternal debug sty uniq occ @@ -728,6 +736,18 @@ <> colon <> ftext (moduleNameFS $ moduleName mod) <> dot <> ftext (occNameFS occ) +-- | Print fully qualified name (with unit-id and module, with the unique) +pprFullNameWithUnique :: Module -> Name -> SDoc +pprFullNameWithUnique this_mod Name{n_sort = sort, n_uniq = u, n_occ = occ} = + let mod = case sort of + WiredIn m _ _ -> m + External m -> m + System -> this_mod + Internal -> this_mod + in ftext (unitIdFS (moduleUnitId mod)) + <> colon <> ftext (moduleNameFS $ moduleName mod) + <> dot <> ftext (occNameFS occ) <> text "_" <> pprUniqueAlways u + -- | Print a ticky ticky styled name -- -- Module argument is the module to use for internal and system names. When @@ -743,8 +763,14 @@ pprNameUnqualified :: Name -> SDoc pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ -pprExternal :: Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc -pprExternal debug sty uniq mod occ is_wired is_builtin +pprExternal :: Bool -> PprStyle -> Unique + -> Module -- ^ module the 'Name' is defined in + -> Maybe ModuleName -- ^ user module qualification + -> OccName + -> Bool -- ^ wired-in? + -> BuiltInSyntax + -> SDoc +pprExternal debug sty uniq mod user_qual occ is_wired is_builtin | debug = pp_mod <> ppr_occ_name occ <> braces (hsep [if is_wired then text "(w)" else empty, pprNameSpaceBrief (occNameSpace occ), @@ -752,10 +778,10 @@ | BuiltInSyntax <- is_builtin = ppr_occ_name occ -- Never qualify builtin syntax | otherwise = if isHoleModule mod - then case qualName sty mod occ of + then case qualName sty mod user_qual occ of NameUnqual -> ppr_occ_name occ _ -> braces (pprModuleName (moduleName mod) <> dot <> ppr_occ_name occ) - else pprModulePrefix sty mod occ <> ppr_occ_name occ + else pprModulePrefix sty mod user_qual occ <> ppr_occ_name occ where pp_mod = ppUnlessOption sdocSuppressModulePrefixes (pprModule mod <> dot) @@ -780,11 +806,11 @@ -- so print the unique -pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc +pprModulePrefix :: PprStyle -> Module -> Maybe ModuleName -> OccName -> SDoc -- Print the "M." part of a name, based on whether it's in scope or not -- See Note [Printing original names] in GHC.Types.Name.Ppr -pprModulePrefix sty mod occ = ppUnlessOption sdocSuppressModulePrefixes $ - case qualName sty mod occ of -- See Outputable.QualifyName: +pprModulePrefix sty mod user_qual occ = ppUnlessOption sdocSuppressModulePrefixes $ + case qualName sty mod user_qual occ of -- See Outputable.QualifyName: NameQual modname -> pprModuleName modname <> dot -- Name is in scope NameNotInScope1 -> pprModule mod <> dot -- Not in scope NameNotInScope2 -> pprUnit (moduleUnit mod) <> colon -- Module not in @@ -877,7 +903,7 @@ -- add parens or back-quotes as appropriate pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n) -pprPrefixName :: NamedThing a => a -> SDoc -pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name) +pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc +pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr thing) where name = getName thing diff --git a/GHC/Types/Name/Cache.hs b/GHC/Types/Name/Cache.hs --- a/GHC/Types/Name/Cache.hs +++ b/GHC/Types/Name/Cache.hs @@ -3,6 +3,8 @@ -- | The Name Cache module GHC.Types.Name.Cache ( NameCache (..) + , newNameCache + , newNameCacheWith , initNameCache , takeUniqFromNameCache , updateNameCache' @@ -13,6 +15,10 @@ , lookupOrigNameCache , extendOrigNameCache' , extendOrigNameCache + + -- * Known-key names + , knownKeysOrigNameCache + , isKnownOrigName_maybe ) where @@ -23,13 +29,14 @@ import GHC.Types.Unique.Supply import GHC.Builtin.Types import GHC.Builtin.Names +import GHC.Builtin.Utils import GHC.Utils.Outputable import GHC.Utils.Panic +import Control.Applicative import Control.Concurrent.MVar import Control.Monad -import Control.Applicative {- @@ -57,36 +64,48 @@ Note [Built-in syntax and the OrigNameCache] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Built-in syntax refers to names that are always in scope and can't be imported +or exported. Such names come in two varieties: -Built-in syntax like unboxed sums and punned syntax like tuples are quite -ubiquitous. To lower their cost we use two tricks, +* Simple names (finite): `[]`, `:`, `->` +* Families of names (infinite): + * boxed tuples `()`, `(,)`, `(,,)`, `(,,,)`, ... + * unboxed tuples `(##)`, `(#,#)`, `(#,,#)`, ... + * unboxed sum type syntax `(#|#)`, `(#||#)`, `(#|||#)`, ... + * unboxed sum data syntax `(#_|#)`, `(#|_#)`, `(#_||#), ... - a. We specially encode tuple and sum Names in interface files' symbol tables - to avoid having to look up their names while loading interface files. - Namely these names are encoded as by their Uniques. We know how to get from - a Unique back to the Name which it represents via the mapping defined in - the SumTupleUniques module. See Note [Symbol table representation of names] - in GHC.Iface.Binary and for details. +Concretely, a built-in name is a WiredIn Name that has a BuiltInSyntax flag. - b. We don't include them in the Orig name cache but instead parse their - OccNames (in isBuiltInOcc_maybe and isPunOcc_maybe) to avoid bloating - the name cache with them. +Historically, GHC used to avoid putting any built-in syntax in the OrigNameCache +to avoid dealing with infinite families of names (tuples and sums). This measure +has become inadequate with the introduction of NoListTuplePuns (GHC Proposal #475). +Nowadays tuples and sums also use Names that are WiredIn, but are not BuiltInSyntax: -Why is the second measure necessary? Good question; afterall, 1) the parser -emits built-in and punned syntax directly as Exact RdrNames, and 2) built-in -and punned syntax never needs to looked-up during interface loading due to (a). -It turns out that there are two reasons why we might look up an Orig RdrName -for built-in and punned syntax, +* boxed tuples (tycons): Unit, Solo, Tuple2, Tuple3, Tuple4, ... +* unboxed tuples (tycons): Unit#, Solo#, Tuple2#, Tuple3#, Tuple4#, ... +* constraint tuples (tycons): CUnit, CSolo, CTuple2, CTuple3, CTuple4, ... +* one-tuples (datacons): MkSolo, MkSolo# - * If you use setRdrNameSpace on an Exact RdrName it may be - turned into an Orig RdrName. +We can't put infinitely many names in a finite data structure (OrigNameCache). +So we deal with them in lookupOrigNameCache by means of isInfiniteFamilyOrigName_maybe. - * Template Haskell turns a BuiltInSyntax Name into a TH.NameG - (GHC.HsToCore.Quote.globalVar), and parses a NameG into an Orig RdrName - (GHC.ThToHs.thRdrName). So, e.g. $(do { reify '(,); ... }) will - go this route (#8954). +At the same time, simple finite built-in names (`[]`, `:`, `->`) can be put in +the OrigNameCache without any issues (they end up there because they're +knownKeyNames). It doesn't matter that they're built-in syntax. +One might wonder: what's the point of having any built-in syntax in the +OrigNameCache at all? Good question; after all, + 1) The parser emits built-in and punned syntax directly as Exact RdrNames + 2) Template Haskell conversion (GHC.ThToHs) matches on built-in and punned + syntax directly to immediately produce Exact names (GHC.ThToHs.thRdrName) + 3) Loading of interface files encodes names via Uniques, as detailed in + Note [Symbol table representation of names] in GHC.Iface.Binary + +It turns out that we end up looking up built-in syntax in the cache when we +generate Haddock documentation. E.g. if we don't find tuple data constructors +there, hyperlinks won't work as expected. Test case: haddockHtmlTest (Bug923.hs) -} + -- | The NameCache makes sure that there is just one Unique assigned for -- each original name; i.e. (module-name, occ-name) pair and provides -- something of a lookup mechanism for those names. @@ -102,18 +121,14 @@ takeUniqFromNameCache (NameCache c _) = uniqFromTag c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name -lookupOrigNameCache nc mod occ - | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_INTERNAL_TUPLE || mod == gHC_CLASSES - , Just name <- isBuiltInOcc_maybe occ <|> isPunOcc_maybe mod occ - = -- See Note [Known-key names], 3(c) in GHC.Builtin.Names - -- Special case for tuples; there are too many - -- of them to pre-populate the original-name cache - Just name - - | otherwise - = case lookupModuleEnv nc mod of - Nothing -> Nothing - Just occ_env -> lookupOccEnv occ_env occ +lookupOrigNameCache nc mod occ = lookup_infinite <|> lookup_normal + where + -- See Note [Known-key names], 3(c) in GHC.Builtin.Names + -- and Note [Infinite families of known-key names] + lookup_infinite = isInfiniteFamilyOrigName_maybe mod occ + lookup_normal = do + occ_env <- lookupModuleEnv nc mod + lookupOccEnv occ_env occ extendOrigNameCache' :: OrigNameCache -> Name -> OrigNameCache extendOrigNameCache' nc name @@ -126,8 +141,27 @@ where combine _ occ_env = extendOccEnv occ_env occ name +-- | Initialize a new name cache +newNameCache :: IO NameCache +newNameCache = newNameCacheWith 'r' knownKeysOrigNameCache + +-- | This is a version of `newNameCache` that lets you supply your +-- own unique tag and set of known key names. This can go wrong if the tag +-- supplied is one reserved by GHC for internal purposes. See #26055 for +-- an example. +-- +-- Use `newNameCache` when possible. +newNameCacheWith :: Char -> OrigNameCache -> IO NameCache +newNameCacheWith c nc = NameCache c <$> newMVar nc + +-- | This takes a tag for uniques to be generated and the list of knownKeyNames +-- These must be initialized properly to ensure that names generated from this +-- NameCache do not conflict with known key names. +-- +-- Use `newNameCache` or `newNameCacheWith` instead +{-# DEPRECATED initNameCache "Use newNameCache or newNameCacheWith instead" #-} initNameCache :: Char -> [Name] -> IO NameCache -initNameCache c names = NameCache c <$> newMVar (initOrigNames names) +initNameCache c names = newNameCacheWith c (initOrigNames names) initOrigNames :: [Name] -> OrigNameCache initOrigNames names = foldl' extendOrigNameCache' emptyModuleEnv names @@ -159,3 +193,10 @@ -> IO c updateNameCache name_cache !_mod !_occ upd_fn = updateNameCache' name_cache upd_fn + +{-# NOINLINE knownKeysOrigNameCache #-} +knownKeysOrigNameCache :: OrigNameCache +knownKeysOrigNameCache = initOrigNames knownKeyNames + +isKnownOrigName_maybe :: Module -> OccName -> Maybe Name +isKnownOrigName_maybe = lookupOrigNameCache knownKeysOrigNameCache diff --git a/GHC/Types/Name/Env.hs b/GHC/Types/Name/Env.hs --- a/GHC/Types/Name/Env.hs +++ b/GHC/Types/Name/Env.hs @@ -166,7 +166,7 @@ disjointNameEnv x y = disjointUFM x y seqEltsNameEnv seqElt x = seqEltsUFM seqElt x -lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n) +lookupNameEnv_NF env n = expectJust (lookupNameEnv env n) -- | Deterministic Name Environment -- diff --git a/GHC/Types/Name/Occurrence.hs b/GHC/Types/Name/Occurrence.hs --- a/GHC/Types/Name/Occurrence.hs +++ b/GHC/Types/Name/Occurrence.hs @@ -49,8 +49,7 @@ mkClsOcc, mkClsOccFS, mkDFunOcc, setOccNameSpace, - demoteOccName, - demoteOccTvName, + demoteOccName, demoteOccTcClsName, demoteOccTvName, promoteOccName, varToRecFieldOcc, recFieldToVarOcc, @@ -93,6 +92,7 @@ plusOccEnv, plusOccEnv_C, extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv, alterOccEnv, minusOccEnv, minusOccEnv_C, minusOccEnv_C_Ns, + sizeOccEnv, pprOccEnv, forceOccEnv, intersectOccEnv_C, @@ -316,16 +316,23 @@ pprNameSpaceBrief TcClsName = text "tc" pprNameSpaceBrief (FldName {}) = text "fld" --- demoteNameSpace lowers the NameSpace if possible. We can not know --- in advance, since a TvName can appear in an HsTyVar. +-- | 'demoteNameSpace' lowers the 'NameSpace' to the term-level, if possible. +-- -- See Note [Demotion] in GHC.Rename.Env. demoteNameSpace :: NameSpace -> Maybe NameSpace demoteNameSpace VarName = Nothing demoteNameSpace DataName = Nothing -demoteNameSpace TvName = Nothing +demoteNameSpace TvName = Just VarName demoteNameSpace TcClsName = Just DataName demoteNameSpace (FldName {}) = Nothing +demoteTcClsNameSpace :: NameSpace -> Maybe NameSpace +demoteTcClsNameSpace VarName = Nothing +demoteTcClsNameSpace DataName = Nothing +demoteTcClsNameSpace TvName = Nothing +demoteTcClsNameSpace TcClsName = Just DataName +demoteTcClsNameSpace (FldName {}) = Nothing + -- demoteTvNameSpace lowers the NameSpace of a type variable. -- See Note [Demotion] in GHC.Rename.Env. demoteTvNameSpace :: NameSpace -> Maybe NameSpace @@ -507,6 +514,11 @@ space' <- demoteNameSpace space return $ OccName space' name +demoteOccTcClsName :: OccName -> Maybe OccName +demoteOccTcClsName (OccName space name) = do + space' <- demoteTcClsNameSpace space + return $ OccName space' name + demoteOccTvName :: OccName -> Maybe OccName demoteOccTvName (OccName space name) = do space' <- demoteTvNameSpace space @@ -791,6 +803,10 @@ in if isNullUFM m then Nothing else Just m + +sizeOccEnv :: OccEnv a -> Int +sizeOccEnv (MkOccEnv as) = + nonDetStrictFoldUFM (\ m !acc -> acc + sizeUFM m) 0 as instance Outputable a => Outputable (OccEnv a) where ppr x = pprOccEnv ppr x diff --git a/GHC/Types/Name/Ppr.hs b/GHC/Types/Name/Ppr.hs --- a/GHC/Types/Name/Ppr.hs +++ b/GHC/Types/Name/Ppr.hs @@ -13,6 +13,7 @@ import GHC.Unit import GHC.Unit.Env +import qualified GHC.Unit.Home.Graph as HUG import GHC.Types.Name import GHC.Types.Name.Reader @@ -72,67 +73,74 @@ mkNamePprCtx ptc unit_env env = QueryQualify (mkQualName env) - (mkQualModule unit_state home_unit) + (mkQualModule unit_state unit_env) (mkQualPackage unit_state) (mkPromTick ptc env) where - unit_state = ue_units unit_env - home_unit = ue_homeUnit unit_env + unit_state = ue_homeUnitState unit_env mkQualName :: Outputable info => GlobalRdrEnvX info -> QueryQualifyName mkQualName env = qual_name where - qual_name mod occ - | [gre] <- unqual_gres - , right_name gre - = NameUnqual -- If there's a unique entity that's in scope - -- unqualified with 'occ' AND that entity is - -- the right one, then we can use the unqualified name + qual_name mod user_qual occ - | [] <- unqual_gres - , pretendNameIsInScopeForPpr - , not (isDerivedOccName occ) - = NameUnqual -- See Note [pretendNameIsInScopeForPpr] + -- Use the user-written qualification, if that's unambiguous. + | Just qual <- user_qual + , let user_rdr = mkRdrQual qual occ + , [gre] <- lookupGRE env $ LookupRdrName user_rdr SameNameSpace + , right_name gre + = NameQual qual - | [gre] <- qual_gres - = NameQual (greQualModName gre) + -- If there's a GRE that's in scope + -- unqualified with 'occ' AND that entity is + -- the right one, then use the unqualified name + | [gre] <- unqual_gres + , right_name gre + = NameUnqual - | null qual_gres - = if null $ lookupGRE env $ - LookupRdrName (mkRdrQual (moduleName mod) occ) SameNameSpace - then NameNotInScope1 - else NameNotInScope2 + | [] <- unqual_gres + , pretendNameIsInScopeForPpr + , not (isDerivedOccName occ) + = NameUnqual -- See Note [pretendNameIsInScopeForPpr] - | otherwise - = NameNotInScope1 -- Can happen if 'f' is bound twice in the module - -- Eg f = True; g = 0; f = False - where - is_name :: Name -> Bool - is_name name = assertPpr (isExternalName name) (ppr name) $ - nameModule name == mod && nameOccName name == occ + | [gre] <- qual_gres + = NameQual (greQualModName gre) - -- See Note [pretendNameIsInScopeForPpr] - pretendNameIsInScopeForPpr :: Bool - pretendNameIsInScopeForPpr = - any is_name - [ liftedTypeKindTyConName - , constraintKindTyConName - , heqTyConName - , coercibleTyConName - , eqTyConName - , tYPETyConName - , fUNTyConName, unrestrictedFunTyConName - , oneDataConName - , listTyConName - , manyDataConName - , soloDataConName ] - || isJust (isTupleTyOcc_maybe mod occ) - || isJust (isSumTyOcc_maybe mod occ) + | null qual_gres + = if null $ lookupGRE env $ + LookupRdrName (mkRdrQual (moduleName mod) occ) SameNameSpace + then NameNotInScope1 + else NameNotInScope2 - right_name gre = greDefinitionModule gre == Just mod + | otherwise + = NameNotInScope1 -- Can happen if 'f' is bound twice in the module + -- Eg f = True; g = 0; f = False + where + is_name :: Name -> Bool + is_name name = assertPpr (isExternalName name) (ppr name) $ + nameModule name == mod && nameOccName name == occ - unqual_gres = lookupGRE env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) - qual_gres = filter right_name (lookupGRE env (LookupOccName occ SameNameSpace)) + -- See Note [pretendNameIsInScopeForPpr] + pretendNameIsInScopeForPpr :: Bool + pretendNameIsInScopeForPpr = + any is_name + [ liftedTypeKindTyConName + , constraintKindTyConName + , heqTyConName + , coercibleTyConName + , eqTyConName + , tYPETyConName + , fUNTyConName, unrestrictedFunTyConName + , oneDataConName + , listTyConName + , manyDataConName + , soloDataConName ] + || isJust (isTupleTyOrigName_maybe mod occ) + || isJust (isSumTyOrigName_maybe mod occ) + right_name gre = greDefinitionModule gre == Just mod + unqual_gres = lookupGRE env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) + qual_gres = filter right_name (lookupGRE env (LookupOccName occ SameNameSpace)) + -- we can mention a module P:M without the P: qualifier iff -- "import M" would resolve unambiguously to P:M. (if P is the -- current package we can just assume it is unqualified). @@ -207,10 +215,12 @@ -- | Creates a function for formatting modules based on two heuristics: -- (1) if the module is the current module, don't qualify, and (2) if there -- is only one exposed package which exports this module, don't qualify. -mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule -mkQualModule unit_state mhome_unit mod - | Just home_unit <- mhome_unit - , isHomeModule home_unit mod = False +mkQualModule :: UnitState -> UnitEnv -> QueryQualifyModule +mkQualModule unit_state unitEnv mod + -- Check whether the unit of the module is in the HomeUnitGraph. + -- If it is, then we consider this 'mod' to be "local" and don't + -- want to qualify it. + | HUG.memberHugUnit (moduleUnit mod) (ue_home_unit_graph unitEnv) = False | [(_, pkgconfig)] <- lookup, mkUnit pkgconfig == moduleUnit mod diff --git a/GHC/Types/Name/Reader.hs b/GHC/Types/Name/Reader.hs --- a/GHC/Types/Name/Reader.hs +++ b/GHC/Types/Name/Reader.hs @@ -5,6 +5,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -37,10 +38,15 @@ nameRdrName, getRdrName, -- ** Destruction - rdrNameOcc, rdrNameSpace, demoteRdrName, demoteRdrNameTv, promoteRdrName, + rdrNameOcc, rdrNameSpace, + demoteRdrName, demoteRdrNameTcCls, demoteRdrNameTv, + promoteRdrName, isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, + -- ** Preserving user-written qualification + WithUserRdr(..), noUserRdr, unLocWithUserRdr, userRdrName, + -- * Local mapping of 'RdrName' to 'Name.Name' LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList, lookupLocalRdrEnv, lookupLocalRdrOcc, @@ -59,12 +65,11 @@ LookupGRE(..), lookupGRE, WhichGREs(.., AllRelevantGREs, RelevantGREsFOS), greIsRelevant, - LookupChild(..), lookupGRE_Name, lookupGRE_FieldLabel, getGRE_NameQualifier_maybes, - transformGREs, pickGREs, pickGREsModExp, + transformGREs, pickGREs, pickGREsModExp, pickLevelZeroGRE, -- * GlobalRdrElts availFromGRE, @@ -85,7 +90,7 @@ pprNameProvenance, mkGRE, mkExactGRE, mkLocalGRE, mkLocalVanillaGRE, mkLocalTyConGRE, mkLocalConLikeGRE, mkLocalFieldGREs, - gresToNameSet, + gresToNameSet, greLevels, -- ** Shadowing greClashesWith, shadowNames, @@ -98,13 +103,15 @@ fieldGRE_maybe, fieldGRELabel, -- ** Parent information - Parent(..), greParent_maybe, + Parent(..), ParentGRE(..), greParent_maybe, mkParent, availParent, ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), - importSpecLoc, importSpecModule, isExplicitItem, bestImport, + importSpecLoc, importSpecModule, importSpecLevel, isExplicitItem, bestImport, + ImportLevel(..), -- * Utils - opIsAt + opIsAt, + ) where import GHC.Prelude @@ -119,7 +126,6 @@ import GHC.Types.FieldLabel import GHC.Types.Name import GHC.Types.Name.Env - ( NameEnv, nonDetNameEnvElts, emptyNameEnv, extendNameEnv_Acc ) import GHC.Types.Name.Set import GHC.Types.PkgQual import GHC.Types.SrcLoc as SrcLoc @@ -127,15 +133,18 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import GHC.Builtin.Uniques ( isFldNSUnique ) +import GHC.Types.ThLevelIndex +import qualified Data.Set as Set import GHC.Unit.Module import GHC.Utils.Misc as Utils import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Binary import Control.DeepSeq -import Control.Monad ( guard ) +import Control.Monad ( guard , (>=>) ) import Data.Data import Data.List ( sort ) import qualified Data.List.NonEmpty as NE @@ -222,7 +231,9 @@ rdrNameSpace :: RdrName -> NameSpace rdrNameSpace = occNameSpace . rdrNameOcc --- demoteRdrName lowers the NameSpace of RdrName. +-- | 'demoteRdrName' attempts to lowers the 'NameSpace' of a 'RdrName' +-- to the term-level. +-- -- See Note [Demotion] in GHC.Rename.Env demoteRdrName :: RdrName -> Maybe RdrName demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ) @@ -230,6 +241,12 @@ demoteRdrName (Orig _ _) = Nothing demoteRdrName (Exact _) = Nothing +demoteRdrNameTcCls :: RdrName -> Maybe RdrName +demoteRdrNameTcCls (Unqual occ) = fmap Unqual (demoteOccTcClsName occ) +demoteRdrNameTcCls (Qual m occ) = fmap (Qual m) (demoteOccTcClsName occ) +demoteRdrNameTcCls (Orig _ _) = Nothing +demoteRdrNameTcCls (Exact _) = Nothing + demoteRdrNameTv :: RdrName -> Maybe RdrName demoteRdrNameTv (Unqual occ) = fmap Unqual (demoteOccTvName occ) demoteRdrNameTv (Qual m occ) = fmap (Qual m) (demoteOccTvName occ) @@ -335,7 +352,7 @@ ppr (Exact name) = ppr name ppr (Unqual occ) = ppr occ ppr (Qual mod occ) = ppr mod <> dot <> ppr occ - ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ) + ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod Nothing occ <> ppr occ) instance OutputableBndr RdrName where pprBndr _ n @@ -456,6 +473,14 @@ = Just name | otherwise + -- As per the Haskell report (www.haskell.org/onlinereport/haskell2010/haskellch5.html#x11-980005), + -- qualified names can only refer to: + -- + -- - imported names, or + -- - top-level declarations in the current module. + -- + -- Thus, looking up in the LocalRdrEnv using a Qual or Orig RdrName will + -- always fail. = Nothing lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name @@ -616,6 +641,11 @@ greInfo :: GlobalRdrElt -> GREInfo greInfo = gre_info +greLevels :: GlobalRdrEltX info -> Set.Set ImportLevel +greLevels g = + if gre_lcl g then Set.singleton NormalLevel + else Set.fromList (bagToList (fmap (is_level . is_decl) (gre_imp g))) + -- | See Note [Parents] data Parent = NoParent | ParentIs { par_is :: !Name } @@ -1095,6 +1125,23 @@ allowGRE WantField gre = isRecFldGRE gre +-- | A parent of a child, in contexts like import/export lists, class and +-- instance declarations, etc. +-- +-- Not simply a 'GlobalRdrElt', because we don't always have a full +-- 'GlobalRdrElt' to hand (e.g. in 'GHC.Rename.Env.lookupInstDeclBndr'). +data ParentGRE + = ParentGRE + { parentGRE_name :: Name + , parentGRE_info :: GREInfo + } + +instance Outputable ParentGRE where + ppr (ParentGRE name info) = ppr name <+> parens (ppr info) + +instance Eq ParentGRE where + ParentGRE name1 _ == ParentGRE name2 _ = name1 == name2 + -- | What should we look up in a 'GlobalRdrEnv'? Should we only look up -- names with the exact same 'OccName', or do we allow different 'NameSpace's? -- @@ -1135,11 +1182,9 @@ -- | Look up children 'GlobalRdrElt's with a given 'Parent'. LookupChildren - :: OccName -- ^ the 'OccName' to look up - -> LookupChild - -- ^ information to decide which 'GlobalRdrElt's - -- are valid children after looking up - -> LookupGRE info + :: ParentGRE -- ^ the parent + -> OccName -- ^ the child 'OccName' to look up + -> LookupGRE GREInfo -- | How should we look up in a 'GlobalRdrEnv'? -- Which 'NameSpace's are considered relevant for a given lookup? @@ -1194,33 +1239,6 @@ , lookupVariablesForFields = fos == WantBoth , lookupTyConsAsWell = False } -data LookupChild - = LookupChild - { wantedParent :: Name - -- ^ the parent we are looking up children of - , lookupDataConFirst :: Bool - -- ^ for type constructors, should we look in the data constructor - -- namespace first? - , prioritiseParent :: Bool - -- ^ should we prioritise getting the right 'Parent'? - -- - -- - @True@: prioritise getting the right 'Parent' - -- - @False@: prioritise getting the right 'NameSpace' - -- - -- See Note [childGREPriority]. - } - -instance Outputable LookupChild where - ppr (LookupChild { wantedParent = par - , lookupDataConFirst = dc - , prioritiseParent = prio_parent }) - = braces $ hsep - [ text "LookupChild" - , braces (text "parent:" <+> ppr par) - , if dc then text "[dc_first]" else empty - , if prio_parent then text "[prio_parent]" else empty - ] - -- | After looking up something with the given 'NameSpace', is the resulting -- 'GlobalRdrElt' we have obtained relevant, according to the 'RelevantGREs' -- specification of which 'NameSpace's are relevant? @@ -1269,69 +1287,64 @@ class C a where { type (+++) :: a -> a ->; infixl 6 +++ } (+++) :: Int -> Int -> Int; (+++) = (+) -In these two situations, there are two competing metrics for finding the "best" +In these two situations, there are two metrics for finding the "best" 'GlobalRdrElt' that a particular 'OccName' resolves to: - does the resolved 'GlobalRdrElt' have the correct parent? - does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'? -(A) and (B) have competing requirements. - -For the example of (A) above, we know that the child 'D' of 'T' must live -in the data namespace, so we look up the OccName 'OccName DataName "D"' and -prioritise the lookup results based on the 'NameSpace'. -This means we get an error message of the form: - - The type constructor 'T' is not the parent of the data constructor 'D'. - -as opposed to the rather unhelpful and confusing: - - The type constructor 'T' is not the parent of the type constructor 'D'. - -See test case T11970. +To resolve a children export item, we proceed by first prioritising GREs which +have the correct parent, and then break ties by looking at 'NameSpace's. -For the example of (B) above, the fixity declaration for +++ lies inside the -class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'. -Not doing so led to #23664. +Test cases: + - T11970: pattern synonyms, classes etc + - T10816, T23664, T24037: fixity declarations for associated types + - T20427: promoted data constructors and TypeData -} -- | Scoring priority function for looking up children 'GlobalRdrElt'. -- --- We score by 'Parent' and 'NameSpace', with higher priorities having lower --- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first) --- is determined by the first argument; see Note [childGREPriority]. -childGREPriority :: LookupChild -- ^ what kind of child do we want, - -- e.g. what should its parent be? - -> NameSpace -- ^ what 'NameSpace' are we originally looking in? - -> GlobalRdrEltX info - -- ^ the result of looking up; it might be in a different - -- 'NameSpace', which is used to determine the score - -- (in the first component) +-- The returned score orders by 'Parent' first and then by 'NameSpace', +-- with higher priorities having lower numbers. +-- +-- See Note [childGREPriority]. +childGREPriority :: ParentGRE -- ^ wanted parent + -> NameSpace -- ^ what 'NameSpace' are we originally looking in? + -> GlobalRdrElt + -- ^ the result of looking up; it might be in a different + -- 'NameSpace', which is used to determine the score + -- (in the second component) -> Maybe (Int, Int) -childGREPriority (LookupChild { wantedParent = wanted_parent - , lookupDataConFirst = try_dc_first - , prioritiseParent = par_first }) - ns gre = - case child_ns_prio $ greNameSpace gre of - Nothing -> Nothing - Just ns_prio -> - let par_prio = parent_prio $ greParent gre - in Just $ if par_first - then (par_prio, ns_prio) - else (ns_prio, par_prio) - -- See Note [childGREPriority]. +childGREPriority (ParentGRE wanted_parent parent_info) wanted_ns child_gre = + (parent_prio, ) <$> child_ns_prio where + child_ns = greNameSpace child_gre + + -- Is the parent a class? Only class TyCons can have children that + -- are in the TcCls NameSpace (associated types). + is_class_parent = + case parent_info of + IAmTyCon ClassFlavour -> True + _ -> False + -- Pick out the possible 'NameSpace's in order of priority. - child_ns_prio :: (NameSpace -> Maybe Int) - child_ns_prio other_ns - | other_ns == ns + child_ns_prio :: Maybe Int + child_ns_prio + | child_ns == wanted_ns + + -- Is it OK to have a child in this NameSpace? + -- + -- If it's in the TcCls NameSpace, then the parent must be a class, + -- unless the child is a promoted data constructor (which can happen + -- when exporting a TypeData declaration, see T20427). + , not (isTcClsNameSpace child_ns) || is_class_parent || child_is_data = Just 0 - | isTermVarOrFieldNameSpace ns - , isTermVarOrFieldNameSpace other_ns + | isTermVarOrFieldNameSpace wanted_ns + , isTermVarOrFieldNameSpace child_ns = Just 0 - | isValNameSpace varName - , other_ns == tcName + | isValNameSpace wanted_ns + , is_class_parent && isTcClsNameSpace child_ns -- When looking up children, we sometimes want a value name -- to resolve to a type constructor. -- For example, for an infix declaration "infixr 3 +!" or "infix 2 `Fun`" @@ -1341,19 +1354,49 @@ -- NameSpace, and "Fun" would be in the term-level data constructor -- NameSpace. See tests T10816, T23664, T24037. = Just 1 - | ns == tcName - , other_ns == dataName - , try_dc_first -- try data namespace before type/class namespace? - = Just (-1) + | wanted_ns == tcName + , child_is_data + = Just $ + -- For classes we de-prioritise data constructors; + -- otherwise we prioritise them. + if is_class_parent + then 1 + else -1 | otherwise = Nothing - parent_prio :: Parent -> Int - parent_prio (ParentIs other_parent) - | other_parent == wanted_parent = 0 - | otherwise = 1 - parent_prio NoParent = 0 + parent_prio :: Int + parent_prio = + case greParent child_gre of + ParentIs other_parent + | other_parent == wanted_parent + -> 0 + | otherwise + -- The parent is wrong, so give this a low priority. + -- Don't return 'Nothing': if there are no other options, this + -- allows us to report an incorrect parent to the user, as opposed + -- to an out-of-scope error. + -> 1 + NoParent -> + -- Higher priority than having the wrong parent entirely, + -- but same priority as having the right parent. Why? See T25892: + -- + -- module M1 where + -- data D = K + -- module M2 (D(M2.K)) where + -- import qualified M1 + -- pattern K = M1.K + -- + -- Here, we do not want the data constructor M1.K to take priority + -- over the pattern synonym M2.K that we are trying to bundle. + 0 + child_is_data = + case greInfo child_gre of + IAmConLike{} -> True + IAmTyCon PromotedDataConFlavour -> True + _ -> child_ns == dataName + -- | Look something up in the Global Reader Environment. -- -- The 'LookupGRE' argument specifies what to look up, and in particular @@ -1377,10 +1420,10 @@ occ = nameOccName nm lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ | otherwise = fromMaybe [] $ lookupOccEnv env occ - LookupChildren occ which_child -> - let ns = occNameSpace occ - all_gres = concat $ lookupOccEnv_AllNameSpaces env occ - in highestPriorityGREs (childGREPriority which_child ns) all_gres + LookupChildren parent child_occ -> + let ns = occNameSpace child_occ + all_gres = concat $ lookupOccEnv_AllNameSpaces env child_occ + in highestPriorityGREs (childGREPriority parent ns) all_gres -- | Collect the 'GlobalRdrElt's with the highest priority according -- to the given function (lower value <=> higher priority). @@ -1561,8 +1604,15 @@ -- -- Used only for the 'module M' item in export list; -- see 'GHC.Tc.Gen.Export.exports_from_avail' -pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres +-- This function also only chooses GREs which are at level zero. +pickGREsModExp mod gres = mapMaybe (pickLevelZeroGRE >=> pickBothGRE mod) gres +pickLevelZeroGRE :: GlobalRdrEltX info -> Maybe (GlobalRdrEltX info) +pickLevelZeroGRE gre = + if NormalLevel `Set.member` greLevels gre + then Just gre + else Nothing + -- | isBuiltInSyntax filter out names for built-in syntax They -- just clutter up the environment (esp tuples), and the -- parser will generate Exact RdrNames for them, so the @@ -1778,6 +1828,7 @@ , is_as = old_mod_name , is_pkg_qual = NoPkgQual , is_qual = True + , is_level = NormalLevel -- MP: Not 100% sure this is correct , is_isboot = NotBoot , is_dloc = greDefinitionSrcSpan old_gre } @@ -1940,12 +1991,34 @@ is_pkg_qual :: !PkgQual, -- ^ Was this a package import? is_qual :: !Bool, -- ^ Was this import qualified? is_dloc :: !SrcSpan, -- ^ The location of the entire import declaration - is_isboot :: !IsBootInterface -- ^ Was this a SOURCE import? + is_isboot :: !IsBootInterface, -- ^ Was this a SOURCE import? + is_level :: !ImportLevel -- ^ Was this import level modified? splice/quote +-1 } deriving (Eq, Data) + + instance NFData ImpDeclSpec where rnf = rwhnf -- Already strict in all fields + +instance Binary ImpDeclSpec where + put_ bh (ImpDeclSpec mod as pkg_qual qual _dloc isboot isstage) = do + put_ bh mod + put_ bh as + put_ bh pkg_qual + put_ bh qual + put_ bh isboot + put_ bh (fromEnum isstage) + + get bh = do + mod <- get bh + as <- get bh + pkg_qual <- get bh + qual <- get bh + isboot <- get bh + isstage <- toEnum <$> get bh + return (ImpDeclSpec mod as pkg_qual qual noSrcSpan isboot isstage) + -- | Import Item Specification -- -- Describes import info a particular Name @@ -2058,6 +2131,9 @@ importSpecModule :: ImportSpec -> ModuleName importSpecModule = moduleName . is_mod . is_decl +importSpecLevel :: ImportSpec -> ImportLevel +importSpecLevel = is_level . is_decl + isExplicitItem :: ImpItemSpec -> Bool isExplicitItem ImpAll = False isExplicitItem (ImpSome {is_explicit = exp}) = exp @@ -2095,11 +2171,18 @@ ppr imp_spec = text "imported" <+> qual <+> text "from" <+> quotes (ppr (importSpecModule imp_spec)) + <+> level_ppr <+> pprLoc (importSpecLoc imp_spec) where qual | is_qual (is_decl imp_spec) = text "qualified" | otherwise = empty + level = thLevelIndexFromImportLevel (is_level (is_decl imp_spec)) + level_ppr + | level == topLevelIndex = empty + | otherwise = text "at" <+> ppr level + + pprLoc :: SrcSpan -> SDoc pprLoc (RealSrcSpan s _) = text "at" <+> ppr s pprLoc (UnhelpfulSpan {}) = empty @@ -2107,3 +2190,42 @@ -- | Indicate if the given name is the "@" operator opIsAt :: RdrName -> Bool opIsAt e = e == mkUnqual varName (fsLit "@") + + +-------------------------------------------------------------------------------- +-- Preserving user-written qualification + +-- | 'WithUserRdr' allows us to keep track of the original user-written +-- 'RdrName', and in particular, any user-written module qualification. +-- +-- See Note [IdOcc] in Language.Haskell.Syntax.Extension. +data WithUserRdr a = WithUserRdr RdrName a + deriving stock (Functor, Foldable, Traversable) + +instance NamedThing a => NamedThing (WithUserRdr a) where + getName (WithUserRdr _rdr a) = getName a +instance Outputable (WithUserRdr Name) where + ppr (WithUserRdr rdr name) = + pprName_userQual (rdrQual_maybe rdr) name +instance OutputableBndr (WithUserRdr Name) where + pprBndr _ (WithUserRdr rdr name) = + pprName_userQual (rdrQual_maybe rdr) name + pprInfixOcc :: WithUserRdr Name -> SDoc + pprInfixOcc = pprInfixName + pprPrefixOcc = pprPrefixName + +unLocWithUserRdr :: GenLocated l (WithUserRdr a) -> a +unLocWithUserRdr (L _ (WithUserRdr _ a)) = a + +noUserRdr :: Name -> WithUserRdr Name +noUserRdr n = WithUserRdr (nameRdrName n) n + +userRdrName :: WithUserRdr Name -> RdrName +userRdrName (WithUserRdr rdr _) = rdr + +rdrQual_maybe :: RdrName -> Maybe ModuleName +rdrQual_maybe = \case + Qual q _ -> Just q + _ -> Nothing + +-------------------------------------------------------------------------------- diff --git a/GHC/Types/PkgQual.hs b/GHC/Types/PkgQual.hs --- a/GHC/Types/PkgQual.hs +++ b/GHC/Types/PkgQual.hs @@ -6,6 +6,7 @@ import GHC.Prelude import GHC.Types.SourceText import GHC.Unit.Types +import GHC.Utils.Binary import GHC.Utils.Outputable import Data.Data @@ -38,4 +39,21 @@ ThisPkg u -> doubleQuotes (ppr u) OtherPkg u -> doubleQuotes (ppr u) +instance Binary PkgQual where + put_ bh NoPkgQual = putByte bh 0 + put_ bh (ThisPkg u) = do + putByte bh 1 + put_ bh u + put_ bh (OtherPkg u) = do + putByte bh 2 + put_ bh u + get bh = do + tag <- getByte bh + case tag of + 0 -> return NoPkgQual + 1 -> do u <- get bh + return (ThisPkg u) + 2 -> do u <- get bh + return (OtherPkg u) + _ -> fail "instance Binary PkgQual: Invalid tag" diff --git a/GHC/Types/ProfAuto.hs b/GHC/Types/ProfAuto.hs --- a/GHC/Types/ProfAuto.hs +++ b/GHC/Types/ProfAuto.hs @@ -12,4 +12,4 @@ | ProfAutoTop -- ^ top-level functions annotated only | ProfAutoExports -- ^ exported functions annotated only | ProfAutoCalls -- ^ annotate call-sites - deriving (Eq,Enum) + deriving (Eq,Enum, Show) diff --git a/GHC/Types/RepType.hs b/GHC/Types/RepType.hs --- a/GHC/Types/RepType.hs +++ b/GHC/Types/RepType.hs @@ -698,7 +698,7 @@ = False | [BoxedRep _] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) - , isDataTyCon tc + , isBoxedDataTyCon tc = False | otherwise = True diff --git a/GHC/Types/SafeHaskell.hs b/GHC/Types/SafeHaskell.hs --- a/GHC/Types/SafeHaskell.hs +++ b/GHC/Types/SafeHaskell.hs @@ -14,6 +14,7 @@ import GHC.Utils.Binary import GHC.Utils.Outputable +import Control.DeepSeq import Data.Word @@ -31,6 +32,15 @@ | Sf_Ignore -- ^ @-fno-safe-haskell@ state deriving (Eq) +instance NFData SafeHaskellMode where + rnf x = case x of + Sf_None -> () + Sf_Unsafe -> () + Sf_Trustworthy -> () + Sf_Safe -> () + Sf_SafeInferred -> () + Sf_Ignore -> () + instance Show SafeHaskellMode where show Sf_None = "None" show Sf_Unsafe = "Unsafe" @@ -45,6 +55,10 @@ -- | Safe Haskell information for 'ModIface' -- Simply a wrapper around SafeHaskellMode to separate iface and flags newtype IfaceTrustInfo = TrustInfo SafeHaskellMode + +instance NFData IfaceTrustInfo where + rnf (TrustInfo shm) = rnf shm + getSafeMode :: IfaceTrustInfo -> SafeHaskellMode getSafeMode (TrustInfo x) = x diff --git a/GHC/Types/SourceFile.hs b/GHC/Types/SourceFile.hs --- a/GHC/Types/SourceFile.hs +++ b/GHC/Types/SourceFile.hs @@ -13,6 +13,7 @@ import GHC.Prelude import GHC.Utils.Binary import GHC.Unit.Types +import Control.DeepSeq {- Note [HscSource types] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -53,6 +54,10 @@ | Hsig -- ^ .hsig file deriving (Eq, Ord, Show) +instance NFData HsBootOrSig where + rnf HsBoot = () + rnf Hsig = () + data HscSource -- | .hs file = HsSrcFile @@ -72,6 +77,10 @@ hscSourceToIsBoot :: HscSource -> IsBootInterface hscSourceToIsBoot HsBootFile = IsBoot hscSourceToIsBoot _ = NotBoot + +instance NFData HscSource where + rnf HsSrcFile = () + rnf (HsBootOrSig h) = rnf h instance Binary HscSource where put_ bh HsSrcFile = putByte bh 0 diff --git a/GHC/Types/SptEntry.hs b/GHC/Types/SptEntry.hs --- a/GHC/Types/SptEntry.hs +++ b/GHC/Types/SptEntry.hs @@ -14,4 +14,3 @@ instance Outputable SptEntry where ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr - diff --git a/GHC/Types/SrcLoc.hs b/GHC/Types/SrcLoc.hs --- a/GHC/Types/SrcLoc.hs +++ b/GHC/Types/SrcLoc.hs @@ -223,8 +223,9 @@ -- We use 'BufPos' in in GHC.Parser.PostProcess.Haddock to associate Haddock -- comments with parts of the AST using location information (#17544). newtype BufPos = BufPos { bufPos :: Int } - deriving (Eq, Ord, Show, Data) + deriving (Eq, Ord, Show, Data, NFData) + -- | Source Location data SrcLoc = RealSrcLoc !RealSrcLoc !(Strict.Maybe BufPos) -- See Note [Why Maybe BufPos] @@ -373,11 +374,13 @@ } deriving Eq --- | StringBuffer Source Span data BufSpan = BufSpan { bufSpanStart, bufSpanEnd :: {-# UNPACK #-} !BufPos } deriving (Eq, Ord, Show, Data) +instance NFData BufSpan where + rnf (BufSpan a1 a2) = rnf a1 `seq` rnf a2 + instance Semigroup BufSpan where BufSpan start1 end1 <> BufSpan start2 end2 = BufSpan (min start1 start2) (max end1 end2) @@ -439,8 +442,19 @@ end = JSObject [ ("line", JSInt srcSpanELine), ("column", JSInt srcSpanECol) ] +instance NFData RealSrcSpan where + rnf (RealSrcSpan' file line col endLine endCol) = rnf file `seq` rnf line `seq` rnf col `seq` rnf endLine `seq` rnf endCol + instance NFData SrcSpan where - rnf x = x `seq` () + rnf (RealSrcSpan a1 a2) = rnf a1 `seq` rnf a2 + rnf (UnhelpfulSpan a1) = rnf a1 + +instance NFData UnhelpfulSpanReason where + rnf (UnhelpfulNoLocationInfo) = () + rnf (UnhelpfulWiredIn) = () + rnf (UnhelpfulInteractive) = () + rnf (UnhelpfulGenerated) = () + rnf (UnhelpfulOther a1) = rnf a1 getBufSpan :: SrcSpan -> Strict.Maybe BufSpan getBufSpan (RealSrcSpan _ mbspan) = mbspan diff --git a/GHC/Types/ThLevelIndex.hs b/GHC/Types/ThLevelIndex.hs new file mode 100644 --- /dev/null +++ b/GHC/Types/ThLevelIndex.hs @@ -0,0 +1,36 @@ +module GHC.Types.ThLevelIndex where + +import GHC.Prelude +import GHC.Utils.Outputable +import GHC.Types.Basic ( ImportLevel(..) ) +import Data.Data + +-- | The integer which represents the level +newtype ThLevelIndex = ThLevelIndex Int deriving (Eq, Ord, Data) + -- NB: see Note [Template Haskell levels] in GHC.Tc.Gen.Splice + -- Incremented when going inside a bracket, + -- decremented when going inside a splice + +instance Outputable ThLevelIndex where + ppr (ThLevelIndex i) = int i + +incThLevelIndex :: ThLevelIndex -> ThLevelIndex +incThLevelIndex (ThLevelIndex i) = ThLevelIndex (i + 1) + +decThLevelIndex :: ThLevelIndex -> ThLevelIndex +decThLevelIndex (ThLevelIndex i) = ThLevelIndex (i - 1) + +topLevelIndex :: ThLevelIndex +topLevelIndex = ThLevelIndex 0 + +spliceLevelIndex :: ThLevelIndex +spliceLevelIndex = decThLevelIndex topLevelIndex + +quoteLevelIndex :: ThLevelIndex +quoteLevelIndex = incThLevelIndex topLevelIndex + +-- | Convert a 'GHC.Types.Basic.ImportLevel' to a 'ThLevelIndex' +thLevelIndexFromImportLevel :: ImportLevel -> ThLevelIndex +thLevelIndexFromImportLevel NormalLevel = topLevelIndex +thLevelIndexFromImportLevel SpliceLevel = spliceLevelIndex +thLevelIndexFromImportLevel QuoteLevel = quoteLevelIndex diff --git a/GHC/Types/Tickish.hs b/GHC/Types/Tickish.hs --- a/GHC/Types/Tickish.hs +++ b/GHC/Types/Tickish.hs @@ -21,11 +21,15 @@ isProfTick, TickishPlacement(..), tickishPlace, - tickishContains + tickishContains, + + -- * Breakpoint tick identifiers + BreakpointId(..), BreakTickIndex ) where import GHC.Prelude import GHC.Data.FastString +import Control.DeepSeq import GHC.Core.Type @@ -40,7 +44,7 @@ import Language.Haskell.Syntax.Extension ( NoExtField ) import Data.Data -import GHC.Utils.Outputable (Outputable (ppr), text) +import GHC.Utils.Outputable (Outputable (ppr), text, (<+>)) {- ********************************************************************* * * @@ -128,7 +132,7 @@ -- and (b) substituting (don't substitute for them) | Breakpoint { breakpointExt :: XBreakpoint pass - , breakpointId :: !Int + , breakpointId :: !BreakpointId , breakpointFVs :: [XTickishId pass] -- ^ the order of this list is important: -- it matches the order of the lists in the @@ -136,7 +140,6 @@ -- -- Careful about substitution! See -- Note [substTickish] in "GHC.Core.Subst". - , breakpointModule :: Module } -- | A source note. @@ -171,6 +174,35 @@ deriving instance Ord (GenTickish 'TickishPassCmm) deriving instance Data (GenTickish 'TickishPassCmm) +-------------------------------------------------------------------------------- +-- Tick breakpoint index +-------------------------------------------------------------------------------- + +-- | Breakpoint tick index +-- newtype BreakTickIndex = BreakTickIndex Int +-- deriving (Eq, Ord, Data, Ix, NFData, Outputable) +type BreakTickIndex = Int + +-- | Breakpoint identifier. +-- +-- Indexes into the structures in the @'ModBreaks'@ created during desugaring +-- (after inserting the breakpoint ticks in the expressions). +-- See Note [Breakpoint identifiers] +data BreakpointId = BreakpointId + { bi_tick_mod :: !Module -- ^ Breakpoint tick module + , bi_tick_index :: !BreakTickIndex -- ^ Breakpoint tick index + } + deriving (Eq, Ord, Data) + +instance Outputable BreakpointId where + ppr BreakpointId{bi_tick_mod, bi_tick_index} = + text "BreakpointId" <+> ppr bi_tick_mod <+> ppr bi_tick_index + +instance NFData BreakpointId where + rnf BreakpointId{bi_tick_mod, bi_tick_index} = + rnf bi_tick_mod `seq` rnf bi_tick_index + +-------------------------------------------------------------------------------- -- | A "counting tick" (where tickishCounts is True) is one that -- counts evaluations in some way. We cannot discard a counting tick, diff --git a/GHC/Types/TyThing.hs b/GHC/Types/TyThing.hs --- a/GHC/Types/TyThing.hs +++ b/GHC/Types/TyThing.hs @@ -125,7 +125,8 @@ IfaceDecl for the data/newtype. Ditto class methods. * Record selectors are *not* implicit, because they get their own - free-standing IfaceDecl. + free-standing IfaceDecl. See Note [Record selectors] in + GHC.Tc.TyCl.Utils. * Associated data/type families are implicit because they are included in the IfaceDecl of the parent class. (NB: the @@ -266,9 +267,9 @@ Just (ATyCon tc) RecSelId { sel_tycon = RecSelPatSyn ps } -> Just (AConLike (PatSynCon ps)) - ClassOpId cls _ -> + ClassOpId cls _ -> Just (ATyCon (classTyCon cls)) - _other -> Nothing + _other -> Nothing tyThingParent_maybe _other = Nothing tyThingsTyCoVars :: [TyThing] -> TyCoVarSet @@ -355,12 +356,12 @@ RecSelPatSyn ps -> unitUniqSet $ PatSynName (patSynName ps) RecSelData tc -> let dcs = map RealDataCon $ tyConDataCons tc in - case conLikesWithFields dcs [flLabel fl] of - ([], _) -> pprPanic "tyThingGREInfo: no DataCons with this FieldLabel" $ + case rsi_def (conLikesRecSelInfo dcs [flLabel fl]) of + [] -> pprPanic "tyThingGREInfo: no DataCons with this FieldLabel" $ vcat [ text "id:" <+> ppr id , text "fl:" <+> ppr fl , text "dcs:" <+> ppr dcs ] - (cons, _) -> mkUniqSet $ map conLikeConLikeName cons + cons -> mkUniqSet $ map conLikeConLikeName cons in IAmRecField $ RecFieldInfo { recFieldLabel = fl diff --git a/GHC/Types/TyThing/Ppr.hs b/GHC/Types/TyThing/Ppr.hs --- a/GHC/Types/TyThing/Ppr.hs +++ b/GHC/Types/TyThing/Ppr.hs @@ -192,7 +192,7 @@ | otherwise = case nameModule_maybe name of Just mod -> Just $ \occ -> getPprStyle $ \sty -> - pprModulePrefix sty mod occ <> ppr occ + pprModulePrefix sty mod Nothing occ <> ppr occ Nothing -> warnPprTrace True "pprTyThing" (ppr name) Nothing -- Nothing is unexpected here; TyThings have External names diff --git a/GHC/Types/Unique.hs b/GHC/Types/Unique.hs --- a/GHC/Types/Unique.hs +++ b/GHC/Types/Unique.hs @@ -302,8 +302,14 @@ showUnique :: Unique -> String showUnique uniq - = case unpkUnique uniq of - (tag, u) -> tag : w64ToBase62 u + = tagStr ++ w64ToBase62 u + where + (tag, u) = unpkUnique uniq + -- Avoid emitting non-printable characters in pretty uniques. + -- See #25989. + tagStr + | tag < 'A' || tag > 'z' = show (ord tag) ++ "_" + | otherwise = [tag] pprUniqueAlways :: IsLine doc => Unique -> doc -- The "always" means regardless of -dsuppress-uniques diff --git a/GHC/Types/Unique/FM.hs b/GHC/Types/Unique/FM.hs --- a/GHC/Types/Unique/FM.hs +++ b/GHC/Types/Unique/FM.hs @@ -41,7 +41,6 @@ listToUFM_C, listToIdentityUFM, addToUFM,addToUFM_C,addToUFM_Acc,addToUFM_L, - strictAddToUFM_C, addListToUFM,addListToUFM_C, addToUFM_Directly, addListToUFM_Directly, @@ -52,9 +51,7 @@ delListFromUFM, delListFromUFM_Directly, plusUFM, - strictPlusUFM, plusUFM_C, - strictPlusUFM_C, plusUFM_CD, plusUFM_CD2, mergeUFM, @@ -66,7 +63,6 @@ minusUFM_C, intersectUFM, intersectUFM_C, - strictIntersectUFM_C, disjointUFM, equalKeysUFM, diffUFM, @@ -183,16 +179,6 @@ addToUFM_C f (UFM m) k v = UFM (M.insertWith (flip f) (getKey $ getUnique k) v m) -strictAddToUFM_C - :: Uniquable key - => (elt -> elt -> elt) -- ^ old -> new -> result - -> UniqFM key elt -- ^ old - -> key -> elt -- ^ new - -> UniqFM key elt -- ^ result --- Arguments of combining function of MS.insertWith and strictAddToUFM_C are flipped. -strictAddToUFM_C f (UFM m) k v = - UFM (MS.insertWith (flip f) (getKey $ getUnique k) v m) - addToUFM_Acc :: Uniquable key => (elt -> elts -> elts) -- Add to existing @@ -254,33 +240,27 @@ delFromUFM :: Uniquable key => UniqFM key elt -> key -> UniqFM key elt delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m) -delListFromUFM :: Uniquable key => UniqFM key elt -> [key] -> UniqFM key elt +delListFromUFM :: (Uniquable key, Foldable f) => UniqFM key elt -> f key -> UniqFM key elt delListFromUFM = foldl' delFromUFM +{-# INLINE delListFromUFM #-} -delListFromUFM_Directly :: UniqFM key elt -> [Unique] -> UniqFM key elt +delListFromUFM_Directly :: Foldable f => UniqFM key elt -> f Unique -> UniqFM key elt delListFromUFM_Directly = foldl' delFromUFM_Directly +{-# INLINE delListFromUFM_Directly #-} delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) --- | Bindings in right argument shadow those in the left. --- --- Unlike containers this union is right-biased for historic reasons. +-- Bindings in right argument shadow those in the left plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt +-- M.union is left-biased, plusUFM should be right-biased. plusUFM (UFM x) (UFM y) = UFM (M.union y x) -- Note (M.union y x), with arguments flipped -- M.union is left-biased, plusUFM should be right-biased. --- | Right biased -strictPlusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt -strictPlusUFM (UFM x) (UFM y) = UFM (MS.union y x) - plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y) -strictPlusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt -strictPlusUFM_C f (UFM x) (UFM y) = UFM (MS.unionWith f x y) - -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the -- combinding function and `d1` resp. `d2` as the default value if -- there is no entry in `m1` reps. `m2`. The domain is the union of @@ -390,13 +370,6 @@ -> UniqFM key elt2 -> UniqFM key elt3 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y) - -strictIntersectUFM_C - :: (elt1 -> elt2 -> elt3) - -> UniqFM key elt1 - -> UniqFM key elt2 - -> UniqFM key elt3 -strictIntersectUFM_C f (UFM x) (UFM y) = UFM (MS.intersectionWith f x y) disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool disjointUFM (UFM x) (UFM y) = M.disjoint x y diff --git a/GHC/Types/Unique/Set.hs b/GHC/Types/Unique/Set.hs --- a/GHC/Types/Unique/Set.hs +++ b/GHC/Types/Unique/Set.hs @@ -21,14 +21,12 @@ emptyUniqSet, unitUniqSet, mkUniqSet, - addOneToUniqSet, addListToUniqSet, strictAddOneToUniqSet_C, + addOneToUniqSet, addListToUniqSet, delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet, delListFromUniqSet_Directly, unionUniqSets, unionManyUniqSets, - strictUnionUniqSets_C, strictUnionManyUniqSets_C, - minusUniqSet, minusUniqSet_C, - uniqSetMinusUFM, uniqSetMinusUDFM, - intersectUniqSets, strictIntersectUniqSets_C, + minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM, + intersectUniqSets, disjointUniqSets, restrictUniqSetToUFM, uniqSetAny, uniqSetAll, @@ -112,10 +110,6 @@ addListToUniqSet = foldl' addOneToUniqSet {-# INLINEABLE addListToUniqSet #-} -strictAddOneToUniqSet_C :: Uniquable a => (a -> a -> a) -> UniqSet a -> a -> UniqSet a -strictAddOneToUniqSet_C f (UniqSet set) x = - UniqSet (strictAddToUFM_C f set x x) - delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) @@ -134,28 +128,14 @@ unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) -strictUnionUniqSets_C :: (a -> a -> a) -> UniqSet a -> UniqSet a -> UniqSet a -strictUnionUniqSets_C f (UniqSet s) (UniqSet t) = - UniqSet (strictPlusUFM_C f s t) - unionManyUniqSets :: [UniqSet a] -> UniqSet a unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet -strictUnionManyUniqSets_C :: (a -> a -> a) -> [UniqSet a] -> UniqSet a -strictUnionManyUniqSets_C f = foldl' (flip (strictUnionUniqSets_C f)) emptyUniqSet - minusUniqSet :: UniqSet a -> UniqSet a -> UniqSet a minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t) -minusUniqSet_C :: (a -> a -> Maybe a) -> UniqSet a -> UniqSet a -> UniqSet a -minusUniqSet_C f (UniqSet s) (UniqSet t) = UniqSet (minusUFM_C f s t) - intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t) - -strictIntersectUniqSets_C :: (a -> a -> a) -> UniqSet a -> UniqSet a -> UniqSet a -strictIntersectUniqSets_C f (UniqSet s) (UniqSet t) = - UniqSet (strictIntersectUFM_C f s t) disjointUniqSets :: UniqSet a -> UniqSet a -> Bool disjointUniqSets (UniqSet s) (UniqSet t) = disjointUFM s t diff --git a/GHC/Types/Var.hs b/GHC/Types/Var.hs --- a/GHC/Types/Var.hs +++ b/GHC/Types/Var.hs @@ -40,12 +40,12 @@ TyVar, TcTyVar, TypeVar, KindVar, TKVar, TyCoVar, -- * In and Out variants - InVar, InCoVar, InId, InTyVar, - OutVar, OutCoVar, OutId, OutTyVar, + InVar, InCoVar, InId, InTyVar, InTyCoVar, + OutVar, OutCoVar, OutId, OutTyVar, OutTyCoVar, -- ** Taking 'Var's apart varName, varUnique, varType, - varMult, varMultMaybe, + varMultMaybe, idMult, -- ** Modifying 'Var's setVarName, setVarUnique, setVarType, @@ -82,7 +82,8 @@ -- * PiTyBinder PiTyBinder(..), PiTyVarBinder, - isInvisiblePiTyBinder, isVisiblePiTyBinder, + isInvisiblePiTyBinder, isInvisibleAnonPiTyBinder, + isVisiblePiTyBinder, isTyBinder, isNamedPiTyBinder, isAnonPiTyBinder, namedPiTyBinder_maybe, anonPiTyBinderType_maybe, piTyBinderType, @@ -131,6 +132,7 @@ import GHC.Hs.Specificity () import Language.Haskell.Syntax.Specificity +import Control.DeepSeq import Data.Data @@ -204,10 +206,12 @@ type InVar = Var type InTyVar = TyVar type InCoVar = CoVar +type InTyCoVar = TyCoVar type InId = Id type OutVar = Var type OutTyVar = TyVar type OutCoVar = CoVar +type OutTyCoVar = TyCoVar type OutId = Id @@ -416,6 +420,10 @@ varMultMaybe (Id { varMult = mult }) = Just mult varMultMaybe _ = Nothing +idMult :: HasDebugCallStack => Id -> Mult +idMult (Id { varMult = mult }) = mult +idMult non_id = pprPanic "idMult" (ppr non_id) + setVarUnique :: Var -> Unique -> Var setVarUnique var uniq = var { realUnique = uniq, @@ -492,6 +500,12 @@ 2 -> return FTF_C_T _ -> return FTF_C_C +instance NFData FunTyFlag where + rnf FTF_T_T = () + rnf FTF_T_C = () + rnf FTF_C_T = () + rnf FTF_C_C = () + mkFunTyFlag :: TypeOrConstraint -> TypeOrConstraint -> FunTyFlag mkFunTyFlag TypeLike torc = visArg torc mkFunTyFlag ConstraintLike torc = invisArg torc @@ -558,11 +572,11 @@ False True FTF_T_C True False FTF_C_T True True FTF_C_C -where isPredTy is defined in GHC.Core.Type, and sees if t1's +where isPredTy is defined in GHC.Core.Predicate, and sees if t1's kind is Constraint. See GHC.Core.Type.chooseFunTyFlag, and -GHC.Core.TyCo.Rep Note [Types for coercions, predicates, and evidence] +GHC.Core.Predicate Note [Types for coercions, predicates, and evidence] -The term (Lam b e) donesn't carry an FunTyFlag; instead it uses +The term (Lam b e) doesn't carry an FunTyFlag; instead it uses mkFunctionType when we want to get its types; see mkLamType. This is just an engineering choice; we could cache here too if we wanted. @@ -727,6 +741,9 @@ get bh = do { tv <- get bh; vis <- get bh; return (Bndr tv vis) } +instance (NFData tv, NFData vis) => NFData (VarBndr tv vis) where + rnf (Bndr tv vis) = rnf tv `seq` rnf vis + instance NamedThing tv => NamedThing (VarBndr tv flag) where getName (Bndr tv _) = getName tv @@ -752,7 +769,6 @@ ppr (Named (Bndr v Specified)) = char '@' <> ppr v ppr (Named (Bndr v Inferred)) = braces (ppr v) - -- | 'PiTyVarBinder' is like 'PiTyBinder', but there can only be 'TyVar' -- in the 'Named' field. type PiTyVarBinder = PiTyBinder @@ -762,6 +778,10 @@ isInvisiblePiTyBinder (Named (Bndr _ vis)) = isInvisibleForAllTyFlag vis isInvisiblePiTyBinder (Anon _ af) = isInvisibleFunArg af +isInvisibleAnonPiTyBinder :: PiTyBinder -> Bool +isInvisibleAnonPiTyBinder (Named {}) = False +isInvisibleAnonPiTyBinder (Anon _ af) = isInvisibleFunArg af + -- | Does this binder bind a visible argument? isVisiblePiTyBinder :: PiTyBinder -> Bool isVisiblePiTyBinder = not . isInvisiblePiTyBinder @@ -1054,7 +1074,7 @@ idInfo (Id { id_info = info }) = info idInfo other = pprPanic "idInfo" (ppr other) -idDetails :: Id -> IdDetails +idDetails :: HasCallStack => Id -> IdDetails idDetails (Id { id_details = details }) = details idDetails other = pprPanic "idDetails" (ppr other) diff --git a/GHC/Types/Var.hs-boot b/GHC/Types/Var.hs-boot --- a/GHC/Types/Var.hs-boot +++ b/GHC/Types/Var.hs-boot @@ -2,7 +2,7 @@ module GHC.Types.Var where import {-# SOURCE #-} GHC.Types.Name -import Language.Haskell.Syntax.Specificity (Specificity) +import Language.Haskell.Syntax.Specificity (Specificity, ForAllTyFlag) data FunTyFlag data Var @@ -13,3 +13,4 @@ type TyCoVar = Id type TcTyVar = Var type InvisTVBinder = VarBndr TyVar Specificity +type TyVarBinder = VarBndr TyVar ForAllTyFlag diff --git a/GHC/Types/Var/Env.hs b/GHC/Types/Var/Env.hs --- a/GHC/Types/Var/Env.hs +++ b/GHC/Types/Var/Env.hs @@ -12,8 +12,7 @@ elemVarEnv, disjointVarEnv, anyVarEnv, extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList, - strictPlusVarEnv, plusVarEnv, plusVarEnv_C, strictPlusVarEnv_C, - plusVarEnv_CD, plusMaybeVarEnv_C, + plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C, plusVarEnvList, alterVarEnv, delVarEnvList, delVarEnv, minusVarEnv, @@ -75,7 +74,8 @@ -- * TidyEnv and its operation TidyEnv, - emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList + emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList, + mapMaybeDVarEnv ) where import GHC.Prelude @@ -511,7 +511,6 @@ extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a -strictPlusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a plusVarEnvList :: [VarEnv a] -> VarEnv a extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a varEnvDomain :: VarEnv elt -> UnVarSet @@ -519,11 +518,10 @@ partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a) -- | Only keep variables contained in the VarSet restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a -delVarEnvList :: VarEnv a -> [Var] -> VarEnv a +delVarEnvList :: Foldable f => VarEnv a -> f Var -> VarEnv a delVarEnv :: VarEnv a -> Var -> VarEnv a minusVarEnv :: VarEnv a -> VarEnv b -> VarEnv a plusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a -strictPlusVarEnv_C :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a plusVarEnv_CD :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a mapVarEnv :: (a -> b) -> VarEnv a -> VarEnv b @@ -550,14 +548,14 @@ extendVarEnv_Acc = addToUFM_Acc extendVarEnvList = addListToUFM plusVarEnv_C = plusUFM_C -strictPlusVarEnv_C = strictPlusUFM_C plusVarEnv_CD = plusUFM_CD plusMaybeVarEnv_C = plusMaybeUFM_C delVarEnvList = delListFromUFM +-- INLINE due to polymorphism +{-# INLINE delVarEnvList #-} delVarEnv = delFromUFM minusVarEnv = minusUFM plusVarEnv = plusUFM -strictPlusVarEnv = strictPlusUFM plusVarEnvList = plusUFMList -- lookupVarEnv is very hot (in part due to being called by substTyVar), -- if it's not inlined than the mere allocation of the Just constructor causes @@ -584,7 +582,7 @@ where keep u _ = u `elemVarSetByKey` vs -zipVarEnv tyvars tys = mkVarEnv (zipEqual "zipVarEnv" tyvars tys) +zipVarEnv tyvars tys = mkVarEnv (zipEqual tyvars tys) lookupVarEnv_NF env id = case lookupVarEnv env id of Just xx -> xx Nothing -> panic "lookupVarEnv_NF: Nothing" @@ -658,6 +656,9 @@ filterDVarEnv :: (a -> Bool) -> DVarEnv a -> DVarEnv a filterDVarEnv = filterUDFM + +mapMaybeDVarEnv :: (a -> Maybe b) -> DVarEnv a -> DVarEnv b +mapMaybeDVarEnv f = mapMaybeUDFM f alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a alterDVarEnv = alterUDFM diff --git a/GHC/Unit/Env.hs b/GHC/Unit/Env.hs --- a/GHC/Unit/Env.hs +++ b/GHC/Unit/Env.hs @@ -1,89 +1,162 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} + +-- | A 'UnitEnv' provides the complete interface into everything that is loaded +-- into a GHC session, including the 'HomeUnitGraph' for mapping home units to their +-- 'HomePackageTable's (which store information about all home modules), and +-- the 'ExternalPackageState' which provides access to all external packages +-- loaded. +-- +-- This module is meant to be imported as @UnitEnv@ when calling @insertHpt@: +-- +-- @ +-- import GHC.Unit.Env (UnitEnv, HomeUnitGraph, HomeUnitEnv) +-- import GHC.Unit.Env as UnitEnv +-- @ +-- +-- Here is an overview of how the UnitEnv, ModuleGraph, HUG, HPT, and EPS interact: +-- +-- @ +-- ┌────────────────┐┌────────────────────┐┌───────────┐ +-- │HomePackageTable││ExternalPackageState││ModuleGraph│ +-- └┬───────────────┘└┬───────────────────┘└┬──────────┘ +-- ┌▽────────────┐ │ │ +-- │HomeUnitGraph│ │ │ +-- └┬────────────┘ │ │ +-- ┌▽─────────────────▽─────────────────────▽┐ +-- │UnitEnv │ +-- └┬─────────────-──────────────────────────┘ +-- │ +-- │ +-- ┌▽──────────────────────────────────────▽┐ +-- │HscEnv │ +-- └────────────────────────────────────────┘ +-- @ +-- +-- The 'UnitEnv' references the 'HomeUnitGraph' (with all the home unit +-- modules), the 'ExternalPackageState' (information about all +-- non-home/external units), and the 'ModuleGraph' (which describes the +-- relationship between the modules being compiled). +-- The 'HscEnv' references this 'UnitEnv'. +-- The 'HomeUnitGraph' has one 'HomePackageTable' for every unit. module GHC.Unit.Env ( UnitEnv (..) , initUnitEnv - , ueEPS - , unsafeGetHomeUnit + , ueEPS -- Not really needed, get directly type families and rule base! , updateHug - , updateHpt_lazy - , updateHpt -- * Unit Env helper functions - , ue_units , ue_currentHomeUnitEnv - , ue_setUnits - , ue_setUnitFlags - , ue_unit_dbs - , ue_all_home_unit_ids - , ue_setUnitDbs , ue_hpt - , ue_homeUnit - , ue_unsafeHomeUnit - , ue_setFlags , ue_setActiveUnit , ue_currentUnit , ue_findHomeUnitEnv - , ue_updateHomeUnitEnv , ue_unitHomeUnit - , ue_unitFlags - , ue_renameUnitId - , ue_transitiveHomeDeps - -- * HomeUnitEnv + , ue_unitHomeUnit_maybe + , ue_updateHomeUnitEnv + , ue_all_home_unit_ids + , ue_unsafeHomeUnit + + -- * HUG Re-export , HomeUnitGraph , HomeUnitEnv (..) - , mkHomeUnitEnv - , lookupHugByModule - , hugElts - , lookupHug - , addHomeModInfoToHug - -- * UnitEnvGraph - , UnitEnvGraph (..) - , UnitEnvGraphKey - , unitEnv_insert - , unitEnv_delete - , unitEnv_adjust - , unitEnv_new - , unitEnv_singleton - , unitEnv_map - , unitEnv_member - , unitEnv_lookup_maybe - , unitEnv_lookup - , unitEnv_keys - , unitEnv_elts - , unitEnv_hpts - , unitEnv_foldWithKey - , unitEnv_union - , unitEnv_mapWithKey + -- * Invariants , assertUnitEnvInvariant -- * Preload units info , preloadUnitsInfo , preloadUnitsInfo' -- * Home Module functions - , isUnitEnvInstalledModule ) + , isUnitEnvInstalledModule + + -------------------------------------------------------------------------------- + -- WIP above + -------------------------------------------------------------------------------- + + -- * Operations on the UnitEnv + , renameUnitId + + -- ** Modifying the current active home unit + , insertHpt + , ue_setFlags + + -- * Queries + + -- ** Queries on the current active home unit + , ue_homeUnitState + , ue_unit_dbs + , ue_homeUnit + , ue_unitFlags + + -- ** Reachability + , ue_transitiveHomeDeps + + -------------------------------------------------------------------------------- + -- Harder queries for the whole UnitEnv + -------------------------------------------------------------------------------- + + -- ** Instances, rules, type fams, annotations, etc.. + -- + -- | The @hug@ prefix means the function returns only things found in home + -- units. + , hugCompleteSigs + , hugAllInstances + , hugAllAnns + + -- * Legacy API + -- + -- | This API is deprecated! + , ue_units + ) where import GHC.Prelude +import qualified Data.Set as Set import GHC.Unit.External import GHC.Unit.State import GHC.Unit.Home import GHC.Unit.Types import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable +import GHC.Unit.Home.Graph (HomeUnitGraph, HomeUnitEnv) +import qualified GHC.Unit.Home.Graph as HUG +import GHC.Unit.Module.Graph import GHC.Platform import GHC.Settings import GHC.Data.Maybe -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map import GHC.Utils.Misc (HasDebugCallStack) import GHC.Driver.DynFlags import GHC.Utils.Outputable import GHC.Utils.Panic -import GHC.Unit.Module.ModIface -import GHC.Unit.Module -import qualified Data.Set as Set +import GHC.Types.Annotations +import GHC.Types.CompleteMatch +import GHC.Core.InstEnv +import GHC.Core.FamInstEnv + +-------------------------------------------------------------------------------- +-- The hard queries +-------------------------------------------------------------------------------- + +-- | Find all the instance declarations (of classes and families) from +-- the Home Package Table filtered by the provided predicate function. +hugAllInstances :: UnitEnv -> IO (InstEnv, [FamInst]) +hugAllInstances = HUG.allInstances . ue_home_unit_graph + +-- | Find all the annotations in all home units +hugAllAnns :: UnitEnv -> IO AnnEnv +hugAllAnns = HUG.allAnns . ue_home_unit_graph + +-- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present across +-- all home units. +hugCompleteSigs :: UnitEnv -> IO CompleteMatches +hugCompleteSigs = HUG.allCompleteSigs . ue_home_unit_graph + +-------------------------------------------------------------------------------- +-- UnitEnv +-------------------------------------------------------------------------------- + data UnitEnv = UnitEnv { ue_eps :: {-# UNPACK #-} !ExternalUnitCache -- ^ Information about the currently loaded external packages. @@ -92,6 +165,10 @@ , ue_current_unit :: UnitId + , ue_module_graph :: ModuleGraph + -- ^ The module graph of the current session + -- See Note [Downsweep and the ModuleGraph] for when this is constructed. + , ue_home_unit_graph :: !HomeUnitGraph -- See Note [Multiple Home Units] @@ -111,39 +188,18 @@ return $ UnitEnv { ue_eps = eps , ue_home_unit_graph = hug + , ue_module_graph = emptyMG , ue_current_unit = cur_unit , ue_platform = platform , ue_namever = namever } --- | Get home-unit --- --- Unsafe because the home-unit may not be set -unsafeGetHomeUnit :: UnitEnv -> HomeUnit -unsafeGetHomeUnit ue = ue_unsafeHomeUnit ue - -updateHpt_lazy :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv -updateHpt_lazy = ue_updateHPT_lazy - -updateHpt :: (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv -updateHpt = ue_updateHPT - updateHug :: (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv updateHug = ue_updateHUG -ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId] -ue_transitiveHomeDeps uid unit_env = Set.toList (loop Set.empty [uid]) - where - loop acc [] = acc - loop acc (uid:uids) - | uid `Set.member` acc = loop acc uids - | otherwise = - let hue = homeUnitDepends (homeUnitEnv_units (ue_findHomeUnitEnv uid unit_env)) - in loop (Set.insert uid acc) (hue ++ uids) - - -- ----------------------------------------------------------------------------- -- Extracting information from the packages in scope +-- ----------------------------------------------------------------------------- -- Many of these functions take a list of packages: in those cases, -- the list is expected to contain the "dependent packages", @@ -159,7 +215,7 @@ preloadUnitsInfo' :: UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo] preloadUnitsInfo' unit_env ids0 = all_infos where - unit_state = ue_units unit_env + unit_state = HUG.homeUnitEnv_units (ue_currentHomeUnitEnv unit_env) ids = ids0 ++ inst_ids inst_ids = case ue_homeUnit unit_env of Nothing -> [] @@ -181,226 +237,50 @@ preloadUnitsInfo :: UnitEnv -> MaybeErr UnitErr [UnitInfo] preloadUnitsInfo unit_env = preloadUnitsInfo' unit_env [] --- ----------------------------------------------------------------------------- - -data HomeUnitEnv = HomeUnitEnv - { homeUnitEnv_units :: !UnitState - -- ^ External units - - , homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId]) - -- ^ Stack of unit databases for the target platform. - -- - -- This field is populated with the result of `initUnits`. - -- - -- 'Nothing' means the databases have never been read from disk. - -- - -- Usually we don't reload the databases from disk if they are - -- cached, even if the database flags changed! - - , homeUnitEnv_dflags :: DynFlags - -- ^ The dynamic flag settings - , homeUnitEnv_hpt :: HomePackageTable - -- ^ The home package table describes already-compiled - -- home-package modules, /excluding/ the module we - -- are compiling right now. - -- (In one-shot mode the current module is the only - -- home-package module, so homeUnitEnv_hpt is empty. All other - -- modules count as \"external-package\" modules. - -- However, even in GHCi mode, hi-boot interfaces are - -- demand-loaded into the external-package table.) - -- - -- 'homeUnitEnv_hpt' is not mutable because we only demand-load - -- external packages; the home package is eagerly - -- loaded, module by module, by the compilation manager. - -- - -- The HPT may contain modules compiled earlier by @--make@ - -- but not actually below the current module in the dependency - -- graph. - -- - -- (This changes a previous invariant: changed Jan 05.) - - , homeUnitEnv_home_unit :: !(Maybe HomeUnit) - -- ^ Home-unit - } - -instance Outputable HomeUnitEnv where - ppr hug = pprHPT (homeUnitEnv_hpt hug) - -homeUnitEnv_unsafeHomeUnit :: HomeUnitEnv -> HomeUnit -homeUnitEnv_unsafeHomeUnit hue = case homeUnitEnv_home_unit hue of - Nothing -> panic "homeUnitEnv_unsafeHomeUnit: No home unit" - Just h -> h - -mkHomeUnitEnv :: DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv -mkHomeUnitEnv dflags hpt home_unit = HomeUnitEnv - { homeUnitEnv_units = emptyUnitState - , homeUnitEnv_unit_dbs = Nothing - , homeUnitEnv_dflags = dflags - , homeUnitEnv_hpt = hpt - , homeUnitEnv_home_unit = home_unit - } - --- | Test if the module comes from the home unit +-- -- | Test if the module comes from the home unit isUnitEnvInstalledModule :: UnitEnv -> InstalledModule -> Bool isUnitEnvInstalledModule ue m = maybe False (`isHomeInstalledModule` m) hu where hu = ue_unitHomeUnit_maybe (moduleUnit m) ue - -type HomeUnitGraph = UnitEnvGraph HomeUnitEnv - -lookupHugByModule :: Module -> HomeUnitGraph -> Maybe HomeModInfo -lookupHugByModule mod hug - | otherwise = do - env <- (unitEnv_lookup_maybe (toUnitId $ moduleUnit mod) hug) - lookupHptByModule (homeUnitEnv_hpt env) mod - -hugElts :: HomeUnitGraph -> [(UnitId, HomeUnitEnv)] -hugElts hug = unitEnv_elts hug - -addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> HomeUnitGraph -addHomeModInfoToHug hmi hug = unitEnv_alter go hmi_unit hug - where - hmi_mod :: Module - hmi_mod = mi_module (hm_iface hmi) - - hmi_unit = toUnitId (moduleUnit hmi_mod) - _hmi_mn = moduleName hmi_mod - - go :: Maybe HomeUnitEnv -> Maybe HomeUnitEnv - go Nothing = pprPanic "addHomeInfoToHug" (ppr hmi_mod) - go (Just hue) = Just (updateHueHpt (addHomeModInfoToHpt hmi) hue) - -updateHueHpt :: (HomePackageTable -> HomePackageTable) -> HomeUnitEnv -> HomeUnitEnv -updateHueHpt f hue = - let !hpt = f (homeUnitEnv_hpt hue) - in hue { homeUnitEnv_hpt = hpt } - - -lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> Maybe HomeModInfo -lookupHug hug uid mod = unitEnv_lookup_maybe uid hug >>= flip lookupHpt mod . homeUnitEnv_hpt - - -instance Outputable (UnitEnvGraph HomeUnitEnv) where - ppr g = ppr [(k, length (homeUnitEnv_hpt hue)) | (k, hue) <- (unitEnv_elts g)] - - -type UnitEnvGraphKey = UnitId - -newtype UnitEnvGraph v = UnitEnvGraph - { unitEnv_graph :: Map UnitEnvGraphKey v - } deriving (Functor, Foldable, Traversable) - -unitEnv_insert :: UnitEnvGraphKey -> v -> UnitEnvGraph v -> UnitEnvGraph v -unitEnv_insert unitId env unitEnv = unitEnv - { unitEnv_graph = Map.insert unitId env (unitEnv_graph unitEnv) - } - -unitEnv_delete :: UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v -unitEnv_delete uid unitEnv = - unitEnv - { unitEnv_graph = Map.delete uid (unitEnv_graph unitEnv) - } - -unitEnv_adjust :: (v -> v) -> UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v -unitEnv_adjust f uid unitEnv = unitEnv - { unitEnv_graph = Map.adjust f uid (unitEnv_graph unitEnv) - } - -unitEnv_alter :: (Maybe v -> Maybe v) -> UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v -unitEnv_alter f uid unitEnv = unitEnv - { unitEnv_graph = Map.alter f uid (unitEnv_graph unitEnv) - } - -unitEnv_mapWithKey :: (UnitEnvGraphKey -> v -> b) -> UnitEnvGraph v -> UnitEnvGraph b -unitEnv_mapWithKey f (UnitEnvGraph u) = UnitEnvGraph $ Map.mapWithKey f u - -unitEnv_new :: Map UnitEnvGraphKey v -> UnitEnvGraph v -unitEnv_new m = - UnitEnvGraph - { unitEnv_graph = m - } - -unitEnv_singleton :: UnitEnvGraphKey -> v -> UnitEnvGraph v -unitEnv_singleton active m = UnitEnvGraph - { unitEnv_graph = Map.singleton active m - } - -unitEnv_map :: (v -> v) -> UnitEnvGraph v -> UnitEnvGraph v -unitEnv_map f m = m { unitEnv_graph = Map.map f (unitEnv_graph m)} - -unitEnv_member :: UnitEnvGraphKey -> UnitEnvGraph v -> Bool -unitEnv_member u env = Map.member u (unitEnv_graph env) - -unitEnv_lookup_maybe :: UnitEnvGraphKey -> UnitEnvGraph v -> Maybe v -unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) - -unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v -unitEnv_lookup u env = fromJust $ unitEnv_lookup_maybe u env - -unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey -unitEnv_keys env = Map.keysSet (unitEnv_graph env) - -unitEnv_elts :: UnitEnvGraph v -> [(UnitEnvGraphKey, v)] -unitEnv_elts env = Map.toList (unitEnv_graph env) - -unitEnv_hpts :: UnitEnvGraph HomeUnitEnv -> [HomePackageTable] -unitEnv_hpts env = map homeUnitEnv_hpt (Map.elems (unitEnv_graph env)) - -unitEnv_foldWithKey :: (b -> UnitEnvGraphKey -> a -> b) -> b -> UnitEnvGraph a -> b -unitEnv_foldWithKey f z (UnitEnvGraph g)= Map.foldlWithKey' f z g +-- ------------------------------------------------------- +-- Operations on arbitrary elements of the home unit graph +-- ------------------------------------------------------- -unitEnv_union :: (a -> a -> a) -> UnitEnvGraph a -> UnitEnvGraph a -> UnitEnvGraph a -unitEnv_union f (UnitEnvGraph env1) (UnitEnvGraph env2) = UnitEnvGraph (Map.unionWith f env1 env2) +ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv +ue_findHomeUnitEnv uid e = case HUG.lookupHugUnitId uid (ue_home_unit_graph e) of + Nothing -> pprPanic "Unit unknown to the internal unit environment" + $ text "unit (" <> ppr uid <> text ")" + $$ ppr (HUG.allUnits (ue_home_unit_graph e)) + Just hue -> hue -- ------------------------------------------------------- --- Query and modify UnitState in HomeUnitEnv +-- Query and modify UnitState of active unit in HomeUnitEnv -- ------------------------------------------------------- -ue_units :: HasDebugCallStack => UnitEnv -> UnitState -ue_units = homeUnitEnv_units . ue_currentHomeUnitEnv - -ue_setUnits :: UnitState -> UnitEnv -> UnitEnv -ue_setUnits units ue = ue_updateHomeUnitEnv f (ue_currentUnit ue) ue - where - f hue = hue { homeUnitEnv_units = units } +ue_homeUnitState :: HasDebugCallStack => UnitEnv -> UnitState +ue_homeUnitState = HUG.homeUnitEnv_units . ue_currentHomeUnitEnv ue_unit_dbs :: UnitEnv -> Maybe [UnitDatabase UnitId] -ue_unit_dbs = homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv - -ue_setUnitDbs :: Maybe [UnitDatabase UnitId] -> UnitEnv -> UnitEnv -ue_setUnitDbs unit_dbs ue = ue_updateHomeUnitEnv f (ue_currentUnit ue) ue - where - f hue = hue { homeUnitEnv_unit_dbs = unit_dbs } +ue_unit_dbs = HUG.homeUnitEnv_unit_dbs . ue_currentHomeUnitEnv -- ------------------------------------------------------- -- Query and modify Home Package Table in HomeUnitEnv -- ------------------------------------------------------- +-- | Get the /current home unit/'s package table ue_hpt :: HasDebugCallStack => UnitEnv -> HomePackageTable -ue_hpt = homeUnitEnv_hpt . ue_currentHomeUnitEnv - -ue_updateHPT_lazy :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv -ue_updateHPT_lazy f e = ue_updateUnitHPT_lazy f (ue_currentUnit e) e +ue_hpt = HUG.homeUnitEnv_hpt . ue_currentHomeUnitEnv -ue_updateHPT :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitEnv -> UnitEnv -ue_updateHPT f e = ue_updateUnitHPT f (ue_currentUnit e) e +-- | Inserts a 'HomeModInfo' at the given 'ModuleName' on the +-- 'HomePackageTable' of the /current unit/ being compiled. +insertHpt :: HasDebugCallStack => HomeModInfo -> UnitEnv -> IO () +insertHpt hmi e = do + HUG.addHomeModInfoToHug hmi (ue_home_unit_graph e) ue_updateHUG :: HasDebugCallStack => (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv ue_updateHUG f e = ue_updateUnitHUG f e -ue_updateUnitHPT_lazy :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitId -> UnitEnv -> UnitEnv -ue_updateUnitHPT_lazy f uid ue_env = ue_updateHomeUnitEnv update uid ue_env - where - update unitEnv = unitEnv { homeUnitEnv_hpt = f $ homeUnitEnv_hpt unitEnv } - -ue_updateUnitHPT :: HasDebugCallStack => (HomePackageTable -> HomePackageTable) -> UnitId -> UnitEnv -> UnitEnv -ue_updateUnitHPT f uid ue_env = ue_updateHomeUnitEnv update uid ue_env - where - update unitEnv = - let !res = f $ homeUnitEnv_hpt unitEnv - in unitEnv { homeUnitEnv_hpt = res } - ue_updateUnitHUG :: HasDebugCallStack => (HomeUnitGraph -> HomeUnitGraph) -> UnitEnv -> UnitEnv ue_updateUnitHUG f ue_env = ue_env { ue_home_unit_graph = f (ue_home_unit_graph ue_env)} @@ -408,52 +288,48 @@ -- Query and modify DynFlags in HomeUnitEnv -- ------------------------------------------------------- -ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv -ue_setFlags dflags ue_env = ue_setUnitFlags (ue_currentUnit ue_env) dflags ue_env - -ue_setUnitFlags :: HasDebugCallStack => UnitId -> DynFlags -> UnitEnv -> UnitEnv -ue_setUnitFlags uid dflags e = - ue_updateUnitFlags (const dflags) uid e - ue_unitFlags :: HasDebugCallStack => UnitId -> UnitEnv -> DynFlags -ue_unitFlags uid ue_env = homeUnitEnv_dflags $ ue_findHomeUnitEnv uid ue_env +ue_unitFlags uid ue_env = HUG.homeUnitEnv_dflags $ ue_findHomeUnitEnv uid ue_env -ue_updateUnitFlags :: HasDebugCallStack => (DynFlags -> DynFlags) -> UnitId -> UnitEnv -> UnitEnv -ue_updateUnitFlags f uid e = ue_updateHomeUnitEnv update uid e - where - update hue = hue { homeUnitEnv_dflags = f $ homeUnitEnv_dflags hue } +-- | Sets the 'DynFlags' of the /current unit/ being compiled to the given ones +ue_setFlags :: HasDebugCallStack => DynFlags -> UnitEnv -> UnitEnv +ue_setFlags dflags env = + env + { ue_home_unit_graph = HUG.updateUnitFlags + (ue_currentUnit env) + (const dflags) + (ue_home_unit_graph env) + } -- ------------------------------------------------------- -- Query and modify home units in HomeUnitEnv -- ------------------------------------------------------- ue_homeUnit :: UnitEnv -> Maybe HomeUnit -ue_homeUnit = homeUnitEnv_home_unit . ue_currentHomeUnitEnv +ue_homeUnit = HUG.homeUnitEnv_home_unit . ue_currentHomeUnitEnv ue_unsafeHomeUnit :: UnitEnv -> HomeUnit ue_unsafeHomeUnit ue = case ue_homeUnit ue of - Nothing -> panic "unsafeGetHomeUnit: No home unit" + Nothing -> panic "ue_unsafeHomeUnit: No home unit" Just h -> h +ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit +ue_unitHomeUnit uid = expectJust . ue_unitHomeUnit_maybe uid + ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit ue_unitHomeUnit_maybe uid ue_env = - homeUnitEnv_unsafeHomeUnit <$> (ue_findHomeUnitEnv_maybe uid ue_env) - -ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit -ue_unitHomeUnit uid ue_env = homeUnitEnv_unsafeHomeUnit $ ue_findHomeUnitEnv uid ue_env + HUG.homeUnitEnv_home_unit =<< HUG.lookupHugUnitId uid (ue_home_unit_graph ue_env) -ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId -ue_all_home_unit_ids = unitEnv_keys . ue_home_unit_graph -- ------------------------------------------------------- -- Query and modify the currently active unit -- ------------------------------------------------------- ue_currentHomeUnitEnv :: HasDebugCallStack => UnitEnv -> HomeUnitEnv ue_currentHomeUnitEnv e = - case ue_findHomeUnitEnv_maybe (ue_currentUnit e) e of + case HUG.lookupHugUnitId (ue_currentUnit e) (ue_home_unit_graph e) of Just unitEnv -> unitEnv Nothing -> pprPanic "packageNotFound" $ - (ppr $ ue_currentUnit e) $$ ppr (ue_home_unit_graph e) + (ppr $ ue_currentUnit e) $$ ppr (HUG.allUnits (ue_home_unit_graph e)) ue_setActiveUnit :: UnitId -> UnitEnv -> UnitEnv ue_setActiveUnit u ue_env = assertUnitEnvInvariant $ ue_env @@ -464,84 +340,75 @@ ue_currentUnit = ue_current_unit --- ------------------------------------------------------- --- Operations on arbitrary elements of the home unit graph --- ------------------------------------------------------- - -ue_findHomeUnitEnv_maybe :: UnitId -> UnitEnv -> Maybe HomeUnitEnv -ue_findHomeUnitEnv_maybe uid e = - unitEnv_lookup_maybe uid (ue_home_unit_graph e) - -ue_findHomeUnitEnv :: HasDebugCallStack => UnitId -> UnitEnv -> HomeUnitEnv -ue_findHomeUnitEnv uid e = case unitEnv_lookup_maybe uid (ue_home_unit_graph e) of - Nothing -> pprPanic "Unit unknown to the internal unit environment" - $ text "unit (" <> ppr uid <> text ")" - $$ pprUnitEnvGraph e - Just hue -> hue - ue_updateHomeUnitEnv :: (HomeUnitEnv -> HomeUnitEnv) -> UnitId -> UnitEnv -> UnitEnv ue_updateHomeUnitEnv f uid e = e - { ue_home_unit_graph = unitEnv_adjust f uid $ ue_home_unit_graph e + { ue_home_unit_graph = HUG.unitEnv_adjust f uid $ ue_home_unit_graph e } +ue_all_home_unit_ids :: UnitEnv -> Set.Set UnitId +ue_all_home_unit_ids = HUG.allUnits . ue_home_unit_graph -- | Rename a unit id in the internal unit env. -- --- @'ue_renameUnitId' oldUnit newUnit UnitEnv@, it is assumed that the 'oldUnit' exists in the map, +-- @'renameUnitId' oldUnit newUnit UnitEnv@, it is assumed that the 'oldUnit' exists in the home units map, -- otherwise we panic. -- The 'DynFlags' associated with the home unit will have its field 'homeUnitId' set to 'newUnit'. -ue_renameUnitId :: HasDebugCallStack => UnitId -> UnitId -> UnitEnv -> UnitEnv -ue_renameUnitId oldUnit newUnit unitEnv = case ue_findHomeUnitEnv_maybe oldUnit unitEnv of - Nothing -> - pprPanic "Tried to rename unit, but it didn't exist" - $ text "Rename old unit \"" <> ppr oldUnit <> text "\" to \""<> ppr newUnit <> text "\"" - $$ nest 2 (pprUnitEnvGraph unitEnv) - Just oldEnv -> - let - activeUnit :: UnitId - !activeUnit = if ue_currentUnit unitEnv == oldUnit - then newUnit - else ue_currentUnit unitEnv +renameUnitId :: HasDebugCallStack => UnitId -> UnitId -> UnitEnv -> UnitEnv +renameUnitId oldUnit newUnit unitEnv = + case HUG.renameUnitId oldUnit newUnit (ue_home_unit_graph unitEnv) of + Nothing -> + pprPanic "Tried to rename unit, but it didn't exist" + $ text "Rename old unit \"" <> ppr oldUnit <> text "\" to \""<> ppr newUnit <> text "\"" + $$ nest 2 (ppr $ HUG.allUnits (ue_home_unit_graph unitEnv)) + Just newHug -> + let + activeUnit :: UnitId + !activeUnit = if ue_currentUnit unitEnv == oldUnit + then newUnit + else ue_currentUnit unitEnv - newInternalUnitEnv = oldEnv - { homeUnitEnv_dflags = (homeUnitEnv_dflags oldEnv) - { homeUnitId_ = newUnit - } + in + unitEnv + { ue_current_unit = activeUnit + , ue_home_unit_graph = + HUG.updateUnitFlags + newUnit + (\df -> df{ homeUnitId_ = newUnit }) + newHug } - in - unitEnv - { ue_current_unit = activeUnit - , ue_home_unit_graph = - unitEnv_insert newUnit newInternalUnitEnv - $ unitEnv_delete oldUnit - $ ue_home_unit_graph unitEnv - } -- --------------------------------------------- +-- Transitive closure +-- --------------------------------------------- + +ue_transitiveHomeDeps :: UnitId -> UnitEnv -> [UnitId] +ue_transitiveHomeDeps uid e = + case HUG.transitiveHomeDeps uid (ue_home_unit_graph e) of + Nothing -> pprPanic "Unit unknown to the internal unit environment" + $ text "unit (" <> ppr uid <> text ")" + $$ ppr (HUG.allUnits $ ue_home_unit_graph e) + Just deps -> deps + +-- --------------------------------------------- -- Asserts to enforce invariants for the UnitEnv -- --------------------------------------------- +-- FIXME: Shouldn't this be a proper assertion only used in debug mode? assertUnitEnvInvariant :: HasDebugCallStack => UnitEnv -> UnitEnv assertUnitEnvInvariant u = - if ue_current_unit u `unitEnv_member` ue_home_unit_graph u - then u - else pprPanic "invariant" (ppr (ue_current_unit u) $$ ppr (ue_home_unit_graph u)) + case HUG.lookupHugUnitId (ue_current_unit u) (ue_home_unit_graph u) of + Just _ -> u + Nothing -> + pprPanic "invariant" (ppr (ue_current_unit u) $$ ppr (HUG.allUnits (ue_home_unit_graph u))) -- ----------------------------------------------------------------------------- -- Pretty output functions -- ----------------------------------------------------------------------------- -pprUnitEnvGraph :: UnitEnv -> SDoc -pprUnitEnvGraph env = text "pprInternalUnitMap" - $$ nest 2 (pprHomeUnitGraph $ ue_home_unit_graph env) - -pprHomeUnitGraph :: HomeUnitGraph -> SDoc -pprHomeUnitGraph unitEnv = vcat (map (\(k, v) -> pprHomeUnitEnv k v) $ Map.assocs $ unitEnv_graph unitEnv) - -pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> SDoc -pprHomeUnitEnv uid env = - ppr uid <+> text "(flags:" <+> ppr (homeUnitId_ $ homeUnitEnv_dflags env) <> text "," <+> ppr (fmap homeUnitId $ homeUnitEnv_home_unit env) <> text ")" <+> text "->" - $$ nest 4 (pprHPT $ homeUnitEnv_hpt env) +-- pprUnitEnvGraph :: UnitEnv -> IO SDoc +-- pprUnitEnvGraph env = do +-- hugDoc <- HUG.pprHomeUnitGraph $ ue_home_unit_graph env +-- return $ text "pprInternalUnitMap" $$ nest 2 hugDoc {- Note [Multiple Home Units] @@ -595,3 +462,12 @@ in order to allow users to offset their own relative paths. -} + +-------------------------------------------------------------------------------- +-- * Legacy API +-------------------------------------------------------------------------------- + +{-# DEPRECATED ue_units "Renamed to ue_homeUnitState because of confusion between units(tate) and unit(s) plural" #-} +ue_units :: HasDebugCallStack => UnitEnv -> UnitState +ue_units = ue_homeUnitState + diff --git a/GHC/Unit/Finder.hs b/GHC/Unit/Finder.hs --- a/GHC/Unit/Finder.hs +++ b/GHC/Unit/Finder.hs @@ -15,6 +15,7 @@ FinderCache(..), initFinderCache, findImportedModule, + findImportedModuleWithIsBoot, findPluginModule, findExactModule, findHomeModule, @@ -36,14 +37,14 @@ import GHC.Platform.Ways -import GHC.Builtin.Names ( gHC_PRIM ) - import GHC.Data.OsPath import GHC.Unit.Env import GHC.Unit.Types import GHC.Unit.Module import GHC.Unit.Home +import GHC.Unit.Home.Graph (UnitEnvGraph) +import qualified GHC.Unit.Home.Graph as HUG import GHC.Unit.State import GHC.Unit.Finder.Types @@ -55,6 +56,7 @@ import GHC.Linker.Types import GHC.Types.PkgQual +import GHC.Types.SourceFile import GHC.Fingerprint import Data.IORef @@ -64,9 +66,9 @@ import Data.Time import qualified Data.Map as M import GHC.Driver.Env - ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env) ) import GHC.Driver.Config.Finder import qualified Data.Set as Set +import Data.List.NonEmpty ( NonEmpty (..) ) import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -86,26 +88,45 @@ -- ----------------------------------------------------------------------------- -- The finder's cache +{- +[Note: Monotonic addToFinderCache] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +addToFinderCache is only used by functions that return the cached value +if there is one, or by functions that always write an InstalledFound value. +Without multithreading it is then safe to always directly write the value +without checking the previously cached value. + +However, with multithreading, it is possible that another function has +written a value into cache between the lookup and the addToFinderCache call. +in this case we should check to not overwrite an InstalledFound with an +InstalledNotFound. +-} + initFinderCache :: IO FinderCache initFinderCache = do - mod_cache <- newIORef emptyInstalledModuleWithIsBootEnv + mod_cache <- newIORef emptyInstalledModuleEnv file_cache <- newIORef M.empty let flushFinderCaches :: UnitEnv -> IO () flushFinderCaches ue = do - atomicModifyIORef' mod_cache $ \fm -> (filterInstalledModuleWithIsBootEnv is_ext fm, ()) + atomicModifyIORef' mod_cache $ \fm -> (filterInstalledModuleEnv is_ext fm, ()) atomicModifyIORef' file_cache $ \_ -> (M.empty, ()) where - is_ext mod _ = not (isUnitEnvInstalledModule ue (gwib_mod mod)) + is_ext mod _ = not (isUnitEnvInstalledModule ue mod) - addToFinderCache :: InstalledModuleWithIsBoot -> InstalledFindResult -> IO () + addToFinderCache :: InstalledModule -> InstalledFindResult -> IO () addToFinderCache key val = - atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleWithIsBootEnv c key val, ()) + atomicModifyIORef' mod_cache $ \c -> + case (lookupInstalledModuleEnv c key, val) of + -- Don't overwrite an InstalledFound with an InstalledNotFound + -- See [Note Monotonic addToFinderCache] + (Just InstalledFound{}, InstalledNotFound{}) -> (c, ()) + _ -> (extendInstalledModuleEnv c key val, ()) - lookupFinderCache :: InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult) + lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult) lookupFinderCache key = do c <- readIORef mod_cache - return $! lookupInstalledModuleWithIsBootEnv c key + return $! lookupInstalledModuleEnv c key lookupFileCache :: FilePath -> IO Fingerprint lookupFileCache key = do @@ -137,6 +158,13 @@ in do findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) mhome_unit mod pkg_qual +findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult +findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do + res <- findImportedModule hsc_env mod pkg_qual + case (res, is_boot) of + (Found loc mod, IsBoot) -> return (Found (addBootSuffixLocn loc) mod) + _ -> return res + findImportedModuleNoHsc :: FinderCache -> FinderOpts @@ -176,7 +204,7 @@ -- Do not be smart and change this to `foldr orIfNotFound home_import hs` as -- that is not the same!! home_import is first because we need to look within ourselves -- first before looking at the packages in order. - any_home_import = foldr1 orIfNotFound (home_import: map home_pkg_import other_fopts) + any_home_import = foldr1 orIfNotFound (home_import:| map home_pkg_import other_fopts) pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg @@ -185,8 +213,8 @@ findExposedPackageModule fc fopts units mod_name NoPkgQual units = case mhome_unit of - Nothing -> ue_units ue - Just home_unit -> homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue + Nothing -> ue_homeUnitState ue + Just home_unit -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue hpt_deps :: [UnitId] hpt_deps = homeUnitDepends units other_fopts = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps @@ -195,30 +223,53 @@ -- plugin. This consults the same set of exposed packages as -- 'findImportedModule', unless @-hide-all-plugin-packages@ or -- @-plugin-package@ are specified. -findPluginModule :: FinderCache -> FinderOpts -> UnitState -> Maybe HomeUnit -> ModuleName -> IO FindResult -findPluginModule fc fopts units (Just home_unit) mod_name = +findPluginModuleNoHsc :: FinderCache -> FinderOpts -> UnitState -> Maybe HomeUnit -> ModuleName -> IO FindResult +findPluginModuleNoHsc fc fopts units (Just home_unit) mod_name = findHomeModule fc fopts home_unit mod_name `orIfNotFound` findExposedPluginPackageModule fc fopts units mod_name -findPluginModule fc fopts units Nothing mod_name = +findPluginModuleNoHsc fc fopts units Nothing mod_name = findExposedPluginPackageModule fc fopts units mod_name --- | Locate a specific 'Module'. The purpose of this function is to --- create a 'ModLocation' for a given 'Module', that is to find out --- where the files associated with this module live. It is used when --- reading the interface for a module mentioned by another interface, --- for example (a "system import"). +findPluginModule :: HscEnv -> ModuleName -> IO FindResult +findPluginModule hsc_env mod_name = do + let fc = hsc_FC hsc_env + let units = hsc_units hsc_env + let mhome_unit = hsc_home_unit_maybe hsc_env + findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env)) units mhome_unit mod_name -findExactModule :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IO InstalledFindResult -findExactModule fc fopts other_fopts unit_state mhome_unit mod = do - case mhome_unit of + +-- | A version of findExactModule which takes the exact parts of the HscEnv it needs +-- directly. +findExactModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IsBootInterface -> IO InstalledFindResult +findExactModuleNoHsc fc fopts other_fopts unit_state mhome_unit mod is_boot = do + res <- case mhome_unit of Just home_unit | isHomeInstalledModule home_unit mod -> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName mod) - | Just home_fopts <- unitEnv_lookup_maybe (moduleUnit mod) other_fopts + | Just home_fopts <- HUG.unitEnv_lookup_maybe (moduleUnit mod) other_fopts -> findInstalledHomeModule fc home_fopts (moduleUnit mod) (moduleName mod) _ -> findPackageModule fc unit_state fopts mod + case (res, is_boot) of + (InstalledFound loc, IsBoot) -> return (InstalledFound (addBootSuffixLocn loc)) + _ -> return res + +-- | Locate a specific 'Module'. The purpose of this function is to +-- create a 'ModLocation' for a given 'Module', that is to find out +-- where the files associated with this module live. It is used when +-- reading the interface for a module mentioned by another interface, +-- for example (a "system import"). +findExactModule :: HscEnv -> InstalledModule -> IsBootInterface -> IO InstalledFindResult +findExactModule hsc_env mod is_boot = do + let dflags = hsc_dflags hsc_env + let fc = hsc_FC hsc_env + let unit_state = hsc_units hsc_env + let home_unit = hsc_home_unit_maybe hsc_env + let other_fopts = initFinderOpts . homeUnitEnv_dflags <$> (hsc_HUG hsc_env) + findExactModuleNoHsc fc (initFinderOpts dflags) other_fopts unit_state home_unit mod is_boot + + -- ----------------------------------------------------------------------------- -- Helpers @@ -255,7 +306,7 @@ homeSearchCache :: FinderCache -> UnitId -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult homeSearchCache fc home_unit mod_name do_this = do let mod = mkModule home_unit mod_name - modLocationCache fc (notBoot mod) do_this + modLocationCache fc mod do_this findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult findExposedPackageModule fc fopts units mod_name mb_pkg = @@ -277,7 +328,7 @@ -- with just the location of the thing that was -- instantiated; you probably also need all of the -- implicit locations from the instances - InstalledFound loc _ -> return (Found loc m) + InstalledFound loc -> return (Found loc m) InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m) , fr_pkgs_hidden = [] @@ -312,7 +363,7 @@ , fr_unusables = [] , fr_suggestions = suggest' }) -modLocationCache :: FinderCache -> InstalledModuleWithIsBoot -> IO InstalledFindResult -> IO InstalledFindResult +modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult modLocationCache fc mod do_this = do m <- lookupFinderCache fc mod case m of @@ -322,17 +373,19 @@ addToFinderCache fc mod result return result -addModuleToFinder :: FinderCache -> ModuleWithIsBoot -> ModLocation -> IO () -addModuleToFinder fc mod loc = do - let imod = fmap toUnitId <$> mod - addToFinderCache fc imod (InstalledFound loc (gwib_mod imod)) +addModuleToFinder :: FinderCache -> Module -> ModLocation -> HscSource -> IO () +addModuleToFinder fc mod loc src_flavour = do + let imod = toUnitId <$> mod + unless (src_flavour == HsBootFile) $ + addToFinderCache fc imod (InstalledFound loc) -- This returns a module because it's more convenient for users -addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleNameWithIsBoot -> ModLocation -> IO Module -addHomeModuleToFinder fc home_unit mod_name loc = do - let mod = mkHomeInstalledModule home_unit <$> mod_name - addToFinderCache fc mod (InstalledFound loc (gwib_mod mod)) - return (mkHomeModule home_unit (gwib_mod mod_name)) +addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> HscSource -> IO Module +addHomeModuleToFinder fc home_unit mod_name loc src_flavour = do + let mod = mkHomeInstalledModule home_unit mod_name + unless (src_flavour == HsBootFile) $ + addToFinderCache fc mod (InstalledFound loc) + return (mkHomeModule home_unit mod_name) -- ----------------------------------------------------------------------------- -- The internal workers @@ -342,7 +395,7 @@ let uid = homeUnitAsUnit home_unit r <- findInstalledHomeModule fc fopts (homeUnitId home_unit) mod_name return $ case r of - InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) + InstalledFound loc -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { fr_paths = fmap unsafeDecodeUtf fps, @@ -367,7 +420,7 @@ let uid = RealUnit (Definite home_unit) r <- findInstalledHomeModule fc fopts home_unit mod_name return $ case r of - InstalledFound loc _ -> Found loc (mkModule uid mod_name) + InstalledFound loc -> Found loc (mkModule uid mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible InstalledNotFound fps _ -> NotFound { fr_paths = fmap unsafeDecodeUtf fps, @@ -431,14 +484,7 @@ (search_dirs, exts) | finder_lookupHomeInterfaces fopts = (hi_dir_path, hi_exts) | otherwise = (home_path, source_exts) - in - - -- special case for GHC.Prim; we won't find it in the filesystem. - -- This is important only when compiling the base package (where GHC.Prim - -- is a home module). - if mod `installedModuleEq` gHC_PRIM - then return (InstalledFound (error "GHC.Prim ModLocation") mod) - else searchPathExts search_dirs mod exts + in searchPathExts search_dirs mod exts -- | Prepend the working directory to the search path. augmentImports :: OsPath -> [OsPath] -> [OsPath] @@ -466,13 +512,7 @@ findPackageModule_ fc fopts mod pkg_conf = do massertPpr (moduleUnit mod == unitId pkg_conf) (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf)) - modLocationCache fc (notBoot mod) $ - - -- special case for GHC.Prim; we won't find it in the filesystem. - if mod `installedModuleEq` gHC_PRIM - then return (InstalledFound (error "GHC.Prim ModLocation") mod) - else - + modLocationCache fc mod $ let tag = waysBuildTag (finder_ways fopts) @@ -494,7 +534,7 @@ -- don't bother looking for it. let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod) loc = mk_hi_loc one basename - in return $ InstalledFound loc mod + in return $ InstalledFound loc _otherwise -> searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)] @@ -528,7 +568,7 @@ search ((file, loc) : rest) = do b <- doesFileExist file if b - then return $ InstalledFound loc mod + then return $ InstalledFound loc else search rest mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt @@ -570,10 +610,12 @@ -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation -mkHomeModLocation dflags mod src_filename = - let (basename,extension) = OsPath.splitExtension src_filename - in mkHomeModLocation2 dflags mod basename extension +mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> FileExt -> HscSource -> ModLocation +mkHomeModLocation dflags mod src_basename ext hsc_src = + let loc = mkHomeModLocation2 dflags mod src_basename ext + in case hsc_src of + HsBootFile -> addBootSuffixLocnOut loc + _ -> loc mkHomeModLocation2 :: FinderOpts -> ModuleName diff --git a/GHC/Unit/Finder/Types.hs b/GHC/Unit/Finder/Types.hs --- a/GHC/Unit/Finder/Types.hs +++ b/GHC/Unit/Finder/Types.hs @@ -30,9 +30,9 @@ -- ^ remove all the home modules from the cache; package modules are -- assumed to not move around during a session; also flush the file hash -- cache. - , addToFinderCache :: InstalledModuleWithIsBoot -> InstalledFindResult -> IO () + , addToFinderCache :: InstalledModule -> InstalledFindResult -> IO () -- ^ Add a found location to the cache for the module. - , lookupFinderCache :: InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult) + , lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult) -- ^ Look for a location in the cache. , lookupFileCache :: FilePath -> IO Fingerprint -- ^ Look for the hash of a file in the cache. This should add it to the @@ -40,7 +40,7 @@ } data InstalledFindResult - = InstalledFound ModLocation InstalledModule + = InstalledFound ModLocation | InstalledNoPackage UnitId | InstalledNotFound [OsPath] (Maybe UnitId) diff --git a/GHC/Unit/Home/Graph.hs b/GHC/Unit/Home/Graph.hs new file mode 100644 --- /dev/null +++ b/GHC/Unit/Home/Graph.hs @@ -0,0 +1,381 @@ +-- | A 'HomeUnitGraph' (HUG) collects information about all the home units. +-- Crucially, each node in a 'HomeUnitGraph' includes a 'HomePackageTable'. +-- +-- Often, we don't want to query just a single 'HomePackageTable', but rather all +-- 'HomePackageTable's of all home units. +-- +-- This module is responsible for maintaining this bridge between querying all +-- home units vs querying the home package table directly. Think 'lookupHug' vs +-- 'lookupHpt', 'hugAllInstances' vs 'hptAllInstances', where the @hug@ version +-- replies with information from all home units, and the @hpt@ version with +-- information pertaining to a single home unit. +-- +-- Meant to be imported qualified as @HUG@. +-- Example usage: +-- +-- @ +-- import GHC.Unit.Home.Graph (HomeUnitGraph, HomeUnitEnv) +-- import qualified GHC.Unit.Home.Graph as HUG +-- usage = ... HUG.insertHug hug uid modname modinfo ... +-- @ +module GHC.Unit.Home.Graph + ( HomeUnitGraph + , HomeUnitEnv(..) + , mkHomeUnitEnv + + -- * Operations + , addHomeModInfoToHug + , restrictHug + , renameUnitId + , allUnits + , updateUnitFlags + + -- ** Lookups + , lookupHug + , lookupHugByModule + , lookupHugUnit + , lookupHugUnitId + , lookupAllHug + , memberHugUnit + , memberHugUnitId + -- ** Reachability + , transitiveHomeDeps + + -- * Very important queries + , allInstances + , allFamInstances + , allAnns + , allCompleteSigs + + -- * Utilities + , hugSCCs + , hugFromList + + -- ** Printing + , pprHomeUnitGraph + , pprHomeUnitEnv + + -- * Auxiliary internal structure + , UnitEnvGraph(..) + , unitEnv_lookup_maybe + , unitEnv_foldWithKey + , unitEnv_singleton + , unitEnv_adjust + , unitEnv_keys + , unitEnv_insert + , unitEnv_new + , unitEnv_lookup + , unitEnv_traverseWithKey + , unitEnv_assocs + ) where + +import GHC.Prelude + +import GHC.Driver.DynFlags +import GHC.Unit.Home +import GHC.Unit.Home.ModInfo +import GHC.Unit.Home.PackageTable +import GHC.Unit.Module +import GHC.Unit.Module.ModIface +import GHC.Unit.State +import GHC.Utils.Monad (mapMaybeM) +import GHC.Utils.Outputable +import GHC.Utils.Panic + +import GHC.Core.FamInstEnv + +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import GHC.Data.Maybe +import GHC.Data.Graph.Directed + +import GHC.Types.Annotations +import GHC.Types.CompleteMatch +import GHC.Core.InstEnv + + +-- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present across +-- all home units. +allCompleteSigs :: HomeUnitGraph -> IO CompleteMatches +allCompleteSigs hug = foldr go (pure []) hug where + go hue = liftA2 (++) (hptCompleteSigs (homeUnitEnv_hpt hue)) + +-- | Find all the instance declarations (of classes and families) from +-- the Home Package Table filtered by the provided predicate function. +-- Used in @tcRnImports@, to select the instances that are in the +-- transitive closure of imports from the currently compiled module. +allInstances :: HomeUnitGraph -> IO (InstEnv, [FamInst]) +allInstances hug = foldr go (pure (emptyInstEnv, [])) hug where + go hue = liftA2 (\(a,b) (a',b') -> (a `unionInstEnv` a', b ++ b')) + (hptAllInstances (homeUnitEnv_hpt hue)) + +allFamInstances :: HomeUnitGraph -> IO (ModuleEnv FamInstEnv) +allFamInstances hug = foldr go (pure emptyModuleEnv) hug where + go hue = liftA2 plusModuleEnv (hptAllFamInstances (homeUnitEnv_hpt hue)) + +allAnns :: HomeUnitGraph -> IO AnnEnv +allAnns hug = foldr go (pure emptyAnnEnv) hug where + go hue = liftA2 plusAnnEnv (hptAllAnnotations (homeUnitEnv_hpt hue)) + +-------------------------------------------------------------------------------- +-- HomeUnitGraph (HUG) +-------------------------------------------------------------------------------- + +type HomeUnitGraph = UnitEnvGraph HomeUnitEnv + +data HomeUnitEnv = HomeUnitEnv + { homeUnitEnv_units :: !UnitState + -- ^ External units + + , homeUnitEnv_unit_dbs :: !(Maybe [UnitDatabase UnitId]) + -- ^ Stack of unit databases for the target platform. + -- + -- This field is populated with the result of `initUnits`. + -- + -- 'Nothing' means the databases have never been read from disk. + -- + -- Usually we don't reload the databases from disk if they are + -- cached, even if the database flags changed! + + , homeUnitEnv_dflags :: DynFlags + -- ^ The dynamic flag settings + , homeUnitEnv_hpt :: HomePackageTable + -- ^ The home package table describes already-compiled + -- home-package modules, /excluding/ the module we + -- are compiling right now. + -- (In one-shot mode the current module is the only + -- home-package module, so homeUnitEnv_hpt is empty. All other + -- modules count as \"external-package\" modules. + -- However, even in GHCi mode, hi-boot interfaces are + -- demand-loaded into the external-package table.) + -- + -- 'homeUnitEnv_hpt' is not mutable because we only demand-load + -- external packages; the home package is eagerly + -- loaded, module by module, by the compilation manager. + -- + -- The HPT may contain modules compiled earlier by @--make@ + -- but not actually below the current module in the dependency + -- graph. + -- + -- (This changes a previous invariant: changed Jan 05.) + + , homeUnitEnv_home_unit :: !(Maybe HomeUnit) + -- ^ Home-unit + } + +mkHomeUnitEnv :: UnitState -> Maybe [UnitDatabase UnitId] -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv +mkHomeUnitEnv us dbs dflags hpt home_unit = HomeUnitEnv + { homeUnitEnv_units = us + , homeUnitEnv_unit_dbs = dbs + , homeUnitEnv_dflags = dflags + , homeUnitEnv_hpt = hpt + , homeUnitEnv_home_unit = home_unit + } + +-------------------------------------------------------------------------------- +-- * Operations on HUG +-------------------------------------------------------------------------------- + +-- | Add an entry to the 'HomePackageTable' under the unit of that entry. +addHomeModInfoToHug :: HomeModInfo -> HomeUnitGraph -> IO () +addHomeModInfoToHug hmi hug = + case unitEnv_lookup_maybe hmi_unit hug of + Nothing -> pprPanic "addHomeInfoToHug" (ppr hmi_mod) + Just hue -> do + addHomeModInfoToHpt hmi (homeUnitEnv_hpt hue) + where + hmi_mod :: Module + hmi_mod = mi_module (hm_iface hmi) + hmi_unit = toUnitId (moduleUnit hmi_mod) + +-- | Thin each HPT variable to only contain keys from the given dependencies. +-- This is used at the end of upsweep to make sure that only completely successfully loaded +-- modules are visible for subsequent operations. +restrictHug :: [(UnitId, [HomeModInfo])] -> HomeUnitGraph -> IO () +restrictHug deps hug = unitEnv_foldWithKey (\k uid hue -> restrict_one uid hue >> k) (return ()) hug + where + deps_map = Map.fromList deps + restrict_one uid hue = + restrictHpt (homeUnitEnv_hpt hue) (Map.findWithDefault [] uid deps_map) + +-- | Rename a unit id in the 'HomeUnitGraph' +-- +-- @'renameUnitId' oldUnit newUnit hug@, if @oldUnit@ is not found in @hug@, returns 'Nothing'. +-- If it exists, the result maps @newUnit@ to the 'HomeUnitEnv' of the +-- @oldUnit@ (and @oldUnit@ is removed from @hug@) +renameUnitId :: UnitId -> UnitId -> HomeUnitGraph -> Maybe HomeUnitGraph +renameUnitId oldUnit newUnit hug = case unitEnv_lookup_maybe oldUnit hug of + Nothing -> Nothing + Just oldHue -> pure $ + unitEnv_insert newUnit oldHue $ + unitEnv_delete oldUnit hug + +-- | Retrieve all 'UnitId's of units in the 'HomeUnitGraph'. +allUnits :: HomeUnitGraph -> Set.Set UnitId +allUnits = unitEnv_keys + +-- | Set the 'DynFlags' of the 'HomeUnitEnv' for unit in the 'HomeModuleGraph' +updateUnitFlags :: UnitId -> (DynFlags -> DynFlags) -> HomeUnitGraph -> HomeUnitGraph +updateUnitFlags uid f = unitEnv_adjust update uid + where + update hue = hue { homeUnitEnv_dflags = f (homeUnitEnv_dflags hue) } + +-------------------------------------------------------------------------------- +-- ** Reachability +-------------------------------------------------------------------------------- + +-- | Compute the transitive closure of a unit in the 'HomeUnitGraph'. +-- If the argument unit is not present in the graph returns Nothing. +transitiveHomeDeps :: UnitId -> HomeUnitGraph -> Maybe [UnitId] +transitiveHomeDeps uid hug = case lookupHugUnitId uid hug of + Nothing -> Nothing + Just hue -> Just $ + Set.toList (loop (Set.singleton uid) (homeUnitDepends (homeUnitEnv_units hue))) + where + loop acc [] = acc + loop acc (uid:uids) + | uid `Set.member` acc = loop acc uids + | otherwise = + let hue = homeUnitDepends + . homeUnitEnv_units + . expectJust + $ lookupHugUnitId uid hug + in loop (Set.insert uid acc) (hue ++ uids) + +-------------------------------------------------------------------------------- +-- ** Lookups +-------------------------------------------------------------------------------- + +-- | Lookup the 'HomeModInfo' of a 'Module' in the 'HomeUnitGraph' given its +-- 'UnitId' and 'ModuleName' (via the 'HomePackageTable' of the corresponding unit) +lookupHug :: HomeUnitGraph -> UnitId -> ModuleName -> IO (Maybe HomeModInfo) +lookupHug hug uid mod = do + case unitEnv_lookup_maybe uid hug of + Nothing -> pure Nothing + Just hue -> lookupHpt (homeUnitEnv_hpt hue) mod + +-- | Lookup the 'HomeModInfo' of a 'Module' in the 'HomeUnitGraph' (via the 'HomePackageTable' of the corresponding unit) +lookupHugByModule :: Module -> HomeUnitGraph -> IO (Maybe HomeModInfo) +lookupHugByModule mod hug = + case lookupHugUnit (moduleUnit mod) hug of + Nothing -> pure Nothing + Just env -> lookupHptByModule (homeUnitEnv_hpt env) mod + +-- | Lookup all 'HomeModInfo' that have the same 'ModuleName' as the given 'ModuleName'. +-- 'ModuleName's are not unique in the case of multiple home units, so there can be +-- more than one possible 'HomeModInfo'. +-- +-- You should always prefer 'lookupHug' and 'lookupHugByModule' when possible. +lookupAllHug :: HomeUnitGraph -> ModuleName -> IO [HomeModInfo] +lookupAllHug hug mod = mapMaybeM (\uid -> lookupHug hug uid mod) (Set.toList $ unitEnv_keys hug) + +-- | Lookup a 'HomeUnitEnv' by 'UnitId' in a 'HomeUnitGraph' +lookupHugUnitId :: UnitId -> HomeUnitGraph -> Maybe HomeUnitEnv +lookupHugUnitId = unitEnv_lookup_maybe + +-- | Check whether the 'UnitId' is present in the 'HomeUnitGraph' +memberHugUnitId :: UnitId -> HomeUnitGraph -> Bool +memberHugUnitId u = isJust . lookupHugUnitId u + +-- | Lookup up the 'HomeUnitEnv' by the 'Unit' in the 'HomeUnitGraph'. +-- If the 'Unit' can be turned into a 'UnitId', we behave identical to 'lookupHugUnitId'. +-- +-- A 'HoleUnit' is never part of the 'HomeUnitGraph', only instantiated 'Unit's +lookupHugUnit :: Unit -> HomeUnitGraph -> Maybe HomeUnitEnv +lookupHugUnit unit hug = + if isHoleUnit unit + then Nothing + else lookupHugUnitId (toUnitId unit) hug + +-- | Check whether the 'Unit' is present in the 'HomeUnitGraph' +-- +-- A 'HoleUnit' is never part of the 'HomeUnitGraph', only instantiated 'Unit's +memberHugUnit :: Unit -> HomeUnitGraph -> Bool +memberHugUnit u = isJust . lookupHugUnit u + +-------------------------------------------------------------------------------- +-- * Internal representation map +-------------------------------------------------------------------------------- +-- Note: we purposefully do not export functions like "elems" to maintain a +-- good clean interface with the HUG. + +type UnitEnvGraphKey = UnitId + +newtype UnitEnvGraph v = UnitEnvGraph + { unitEnv_graph :: Map UnitEnvGraphKey v + } deriving (Functor, Foldable, Traversable) + +unitEnv_new :: Map UnitEnvGraphKey v -> UnitEnvGraph v +unitEnv_new m = + UnitEnvGraph + { unitEnv_graph = m + } + +unitEnv_insert :: UnitEnvGraphKey -> v -> UnitEnvGraph v -> UnitEnvGraph v +unitEnv_insert unitId env unitEnv = unitEnv + { unitEnv_graph = Map.insert unitId env (unitEnv_graph unitEnv) + } + +unitEnv_delete :: UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v +unitEnv_delete uid unitEnv = + unitEnv + { unitEnv_graph = Map.delete uid (unitEnv_graph unitEnv) + } + +unitEnv_adjust :: (v -> v) -> UnitEnvGraphKey -> UnitEnvGraph v -> UnitEnvGraph v +unitEnv_adjust f uid unitEnv = unitEnv + { unitEnv_graph = Map.adjust f uid (unitEnv_graph unitEnv) + } + +unitEnv_singleton :: UnitEnvGraphKey -> v -> UnitEnvGraph v +unitEnv_singleton active m = UnitEnvGraph + { unitEnv_graph = Map.singleton active m + } + +unitEnv_lookup_maybe :: UnitEnvGraphKey -> UnitEnvGraph v -> Maybe v +unitEnv_lookup_maybe u env = Map.lookup u (unitEnv_graph env) + +unitEnv_keys :: UnitEnvGraph v -> Set.Set UnitEnvGraphKey +unitEnv_keys env = Map.keysSet (unitEnv_graph env) + +unitEnv_foldWithKey :: (b -> UnitEnvGraphKey -> a -> b) -> b -> UnitEnvGraph a -> b +unitEnv_foldWithKey f z (UnitEnvGraph g)= Map.foldlWithKey' f z g + +unitEnv_lookup :: UnitEnvGraphKey -> UnitEnvGraph v -> v +unitEnv_lookup u env = expectJust $ unitEnv_lookup_maybe u env + +unitEnv_traverseWithKey :: Applicative f => (UnitEnvGraphKey -> a -> f b) -> UnitEnvGraph a -> f (UnitEnvGraph b) +unitEnv_traverseWithKey f unitEnv = + UnitEnvGraph <$> Map.traverseWithKey f (unitEnv_graph unitEnv) + +unitEnv_assocs :: UnitEnvGraph a -> [(UnitEnvGraphKey, a)] +unitEnv_assocs (UnitEnvGraph x) = Map.assocs x + +-------------------------------------------------------------------------------- +-- * Utilities +-------------------------------------------------------------------------------- + +hugSCCs :: HomeUnitGraph -> [SCC UnitId] +hugSCCs hug = sccs where + mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId + mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue)) + nodes = map mkNode (Map.toList $ unitEnv_graph hug) + + sccs = stronglyConnCompFromEdgedVerticesOrd nodes + +hugFromList :: [(UnitId, HomeUnitEnv)] -> HomeUnitGraph +hugFromList = UnitEnvGraph . Map.fromList + +pprHomeUnitGraph :: HomeUnitGraph -> IO SDoc +pprHomeUnitGraph unitEnv = do + docs <- mapM (\(k, v) -> pprHomeUnitEnv k v) $ Map.assocs $ unitEnv_graph unitEnv + return $ vcat docs + +pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> IO SDoc +pprHomeUnitEnv uid env = do + hptDoc <- pprHPT $ homeUnitEnv_hpt env + return $ + ppr uid <+> text "(flags:" <+> ppr (homeUnitId_ $ homeUnitEnv_dflags env) <> text "," <+> ppr (fmap homeUnitId $ homeUnitEnv_home_unit env) <> text ")" <+> text "->" + $$ nest 4 hptDoc + diff --git a/GHC/Unit/Home/ModInfo.hs b/GHC/Unit/Home/ModInfo.hs --- a/GHC/Unit/Home/ModInfo.hs +++ b/GHC/Unit/Home/ModInfo.hs @@ -1,6 +1,8 @@ --- | Info about modules in the "home" unit +-- | Info about modules in the "home" unit. +-- Stored in a 'HomePackageTable'. module GHC.Unit.Home.ModInfo - ( HomeModInfo (..) + ( + HomeModInfo (..) , HomeModLinkable(..) , homeModInfoObject , homeModInfoByteCode @@ -8,24 +10,6 @@ , justBytecode , justObjects , bytecodeAndObjects - , HomePackageTable - , emptyHomePackageTable - , lookupHpt - , eltsHpt - , concatHpt - , filterHpt - , allHpt - , anyHpt - , mapHpt - , delFromHpt - , addToHpt - , addHomeModInfoToHpt - , addListToHpt - , lookupHptDirectly - , lookupHptByModule - , listToHpt - , listHMIToHpt - , pprHPT ) where @@ -33,18 +17,13 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModDetails -import GHC.Unit.Module import GHC.Linker.Types ( Linkable(..), linkableIsNativeCodeOnly ) -import GHC.Types.Unique -import GHC.Types.Unique.DFM - import GHC.Utils.Outputable -import Data.List (sortOn) -import Data.Ord import GHC.Utils.Panic + -- | Information about modules in the package being compiled data HomeModInfo = HomeModInfo { hm_iface :: !ModIface @@ -128,79 +107,3 @@ flag to make sure that byte code is generated for your modules. -} - --- | Helps us find information about modules in the home package -type HomePackageTable = DModuleNameEnv HomeModInfo - -- Domain = modules in the home unit that have been fully compiled - -- "home" unit id cached (implicit) here for convenience - --- | Constructs an empty HomePackageTable -emptyHomePackageTable :: HomePackageTable -emptyHomePackageTable = emptyUDFM - -lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo -lookupHpt = lookupUDFM - -lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo -lookupHptDirectly = lookupUDFM_Directly - -eltsHpt :: HomePackageTable -> [HomeModInfo] -eltsHpt = eltsUDFM - --- | Like @concatMap f . 'eltsHpt'@, but filters out all 'HomeModInfo' for which --- @f@ returns the empty list before doing the sort inherent to 'eltsUDFM'. -concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> [a] -concatHpt f = concat . eltsUDFM . mapMaybeUDFM g - where - g hmi = case f hmi of { [] -> Nothing; as -> Just as } - -filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable -filterHpt = filterUDFM - -allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool -allHpt = allUDFM - -anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool -anyHpt = anyUDFM - -mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable -mapHpt = mapUDFM - -delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable -delFromHpt = delFromUDFM - -addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable -addToHpt = addToUDFM - -addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> HomePackageTable -addHomeModInfoToHpt hmi hpt = addToHpt hpt (moduleName (mi_module (hm_iface hmi))) hmi - -addListToHpt - :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable -addListToHpt = addListToUDFM - -listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable -listToHpt = listToUDFM - -listHMIToHpt :: [HomeModInfo] -> HomePackageTable -listHMIToHpt hmis = - listToHpt [(moduleName (mi_module (hm_iface hmi)), hmi) | hmi <- sorted_hmis] - where - -- Sort to put Non-boot things last, so they overwrite the boot interfaces - -- in the HPT, other than that, the order doesn't matter - sorted_hmis = sortOn (Down . mi_boot . hm_iface) hmis - -lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo --- The HPT is indexed by ModuleName, not Module, --- we must check for a hit on the right Module -lookupHptByModule hpt mod - = case lookupHpt hpt (moduleName mod) of - Just hm | mi_module (hm_iface hm) == mod -> Just hm - _otherwise -> Nothing - -pprHPT :: HomePackageTable -> SDoc --- A bit arbitrary for now -pprHPT hpt = pprUDFM hpt $ \hms -> - vcat [ ppr (mi_module (hm_iface hm)) - | hm <- hms ] - diff --git a/GHC/Unit/Home/PackageTable.hs b/GHC/Unit/Home/PackageTable.hs new file mode 100644 --- /dev/null +++ b/GHC/Unit/Home/PackageTable.hs @@ -0,0 +1,334 @@ +{-# LANGUAGE LambdaCase #-} +-- | The 'HomePackageTable' (HPT) contains information about all modules that are part +-- of a home package. At its core, the information for each module is a +-- 'HomeModInfo'. +-- +-- During upsweep, the HPT is a monotonically increasing data structure: it +-- only ever gets extended by inserting modules which are loaded and for which +-- we discover the information required to construct a 'ModInfo'. +-- +-- There should only ever exist one single HPT for any given home unit. It's +-- crucial we don't accidentally leak HPTs (e.g. by filtering it, which used to +-- happen -- #25511), so the HPT is mutable and only its reference should be shared. +-- This is alright because the modules don't change throughout compilation. +-- +-- :::WARNING::: +-- If you intend to change this interface, consider carefully whether you are +-- exposing memory-leak footguns which may end up being misused in the compiler +-- eventually. For instance, if you really, really, end up needing a way to take +-- a snapshot of the IORef (think: do you really need to?), at least make +-- obvious in the name like `snapshotCopyHpt`. +-- +-- Or, do you really need a function to traverse all modules in the HPT? It is +-- often better to keep the computation internal to this module, such as in +-- 'hptCollectObjects'... +module GHC.Unit.Home.PackageTable + ( + HomePackageTable(..) + , emptyHomePackageTable + + -- * Lookups in the HPT + , lookupHpt + , lookupHptByModule + + -- * Extending the HPT + , addHomeModInfoToHpt + , addHomeModInfosToHpt + + -- * Restrict the HPT + , restrictHpt + + -- * Queries about home modules + , hptCompleteSigs + , hptAllInstances + , hptAllFamInstances + , hptAllAnnotations + + -- ** More Traversal-based queries + , hptCollectDependencies + , hptCollectObjects + , hptCollectModules + + -- ** Memory dangerous queries + , concatHpt + + -- * Utilities + , pprHPT + + -- * Internals + -- + -- | These provide access to the internals of the HomePackageTable to + -- facilitate existing workflows that used the previous API. For instance, + -- if you were listing out all elements or merging, you can keep doing so by reading + -- the internal IO ref and then using the moduleenv contents directly. + -- + -- In GHC itself these should be avoided, and other uses should justify why + -- it is not sufficient to go through the intended insert-only API. + , hptInternalTableRef + , hptInternalTableFromRef + + -- * Legacy API + -- + -- | This API is deprecated and meant to be removed. + , addToHpt + , addListToHpt + ) where + +import GHC.Prelude +import GHC.Data.Maybe + +import Data.IORef +import Control.Monad ((<$!>)) +import qualified Data.Set as Set + +import GHC.Core.FamInstEnv +import GHC.Core.InstEnv +import GHC.Linker.Types +import GHC.Types.Annotations +import GHC.Types.CompleteMatch +import GHC.Types.Unique.DFM +import GHC.Unit.Home.ModInfo +import GHC.Unit.Module +import GHC.Unit.Module.Deps +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModIface +import GHC.Utils.Outputable +import GHC.Types.Unique (getUnique, getKey) +import qualified GHC.Data.Word64Set as W64 + +-- | Helps us find information about modules in the home package +newtype HomePackageTable = HPT { + + table :: IORef (DModuleNameEnv HomeModInfo) + -- ^ Domain = modules in this home unit + -- + -- This is an IORef because we want to avoid leaking HPTs (see the particularly bad #25511). + -- Moreover, the HPT invariant allows mutability in this table without compromising thread safety or soundness. + -- To recall: + -- A query to the HPT should depend only on data relevant to that query, such that + -- there being more or less unrelated entries in the HPT does not influence the result in any way. + -- + -- Note that the HPT increases monotonically, except at certain barrier + -- points like when 'restrictHpt' is called. At these barriers, it is safe + -- to temporarily violate the HPT monotonicity. + -- + -- The elements of this table may be updated (e.g. on rehydration). + } + +-- | Create a new 'HomePackageTable'. +-- +-- Be careful not to share it across e.g. different units, since it uses a +-- mutable variable under the hood to keep the monotonically increasing list of +-- loaded modules. +emptyHomePackageTable :: IO HomePackageTable +-- romes:todo: use a MutableArray directly? +emptyHomePackageTable = do + table <- newIORef emptyUDFM + return HPT{table} + +-------------------------------------------------------------------------------- +-- * Lookups in the HPT +-------------------------------------------------------------------------------- + +-- | Lookup the 'HomeModInfo' of a module in the HPT, given its name. +lookupHpt :: HomePackageTable -> ModuleName -> IO (Maybe HomeModInfo) +lookupHpt HPT{table=hpt} mn = (`lookupUDFM` mn) <$!> readIORef hpt + +-- | Lookup the 'HomeModInfo' of a 'Module' in the HPT. +lookupHptByModule :: HomePackageTable -> Module -> IO (Maybe HomeModInfo) +lookupHptByModule hpt mod + = -- The HPT is indexed by ModuleName, not Module, + -- we must check for a hit on the right Module + lookupHpt hpt (moduleName mod) >>= pure . \case + Just hm | mi_module (hm_iface hm) == mod -> Just hm + _otherwise -> Nothing + +-------------------------------------------------------------------------------- +-- * Extending the HPT +-------------------------------------------------------------------------------- + +-- | Add a new module to the HPT. +-- +-- An HPT is a monotonically increasing data structure, holding information about loaded modules in a package. +-- This is the main function by which the HPT is extended or updated. +-- +-- When the module of the inserted 'HomeModInfo' does not exist, a new entry in +-- the HPT is created for that module name. +-- When the module already has an entry, inserting a new one entry in the HPT +-- will always overwrite the existing entry for that module. +addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> IO () +addHomeModInfoToHpt hmi hpt = addToHpt hpt (moduleName (mi_module (hm_iface hmi))) hmi + +{-# DEPRECATED addToHpt "Deprecated in favour of 'addHomeModInfoToHpt', as the module at which a 'HomeModInfo' is inserted should always be derived from the 'HomeModInfo' itself." #-} +-- After deprecation cycle, move `addToHpt` to a `where` clause inside `addHomeModInfoToHpt`. +addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> IO () +addToHpt HPT{table=hptr} mn hmi = do + atomicModifyIORef' hptr (\hpt -> (addToUDFM hpt mn hmi, ())) + -- If the key already existed in the map, this insertion is overwriting + -- the HMI of a previously loaded module (likely in rehydration). + +-- | 'addHomeModInfoToHpt' for multiple module infos. +addHomeModInfosToHpt :: HomePackageTable -> [HomeModInfo] -> IO () +addHomeModInfosToHpt hpt = mapM_ (flip addHomeModInfoToHpt hpt) + +-- | Thin each HPT variable to only contain keys from the given dependencies. +-- This is used at the end of upsweep to make sure that only completely successfully loaded +-- modules are visible for subsequent operations. +-- +-- This is an exception to the invariant of the HPT -- that it grows +-- monotonically, never removing entries -- which is safe as long as it is only +-- called at barrier points, such as the end of upsweep, when all threads are +-- done and we want to clean up failed entries. +restrictHpt :: HomePackageTable -> [HomeModInfo] -> IO () +restrictHpt HPT{table=hptr} hmis = + let key_set = map (getKey . getUnique . hmi_mod) hmis + hmi_mod hmi = moduleName (mi_module (hm_iface hmi)) + in atomicModifyIORef' hptr (\hpt -> (udfmRestrictKeysSet hpt (W64.fromList key_set), ())) + +{-# DEPRECATED addListToHpt "Deprecated in favour of 'addHomeModInfosToHpt', as the module at which a 'HomeModInfo' is inserted should always be derived from the 'HomeModInfo' itself." #-} +-- After deprecation cycle, remove. +addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> IO () +addListToHpt hpt = mapM_ (uncurry (addToHpt hpt)) + +---------------------------------------------------------------------------------- +---- * Queries +---------------------------------------------------------------------------------- + +-- | Get all 'CompleteMatches' (arising from COMPLETE pragmas) present in all +-- modules from this unit's HPT. +hptCompleteSigs :: HomePackageTable -> IO CompleteMatches +hptCompleteSigs = concatHpt (md_complete_matches . hm_details) + +-- | Find all the instance declarations (of classes and families) from this Home Package Table +hptAllInstances :: HomePackageTable -> IO (InstEnv, [FamInst]) +hptAllInstances hpt = do + hits <- flip concatHpt hpt $ \mod_info -> do + let details = hm_details mod_info + return (md_insts details, md_fam_insts details) + let (insts, famInsts) = unzip hits + return (foldl' unionInstEnv emptyInstEnv insts, concat famInsts) + +-- | Find all the family instance declarations from the HPT +hptAllFamInstances :: HomePackageTable -> IO (ModuleEnv FamInstEnv) +hptAllFamInstances = fmap mkModuleEnv . concatHpt (\hmi -> [(hmiModule hmi, hmiFamInstEnv hmi)]) + where + hmiModule = mi_module . hm_iface + hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv + . md_fam_insts . hm_details + +-- | All annotations from the HPT +hptAllAnnotations :: HomePackageTable -> IO AnnEnv +hptAllAnnotations = fmap mkAnnEnv . concatHpt (md_anns . hm_details) + + +-------------------------------------------------------------------------------- +-- * Traversal-based queries +-------------------------------------------------------------------------------- + +-- | Collect the immediate dependencies of all modules in the HPT into a Set. +-- The immediate dependencies are given by the iface as @'dep_direct_pkgs' . 'mi_deps'@. +-- +-- Note: This should be a query on the 'ModuleGraph', since we don't really +-- ever want to collect *all* dependencies. The current caller of this function +-- currently takes all dependencies only to then filter them with an ad-hoc transitive closure check. +-- See #25639 +hptCollectDependencies :: HomePackageTable -> IO (Set.Set (IfaceImportLevel, UnitId)) +hptCollectDependencies HPT{table} = do + hpt <- readIORef table + return $ + foldr (Set.union . dep_direct_pkgs . mi_deps . hm_iface) Set.empty hpt + +-- | Collect the linkable object of all modules in the HPT. +-- The linkable objects are given by @'homeModInfoObject'@. +-- +-- $O(n)$ in the number of modules in the HPT. +hptCollectObjects :: HomePackageTable -> IO [Linkable] +hptCollectObjects HPT{table} = do + hpt <- readIORef table + return $ + foldr ((:) . expectJust . homeModInfoObject) [] hpt + +-- | Collect all module ifaces in the HPT +-- +-- $O(n)$ in the number of modules in the HPT. +hptCollectModules :: HomePackageTable -> IO [Module] +hptCollectModules HPT{table} = do + hpt <- readIORef table + return $ + foldr ((:) . mi_module . hm_iface) [] hpt + +-------------------------------------------------------------------------------- +-- * Utilities +-------------------------------------------------------------------------------- + +-- | Pretty print a 'HomePackageTable'. +-- +-- Make sure you really do need to print the whole HPT before infusing too much +-- code with IO. +-- +-- For instance, in the HUG, it suffices to print the unit-keys present in the +-- unit map in failed lookups. +pprHPT :: HomePackageTable -> IO SDoc +-- A bit arbitrary for now +pprHPT HPT{table=hptr} = do + hpt <- readIORef hptr + return $! + pprUDFM hpt $ \hms -> + vcat [ ppr (mi_module (hm_iface hm)) + | hm <- hms ] + +---------------------------------------------------------------------------------- +-- THE TYPE OF FOOTGUNS WE DON'T WANT TO EXPOSE +---------------------------------------------------------------------------------- + +-- eltsHpt :: HomePackageTable -> [HomeModInfo] +-- filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable +-- mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable +-- delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable +-- listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable +-- listHMIToHpt :: [HomeModInfo] -> HomePackageTable + +---------------------------------------------------------------------------------- +-- Would be fine, but may lead to linearly traversing the HPT unnecessarily +-- (e.g. `lastLoadedKey` superseded bad usages) +---------------------------------------------------------------------------------- + +-- allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool +-- allHpt = allUDFM + +-- anyHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool +-- anyHpt = anyUDFM + +---------------------------------------------------------------------------------- +-- Would be ok to expose this function very /careful/ with the argument function +---------------------------------------------------------------------------------- + +-- | Like @concatMap f . 'eltsHpt'@, but filters out all 'HomeModInfo' for which +-- @f@ returns the empty list before doing the sort inherent to 'eltsUDFM'. +-- +-- If this function is ever exposed from the HPT module, make sure the +-- argument function doesn't introduce leaks. +concatHpt :: (HomeModInfo -> [a]) -> HomePackageTable -> IO [a] +concatHpt f HPT{table} = do + hpt <- readIORef table + return $ concat . eltsUDFM . mapMaybeUDFM g $ hpt + where + g hmi = case f hmi of { [] -> Nothing; as -> Just as } + +-------------------------------------------------------------------------------- +-- * Internals (see haddocks!) +-------------------------------------------------------------------------------- + +-- | Gets the internal 'IORef' which holds the 'HomeModInfo's of this HPT. +-- Use with care. +hptInternalTableRef :: HomePackageTable -> IORef (DModuleNameEnv HomeModInfo) +hptInternalTableRef = table + +-- | Construct a HomePackageTable from the IORef. +-- Use with care, only if you can really justify going around the intended insert-only API. +hptInternalTableFromRef :: IORef (DModuleNameEnv HomeModInfo) -> IO HomePackageTable +hptInternalTableFromRef ref = do + return HPT { + table = ref + } + diff --git a/GHC/Unit/Module/Deps.hs b/GHC/Unit/Module/Deps.hs --- a/GHC/Unit/Module/Deps.hs +++ b/GHC/Unit/Module/Deps.hs @@ -1,21 +1,29 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE DerivingVia #-} -- | Dependencies and Usage of a module module GHC.Unit.Module.Deps - ( Dependencies - , mkDependencies - , noDependencies - , dep_direct_mods - , dep_direct_pkgs - , dep_sig_mods - , dep_trusted_pkgs - , dep_orphs - , dep_plugin_pkgs - , dep_finsts - , dep_boot_mods + ( Dependencies(dep_direct_mods + , dep_direct_pkgs + , dep_sig_mods + , dep_trusted_pkgs + , dep_orphs + , dep_plugin_pkgs + , dep_finsts + , dep_boot_mods + , Dependencies) , dep_orphs_update , dep_finsts_update + , mkDependencies + , noDependencies , pprDeps , Usage (..) + , HomeModImport (..) + , HomeModImportedAvails (..) , ImportAvails (..) + , IfaceImportLevel(..) + , tcImportLevel ) where @@ -23,8 +31,10 @@ import GHC.Data.FastString +import GHC.Types.Avail import GHC.Types.SafeHaskell import GHC.Types.Name +import GHC.Types.Basic import GHC.Unit.Module.Imported import GHC.Unit.Module @@ -39,7 +49,11 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Bifunctor +import Control.DeepSeq +import GHC.Types.Name.Set + + -- | Dependency information about ALL modules and packages below this one -- in the import hierarchy. This is the serialisable version of `ImportAvails`. -- @@ -51,38 +65,38 @@ -- -- See Note [Transitive Information in Dependencies] data Dependencies = Deps - { dep_direct_mods :: Set (UnitId, ModuleNameWithIsBoot) + { dep_direct_mods_ :: Set (IfaceImportLevel, UnitId, ModuleNameWithIsBoot) -- ^ All home-package modules which are directly imported by this one. -- This may include modules from other units when using multiple home units - , dep_direct_pkgs :: Set UnitId + , dep_direct_pkgs_ :: Set (IfaceImportLevel, UnitId) -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. -- Does not include other home units when using multiple home units. -- Modules from these units will go in `dep_direct_mods` - , dep_plugin_pkgs :: Set UnitId + , dep_plugin_pkgs_ :: Set UnitId -- ^ All units needed for plugins ------------------------------------ -- Transitive information below here - , dep_sig_mods :: ![ModuleName] + , dep_sig_mods_ :: ![ModuleName] -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: Set UnitId + , dep_trusted_pkgs_ :: Set UnitId -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names - , dep_boot_mods :: Set (UnitId, ModuleNameWithIsBoot) + , dep_boot_mods_ :: Set (UnitId, ModuleNameWithIsBoot) -- ^ All modules which have boot files below this one, and whether we -- should use the boot file or not. -- This information is only used to populate the eps_is_boot field. -- See Note [Structure of dep_boot_mods] - , dep_orphs :: [Module] + , dep_orphs_ :: [Module] -- ^ Transitive closure of orphan modules (whether -- home or external pkg). -- @@ -92,7 +106,7 @@ -- which relies on dep_orphs having the complete list!) -- This does NOT include us, unlike 'imp_orphs'. - , dep_finsts :: [Module] + , dep_finsts_ :: [Module] -- ^ Transitive closure of depended upon modules which -- contain family instances (whether home or external). -- This is used by 'checkFamInstConsistency'. This @@ -104,7 +118,55 @@ -- Equality used only for old/new comparison in GHC.Iface.Recomp.addFingerprints -- See 'GHC.Tc.Utils.ImportAvails' for details on dependencies. +pattern Dependencies :: Set (IfaceImportLevel, UnitId, ModuleNameWithIsBoot) + -> Set (IfaceImportLevel, UnitId) + -> Set UnitId + -> [ModuleName] + -> Set UnitId + -> Set (UnitId, ModuleNameWithIsBoot) + -> [Module] + -> [Module] + -> Dependencies +pattern Dependencies {dep_direct_mods, dep_direct_pkgs, dep_plugin_pkgs, dep_sig_mods, dep_trusted_pkgs, dep_boot_mods, dep_orphs, dep_finsts} + <- Deps {dep_direct_mods_ = dep_direct_mods + , dep_direct_pkgs_ = dep_direct_pkgs + , dep_plugin_pkgs_ = dep_plugin_pkgs + , dep_sig_mods_ = dep_sig_mods + , dep_trusted_pkgs_ = dep_trusted_pkgs + , dep_boot_mods_ = dep_boot_mods + , dep_orphs_ = dep_orphs + , dep_finsts_ = dep_finsts} +{-# COMPLETE Dependencies #-} +instance NFData Dependencies where + rnf (Deps dmods dpkgs ppkgs hsigms tps bmods orphs finsts) + = rnf dmods + `seq` rnf dpkgs + `seq` rnf ppkgs + `seq` rnf hsigms + `seq` rnf tps + `seq` rnf bmods + `seq` rnf orphs + `seq` rnf finsts + `seq` () + +newtype IfaceImportLevel = IfaceImportLevel ImportLevel + deriving (Eq, Ord) + deriving Binary via EnumBinary ImportLevel + +tcImportLevel :: IfaceImportLevel -> ImportLevel +tcImportLevel (IfaceImportLevel lvl) = lvl + +instance NFData IfaceImportLevel where + rnf (IfaceImportLevel lvl) = case lvl of + NormalLevel -> () + QuoteLevel -> () + SpliceLevel -> () + +instance Outputable IfaceImportLevel where + ppr (IfaceImportLevel lvl) = ppr lvl + + -- | Extract information from the rename and typecheck phases to produce -- a dependencies information for the module being compiled. -- @@ -113,15 +175,19 @@ mkDependencies home_unit mod imports plugin_mods = let (home_plugins, external_plugins) = partition (isHomeUnit home_unit . moduleUnit) plugin_mods plugin_units = Set.fromList (map (toUnitId . moduleUnit) external_plugins) - all_direct_mods = foldr (\mn m -> extendInstalledModuleEnv m mn (GWIB (moduleName mn) NotBoot)) + all_direct_mods = foldr (\(s, mn) m -> extendInstalledModuleEnv m mn (s, (GWIB (moduleName mn) NotBoot))) (imp_direct_dep_mods imports) - (map (fmap toUnitId) home_plugins) + (map (fmap (fmap toUnitId) . (Set.singleton SpliceLevel,)) home_plugins) - modDepsElts = Set.fromList . installedModuleEnvElts + modDepsElts_source :: Ord a => InstalledModuleEnv a -> Set.Set (InstalledModule, a) + modDepsElts_source = Set.fromList . installedModuleEnvElts -- It's OK to use nonDetEltsUFM here because sorting by module names -- restores determinism - direct_mods = first moduleUnit `Set.map` modDepsElts (delInstalledModuleEnv all_direct_mods (toUnitId <$> mod)) + modDepsElts :: Ord a => InstalledModuleEnv (Set.Set ImportLevel, a) -> Set.Set (IfaceImportLevel, UnitId, a) + modDepsElts e = Set.fromList [ (IfaceImportLevel s, moduleUnit im, a) | (im, (ss,a)) <- installedModuleEnvElts e, s <- Set.toList ss] + + direct_mods = modDepsElts (delInstalledModuleEnv all_direct_mods (toUnitId <$> mod)) -- M.hi-boot can be in the imp_dep_mods, but we must remove -- it before recording the modules on which this one depends! -- (We want to retain M.hi-boot in imp_dep_mods so that @@ -133,7 +199,7 @@ -- We must also remove self-references from imp_orphs. See -- Note [Module self-dependency] - direct_pkgs = imp_dep_direct_pkgs imports + direct_pkgs = Set.map (\(lvl, uid) -> (IfaceImportLevel lvl, uid)) (imp_dep_direct_pkgs imports) -- Set the packages required to be Safe according to Safe Haskell. -- See Note [Tracking Trust Transitively] in GHC.Rename.Names @@ -141,18 +207,18 @@ -- If there's a non-boot import, then it shadows the boot import -- coming from the dependencies - source_mods = first moduleUnit `Set.map` modDepsElts (imp_boot_mods imports) + source_mods = first moduleUnit `Set.map` modDepsElts_source (imp_boot_mods imports) sig_mods = filter (/= (moduleName mod)) $ imp_sig_mods imports - in Deps { dep_direct_mods = direct_mods - , dep_direct_pkgs = direct_pkgs - , dep_plugin_pkgs = plugin_units - , dep_sig_mods = sort sig_mods - , dep_trusted_pkgs = trust_pkgs - , dep_boot_mods = source_mods - , dep_orphs = sortBy stableModuleCmp dep_orphs - , dep_finsts = sortBy stableModuleCmp (imp_finsts imports) + in Deps { dep_direct_mods_ = direct_mods + , dep_direct_pkgs_ = direct_pkgs + , dep_plugin_pkgs_ = plugin_units + , dep_sig_mods_ = sort sig_mods + , dep_trusted_pkgs_ = trust_pkgs + , dep_boot_mods_ = source_mods + , dep_orphs_ = sortBy stableModuleCmp dep_orphs + , dep_finsts_ = sortBy stableModuleCmp (imp_finsts imports) -- sort to get into canonical order -- NB. remember to use lexicographic ordering } @@ -161,14 +227,13 @@ dep_orphs_update :: Monad m => Dependencies -> ([Module] -> m [Module]) -> m Dependencies dep_orphs_update deps f = do r <- f (dep_orphs deps) - pure (deps { dep_orphs = sortBy stableModuleCmp r }) + pure (deps { dep_orphs_ = sortBy stableModuleCmp r }) -- | Update module dependencies containing family instances (used by Backpack) dep_finsts_update :: Monad m => Dependencies -> ([Module] -> m [Module]) -> m Dependencies dep_finsts_update deps f = do r <- f (dep_finsts deps) - pure (deps { dep_finsts = sortBy stableModuleCmp r }) - + pure (deps { dep_finsts_ = sortBy stableModuleCmp r }) instance Binary Dependencies where put_ bh deps = do put_ bh (dep_direct_mods deps) @@ -188,36 +253,36 @@ sms <- get bh os <- get bh fis <- get bh - return (Deps { dep_direct_mods = dms - , dep_direct_pkgs = dps - , dep_plugin_pkgs = plugin_pkgs - , dep_sig_mods = hsigms - , dep_boot_mods = sms - , dep_trusted_pkgs = tps - , dep_orphs = os, - dep_finsts = fis }) + return (Deps { dep_direct_mods_ = dms + , dep_direct_pkgs_ = dps + , dep_plugin_pkgs_ = plugin_pkgs + , dep_sig_mods_ = hsigms + , dep_boot_mods_ = sms + , dep_trusted_pkgs_ = tps + , dep_orphs_ = os, + dep_finsts_ = fis }) noDependencies :: Dependencies noDependencies = Deps - { dep_direct_mods = Set.empty - , dep_direct_pkgs = Set.empty - , dep_plugin_pkgs = Set.empty - , dep_sig_mods = [] - , dep_boot_mods = Set.empty - , dep_trusted_pkgs = Set.empty - , dep_orphs = [] - , dep_finsts = [] + { dep_direct_mods_ = Set.empty + , dep_direct_pkgs_ = Set.empty + , dep_plugin_pkgs_ = Set.empty + , dep_sig_mods_ = [] + , dep_boot_mods_ = Set.empty + , dep_trusted_pkgs_ = Set.empty + , dep_orphs_ = [] + , dep_finsts_ = [] } -- | Pretty-print unit dependencies pprDeps :: UnitState -> Dependencies -> SDoc -pprDeps unit_state (Deps { dep_direct_mods = dmods - , dep_boot_mods = bmods - , dep_plugin_pkgs = plgns - , dep_orphs = orphs - , dep_direct_pkgs = pkgs - , dep_trusted_pkgs = tps - , dep_finsts = finsts +pprDeps unit_state (Deps { dep_direct_mods_ = dmods + , dep_boot_mods_ = bmods + , dep_plugin_pkgs_ = plgns + , dep_orphs_ = orphs + , dep_direct_pkgs_ = pkgs + , dep_trusted_pkgs_ = tps + , dep_finsts_ = finsts }) = pprWithUnitState unit_state $ vcat [text "direct module dependencies:" <+> ppr_set ppr_mod dmods, @@ -231,8 +296,8 @@ text "family instance modules:" <+> fsep (map ppr finsts) ] where - ppr_mod (uid, (GWIB mod IsBoot)) = ppr uid <> colon <> ppr mod <+> text "[boot]" - ppr_mod (uid, (GWIB mod NotBoot)) = ppr uid <> colon <> ppr mod + ppr_mod (_, uid, (GWIB mod IsBoot)) = ppr uid <> colon <> ppr mod <+> text "[boot]" + ppr_mod (lvl, uid, (GWIB mod NotBoot)) = ppr lvl <+> ppr uid <> colon <> ppr mod ppr_set :: Outputable a => (a -> SDoc) -> Set a -> SDoc ppr_set w = fsep . fmap w . Set.toAscList @@ -268,9 +333,9 @@ -- ^ Entities we depend on, sorted by occurrence name and fingerprinted. -- NB: usages are for parent names only, e.g. type constructors -- but not the associated data constructors. - usg_exports :: Maybe Fingerprint, - -- ^ Fingerprint for the export list of this module, - -- if we directly imported it (and hence we depend on its export list) + usg_exports :: Maybe HomeModImport, + -- ^ What we depend on from the exports of the module; + -- see 'HomeModImport'. usg_safe :: IsSafeImport -- ^ Was this module imported as a safe import } @@ -326,6 +391,13 @@ -- And of course, for modules that aren't imported directly we don't -- depend on their export lists +instance NFData Usage where + rnf (UsagePackageModule mod hash safe) = rnf mod `seq` rnf hash `seq` rnf safe `seq` () + rnf (UsageHomeModule mod uid hash entities exports safe) = rnf mod `seq` rnf uid `seq` rnf hash `seq` rnf entities `seq` rnf exports `seq` rnf safe `seq` () + rnf (UsageFile file hash label) = rnf file `seq` rnf hash `seq` rnf label `seq` () + rnf (UsageMergedRequirement mod hash) = rnf mod `seq` rnf hash `seq` () + rnf (UsageHomeModuleInterface mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` () + instance Binary Usage where put_ bh usg@UsagePackageModule{} = do putByte bh 0 @@ -392,11 +464,79 @@ return UsageHomeModuleInterface { usg_mod_name = mod, usg_unit_id = uid, usg_iface_hash = hash } i -> error ("Binary.get(Usage): " ++ show i) +-- | Records the imports that we depend on from a home module, +-- for recompilation checking. +-- +-- See Note [When to recompile when export lists change?] in GHC.Iface.Recomp. +data HomeModImport + = HomeModImport + -- | Hash of orphans, dependencies, orphans of dependencies etc... + -- + -- See Note [Orphan-like hash]. + -- + -- If this changes, we definitely need to recompile. + { hmiu_orphanLikeHash :: Fingerprint + -- | The avails we are importing; see 'HomeModImportedAvails'. + , hmiu_importedAvails :: HomeModImportedAvails + } + deriving stock Eq -{- -Note [Transitive Information in Dependencies] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- | Records all the 'Avail's we are importing from a home module. +data HomeModImportedAvails + -- | All import lists are explicit import lists, but some identifiers + -- may still be implicitly imported, e.g. @import M(a, b, T(..))@. + -- + -- In this case, recompilation is keyed by the names we are importing, + -- with their 'Avail' structure. + = HMIA_Explicit + { hmia_imported_avails :: DetOrdAvails + -- ^ The avails we are importing + , hmia_parents_with_implicits :: NameSet + -- ^ The 'Name's of all 'AvailTC' imports which + -- implicitly import children + } + -- | One import is a whole module import, or a @import module M hiding(..)@ + -- import. + -- + -- In this case, recompilation is keyed on the hash of the exported avails + -- of the module we are importing. + | HMIA_Implicit + { hmia_exportedAvailsHash :: Fingerprint + -- ^ The export avails hash of the module we are importing + } + deriving stock Eq +instance Outputable HomeModImport where + ppr (HomeModImport orphan_like imp_avails) = + braces (text "orphan_like:" <+> ppr orphan_like <+> text ", imported avails:" <+> ppr imp_avails) +instance Outputable HomeModImportedAvails where + ppr (HMIA_Explicit avails implicit_parents) = + braces (text "explicit:" <+> ppr avails <+> text ", implicit_parents:" <+> ppr implicit_parents) + ppr (HMIA_Implicit hash) = braces (text "implicit:" <+> ppr hash) +instance NFData HomeModImport where + rnf (HomeModImport a b) = rnf a `seq` rnf b `seq` () +instance NFData HomeModImportedAvails where + rnf (HMIA_Explicit avails implicit_parents) = rnf avails `seq` rnf implicit_parents + rnf (HMIA_Implicit hash) = rnf hash +instance Binary HomeModImport where + put_ bh (HomeModImport a b) = put_ bh a >> put_ bh b + get bh = do + a <- get bh + b <- get bh + return $ HomeModImport a b +instance Binary HomeModImportedAvails where + put_ bh (HMIA_Explicit avails implicit_parents) = + putByte bh 0 >> put_ bh avails >> put_ bh (nameSetElemsStable implicit_parents) + put_ bh (HMIA_Implicit hash ) = putByte bh 1 >> put_ bh hash + get bh = do + tag <- getByte bh + case tag of + 0 -> HMIA_Explicit <$> get bh <*> (mkNameSet <$> get bh) + 1 -> HMIA_Implicit <$> get bh + _ -> error ("Binary.get(HomeModImportedAvails): " ++ show tag) + +{- Note [Transitive Information in Dependencies] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is important to be careful what information we put in 'Dependencies' because ultimately it ends up serialised in an interface file. Interface files must always be kept up-to-date with the state of the world, so if `Dependencies` needs to be updated @@ -490,10 +630,10 @@ -- different packages. (currently not the case, but might be in the -- future). - imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot, + imp_direct_dep_mods :: InstalledModuleEnv (Set.Set ImportLevel, ModuleNameWithIsBoot), -- ^ Home-package modules directly imported by the module being compiled. - imp_dep_direct_pkgs :: Set UnitId, + imp_dep_direct_pkgs :: Set (ImportLevel, UnitId), -- ^ Packages directly needed by the module being compiled imp_trust_own_pkg :: Bool, diff --git a/GHC/Unit/Module/Env.hs b/GHC/Unit/Module/Env.hs --- a/GHC/Unit/Module/Env.hs +++ b/GHC/Unit/Module/Env.hs @@ -33,17 +33,6 @@ , mergeInstalledModuleEnv , plusInstalledModuleEnv , installedModuleEnvElts - - -- * InstalledModuleWithIsBootEnv - , InstalledModuleWithIsBootEnv - , emptyInstalledModuleWithIsBootEnv - , lookupInstalledModuleWithIsBootEnv - , extendInstalledModuleWithIsBootEnv - , filterInstalledModuleWithIsBootEnv - , delInstalledModuleWithIsBootEnv - , mergeInstalledModuleWithIsBootEnv - , plusInstalledModuleWithIsBootEnv - , installedModuleWithIsBootEnvElts ) where @@ -293,57 +282,4 @@ -> InstalledModuleEnv elt plusInstalledModuleEnv f (InstalledModuleEnv xm) (InstalledModuleEnv ym) = InstalledModuleEnv $ Map.unionWith f xm ym - - - --------------------------------------------------------------------- --- InstalledModuleWithIsBootEnv --------------------------------------------------------------------- - --- | A map keyed off of 'InstalledModuleWithIsBoot' -newtype InstalledModuleWithIsBootEnv elt = InstalledModuleWithIsBootEnv (Map InstalledModuleWithIsBoot elt) - -instance Outputable elt => Outputable (InstalledModuleWithIsBootEnv elt) where - ppr (InstalledModuleWithIsBootEnv env) = ppr env - - -emptyInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -emptyInstalledModuleWithIsBootEnv = InstalledModuleWithIsBootEnv Map.empty - -lookupInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> Maybe a -lookupInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = Map.lookup m e - -extendInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> a -> InstalledModuleWithIsBootEnv a -extendInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m x = InstalledModuleWithIsBootEnv (Map.insert m x e) - -filterInstalledModuleWithIsBootEnv :: (InstalledModuleWithIsBoot -> a -> Bool) -> InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBootEnv a -filterInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv e) = - InstalledModuleWithIsBootEnv (Map.filterWithKey f e) - -delInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> InstalledModuleWithIsBootEnv a -delInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = InstalledModuleWithIsBootEnv (Map.delete m e) - -installedModuleWithIsBootEnvElts :: InstalledModuleWithIsBootEnv a -> [(InstalledModuleWithIsBoot, a)] -installedModuleWithIsBootEnvElts (InstalledModuleWithIsBootEnv e) = Map.assocs e - -mergeInstalledModuleWithIsBootEnv - :: (elta -> eltb -> Maybe eltc) - -> (InstalledModuleWithIsBootEnv elta -> InstalledModuleWithIsBootEnv eltc) -- map X - -> (InstalledModuleWithIsBootEnv eltb -> InstalledModuleWithIsBootEnv eltc) -- map Y - -> InstalledModuleWithIsBootEnv elta - -> InstalledModuleWithIsBootEnv eltb - -> InstalledModuleWithIsBootEnv eltc -mergeInstalledModuleWithIsBootEnv f g h (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym) - = InstalledModuleWithIsBootEnv $ Map.mergeWithKey - (\_ x y -> (x `f` y)) - (coerce g) - (coerce h) - xm ym - -plusInstalledModuleWithIsBootEnv :: (elt -> elt -> elt) - -> InstalledModuleWithIsBootEnv elt - -> InstalledModuleWithIsBootEnv elt - -> InstalledModuleWithIsBootEnv elt -plusInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym) = - InstalledModuleWithIsBootEnv $ Map.unionWith f xm ym diff --git a/GHC/Unit/Module/Graph.hs b/GHC/Unit/Module/Graph.hs --- a/GHC/Unit/Module/Graph.hs +++ b/GHC/Unit/Module/Graph.hs @@ -2,416 +2,1048 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveTraversable #-} -module GHC.Unit.Module.Graph - ( ModuleGraph - , ModuleGraphNode(..) - , nodeDependencies - , emptyMG - , mkModuleGraph - , extendMG - , extendMGInst - , extendMG' - , unionMG - , isTemplateHaskellOrQQNonBoot - , filterToposortToModules - , mapMG - , mgModSummaries - , mgModSummaries' - , mgLookupModule - , mgTransDeps - , showModMsg - , moduleGraphNodeModule - , moduleGraphNodeModSum - , moduleGraphModulesBelow - - , moduleGraphNodes - , SummaryNode - , summaryNodeSummary - - , NodeKey(..) - , nodeKeyUnitId - , nodeKeyModName - , ModNodeKey - , mkNodeKey - , msKey - - - , moduleGraphNodeUnitId - - , ModNodeKeyWithUid(..) - ) -where - -import GHC.Prelude -import GHC.Platform - -import qualified GHC.LanguageExtensions as LangExt - -import GHC.Data.Maybe -import GHC.Data.Graph.Directed - -import GHC.Driver.Backend -import GHC.Driver.DynFlags - -import GHC.Types.SourceFile ( hscSourceString ) - -import GHC.Unit.Module.ModSummary -import GHC.Unit.Types -import GHC.Utils.Outputable -import GHC.Utils.Misc ( partitionWith ) - -import System.FilePath -import qualified Data.Map as Map -import GHC.Types.Unique.DSet -import qualified Data.Set as Set -import Data.Set (Set) -import GHC.Unit.Module -import GHC.Linker.Static.Utils - -import Data.Bifunctor -import Data.Function -import Data.List (sort) -import GHC.Data.List.SetOps - --- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'. --- Edges between nodes mark dependencies arising from module imports --- and dependencies arising from backpack instantiations. -data ModuleGraphNode - -- | Instantiation nodes track the instantiation of other units - -- (backpack dependencies) with the holes (signatures) of the current package. - = InstantiationNode UnitId InstantiatedUnit - -- | There is a module summary node for each module, signature, and boot module being built. - | ModuleNode [NodeKey] ModSummary - -- | Link nodes are whether are are creating a linked product (ie executable/shared object etc) for a unit. - | LinkNode [NodeKey] UnitId - -moduleGraphNodeModule :: ModuleGraphNode -> Maybe ModuleName -moduleGraphNodeModule mgn = ms_mod_name <$> (moduleGraphNodeModSum mgn) - -moduleGraphNodeModSum :: ModuleGraphNode -> Maybe ModSummary -moduleGraphNodeModSum (InstantiationNode {}) = Nothing -moduleGraphNodeModSum (LinkNode {}) = Nothing -moduleGraphNodeModSum (ModuleNode _ ms) = Just ms - -moduleGraphNodeUnitId :: ModuleGraphNode -> UnitId -moduleGraphNodeUnitId mgn = - case mgn of - InstantiationNode uid _iud -> uid - ModuleNode _ ms -> toUnitId (moduleUnit (ms_mod ms)) - LinkNode _ uid -> uid - -instance Outputable ModuleGraphNode where - ppr = \case - InstantiationNode _ iuid -> ppr iuid - ModuleNode nks ms -> ppr (msKey ms) <+> ppr nks - LinkNode uid _ -> text "LN:" <+> ppr uid - -instance Eq ModuleGraphNode where - (==) = (==) `on` mkNodeKey - -instance Ord ModuleGraphNode where - compare = compare `on` mkNodeKey - -data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit - | NodeKey_Module {-# UNPACK #-} !ModNodeKeyWithUid - | NodeKey_Link !UnitId - deriving (Eq, Ord) - -instance Outputable NodeKey where - ppr nk = pprNodeKey nk - -pprNodeKey :: NodeKey -> SDoc -pprNodeKey (NodeKey_Unit iu) = ppr iu -pprNodeKey (NodeKey_Module mk) = ppr mk -pprNodeKey (NodeKey_Link uid) = ppr uid - -nodeKeyUnitId :: NodeKey -> UnitId -nodeKeyUnitId (NodeKey_Unit iu) = instUnitInstanceOf iu -nodeKeyUnitId (NodeKey_Module mk) = mnkUnitId mk -nodeKeyUnitId (NodeKey_Link uid) = uid - -nodeKeyModName :: NodeKey -> Maybe ModuleName -nodeKeyModName (NodeKey_Module mk) = Just (gwib_mod $ mnkModuleName mk) -nodeKeyModName _ = Nothing - -data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: !ModuleNameWithIsBoot - , mnkUnitId :: !UnitId } deriving (Eq, Ord) - -instance Outputable ModNodeKeyWithUid where - ppr (ModNodeKeyWithUid mnwib uid) = ppr uid <> colon <> ppr mnwib - --- | A '@ModuleGraph@' contains all the nodes from the home package (only). See --- '@ModuleGraphNode@' for information about the nodes. --- --- Modules need to be compiled. hs-boots need to be typechecked before --- the associated "real" module so modules with {-# SOURCE #-} imports can be --- built. Instantiations also need to be typechecked to ensure that the module --- fits the signature. Substantiation typechecking is roughly comparable to the --- check that the module and its hs-boot agree. --- --- The graph is not necessarily stored in topologically-sorted order. Use --- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this. -data ModuleGraph = ModuleGraph - { mg_mss :: [ModuleGraphNode] - , mg_trans_deps :: Map.Map NodeKey (Set.Set NodeKey) - -- A cached transitive dependency calculation so that a lot of work is not - -- repeated whenever the transitive dependencies need to be calculated (for example, hptInstances) - } - --- | Map a function 'f' over all the 'ModSummaries'. --- To preserve invariants 'f' can't change the isBoot status. -mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph -mapMG f mg@ModuleGraph{..} = mg - { mg_mss = flip fmap mg_mss $ \case - InstantiationNode uid iuid -> InstantiationNode uid iuid - LinkNode uid nks -> LinkNode uid nks - ModuleNode deps ms -> ModuleNode deps (f ms) - } - -unionMG :: ModuleGraph -> ModuleGraph -> ModuleGraph -unionMG a b = - let new_mss = nubOrdBy compare $ mg_mss a `mappend` mg_mss b - in ModuleGraph { - mg_mss = new_mss - , mg_trans_deps = mkTransDeps new_mss - } - - -mgTransDeps :: ModuleGraph -> Map.Map NodeKey (Set.Set NodeKey) -mgTransDeps = mg_trans_deps - -mgModSummaries :: ModuleGraph -> [ModSummary] -mgModSummaries mg = [ m | ModuleNode _ m <- mgModSummaries' mg ] - -mgModSummaries' :: ModuleGraph -> [ModuleGraphNode] -mgModSummaries' = mg_mss - --- | Look up a ModSummary in the ModuleGraph --- Looks up the non-boot ModSummary --- Linear in the size of the module graph -mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary -mgLookupModule ModuleGraph{..} m = listToMaybe $ mapMaybe go mg_mss - where - go (ModuleNode _ ms) - | NotBoot <- isBootSummary ms - , ms_mod ms == m - = Just ms - go _ = Nothing - -emptyMG :: ModuleGraph -emptyMG = ModuleGraph [] Map.empty - -isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool -isTemplateHaskellOrQQNonBoot ms = - (xopt LangExt.TemplateHaskell (ms_hspp_opts ms) - || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) && - (isBootSummary ms == NotBoot) - --- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is --- not an element of the ModuleGraph. -extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph -extendMG ModuleGraph{..} deps ms = ModuleGraph - { mg_mss = ModuleNode deps ms : mg_mss - , mg_trans_deps = mkTransDeps (ModuleNode deps ms : mg_mss) - } - -mkTransDeps :: [ModuleGraphNode] -> Map.Map NodeKey (Set.Set NodeKey) -mkTransDeps mss = - let (gg, _lookup_node) = moduleGraphNodes False mss - in allReachable gg (mkNodeKey . node_payload) - -extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph -extendMGInst mg uid depUnitId = mg - { mg_mss = InstantiationNode uid depUnitId : mg_mss mg - } - -extendMGLink :: ModuleGraph -> UnitId -> [NodeKey] -> ModuleGraph -extendMGLink mg uid nks = mg { mg_mss = LinkNode nks uid : mg_mss mg } - -extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph -extendMG' mg = \case - InstantiationNode uid depUnitId -> extendMGInst mg uid depUnitId - ModuleNode deps ms -> extendMG mg deps ms - LinkNode deps uid -> extendMGLink mg uid deps - -mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph -mkModuleGraph = foldr (flip extendMG') emptyMG - --- | This function filters out all the instantiation nodes from each SCC of a --- topological sort. Use this with care, as the resulting "strongly connected components" --- may not really be strongly connected in a direct way, as instantiations have been --- removed. It would probably be best to eliminate uses of this function where possible. -filterToposortToModules - :: [SCC ModuleGraphNode] -> [SCC ModSummary] -filterToposortToModules = mapMaybe $ mapMaybeSCC $ \case - InstantiationNode _ _ -> Nothing - LinkNode{} -> Nothing - ModuleNode _deps node -> Just node - where - -- This higher order function is somewhat bogus, - -- as the definition of "strongly connected component" - -- is not necessarily respected. - mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b) - mapMaybeSCC f = \case - AcyclicSCC a -> AcyclicSCC <$> f a - CyclicSCC as -> case mapMaybe f as of - [] -> Nothing - [a] -> Just $ AcyclicSCC a - as -> Just $ CyclicSCC as - -showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc -showModMsg dflags _ (LinkNode {}) = - let staticLink = case ghcLink dflags of - LinkStaticLib -> True - _ -> False - - platform = targetPlatform dflags - arch_os = platformArchOS platform - exe_file = exeFileName arch_os staticLink (outputFile_ dflags) - in text exe_file -showModMsg _ _ (InstantiationNode _uid indef_unit) = - ppr $ instUnitInstanceOf indef_unit -showModMsg dflags recomp (ModuleNode _ mod_summary) = - if gopt Opt_HideSourcePaths dflags - then text mod_str - else hsep $ - [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ') - , char '(' - , text (op $ msHsFilePath mod_summary) <> char ',' - , message, char ')' ] - - where - op = normalise - mod_str = moduleNameString (moduleName (ms_mod mod_summary)) ++ - hscSourceString (ms_hsc_src mod_summary) - dyn_file = op $ msDynObjFilePath mod_summary - obj_file = op $ msObjFilePath mod_summary - files = [ obj_file ] - ++ [ dyn_file | gopt Opt_BuildDynamicToo dflags ] - ++ [ "interpreted" | gopt Opt_ByteCodeAndObjectCode dflags ] - message = case backendSpecialModuleSource (backend dflags) recomp of - Just special -> text special - Nothing -> foldr1 (\ofile rest -> ofile <> comma <+> rest) (map text files) - - - -type SummaryNode = Node Int ModuleGraphNode - -summaryNodeKey :: SummaryNode -> Int -summaryNodeKey = node_key - -summaryNodeSummary :: SummaryNode -> ModuleGraphNode -summaryNodeSummary = node_payload - --- | Collect the immediate dependencies of a ModuleGraphNode, --- optionally avoiding hs-boot dependencies. --- If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is --- an equivalent .hs-boot, add a link from the former to the latter. This --- has the effect of detecting bogus cases where the .hs-boot depends on the --- .hs, by introducing a cycle. Additionally, it ensures that we will always --- process the .hs-boot before the .hs, and so the HomePackageTable will always --- have the most up to date information. -nodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey] -nodeDependencies drop_hs_boot_nodes = \case - LinkNode deps _uid -> deps - InstantiationNode uid iuid -> - NodeKey_Module . (\mod -> ModNodeKeyWithUid (GWIB mod NotBoot) uid) <$> uniqDSetToList (instUnitHoles iuid) - ModuleNode deps _ms -> - map drop_hs_boot deps - where - -- Drop hs-boot nodes by using HsSrcFile as the key - hs_boot_key | drop_hs_boot_nodes = NotBoot -- is regular mod or signature - | otherwise = IsBoot - - drop_hs_boot (NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid)) = (NodeKey_Module (ModNodeKeyWithUid (GWIB mn hs_boot_key) uid)) - drop_hs_boot x = x - --- | Turn a list of graph nodes into an efficient queriable graph. --- The first boolean parameter indicates whether nodes corresponding to hs-boot files --- should be collapsed into their relevant hs nodes. -moduleGraphNodes :: Bool - -> [ModuleGraphNode] - -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode) -moduleGraphNodes drop_hs_boot_nodes summaries = - (graphFromEdgedVerticesUniq nodes, lookup_node) - where - -- Map from module to extra boot summary dependencies which need to be merged in - (boot_summaries, nodes) = bimap Map.fromList id $ partitionWith go numbered_summaries - - where - go (s, key) = - case s of - ModuleNode __deps ms | isBootSummary ms == IsBoot, drop_hs_boot_nodes - -- Using nodeDependencies here converts dependencies on other - -- boot files to dependencies on dependencies on non-boot files. - -> Left (ms_mod ms, nodeDependencies drop_hs_boot_nodes s) - _ -> normal_case - where - normal_case = - let lkup_key = ms_mod <$> moduleGraphNodeModSum s - extra = (lkup_key >>= \key -> Map.lookup key boot_summaries) - - in Right $ DigraphNode s key $ out_edge_keys $ - (fromMaybe [] extra - ++ nodeDependencies drop_hs_boot_nodes s) - - numbered_summaries = zip summaries [1..] - - lookup_node :: NodeKey -> Maybe SummaryNode - lookup_node key = Map.lookup key (unNodeMap node_map) - - lookup_key :: NodeKey -> Maybe Int - lookup_key = fmap summaryNodeKey . lookup_node - - node_map :: NodeMap SummaryNode - node_map = NodeMap $ - Map.fromList [ (mkNodeKey s, node) - | node <- nodes - , let s = summaryNodeSummary node - ] - - out_edge_keys :: [NodeKey] -> [Int] - out_edge_keys = mapMaybe lookup_key - -- If we want keep_hi_boot_nodes, then we do lookup_key with - -- IsBoot; else False -newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a } - deriving (Functor, Traversable, Foldable) - -mkNodeKey :: ModuleGraphNode -> NodeKey -mkNodeKey = \case - InstantiationNode _ iu -> NodeKey_Unit iu - ModuleNode _ x -> NodeKey_Module $ msKey x - LinkNode _ uid -> NodeKey_Link uid - -msKey :: ModSummary -> ModNodeKeyWithUid -msKey ms = ModNodeKeyWithUid (ms_mnwib ms) (ms_unitid ms) - -type ModNodeKey = ModuleNameWithIsBoot - - --- | This function returns all the modules belonging to the home-unit that can --- be reached by following the given dependencies. Additionally, if both the --- boot module and the non-boot module can be reached, it only returns the --- non-boot one. -moduleGraphModulesBelow :: ModuleGraph -> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid -moduleGraphModulesBelow mg uid mn = filtered_mods $ [ mn | NodeKey_Module mn <- modules_below] - where - td_map = mgTransDeps mg - - modules_below = maybe [] Set.toList $ Map.lookup (NodeKey_Module (ModNodeKeyWithUid mn uid)) td_map - - filtered_mods = Set.fromDistinctAscList . filter_mods . sort - - -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list - -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a - -- linear sweep with a window of size 2 to remove boot modules for which we - -- have the corresponding non-boot. - filter_mods = \case - (r1@(ModNodeKeyWithUid (GWIB m1 b1) uid1) : r2@(ModNodeKeyWithUid (GWIB m2 _) uid2): rs) - | m1 == m2 && uid1 == uid2 -> - let !r' = case b1 of - NotBoot -> r1 - IsBoot -> r2 - in r' : filter_mods rs - | otherwise -> r1 : filter_mods (r2:rs) - rs -> rs +-- | A module graph should be constructed once and never change from there onwards. +-- +-- The only operations should be for building the 'ModuleGraph' +-- (once and for all -- no update-like/insert-like functions) +-- and querying the structure in various ways, e.g. to determine reachability. +-- +-- We should avoid exposing fields like 'mg_mss' since it may be a footgun +-- trying to use the nodes directly... We do still expose it, but it feels like +-- all its use cases would be better served by a more proper ModuleGraph +-- abstraction +module GHC.Unit.Module.Graph + ( + -- * Construct a module graph + -- + -- | A module graph should be constructed once by downsweep and never modified. + ModuleGraph(..) + , emptyMG + , mkModuleGraph + , mkModuleGraphChecked + + -- * Invariant checking + , checkModuleGraph + , ModuleGraphInvariantError(..) + + -- * Nodes in a module graph + -- + -- | The user-facing nodes in a module graph are 'ModuleGraphNode's. + -- There are a few things which we can query out of each 'ModuleGraphNode': + -- + -- - 'mgNodeDependencies' gets the immediate dependencies of this node + -- - 'mgNodeUnitId' returns the 'UnitId' of that node + -- - 'mgNodeModSum' extracts the 'ModSummary' of a node if exists + , ModuleGraphNode(..) + , mgNodeDependencies + , mgNodeIsModule + , mgNodeUnitId + + , ModuleNodeEdge(..) + , mkModuleEdge + , mkNormalEdge + + , ModuleNodeInfo(..) + , moduleNodeInfoModule + , moduleNodeInfoUnitId + , moduleNodeInfoMnwib + , moduleNodeInfoModuleName + , moduleNodeInfoModNodeKeyWithUid + , moduleNodeInfoHscSource + , moduleNodeInfoLocation + , isBootModuleNodeInfo + -- * Module graph operations + , lengthMG + , isEmptyMG + -- ** 'ModSummary' operations + -- + -- | A couple of operations on the module graph allow access to the + -- 'ModSummary's of the modules in it contained. + -- + -- In particular, 'mapMG' and 'mapMGM' allow updating these 'ModSummary's + -- (without changing the 'ModuleGraph' structure itself!). + -- 'mgModSummaries' lists out all 'ModSummary's, and + -- 'mgLookupModule' looks up a 'ModSummary' for a given module. + , mapMG, mgMapM + , mgModSummaries + , mgLookupModule + , mgLookupModuleName + , mgHasHoles + , showModMsg + + -- ** Reachability queries + -- + -- | A module graph explains the structure and relationship between the + -- modules being compiled. Often times, this structure is relevant to + -- answer reachability queries -- is X reachable from Y; or, what is the + -- transitive closure of Z? + , mgReachable + , mgReachableLoop + , mgQuery + , ZeroScopeKey(..) + , mgQueryZero + , mgQueryMany + , mgQueryManyZero + , mgMember + + -- ** Other operations + -- + -- | These operations allow more-internal-than-ideal access to the + -- ModuleGraph structure. Ideally, we could restructure the code using + -- these functions to avoid deconstructing/reconstructing the ModuleGraph + -- and instead extend the "proper interface" of the ModuleGraph to achieve + -- what is currently done but through a better abstraction. + , mgModSummaries' + , moduleGraphNodes + , moduleGraphModulesBelow -- needed for 'hptSomeThingsBelowUs', + -- but I think we could be more clever and cache + -- the graph-ixs of boot modules to efficiently + -- filter them out of the returned list. + -- hptInstancesBelow is re-doing that work every + -- time it's called. + , filterToposortToModules + , moduleGraphNodesZero + , StageSummaryNode + , stageSummaryNodeSummary + , stageSummaryNodeKey + , mkStageDeps + + -- * Keys into the 'ModuleGraph' + , NodeKey(..) + , mkNodeKey + , nodeKeyUnitId + , nodeKeyModName + , ModNodeKey + , ModNodeKeyWithUid(..) + , mnkToModule + , moduleToMnk + , mnkToInstalledModule + , installedModuleToMnk + , mnkIsBoot + , msKey + , mnKey + , miKey + + , ImportLevel(..) + + -- ** Internal node representation + -- + -- | 'SummaryNode' is the internal representation for each node stored in + -- the graph. It's not immediately clear to me why users do depend on them. + , SummaryNode + , summaryNodeSummary + , summaryNodeKey + + ) +where + +import GHC.Prelude +import GHC.Platform + +import GHC.Data.Maybe +import Data.Either +import GHC.Data.Graph.Directed +import GHC.Data.Graph.Directed.Reachability + +import GHC.Driver.Backend +import GHC.Driver.DynFlags + +import GHC.Types.SourceFile ( hscSourceString, isHsigFile, HscSource(..)) +import GHC.Types.Basic + +import GHC.Unit.Module.ModSummary +import GHC.Unit.Types +import GHC.Utils.Outputable +import GHC.Unit.Module.ModIface +import GHC.Utils.Misc ( partitionWith ) + +import System.FilePath +import qualified Data.Map as Map +import GHC.Types.Unique.DSet +import qualified Data.Set as Set +import Data.Set (Set) +import GHC.Unit.Module +import GHC.Unit.Module.ModNodeKey +import GHC.Unit.Module.Stage +import GHC.Linker.Static.Utils + +import Data.Bifunctor +import Data.Function +import Data.List (sort) +import Data.List.NonEmpty ( NonEmpty (..) ) +import qualified Data.List.NonEmpty as NE +import Control.Monad +import qualified GHC.LanguageExtensions as LangExt + +-- | A '@ModuleGraph@' contains all the nodes from the home package (only). See +-- '@ModuleGraphNode@' for information about the nodes. +-- +-- Modules need to be compiled. hs-boots need to be typechecked before +-- the associated "real" module so modules with {-# SOURCE #-} imports can be +-- built. Instantiations also need to be typechecked to ensure that the module +-- fits the signature. Substantiation typechecking is roughly comparable to the +-- check that the module and its hs-boot agree. +-- +-- The graph is not necessarily stored in topologically-sorted order. Use +-- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this. +data ModuleGraph = ModuleGraph + { mg_mss :: [ModuleGraphNode] + , mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode) + , mg_loop_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode) + , mg_zero_graph :: (ReachabilityIndex ZeroSummaryNode, ZeroScopeKey -> Maybe ZeroSummaryNode) + + -- `mg_graph` and `mg_loop_graph` cached transitive dependency calculations + -- so that a lot of work is not repeated whenever the transitive + -- dependencies need to be calculated (for example, hptInstances). + -- + --- - `mg_graph` is a reachability index constructed from a module + -- graph /with/ boot nodes (which make the graph acyclic), and + -- + --- * `mg_loop_graph` is a reachability index for the graph /without/ + -- hs-boot nodes, that may be cyclic. + + , mg_has_holes :: !Bool + -- Cached computation, whether any of the ModuleGraphNode are isHoleModule, + -- This is only used for a hack in GHC.Iface.Load to do with backpack, please + -- remove this at the earliest opportunity. + } + +-- | Why do we ever need to construct empty graphs? Is it because of one shot mode? +emptyMG :: ModuleGraph +emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) + (graphReachability emptyGraph, const Nothing) + (graphReachability emptyGraph, const Nothing) + False + +-- | Construct a module graph. This function should be the only entry point for +-- building a 'ModuleGraph', since it is supposed to be built once and never modified. +-- +-- If you ever find the need to build a 'ModuleGraph' iteratively, don't +-- add insert and update functions to the API since they become footguns. +-- Instead, design an API that allows iterative construction without posterior +-- modification, perhaps like what is done for building arrays from mutable +-- arrays. +mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph +mkModuleGraph = foldr (flip extendMG) emptyMG + +-- | A version of mkModuleGraph that checks the module graph for invariants. +mkModuleGraphChecked :: [ModuleGraphNode] -> Either [ModuleGraphInvariantError] ModuleGraph +mkModuleGraphChecked nodes = + let mg = mkModuleGraph nodes + in case checkModuleGraph mg of + [] -> Right mg + errors -> Left errors + +-------------------------------------------------------------------------------- +-- * Module Graph Nodes +-------------------------------------------------------------------------------- + +-- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'. +-- Edges between nodes mark dependencies arising from module imports +-- and dependencies arising from backpack instantiations. +data ModuleGraphNode + -- | Instantiation nodes track the instantiation of other units + -- (backpack dependencies) with the holes (signatures) of the current package. + = InstantiationNode UnitId InstantiatedUnit + -- | There is a module node for each module being built. + -- A node is either fixed or can be compiled. + -- - Fixed modules are not compiled, the artifacts are just loaded from disk. + -- It is up to your to make sure the artifacts are up to date and available. + -- - Compile modules are compiled from source if needed. + | ModuleNode [ModuleNodeEdge] ModuleNodeInfo + -- | Link nodes are whether are are creating a linked product (ie executable/shared object etc) for a unit. + | LinkNode [NodeKey] UnitId + -- | Package dependency + | UnitNode [UnitId] UnitId + + +data ModuleNodeEdge = ModuleNodeEdge { edgeLevel :: ImportLevel + , edgeTargetKey :: NodeKey } + +mkModuleEdge :: ImportLevel -> NodeKey -> ModuleNodeEdge +mkModuleEdge level key = ModuleNodeEdge level key + +-- | A 'normal' edge in the graph which isn't offset by an import stage. +mkNormalEdge :: NodeKey -> ModuleNodeEdge +mkNormalEdge = mkModuleEdge NormalLevel + +instance Outputable ModuleNodeEdge where + ppr (ModuleNodeEdge level key) = + let level_str = case level of + NormalLevel -> "" + SpliceLevel -> "(S)" + QuoteLevel -> "(Q)" + in text level_str <> ppr key + +data ModuleGraphInvariantError = + FixedNodeDependsOnCompileNode ModNodeKeyWithUid [NodeKey] + | DuplicateModuleNodeKey NodeKey + | DependencyNotInGraph NodeKey [NodeKey] + deriving (Eq, Ord) + +instance Outputable ModuleGraphInvariantError where + ppr = \case + FixedNodeDependsOnCompileNode key bad_deps -> + text "Fixed node" <+> ppr key <+> text "depends on compile nodes" <+> ppr bad_deps + DuplicateModuleNodeKey k -> + text "Duplicate module node key" <+> ppr k + DependencyNotInGraph from to -> + text "Dependency not in graph" <+> ppr from <+> text "->" <+> ppr to + +-- Used for invariant checking. Is a NodeKey fixed or compilable? +data ModuleNodeType = MN_Fixed | MN_Compile + +instance Outputable ModuleNodeType where + ppr = \case + MN_Fixed -> text "Fixed" + MN_Compile -> text "Compile" + +moduleNodeType :: ModuleGraphNode -> ModuleNodeType +moduleNodeType (ModuleNode _ (ModuleNodeCompile _)) = MN_Compile +moduleNodeType (ModuleNode _ (ModuleNodeFixed _ _)) = MN_Fixed +moduleNodeType (UnitNode {}) = MN_Fixed +moduleNodeType _ = MN_Compile + +checkModuleGraph :: ModuleGraph -> [ModuleGraphInvariantError] +checkModuleGraph ModuleGraph{..} = + mapMaybe (checkFixedModuleInvariant node_types) mg_mss + ++ mapMaybe (checkAllDependenciesInGraph node_types) mg_mss + ++ duplicate_errs + where + duplicate_errs = rights (Map.elems node_types) + + node_types :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) + node_types = Map.fromListWithKey go [ (mkNodeKey n, Left (moduleNodeType n)) | n <- mg_mss ] + where + -- Multiple nodes with the same key are not allowed. + go :: NodeKey -> Either ModuleNodeType ModuleGraphInvariantError + -> Either ModuleNodeType ModuleGraphInvariantError + -> Either ModuleNodeType ModuleGraphInvariantError + go k _ _ = Right (DuplicateModuleNodeKey k) + +-- | Check that all dependencies in the graph are present in the node_types map. +-- This is a helper function used by checkModuleGraph. +checkAllDependenciesInGraph :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) + -> ModuleGraphNode + -> Maybe ModuleGraphInvariantError +checkAllDependenciesInGraph node_types node = + let nodeKey = mkNodeKey node + deps = mgNodeDependencies False node + missingDeps = filter (\dep -> not (Map.member dep node_types)) deps + in if null missingDeps + then Nothing + else Just (DependencyNotInGraph nodeKey missingDeps) + + +-- | Check if for the fixed module node invariant: +-- +-- Fixed nodes can only depend on other fixed nodes. +checkFixedModuleInvariant :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError) + -> ModuleGraphNode + -> Maybe ModuleGraphInvariantError +checkFixedModuleInvariant node_types node = case node of + ModuleNode deps (ModuleNodeFixed key _) -> + let check_node dep = case Map.lookup dep node_types of + -- Dependency is not fixed + Just (Left MN_Compile) -> Just dep + _ -> Nothing + bad_deps = mapMaybe check_node (map edgeTargetKey deps) + in if null bad_deps + then Nothing + else Just (FixedNodeDependsOnCompileNode key bad_deps) + + _ -> Nothing + + +{- Note [Module Types in the ModuleGraph] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Modules can be one of two different types in the module graph. + +1. ModuleNodeCompile, modules with source files we can compile. +2. ModuleNodeFixed, modules which we presume are already compiled and available. + +The ModuleGraph can contain a combination of these two types of nodes but must +obey the invariant that Fixed nodes only depend on other Fixed nodes. This invariant +can be checked by the `checkModuleGraph` function, but it's +the responsibility of the code constructing the ModuleGraph to ensure it is upheld. + +At the moment, when using --make mode, GHC itself will only use `ModuleNodeCompile` nodes. + +In oneshot mode, we don't have access to the source files of dependencies but sometimes need to know +information about the module graph still (for example, getLinkDeps). + +In theory, the whole compiler will work if an API program uses ModuleNodeFixed nodes, and +there is a simple test in FixedNodes, which can be extended in future to cover +any missing cases. + +-} +data ModuleNodeInfo = ModuleNodeFixed ModNodeKeyWithUid ModLocation + | ModuleNodeCompile ModSummary + +-- | Extract the Module from a ModuleNodeInfo +moduleNodeInfoModule :: ModuleNodeInfo -> Module +moduleNodeInfoModule (ModuleNodeFixed key _) = mnkToModule key +moduleNodeInfoModule (ModuleNodeCompile ms) = ms_mod ms + +-- | Extract the ModNodeKeyWithUid from a ModuleNodeInfo +moduleNodeInfoModNodeKeyWithUid :: ModuleNodeInfo -> ModNodeKeyWithUid +moduleNodeInfoModNodeKeyWithUid (ModuleNodeFixed key _) = key +moduleNodeInfoModNodeKeyWithUid (ModuleNodeCompile ms) = msKey ms + +-- | Extract the HscSource from a ModuleNodeInfo, if we can determine it. +moduleNodeInfoHscSource :: ModuleNodeInfo -> Maybe HscSource +moduleNodeInfoHscSource (ModuleNodeFixed _ _) = Nothing +moduleNodeInfoHscSource (ModuleNodeCompile ms) = Just (ms_hsc_src ms) + +-- | Extract the ModLocation from a ModuleNodeInfo +moduleNodeInfoLocation :: ModuleNodeInfo -> ModLocation +moduleNodeInfoLocation (ModuleNodeFixed _ loc) = loc +moduleNodeInfoLocation (ModuleNodeCompile ms) = ms_location ms + +-- | Extract the IsBootInterface from a ModuleNodeInfo +isBootModuleNodeInfo :: ModuleNodeInfo -> IsBootInterface +isBootModuleNodeInfo (ModuleNodeFixed mnwib _) = mnkIsBoot mnwib +isBootModuleNodeInfo (ModuleNodeCompile ms) = isBootSummary ms + +-- | Extract the ModuleName from a ModuleNodeInfo +moduleNodeInfoModuleName :: ModuleNodeInfo -> ModuleName +moduleNodeInfoModuleName m = moduleName (moduleNodeInfoModule m) + +moduleNodeInfoUnitId :: ModuleNodeInfo -> UnitId +moduleNodeInfoUnitId (ModuleNodeFixed key _) = mnkUnitId key +moduleNodeInfoUnitId (ModuleNodeCompile ms) = ms_unitid ms + +moduleNodeInfoMnwib :: ModuleNodeInfo -> ModuleNameWithIsBoot +moduleNodeInfoMnwib (ModuleNodeFixed key _) = mnkModuleName key +moduleNodeInfoMnwib (ModuleNodeCompile ms) = ms_mnwib ms + +-- | Collect the immediate dependencies of a ModuleGraphNode, +-- optionally avoiding hs-boot dependencies. +-- If the drop_hs_boot_nodes flag is False, and if this is a .hs and there is +-- an equivalent .hs-boot, add a link from the former to the latter. This +-- has the effect of detecting bogus cases where the .hs-boot depends on the +-- .hs, by introducing a cycle. Additionally, it ensures that we will always +-- process the .hs-boot before the .hs, and so the HomePackageTable will always +-- have the most up to date information. +mgNodeDependencies :: Bool -> ModuleGraphNode -> [NodeKey] +mgNodeDependencies drop_hs_boot_nodes = \case + LinkNode deps _uid -> deps + InstantiationNode uid iuid -> + [ NodeKey_Module (ModNodeKeyWithUid (GWIB mod NotBoot) uid) | mod <- uniqDSetToList (instUnitHoles iuid) ] + ++ [ NodeKey_ExternalUnit (instUnitInstanceOf iuid) ] + ModuleNode deps _ms -> + map (drop_hs_boot . edgeTargetKey) deps + UnitNode deps _ -> map NodeKey_ExternalUnit deps + where + -- Drop hs-boot nodes by using HsSrcFile as the key + hs_boot_key | drop_hs_boot_nodes = NotBoot -- is regular mod or signature + | otherwise = IsBoot + + drop_hs_boot (NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid)) = (NodeKey_Module (ModNodeKeyWithUid (GWIB mn hs_boot_key) uid)) + drop_hs_boot x = x + +mgNodeIsModule :: ModuleGraphNode -> Maybe ModuleNodeInfo +mgNodeIsModule (InstantiationNode {}) = Nothing +mgNodeIsModule (LinkNode {}) = Nothing +mgNodeIsModule (ModuleNode _ ms) = Just ms +mgNodeIsModule (UnitNode {}) = Nothing + +mgNodeUnitId :: ModuleGraphNode -> UnitId +mgNodeUnitId mgn = + case mgn of + InstantiationNode uid _iud -> uid + ModuleNode _ ms -> toUnitId (moduleUnit (moduleNodeInfoModule ms)) + LinkNode _ uid -> uid + UnitNode _ uid -> uid + +instance Outputable ModuleGraphNode where + ppr = \case + InstantiationNode _ iuid -> ppr iuid + ModuleNode nks ms -> ppr (mnKey ms) <+> ppr nks + LinkNode uid _ -> text "LN:" <+> ppr uid + UnitNode _ uid -> text "P:" <+> ppr uid + +instance Eq ModuleGraphNode where + (==) = (==) `on` mkNodeKey + +instance Ord ModuleGraphNode where + compare = compare `on` mkNodeKey + +-------------------------------------------------------------------------------- +-- * Module Graph operations +-------------------------------------------------------------------------------- +-- | Returns the number of nodes in a 'ModuleGraph' +lengthMG :: ModuleGraph -> Int +lengthMG = length . mg_mss + +isEmptyMG :: ModuleGraph -> Bool +isEmptyMG = null . mg_mss + +-------------------------------------------------------------------------------- +-- ** ModSummaries +-------------------------------------------------------------------------------- + +-- | Map a function 'f' over all the 'ModSummaries'. +-- To preserve invariants, 'f' can't change the isBoot status. +mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph +mapMG f mg@ModuleGraph{..} = mg + { mg_mss = flip fmap mg_mss $ \case + InstantiationNode uid iuid -> InstantiationNode uid iuid + LinkNode uid nks -> LinkNode uid nks + ModuleNode deps (ModuleNodeFixed key loc) -> ModuleNode deps (ModuleNodeFixed key loc) + ModuleNode deps (ModuleNodeCompile ms) -> ModuleNode deps (ModuleNodeCompile (f ms)) + UnitNode deps uid -> UnitNode deps uid + } + +-- | Map a function 'f' over all the 'ModSummaries', in 'IO'. +-- To preserve invariants, 'f' can't change the isBoot status. +mgMapM :: (ModuleNodeInfo -> IO ModuleNodeInfo) -> ModuleGraph -> IO ModuleGraph +mgMapM f mg@ModuleGraph{..} = do + mss' <- forM mg_mss $ \case + InstantiationNode uid iuid -> pure $ InstantiationNode uid iuid + LinkNode uid nks -> pure $ LinkNode uid nks + ModuleNode deps ms -> ModuleNode deps <$> (f ms) + UnitNode deps uid -> pure $ UnitNode deps uid + return $ mg { mg_mss = mss' } + + +mgModSummaries :: ModuleGraph -> [ModSummary] +mgModSummaries mg = [ m | ModuleNode _ (ModuleNodeCompile m) <- mgModSummaries' mg ] + +-- | Look up a non-boot ModSummary in the ModuleGraph. +-- +-- Careful: Linear in the size of the module graph +-- MP: This should probably be level aware +mgLookupModule :: ModuleGraph -> Module -> Maybe ModuleNodeInfo +mgLookupModule ModuleGraph{..} m = listToMaybe $ mapMaybe go mg_mss + where + go (ModuleNode _ ms) + | NotBoot <- isBootModuleNodeInfo ms + , moduleNodeInfoModule ms == m + = Just ms + go _ = Nothing + +-- | Lookup up a 'ModuleNameWithIsBoot' in the 'ModuleGraph'. +-- +-- Multiple nodes in the 'ModuleGraph' can have the same 'ModuleName' +-- and 'IsBootInterface'. +-- +-- Careful: Linear in the size of the module graph. +mgLookupModuleName :: ModuleGraph -> ModuleNameWithIsBoot -> [ModuleNodeInfo] +mgLookupModuleName ModuleGraph{..} m = mapMaybe go mg_mss + where + go (ModuleNode _ ms) + | moduleNodeInfoMnwib ms == m + = Just ms + go _ = Nothing + +mgMember :: ModuleGraph -> NodeKey -> Bool +mgMember graph k = isJust $ snd (mg_graph graph) k + +-- | A function you should not need to use, or desire to use. Only used +-- in one place, `GHC.Iface.Load` to facilitate a misimplementation in Backpack. +mgHasHoles :: ModuleGraph -> Bool +mgHasHoles ModuleGraph{..} = mg_has_holes + +-------------------------------------------------------------------------------- +-- ** Reachability +-------------------------------------------------------------------------------- + +-- | Return all nodes reachable from the given 'NodeKey'. +-- +-- @Nothing@ if the key couldn't be found in the graph. +mgReachable :: ModuleGraph -> NodeKey -> Maybe [ModuleGraphNode] +mgReachable mg nk = map summaryNodeSummary <$> modules_below where + (td_map, lookup_node) = mg_graph mg + modules_below = + allReachable td_map <$> lookup_node nk + +-- | Things which are reachable if hs-boot files are ignored. Used by 'getLinkDeps' +mgReachableLoop :: ModuleGraph -> [NodeKey] -> [ModuleGraphNode] +mgReachableLoop mg nk = map summaryNodeSummary modules_below where + (td_map, lookup_node) = mg_loop_graph mg + modules_below = + allReachableMany td_map (mapMaybe lookup_node nk) + + +-- | @'mgQueryZero' g root b@ answers the question: can we reach @b@ from @root@ +-- in the module graph @g@, only using normal (level 0) imports? +mgQueryZero :: ModuleGraph + -> ZeroScopeKey + -> ZeroScopeKey + -> Bool +mgQueryZero mg nka nkb = isReachable td_map na nb where + (td_map, lookup_node) = mg_zero_graph mg + na = expectJust $ lookup_node nka + nb = expectJust $ lookup_node nkb + + +-- | Reachability Query. +-- +-- @mgQuery(g, a, b)@ asks: +-- Can we reach @b@ from @a@ in graph @g@? +-- +-- Both @a@ and @b@ must be in @g@. +mgQuery :: ModuleGraph -- ^ @g@ + -> NodeKey -- ^ @a@ + -> NodeKey -- ^ @b@ + -> Bool -- ^ @b@ is reachable from @a@ +mgQuery mg nka nkb = isReachable td_map na nb where + (td_map, lookup_node) = mg_graph mg + na = expectJust $ lookup_node nka + nb = expectJust $ lookup_node nkb + +-- | Many roots reachability Query. +-- +-- @mgQuery(g, roots, b)@ asks: +-- Can we reach @b@ from any of the @roots@ in graph @g@? +-- +-- Node @b@ must be in @g@. +mgQueryMany :: ModuleGraph -- ^ @g@ + -> [NodeKey] -- ^ @roots@ + -> NodeKey -- ^ @b@ + -> Bool -- ^ @b@ is reachable from @roots@ +mgQueryMany mg roots nkb = isReachableMany td_map nroots nb where + (td_map, lookup_node) = mg_graph mg + nroots = mapMaybe lookup_node roots + nb = expectJust $ lookup_node nkb + +-- | Many roots reachability Query. +-- +-- @mgQuery(g, roots, b)@ asks: +-- Can we reach @b@ from any of the @roots@ in graph @g@, only using normal (level 0) imports? +-- +-- Node @b@ must be in @g@. +mgQueryManyZero :: ModuleGraph -- ^ @g@ + -> [ZeroScopeKey] -- ^ @roots@ + -> ZeroScopeKey -- ^ @b@ + -> Bool -- ^ @b@ is reachable from @roots@ +mgQueryManyZero mg roots nkb = isReachableMany td_map nroots nb where + (td_map, lookup_node) = mg_zero_graph mg + nroots = mapMaybe lookup_node roots + nb = expectJust $ lookup_node (pprTrace "mg" (ppr nkb) nkb) + +-------------------------------------------------------------------------------- +-- ** Other operations (read haddocks on export list) +-------------------------------------------------------------------------------- + +mgModSummaries' :: ModuleGraph -> [ModuleGraphNode] +mgModSummaries' = mg_mss + +-- | Turn a list of graph nodes into an efficient queriable graph. +-- The first boolean parameter indicates whether nodes corresponding to hs-boot files +-- should be collapsed into their relevant hs nodes. +moduleGraphNodes :: Bool + -> [ModuleGraphNode] + -> (Graph SummaryNode, NodeKey -> Maybe SummaryNode) +moduleGraphNodes drop_hs_boot_nodes summaries = + (graphFromEdgedVerticesUniq nodes, lookup_node) + where + -- Map from module to extra boot summary dependencies which need to be merged in + (boot_summaries, nodes) = bimap Map.fromList id $ partitionWith go numbered_summaries + + where + go (s, key) = + case s of + ModuleNode __deps ms | isBootModuleNodeInfo ms == IsBoot, drop_hs_boot_nodes + -- Using nodeDependencies here converts dependencies on other + -- boot files to dependencies on dependencies on non-boot files. + -> Left (moduleNodeInfoModule ms, mgNodeDependencies drop_hs_boot_nodes s) + _ -> normal_case + where + normal_case = + let lkup_key = moduleNodeInfoModule <$> mgNodeIsModule s + extra = (lkup_key >>= \key -> Map.lookup key boot_summaries) + + in Right $ DigraphNode s key $ out_edge_keys $ + (fromMaybe [] extra + ++ mgNodeDependencies drop_hs_boot_nodes s) + + numbered_summaries = zip summaries [1..] + + lookup_node :: NodeKey -> Maybe SummaryNode + lookup_node key = Map.lookup key (unNodeMap node_map) + + lookup_key :: NodeKey -> Maybe Int + lookup_key = fmap summaryNodeKey . lookup_node + + node_map :: NodeMap SummaryNode + node_map = NodeMap $ + Map.fromList [ (mkNodeKey s, node) + | node <- nodes + , let s = summaryNodeSummary node + ] + + out_edge_keys :: [NodeKey] -> [Int] + out_edge_keys = mapMaybe lookup_key + -- If we want keep_hi_boot_nodes, then we do lookup_key with + -- IsBoot; else False + + +-- | This function returns all the modules belonging to the home-unit that can +-- be reached by following the given dependencies. Additionally, if both the +-- boot module and the non-boot module can be reached, it only returns the +-- non-boot one. +moduleGraphModulesBelow :: ModuleGraph -> UnitId -> ModuleNameWithIsBoot -> Set ModNodeKeyWithUid +moduleGraphModulesBelow mg uid mn = filtered_mods [ mn | NodeKey_Module mn <- modules_below] + where + modules_below = maybe [] (map mkNodeKey) (mgReachable mg (NodeKey_Module (ModNodeKeyWithUid mn uid))) + filtered_mods = Set.fromDistinctAscList . filter_mods . sort + + -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list + -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a + -- linear sweep with a window of size 2 to remove boot modules for which we + -- have the corresponding non-boot. + filter_mods = \case + (r1@(ModNodeKeyWithUid (GWIB m1 b1) uid1) : r2@(ModNodeKeyWithUid (GWIB m2 _) uid2): rs) + | m1 == m2 && uid1 == uid2 -> + let !r' = case b1 of + NotBoot -> r1 + IsBoot -> r2 + in r' : filter_mods rs + | otherwise -> r1 : filter_mods (r2:rs) + rs -> rs + +-- | This function filters out all the instantiation nodes from each SCC of a +-- topological sort. Use this with care, as the resulting "strongly connected components" +-- may not really be strongly connected in a direct way, as instantiations have been +-- removed. It would probably be best to eliminate uses of this function where possible. +filterToposortToModules + :: [SCC ModuleGraphNode] -> [SCC ModuleNodeInfo] +filterToposortToModules = mapMaybe $ mapMaybeSCC $ \case + ModuleNode _deps node -> Just node + _ -> Nothing + where + -- This higher order function is somewhat bogus, + -- as the definition of "strongly connected component" + -- is not necessarily respected. + mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b) + mapMaybeSCC f = \case + AcyclicSCC a -> AcyclicSCC <$> f a + CyclicSCC as -> case mapMaybe f as of + [] -> Nothing + [a] -> Just $ AcyclicSCC a + as -> Just $ CyclicSCC as + +-------------------------------------------------------------------------------- +-- * Keys into ModuleGraph +-------------------------------------------------------------------------------- + +data NodeKey = NodeKey_Unit {-# UNPACK #-} !InstantiatedUnit + | NodeKey_Module {-# UNPACK #-} !ModNodeKeyWithUid + | NodeKey_Link !UnitId + | NodeKey_ExternalUnit !UnitId + deriving (Eq, Ord) + +instance Outputable NodeKey where + ppr (NodeKey_Unit iu) = ppr iu + ppr (NodeKey_Module mk) = ppr mk + ppr (NodeKey_Link uid) = ppr uid + ppr (NodeKey_ExternalUnit uid) = ppr uid + +mkNodeKey :: ModuleGraphNode -> NodeKey +mkNodeKey = \case + InstantiationNode _ iu -> NodeKey_Unit iu + ModuleNode _ x -> NodeKey_Module $ mnKey x + LinkNode _ uid -> NodeKey_Link uid + UnitNode _ uid -> NodeKey_ExternalUnit uid + +nodeKeyUnitId :: NodeKey -> UnitId +nodeKeyUnitId (NodeKey_Unit iu) = instUnitInstanceOf iu +nodeKeyUnitId (NodeKey_Module mk) = mnkUnitId mk +nodeKeyUnitId (NodeKey_Link uid) = uid +nodeKeyUnitId (NodeKey_ExternalUnit uid) = uid + +nodeKeyModName :: NodeKey -> Maybe ModuleName +nodeKeyModName (NodeKey_Module mk) = Just (gwib_mod $ mnkModuleName mk) +nodeKeyModName _ = Nothing + +msKey :: ModSummary -> ModNodeKeyWithUid +msKey ms = ModNodeKeyWithUid (ms_mnwib ms) (ms_unitid ms) + +mnKey :: ModuleNodeInfo -> ModNodeKeyWithUid +mnKey (ModuleNodeFixed key _) = key +mnKey (ModuleNodeCompile ms) = msKey ms + +miKey :: ModIface -> ModNodeKeyWithUid +miKey hmi = ModNodeKeyWithUid (mi_mnwib hmi) ((toUnitId $ moduleUnit (mi_module hmi))) + +type ModNodeKey = ModuleNameWithIsBoot + +-------------------------------------------------------------------------------- +-- ** Internal node representation (exposed) +-------------------------------------------------------------------------------- + +type SummaryNode = Node Int ModuleGraphNode + +summaryNodeKey :: SummaryNode -> Int +summaryNodeKey = node_key + +summaryNodeSummary :: SummaryNode -> ModuleGraphNode +summaryNodeSummary = node_payload + +-------------------------------------------------------------------------------- +-- * Misc utilities +-------------------------------------------------------------------------------- + +showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc +showModMsg dflags _ (LinkNode {}) = + let staticLink = case ghcLink dflags of + LinkStaticLib -> True + _ -> False + + platform = targetPlatform dflags + arch_os = platformArchOS platform + exe_file = exeFileName arch_os staticLink (outputFile_ dflags) + in text exe_file +showModMsg _ _ (UnitNode _deps uid) = ppr uid +showModMsg _ _ (InstantiationNode _uid indef_unit) = + ppr $ instUnitInstanceOf indef_unit +showModMsg dflags recomp (ModuleNode _ mni) = + if gopt Opt_HideSourcePaths dflags + then text mod_str + else hsep $ + [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ') + , char '(' + , text (moduleNodeInfoSource mni) <> char ',' + , moduleNodeInfoExtraMessage dflags recomp mni, char ')' ] + where + mod_str = moduleNameString (moduleName (moduleNodeInfoModule mni)) ++ + moduleNodeInfoBootString mni + +-- | Extra information about a 'ModuleNodeInfo' to display in the progress message. +moduleNodeInfoExtraMessage :: DynFlags -> Bool -> ModuleNodeInfo -> SDoc +moduleNodeInfoExtraMessage dflags recomp (ModuleNodeCompile mod_summary) = + let dyn_file = normalise $ msDynObjFilePath mod_summary + obj_file = normalise $ msObjFilePath mod_summary + files = obj_file + :| [ dyn_file | gopt Opt_BuildDynamicToo dflags ] + ++ [ "interpreted" | gopt Opt_ByteCodeAndObjectCode dflags ] + in case backendSpecialModuleSource (backend dflags) recomp of + Just special -> text special + Nothing -> foldr1 (\ofile rest -> ofile <> comma <+> rest) (NE.map text files) +moduleNodeInfoExtraMessage _ _ (ModuleNodeFixed {}) = text "fixed" + + +-- | The source location of the module node to show to the user. +moduleNodeInfoSource :: ModuleNodeInfo -> FilePath +moduleNodeInfoSource (ModuleNodeCompile ms) = normalise $ msHsFilePath ms +moduleNodeInfoSource (ModuleNodeFixed _ loc) = normalise $ ml_hi_file loc + +-- | The extra info about a module [boot] or [sig] to display. +moduleNodeInfoBootString :: ModuleNodeInfo -> String +moduleNodeInfoBootString (ModuleNodeCompile ms) = hscSourceString (ms_hsc_src ms) +moduleNodeInfoBootString mn@(ModuleNodeFixed {}) = + hscSourceString (case isBootModuleNodeInfo mn of + IsBoot -> HsBootFile + NotBoot -> HsSrcFile) + +-------------------------------------------------------------------------------- +-- * Internal methods for module graph +-- +-- These are *really* meant to be internal! +-- Don't expose them without careful consideration about the invariants +-- described in the export list haddocks. +-------------------------------------------------------------------------------- + +newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a } + deriving (Functor, Traversable, Foldable) + +-- | Transitive dependencies, including SOURCE edges +mkTransDeps :: [ModuleGraphNode] -> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode) +mkTransDeps = first graphReachability {- module graph is acyclic -} . moduleGraphNodes False + +-- | Transitive dependencies, ignoring SOURCE edges +mkTransLoopDeps :: [ModuleGraphNode] -> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode) +mkTransLoopDeps = first cyclicGraphReachability . moduleGraphNodes True + +-- | Transitive dependencies, but only following "normal" level 0 imports. +-- This graph can be used to query what the transitive dependencies of a particular +-- level are within a module. +mkTransZeroDeps :: [ModuleGraphNode] -> (ReachabilityIndex ZeroSummaryNode, ZeroScopeKey -> Maybe ZeroSummaryNode) +mkTransZeroDeps = first graphReachability {- module graph is acyclic -} . moduleGraphNodesZero + +-- | Transitive dependencies, but with the stage that each module is required at. +mkStageDeps :: [ModuleGraphNode] -> (ReachabilityIndex StageSummaryNode, (NodeKey, ModuleStage) -> Maybe StageSummaryNode) +mkStageDeps = first cyclicGraphReachability . moduleGraphNodesStages + +type ZeroSummaryNode = Node Int ZeroScopeKey + +zeroSummaryNodeKey :: ZeroSummaryNode -> Int +zeroSummaryNodeKey = node_key + +zeroSummaryNodeSummary :: ZeroSummaryNode -> ZeroScopeKey +zeroSummaryNodeSummary = node_payload + +-- | The 'ZeroScopeKey' indicates the different scopes which we can refer to in a zero-scope query. +data ZeroScopeKey = ModuleScope ModNodeKeyWithUid ImportLevel | UnitScope UnitId + deriving (Eq, Ord) + +instance Outputable ZeroScopeKey where + ppr (ModuleScope mk il) = text "ModuleScope" <+> ppr mk <+> ppr il + ppr (UnitScope uid) = text "UnitScope" <+> ppr uid + +-- | Turn a list of graph nodes into an efficient queriable graph. +-- This graph only has edges between level-0 imports +-- +-- This query answers the question. If I am looking at level n in module M then which +-- modules are visible? +-- +-- If you are looking at level -1 then the reachable modules are those imported at splice and +-- then any modules those modules import at zero. (Ie the zero scope for those modules) +moduleGraphNodesZero :: + [ModuleGraphNode] + -> (Graph ZeroSummaryNode, ZeroScopeKey -> Maybe ZeroSummaryNode) +moduleGraphNodesZero summaries = + (graphFromEdgedVerticesUniq nodes, lookup_node) + where + nodes = mapMaybe go numbered_summaries + + where + go :: (((ModuleGraphNode, ImportLevel)), Int) -> Maybe ZeroSummaryNode + go (((ModuleNode nks ms), s), key) = Just $ + DigraphNode (ModuleScope (mnKey ms) s) key $ out_edge_keys $ + mapMaybe (classifyDeps s) nks + go (((UnitNode uids uid), _s), key) = + Just $ DigraphNode (UnitScope uid) key (mapMaybe lookup_key $ map UnitScope uids) + go _ = Nothing + + -- This is the key part, a dependency edge also depends on the NormalLevel scope of an import. + classifyDeps s (ModuleNodeEdge il (NodeKey_Module k)) | s == il = Just (ModuleScope k NormalLevel) + classifyDeps s (ModuleNodeEdge il (NodeKey_ExternalUnit u)) | s == il = Just (UnitScope u) + classifyDeps _ _ = Nothing + + numbered_summaries :: [((ModuleGraphNode, ImportLevel), Int)] + numbered_summaries = zip (([(s, l) | s <- summaries, l <- [SpliceLevel, QuoteLevel, NormalLevel]])) [0..] + + lookup_node :: ZeroScopeKey -> Maybe ZeroSummaryNode + lookup_node key = Map.lookup key node_map + + lookup_key :: ZeroScopeKey -> Maybe Int + lookup_key = fmap zeroSummaryNodeKey . lookup_node + + node_map :: Map.Map ZeroScopeKey ZeroSummaryNode + node_map = + Map.fromList [ (s, node) + | node <- nodes + , let s = zeroSummaryNodeSummary node + ] + + out_edge_keys :: [ZeroScopeKey] -> [Int] + out_edge_keys = mapMaybe lookup_key + +type StageSummaryNode = Node Int (NodeKey, ModuleStage) + +stageSummaryNodeKey :: StageSummaryNode -> Int +stageSummaryNodeKey = node_key + +stageSummaryNodeSummary :: StageSummaryNode -> (NodeKey, ModuleStage) +stageSummaryNodeSummary = node_payload + +-- | Turn a list of graph nodes into an efficient queriable graph. +-- This graph has edges between modules and the stage they are required at. +-- +-- This graph can be used to answer the query, if I am compiling a module at stage +-- S, then what modules do I need at which stages for that? +-- Used by 'downsweep' in order to determine which modules need code generation if you +-- are using 'TemplateHaskell'. +-- +-- The rules for this query can be read in more detail in the Explicit Level Imports proposal. +-- Briefly: +-- * If NoImplicitStagePersistence then Quote/Splice/Normal imports offset the required stage +-- * If ImplicitStagePersistence and TemplateHaskell then imported module are needed at all stages. +-- * Otherwise, an imported module is just needed at the normal stage. +-- +-- * A module using TemplateHaskellQuotes required at C stage is also required at R +-- stage. +moduleGraphNodesStages :: + [ModuleGraphNode] + -> (Graph StageSummaryNode, (NodeKey, ModuleStage) -> Maybe StageSummaryNode) +moduleGraphNodesStages summaries = + (graphFromEdgedVerticesUniq nodes, lookup_node) + where + nodes = map go numbered_summaries + + where + go :: (((ModuleGraphNode, ModuleStage)), Int) -> StageSummaryNode + go (s, key) = normal_case s + where + normal_case :: (ModuleGraphNode, ModuleStage) -> StageSummaryNode + normal_case ((m@(ModuleNode nks ms), s)) = + DigraphNode ((mkNodeKey m, s)) key $ out_edge_keys $ + selfEdges ms s (mkNodeKey m) ++ concatMap (classifyDeps ms s) nks + normal_case (m, s) = + DigraphNode (mkNodeKey m, s) key (out_edge_keys . map (, s) $ mgNodeDependencies False m) + + isExplicitStageMS :: ModSummary -> Bool + isExplicitStageMS ms = not (xopt LangExt.ImplicitStagePersistence (ms_hspp_opts ms)) + + isTemplateHaskellQuotesMS :: ModSummary -> Bool + isTemplateHaskellQuotesMS ms = xopt LangExt.TemplateHaskellQuotes (ms_hspp_opts ms) + + -- Accounting for persistence within a module. + -- If a module is required @ C and it persists an idenfifier, it's also required + -- at R. + selfEdges (ModuleNodeCompile ms) s self_key + | not (isExplicitStageMS ms) + && (isTemplateHaskellQuotesMS ms + || isTemplateHaskellOrQQNonBoot ms) + = [(self_key, s') | s' <- onlyFutureStages s] + selfEdges _ _ _ = [] + + -- Case 1. No implicit stage persistnce is enabled + classifyDeps (ModuleNodeCompile ms) s (ModuleNodeEdge il k) + | isExplicitStageMS ms = case il of + SpliceLevel -> [(k, decModuleStage s)] + NormalLevel -> [(k, s)] + QuoteLevel -> [(k, incModuleStage s)] + -- Case 2a. TemplateHaskellQuotes case (section 5.6 in the paper) + classifyDeps (ModuleNodeCompile ms) s (ModuleNodeEdge _ k) + | not (isExplicitStageMS ms) + , not (isTemplateHaskellOrQQNonBoot ms) + , isTemplateHaskellQuotesMS ms + = [(k, s') | s' <- nowAndFutureStages s] + -- Case 2b. Template haskell is enabled, with implicit stage persistence + classifyDeps (ModuleNodeCompile ms) _ (ModuleNodeEdge _ k) + | isTemplateHaskellOrQQNonBoot ms + , not (isExplicitStageMS ms) = + [(k, s) | s <- allStages] + -- Case 3. No template haskell, therefore no additional dependencies. + classifyDeps _ s (ModuleNodeEdge _ k) = [(k, s)] + + + numbered_summaries :: [((ModuleGraphNode, ModuleStage), Int)] + numbered_summaries = zip (([(s, l) | s <- summaries, l <- allStages])) [0..] + + lookup_node :: (NodeKey, ModuleStage) -> Maybe StageSummaryNode + lookup_node key = Map.lookup key node_map + + lookup_key :: (NodeKey, ModuleStage) -> Maybe Int + lookup_key = fmap stageSummaryNodeKey . lookup_node + + node_map :: Map.Map (NodeKey, ModuleStage) StageSummaryNode + node_map = + Map.fromList [ (s, node) + | node <- nodes + , let s = stageSummaryNodeSummary node + ] + + out_edge_keys :: [(NodeKey, ModuleStage)] -> [Int] + out_edge_keys = mapMaybe lookup_key + -- If we want keep_hi_boot_nodes, then we do lookup_key with + -- IsBoot; else False + + +-- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is +-- not an element of the ModuleGraph. +extendMG :: ModuleGraph -> ModuleGraphNode -> ModuleGraph +extendMG ModuleGraph{..} node = + ModuleGraph + { mg_mss = node : mg_mss + , mg_graph = mkTransDeps (node : mg_mss) + , mg_loop_graph = mkTransLoopDeps (node : mg_mss) + , mg_zero_graph = mkTransZeroDeps (node : mg_mss) + , mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node) + } + diff --git a/GHC/Unit/Module/Imported.hs b/GHC/Unit/Module/Imported.hs --- a/GHC/Unit/Module/Imported.hs +++ b/GHC/Unit/Module/Imported.hs @@ -43,6 +43,9 @@ , imv_is_safe :: IsSafeImport -- ^ whether this is a safe import + , imv_is_level :: ImportLevel + -- ^ the level the module is imported at (splice, quote, or normal) + , imv_is_hiding :: Bool -- ^ whether this is an "hiding" import diff --git a/GHC/Unit/Module/Location.hs b/GHC/Unit/Module/Location.hs --- a/GHC/Unit/Module/Location.hs +++ b/GHC/Unit/Module/Location.hs @@ -13,8 +13,6 @@ ) , pattern ModLocation , addBootSuffix - , addBootSuffix_maybe - , addBootSuffixLocn_maybe , addBootSuffixLocn , addBootSuffixLocnOut , removeBootSuffix @@ -25,7 +23,6 @@ import GHC.Prelude import GHC.Data.OsPath -import GHC.Unit.Types import GHC.Types.SrcLoc import GHC.Utils.Outputable import GHC.Data.FastString (mkFastString) @@ -99,26 +96,10 @@ Just path -> path Nothing -> error "removeBootSuffix: no -boot suffix" --- | Add the @-boot@ suffix if the @Bool@ argument is @True@ -addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath -addBootSuffix_maybe is_boot path = case is_boot of - IsBoot -> addBootSuffix path - NotBoot -> path - -addBootSuffixLocn_maybe :: IsBootInterface -> ModLocation -> ModLocation -addBootSuffixLocn_maybe is_boot locn = case is_boot of - IsBoot -> addBootSuffixLocn locn - _ -> locn - -- | Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn :: ModLocation -> ModLocation addBootSuffixLocn locn - = locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) - , ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn) - , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn) - , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn) - , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn) - , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) } + = addBootSuffixLocnOut locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) } -- | Add the @-boot@ suffix to all output file paths associated with the -- module, not including the input file itself diff --git a/GHC/Unit/Module/ModGuts.hs b/GHC/Unit/Module/ModGuts.hs --- a/GHC/Unit/Module/ModGuts.hs +++ b/GHC/Unit/Module/ModGuts.hs @@ -7,7 +7,7 @@ import GHC.Prelude -import GHC.ByteCode.Types +import GHC.HsToCore.Breakpoints import GHC.ForeignSrcLang import GHC.Hs @@ -53,9 +53,8 @@ mg_exports :: ![AvailInfo], -- ^ What it exports mg_deps :: !Dependencies, -- ^ What it depends on, directly or -- otherwise - mg_usages :: ![Usage], -- ^ What was used? Used for interfaces. + mg_usages :: !(Maybe [Usage]), -- ^ What was used? Used for interfaces. - mg_used_th :: !Bool, -- ^ Did we run a TH splice? mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment -- These fields all describe the things **declared in this module** diff --git a/GHC/Unit/Module/ModIface.hs b/GHC/Unit/Module/ModIface.hs --- a/GHC/Unit/Module/ModIface.hs +++ b/GHC/Unit/Module/ModIface.hs @@ -11,1049 +11,1266 @@ module GHC.Unit.Module.ModIface ( ModIface , ModIface_ - ( mi_module - , mi_sig_of - , mi_hsc_src - , mi_deps - , mi_usages - , mi_exports - , mi_used_th - , mi_fixities - , mi_warns - , mi_anns - , mi_decls - , mi_defaults - , mi_extra_decls - , mi_foreign - , mi_top_env - , mi_insts - , mi_fam_insts - , mi_rules - , mi_hpc - , mi_trust - , mi_trust_pkg - , mi_complete_matches - , mi_docs - , mi_final_exts - , mi_ext_fields - , mi_src_hash - , mi_hi_bytes - ) - , pattern ModIface - , restoreFromOldModIface - , addSourceFingerprint - , set_mi_module - , set_mi_sig_of - , set_mi_hsc_src - , set_mi_src_hash - , set_mi_hi_bytes - , set_mi_deps - , set_mi_usages - , set_mi_exports - , set_mi_used_th - , set_mi_fixities - , set_mi_warns - , set_mi_anns - , set_mi_insts - , set_mi_fam_insts - , set_mi_rules - , set_mi_decls - , set_mi_defaults - , set_mi_extra_decls - , set_mi_foreign - , set_mi_top_env - , set_mi_hpc - , set_mi_trust - , set_mi_trust_pkg - , set_mi_complete_matches - , set_mi_docs - , set_mi_final_exts - , set_mi_ext_fields - , completePartialModIface - , IfaceBinHandle(..) - , PartialModIface - , ModIfaceBackend (..) - , IfaceDeclExts - , IfaceBackendExts - , IfaceExport - , WhetherHasOrphans - , WhetherHasFamInst - , IfaceTopEnv (..) - , IfaceImport(..) - , mi_boot - , mi_fix - , mi_semantic_module - , mi_free_holes - , mi_mnwib - , renameFreeHoles - , emptyPartialModIface - , emptyFullModIface - , mkIfaceHashCache - , emptyIfaceHashCache - , forceModIface - ) -where - -import GHC.Prelude - -import GHC.Hs - -import GHC.Iface.Syntax -import GHC.Iface.Ext.Fields - -import GHC.Unit -import GHC.Unit.Module.Deps -import GHC.Unit.Module.Warnings -import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..), emptyIfaceForeign) - -import GHC.Types.Avail -import GHC.Types.Fixity -import GHC.Types.Fixity.Env -import GHC.Types.HpcInfo -import GHC.Types.Name -import GHC.Types.Name.Reader (IfGlobalRdrEnv) -import GHC.Types.SafeHaskell -import GHC.Types.SourceFile -import GHC.Types.Unique.DSet -import GHC.Types.Unique.FM - -import GHC.Data.Maybe -import qualified GHC.Data.Strict as Strict - -import GHC.Utils.Fingerprint -import GHC.Utils.Binary - -import Control.DeepSeq -import Control.Exception - - -{- Note [Interface file stages] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Interface files have two possible stages. - -* A partial stage built from the result of the core pipeline. -* A fully instantiated form. Which also includes fingerprints and - potentially information provided by backends. - -We can build a full interface file two ways: -* Directly from a partial one: - Then we omit backend information and mostly compute fingerprints. -* From a partial one + information produced by a backend. - Then we store the provided information and fingerprint both. --} - -type PartialModIface = ModIface_ 'ModIfaceCore -type ModIface = ModIface_ 'ModIfaceFinal - --- | Extends a PartialModIface with information which is either: --- * Computed after codegen --- * Or computed just before writing the iface to disk. (Hashes) --- In order to fully instantiate it. -data ModIfaceBackend = ModIfaceBackend - { mi_iface_hash :: !Fingerprint - -- ^ Hash of the whole interface - , mi_mod_hash :: !Fingerprint - -- ^ Hash of the ABI only - , mi_flag_hash :: !Fingerprint - -- ^ Hash of the important flags used when compiling the module, excluding - -- optimisation flags - , mi_opt_hash :: !Fingerprint - -- ^ Hash of optimisation flags - , mi_hpc_hash :: !Fingerprint - -- ^ Hash of hpc flags - , mi_plugin_hash :: !Fingerprint - -- ^ Hash of plugins - , mi_orphan :: !WhetherHasOrphans - -- ^ Whether this module has orphans - , mi_finsts :: !WhetherHasFamInst - -- ^ Whether this module has family instances. See Note [The type family - -- instance consistency story]. - , mi_exp_hash :: !Fingerprint - -- ^ Hash of export list - , mi_orphan_hash :: !Fingerprint - -- ^ Hash for orphan rules, class and family instances combined - - -- Cached environments for easy lookup. These are computed (lazily) from - -- other fields and are not put into the interface file. - -- Not really produced by the backend but there is no need to create them - -- any earlier. - , mi_decl_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn)) - -- ^ Cached lookup for 'mi_warns' for declaration deprecations - , mi_export_warn_fn :: !(Name -> Maybe (WarningTxt GhcRn)) - -- ^ Cached lookup for 'mi_warns' for export deprecations - , mi_fix_fn :: !(OccName -> Maybe Fixity) - -- ^ Cached lookup for 'mi_fixities' - , mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint)) - -- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that - -- the thing isn't in decls. It's useful to know that when seeing if we are - -- up to date wrt. the old interface. The 'OccName' is the parent of the - -- name, if it has one. - } - -data ModIfacePhase - = ModIfaceCore - -- ^ Partial interface built based on output of core pipeline. - | ModIfaceFinal - --- | Selects a IfaceDecl representation. --- For fully instantiated interfaces we also maintain --- a fingerprint, which is used for recompilation checks. -type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where - IfaceDeclExts 'ModIfaceCore = IfaceDecl - IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl) - -type family IfaceBackendExts (phase :: ModIfacePhase) = bk | bk -> phase where - IfaceBackendExts 'ModIfaceCore = () - IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend - --- | In-memory byte array representation of a 'ModIface'. --- --- See Note [Sharing of ModIface] for why we need this. -data IfaceBinHandle (phase :: ModIfacePhase) where - -- | A partial 'ModIface' cannot be serialised to disk. - PartialIfaceBinHandle :: IfaceBinHandle 'ModIfaceCore - -- | Optional 'FullBinData' that can be serialised to disk directly. - -- - -- See Note [Private fields in ModIface] for when this fields needs to be cleared - -- (e.g., set to 'Nothing'). - FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal - --- | A 'ModIface' plus a 'ModDetails' summarises everything we know --- about a compiled module. The 'ModIface' is the stuff *before* linking, --- and can be written out to an interface file. The 'ModDetails is after --- linking and can be completely recovered from just the 'ModIface'. --- --- When we read an interface file, we also construct a 'ModIface' from it, --- except that we explicitly make the 'mi_decls' and a few other fields empty; --- as when reading we consolidate the declarations etc. into a number of indexed --- maps and environments in the 'ExternalPackageState'. --- --- See Note [Strictness in ModIface] to learn about why some fields are --- strict and others are not. --- --- See Note [Private fields in ModIface] to learn why we don't export any of the --- fields. -data ModIface_ (phase :: ModIfacePhase) - = PrivateModIface { - mi_module_ :: !Module, -- ^ Name of the module we are for - mi_sig_of_ :: !(Maybe Module), -- ^ Are we a sig of another mod? - - mi_hsc_src_ :: !HscSource, -- ^ Boot? Signature? - - mi_deps_ :: Dependencies, - -- ^ The dependencies of the module. This is - -- consulted for directly-imported modules, but not - -- for anything else (hence lazy) - - mi_usages_ :: [Usage], - -- ^ Usages; kept sorted so that it's easy to decide - -- whether to write a new iface file (changing usages - -- doesn't affect the hash of this module) - -- NOT STRICT! we read this field lazily from the interface file - -- It is *only* consulted by the recompilation checker - -- - -- The elements must be *deterministically* sorted to guarantee - -- deterministic interface files - - mi_exports_ :: ![IfaceExport], - -- ^ Exports - -- Kept sorted by (mod,occ), to make version comparisons easier - -- Records the modules that are the declaration points for things - -- exported by this module, and the 'OccName's of those things - - - mi_used_th_ :: !Bool, - -- ^ Module required TH splices when it was compiled. - -- This disables recompilation avoidance (see #481). - - mi_fixities_ :: [(OccName,Fixity)], - -- ^ Fixities - -- NOT STRICT! we read this field lazily from the interface file - - mi_warns_ :: IfaceWarnings, - -- ^ Warnings - -- NOT STRICT! we read this field lazily from the interface file - - mi_anns_ :: [IfaceAnnotation], - -- ^ Annotations - -- NOT STRICT! we read this field lazily from the interface file - - - mi_decls_ :: [IfaceDeclExts phase], - -- ^ Type, class and variable declarations - -- The hash of an Id changes if its fixity or deprecations change - -- (as well as its type of course) - -- Ditto data constructors, class operations, except that - -- the hash of the parent class/tycon changes - - mi_extra_decls_ :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo], - -- ^ Extra variable definitions which are **NOT** exposed but when - -- combined with mi_decls allows us to restart code generation. - -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs] - - mi_foreign_ :: !IfaceForeign, - -- ^ Foreign stubs and files to supplement 'mi_extra_decls_'. - -- See Note [Foreign stubs and TH bytecode linking] - - mi_defaults_ :: [IfaceDefault], - -- ^ default declarations exported by the module - - mi_top_env_ :: !(Maybe IfaceTopEnv), - -- ^ Just enough information to reconstruct the top level environment in - -- the /original source/ code for this module. which - -- is NOT the same as mi_exports, nor mi_decls (which - -- may contains declarations for things not actually - -- defined by the user). Used for GHCi and for inspecting - -- the contents of modules via the GHC API only. - -- - -- (We need the source file to figure out the - -- top-level environment, if we didn't compile this module - -- from source then this field contains @Nothing@). - -- - -- Strictly speaking this field should live in the - -- 'HomeModInfo', but that leads to more plumbing. - - -- Instance declarations and rules - mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance - mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances - mi_rules_ :: [IfaceRule], -- ^ Sorted rules - - mi_hpc_ :: !AnyHpcUsage, - -- ^ True if this program uses Hpc at any point in the program. - - mi_trust_ :: !IfaceTrustInfo, - -- ^ Safe Haskell Trust information for this module. - - mi_trust_pkg_ :: !Bool, - -- ^ Do we require the package this module resides in be trusted - -- to trust this module? This is used for the situation where a - -- module is Safe (so doesn't require the package be trusted - -- itself) but imports some trustworthy modules from its own - -- package (which does require its own package be trusted). - -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_matches_ :: ![IfaceCompleteMatch], - - mi_docs_ :: !(Maybe Docs), - -- ^ Docstrings and related data for use by haddock, the ghci - -- @:doc@ command, and other tools. - -- - -- @Just _@ @<=>@ the module was built with @-haddock@. - - mi_final_exts_ :: !(IfaceBackendExts phase), - -- ^ Either `()` or `ModIfaceBackend` for - -- a fully instantiated interface. - - mi_ext_fields_ :: !ExtensibleFields, - -- ^ Additional optional fields, where the Map key represents - -- the field name, resulting in a (size, serialized data) pair. - -- Because the data is intended to be serialized through the - -- internal `Binary` class (increasing compatibility with types - -- using `Name` and `FastString`, such as HIE), this format is - -- chosen over `ByteString`s. - -- - - mi_src_hash_ :: !Fingerprint, - -- ^ Hash of the .hs source, used for recompilation checking. - mi_hi_bytes_ :: !(IfaceBinHandle phase) - -- ^ A serialised in-memory buffer of this 'ModIface'. - -- If this handle is given, we can avoid serialising the 'ModIface' - -- when writing this 'ModIface' to disk, and write this buffer to disk instead. - -- See Note [Sharing of ModIface]. - } - --- Enough information to reconstruct the top level environment for a module -data IfaceTopEnv - = IfaceTopEnv - { ifaceTopExports :: !IfGlobalRdrEnv -- ^ all top level things in this module, including unexported stuff - , ifaceImports :: ![IfaceImport] -- ^ all the imports in this module - } - -instance NFData IfaceTopEnv where - rnf (IfaceTopEnv a b) = rnf a `seq` rnf b - -{- -Note [Strictness in ModIface] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The ModIface is the Haskell representation of an interface (.hi) file. - -* During compilation we write out ModIface values to disk for files - that we have just compiled -* For packages that we depend on we load the ModIface from disk. - -Some fields in the ModIface are deliberately lazy because when we read -an interface file we don't always need all the parts. For example, an -interface file contains information about documentation which is often -not needed during compilation. This is achieved using the lazyPut/lazyGet pair. -If the field was strict then we would pointlessly load this information into memory. - -On the other hand, if we create a ModIface but **don't** write it to -disk then to avoid space leaks we need to make sure to deepseq all these lazy fields -because the ModIface might live for a long time (for instance in a GHCi session). -That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to -forceModIface. --} - --- | Old-style accessor for whether or not the ModIface came from an hs-boot --- file. -mi_boot :: ModIface -> IsBootInterface -mi_boot iface = if mi_hsc_src iface == HsBootFile - then IsBoot - else NotBoot - -mi_mnwib :: ModIface -> ModuleNameWithIsBoot -mi_mnwib iface = GWIB (moduleName $ mi_module iface) (mi_boot iface) - --- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be --- found, 'defaultFixity' is returned instead. -mi_fix :: ModIface -> OccName -> Fixity -mi_fix iface name = mi_fix_fn (mi_final_exts iface) name `orElse` defaultFixity - --- | The semantic module for this interface; e.g., if it's a interface --- for a signature, if 'mi_module' is @p[A=]:A@, 'mi_semantic_module' --- will be @@. -mi_semantic_module :: ModIface_ a -> Module -mi_semantic_module iface = case mi_sig_of iface of - Nothing -> mi_module iface - Just mod -> mod - --- | The "precise" free holes, e.g., the signatures that this --- 'ModIface' depends on. -mi_free_holes :: ModIface -> UniqDSet ModuleName -mi_free_holes iface = - case getModuleInstantiation (mi_module iface) of - (_, Just indef) - -- A mini-hack: we rely on the fact that 'renameFreeHoles' - -- drops things that aren't holes. - -> renameFreeHoles (mkUniqDSet cands) (instUnitInsts (moduleUnit indef)) - _ -> emptyUniqDSet - where - cands = dep_sig_mods $ mi_deps iface - --- | Given a set of free holes, and a unit identifier, rename --- the free holes according to the instantiation of the unit --- identifier. For example, if we have A and B free, and --- our unit identity is @p[A=,B=impl:B]@, the renamed free --- holes are just C. -renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName -renameFreeHoles fhs insts = - unionManyUniqDSets (map lookup_impl (uniqDSetToList fhs)) - where - hmap = listToUFM insts - lookup_impl mod_name - | Just mod <- lookupUFM hmap mod_name = moduleFreeHoles mod - -- It wasn't actually a hole - | otherwise = emptyUniqDSet - --- See Note [Strictness in ModIface] about where we use lazyPut vs put -instance Binary ModIface where - put_ bh (PrivateModIface { - mi_module_ = mod, - mi_sig_of_ = sig_of, - mi_hsc_src_ = hsc_src, - mi_src_hash_ = _src_hash, -- Don't `put_` this in the instance - -- because we are going to write it - -- out separately in the actual file - mi_hi_bytes_ = _hi_bytes, -- We don't serialise the 'mi_hi_bytes_', as it itself - -- may contain an in-memory byte array buffer for this - -- 'ModIface'. If we used 'put_' on this 'ModIface', then - -- we likely have a good reason, and do not want to reuse - -- the byte array. - -- See Note [Private fields in ModIface] - mi_deps_ = deps, - mi_usages_ = usages, - mi_exports_ = exports, - mi_used_th_ = used_th, - mi_fixities_ = fixities, - mi_warns_ = warns, - mi_anns_ = anns, - mi_decls_ = decls, - mi_extra_decls_ = extra_decls, - mi_foreign_ = foreign_, - mi_defaults_ = defaults, - mi_insts_ = insts, - mi_fam_insts_ = fam_insts, - mi_rules_ = rules, - mi_hpc_ = hpc_info, - mi_trust_ = trust, - mi_trust_pkg_ = trust_pkg, - mi_complete_matches_ = complete_matches, - mi_docs_ = docs, - mi_ext_fields_ = _ext_fields, -- Don't `put_` this in the instance so we - -- can deal with it's pointer in the header - -- when we write the actual file - mi_final_exts_ = ModIfaceBackend { - mi_iface_hash = iface_hash, - mi_mod_hash = mod_hash, - mi_flag_hash = flag_hash, - mi_opt_hash = opt_hash, - mi_hpc_hash = hpc_hash, - mi_plugin_hash = plugin_hash, - mi_orphan = orphan, - mi_finsts = hasFamInsts, - mi_exp_hash = exp_hash, - mi_orphan_hash = orphan_hash - }}) = do - put_ bh mod - put_ bh sig_of - put_ bh hsc_src - put_ bh iface_hash - put_ bh mod_hash - put_ bh flag_hash - put_ bh opt_hash - put_ bh hpc_hash - put_ bh plugin_hash - put_ bh orphan - put_ bh hasFamInsts - lazyPut bh deps - lazyPut bh usages - put_ bh exports - put_ bh exp_hash - put_ bh used_th - put_ bh fixities - lazyPut bh warns - lazyPut bh anns - put_ bh decls - put_ bh extra_decls - put_ bh defaults - put_ bh foreign_ - put_ bh insts - put_ bh fam_insts - lazyPut bh rules - put_ bh orphan_hash - put_ bh hpc_info - put_ bh trust - put_ bh trust_pkg - put_ bh complete_matches - lazyPutMaybe bh docs - - get bh = do - mod <- get bh - sig_of <- get bh - hsc_src <- get bh - iface_hash <- get bh - mod_hash <- get bh - flag_hash <- get bh - opt_hash <- get bh - hpc_hash <- get bh - plugin_hash <- get bh - orphan <- get bh - hasFamInsts <- get bh - deps <- lazyGet bh - usages <- {-# SCC "bin_usages" #-} lazyGet bh - exports <- {-# SCC "bin_exports" #-} get bh - exp_hash <- get bh - used_th <- get bh - fixities <- {-# SCC "bin_fixities" #-} get bh - warns <- {-# SCC "bin_warns" #-} lazyGet bh - anns <- {-# SCC "bin_anns" #-} lazyGet bh - decls <- {-# SCC "bin_tycldecls" #-} get bh - extra_decls <- get bh - defaults <- get bh - foreign_ <- get bh - insts <- {-# SCC "bin_insts" #-} get bh - fam_insts <- {-# SCC "bin_fam_insts" #-} get bh - rules <- {-# SCC "bin_rules" #-} lazyGet bh - orphan_hash <- get bh - hpc_info <- get bh - trust <- get bh - trust_pkg <- get bh - complete_matches <- get bh - docs <- lazyGetMaybe bh - return (PrivateModIface { - mi_module_ = mod, - mi_sig_of_ = sig_of, - mi_hsc_src_ = hsc_src, - mi_src_hash_ = fingerprint0, -- placeholder because this is dealt - -- with specially when the file is read - mi_hi_bytes_ = - -- We can't populate this field here, as we are - -- missing the 'mi_ext_fields_' field, which is - -- handled in 'getIfaceWithExtFields'. - FullIfaceBinHandle Strict.Nothing, - mi_deps_ = deps, - mi_usages_ = usages, - mi_exports_ = exports, - mi_used_th_ = used_th, - mi_anns_ = anns, - mi_fixities_ = fixities, - mi_warns_ = warns, - mi_decls_ = decls, - mi_extra_decls_ = extra_decls, - mi_foreign_ = foreign_, - mi_top_env_ = Nothing, - mi_defaults_ = defaults, - mi_insts_ = insts, - mi_fam_insts_ = fam_insts, - mi_rules_ = rules, - mi_hpc_ = hpc_info, - mi_trust_ = trust, - mi_trust_pkg_ = trust_pkg, - -- And build the cached values - mi_complete_matches_ = complete_matches, - mi_docs_ = docs, - mi_ext_fields_ = emptyExtensibleFields, -- placeholder because this is dealt - -- with specially when the file is read - mi_final_exts_ = ModIfaceBackend { - mi_iface_hash = iface_hash, - mi_mod_hash = mod_hash, - mi_flag_hash = flag_hash, - mi_opt_hash = opt_hash, - mi_hpc_hash = hpc_hash, - mi_plugin_hash = plugin_hash, - mi_orphan = orphan, - mi_finsts = hasFamInsts, - mi_exp_hash = exp_hash, - mi_orphan_hash = orphan_hash, - mi_decl_warn_fn = mkIfaceDeclWarnCache $ fromIfaceWarnings warns, - mi_export_warn_fn = mkIfaceExportWarnCache $ fromIfaceWarnings warns, - mi_fix_fn = mkIfaceFixCache fixities, - mi_hash_fn = mkIfaceHashCache decls - }}) - - --- | The original names declared of a certain module that are exported -type IfaceExport = AvailInfo - -emptyPartialModIface :: Module -> PartialModIface -emptyPartialModIface mod - = PrivateModIface - { mi_module_ = mod, - mi_sig_of_ = Nothing, - mi_hsc_src_ = HsSrcFile, - mi_src_hash_ = fingerprint0, - mi_hi_bytes_ = PartialIfaceBinHandle, - mi_deps_ = noDependencies, - mi_usages_ = [], - mi_exports_ = [], - mi_used_th_ = False, - mi_fixities_ = [], - mi_warns_ = IfWarnSome [] [], - mi_anns_ = [], - mi_defaults_ = [], - mi_insts_ = [], - mi_fam_insts_ = [], - mi_rules_ = [], - mi_decls_ = [], - mi_extra_decls_ = Nothing, - mi_foreign_ = emptyIfaceForeign, - mi_top_env_ = Nothing, - mi_hpc_ = False, - mi_trust_ = noIfaceTrustInfo, - mi_trust_pkg_ = False, - mi_complete_matches_ = [], - mi_docs_ = Nothing, - mi_final_exts_ = (), - mi_ext_fields_ = emptyExtensibleFields - } - -emptyFullModIface :: Module -> ModIface -emptyFullModIface mod = - (emptyPartialModIface mod) - { mi_decls_ = [] - , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing - , mi_final_exts_ = ModIfaceBackend - { mi_iface_hash = fingerprint0, - mi_mod_hash = fingerprint0, - mi_flag_hash = fingerprint0, - mi_opt_hash = fingerprint0, - mi_hpc_hash = fingerprint0, - mi_plugin_hash = fingerprint0, - mi_orphan = False, - mi_finsts = False, - mi_exp_hash = fingerprint0, - mi_orphan_hash = fingerprint0, - mi_decl_warn_fn = emptyIfaceWarnCache, - mi_export_warn_fn = emptyIfaceWarnCache, - mi_fix_fn = emptyIfaceFixCache, - mi_hash_fn = emptyIfaceHashCache } } - --- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' -mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] - -> (OccName -> Maybe (OccName, Fingerprint)) -mkIfaceHashCache pairs - = \occ -> lookupOccEnv env occ - where - env = foldl' add_decl emptyOccEnv pairs - add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d) - where - add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash) - -emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) -emptyIfaceHashCache _occ = Nothing - --- Take care, this instance only forces to the degree necessary to --- avoid major space leaks. -instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) - , NFData (IfaceDeclExts (phase :: ModIfacePhase)) - ) => NFData (ModIface_ phase) where - rnf (PrivateModIface - { mi_module_, mi_sig_of_, mi_hsc_src_, mi_hi_bytes_, mi_deps_, mi_usages_ - , mi_exports_, mi_used_th_, mi_fixities_, mi_warns_, mi_anns_ - , mi_decls_, mi_defaults_, mi_extra_decls_, mi_foreign_, mi_top_env_, mi_insts_ - , mi_fam_insts_, mi_rules_, mi_hpc_, mi_trust_, mi_trust_pkg_ - , mi_complete_matches_, mi_docs_, mi_final_exts_ - , mi_ext_fields_, mi_src_hash_ }) - = rnf mi_module_ - `seq` rnf mi_sig_of_ - `seq` mi_hsc_src_ - `seq` mi_hi_bytes_ - `seq` mi_deps_ - `seq` mi_usages_ - `seq` mi_exports_ - `seq` rnf mi_used_th_ - `seq` mi_fixities_ - `seq` rnf mi_warns_ - `seq` rnf mi_anns_ - `seq` rnf mi_decls_ - `seq` rnf mi_defaults_ - `seq` rnf mi_extra_decls_ - `seq` rnf mi_foreign_ - `seq` rnf mi_top_env_ - `seq` rnf mi_insts_ - `seq` rnf mi_fam_insts_ - `seq` rnf mi_rules_ - `seq` rnf mi_hpc_ - `seq` mi_trust_ - `seq` rnf mi_trust_pkg_ - `seq` rnf mi_complete_matches_ - `seq` rnf mi_docs_ - `seq` mi_final_exts_ - `seq` mi_ext_fields_ - `seq` rnf mi_src_hash_ - `seq` () - -instance NFData (ModIfaceBackend) where - rnf (ModIfaceBackend{ mi_iface_hash, mi_mod_hash, mi_flag_hash, mi_opt_hash - , mi_hpc_hash, mi_plugin_hash, mi_orphan, mi_finsts, mi_exp_hash - , mi_orphan_hash, mi_decl_warn_fn, mi_export_warn_fn, mi_fix_fn - , mi_hash_fn}) - = rnf mi_iface_hash - `seq` rnf mi_mod_hash - `seq` rnf mi_flag_hash - `seq` rnf mi_opt_hash - `seq` rnf mi_hpc_hash - `seq` rnf mi_plugin_hash - `seq` rnf mi_orphan - `seq` rnf mi_finsts - `seq` rnf mi_exp_hash - `seq` rnf mi_orphan_hash - `seq` rnf mi_decl_warn_fn - `seq` rnf mi_export_warn_fn - `seq` rnf mi_fix_fn - `seq` rnf mi_hash_fn - - -forceModIface :: ModIface -> IO () -forceModIface iface = () <$ (evaluate $ force iface) - --- | Records whether a module has orphans. An \"orphan\" is one of: --- --- * An instance declaration in a module other than the definition --- module for one of the type constructors or classes in the instance head --- --- * A rewrite rule in a module other than the one defining --- the function in the head of the rule --- -type WhetherHasOrphans = Bool - --- | Does this module define family instances? -type WhetherHasFamInst = Bool - --- ---------------------------------------------------------------------------- --- Modify a 'ModIface'. --- ---------------------------------------------------------------------------- - -{- -Note [Private fields in ModIface] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The fields of 'ModIface' are private, e.g., not exported, to make the API -impossible to misuse. A 'ModIface' can be "compressed" in-memory using -'shareIface', which serialises the 'ModIface' to an in-memory buffer. -This has the advantage of reducing memory usage of 'ModIface', reducing the -overall memory usage of GHC. -See Note [Sharing of ModIface]. - -This in-memory buffer can be reused, if and only if the 'ModIface' is not -modified after it has been "compressed"/shared via 'shareIface'. Instead of -serialising 'ModIface', we simply write the in-memory buffer to disk directly. - -However, we can't rely that a 'ModIface' isn't modified after 'shareIface' has -been called. Thus, we make all fields of 'ModIface' private and modification -only happens via exported update functions, such as 'set_mi_decls'. -These functions unconditionally clear any in-memory buffer if used, forcing us -to serialise the 'ModIface' to disk again. --} - --- | Given a 'PartialModIface', turn it into a 'ModIface' by completing --- missing fields. -completePartialModIface :: PartialModIface - -> [(Fingerprint, IfaceDecl)] - -> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] - -> ModIfaceBackend - -> ModIface -completePartialModIface partial decls extra_decls final_exts = partial - { mi_decls_ = decls - , mi_extra_decls_ = extra_decls - , mi_final_exts_ = final_exts - , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing - } - --- | Add a source fingerprint to a 'ModIface_' without invalidating the byte array --- buffer 'mi_hi_bytes'. --- This is a variant of 'set_mi_src_hash' which does invalidate the buffer. --- --- The 'mi_src_hash' is computed outside of 'ModIface_' based on the 'ModSummary'. -addSourceFingerprint :: Fingerprint -> ModIface_ phase -> ModIface_ phase -addSourceFingerprint val iface = iface { mi_src_hash_ = val } - --- | Copy fields that aren't serialised to disk to the new 'ModIface_'. --- This includes especially hashes that are usually stored in the interface --- file header and 'mi_top_env'. --- --- We need this function after calling 'shareIface', to make sure the --- 'ModIface_' doesn't lose any information. This function does not discard --- the in-memory byte array buffer 'mi_hi_bytes'. -restoreFromOldModIface :: ModIface_ phase -> ModIface_ phase -> ModIface_ phase -restoreFromOldModIface old new = new - { mi_top_env_ = mi_top_env_ old - , mi_hsc_src_ = mi_hsc_src_ old - , mi_src_hash_ = mi_src_hash_ old - } - -set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase -set_mi_module val iface = clear_mi_hi_bytes $ iface { mi_module_ = val } - -set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase -set_mi_sig_of val iface = clear_mi_hi_bytes $ iface { mi_sig_of_ = val } - -set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase -set_mi_hsc_src val iface = clear_mi_hi_bytes $ iface { mi_hsc_src_ = val } - -set_mi_src_hash :: Fingerprint -> ModIface_ phase -> ModIface_ phase -set_mi_src_hash val iface = clear_mi_hi_bytes $ iface { mi_src_hash_ = val } - -set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase -set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val } - -set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase -set_mi_deps val iface = clear_mi_hi_bytes $ iface { mi_deps_ = val } - -set_mi_usages :: [Usage] -> ModIface_ phase -> ModIface_ phase -set_mi_usages val iface = clear_mi_hi_bytes $ iface { mi_usages_ = val } - -set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase -set_mi_exports val iface = clear_mi_hi_bytes $ iface { mi_exports_ = val } - -set_mi_used_th :: Bool -> ModIface_ phase -> ModIface_ phase -set_mi_used_th val iface = clear_mi_hi_bytes $ iface { mi_used_th_ = val } - -set_mi_fixities :: [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase -set_mi_fixities val iface = clear_mi_hi_bytes $ iface { mi_fixities_ = val } - -set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase -set_mi_warns val iface = clear_mi_hi_bytes $ iface { mi_warns_ = val } - -set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase -set_mi_anns val iface = clear_mi_hi_bytes $ iface { mi_anns_ = val } - -set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase -set_mi_insts val iface = clear_mi_hi_bytes $ iface { mi_insts_ = val } - -set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase -set_mi_fam_insts val iface = clear_mi_hi_bytes $ iface { mi_fam_insts_ = val } - -set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase -set_mi_rules val iface = clear_mi_hi_bytes $ iface { mi_rules_ = val } - -set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase -set_mi_decls val iface = clear_mi_hi_bytes $ iface { mi_decls_ = val } - -set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase -set_mi_defaults val iface = clear_mi_hi_bytes $ iface { mi_defaults_ = val } - -set_mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> ModIface_ phase -> ModIface_ phase -set_mi_extra_decls val iface = clear_mi_hi_bytes $ iface { mi_extra_decls_ = val } - -set_mi_foreign :: IfaceForeign -> ModIface_ phase -> ModIface_ phase -set_mi_foreign foreign_ iface = clear_mi_hi_bytes $ iface { mi_foreign_ = foreign_ } - -set_mi_top_env :: Maybe IfaceTopEnv -> ModIface_ phase -> ModIface_ phase -set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val } - -set_mi_hpc :: AnyHpcUsage -> ModIface_ phase -> ModIface_ phase -set_mi_hpc val iface = clear_mi_hi_bytes $ iface { mi_hpc_ = val } - -set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase -set_mi_trust val iface = clear_mi_hi_bytes $ iface { mi_trust_ = val } - -set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase -set_mi_trust_pkg val iface = clear_mi_hi_bytes $ iface { mi_trust_pkg_ = val } - -set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase -set_mi_complete_matches val iface = clear_mi_hi_bytes $ iface { mi_complete_matches_ = val } - -set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase -set_mi_docs val iface = clear_mi_hi_bytes $ iface { mi_docs_ = val } - -set_mi_final_exts :: IfaceBackendExts phase -> ModIface_ phase -> ModIface_ phase -set_mi_final_exts val iface = clear_mi_hi_bytes $ iface { mi_final_exts_ = val } - -set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase -set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val } - --- | Invalidate any byte array buffer we might have. -clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase -clear_mi_hi_bytes iface = iface - { mi_hi_bytes_ = case mi_hi_bytes iface of - PartialIfaceBinHandle -> PartialIfaceBinHandle - FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing - } - --- ---------------------------------------------------------------------------- --- 'ModIface' pattern synonyms to keep breakage low. --- ---------------------------------------------------------------------------- - -{- -Note [Inline Pattern synonym of ModIface] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The introduction of the 'ModIface' pattern synonym originally caused an increase -in allocated bytes in multiple performance tests. -In some benchmarks, it was a 2~3% increase. - -Without {-# INLINE ModIface #-}, the generated core reveals the reason for this increase. -We show the core for the 'mi_module' record selector: - -@ - mi_module - = \ @phase iface -> $w$mModIface iface mi_module1 - - $w$mModIface - = \ @phase iface cont -> - case iface of - { PrivateModIface a b ... z -> - cont - a - b - ... - z - } - - mi_module1 - = \ @phase - a - _ - ... - _ -> - a -@ - -Thus, we can see the '$w$mModIface' is not inlined, leading to an increase in -the allocated bytes. - -However, with the pragma, the correct core is generated: - -@ - mi_module = mi_module_ -@ - --} - --- See Note [Inline Pattern synonym of ModIface] for why we have all these --- inline pragmas. -{-# INLINE ModIface #-} -{-# INLINE mi_module #-} -{-# INLINE mi_sig_of #-} -{-# INLINE mi_hsc_src #-} -{-# INLINE mi_deps #-} -{-# INLINE mi_usages #-} -{-# INLINE mi_exports #-} -{-# INLINE mi_used_th #-} -{-# INLINE mi_fixities #-} -{-# INLINE mi_warns #-} -{-# INLINE mi_anns #-} -{-# INLINE mi_decls #-} -{-# INLINE mi_extra_decls #-} -{-# INLINE mi_foreign #-} -{-# INLINE mi_top_env #-} -{-# INLINE mi_insts #-} -{-# INLINE mi_fam_insts #-} -{-# INLINE mi_rules #-} -{-# INLINE mi_hpc #-} -{-# INLINE mi_trust #-} -{-# INLINE mi_trust_pkg #-} -{-# INLINE mi_complete_matches #-} -{-# INLINE mi_docs #-} -{-# INLINE mi_final_exts #-} -{-# INLINE mi_ext_fields #-} -{-# INLINE mi_src_hash #-} -{-# INLINE mi_hi_bytes #-} -{-# COMPLETE ModIface #-} - -pattern ModIface :: - Module -> Maybe Module -> HscSource -> Dependencies -> [Usage] -> - [IfaceExport] -> Bool -> [(OccName, Fixity)] -> IfaceWarnings -> - [IfaceAnnotation] -> [IfaceDeclExts phase] -> - Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] -> IfaceForeign -> - [IfaceDefault] -> Maybe IfaceTopEnv -> [IfaceClsInst] -> [IfaceFamInst] -> [IfaceRule] -> - AnyHpcUsage -> IfaceTrustInfo -> Bool -> [IfaceCompleteMatch] -> Maybe Docs -> - IfaceBackendExts phase -> ExtensibleFields -> Fingerprint -> IfaceBinHandle phase -> - ModIface_ phase -pattern ModIface - { mi_module - , mi_sig_of - , mi_hsc_src - , mi_deps - , mi_usages - , mi_exports - , mi_used_th - , mi_fixities - , mi_warns - , mi_anns - , mi_decls - , mi_extra_decls - , mi_foreign - , mi_defaults - , mi_top_env - , mi_insts - , mi_fam_insts - , mi_rules - , mi_hpc - , mi_trust - , mi_trust_pkg - , mi_complete_matches - , mi_docs - , mi_final_exts - , mi_ext_fields - , mi_src_hash - , mi_hi_bytes - } <- PrivateModIface - { mi_module_ = mi_module - , mi_sig_of_ = mi_sig_of - , mi_hsc_src_ = mi_hsc_src - , mi_deps_ = mi_deps - , mi_usages_ = mi_usages - , mi_exports_ = mi_exports - , mi_used_th_ = mi_used_th - , mi_fixities_ = mi_fixities - , mi_warns_ = mi_warns - , mi_anns_ = mi_anns - , mi_decls_ = mi_decls - , mi_extra_decls_ = mi_extra_decls - , mi_foreign_ = mi_foreign - , mi_defaults_ = mi_defaults - , mi_top_env_ = mi_top_env - , mi_insts_ = mi_insts - , mi_fam_insts_ = mi_fam_insts - , mi_rules_ = mi_rules - , mi_hpc_ = mi_hpc - , mi_trust_ = mi_trust - , mi_trust_pkg_ = mi_trust_pkg - , mi_complete_matches_ = mi_complete_matches - , mi_docs_ = mi_docs - , mi_final_exts_ = mi_final_exts - , mi_ext_fields_ = mi_ext_fields - , mi_src_hash_ = mi_src_hash - , mi_hi_bytes_ = mi_hi_bytes + ( mi_mod_info + , mi_module + , mi_sig_of + , mi_hsc_src + , mi_iface_hash + , mi_deps + , mi_public + , mi_exports + , mi_fixities + , mi_warns + , mi_anns + , mi_decls + , mi_defaults + , mi_simplified_core + , mi_top_env + , mi_insts + , mi_fam_insts + , mi_rules + , mi_trust + , mi_trust_pkg + , mi_complete_matches + , mi_docs + , mi_abi_hashes + , mi_ext_fields + , mi_hi_bytes + , mi_self_recomp_info + , mi_fix_fn + , mi_decl_warn_fn + , mi_export_warn_fn + , mi_hash_fn + ) + , pattern ModIface + , set_mi_mod_info + , set_mi_module + , set_mi_sig_of + , set_mi_hsc_src + , set_mi_self_recomp + , set_mi_hi_bytes + , set_mi_deps + , set_mi_exports + , set_mi_fixities + , set_mi_warns + , set_mi_anns + , set_mi_insts + , set_mi_fam_insts + , set_mi_rules + , set_mi_decls + , set_mi_defaults + , set_mi_simplified_core + , set_mi_top_env + , set_mi_trust + , set_mi_trust_pkg + , set_mi_complete_matches + , set_mi_docs + , set_mi_abi_hashes + , set_mi_ext_fields + , set_mi_caches + , set_mi_decl_warn_fn + , set_mi_export_warn_fn + , set_mi_fix_fn + , set_mi_hash_fn + , completePartialModIface + , IfaceBinHandle(..) + , PartialModIface + , IfaceAbiHashes (..) + , IfaceSelfRecomp (..) + , IfaceCache (..) + , IfaceSimplifiedCore (..) + , withSelfRecomp + , IfaceDeclExts + , IfaceAbiHashesExts + , IfaceExport + , IfacePublic_(..) + , IfacePublic + , PartialIfacePublic + , IfaceModInfo(..) + , WhetherHasOrphans + , WhetherHasFamInst + , IfaceTopEnv (..) + , IfaceImport(..) + , mi_boot + , mi_fix + , mi_semantic_module + , mi_mod_info_semantic_module + , mi_free_holes + , mi_mnwib + , mi_flag_hash + , mi_opt_hash + , mi_hpc_hash + , mi_plugin_hash + , mi_src_hash + , mi_usages + , mi_mod_hash + , mi_orphan + , mi_finsts + , mi_export_avails_hash + , mi_orphan_like_hash + , mi_orphan_hash + , renameFreeHoles + , emptyPartialModIface + , emptyFullModIface + , mkIfaceHashCache + , emptyIfaceHashCache + , forceModIface + ) +where + +import GHC.Prelude + +import GHC.Hs + +import GHC.Iface.Syntax +import GHC.Iface.Flags +import GHC.Iface.Ext.Fields +import GHC.Iface.Recomp.Types + +import GHC.Unit +import GHC.Unit.Module.Deps +import GHC.Unit.Module.Warnings +import GHC.Unit.Module.WholeCoreBindings (IfaceForeign (..)) + + +import GHC.Types.Avail +import GHC.Types.Fixity +import GHC.Types.Fixity.Env +import GHC.Types.Name +import GHC.Types.SafeHaskell +import GHC.Types.SourceFile +import GHC.Types.Unique.DSet +import GHC.Types.Unique.FM + +import GHC.Data.Maybe +import qualified GHC.Data.Strict as Strict + +import GHC.Utils.Fingerprint +import GHC.Utils.Binary + +import Control.DeepSeq +import Control.Exception + + +{- Note [Interface file stages] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Interface files have two possible stages. + +* A partial stage built from the result of the core pipeline. +* A fully instantiated form. Which also includes fingerprints and + potentially information provided by backends. + +We can build a full interface file two ways: +* Directly from a partial one: + Then we omit backend information and mostly compute fingerprints. +* From a partial one + information produced by a backend. + Then we store the provided information and fingerprint both. +-} + +type PartialModIface = ModIface_ 'ModIfaceCore +type ModIface = ModIface_ 'ModIfaceFinal + +type PartialIfacePublic = IfacePublic_ 'ModIfaceCore +type IfacePublic = IfacePublic_ 'ModIfaceFinal + +-- | Extends a PartialModIface with hashes of the ABI. +-- +-- * The mi_mod_hash is the hash of the entire ABI +-- * THe other fields are more specific hashes of parts of the ABI +data IfaceAbiHashes = IfaceAbiHashes + { mi_abi_mod_hash :: !Fingerprint + -- ^ Hash of the ABI only + , mi_abi_orphan :: !WhetherHasOrphans + -- ^ Whether this module has orphans + , mi_abi_finsts :: !WhetherHasFamInst + -- ^ Whether this module has family instances. See Note [The type family + -- instance consistency story]. + , mi_abi_export_avails_hash :: !Fingerprint + -- ^ Hash of the exported avails (does not include e.g. instances) + , mi_abi_orphan_like_hash :: !Fingerprint + -- ^ Orphans, together with (non-orphan) type family instances of + -- dependencies and a few other things; see Note [Orphan-like hash]. + -- + -- If this changes, we must recompile due to the impact + -- on instance resolution. + , mi_abi_orphan_hash :: !Fingerprint + -- ^ Hash for orphan rules, class and family instances combined + -- NOT transitive + } + +data IfaceCache = IfaceCache + { mi_cache_decl_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn)) + -- ^ Cached lookup for 'mi_warns' for declaration deprecations + , mi_cache_export_warn_fn :: !(Name -> Maybe (WarningTxt GhcRn)) + -- ^ Cached lookup for 'mi_warns' for export deprecations + , mi_cache_fix_fn :: !(OccName -> Maybe Fixity) + -- ^ Cached lookup for 'mi_fixities' + , mi_cache_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint)) + -- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that + -- the thing isn't in decls. It's useful to know that when seeing if we are + -- up to date wrt. the old interface. The 'OccName' is the parent of the + -- name, if it has one. + } + +data ModIfacePhase + = ModIfaceCore + -- ^ Partial interface built based on output of core pipeline. + | ModIfaceFinal + +-- | Selects a IfaceDecl representation. +-- For fully instantiated interfaces we also maintain +-- a fingerprint, which is used for recompilation checks. +type family IfaceDeclExts (phase :: ModIfacePhase) = decl | decl -> phase where + IfaceDeclExts 'ModIfaceCore = IfaceDecl + IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl) + +type family IfaceAbiHashesExts (phase :: ModIfacePhase) = bk | bk -> phase where + IfaceAbiHashesExts 'ModIfaceCore = () + IfaceAbiHashesExts 'ModIfaceFinal = IfaceAbiHashes + +-- | In-memory byte array representation of a 'ModIface'. +-- +-- See Note [Sharing of ModIface] for why we need this. +data IfaceBinHandle (phase :: ModIfacePhase) where + -- | A partial 'ModIface' cannot be serialised to disk. + PartialIfaceBinHandle :: IfaceBinHandle 'ModIfaceCore + -- | Optional 'FullBinData' that can be serialised to disk directly. + -- + -- See Note [Private fields in ModIface] for when this fields needs to be cleared + -- (e.g., set to 'Nothing'). + FullIfaceBinHandle :: !(Strict.Maybe FullBinData) -> IfaceBinHandle 'ModIfaceFinal + + +withSelfRecomp :: ModIface_ phase -> r -> (IfaceSelfRecomp -> r) -> r +withSelfRecomp iface nk jk = + case mi_self_recomp_info iface of + Nothing -> nk + Just x -> jk x + + + +-- | A 'ModIface' summarises everything we know +-- about a compiled module. +-- +-- See Note [Structure of ModIface] for information about what belongs in each field. +-- +-- See Note [Strictness in ModIface] to learn about why all the fields are lazy. +-- +-- See Note [Private fields in ModIface] to learn why we don't export any of the +-- fields. +data ModIface_ (phase :: ModIfacePhase) + = PrivateModIface { + mi_hi_bytes_ :: !(IfaceBinHandle phase), + -- ^ A serialised in-memory buffer of this 'ModIface'. + -- If this handle is given, we can avoid serialising the 'ModIface' + -- when writing this 'ModIface' to disk, and write this buffer to disk instead. + -- See Note [Sharing of ModIface]. + mi_iface_hash_ :: Fingerprint, -- A hash of the whole interface + + mi_mod_info_ :: IfaceModInfo, + -- ^ Meta information about the module the interface file is for + + mi_deps_ :: Dependencies, + -- ^ The dependencies of the module. This is + -- consulted for directly-imported modules, but not + -- for anything else (hence lazy) + -- MP: Needs to be refactored (#25844) + + mi_public_ :: IfacePublic_ phase, + -- ^ The parts of interface which are used by other modules when + -- importing this module. The main, original part of an interface. + + + mi_self_recomp_ :: Maybe IfaceSelfRecomp, + -- ^ Information needed for checking self-recompilation. + -- See Note [Self recompilation information in interface files] + + mi_simplified_core_ :: Maybe IfaceSimplifiedCore, + -- ^ The part of the interface written when `-fwrite-if-simplified-core` is enabled. + -- These parts are used to restart bytecode generation. + + mi_docs_ :: Maybe Docs, + -- ^ Docstrings and related data for use by haddock, the ghci + -- @:doc@ command, and other tools. + -- + -- @Just _@ @<=>@ the module was built with @-haddock@. + + mi_top_env_ :: IfaceTopEnv, + -- ^ Just enough information to reconstruct the top level environment in + -- the /original source/ code for this module. which + -- is NOT the same as mi_exports, nor mi_decls (which + -- may contains declarations for things not actually + -- defined by the user). Used for GHCi and for inspecting + -- the contents of modules via the GHC API only. + + mi_ext_fields_ :: ExtensibleFields + -- ^ Additional optional fields, where the Map key represents + -- the field name, resulting in a (size, serialized data) pair. + -- Because the data is intended to be serialized through the + -- internal `Binary` class (increasing compatibility with types + -- using `Name` and `FastString`, such as HIE), this format is + -- chosen over `ByteString`s. + } + +-- | Meta information about the module the interface file is for +data IfaceModInfo = IfaceModInfo { + mi_mod_info_module :: Module, -- ^ Name of the module we are for + mi_mod_info_sig_of :: Maybe Module, -- ^ Are we a sig of another mod? + mi_mod_info_hsc_src :: HscSource -- ^ Boot? Signature? +} + +-- | The public interface of a module which are used by other modules when importing this module. +-- The ABI of a module. +data IfacePublic_ phase = IfacePublic { + mi_exports_ :: [IfaceExport], + -- ^ Exports + -- Kept sorted by (mod,occ), to make version comparisons easier + -- Records the modules that are the declaration points for things + -- exported by this module, and the 'OccName's of those things + + mi_fixities_ :: [(OccName,Fixity)], + -- ^ Fixities + -- NOT STRICT! we read this field lazily from the interface file + + mi_warns_ :: IfaceWarnings, + -- ^ Warnings + -- NOT STRICT! we read this field lazily from the interface file + + mi_anns_ :: [IfaceAnnotation], + -- ^ Annotations + -- NOT STRICT! we read this field lazily from the interface file + + + mi_decls_ :: [IfaceDeclExts phase], + -- ^ Type, class and variable declarations + -- The hash of an Id changes if its fixity or deprecations change + -- (as well as its type of course) + -- Ditto data constructors, class operations, except that + -- the hash of the parent class/tycon changes + + + mi_defaults_ :: [IfaceDefault], + -- ^ default declarations exported by the module + + + -- Instance declarations and rules + mi_insts_ :: [IfaceClsInst], -- ^ Sorted class instance + mi_fam_insts_ :: [IfaceFamInst], -- ^ Sorted family instances + mi_rules_ :: [IfaceRule], -- ^ Sorted rules + + + mi_trust_ :: IfaceTrustInfo, + -- ^ Safe Haskell Trust information for this module. + + mi_trust_pkg_ :: Bool, + -- ^ Do we require the package this module resides in be trusted + -- to trust this module? This is used for the situation where a + -- module is Safe (so doesn't require the package be trusted + -- itself) but imports some trustworthy modules from its own + -- package (which does require its own package be trusted). + -- See Note [Trust Own Package] in GHC.Rename.Names + mi_complete_matches_ :: [IfaceCompleteMatch], + -- ^ {-# COMPLETE #-} declarations + + mi_caches_ :: IfaceCache, + -- ^ Cached lookups of some parts of mi_public + + mi_abi_hashes_ :: (IfaceAbiHashesExts phase) + -- ^ Either `()` or `IfaceAbiHashes` for + -- a fully instantiated interface. + -- These fields are hashes of different parts of the public interface. +} + +mkIfacePublic :: [IfaceExport] + -> [IfaceDeclExts 'ModIfaceFinal] + -> [(OccName, Fixity)] + -> IfaceWarnings + -> [IfaceAnnotation] + -> [IfaceDefault] + -> [IfaceClsInst] + -> [IfaceFamInst] + -> [IfaceRule] + -> IfaceTrustInfo + -> Bool + -> [IfaceCompleteMatch] + -> IfaceAbiHashes + -> IfacePublic +mkIfacePublic exports decls fixities warns anns defaults insts fam_insts rules trust trust_pkg complete_matches abi_hashes = IfacePublic { + mi_exports_ = exports, + mi_decls_ = decls, + mi_fixities_ = fixities, + mi_warns_ = warns, + mi_anns_ = anns, + mi_defaults_ = defaults, + mi_insts_ = insts, + mi_fam_insts_ = fam_insts, + mi_rules_ = rules, + mi_trust_ = trust, + mi_trust_pkg_ = trust_pkg, + mi_complete_matches_ = complete_matches, + mi_caches_ = IfaceCache { + mi_cache_decl_warn_fn = mkIfaceDeclWarnCache $ fromIfaceWarnings warns, + mi_cache_export_warn_fn = mkIfaceExportWarnCache $ fromIfaceWarnings warns, + mi_cache_fix_fn = mkIfaceFixCache fixities, + mi_cache_hash_fn = mkIfaceHashCache decls + }, + mi_abi_hashes_ = abi_hashes +} + +-- | The information needed to restart bytecode generation. +-- Enabled by `-fwrite-if-simplified-core`. +data IfaceSimplifiedCore = IfaceSimplifiedCore { + mi_sc_extra_decls :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] + -- ^ Extra variable definitions which are **NOT** exposed but when + -- combined with mi_decls allows us to restart code generation. + -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs] + , mi_sc_foreign :: IfaceForeign + -- ^ Foreign stubs and files to supplement 'mi_extra_decls_'. + -- See Note [Foreign stubs and TH bytecode linking] +} + +-- Enough information to reconstruct the top level environment for a module +data IfaceTopEnv + = IfaceTopEnv + { ifaceTopExports :: DetOrdAvails -- ^ all top level things in this module, including unexported stuff + , ifaceImports :: [IfaceImport] -- ^ all the imports in this module + } + +instance NFData IfaceTopEnv where + rnf (IfaceTopEnv a b) = rnf a `seq` rnf b + +instance Binary IfaceTopEnv where + put_ bh (IfaceTopEnv exports imports) = do + put_ bh exports + put_ bh imports + get bh = do + exports <- get bh + imports <- get bh + return (IfaceTopEnv exports imports) + + +{- +Note [Structure of ModIface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The ModIface structure is divided into several logical parts: + +1. mi_mod_info: Basic module metadata (name, version, etc.) + +2. mi_public: The public interface of the module, which includes: + - Exports, declarations, fixities, warnings, annotations + - Class and type family instances + - Rewrite rules and COMPLETE pragmas + - Safe Haskell and package trust information + - ABI hashes for recompilation checking + +4. mi_self_recomp: Information needed for self-recompilation checking + (see Note [Self recompilation information in interface files]) + +5. mi_simplified_core: Optional simplified Core for bytecode generation + (only present when -fwrite-if-simplified-core is enabled) + +6. mi_docs: Optional documentation (only present when -haddock is enabled) + +7. mi_top_env: Information about the top-level environment of the original source + +8. mi_ext_fields: Additional fields for extensibility + +This structure helps organize the interface data according to its purpose and usage +patterns. Different parts of the compiler use different fields. By separating them +logically in the interface we can arrange to only deserialize the fields that are needed. + +Note [Strictness in ModIface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The ModIface is the Haskell representation of an interface (.hi) file. + +* During compilation we write out ModIface values to disk for files + that we have just compiled +* For packages that we depend on we load the ModIface from disk. + +All fields in the ModIface are deliberately lazy because when we read +an interface file we don't always need all the parts. For example, an +interface file contains information about documentation which is often +not needed during compilation. This is achieved using the lazyPut/lazyGet pair. +If the field was strict then we would pointlessly load this information into memory. + +On the other hand, if we create a ModIface but **don't** write it to +disk then to avoid space leaks we need to make sure to deepseq all these lazy fields +because the ModIface might live for a long time (for instance in a GHCi session). +That's why in GHC.Driver.Main.hscMaybeWriteIface there is the call to +forceModIface. +-} + +mi_flag_hash :: ModIface_ phase -> Maybe (FingerprintWithValue IfaceDynFlags) +mi_flag_hash = fmap mi_sr_flag_hash . mi_self_recomp_ + +mi_opt_hash :: ModIface_ phase -> Maybe Fingerprint +mi_opt_hash = fmap mi_sr_opt_hash . mi_self_recomp_ + +mi_hpc_hash :: ModIface_ phase -> Maybe Fingerprint +mi_hpc_hash = fmap mi_sr_hpc_hash . mi_self_recomp_ + +mi_src_hash :: ModIface_ phase -> Maybe Fingerprint +mi_src_hash = fmap mi_sr_src_hash . mi_self_recomp_ + +mi_usages :: ModIface_ phase -> Maybe [Usage] +mi_usages = fmap mi_sr_usages . mi_self_recomp_ + +mi_plugin_hash :: ModIface_ phase -> Maybe Fingerprint +mi_plugin_hash = fmap mi_sr_plugin_hash . mi_self_recomp_ + +-- | Accessor for the module hash of the ABI from a ModIface. +mi_mod_hash :: ModIface -> Fingerprint +mi_mod_hash iface = mi_abi_mod_hash (mi_abi_hashes iface) + +-- | Accessor for whether this module has orphans from a ModIface. +mi_orphan :: ModIface -> WhetherHasOrphans +mi_orphan iface = mi_abi_orphan (mi_abi_hashes iface) + +-- | Accessor for whether this module has family instances from a ModIface. +mi_finsts :: ModIface -> WhetherHasFamInst +mi_finsts iface = mi_abi_finsts (mi_abi_hashes iface) + +-- | Accessor for the hash of exported avails. +mi_export_avails_hash :: ModIface -> Fingerprint +mi_export_avails_hash iface = mi_abi_export_avails_hash (mi_abi_hashes iface) + +-- | Accessor for the hash of orphans and dependencies. +-- +-- See Note [Orphan-like hash]. +mi_orphan_like_hash :: ModIface -> Fingerprint +mi_orphan_like_hash iface = mi_abi_orphan_like_hash (mi_abi_hashes iface) + +-- | Accessor for the hash of orphan rules, class and family instances combined from a ModIface. +mi_orphan_hash :: ModIface -> Fingerprint +mi_orphan_hash iface = mi_abi_orphan_hash (mi_abi_hashes iface) + +-- | Old-style accessor for whether or not the ModIface came from an hs-boot +-- file. +mi_boot :: ModIface -> IsBootInterface +mi_boot iface = if mi_hsc_src iface == HsBootFile + then IsBoot + else NotBoot + +mi_mnwib :: ModIface -> ModuleNameWithIsBoot +mi_mnwib iface = GWIB (moduleName $ mi_module iface) (mi_boot iface) + +-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be +-- found, 'defaultFixity' is returned instead. +mi_fix :: ModIface -> OccName -> Fixity +mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity + +-- | The semantic module for this interface; e.g., if it's a interface +-- for a signature, if 'mi_module' is @p[A=]:A@, 'mi_semantic_module' +-- will be @@. +mi_mod_info_semantic_module :: IfaceModInfo -> Module +mi_mod_info_semantic_module iface = case mi_mod_info_sig_of iface of + Nothing -> mi_mod_info_module iface + Just mod -> mod + +mi_semantic_module :: ModIface_ a -> Module +mi_semantic_module iface = mi_mod_info_semantic_module (mi_mod_info iface) + +-- | The "precise" free holes, e.g., the signatures that this +-- 'ModIface' depends on. +mi_free_holes :: ModIface -> UniqDSet ModuleName +mi_free_holes iface = + case getModuleInstantiation (mi_module iface) of + (_, Just indef) + -- A mini-hack: we rely on the fact that 'renameFreeHoles' + -- drops things that aren't holes. + -> renameFreeHoles (mkUniqDSet cands) (instUnitInsts (moduleUnit indef)) + _ -> emptyUniqDSet + where + cands = dep_sig_mods $ mi_deps iface + +-- | Given a set of free holes, and a unit identifier, rename +-- the free holes according to the instantiation of the unit +-- identifier. For example, if we have A and B free, and +-- our unit identity is @p[A=,B=impl:B]@, the renamed free +-- holes are just C. +renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName +renameFreeHoles fhs insts = + unionManyUniqDSets (map lookup_impl (uniqDSetToList fhs)) + where + hmap = listToUFM insts + lookup_impl mod_name + | Just mod <- lookupUFM hmap mod_name = moduleFreeHoles mod + -- It wasn't actually a hole + | otherwise = emptyUniqDSet + +-- See Note [Strictness in ModIface] about where we use lazyPut vs put +instance Binary ModIface where + put_ bh (PrivateModIface + { mi_hi_bytes_ = _hi_bytes, -- We don't serialise the 'mi_hi_bytes_', as it itself + -- may contain an in-memory byte array buffer for this + -- 'ModIface'. If we used 'put_' on this 'ModIface', then + -- we likely have a good reason, and do not want to reuse + -- the byte array. + -- See Note [Private fields in ModIface] + mi_mod_info_ = mod_info, + mi_iface_hash_ = iface_hash, + mi_deps_ = deps, + mi_public_ = public, + mi_top_env_ = top_env, + mi_docs_ = docs, + mi_ext_fields_ = _ext_fields, -- Don't `put_` this in the instance so we + -- can deal with it's pointer in the header + -- when we write the actual file + mi_self_recomp_ = self_recomp, + mi_simplified_core_ = simplified_core + }) = do + put_ bh mod_info + put_ bh iface_hash + lazyPut bh deps + lazyPut bh public + lazyPut bh top_env + lazyPutMaybe bh docs + lazyPutMaybe bh self_recomp + lazyPutMaybe bh simplified_core + + get bh = do + mod_info <- get bh + iface_hash <- get bh + deps <- lazyGet bh + public <- lazyGet bh + top_env <- lazyGet bh + docs <- lazyGetMaybe bh + self_recomp <- lazyGetMaybe bh + simplified_core <- lazyGetMaybe bh + + return (PrivateModIface { + mi_mod_info_ = mod_info, + mi_iface_hash_ = iface_hash, + mi_deps_ = deps, + mi_public_ = public, + mi_simplified_core_ = simplified_core, + mi_docs_ = docs, + mi_top_env_ = top_env, + mi_self_recomp_ = self_recomp, + -- placeholder because this is dealt + -- with specially when the file is read + mi_ext_fields_ = emptyExtensibleFields, + -- We can't populate this field here, as we are + -- missing the 'mi_ext_fields_' field, which is + -- handled in 'getIfaceWithExtFields'. + mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing + }) + +instance Binary IfaceModInfo where + put_ bh (IfaceModInfo { mi_mod_info_module = mod + , mi_mod_info_sig_of = sig_of + , mi_mod_info_hsc_src = hsc_src + }) = do + put_ bh mod + put_ bh sig_of + put_ bh hsc_src + + get bh = do + mod <- get bh + sig_of <- get bh + hsc_src <- get bh + return (IfaceModInfo { mi_mod_info_module = mod + , mi_mod_info_sig_of = sig_of + , mi_mod_info_hsc_src = hsc_src + }) + + +instance Binary (IfacePublic_ 'ModIfaceFinal) where + put_ bh (IfacePublic { mi_exports_ = exports + , mi_decls_ = decls + , mi_fixities_ = fixities + , mi_warns_ = warns + , mi_anns_ = anns + , mi_defaults_ = defaults + , mi_insts_ = insts + , mi_fam_insts_ = fam_insts + , mi_rules_ = rules + , mi_trust_ = trust + , mi_trust_pkg_ = trust_pkg + , mi_complete_matches_ = complete_matches + , mi_abi_hashes_ = abi_hashes + }) = do + + lazyPut bh exports + lazyPut bh decls + lazyPut bh fixities + lazyPut bh warns + lazyPut bh anns + lazyPut bh defaults + lazyPut bh insts + lazyPut bh fam_insts + lazyPut bh rules + lazyPut bh trust + lazyPut bh trust_pkg + lazyPut bh complete_matches + lazyPut bh abi_hashes + + get bh = do + exports <- lazyGet bh + decls <- lazyGet bh + fixities <- lazyGet bh + warns <- lazyGet bh + anns <- lazyGet bh + defaults <- lazyGet bh + insts <- lazyGet bh + fam_insts <- lazyGet bh + rules <- lazyGet bh + trust <- lazyGet bh + trust_pkg <- lazyGet bh + complete_matches <- lazyGet bh + abi_hashes <- lazyGet bh + return (mkIfacePublic exports decls fixities warns anns defaults insts fam_insts rules trust trust_pkg complete_matches abi_hashes) + +instance Binary IfaceAbiHashes where + put_ bh (IfaceAbiHashes { mi_abi_mod_hash = mod_hash + , mi_abi_orphan = orphan + , mi_abi_finsts = hasFamInsts + , mi_abi_export_avails_hash = vis_hash + , mi_abi_orphan_like_hash = invis_hash + , mi_abi_orphan_hash = orphan_hash + }) = do + put_ bh mod_hash + put_ bh orphan + put_ bh hasFamInsts + put_ bh vis_hash + put_ bh invis_hash + put_ bh orphan_hash + get bh = do + mod_hash <- get bh + orphan <- get bh + hasFamInsts <- get bh + vis_hash <- get bh + invis_hash <- get bh + orphan_hash <- get bh + return $ IfaceAbiHashes { + mi_abi_mod_hash = mod_hash, + mi_abi_orphan = orphan, + mi_abi_finsts = hasFamInsts, + mi_abi_export_avails_hash = vis_hash, + mi_abi_orphan_like_hash = invis_hash, + mi_abi_orphan_hash = orphan_hash + } + +instance Binary IfaceSimplifiedCore where + put_ bh (IfaceSimplifiedCore eds fs) = do + put_ bh eds + put_ bh fs + + get bh = do + eds <- get bh + fs <- get bh + return (IfaceSimplifiedCore eds fs) + +emptyPartialModIface :: Module -> PartialModIface +emptyPartialModIface mod + = PrivateModIface + { mi_mod_info_ = emptyIfaceModInfo mod, + mi_iface_hash_ = fingerprint0, + mi_hi_bytes_ = PartialIfaceBinHandle, + mi_deps_ = noDependencies, + mi_public_ = emptyPublicModIface (), + mi_simplified_core_ = Nothing, + mi_top_env_ = IfaceTopEnv emptyDetOrdAvails [] , + mi_docs_ = Nothing, + mi_self_recomp_ = Nothing, + mi_ext_fields_ = emptyExtensibleFields + + } + +emptyIfaceModInfo :: Module -> IfaceModInfo +emptyIfaceModInfo mod = IfaceModInfo + { mi_mod_info_module = mod + , mi_mod_info_sig_of = Nothing + , mi_mod_info_hsc_src = HsSrcFile + } + + +emptyPublicModIface :: IfaceAbiHashesExts phase -> IfacePublic_ phase +emptyPublicModIface abi_hashes = IfacePublic + { mi_exports_ = [] + , mi_decls_ = [] + , mi_fixities_ = [] + , mi_warns_ = IfWarnSome [] [] + , mi_anns_ = [] + , mi_defaults_ = [] + , mi_insts_ = [] + , mi_fam_insts_ = [] + , mi_rules_ = [] + , mi_abi_hashes_ = abi_hashes + , mi_trust_ = noIfaceTrustInfo + , mi_trust_pkg_ = False + , mi_caches_ = emptyModIfaceCache + , mi_complete_matches_ = [] + } + +emptyModIfaceCache :: IfaceCache +emptyModIfaceCache = IfaceCache { + mi_cache_decl_warn_fn = emptyIfaceWarnCache, + mi_cache_export_warn_fn = emptyIfaceWarnCache, + mi_cache_fix_fn = emptyIfaceFixCache, + mi_cache_hash_fn = emptyIfaceHashCache +} + +emptyIfaceBackend :: IfaceAbiHashes +emptyIfaceBackend = IfaceAbiHashes + { mi_abi_mod_hash = fingerprint0, + mi_abi_orphan = False, + mi_abi_finsts = False, + mi_abi_export_avails_hash = fingerprint0, + mi_abi_orphan_like_hash = fingerprint0, + mi_abi_orphan_hash = fingerprint0 + } + +emptyFullModIface :: Module -> ModIface +emptyFullModIface mod = + (emptyPartialModIface mod) + { mi_public_ = emptyPublicModIface emptyIfaceBackend + , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing + } + + +-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' +mkIfaceHashCache :: [(Fingerprint,IfaceDecl)] + -> (OccName -> Maybe (OccName, Fingerprint)) +mkIfaceHashCache pairs + = \occ -> lookupOccEnv env occ + where + env = foldl' add_decl emptyOccEnv pairs + add_decl env0 (v,d) = foldl' add env0 (ifaceDeclFingerprints v d) + where + add env0 (occ,hash) = extendOccEnv env0 occ (occ,hash) + +emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint) +emptyIfaceHashCache _occ = Nothing + +-- ModIface is completely forced since it will live in memory for a long time. +-- If forcing it uses a lot of memory, then store less things in ModIface. +instance ( NFData (IfaceAbiHashesExts (phase :: ModIfacePhase)) + , NFData (IfaceDeclExts (phase :: ModIfacePhase)) + ) => NFData (ModIface_ phase) where + rnf (PrivateModIface a1 a2 a3 a4 a5 a6 a7 a8 a9 a10) + = (a1 :: IfaceBinHandle phase) + `seq` rnf a2 + `seq` rnf a3 + `seq` rnf a4 + `seq` rnf a5 + `seq` rnf a6 + `seq` rnf a7 + `seq` rnf a8 + `seq` rnf a9 + `seq` rnf a10 + +instance NFData IfaceModInfo where + rnf (IfaceModInfo a1 a2 a3) + = rnf a1 + `seq` rnf a2 + `seq` rnf a3 + + +instance NFData IfaceSimplifiedCore where + rnf (IfaceSimplifiedCore eds fs) = rnf eds `seq` rnf fs + +instance NFData IfaceAbiHashes where + rnf (IfaceAbiHashes a1 a2 a3 a4 a5 a6) + = rnf a1 + `seq` rnf a2 + `seq` rnf a3 + `seq` rnf a4 + `seq` rnf a5 + `seq` rnf a6 + +instance (NFData (IfaceAbiHashesExts phase), NFData (IfaceDeclExts phase)) => NFData (IfacePublic_ phase) where + rnf (IfacePublic a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14) + = rnf a1 + `seq` rnf a2 + `seq` rnf a3 + `seq` rnf a4 + `seq` rnf a5 + `seq` rnf a6 + `seq` rnf a7 + `seq` rnf a8 + `seq` rnf a9 + `seq` rnf a10 + `seq` rnf a11 + `seq` rnf a12 + `seq` rnf a13 + `seq` rnf a14 + +instance NFData IfaceCache where + rnf (IfaceCache a1 a2 a3 a4) + = rnf a1 + `seq` rnf a2 + `seq` rnf a3 + `seq` rnf a4 + + + +forceModIface :: ModIface -> IO () +forceModIface iface = () <$ (evaluate $ force iface) + +-- | Records whether a module has orphans. An \"orphan\" is one of: +-- +-- * An instance declaration in a module other than the definition +-- module for one of the type constructors or classes in the instance head +-- +-- * A rewrite rule in a module other than the one defining +-- the function in the head of the rule +-- +type WhetherHasOrphans = Bool + +-- | Does this module define family instances? +type WhetherHasFamInst = Bool + +-- ---------------------------------------------------------------------------- +-- Modify a 'ModIface'. +-- ---------------------------------------------------------------------------- + +{- +Note [Private fields in ModIface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The fields of 'ModIface' are private, e.g., not exported, to make the API +impossible to misuse. A 'ModIface' can be "compressed" in-memory using +'shareIface', which serialises the 'ModIface' to an in-memory buffer. +This has the advantage of reducing memory usage of 'ModIface', reducing the +overall memory usage of GHC. +See Note [Sharing of ModIface]. + +This in-memory buffer can be reused, if and only if the 'ModIface' is not +modified after it has been "compressed"/shared via 'shareIface'. Instead of +serialising 'ModIface', we simply write the in-memory buffer to disk directly. + +However, we can't rely that a 'ModIface' isn't modified after 'shareIface' has +been called. Thus, we make all fields of 'ModIface' private and modification +only happens via exported update functions, such as 'set_mi_decls'. +These functions unconditionally clear any in-memory buffer if used, forcing us +to serialise the 'ModIface' to disk again. +-} + +-- | Given a 'PartialModIface', turn it into a 'ModIface' by completing +-- missing fields. +completePartialModIface :: PartialModIface + -> Fingerprint + -> [(Fingerprint, IfaceDecl)] + -> Maybe IfaceSimplifiedCore + -> IfaceAbiHashes + -> IfaceCache + -> ModIface +completePartialModIface partial iface_hash decls extra_decls final_exts cache = partial + { mi_public_ = completePublicModIface decls final_exts cache (mi_public_ partial) + , mi_simplified_core_ = extra_decls + , mi_hi_bytes_ = FullIfaceBinHandle Strict.Nothing + , mi_iface_hash_ = iface_hash + } + where + +-- | Given a 'PartialIfacePublic', turn it into an 'IfacePublic' by completing +-- missing fields. +completePublicModIface :: [(Fingerprint, IfaceDecl)] + -> IfaceAbiHashes + -> IfaceCache + -> PartialIfacePublic + -> IfacePublic +completePublicModIface decls abi_hashes cache partial = partial + { mi_decls_ = decls + , mi_abi_hashes_ = abi_hashes + , mi_caches_ = cache + } + +set_mi_mod_info :: IfaceModInfo -> ModIface_ phase -> ModIface_ phase +set_mi_mod_info val iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = val } + +set_mi_self_recomp :: Maybe IfaceSelfRecomp-> ModIface_ phase -> ModIface_ phase +set_mi_self_recomp val iface = clear_mi_hi_bytes $ iface { mi_self_recomp_ = val } + +set_mi_hi_bytes :: IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase +set_mi_hi_bytes val iface = iface { mi_hi_bytes_ = val } + +set_mi_deps :: Dependencies -> ModIface_ phase -> ModIface_ phase +set_mi_deps val iface = clear_mi_hi_bytes $ iface { mi_deps_ = val } + +set_mi_public :: (IfacePublic_ phase -> IfacePublic_ phase) -> ModIface_ phase -> ModIface_ phase +set_mi_public f iface = clear_mi_hi_bytes $ iface { mi_public_ = f (mi_public_ iface) } + +set_mi_simplified_core :: Maybe IfaceSimplifiedCore -> ModIface_ phase -> ModIface_ phase +set_mi_simplified_core val iface = clear_mi_hi_bytes $ iface { mi_simplified_core_ = val } + +set_mi_top_env :: IfaceTopEnv -> ModIface_ phase -> ModIface_ phase +set_mi_top_env val iface = clear_mi_hi_bytes $ iface { mi_top_env_ = val } + +set_mi_docs :: Maybe Docs -> ModIface_ phase -> ModIface_ phase +set_mi_docs val iface = clear_mi_hi_bytes $ iface { mi_docs_ = val } + +set_mi_ext_fields :: ExtensibleFields -> ModIface_ phase -> ModIface_ phase +set_mi_ext_fields val iface = clear_mi_hi_bytes $ iface { mi_ext_fields_ = val } + +{- Settings for mi_public interface fields -} + +set_mi_exports :: [IfaceExport] -> ModIface_ phase -> ModIface_ phase +set_mi_exports val = set_mi_public (\iface -> iface { mi_exports_ = val }) + +set_mi_fixities :: [(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase +set_mi_fixities val = set_mi_public (\iface -> iface { mi_fixities_ = val }) + +set_mi_warns :: IfaceWarnings -> ModIface_ phase -> ModIface_ phase +set_mi_warns val = set_mi_public (\iface -> iface { mi_warns_ = val }) + +set_mi_anns :: [IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase +set_mi_anns val = set_mi_public (\iface -> iface { mi_anns_ = val }) + +set_mi_insts :: [IfaceClsInst] -> ModIface_ phase -> ModIface_ phase +set_mi_insts val = set_mi_public (\iface -> iface { mi_insts_ = val }) + +set_mi_fam_insts :: [IfaceFamInst] -> ModIface_ phase -> ModIface_ phase +set_mi_fam_insts val = set_mi_public (\iface -> iface { mi_fam_insts_ = val }) + +set_mi_rules :: [IfaceRule] -> ModIface_ phase -> ModIface_ phase +set_mi_rules val = set_mi_public (\iface -> iface { mi_rules_ = val }) + +set_mi_decls :: [IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase +set_mi_decls val = set_mi_public (\iface -> iface { mi_decls_ = val }) + +set_mi_defaults :: [IfaceDefault] -> ModIface_ phase -> ModIface_ phase +set_mi_defaults val = set_mi_public (\iface -> iface { mi_defaults_ = val }) + +set_mi_trust :: IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase +set_mi_trust val = set_mi_public (\iface -> iface { mi_trust_ = val }) + +set_mi_trust_pkg :: Bool -> ModIface_ phase -> ModIface_ phase +set_mi_trust_pkg val = set_mi_public (\iface -> iface { mi_trust_pkg_ = val }) + +set_mi_complete_matches :: [IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase +set_mi_complete_matches val = set_mi_public (\iface -> iface { mi_complete_matches_ = val }) + +set_mi_abi_hashes :: IfaceAbiHashesExts phase -> ModIface_ phase -> ModIface_ phase +set_mi_abi_hashes val = set_mi_public (\iface -> iface { mi_abi_hashes_ = val }) + +{- Setters for mi_caches interface fields -} + +set_mi_decl_warn_fn :: (OccName -> Maybe (WarningTxt GhcRn)) -> ModIface_ phase -> ModIface_ phase +set_mi_decl_warn_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_decl_warn_fn = val } }) + +set_mi_export_warn_fn :: (Name -> Maybe (WarningTxt GhcRn)) -> ModIface_ phase -> ModIface_ phase +set_mi_export_warn_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_export_warn_fn = val } }) + +set_mi_fix_fn :: (OccName -> Maybe Fixity) -> ModIface_ phase -> ModIface_ phase +set_mi_fix_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_fix_fn = val } }) + +set_mi_hash_fn :: (OccName -> Maybe (OccName, Fingerprint)) -> ModIface_ phase -> ModIface_ phase +set_mi_hash_fn val = set_mi_public (\iface -> iface { mi_caches_ = (mi_caches_ iface) { mi_cache_hash_fn = val } }) + +set_mi_caches :: IfaceCache -> ModIface_ phase -> ModIface_ phase +set_mi_caches val = set_mi_public (\iface -> iface { mi_caches_ = val }) + +{- + +-} + +{- Setters for mi_mod_info interface fields -} + +set_mi_module :: Module -> ModIface_ phase -> ModIface_ phase +set_mi_module val = set_mi_mod_info_field (\info -> info { mi_mod_info_module = val }) + +set_mi_sig_of :: Maybe Module -> ModIface_ phase -> ModIface_ phase +set_mi_sig_of val = set_mi_mod_info_field (\info -> info { mi_mod_info_sig_of = val }) + +set_mi_hsc_src :: HscSource -> ModIface_ phase -> ModIface_ phase +set_mi_hsc_src val = set_mi_mod_info_field (\info -> info { mi_mod_info_hsc_src = val }) + +-- | Helper function for setting fields in mi_mod_info_ +set_mi_mod_info_field :: (IfaceModInfo -> IfaceModInfo) -> ModIface_ phase -> ModIface_ phase +set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi_mod_info_ iface) } + + + + +-- | Invalidate any byte array buffer we might have. +clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase +clear_mi_hi_bytes iface = iface + { mi_hi_bytes_ = case mi_hi_bytes iface of + PartialIfaceBinHandle -> PartialIfaceBinHandle + FullIfaceBinHandle _ -> FullIfaceBinHandle Strict.Nothing + } + +-- ---------------------------------------------------------------------------- +-- 'ModIface' pattern synonyms to keep breakage low. +-- ---------------------------------------------------------------------------- + +{- +Note [Inline Pattern synonym of ModIface] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The introduction of the 'ModIface' pattern synonym originally caused an increase +in allocated bytes in multiple performance tests. +In some benchmarks, it was a 2~3% increase. + +Without {-# INLINE ModIface #-}, the generated core reveals the reason for this increase. +We show the core for the 'mi_module' record selector: + +@ + mi_module + = \ @phase iface -> $w$mModIface iface mi_module1 + + $w$mModIface + = \ @phase iface cont -> + case iface of + { PrivateModIface a b ... z -> + cont + a + b + ... + z + } + + mi_module1 + = \ @phase + a + _ + ... + _ -> + a +@ + +Thus, we can see the '$w$mModIface' is not inlined, leading to an increase in +the allocated bytes. + +However, with the pragma, the correct core is generated: + +@ + mi_module = mi_module_ +@ + +-} + +-- See Note [Inline Pattern synonym of ModIface] for why we have all these +-- inline pragmas. +{-# INLINE mi_mod_info #-} +{-# INLINE mi_iface_hash #-} +{-# INLINE mi_module #-} +{-# INLINE mi_sig_of #-} +{-# INLINE mi_hsc_src #-} +{-# INLINE mi_deps #-} +{-# INLINE mi_public #-} +{-# INLINE mi_exports #-} +{-# INLINE mi_fixities #-} +{-# INLINE mi_warns #-} +{-# INLINE mi_anns #-} +{-# INLINE mi_decls #-} +{-# INLINE mi_simplified_core #-} +{-# INLINE mi_defaults #-} +{-# INLINE mi_top_env #-} +{-# INLINE mi_insts #-} +{-# INLINE mi_fam_insts #-} +{-# INLINE mi_rules #-} +{-# INLINE mi_trust #-} +{-# INLINE mi_trust_pkg #-} +{-# INLINE mi_complete_matches #-} +{-# INLINE mi_docs #-} +{-# INLINE mi_abi_hashes #-} +{-# INLINE mi_ext_fields #-} +{-# INLINE mi_hi_bytes #-} +{-# INLINE mi_self_recomp_info #-} +{-# INLINE mi_fix_fn #-} +{-# INLINE mi_hash_fn #-} +{-# INLINE mi_decl_warn_fn #-} +{-# INLINE mi_export_warn_fn #-} +{-# INLINE ModIface #-} +{-# COMPLETE ModIface #-} + +pattern ModIface :: + IfaceModInfo + -> Module + -> Maybe Module + -> HscSource + -> Fingerprint + -> Dependencies + -> IfacePublic_ phase + -> [IfaceExport] + -> [(OccName, Fixity)] + -> IfaceWarnings + -> [IfaceAnnotation] + -> [IfaceDeclExts phase] + -> Maybe IfaceSimplifiedCore + -> [IfaceDefault] + -> IfaceTopEnv + -> [IfaceClsInst] + -> [IfaceFamInst] + -> [IfaceRule] + -> IfaceTrustInfo + -> Bool + -> [IfaceCompleteMatch] + -> Maybe Docs + -> IfaceAbiHashesExts phase + -> ExtensibleFields + -> IfaceBinHandle phase + -> Maybe IfaceSelfRecomp + -> (OccName -> Maybe Fixity) + -> (OccName -> Maybe (OccName, Fingerprint)) + -> (OccName -> Maybe (WarningTxt GhcRn)) + -> (Name -> Maybe (WarningTxt GhcRn)) -> + ModIface_ phase +pattern ModIface + { mi_mod_info + , mi_module + , mi_sig_of + , mi_hsc_src + , mi_iface_hash + , mi_deps + , mi_public + , mi_exports + , mi_fixities + , mi_warns + , mi_anns + , mi_decls + , mi_simplified_core + , mi_defaults + , mi_top_env + , mi_insts + , mi_fam_insts + , mi_rules + , mi_trust + , mi_trust_pkg + , mi_complete_matches + , mi_docs + , mi_abi_hashes + , mi_ext_fields + , mi_hi_bytes + , mi_self_recomp_info + , mi_fix_fn + , mi_hash_fn + , mi_decl_warn_fn + , mi_export_warn_fn + } <- PrivateModIface + { mi_mod_info_ = mi_mod_info@IfaceModInfo { mi_mod_info_module = mi_module + , mi_mod_info_sig_of = mi_sig_of + , mi_mod_info_hsc_src = mi_hsc_src } + , mi_iface_hash_ = mi_iface_hash + , mi_deps_ = mi_deps + , mi_public_ = mi_public@IfacePublic { + mi_exports_ = mi_exports + , mi_fixities_ = mi_fixities + , mi_warns_ = mi_warns + , mi_anns_ = mi_anns + , mi_decls_ = mi_decls + , mi_defaults_ = mi_defaults + , mi_insts_ = mi_insts + , mi_fam_insts_ = mi_fam_insts + , mi_rules_ = mi_rules + , mi_trust_ = mi_trust + , mi_trust_pkg_ = mi_trust_pkg + , mi_complete_matches_ = mi_complete_matches + , mi_caches_ = IfaceCache { + mi_cache_decl_warn_fn = mi_decl_warn_fn, + mi_cache_export_warn_fn = mi_export_warn_fn, + mi_cache_fix_fn = mi_fix_fn, + mi_cache_hash_fn = mi_hash_fn + } + , mi_abi_hashes_ = mi_abi_hashes + } + , mi_docs_ = mi_docs + , mi_ext_fields_ = mi_ext_fields + , mi_hi_bytes_ = mi_hi_bytes + , mi_self_recomp_ = mi_self_recomp_info + , mi_simplified_core_ = mi_simplified_core + , mi_top_env_ = mi_top_env } diff --git a/GHC/Unit/Module/ModNodeKey.hs b/GHC/Unit/Module/ModNodeKey.hs new file mode 100644 --- /dev/null +++ b/GHC/Unit/Module/ModNodeKey.hs @@ -0,0 +1,35 @@ +module GHC.Unit.Module.ModNodeKey + ( ModNodeKeyWithUid(..) + , mnkToModule + , moduleToMnk + , mnkIsBoot + , mnkToInstalledModule + , installedModuleToMnk + ) where + +import GHC.Prelude +import GHC.Utils.Outputable +import GHC.Unit.Types + +data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: !ModuleNameWithIsBoot + , mnkUnitId :: !UnitId } deriving (Eq, Ord) + +mnkToModule :: ModNodeKeyWithUid -> Module +mnkToModule (ModNodeKeyWithUid mnwib uid) = Module (RealUnit (Definite uid)) (gwib_mod mnwib) + +mnkToInstalledModule :: ModNodeKeyWithUid -> InstalledModule +mnkToInstalledModule (ModNodeKeyWithUid mnwib uid) = Module uid (gwib_mod mnwib) + +-- | Already InstalledModules are always NotBoot +installedModuleToMnk :: InstalledModule -> ModNodeKeyWithUid +installedModuleToMnk mod = ModNodeKeyWithUid (GWIB (moduleName mod) NotBoot) (moduleUnit mod) + +moduleToMnk :: Module -> IsBootInterface -> ModNodeKeyWithUid +moduleToMnk mod is_boot = ModNodeKeyWithUid (GWIB (moduleName mod) is_boot) (moduleUnitId mod) + +mnkIsBoot :: ModNodeKeyWithUid -> IsBootInterface +mnkIsBoot (ModNodeKeyWithUid mnwib _) = gwib_isBoot mnwib + +instance Outputable ModNodeKeyWithUid where + ppr (ModNodeKeyWithUid mnwib uid) = ppr uid <> colon <> ppr mnwib + diff --git a/GHC/Unit/Module/ModSummary.hs b/GHC/Unit/Module/ModSummary.hs --- a/GHC/Unit/Module/ModSummary.hs +++ b/GHC/Unit/Module/ModSummary.hs @@ -24,12 +24,14 @@ , msDynObjFileOsPath , msDeps , isBootSummary + , isTemplateHaskellOrQQNonBoot , findTarget ) where import GHC.Prelude +import qualified GHC.LanguageExtensions as LangExt import GHC.Hs import GHC.Driver.DynFlags @@ -41,6 +43,7 @@ import GHC.Types.SrcLoc import GHC.Types.Target import GHC.Types.PkgQual +import GHC.Types.Basic import GHC.Data.Maybe import GHC.Data.OsPath (OsPath) @@ -77,12 +80,10 @@ -- See Note [When source is considered modified] and #9243 ms_hie_date :: Maybe UTCTime, -- ^ Timestamp of hie file, if we have one - ms_srcimps :: [(PkgQual, Located ModuleName)], -- FIXME: source imports are never from an external package, why do we allow PkgQual? + ms_srcimps :: [Located ModuleName], -- ^ Source imports of the module - ms_textual_imps :: [(PkgQual, Located ModuleName)], + ms_textual_imps :: [(ImportLevel, PkgQual, Located ModuleName)], -- ^ Non-source imports of the module from the module *text* - ms_ghc_prim_import :: !Bool, - -- ^ Whether the special module GHC.Prim was imported explicitly ms_parsed_mod :: Maybe HsParsedModule, -- ^ The parsed, nonrenamed source, if we have it. This is also -- used to support "inline module syntax" in Backpack files. @@ -105,34 +106,36 @@ ms_mod_name = moduleName . ms_mod -- | Textual imports, plus plugin imports but not SOURCE imports. -ms_imps :: ModSummary -> [(PkgQual, Located ModuleName)] +ms_imps :: ModSummary -> [(ImportLevel, PkgQual, Located ModuleName)] ms_imps ms = ms_textual_imps ms ++ ms_plugin_imps ms -- | Plugin imports -ms_plugin_imps :: ModSummary -> [(PkgQual, Located ModuleName)] -ms_plugin_imps ms = map ((NoPkgQual,) . noLoc) (pluginModNames (ms_hspp_opts ms)) +ms_plugin_imps :: ModSummary -> [(ImportLevel, PkgQual, Located ModuleName)] +ms_plugin_imps ms = map ((SpliceLevel, NoPkgQual,) . noLoc) (pluginModNames (ms_hspp_opts ms)) -- | All of the (possibly) home module imports from the given list that is to -- say, each of these module names could be a home import if an appropriately -- named file existed. (This is in contrast to package qualified imports, which -- are guaranteed not to be home imports.) -home_imps :: [(PkgQual, Located ModuleName)] -> [(PkgQual, Located ModuleName)] -home_imps imps = filter (maybe_home . fst) imps +home_imps :: [(ImportLevel, PkgQual, Located ModuleName)] -> [(ImportLevel, PkgQual, Located ModuleName)] +home_imps imps = filter (maybe_home . pq) imps where maybe_home NoPkgQual = True maybe_home (ThisPkg _) = True maybe_home (OtherPkg _) = False + pq (_, p, _) = p + -- | Like 'ms_home_imps', but for SOURCE imports. ms_home_srcimps :: ModSummary -> ([Located ModuleName]) -- [] here because source imports can only refer to the current package. -ms_home_srcimps = map snd . home_imps . ms_srcimps +ms_home_srcimps = ms_srcimps -- | All of the (possibly) home module imports from a -- 'ModSummary'; that is to say, each of these module names -- could be a home import if an appropriately named file -- existed. (This is in contrast to package qualified -- imports, which are guaranteed not to be home imports.) -ms_home_imps :: ModSummary -> ([(PkgQual, Located ModuleName)]) +ms_home_imps :: ModSummary -> ([(ImportLevel, PkgQual, Located ModuleName)]) ms_home_imps = home_imps . ms_imps -- The ModLocation contains both the original source filename and the @@ -146,14 +149,14 @@ -- the ms_hs_hash and imports can, of course, change msHsFilePath, msDynHiFilePath, msHiFilePath, msObjFilePath, msDynObjFilePath :: ModSummary -> FilePath -msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms)) +msHsFilePath ms = expectJust (ml_hs_file (ms_location ms)) msHiFilePath ms = ml_hi_file (ms_location ms) msDynHiFilePath ms = ml_dyn_hi_file (ms_location ms) msObjFilePath ms = ml_obj_file (ms_location ms) msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms) msHsFileOsPath, msDynHiFileOsPath, msHiFileOsPath, msObjFileOsPath, msDynObjFileOsPath :: ModSummary -> OsPath -msHsFileOsPath ms = expectJust "msHsFilePath" (ml_hs_file_ospath (ms_location ms)) +msHsFileOsPath ms = expectJust (ml_hs_file_ospath (ms_location ms)) msHiFileOsPath ms = ml_hi_file_ospath (ms_location ms) msDynHiFileOsPath ms = ml_dyn_hi_file_ospath (ms_location ms) msObjFileOsPath ms = ml_obj_file_ospath (ms_location ms) @@ -163,19 +166,24 @@ isBootSummary :: ModSummary -> IsBootInterface isBootSummary ms = if ms_hsc_src ms == HsBootFile then IsBoot else NotBoot +isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool +isTemplateHaskellOrQQNonBoot ms = + (xopt LangExt.TemplateHaskell (ms_hspp_opts ms) + || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) && + (isBootSummary ms == NotBoot) + ms_mnwib :: ModSummary -> ModuleNameWithIsBoot ms_mnwib ms = GWIB (ms_mod_name ms) (isBootSummary ms) -- | Returns the dependencies of the ModSummary s. -msDeps :: ModSummary -> ([(PkgQual, GenWithIsBoot (Located ModuleName))]) -msDeps s = - [ (NoPkgQual, d) +msDeps :: ModSummary -> ([(ImportLevel, PkgQual, GenWithIsBoot (Located ModuleName))]) +msDeps s = [ (NormalLevel, NoPkgQual, d) -- Source imports are always NormalLevel | m <- ms_home_srcimps s , d <- [ GWIB { gwib_mod = m, gwib_isBoot = IsBoot } ] ] - ++ [ (pkg, (GWIB { gwib_mod = m, gwib_isBoot = NotBoot })) - | (pkg, m) <- ms_imps s + ++ [ (stage, pkg, (GWIB { gwib_mod = m, gwib_isBoot = NotBoot })) + | (stage, pkg, m) <- ms_imps s ] instance Outputable ModSummary where @@ -205,5 +213,4 @@ = f == f' && ms_unitid summary == unitid _ `matches` _ = False - diff --git a/GHC/Unit/Module/Stage.hs b/GHC/Unit/Module/Stage.hs new file mode 100644 --- /dev/null +++ b/GHC/Unit/Module/Stage.hs @@ -0,0 +1,85 @@ +module GHC.Unit.Module.Stage ( ModuleStage(..) + , allStages + , nowAndFutureStages + , onlyFutureStages + , minStage + , maxStage + , zeroStage + , decModuleStage + , incModuleStage + ) where + +import GHC.Prelude +import GHC.Utils.Outputable + +{- Note [Stage vs Level] +~~~~~~~~~~~~~~~~~~~~~~~~ + +Modules are compiled at a specific stage. Levels within a module are interpreted +as offsets to the specific stage at which the module is being compiled. + +* A **level** is a typechecking concept. The type checker performs level checking + to ensure that the evaluation can proceed in a well-staged manner. +* A **stage** is an operational construct. The execution of the program happens + in stages. + +GHC at the moment knows about two stages, a module is either compiled for +compile time (*C*) or runtime (*R*), with *C* before *R*. Then: + +* The main module is compiled for `R`. + +* A normal import does not shift the stage at which the dependent module is required. + +* If a module `M` splice imports module `A`, then compiling `M` at stage + *R* requires compiling module `A` at stage *C*. + +* If a module `N` quote imports module `B`, then compiling `N` at stage + *C* requires compiling module `B` at stage *R*. + +The compiler can then choose appropiately how modules needed at `C` are compiled +and how modules needed at `R` are compiled. + +For example: + +* In `-fno-code` mode, `C` modules may be compiled in dynamic way, but `R` modules + are not compiled at all. +* When using a profiled GHC. `C` modules must be compiled in profiled way but `R` modules + will be compiled in static way. + +Further structure as needed by cross-compilation settings may require more stages. + +-} + +-- The order of these constructors is important for definitions such as +-- 'futureStages'. +data ModuleStage = CompileStage | RunStage deriving (Eq, Ord, Enum, Bounded) + +allStages :: [ModuleStage] +allStages = [minBound .. maxBound] + +nowAndFutureStages :: ModuleStage -> [ModuleStage] +nowAndFutureStages cur_st = [cur_st .. ] + +onlyFutureStages :: ModuleStage -> [ModuleStage] +onlyFutureStages cur_st | cur_st == maxBound = [] +onlyFutureStages cur_st = [succ cur_st .. ] + +minStage :: ModuleStage +minStage = minBound + +maxStage :: ModuleStage +maxStage = maxBound + +instance Outputable ModuleStage where + ppr CompileStage = text "compile" + ppr RunStage = text "run" + +zeroStage :: ModuleStage +zeroStage = RunStage + +decModuleStage, incModuleStage :: ModuleStage -> ModuleStage +incModuleStage RunStage = RunStage +incModuleStage CompileStage = RunStage + +decModuleStage RunStage = CompileStage +decModuleStage CompileStage = RunStage diff --git a/GHC/Unit/Module/Status.hs b/GHC/Unit/Module/Status.hs --- a/GHC/Unit/Module/Status.hs +++ b/GHC/Unit/Module/Status.hs @@ -41,6 +41,9 @@ -- changed. } +instance Outputable HscRecompStatus where + ppr HscUpToDate{} = text "HscUpToDate" + ppr HscRecompNeeded{} = text "HscRecompNeeded" instance Outputable HscBackendAction where ppr (HscUpdate mi) = text "Update:" <+> (ppr (mi_module mi)) diff --git a/GHC/Unit/State.hs b/GHC/Unit/State.hs --- a/GHC/Unit/State.hs +++ b/GHC/Unit/State.hs @@ -66,6 +66,7 @@ pprUnitInfoForUser, pprModuleMap, pprWithUnitState, + pprRawUnitIds, -- * Utils unwireUnit) @@ -364,9 +365,13 @@ autoLink | not (gopt Opt_AutoLinkPackages dflags) = [] - -- By default we add ghc-internal & rts to the preload units (when they are + -- By default we add base, ghc-internal and rts to the preload units (when they are -- found in the unit database) except when we are building them - | otherwise = filter (hu_id /=) [ghcInternalUnitId, rtsUnitId] + -- + -- Since "base" is not wired in, then the unit-id is discovered + -- from the settings file by default, but can be overriden by power-users + -- by specifying `-base-unit-id` flag. + | otherwise = filter (hu_id /=) [baseUnitId dflags, ghcInternalUnitId, rtsUnitId] -- if the home unit is indefinite, it means we are type-checking it only -- (not producing any code). Hence we can use virtual units instantiated @@ -1885,8 +1890,7 @@ = case lookupModuleWithSuggestions pkgs m NoPkgQual of LookupFound a b -> [(a,fst b)] LookupMultiple rs -> map f rs - where f (m,_) = (m, expectJust "lookupModule" (lookupUnit pkgs - (moduleUnit m))) + where f (m,_) = (m, expectJust (lookupUnit pkgs (moduleUnit m))) _ -> [] -- | The result of performing a lookup @@ -2266,3 +2270,7 @@ pprWithUnitState state = updSDocContext (\ctx -> ctx { sdocUnitIdForUser = \fs -> pprUnitIdForUser state (UnitId fs) }) + +-- | Print raw unit-ids, without removing the hash +pprRawUnitIds :: SDoc -> SDoc +pprRawUnitIds = updSDocContext (\ctx -> ctx { sdocUnitIdForUser = ftext }) diff --git a/GHC/Unit/Types.hs b/GHC/Unit/Types.hs --- a/GHC/Unit/Types.hs +++ b/GHC/Unit/Types.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-orphans #-} -- instance Binary IsBootInterface - {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveTraversable #-} @@ -60,21 +58,21 @@ , Definite (..) -- * Wired-in units - , primUnitId - , bignumUnitId , ghcInternalUnitId , rtsUnitId , mainUnitId , thisGhcUnitId , interactiveUnitId + , interactiveGhciUnitId + , interactiveSessionUnitId - , primUnit - , bignumUnit , ghcInternalUnit , rtsUnit , mainUnit , thisGhcUnit , interactiveUnit + , interactiveGhciUnit + , interactiveSessionUnit , isInteractiveModule , wiredInUnitIds @@ -84,8 +82,6 @@ , GenWithIsBoot (..) , ModuleNameWithIsBoot , ModuleWithIsBoot - , InstalledModuleWithIsBoot - , notBoot ) where @@ -110,7 +106,7 @@ import qualified Data.ByteString.Char8 as BS.Char8 import Language.Haskell.Syntax.Module.Name -import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) +import Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) --------------------------------------------------------------------- -- MODULES @@ -123,12 +119,6 @@ } deriving (Eq,Ord,Data,Functor) -instance Data ModuleName where - -- don't traverse? - toConstr _ = abstractConstr "ModuleName" - gunfold _ _ = error "gunfold" - dataTypeOf _ = mkNoRepType "ModuleName" - -- | A Module is a pair of a 'Unit' and a 'ModuleName'. type Module = GenModule Unit @@ -523,6 +513,9 @@ } deriving (Data) +instance NFData UnitId where + rnf (UnitId fs) = rnf fs `seq` () + instance Binary UnitId where put_ bh (UnitId fs) = put_ bh fs get bh = do fs <- get bh; return (UnitId fs) @@ -598,25 +591,25 @@ -} -bignumUnitId, primUnitId, ghcInternalUnitId, rtsUnitId, - mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId +ghcInternalUnitId, rtsUnitId, + mainUnitId, thisGhcUnitId, interactiveUnitId, interactiveGhciUnitId, interactiveSessionUnitId :: UnitId -bignumUnit, primUnit, ghcInternalUnit, rtsUnit, - mainUnit, thisGhcUnit, interactiveUnit :: Unit +ghcInternalUnit, rtsUnit, + mainUnit, thisGhcUnit, interactiveUnit, interactiveGhciUnit, interactiveSessionUnit :: Unit -primUnitId = UnitId (fsLit "ghc-prim") -bignumUnitId = UnitId (fsLit "ghc-bignum") ghcInternalUnitId = UnitId (fsLit "ghc-internal") rtsUnitId = UnitId (fsLit "rts") thisGhcUnitId = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id] interactiveUnitId = UnitId (fsLit "interactive") +interactiveGhciUnitId = UnitId (fsLit "interactive-ghci") +interactiveSessionUnitId = UnitId (fsLit "interactive-session") -primUnit = RealUnit (Definite primUnitId) -bignumUnit = RealUnit (Definite bignumUnitId) ghcInternalUnit = RealUnit (Definite ghcInternalUnitId) rtsUnit = RealUnit (Definite rtsUnitId) thisGhcUnit = RealUnit (Definite thisGhcUnitId) interactiveUnit = RealUnit (Definite interactiveUnitId) +interactiveGhciUnit = RealUnit (Definite interactiveGhciUnitId) +interactiveSessionUnit = RealUnit (Definite interactiveSessionUnitId) -- | This is the package Id for the current program. It is the default -- package Id if you don't specify a package name. We don't add this prefix @@ -629,9 +622,7 @@ wiredInUnitIds :: [UnitId] wiredInUnitIds = - [ primUnitId - , bignumUnitId - , ghcInternalUnitId + [ ghcInternalUnitId , rtsUnitId ] -- NB: ghc is no longer part of the wired-in units since its unit-id, given @@ -693,17 +684,6 @@ -- modules in opposition to boot interfaces. Instead, one should use -- 'DriverPhases.HscSource'. See Note [HscSource types]. -instance Binary IsBootInterface where - put_ bh ib = put_ bh $ - case ib of - NotBoot -> False - IsBoot -> True - get bh = do - b <- get bh - return $ case b of - False -> NotBoot - True -> IsBoot - -- | This data type just pairs a value 'mod' with an IsBootInterface flag. In -- practice, 'mod' is usually a @Module@ or @ModuleName@'. data GenWithIsBoot mod = GWIB @@ -716,12 +696,13 @@ -- IsBootInterface: this is assumed to perform filtering of non-boot modules, -- e.g. in GHC.Driver.Env.hptModulesBelow +instance NFData mod => NFData (GenWithIsBoot mod) where + rnf (GWIB mod isBoot) = rnf mod `seq` rnf isBoot `seq` () + type ModuleNameWithIsBoot = GenWithIsBoot ModuleName type ModuleWithIsBoot = GenWithIsBoot Module -type InstalledModuleWithIsBoot = GenWithIsBoot InstalledModule - instance Binary a => Binary (GenWithIsBoot a) where put_ bh (GWIB { gwib_mod, gwib_isBoot }) = do put_ bh gwib_mod @@ -735,6 +716,3 @@ ppr (GWIB { gwib_mod, gwib_isBoot }) = hsep $ ppr gwib_mod : case gwib_isBoot of IsBoot -> [ text "{-# SOURCE #-}" ] NotBoot -> [] - -notBoot :: mod -> GenWithIsBoot mod -notBoot gwib_mod = GWIB {gwib_mod, gwib_isBoot = NotBoot} diff --git a/GHC/Utils/Binary.hs b/GHC/Utils/Binary.hs --- a/GHC/Utils/Binary.hs +++ b/GHC/Utils/Binary.hs @@ -2,6 +2,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-} -- We always optimise this, otherwise performance of a non-optimised @@ -75,6 +77,9 @@ lazyGetMaybe, lazyPutMaybe, + -- * EnumBinary + EnumBinary(..), + -- * User data ReaderUserData, getReaderUserData, setReaderUserData, noReaderUserData, WriterUserData, getWriterUserData, setWriterUserData, noWriterUserData, @@ -107,11 +112,15 @@ simpleBindingNameReader, FullBinData(..), freezeBinHandle, thawBinHandle, putFullBinData, BinArray, + + -- * FingerprintWithValue + FingerprintWithValue(..) ) where import GHC.Prelude import Language.Haskell.Syntax.Module.Name (ModuleName(..)) +import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..)) import {-# SOURCE #-} GHC.Types.Name (Name) import GHC.Data.FastString @@ -135,6 +144,7 @@ import Data.Coerce import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS +import qualified Data.ByteString.Short.Internal as SBS import Data.IORef import Data.Char ( ord, chr ) import Data.List.NonEmpty ( NonEmpty(..)) @@ -154,18 +164,12 @@ import GHC.Real ( Ratio(..) ) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap -#if MIN_VERSION_base(4,15,0) import GHC.ForeignPtr ( unsafeWithForeignPtr ) -#endif import Unsafe.Coerce (unsafeCoerce) type BinArray = ForeignPtr Word8 -#if !MIN_VERSION_base(4,15,0) -unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -unsafeWithForeignPtr = withForeignPtr -#endif --------------------------------------------------------------- -- BinData @@ -946,8 +950,8 @@ -- | This instance doesn't rely on the determinism of the keys' 'Ord' instance, -- so it works e.g. for 'Name's too. instance (Binary a, Ord a) => Binary (Set a) where - put_ bh s = put_ bh (Set.toList s) - get bh = Set.fromList <$> get bh + put_ bh s = put_ bh (Set.toAscList s) + get bh = Set.fromAscList <$> get bh instance Binary a => Binary (NonEmpty a) where put_ bh = put_ bh . NonEmpty.toList @@ -1066,6 +1070,22 @@ 0 -> return NotJoinPoint _ -> do { ar <- get bh; return (JoinPoint ar) } +newtype EnumBinary a = EnumBinary { unEnumBinary :: a } +instance Enum a => Binary (EnumBinary a) where + put_ bh (EnumBinary x) = put_ bh (fromEnum x) + get bh = do x <- get bh + return $ EnumBinary (toEnum x) + + +instance Binary IsBootInterface where + put_ bh ib = put_ bh (case ib of + IsBoot -> True + NotBoot -> False) + get bh = do x <- get bh + return $ case x of + True -> IsBoot + False -> NotBoot + {- Finally - a reasonable portable Integer instance. @@ -1777,7 +1797,7 @@ --------------------------------------------------------- putFS :: WriteBinHandle -> FastString -> IO () -putFS bh fs = putBS bh $ bytesFS fs +putFS bh fs = putSBS bh $ fastStringToShortByteString fs getFS :: ReadBinHandle -> IO FastString getFS bh = do @@ -1797,6 +1817,18 @@ BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) +putSBS :: WriteBinHandle -> SBS.ShortByteString -> IO () +putSBS bh sbs = do + let l = SBS.length sbs + put_ bh l + putPrim bh l (\p -> SBS.copyToPtr sbs 0 p l) + + +getSBS :: ReadBinHandle -> IO SBS.ShortByteString +getSBS bh = do + l <- get bh :: IO Int + getPrim bh l (\src -> SBS.createFromPtr src l) + putBS :: WriteBinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do @@ -1809,6 +1841,10 @@ BS.create l $ \dest -> do getPrim bh l (\src -> copyBytes dest src l) +instance Binary SBS.ShortByteString where + put_ bh f = putSBS bh f + get bh = getSBS bh + instance Binary ByteString where put_ bh f = putBS bh f get bh = getBS bh @@ -2092,5 +2128,38 @@ -------------------------------------------------------------------------------- instance (Binary v) => Binary (IntMap v) where - put_ bh m = put_ bh (IntMap.toList m) - get bh = IntMap.fromList <$> get bh + put_ bh m = put_ bh (IntMap.toAscList m) + get bh = IntMap.fromAscList <$> get bh + + +{- Note [FingerprintWithValue] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +FingerprintWithValue is a wrapper which allows us to store a fingerprint and +optionally the value which was used to create the fingerprint. + +This is useful for storing information in interface files, where we want to +store the fingerprint of the interface file, but also the value which was used +to create the fingerprint (e.g. the DynFlags). + +The wrapper is useful to ensure that the fingerprint can be read quickly without +having to deserialise the value itself. +-} + +-- | A wrapper which allows us to store a fingerprint and optionally the value which +-- was used to create the fingerprint. +data FingerprintWithValue a = FingerprintWithValue !Fingerprint (Maybe a) + deriving Functor + +instance Binary a => Binary (FingerprintWithValue a) where + put_ bh (FingerprintWithValue fp val) = do + put_ bh fp + lazyPutMaybe bh val + + get bh = do + fp <- get bh + val <- lazyGetMaybe bh + return $ FingerprintWithValue fp val + +instance NFData a => NFData (FingerprintWithValue a) where + rnf (FingerprintWithValue fp mflags) + = rnf fp `seq` rnf mflags `seq` () diff --git a/GHC/Utils/GlobalVars.hs b/GHC/Utils/GlobalVars.hs --- a/GHC/Utils/GlobalVars.hs +++ b/GHC/Utils/GlobalVars.hs @@ -57,13 +57,6 @@ -#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) - -GLOBAL_VAR(v_unsafeHasPprDebug, False, Bool) -GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool) -GLOBAL_VAR(v_unsafeHasNoStateHack, False, Bool) - -#else SHARED_GLOBAL_VAR( v_unsafeHasPprDebug , getOrSetLibHSghcGlobalHasPprDebug , "getOrSetLibHSghcGlobalHasPprDebug" @@ -79,7 +72,6 @@ , "getOrSetLibHSghcGlobalHasNoStateHack" , False , Bool ) -#endif unsafeHasPprDebug :: Bool unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug diff --git a/GHC/Utils/Logger.hs b/GHC/Utils/Logger.hs --- a/GHC/Utils/Logger.hs +++ b/GHC/Utils/Logger.hs @@ -54,6 +54,7 @@ -- * Logging , putLogMsg , defaultLogAction + , defaultLogActionWithHandles , defaultLogJsonAction , defaultLogActionHPrintDoc , defaultLogActionHPutStrDoc @@ -372,13 +373,14 @@ printErrs = defaultLogActionHPrintDoc logflags False stderr putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout msg = renderJSON jsdoc + -- See Note [JSON Error Messages] -- this is to be removed -jsonLogAction :: LogAction -jsonLogAction _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message -jsonLogAction logflags msg_class srcSpan msg +jsonLogActionWithHandle :: Handle {-^ Standard out -} -> LogAction +jsonLogActionWithHandle _ _ (MCDiagnostic SevIgnore _ _) _ _ = return () -- suppress the message +jsonLogActionWithHandle out logflags msg_class srcSpan msg = - defaultLogActionHPutStrDoc logflags True stdout + defaultLogActionHPutStrDoc logflags True out (withPprStyle PprCode (doc $$ text "")) where str = renderWithContext (log_default_user_context logflags) msg @@ -398,9 +400,18 @@ where file = unpackFS $ srcSpanFile rss UnhelpfulSpan _ -> JSNull +-- | The default 'LogAction' prints to 'stdout' and 'stderr'. +-- +-- To replicate the default log action behaviour with different @out@ and @err@ +-- handles, see 'defaultLogActionWithHandles'. defaultLogAction :: LogAction -defaultLogAction logflags msg_class srcSpan msg - | log_dopt Opt_D_dump_json logflags = jsonLogAction logflags msg_class srcSpan msg +defaultLogAction = defaultLogActionWithHandles stdout stderr + +-- | The default 'LogAction' parametrized over the standard output and standard error handles. +-- Allows clients to replicate the log message formatting of GHC with custom handles. +defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction +defaultLogActionWithHandles out err logflags msg_class srcSpan msg + | log_dopt Opt_D_dump_json logflags = jsonLogActionWithHandle out logflags msg_class srcSpan msg | otherwise = case msg_class of MCOutput -> printOut msg MCDump -> printOut (msg $$ blankLine) @@ -410,9 +421,9 @@ MCDiagnostic SevIgnore _ _ -> pure () -- suppress the message MCDiagnostic _sev _rea _code -> printDiagnostics where - printOut = defaultLogActionHPrintDoc logflags False stdout - printErrs = defaultLogActionHPrintDoc logflags False stderr - putStrSDoc = defaultLogActionHPutStrDoc logflags False stdout + printOut = defaultLogActionHPrintDoc logflags False out + printErrs = defaultLogActionHPrintDoc logflags False err + putStrSDoc = defaultLogActionHPutStrDoc logflags False out -- Pretty print the warning flag, if any (#10752) message = mkLocMessageWarningGroups (log_show_warn_groups logflags) msg_class srcSpan msg diff --git a/GHC/Utils/Misc.hs b/GHC/Utils/Misc.hs --- a/GHC/Utils/Misc.hs +++ b/GHC/Utils/Misc.hs @@ -2,6 +2,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Highly random utility functions -- @@ -23,7 +25,8 @@ dropWhileEndLE, spanEnd, last2, lastMaybe, onJust, - List.foldl1', foldl2, count, countWhile, all2, any2, + foldl2, count, countWhile, all2, any2, all2Prefix, all3Prefix, + foldr1WithDefault, foldl1WithDefault', lengthExceeds, lengthIs, lengthIsNot, lengthAtLeast, lengthAtMost, lengthLessThan, @@ -126,8 +129,9 @@ import qualified Data.List as List import Data.List.NonEmpty ( NonEmpty(..), last, nonEmpty ) -import GHC.Exts +import GHC.Exts hiding (toList) import GHC.Stack (HasCallStack) +import GHC.Data.List import Control.Monad ( guard ) import Control.Monad.IO.Class ( MonadIO, liftIO ) @@ -138,6 +142,7 @@ import Data.Bifunctor ( first, second ) import Data.Char ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit, toUpper , isHexDigit, digitToInt ) +import Data.Foldable ( Foldable (toList) ) import Data.Int import Data.Ratio ( (%) ) import Data.Ord ( comparing ) @@ -237,34 +242,34 @@ DEBUGging on; hey, why not? -} -zipEqual :: HasDebugCallStack => String -> [a] -> [b] -> [(a,b)] -zipWithEqual :: HasDebugCallStack => String -> (a->b->c) -> [a]->[b]->[c] -zipWith3Equal :: HasDebugCallStack => String -> (a->b->c->d) -> [a]->[b]->[c]->[d] -zipWith4Equal :: HasDebugCallStack => String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] +zipEqual :: HasDebugCallStack => [a] -> [b] -> [(a,b)] +zipWithEqual :: HasDebugCallStack => (a->b->c) -> [a]->[b]->[c] +zipWith3Equal :: HasDebugCallStack => (a->b->c->d) -> [a]->[b]->[c]->[d] +zipWith4Equal :: HasDebugCallStack => (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e] #if !defined(DEBUG) -zipEqual _ = zip -zipWithEqual _ = zipWith -zipWith3Equal _ = zipWith3 -zipWith4Equal _ = List.zipWith4 +zipEqual = zip +zipWithEqual = zipWith +zipWith3Equal = zipWith3 +zipWith4Equal = List.zipWith4 #else -zipEqual _ [] [] = [] -zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs -zipEqual msg _ _ = panic ("zipEqual: unequal lists: "++msg) +zipEqual [] [] = [] +zipEqual (a:as) (b:bs) = (a,b) : zipEqual as bs +zipEqual _ _ = panic "zipEqual: unequal lists" -zipWithEqual msg z (a:as) (b:bs)= z a b : zipWithEqual msg z as bs -zipWithEqual _ _ [] [] = [] -zipWithEqual msg _ _ _ = panic ("zipWithEqual: unequal lists: "++msg) +zipWithEqual z (a:as) (b:bs)= z a b : zipWithEqual z as bs +zipWithEqual _ [] [] = [] +zipWithEqual _ _ _ = panic "zipWithEqual: unequal lists" -zipWith3Equal msg z (a:as) (b:bs) (c:cs) - = z a b c : zipWith3Equal msg z as bs cs -zipWith3Equal _ _ [] [] [] = [] -zipWith3Equal msg _ _ _ _ = panic ("zipWith3Equal: unequal lists: "++msg) +zipWith3Equal z (a:as) (b:bs) (c:cs) + = z a b c : zipWith3Equal z as bs cs +zipWith3Equal _ [] [] [] = [] +zipWith3Equal _ _ _ _ = panic "zipWith3Equal: unequal lists" -zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds) - = z a b c d : zipWith4Equal msg z as bs cs ds -zipWith4Equal _ _ [] [] [] [] = [] -zipWith4Equal msg _ _ _ _ _ = panic ("zipWith4Equal: unequal lists: "++msg) +zipWith4Equal z (a:as) (b:bs) (c:cs) (d:ds) + = z a b c d : zipWith4Equal z as bs cs ds +zipWith4Equal _ [] [] [] [] = [] +zipWith4Equal _ _ _ _ _ = panic "zipWith4Equal: unequal lists" #endif -- | 'filterByList' takes a list of Bools and a list of some elements and @@ -323,31 +328,6 @@ mapFst = fmap . first mapSnd = fmap . second -mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c]) - -mapAndUnzip _ [] = ([], []) -mapAndUnzip f (x:xs) - = let (r1, r2) = f x - (rs1, rs2) = mapAndUnzip f xs - in - (r1:rs1, r2:rs2) - -mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d]) -mapAndUnzip3 _ [] = ([], [], []) -mapAndUnzip3 f (x:xs) - = let (r1, r2, r3) = f x - (rs1, rs2, rs3) = mapAndUnzip3 f xs - in - (r1:rs1, r2:rs2, r3:rs3) - -mapAndUnzip4 :: (a -> (b, c, d, e)) -> [a] -> ([b], [c], [d], [e]) -mapAndUnzip4 _ [] = ([], [], [], []) -mapAndUnzip4 f (x:xs) - = let (r1, r2, r3, r4) = f x - (rs1, rs2, rs3, rs4) = mapAndUnzip4 f xs - in - (r1:rs1, r2:rs2, r3:rs3, r4:rs4) - zipWithAndUnzip :: (a -> b -> (c,d)) -> [a] -> [b] -> ([c],[d]) zipWithAndUnzip f (a:as) (b:bs) = let (r1, r2) = f a b @@ -488,14 +468,15 @@ -- | Extract the single element of a list and panic with the given message if -- there are more elements or the list was empty. -- Like 'expectJust', but for lists. -expectOnly :: HasDebugCallStack => String -> [a] -> a +expectOnly :: HasCallStack => [a] -> a +-- always enable the call stack to get the location even on non-debug builds {-# INLINE expectOnly #-} #if defined(DEBUG) -expectOnly _ [a] = a +expectOnly [a] = a #else -expectOnly _ (a:_) = a +expectOnly (a:_) = a #endif -expectOnly msg _ = panic ("expectOnly: " ++ msg) +expectOnly _ = panic "expectOnly" -- | Compute all the ways of removing a single element from a list. -- @@ -511,13 +492,14 @@ changeLast (x:xs) x' = x : changeLast xs x' -- | Like @expectJust msg . nonEmpty@; a better alternative to 'NE.fromList'. -expectNonEmpty :: HasDebugCallStack => String -> [a] -> NonEmpty a +expectNonEmpty :: HasCallStack => [a] -> NonEmpty a +-- always enable the call stack to get the location even on non-debug builds {-# INLINE expectNonEmpty #-} -expectNonEmpty _ (x:xs) = x:|xs -expectNonEmpty msg [] = expectNonEmptyPanic msg +expectNonEmpty (x:xs) = x:|xs +expectNonEmpty [] = expectNonEmptyPanic -expectNonEmptyPanic :: String -> a -expectNonEmptyPanic msg = panic ("expectNonEmpty: " ++ msg) +expectNonEmptyPanic :: HasCallStack => a +expectNonEmptyPanic = panic "expectNonEmpty" {-# NOINLINE expectNonEmptyPanic #-} whenNonEmpty :: Applicative m => [a] -> (NonEmpty a -> m ()) -> m () @@ -658,6 +640,36 @@ any2 p (x:xs) (y:ys) = p x y || any2 p xs ys any2 _ _ _ = False +all2Prefix :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool +-- ^ `all2Prefix p xs ys` is a fused version of `and $ zipWith2 p xs ys`. +-- (It generates good code nonetheless.) +-- So if one list is shorter than the other, `p` is assumed to be `True` for the +-- suffix. +all2Prefix p = foldr k z + where + k :: a -> ([b] -> Bool) -> [b] -> Bool + k x go ys' = case ys' of + (y:ys'') -> p x y && go ys'' + _ -> True + z :: [b] -> Bool + z _ = True +{-# INLINE all2Prefix #-} + +all3Prefix :: forall a b c. (a -> b -> c -> Bool) -> [a] -> [b] -> [c] -> Bool +-- ^ `all3Prefix p xs ys zs` is a fused version of `and $ zipWith3 p xs ys zs`. +-- (It generates good code nonetheless.) +-- So if one list is shorter than the others, `p` is assumed to be `True` for +-- the suffix. +all3Prefix p = foldr k z + where + k :: a -> ([b] -> [c] -> Bool) -> [b] -> [c] -> Bool + k x go ys' zs' = case (ys',zs') of + (y:ys'',z:zs'') -> p x y z && go ys'' zs'' + _ -> False + z :: [b] -> [c] -> Bool + z _ _ = True +{-# INLINE all3Prefix #-} + -- Count the number of times a predicate is true count :: (a -> Bool) -> [a] -> Int @@ -1049,7 +1061,7 @@ readFix r = do (ds,s) <- lexDecDigits r (ds',t) <- lexDotDigits s - return (read (ds++ds'), length ds', t) + return (read (toList ds++ds'), length ds', t) readExp (e:s) | e `elem` "eE" = readExp' s readExp s = return (0,s) @@ -1069,8 +1081,8 @@ lexDotDigits ('.':s) = return (span' isDigit s) lexDotDigits s = return ("",s) - nonnull p s = do (cs@(_:_),t) <- return (span' p s) - return (cs,t) + nonnull p s = do (c:cs,t) <- return (span' p s) + return (c:|cs,t) span' _ xs@[] = (xs, xs) span' p xs@(x:xs') @@ -1438,3 +1450,15 @@ g x rest | Just y <- f x = y : rest | otherwise = rest + +foldr1WithDefault :: Foldable f => a -> (a -> a -> a) -> f a -> a +foldr1WithDefault defaultA f xs = case nonEmpty (toList xs) of + Nothing -> defaultA + Just (xs1 :: NonEmpty a) -> foldr1 f xs1 +{-# SPECIALIZE foldr1WithDefault :: a -> (a -> a -> a) -> [a] -> a #-} + +foldl1WithDefault' :: Foldable f => a -> (a -> a -> a) -> f a -> a +foldl1WithDefault' defaultA f xs = case nonEmpty (toList xs) of + Nothing -> defaultA + Just (xs1 :: NonEmpty a) -> foldl1' f xs1 +{-# SPECIALIZE foldl1WithDefault' :: a -> (a -> a -> a) -> [a] -> a #-} diff --git a/GHC/Utils/Outputable.hs b/GHC/Utils/Outputable.hs --- a/GHC/Utils/Outputable.hs +++ b/GHC/Utils/Outputable.hs @@ -33,7 +33,7 @@ docToSDoc, interppSP, interpp'SP, interpp'SP', pprQuotedList, pprWithCommas, pprWithSemis, - unquotedListWith, + unquotedListWith, pprUnquotedSet, quotedListWithOr, quotedListWithNor, quotedListWithAnd, pprWithBars, spaceIfSingleQuote, @@ -51,7 +51,7 @@ cat, fcat, hang, hangNotEmpty, punctuate, punctuateFinal, ppWhen, ppUnless, ppWhenOption, ppUnlessOption, - speakNth, speakN, speakNOf, plural, singular, + speakNth, speakN, speakNOf, plural, singular, pluralSet, isOrAre, doOrDoes, itsOrTheir, thisOrThese, hasOrHave, itOrThey, unicodeSyntax, @@ -213,7 +213,7 @@ -- | Given a `Name`'s `Module` and `OccName`, decide whether and how to qualify -- it. -type QueryQualifyName = Module -> OccName -> QualifyName +type QueryQualifyName = Module -> Maybe ModuleName -> OccName -> QualifyName -- | For a given module, we need to know whether to print it with -- a package name to disambiguate it. @@ -268,14 +268,14 @@ ppr NameNotInScope2 = text "NameNotInScope2" reallyAlwaysQualifyNames :: QueryQualifyName -reallyAlwaysQualifyNames _ _ = NameNotInScope2 +reallyAlwaysQualifyNames _ _ _ = NameNotInScope2 -- | NB: This won't ever show package IDs alwaysQualifyNames :: QueryQualifyName -alwaysQualifyNames m _ = NameQual (moduleName m) +alwaysQualifyNames m _ _ = NameQual (moduleName m) neverQualifyNames :: QueryQualifyName -neverQualifyNames _ _ = NameUnqual +neverQualifyNames _ _ _ = NameUnqual alwaysQualifyModules :: QueryQualifyModule alwaysQualifyModules _ = True @@ -567,9 +567,9 @@ = SDoc $ \ctx -> runSDoc doc (upd ctx) qualName :: PprStyle -> QueryQualifyName -qualName (PprUser q _ _) mod occ = queryQualifyName q mod occ -qualName (PprDump q) mod occ = queryQualifyName q mod occ -qualName _other mod _ = NameQual (moduleName mod) +qualName (PprUser q _ _) mod user_qual occ = queryQualifyName q mod user_qual occ +qualName (PprDump q) mod user_qual occ = queryQualifyName q mod user_qual occ +qualName _other mod _ _ = NameQual (moduleName mod) qualModule :: PprStyle -> QueryQualifyModule qualModule (PprUser q _ _) m = queryQualifyModule q m @@ -1080,6 +1080,7 @@ instance Outputable ModuleName where ppr = pprModuleName + pprModuleName :: IsLine doc => ModuleName -> doc pprModuleName (ModuleName nm) = docWithStyle (ztext (zEncodeFS nm)) (\_ -> ftext nm) @@ -1436,6 +1437,15 @@ pprQuotedList :: Outputable a => [a] -> SDoc pprQuotedList = quotedList . map ppr + +pprUnquotedSet :: Outputable a => Set.Set a -> SDoc +pprUnquotedSet set = + case Set.toList set of + [] -> braces empty + [x] -> ppr x + xs -> braces (fsep (punctuate comma (map ppr xs))) + + quotedList :: [SDoc] -> SDoc quotedList xs = fsep (punctuate comma (map quotes xs)) @@ -1539,6 +1549,10 @@ plural :: [a] -> SDoc plural [_] = empty -- a bit frightening, but there you are plural _ = char 's' + +-- | Like 'plural', but for sets. +pluralSet :: Set.Set a -> SDoc +pluralSet set = plural (Set.toList set) -- | Determines the singular verb suffix appropriate for the length of a list: -- diff --git a/GHC/Utils/Panic.hs b/GHC/Utils/Panic.hs --- a/GHC/Utils/Panic.hs +++ b/GHC/Utils/Panic.hs @@ -27,6 +27,7 @@ , panicDoc , sorryDoc , pgmErrorDoc + -- ** Assertions , assertPprPanic , assertPpr @@ -176,7 +177,7 @@ PprProgramError str sdoc -> PlainProgramError $ concat [str, "\n\n", renderWithContext ctx sdoc] -throwGhcException :: GhcException -> a +throwGhcException :: HasCallStack => GhcException -> a throwGhcException = Exception.throw throwGhcExceptionIO :: GhcException -> IO a @@ -187,11 +188,11 @@ -- | Throw an exception saying "bug in GHC" with a callstack pprPanic :: HasCallStack => String -> SDoc -> a -pprPanic s doc = panicDoc s (doc $$ callStackDoc) +pprPanic s doc = withFrozenCallStack $ panicDoc s (doc $$ callStackDoc) -- | Throw an exception saying "bug in GHC" -panicDoc :: String -> SDoc -> a -panicDoc x doc = throwGhcException (PprPanic x doc) +panicDoc :: HasCallStack => String -> SDoc -> a +panicDoc x doc = withFrozenCallStack $ throwGhcException (PprPanic x doc) -- | Throw an exception saying "this isn't finished yet" sorryDoc :: String -> SDoc -> a diff --git a/GHC/Utils/Panic/Plain.hs b/GHC/Utils/Panic/Plain.hs --- a/GHC/Utils/Panic/Plain.hs +++ b/GHC/Utils/Panic/Plain.hs @@ -116,9 +116,17 @@ Exception.throw (Exception.AssertionFailed ("ASSERT failed! file " ++ file ++ ", line " ++ show line)) - +-- | Throw a failed assertion exception taking the location information +-- from 'HasCallStack' evidence. assertPanic' :: HasCallStack => a -assertPanic' = Exception.throw (Exception.AssertionFailed "ASSERT failed!") +assertPanic' = + Exception.throw + $ Exception.AssertionFailed + $ "ASSERT failed!\n" ++ withFrozenCallStack doc + where + -- TODO: Drop CallStack when exception backtrace functionality + -- can be assumed of bootstrap compiler. + doc = unlines $ fmap (" "++) $ lines (prettyCallStack callStack) assert :: HasCallStack => Bool -> a -> a {-# INLINE assert #-} diff --git a/GHC/Utils/Touch.hs b/GHC/Utils/Touch.hs --- a/GHC/Utils/Touch.hs +++ b/GHC/Utils/Touch.hs @@ -21,14 +21,8 @@ setFileTime hdl Nothing Nothing (Just t) closeHandle hdl #else -#if MIN_VERSION_unix(2,8,0) let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } fd <- openFd file WriteOnly oflags -#else - let oflags = defaultFileFlags { noctty = True } - fd <- openFd file WriteOnly (Just 0o666) oflags -#endif touchFd fd closeFd fd #endif - diff --git a/GHC/Utils/Unique.hs b/GHC/Utils/Unique.hs --- a/GHC/Utils/Unique.hs +++ b/GHC/Utils/Unique.hs diff --git a/Language/Haskell/Syntax/Basic.hs b/Language/Haskell/Syntax/Basic.hs --- a/Language/Haskell/Syntax/Basic.hs +++ b/Language/Haskell/Syntax/Basic.hs @@ -2,11 +2,11 @@ {-# LANGUAGE GeneralisedNewtypeDeriving #-} module Language.Haskell.Syntax.Basic where -import Data.Data +import Data.Data (Data) import Data.Eq import Data.Ord import Data.Bool -import Data.Int (Int) +import Prelude import GHC.Data.FastString (FastString) import Control.DeepSeq @@ -81,24 +81,6 @@ ************************************************************************ -} --- | Haskell Bang --- --- Bangs on data constructor arguments written by the user. --- --- @(HsBang SrcUnpack SrcLazy)@ and --- @(HsBang SrcUnpack NoSrcStrict)@ (without StrictData) makes no sense, we --- emit a warning (in checkValidDataCon) and treat it like --- @(HsBang NoSrcUnpack SrcLazy)@ --- --- 'GHC.Core.DataCon.HsSrcBang' is a wrapper around this, associating it with --- a 'GHC.Types.SourceText.SourceText' as written by the user. --- In the AST, the @SourceText@ is hidden inside the extension point --- 'Language.Haskell.Syntax.Extension.XBangTy'. -data HsBang = - HsBang SrcUnpackedness - SrcStrictness - deriving Data - -- | Source Strictness -- -- What strictness annotation the user wrote @@ -134,5 +116,13 @@ | InfixN deriving (Eq, Data) +instance NFData FixityDirection where + rnf InfixL = () + rnf InfixR = () + rnf InfixN = () + data Fixity = Fixity Int FixityDirection deriving (Eq, Data) + +instance NFData Fixity where + rnf (Fixity i d) = rnf i `seq` rnf d `seq` () diff --git a/Language/Haskell/Syntax/Binds.hs b/Language/Haskell/Syntax/Binds.hs --- a/Language/Haskell/Syntax/Binds.hs +++ b/Language/Haskell/Syntax/Binds.hs @@ -26,19 +26,15 @@ ( LHsExpr , MatchGroup , GRHSs ) -import {-# SOURCE #-} Language.Haskell.Syntax.Pat - ( LPat ) - +import {-# SOURCE #-} Language.Haskell.Syntax.Pat( LPat ) +import Language.Haskell.Syntax.BooleanFormula (LBooleanFormula) import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type +import Language.Haskell.Syntax.Basic ( Fixity ) -import GHC.Types.Fixity (Fixity) import GHC.Types.Basic (InlinePragma) - -import GHC.Data.BooleanFormula (LBooleanFormula) import GHC.Types.SourceText (StringLiteral) -import Data.Void import Data.Bool import Data.Maybe @@ -255,20 +251,6 @@ } | XPatSynBind !(XXPatSynBind idL idR) --- | Multiplicity annotations, on binders, are always resolved (to a unification --- variable if there is no annotation) during type-checking. The resolved --- multiplicity is stored in the extension fields. -data HsMultAnn pass - = HsNoMultAnn !(XNoMultAnn pass) - | HsPct1Ann !(XPct1Ann pass) - | HsMultAnn !(XMultAnn pass) (LHsType (NoGhcTc pass)) - | XMultAnn !(XXMultAnn pass) - -type family XNoMultAnn p -type family XPct1Ann p -type family XMultAnn p -type family XXMultAnn p - {- ************************************************************************ * * @@ -359,9 +341,11 @@ (LIdP pass) -- Function name InlinePragma -- Never defaultInlinePragma - -- | A specialisation pragma + -- | An old-form specialisation pragma -- -- > {-# SPECIALISE f :: Int -> Int #-} + -- + -- NB: this constructor is deprecated and will be removed in GHC 9.18 (#25540) | SpecSig (XSpecSig pass) (LIdP pass) -- Specialise a function or datatype ... [LHsSigType pass] -- ... to these types @@ -369,6 +353,17 @@ -- If it's just defaultInlinePragma, then we said -- SPECIALISE, not SPECIALISE_INLINE + -- | A new-form specialisation pragma (see GHC Proposal #493) + -- e.g. {-# SPECIALISE f @Int 1 :: Int -> Int #-} + -- See Note [Overview of SPECIALISE pragmas] + | SpecSigE (XSpecSigE pass) + (RuleBndrs pass) + (LHsExpr pass) -- Expression to specialise + InlinePragma + -- The expression should be of form + -- f a1 ... an [ :: sig ] + -- with an optional type signature + -- | A specialisation pragma for instance declarations only -- -- > {-# SPECIALISE instance Eq [Int] #-} @@ -380,7 +375,7 @@ -- | A minimal complete definition pragma -- -- > {-# MINIMAL a | (b, c | (d | e)) #-} - | MinimalSig (XMinimalSig pass) (LBooleanFormula (LIdP pass)) + | MinimalSig (XMinimalSig pass) (LBooleanFormula pass) -- | A "set cost centre" pragma for declarations -- @@ -423,8 +418,9 @@ isTypeLSig _ = False isSpecLSig :: forall p. UnXRec p => LSig p -> Bool -isSpecLSig (unXRec @p -> SpecSig {}) = True -isSpecLSig _ = False +isSpecLSig (unXRec @p -> SpecSig {}) = True +isSpecLSig (unXRec @p -> SpecSigE {}) = True +isSpecLSig _ = False isSpecInstLSig :: forall p. UnXRec p => LSig p -> Bool isSpecInstLSig (unXRec @p -> SpecInstSig {}) = True @@ -433,6 +429,7 @@ isPragLSig :: forall p. UnXRec p => LSig p -> Bool -- Identifies pragmas isPragLSig (unXRec @p -> SpecSig {}) = True +isPragLSig (unXRec @p -> SpecSigE {}) = True isPragLSig (unXRec @p -> InlineSig {}) = True isPragLSig (unXRec @p -> SCCFunSig {}) = True isPragLSig (unXRec @p -> CompleteMatchSig {}) = True @@ -455,6 +452,40 @@ isCompleteMatchSig (unXRec @p -> CompleteMatchSig {} ) = True isCompleteMatchSig _ = False +{- ********************************************************************* +* * + Rule binders +* * +********************************************************************* -} + +data RuleBndrs pass = RuleBndrs + { rb_ext :: XCRuleBndrs pass + -- After typechecking rb_ext contains /all/ the quantified variables + -- both term variables and type varibles + , rb_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)] + -- ^ User-written forall'd type vars; preserved for pretty-printing + , rb_tmvs :: [LRuleBndr (NoGhcTc pass)] + -- ^ User-written forall'd term vars; preserved for pretty-printing + } + | XRuleBndrs !(XXRuleBndrs pass) + +-- | Located Rule Binder +type LRuleBndr pass = XRec pass (RuleBndr pass) + +-- | Rule Binder +data RuleBndr pass + = RuleBndr (XCRuleBndr pass) (LIdP pass) + | RuleBndrSig (XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass) + | XRuleBndr !(XXRuleBndr pass) + -- ^ + -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', + -- 'GHC.Parser.Annotation.AnnDcolon','GHC.Parser.Annotation.AnnClose' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + +collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass] +collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs] + {- ************************************************************************ * * @@ -464,7 +495,7 @@ -} -- | Haskell Pattern Synonym Details -type HsPatSynDetails pass = HsConDetails Void (LIdP pass) [RecordPatSynField pass] +type HsPatSynDetails pass = HsConDetails (LIdP pass) [RecordPatSynField pass] -- See Note [Record PatSyn Fields] -- | Record Pattern Synonym Field diff --git a/Language/Haskell/Syntax/BooleanFormula.hs b/Language/Haskell/Syntax/BooleanFormula.hs new file mode 100644 --- /dev/null +++ b/Language/Haskell/Syntax/BooleanFormula.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} + +module Language.Haskell.Syntax.BooleanFormula( + BooleanFormula(..), LBooleanFormula, + mkVar, mkFalse, mkTrue, mkBool, mkAnd, mkOr + ) where + +import Prelude hiding ( init, last ) +import Data.List ( nub ) +import Language.Haskell.Syntax.Extension (XRec, UnXRec (..), LIdP) + + +-- types +type LBooleanFormula p = XRec p (BooleanFormula p) +data BooleanFormula p = Var (LIdP p) | And [LBooleanFormula p] | Or [LBooleanFormula p] + | Parens (LBooleanFormula p) + +-- instances +deriving instance (Eq (LIdP p), Eq (LBooleanFormula p)) => Eq (BooleanFormula p) + +-- smart constructors +-- see note [Simplification of BooleanFormulas] +mkVar :: LIdP p -> BooleanFormula p +mkVar = Var + +mkFalse, mkTrue :: BooleanFormula p +mkFalse = Or [] +mkTrue = And [] + +-- Convert a Bool to a BooleanFormula +mkBool :: Bool -> BooleanFormula p +mkBool False = mkFalse +mkBool True = mkTrue + +-- Make a conjunction, and try to simplify +mkAnd :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p +mkAnd = maybe mkFalse (mkAnd' . nub . concat) . mapM fromAnd + where + -- See Note [Simplification of BooleanFormulas] + fromAnd :: LBooleanFormula p -> Maybe [LBooleanFormula p] + fromAnd bf = case unXRec @p bf of + (And xs) -> Just xs + -- assume that xs are already simplified + -- otherwise we would need: fromAnd (And xs) = concat <$> traverse fromAnd xs + (Or []) -> Nothing + -- in case of False we bail out, And [..,mkFalse,..] == mkFalse + _ -> Just [bf] + mkAnd' [x] = unXRec @p x + mkAnd' xs = And xs + +mkOr :: forall p. (UnXRec p, Eq (LIdP p), Eq (LBooleanFormula p)) => [LBooleanFormula p] -> BooleanFormula p +mkOr = maybe mkTrue (mkOr' . nub . concat) . mapM fromOr + where + -- See Note [Simplification of BooleanFormulas] + fromOr bf = case unXRec @p bf of + (Or xs) -> Just xs + (And []) -> Nothing + _ -> Just [bf] + mkOr' [x] = unXRec @p x + mkOr' xs = Or xs diff --git a/Language/Haskell/Syntax/Decls.hs b/Language/Haskell/Syntax/Decls.hs --- a/Language/Haskell/Syntax/Decls.hs +++ b/Language/Haskell/Syntax/Decls.hs @@ -36,12 +36,9 @@ -- ** Class or type declarations TyClDecl(..), LTyClDecl, TyClGroup(..), - tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls, - tyClGroupKindSigs, isClassDecl, isDataDecl, isSynDecl, isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl, isOpenTypeFamilyInfo, isClosedTypeFamilyInfo, - tyClDeclTyVars, FamilyDecl(..), LFamilyDecl, -- ** Instance declarations @@ -86,7 +83,7 @@ FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn, -- * Grouping - HsGroup(..), hsGroupInstDecls, + HsGroup(..) ) where -- friends: @@ -97,13 +94,12 @@ import Language.Haskell.Syntax.Binds import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type -import Language.Haskell.Syntax.Basic (Role) +import Language.Haskell.Syntax.Basic (Role, LexicalFixity) import Language.Haskell.Syntax.Specificity (Specificity) import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation - ,TyConFlavour(..), TypeOrData(..)) + ,TyConFlavour(..), TypeOrData(..), NewOrData(..)) import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec) -import GHC.Types.Fixity (LexicalFixity) import GHC.Unit.Module.Warnings (WarningTxt) @@ -112,15 +108,12 @@ import Control.Monad import Control.Exception (assert) import Data.Data hiding (TyCon, Fixity, Infix) -import Data.Void import Data.Maybe import Data.String -import Data.Function import Data.Eq import Data.Int import Data.Bool import Prelude (Show) -import qualified Data.List import Data.Foldable import Data.Traversable import Data.List.NonEmpty (NonEmpty (..)) @@ -235,9 +228,6 @@ | XHsGroup !(XXHsGroup p) -hsGroupInstDecls :: HsGroup id -> [LInstDecl id] -hsGroupInstDecls = (=<<) group_instds . hs_tyclds - -- | Located Splice Declaration type LSpliceDecl pass = XRec pass (SpliceDecl pass) @@ -532,11 +522,6 @@ -- Dealing with names -tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass -tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs -tyClDeclTyVars d = tcdTyVars d - - {- Note [CUSKs: complete user-supplied kind signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We kind-check declarations differently if they have a complete, user-supplied @@ -636,25 +621,26 @@ {- Note [TyClGroups and dependency analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A TyClGroup represents a strongly connected components of type/class/instance -decls, together with the role annotations for the type/class declarations. +A TyClGroup represents a strongly connected component of type/class/instance +decls, together with the role annotations and standalone kind signatures for the +type/class declarations. The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order sequence of strongly-connected components. Invariants - * The type and class declarations, group_tyclds, may depend on each - other, or earlier TyClGroups, but not on later ones + * The type and class declarations, group_tyclds, may lexically depend + on each other, or earlier TyClGroups, but not on later ones * The role annotations, group_roles, are role-annotations for some or all of the types and classes in group_tyclds (only). * The instance declarations, group_instds, may (and usually will) - depend on group_tyclds, or on earlier TyClGroups, but not on later - ones. + lexically depend on group_tyclds, or on earlier TyClGroups, but + not on later ones. -See Note [Dependency analysis of type, class, and instance decls] -in GHC.Rename.Module for more info. +See Note [Dependency analysis of type and class decls] in GHC.Rename.Module +for more info. -} -- | Type or Class Group @@ -667,19 +653,6 @@ | XTyClGroup !(XXTyClGroup pass) -tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass] -tyClGroupTyClDecls = Data.List.concatMap group_tyclds - -tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass] -tyClGroupInstDecls = Data.List.concatMap group_instds - -tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass] -tyClGroupRoleDecls = Data.List.concatMap group_roles - -tyClGroupKindSigs :: [TyClGroup pass] -> [LStandaloneKindSig pass] -tyClGroupKindSigs = Data.List.concatMap group_kisigs - - {- ********************************************************************* * * Data and type family declarations @@ -807,7 +780,7 @@ -> TyConFlavour tc familyInfoTyConFlavour mb_parent_tycon info = case info of - DataFamily -> OpenFamilyFlavour IAmData mb_parent_tycon + DataFamily -> OpenFamilyFlavour (IAmData DataType) mb_parent_tycon OpenTypeFamily -> OpenFamilyFlavour IAmType mb_parent_tycon ClosedTypeFamily _ -> assert (isNothing mb_parent_tycon) -- See Note [Closed type family mb_parent_tycon] @@ -942,12 +915,6 @@ for CUSKs, so this would be a separate feature. -} --- | When we only care whether a data-type declaration is `data` or `newtype`, but not what constructors it has -data NewOrData - = NewType -- ^ @newtype Blah ...@ - | DataType -- ^ @data Blah ...@ - deriving ( Eq, Data ) -- Needed because Demand derives Eq - -- | Whether a data-type declaration is @data@ or @newtype@, and its constructors. data DataDefnCons a = NewTypeCon -- @newtype N x = MkN blah@ @@ -962,8 +929,8 @@ dataDefnConsNewOrData :: DataDefnCons a -> NewOrData dataDefnConsNewOrData = \ case - NewTypeCon _ -> NewType - DataTypeCons _ _ -> DataType + NewTypeCon {} -> NewType + DataTypeCons {} -> DataType -- | Are the constructors within a @type data@ declaration? -- See Note [Type data declarations] in GHC.Rename.Module. @@ -1002,10 +969,13 @@ , con_names :: NonEmpty (LIdP pass) -- The following fields describe the type after the '::' -- See Note [GADT abstract syntax] - , con_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass) - -- ^ The outermost type variable binders, be they explicit or - -- implicit. The 'XRec' is used to anchor exact print - -- annotations, AnnForall and AnnDot. + , con_outer_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass) + -- ^ The outermost type variable binders, be they explicit or implicit; + -- cf. HsSigType that also stores the outermost sig_bndrs separately + -- from the forall telescopes in sig_body. + -- See Note [Representing type signatures] in Language.Haskell.Syntax.Type + , con_inner_bndrs :: [HsForAllTelescope pass] + -- ^ The forall telescopes other than the outermost invisible forall. , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any) , con_g_args :: HsConDeclGADTDetails pass -- ^ Arguments; never infix , con_res_ty :: LHsType pass -- ^ Result type @@ -1149,7 +1119,7 @@ -- | The arguments in a Haskell98-style data constructor. type HsConDeclH98Details pass - = HsConDetails Void (HsScaled pass (LBangType pass)) (XRec pass [LConDeclField pass]) + = HsConDetails (HsConDeclField pass) (XRec pass [LHsConDeclRecField pass]) -- The Void argument to HsConDetails here is a reflection of the fact that -- type applications are not allowed in data constructor declarations. @@ -1160,8 +1130,8 @@ -- derived Show instances—see Note [Infix GADT constructors] in -- GHC.Tc.TyCl—but that is an orthogonal concern.) data HsConDeclGADTDetails pass - = PrefixConGADT !(XPrefixConGADT pass) [HsScaled pass (LBangType pass)] - | RecConGADT !(XRecConGADT pass) (XRec pass [LConDeclField pass]) + = PrefixConGADT !(XPrefixConGADT pass) [HsConDeclField pass] + | RecConGADT !(XRecConGADT pass) (XRec pass [LHsConDeclRecField pass]) | XConDeclGADTDetails !(XXConDeclGADTDetails pass) type family XPrefixConGADT p @@ -1511,28 +1481,12 @@ -- ^ After renamer, free-vars from the LHS and RHS , rd_name :: XRec pass RuleName -- ^ Note [Pragma source text] in "GHC.Types.SourceText" - , rd_act :: Activation - , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)] - -- ^ Forall'd type vars - , rd_tmvs :: [LRuleBndr pass] - -- ^ Forall'd term vars, before typechecking; after typechecking - -- this includes all forall'd vars - , rd_lhs :: XRec pass (HsExpr pass) - , rd_rhs :: XRec pass (HsExpr pass) + , rd_act :: Activation + , rd_bndrs :: RuleBndrs pass + , rd_lhs :: XRec pass (HsExpr pass) + , rd_rhs :: XRec pass (HsExpr pass) } | XRuleDecl !(XXRuleDecl pass) - --- | Located Rule Binder -type LRuleBndr pass = XRec pass (RuleBndr pass) - --- | Rule Binder -data RuleBndr pass - = RuleBndr (XCRuleBndr pass) (LIdP pass) - | RuleBndrSig (XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass) - | XRuleBndr !(XXRuleBndr pass) - -collectRuleBndrSigTys :: [RuleBndr pass] -> [HsPatSigType pass] -collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs] {- ************************************************************************ diff --git a/Language/Haskell/Syntax/Expr.hs b/Language/Haskell/Syntax/Expr.hs --- a/Language/Haskell/Syntax/Expr.hs +++ b/Language/Haskell/Syntax/Expr.hs @@ -41,7 +41,6 @@ import Data.Eq import Data.Maybe import Data.List.NonEmpty ( NonEmpty ) -import GHC.Types.Name.Reader {- Note [RecordDotSyntax field updates] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -130,7 +129,7 @@ type LFieldLabelStrings p = XRec p (FieldLabelStrings p) newtype FieldLabelStrings p = - FieldLabelStrings [XRec p (DotFieldOcc p)] + FieldLabelStrings (NonEmpty (XRec p (DotFieldOcc p))) -- Field projection updates (e.g. @foo.bar.baz = 1@). See Note -- [RecordDotSyntax field updates]. @@ -292,7 +291,7 @@ ... | HsForAll (XForAll p) (HsForAllTelescope p) (LHsExpr p) | HsQual (XQual p) (XRec p [LHsExpr p]) (LHsExpr p) - | HsFunArr (XFunArr p) (HsArrowOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p) + | HsFunArr (XFunArr p) (HsMultAnnOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p) -- GHC/Parser.y infixexp2 :: { ECP } @@ -332,21 +331,8 @@ -- | A Haskell expression. data HsExpr p = HsVar (XVar p) - (LIdP p) -- ^ Variable - -- See Note [Located RdrNames] - - | HsUnboundVar (XUnboundVar p) - RdrName -- ^ Unbound variable; also used for "holes" - -- (_ or _x). - -- Turned from HsVar to HsUnboundVar by the - -- renamer, when it finds an out-of-scope - -- variable or hole. - -- The (XUnboundVar p) field becomes an HoleExprRef - -- after typechecking; this is where the - -- erroring expression will be written after - -- solving. See Note [Holes] in GHC.Tc.Types.Constraint. - - + (LIdOccP p) -- ^ Variable + -- See Note [Located RdrNames] | HsOverLabel (XOverLabel p) FastString -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels) @@ -380,7 +366,7 @@ -- NB Bracketed ops such as (+) come out as Vars. -- NB Sadly, we need an expr for the operator in an OpApp/Section since - -- the renamer may turn a HsVar into HsRecSel or HsUnboundVar + -- the renamer may turn a HsVar into HsRecSel or HsHole. | OpApp (XOpApp p) (LHsExpr p) -- left operand @@ -429,7 +415,7 @@ (LHsExpr p) -- else part -- | Multi-way if - | HsMultiIf (XMultiIf p) [LGRHS p (LHsExpr p)] + | HsMultiIf (XMultiIf p) (NonEmpty (LGRHS p (LHsExpr p))) -- | let(rec) | HsLet (XLet p) @@ -503,7 +489,7 @@ | HsTypedBracket (XTypedBracket p) (LHsExpr p) | HsUntypedBracket (XUntypedBracket p) (HsQuote p) - | HsTypedSplice (XTypedSplice p) (LHsExpr p) -- `$$z` or `$$(f 4)` + | HsTypedSplice (XTypedSplice p) (HsTypedSplice p) -- `$$z` or `$$(f 4)` | HsUntypedSplice (XUntypedSplice p) (HsUntypedSplice p) ----------------------------------------------------------- @@ -529,6 +515,10 @@ | HsEmbTy (XEmbTy p) (LHsWcType (NoGhcTc p)) + -- | Holes in expressions, i.e. '_'. + -- See Note [Holes in expressions] in GHC.Tc.Types.Constraint. + | HsHole (XHole p) + -- | Forall-types @forall tvs. t@ and @forall tvs -> t@. -- Used with @RequiredTypeArguments@, e.g. @fn (forall a. Proxy a)@. -- See Note [Types in terms] @@ -542,7 +532,7 @@ -- | Function types @a -> b@. -- Used with @RequiredTypeArguments@, e.g. @fn (Int -> Bool)@. -- See Note [Types in terms] - | HsFunArr (XFunArr p) (HsArrowOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p) + | HsFunArr (XFunArr p) (HsMultAnnOf (LHsExpr p) p) (LHsExpr p) (LHsExpr p) | XExpr !(XXExpr p) -- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the @@ -871,10 +861,13 @@ data MatchGroup p body = MG { mg_ext :: XMG p body -- Post-typechecker, types of args and result, and origin - , mg_alts :: XRec p [LMatch p body] } -- The alternatives + , mg_alts :: XRec p [LMatch p body] + -- The alternatives, see Note [Empty mg_alts] for what it means if 'mg_alts' is empty. + } -- The type is the type of the entire group -- t1 -> ... -> tn -> tr -- where there are n patterns + | XMatchGroup !(XXMatchGroup p body) -- | Located Match @@ -920,21 +913,31 @@ (&&& ) [] [] = [] xs &&& [] = xs ( &&& ) [] ys = ys --} -isInfixMatch :: Match id body -> Bool -isInfixMatch match = case m_ctxt match of - FunRhs {mc_fixity = Infix} -> True - _ -> False +Note [Empty mg_alts] +~~~~~~~~~~~~~~~~~~~~~~ +A `MatchGroup` for a function definition must have at least one alt, as it is not possible to +define a function by zero clauses — the compiler would consider this a missing definition, +rather than one with no clauses. +However, a `MatchGroup` for a `case` or `\ case` expression may be empty, as such an expression +may have zero branches. (Note: A `\ cases` expression may not have zero branches; see GHC +proposal 302). + +Ergo, if we have no alts, it must be either a `case` or a `\ case` expression; such expressions +have match arity 1. + +-} + + -- | Guarded Right-Hand Sides -- -- GRHSs are used both for pattern bindings and for Matches data GRHSs p body = GRHSs { grhssExt :: XCGRHSs p body, - grhssGRHSs :: [LGRHS p body], -- ^ Guarded RHSs + grhssGRHSs :: NonEmpty (LGRHS p body), -- ^ Guarded RHSs grhssLocalBinds :: HsLocalBinds p -- ^ The where clause } | XGRHSs !(XXGRHSs p body) @@ -1030,7 +1033,7 @@ -- ParStmts only occur in a list/monad comprehension | ParStmt (XParStmt idL idR body) -- Post typecheck, -- S in (>>=) :: Q -> (R -> S) -> T - [ParStmtBlock idL idR] + (NonEmpty (ParStmtBlock idL idR)) (HsExpr idR) -- Polymorphic `mzip` for monad comprehensions (SyntaxExpr idR) -- The `>>=` operator -- See notes [Monad Comprehensions] @@ -1316,11 +1319,15 @@ | HsQuasiQuote -- See Note [Quasi-quote overview] (XQuasiQuote id) - (IdP id) -- The quoter (the bit between `[` and `|`) + (LIdP id) -- The quoter (the bit between `[` and `|`) (XRec id FastString) -- The enclosed string | XUntypedSplice !(XXUntypedSplice id) -- Extension point; see Note [Trees That Grow] -- in Language.Haskell.Syntax.Extension + +data HsTypedSplice id + = HsTypedSpliceExpr (XTypedSpliceExpr id) (LHsExpr id) + | XTypedSplice !(XXTypedSplice id) -- | Haskell (Untyped) Quote = Expr + Pat + Type + Var data HsQuote p diff --git a/Language/Haskell/Syntax/Extension.hs b/Language/Haskell/Syntax/Extension.hs --- a/Language/Haskell/Syntax/Extension.hs +++ b/Language/Haskell/Syntax/Extension.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -- for unXRec, etc. -{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -21,9 +20,7 @@ -- This module captures the type families to precisely identify the extension -- points for GHC.Hs syntax -#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) import Data.Type.Equality (type (~)) -#endif import Data.Data hiding ( Fixity ) import Data.Kind (Type) @@ -171,6 +168,42 @@ type LIdP p = XRec p (IdP p) +-- | Like 'IdP', except it keeps track of the user-written module qualification, +-- if any. +-- +-- See Note [IdOcc]. +type family IdOccP p +type LIdOccP p = XRec p (IdOccP p) + +{- Note [IdOcc] +~~~~~~~~~~~~~~~ +When possible, in error messages we would like to report identifiers with the +qualification that the user has written (provided this does not cause any +ambiguity). To do this, we record the user-written qualification in the +AST in the GhcRn stage. This is achieved with the 'WithUserRdr' data type. +Thus: + + - instead of using 'IdP', we use 'IdOccP', which wraps an 'IdP' in + 'WithUserRdr' at GhcRn pass, in: + - 'HsVar' + - 'HsTyVar' (which is used for 'TyCon's, not just type variables) + - 'HsOpTy' + - we also use 'ConLikeP' which wraps a 'Name' in 'WithUserRdr' at 'GhcRn' + pass, in: + - 'RecordCon' + - 'ConPat' + +This user-written module qualification is then consulted when pretty-printing +expressions, e.g. we have: + + - ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v + +and 'pprPrefixOcc' uses the 'OutputableBndr' instance for 'WithUserRdr'. +This happens in 'GHC.Types.Name.Ppr.mkQualName'. + +Test case: T25877. +-} + -- ===================================================================== -- Type families for the HsBinds extension points @@ -211,6 +244,7 @@ type family XFixSig x type family XInlineSig x type family XSpecSig x +type family XSpecSigE x type family XSpecInstSig x type family XMinimalSig x type family XSCCFunSig x @@ -367,6 +401,11 @@ type family XXRuleDecl x -- ------------------------------------- +-- RuleBndrs type families +type family XCRuleBndrs x +type family XXRuleBndrs x + +-- ------------------------------------- -- RuleBndr type families type family XCRuleBndr x type family XRuleBndrSig x @@ -448,6 +487,7 @@ type family XBinTick x type family XPragE x type family XEmbTy x +type family XHole x type family XForAll x type family XQual x type family XFunArr x @@ -476,9 +516,13 @@ -- ------------------------------------- -- HsUntypedSplice type families type family XUntypedSpliceExpr x +type family XTypedSpliceExpr x type family XQuasiQuote x type family XXUntypedSplice x +-- HsTypedSplice type families +type family XXTypedSplice x + -- ------------------------------------- -- HsQuoteBracket type families type family XExpBr x @@ -566,8 +610,6 @@ type family XHsWord16Prim x type family XHsWord32Prim x type family XHsWord64Prim x -type family XHsInteger x -type family XHsRat x type family XHsFloatPrim x type family XHsDoublePrim x type family XXLit x @@ -656,8 +698,6 @@ type family XKindSig x type family XSpliceTy x type family XDocTy x -type family XBangTy x -type family XRecTy x type family XExplicitListTy x type family XExplicitTupleTy x type family XTyLit x @@ -683,6 +723,11 @@ type family XXTyVarBndr x -- --------------------------------------------------------------------- +-- HsConDeclRecField type families +type family XConDeclRecField x +type family XXConDeclRecField x + +-- --------------------------------------------------------------------- -- ConDeclField type families type family XConDeclField x type family XXConDeclField x @@ -719,6 +764,7 @@ type family XIEDefault p type family XIEPattern p type family XIEType p +type family XIEData p type family XXIEWrappedName p diff --git a/Language/Haskell/Syntax/ImpExp.hs b/Language/Haskell/Syntax/ImpExp.hs --- a/Language/Haskell/Syntax/ImpExp.hs +++ b/Language/Haskell/Syntax/ImpExp.hs @@ -1,13 +1,12 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} -module Language.Haskell.Syntax.ImpExp where +module Language.Haskell.Syntax.ImpExp ( module Language.Haskell.Syntax.ImpExp, IsBootInterface(..) ) where import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name +import Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) ) import Data.Eq (Eq) -import Data.Ord (Ord) -import Text.Show (Show) import Data.Data (Data) import Data.Bool (Bool) import Data.Maybe (Maybe) @@ -15,8 +14,7 @@ import Data.Int (Int) import Control.DeepSeq - -import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +import {-# SOURCE #-} GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST {- ************************************************************************ @@ -38,15 +36,13 @@ | NotQualified -- ^ Not qualified. deriving (Eq, Data) --- | Indicates whether a module name is referring to a boot interface (hs-boot --- file) or regular module (hs file). We need to treat boot modules specially --- when building compilation graphs, since they break cycles. Regular source --- files and signature files are treated equivalently. -data IsBootInterface = NotBoot | IsBoot - deriving (Eq, Ord, Show, Data) +data ImportDeclLevelStyle + = LevelStylePre ImportDeclLevel -- ^ 'splice' or 'quote' appears in prepositive position. + | LevelStylePost ImportDeclLevel -- ^ 'splice' or 'quote' appears in postpositive position. + | NotLevelled -- ^ Not levelled. + deriving (Eq, Data) -instance NFData IsBootInterface where - rnf = rwhnf +data ImportDeclLevel = ImportDeclQuote | ImportDeclSplice deriving (Eq, Data) -- | Import Declaration -- @@ -57,6 +53,7 @@ ideclName :: XRec pass ModuleName, -- ^ Module name. ideclPkgQual :: ImportDeclPkgQual pass, -- ^ Package qualifier. ideclSource :: IsBootInterface, -- ^ IsBoot \<=> {-\# SOURCE \#-} import + ideclLevelSpec :: ImportDeclLevelStyle, ideclSafe :: Bool, -- ^ True => safe import ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified. ideclAs :: Maybe (XRec pass ModuleName), -- ^ as Module @@ -177,11 +174,8 @@ = IEName (XIEName p) (LIdP p) -- ^ unadorned name, e.g @myFun@ | IEDefault (XIEDefault p) (LIdP p) -- ^ @default X ()@, see Note [Named default declarations] in GHC.Tc.Gen.Default | IEPattern (XIEPattern p) (LIdP p) -- ^ @pattern X@ - -- - -- exactprint: the location of @pattern@ keyword is captured via 'GHC.Parser.Annotation.EpaLocation' | IEType (XIEType p) (LIdP p) -- ^ @type (:+:)@ - -- - -- exactprint: the location of @type@ keyword is captured via 'GHC.Parser.Annotation.EpaLocation' + | IEData (XIEData p) (LIdP p) -- ^ @data (:+:)@ | XIEWrappedName !(XXIEWrappedName p) -- | Located name with possible adornment diff --git a/Language/Haskell/Syntax/ImpExp.hs-boot b/Language/Haskell/Syntax/ImpExp.hs-boot deleted file mode 100644 --- a/Language/Haskell/Syntax/ImpExp.hs-boot +++ /dev/null @@ -1,16 +0,0 @@ -module Language.Haskell.Syntax.ImpExp where - -import Data.Eq -import Data.Ord -import Text.Show -import Data.Data - --- This boot file should be short lived: As soon as the dependency on --- `GHC.Hs.Doc` is gone we'll no longer have cycles and can get rid this file. - -data IsBootInterface = NotBoot | IsBoot - -instance Eq IsBootInterface -instance Ord IsBootInterface -instance Show IsBootInterface -instance Data IsBootInterface diff --git a/Language/Haskell/Syntax/ImpExp/IsBoot.hs b/Language/Haskell/Syntax/ImpExp/IsBoot.hs new file mode 100644 --- /dev/null +++ b/Language/Haskell/Syntax/ImpExp/IsBoot.hs @@ -0,0 +1,15 @@ +module Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) ) where + +import Prelude (Eq, Ord, Show) +import Data.Data (Data) +import Control.DeepSeq (NFData(..), rwhnf) + +-- | Indicates whether a module name is referring to a boot interface (hs-boot +-- file) or regular module (hs file). We need to treat boot modules specially +-- when building compilation graphs, since they break cycles. Regular source +-- files and signature files are treated equivalently. +data IsBootInterface = NotBoot | IsBoot + deriving (Eq, Ord, Show, Data) + +instance NFData IsBootInterface where + rnf = rwhnf diff --git a/Language/Haskell/Syntax/Lit.hs b/Language/Haskell/Syntax/Lit.hs --- a/Language/Haskell/Syntax/Lit.hs +++ b/Language/Haskell/Syntax/Lit.hs @@ -21,7 +21,6 @@ import Language.Haskell.Syntax.Extension import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText) -import GHC.Core.Type (Type) import GHC.Data.FastString (FastString, lexicalCompareFS) @@ -80,22 +79,13 @@ -- ^ literal @Word32#@ | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer -- ^ literal @Word64#@ - | HsInteger (XHsInteger x) {- SourceText -} Integer Type - -- ^ Genuinely an integer; arises only - -- from TRANSLATION (overloaded - -- literals are done with HsOverLit) - | HsRat (XHsRat x) FractionalLit Type - -- ^ Genuinely a rational; arises only from - -- TRANSLATION (overloaded literals are - -- done with HsOverLit) | HsFloatPrim (XHsFloatPrim x) FractionalLit -- ^ Unboxed Float | HsDoublePrim (XHsDoublePrim x) FractionalLit -- ^ Unboxed Double - | XLit !(XXLit x) -instance Eq (HsLit x) where +instance (Eq (XXLit x)) => Eq (HsLit x) where (HsChar _ x1) == (HsChar _ x2) = x1==x2 (HsCharPrim _ x1) == (HsCharPrim _ x2) = x1==x2 (HsString _ x1) == (HsString _ x2) = x1==x2 @@ -105,10 +95,9 @@ (HsWordPrim _ x1) == (HsWordPrim _ x2) = x1==x2 (HsInt64Prim _ x1) == (HsInt64Prim _ x2) = x1==x2 (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2 - (HsInteger _ x1 _) == (HsInteger _ x2 _) = x1==x2 - (HsRat _ x1 _) == (HsRat _ x2 _) = x1==x2 (HsFloatPrim _ x1) == (HsFloatPrim _ x2) = x1==x2 (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2 + (XLit x1) == (XLit x2) = x1==x2 _ == _ = False -- | Haskell Overloaded Literal diff --git a/Language/Haskell/Syntax/Module/Name.hs b/Language/Haskell/Syntax/Module/Name.hs --- a/Language/Haskell/Syntax/Module/Name.hs +++ b/Language/Haskell/Syntax/Module/Name.hs @@ -3,6 +3,7 @@ import Prelude import Data.Char (isAlphaNum) +import Data.Data import Control.DeepSeq import qualified Text.ParserCombinators.ReadP as Parse import System.FilePath @@ -11,6 +12,14 @@ -- | A ModuleName is essentially a simple string, e.g. @Data.List@. newtype ModuleName = ModuleName FastString deriving (Show, Eq) + +instance Data ModuleName where + -- don't traverse? + toConstr x = constr + where + constr = mkConstr (dataTypeOf x) "{abstract:ModuleName}" [] Prefix + gunfold _ _ = error "gunfold" + dataTypeOf _ = mkNoRepType "ModuleName" instance Ord ModuleName where nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2 diff --git a/Language/Haskell/Syntax/Pat.hs b/Language/Haskell/Syntax/Pat.hs --- a/Language/Haskell/Syntax/Pat.hs +++ b/Language/Haskell/Syntax/Pat.hs @@ -20,16 +20,16 @@ -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.* module Language.Haskell.Syntax.Pat ( Pat(..), LPat, - ConLikeP, isInvisArgPat, - isVisArgPat, + ConLikeP, + isInvisArgPat, isInvisArgLPat, + isVisArgPat, isVisArgLPat, - HsConPatDetails, hsConPatArgs, hsConPatTyArgs, - HsConPatTyArg(..), XConPatTyArg, + HsConPatDetails, hsConPatArgs, + takeHsConPatTyArgs, dropHsConPatTyArgs, HsRecFields(..), XHsRecFields, HsFieldBind(..), LHsFieldBind, HsRecField, LHsRecField, HsRecUpdField, LHsRecUpdField, - RecFieldsDotDot(..), - hsRecFields, hsRecFieldSel, hsRecFieldsArgs, + RecFieldsDotDot(..) ) where import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntypedSplice) @@ -204,32 +204,36 @@ -- --------------------------------------------------------------------- --- | Type argument in a data constructor pattern, --- e.g. the @\@a@ in @f (Just \@a x) = ...@. -data HsConPatTyArg p = HsConPatTyArg !(XConPatTyArg p) (HsTyPat p) - -type family XConPatTyArg p - isInvisArgPat :: Pat p -> Bool isInvisArgPat InvisPat{} = True isInvisArgPat _ = False +isInvisArgLPat :: forall p. (UnXRec p) => LPat p -> Bool +isInvisArgLPat = isInvisArgPat . unXRec @p + isVisArgPat :: Pat p -> Bool isVisArgPat = not . isInvisArgPat +isVisArgLPat :: forall p. (UnXRec p) => LPat p -> Bool +isVisArgLPat = isVisArgPat . unXRec @p + -- | Haskell Constructor Pattern Details -type HsConPatDetails p = HsConDetails (HsConPatTyArg (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p)) +type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p)) hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p] -hsConPatArgs (PrefixCon _ ps) = ps +hsConPatArgs (PrefixCon ps) = ps hsConPatArgs (RecCon fs) = Data.List.map (hfbRHS . unXRec @p) (rec_flds fs) hsConPatArgs (InfixCon p1 p2) = [p1,p2] -hsConPatTyArgs :: forall p. HsConPatDetails p -> [HsConPatTyArg (NoGhcTc p)] -hsConPatTyArgs (PrefixCon tyargs _) = tyargs -hsConPatTyArgs (RecCon _) = [] -hsConPatTyArgs (InfixCon _ _) = [] +takeHsConPatTyArgs :: forall p. (UnXRec p) => [LPat p] -> [HsTyPat (NoGhcTc p)] +takeHsConPatTyArgs (p : ps) + | InvisPat _ tp <- unXRec @p p + = tp : takeHsConPatTyArgs ps +takeHsConPatTyArgs _ = [] +dropHsConPatTyArgs :: forall p. (UnXRec p) => [LPat p] -> [LPat p] +dropHsConPatTyArgs = Data.List.dropWhile (isInvisArgPat . unXRec @p) + -- | Haskell Record Fields -- -- HsRecFields is used only for patterns and expressions (not data type @@ -340,12 +344,3 @@ -- hfbLHS = Unambiguous "x" $sel:x:MkS :: AmbiguousFieldOcc Id -- -- See also Note [Disambiguating record updates] in GHC.Rename.Pat. - -hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [IdP p] -hsRecFields rbinds = Data.List.map (hsRecFieldSel . unXRec @p) (rec_flds rbinds) - -hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg] -hsRecFieldsArgs rbinds = Data.List.map (hfbRHS . unXRec @p) (rec_flds rbinds) - -hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> IdP p -hsRecFieldSel = unXRec @p . foLabel . unXRec @p . hfbLHS diff --git a/Language/Haskell/Syntax/Type.hs b/Language/Haskell/Syntax/Type.hs --- a/Language/Haskell/Syntax/Type.hs +++ b/Language/Haskell/Syntax/Type.hs @@ -20,9 +20,8 @@ -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.* module Language.Haskell.Syntax.Type ( - HsScaled(..), - hsMult, hsScaledThing, - HsArrow, HsArrowOf(..), XUnrestrictedArrow, XLinearArrow, XExplicitMult, XXArrow, + HsMultAnn, HsMultAnnOf(..), + XUnannotated, XLinearAnn, XExplicitMult, XXMultAnnOf, HsType(..), LHsType, HsKind, LHsKind, HsBndrVis(..), XBndrRequired, XBndrInvisible, XXBndrVis, @@ -46,40 +45,39 @@ LHsTypeArg, - LBangType, BangType, - HsBang(..), PromotionFlag(..), isPromoted, - ConDeclField(..), LConDeclField, + HsConDeclRecField(..), LHsConDeclRecField, - HsConDetails(..), noTypeArgs, + HsConDetails(..), + HsConDeclField(..), FieldOcc(..), LFieldOcc, mapHsOuterImplicit, hsQTvExplicit, - isHsKindedTyVar, - hsPatSigType, + isHsKindedTyVar ) where import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice ) -import Language.Haskell.Syntax.Basic ( HsBang(..) ) +import Language.Haskell.Syntax.Basic ( SrcStrictness, SrcUnpackedness ) import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Specificity import GHC.Hs.Doc (LHsDoc) import GHC.Data.FastString (FastString) +import GHC.Utils.Panic( panic ) import Data.Data hiding ( Fixity, Prefix, Infix ) -import Data.Void import Data.Maybe import Data.Eq import Data.Bool import Data.Char import Prelude (Integer) import Data.Ord (Ord) +import Control.DeepSeq {- ************************************************************************ @@ -99,24 +97,9 @@ isPromoted IsPromoted = True isPromoted NotPromoted = False -{- -************************************************************************ -* * -\subsection{Bang annotations} -* * -************************************************************************ --} - --- | Located Bang Type -type LBangType pass = XRec pass (BangType pass) - --- | Bang Type --- --- In the parser, strictness and packedness annotations bind more tightly --- than docstrings. This means that when consuming a 'BangType' (and looking --- for 'HsBangTy') we must be ready to peer behind a potential layer of --- 'HsDocTy'. See #15206 for motivation and 'getBangType' for an example. -type BangType pass = HsType pass -- Bangs are in the HsType data type +instance NFData PromotionFlag where + rnf NotPromoted = () + rnf IsPromoted = () {- ************************************************************************ @@ -344,7 +327,8 @@ | XLHsQTyVars !(XXLHsQTyVars pass) hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass] -hsQTvExplicit = hsq_explicit +hsQTvExplicit (HsQTvs { hsq_explicit = explicit_tvs }) = explicit_tvs +hsQTvExplicit (XLHsQTyVars {}) = panic "hsQTvExplicit" ------------------------------------------------ -- HsOuterTyVarBndrs @@ -460,9 +444,6 @@ } | XHsSigType !(XXHsSigType pass) -hsPatSigType :: HsPatSigType pass -> LHsType pass -hsPatSigType = hsps_body - {- Note [forall-or-nothing rule] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -790,7 +771,7 @@ 4. In constructor patterns, as long as the conditions outlined in Note [Type patterns: binders and unifiers] are satisfied - fn (MkT @a @b x y) = ... -- type arguments (HsConPatTyArg) + fn (MkT @a @b x y) = ... -- invisible type arguments (InvisPat) -- in constructor patterns (ConPat) Here, the `a` and `b` are type variable binders iff @@ -844,7 +825,7 @@ | HsTyVar (XTyVar pass) PromotionFlag -- Whether explicitly promoted, -- for the pretty printer - (LIdP pass) + (LIdOccP pass) -- Type variable, type constructor, or data constructor -- see Note [Promotions (HsTyVar)] -- See Note [Located RdrNames] in GHC.Hs.Expr @@ -858,7 +839,7 @@ (LHsKind pass) | HsFunTy (XFunTy pass) - (HsArrow pass) + (HsMultAnn pass) -- multiplicty annotations, includes the arrow (LHsType pass) -- function type (LHsType pass) @@ -875,7 +856,7 @@ | HsOpTy (XOpTy pass) PromotionFlag -- Whether explicitly promoted, -- for the pretty printer - (LHsType pass) (LIdP pass) (LHsType pass) + (LHsType pass) (LIdOccP pass) (LHsType pass) | HsParTy (XParTy pass) (LHsType pass) -- See Note [Parens in HsSyn] in GHC.Hs.Expr @@ -906,12 +887,6 @@ | HsDocTy (XDocTy pass) (LHsType pass) (LHsDoc pass) -- A documented type - | HsBangTy (XBangTy pass) -- Contains the SourceText in GHC passes. - HsBang (LHsType pass) -- Bang-style type annotations - - | HsRecTy (XRecTy pass) - [LConDeclField pass] -- Only in data type declarations - | HsExplicitListTy -- A promoted explicit list (XExplicitListTy pass) PromotionFlag -- whether explicitly promoted, for pretty printer @@ -939,38 +914,31 @@ | HsCharTy (XCharTy pass) Char | XTyLit !(XXTyLit pass) -type HsArrow pass = HsArrowOf (LHsType pass) pass +type HsMultAnn pass = HsMultAnnOf (LHsType (NoGhcTc pass)) pass --- | Denotes the type of arrows in the surface language -data HsArrowOf mult pass - = HsUnrestrictedArrow !(XUnrestrictedArrow mult pass) - -- ^ a -> b or a → b +-- | Denotes multiplicity annotations in the surface language. +-- The `mult` type argument is usually `LHsType (NoGhcTc pass)`, but when the annotation +-- is part of a type used in a term, it is `LHsExpr pass`. See Note [Types in terms]. +data HsMultAnnOf mult pass + = HsUnannotated !(XUnannotated mult pass) + -- ^ a -> b or a → b or { nm :: a } - | HsLinearArrow !(XLinearArrow mult pass) - -- ^ a %1 -> b or a %1 → b, or a ⊸ b + | HsLinearAnn !(XLinearAnn mult pass) + -- ^ a %1 -> b or a %1 → b, or a ⊸ b, or { nm %1 :: a } | HsExplicitMult !(XExplicitMult mult pass) !mult - -- ^ a %m -> b or a %m → b (very much including `a %Many -> b`! + -- ^ a %m -> b or a %m → b or { nm %m :: a } + -- (very much including `a %Many -> b`! -- This is how the programmer wrote it). It is stored as an -- `HsType` so as to preserve the syntax as written in the -- program. - | XArrow !(XXArrow mult pass) - -type family XUnrestrictedArrow mult p -type family XLinearArrow mult p -type family XExplicitMult mult p -type family XXArrow mult p - --- | This is used in the syntax. In constructor declaration. It must keep the --- arrow representation. -data HsScaled pass a = HsScaled (HsArrow pass) a - -hsMult :: HsScaled pass a -> HsArrow pass -hsMult (HsScaled m _) = m + | XMultAnnOf !(XXMultAnnOf mult pass) -hsScaledThing :: HsScaled pass a -> a -hsScaledThing (HsScaled _ t) = t +type family XUnannotated mult p +type family XLinearAnn mult p +type family XExplicitMult mult p +type family XXMultAnnOf mult p {- Note [Unit tuples] @@ -1067,17 +1035,16 @@ | HsBoxedOrConstraintTuple deriving Data --- | Located Constructor Declaration Field -type LConDeclField pass = XRec pass (ConDeclField pass) +-- | Located Constructor Declaration Record Field +type LHsConDeclRecField pass = XRec pass (HsConDeclRecField pass) --- | Constructor Declaration Field -data ConDeclField pass -- Record fields have Haddock docs on them - = ConDeclField { cd_fld_ext :: XConDeclField pass, - cd_fld_names :: [LFieldOcc pass], - -- ^ See Note [ConDeclField pass] - cd_fld_type :: LBangType pass, - cd_fld_doc :: Maybe (LHsDoc pass)} - | XConDeclField !(XXConDeclField pass) +-- | Constructor Declaration Record Field +data HsConDeclRecField pass + = HsConDeclRecField { cdrf_ext :: XConDeclRecField pass, + cdrf_names :: [LFieldOcc pass], + -- ^ See Note [FieldOcc pass] + cdrf_spec :: HsConDeclField pass } + | XConDeclRecField !(XXConDeclRecField pass) -- | Describes the arguments to a data constructor. This is a common -- representation for several constructor-related concepts, including: @@ -1095,35 +1062,56 @@ -- a separate data type entirely (see 'HsConDeclGADTDetails' in -- "GHC.Hs.Decls"). This is because GADT constructors cannot be declared with -- infix syntax, unlike the concepts above (#18844). -data HsConDetails tyarg arg rec - = PrefixCon [tyarg] [arg] -- C @t1 @t2 p1 p2 p3 +data HsConDetails arg rec + = PrefixCon [arg] -- C @t1 @t2 p1 p2 p3 | RecCon rec -- C { x = p1, y = p2 } | InfixCon arg arg -- p1 `C` p2 deriving Data --- | An empty list that can be used to indicate that there are no --- type arguments allowed in cases where HsConDetails is applied to Void. -noTypeArgs :: [Void] -noTypeArgs = [] +-- | Constructor declaration field specification, see Note [HsConDeclField on pass] +data HsConDeclField pass + = CDF { cdf_ext :: XConDeclField pass + -- ^ Extension point -{- -Note [ConDeclField pass] -~~~~~~~~~~~~~~~~~~~~~~~~~ + , cdf_unpack :: SrcUnpackedness + -- ^ UNPACK pragma if any + -- E.g. data T = MkT {-# UNPACK #-} Int + -- or data T where MtT :: {-# UNPACK #-} Int -> T -A ConDeclField contains a list of field occurrences: these always -include the field label as the user wrote it. After the renamer, it -will additionally contain the identity of the selector function in the -second component. + , cdf_bang :: SrcStrictness + -- ^ User-specified strictness, if any + -- E.g. data T a = MkT !a + -- or data T a where MtT :: !a -> T a -Due to DuplicateRecordFields, the OccName of the selector function -may have been mangled, which is why we keep the original field label -separately. For example, when DuplicateRecordFields is enabled + , cdf_multiplicity :: HsMultAnn pass + -- ^ User-specified multiplicity, if any + -- E.g. data T a = MkT { t %Many :: a } + -- or data T a where MtT :: a %1 -> T a - data T = MkT { x :: Int } + , cdf_type :: LHsType pass + -- ^ The type of the field -gives + , cdf_doc :: Maybe (LHsDoc pass) + -- ^ Documentation for the field + -- F.e. this very piece of documentation + } - ConDeclField { cd_fld_names = [L _ (FieldOcc "x" $sel:x:MkT)], ... }. +{- Note [HsConDeclField on pass] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`HsConDeclField` is used to specify the type of a data single constructor argument for all of: +* Haskell-98 style declarations (with prefix, infix or record syntax) + e.g. data T1 a = MkT (Maybe a) !Int +* GADT-style declarations with arrow syntax + e.g. data T2 a where MkT :: Maybe a -> !Int -> T2 a +* GADT-style declarations with record syntax + e.g. data T3 a where MkT :: { x :: Maybe a, y :: !Int } -> T3 a + +Each argument type is decorated with any user-defined + a) UNPACK pragma `cdf_unpack` + b) strictness annotation `cdf_bang` + c) multiplicity annotation `cdf_multiplicity` + In the case of Haskell-98 style declarations, this only applies to record syntax. + d) documentation `cdf_doc` -} ----------------------- @@ -1271,13 +1259,13 @@ -- | Field Occurrence -- -- Represents an *occurrence* of a field. This may or may not be a --- binding occurrence (e.g. this type is used in 'ConDeclField' and +-- binding occurrence (e.g. this type is used in 'HsConDeclRecField' and -- 'RecordPatSynField' which bind their fields, but also in -- 'HsRecField' for record construction and patterns, which do not). -- -- We store both the 'RdrName' the user originally wrote, and after -- the renamer we use the extension field to store the selector --- function. +-- function. See note [FieldOcc pass] -- -- There is a wrinkle in that update field occurances are sometimes -- ambiguous during the rename stage. See note @@ -1294,6 +1282,23 @@ , Eq (XCFieldOcc pass) , Eq (XXFieldOcc pass) ) => Eq (FieldOcc pass) + +{- Note [FieldOcc pass] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The foLabel field of FieldOcc GhcRn contains the field name as the user wrote it. +After the renamer, a FieldOcc GhcTc has +- foExt field: A RdrName containing the original field label written by the user +- foLabel field: An Id for the field selector, whose OccName may have been mangled + to give it a globally unique identity. + +For example, when DuplicateRecordFields is enabled + + data T = MkT { x :: Int } + +gives + + FieldOcc "x" $sel:x:MkT. +-} {- ************************************************************************ diff --git a/Language/Haskell/Syntax/Type.hs-boot b/Language/Haskell/Syntax/Type.hs-boot --- a/Language/Haskell/Syntax/Type.hs-boot +++ b/Language/Haskell/Syntax/Type.hs-boot @@ -4,6 +4,8 @@ import Data.Eq import Data.Ord +import Control.DeepSeq + {- ************************************************************************ * * @@ -19,5 +21,6 @@ instance Eq PromotionFlag instance Ord PromotionFlag +instance NFData PromotionFlag isPromoted :: PromotionFlag -> Bool diff --git a/MachRegs.h b/MachRegs.h --- a/MachRegs.h +++ b/MachRegs.h @@ -222,7 +222,7 @@ /* define NO_ARG_REGS if we have no argument registers at all (we can * optimise certain code paths using this predicate). */ -#if MAX_REAL_VANILLA_REG < 2 +#if MAX_REAL_VANILLA_REG < 2 && MAX_REAL_XMM_REG == 0 #define NO_ARG_REGS #else #undef NO_ARG_REGS diff --git a/MachRegs/loongarch64.h b/MachRegs/loongarch64.h --- a/MachRegs/loongarch64.h +++ b/MachRegs/loongarch64.h @@ -46,6 +46,3 @@ #define REG_D2 fs5 #define REG_D3 fs6 #define REG_D4 fs7 - -#define MAX_REAL_FLOAT_REG 4 -#define MAX_REAL_DOUBLE_REG 4 diff --git a/MachRegs/ppc.h b/MachRegs/ppc.h --- a/MachRegs/ppc.h +++ b/MachRegs/ppc.h @@ -60,6 +60,3 @@ #define REG_SpLim r25 #define REG_Hp r26 #define REG_Base r27 - -#define MAX_REAL_FLOAT_REG 6 -#define MAX_REAL_DOUBLE_REG 6 diff --git a/MachRegs/riscv64.h b/MachRegs/riscv64.h --- a/MachRegs/riscv64.h +++ b/MachRegs/riscv64.h @@ -56,6 +56,3 @@ #define REG_D4 fs9 #define REG_D5 fs10 #define REG_D6 fs11 - -#define MAX_REAL_FLOAT_REG 6 -#define MAX_REAL_DOUBLE_REG 6 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} module Main where import Distribution.Simple @@ -11,6 +11,7 @@ import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.Simple.Setup +import Distribution.Simple.PackageIndex import System.IO import System.Process @@ -52,10 +53,12 @@ , ("primop-vector-tys-exports.hs-incl", "--primop-vector-tys-exports") , ("primop-vector-tycons.hs-incl" , "--primop-vector-tycons") , ("primop-docs.hs-incl" , "--wired-in-docs") + , ("primop-deprecations.hs-incl" , "--wired-in-deprecations") ] ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () -ghcAutogen verbosity lbi@LocalBuildInfo{..} = do +ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs} + = do -- Get compiler/ root directory from the cabal file let Just compilerRoot = takeDirectory <$> pkgDescrFile @@ -77,7 +80,7 @@ -- Call genprimopcode to generate *.hs-incl forM_ primopIncls $ \(file,command) -> do contents <- readProcess "genprimopcode" [command] primopsStr - rewriteFileEx verbosity (buildDir file) contents + rewriteFileEx verbosity (buildDir lbi file) contents -- Write GHC.Platform.Constants let platformConstantsPath = autogenPackageModulesDir lbi "GHC/Platform/Constants.hs" @@ -94,9 +97,14 @@ Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId _ -> error "Couldn't find unique cabal library when building ghc" + let cGhcInternalUnitId = case lookupPackageName installedPkgs (mkPackageName "ghc-internal") of + -- We assume there is exactly one copy of `ghc-internal` in our dependency closure + [(_,[packageInfo])] -> unUnitId $ installedUnitId packageInfo + _ -> error "Couldn't find unique ghc-internal library when building ghc" + -- Write GHC.Settings.Config configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" - configHs = generateConfigHs cProjectUnitId settings + configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -108,8 +116,9 @@ Just v -> Right v generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key -> [(String,String)] -> String -generateConfigHs cProjectUnitId settings = either error id $ do +generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -125,6 +134,7 @@ , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -148,4 +158,7 @@ , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] diff --git a/cbits/genSym.c b/cbits/genSym.c --- a/cbits/genSym.c +++ b/cbits/genSym.c @@ -24,6 +24,3 @@ #if !defined(HAVE_UNIQUE64) HsWord64 ghc_unique_counter64 = 0; #endif -#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) -HsInt ghc_unique_inc = 1; -#endif diff --git a/ghc.cabal b/ghc.cabal --- a/ghc.cabal +++ b/ghc.cabal @@ -3,7 +3,7 @@ -- ./configure. Make sure you are editing ghc.cabal.in, not ghc.cabal. Name: ghc -Version: 9.12.4 +Version: 9.14.1 License: BSD-3-Clause License-File: LICENSE Author: The GHC Team @@ -50,7 +50,7 @@ custom-setup - setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath, containers + setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, process, filepath, containers Flag internal-interpreter Description: Build with internal interpreter support. @@ -114,14 +114,14 @@ extra-libraries: zstd CPP-Options: -DHAVE_LIBZSTD - Build-Depends: base >= 4.11 && < 4.22, + Build-Depends: base >= 4.11 && < 4.23, deepseq >= 1.4 && < 1.6, directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.11 && < 0.13, binary == 0.8.*, - time >= 1.4 && < 1.15, - containers >= 0.6.2.1 && < 0.8, + time >= 1.4 && < 1.16, + containers >= 0.6.2.1 && < 0.9, array >= 0.1 && < 0.6, filepath >= 1.5 && < 1.6, os-string >= 2.0.1 && < 2.1, @@ -131,16 +131,17 @@ semaphore-compat, stm, rts, - ghc-boot == 9.12.4, - ghc-heap == 9.12.4, - ghci == 9.12.4 + ghc-boot == 9.14.1, + ghc-heap >=9.10.1 && <=9.14.1, + ghci == 9.14.1 if flag(bootstrap) Build-Depends: - ghc-boot-th-next == 9.12.4 + ghc-boot-th-next == 9.14.1 else Build-Depends: - ghc-boot-th == 9.12.4 + ghc-boot-th == 9.14.1, + ghc-internal == 9.1401.0, if os(windows) Build-Depends: Win32 >= 2.3 && < 2.15 @@ -223,6 +224,7 @@ GHC.Builtin.Uniques GHC.Builtin.Utils GHC.ByteCode.Asm + GHC.ByteCode.Breakpoints GHC.ByteCode.InfoTable GHC.ByteCode.Instr GHC.ByteCode.Linker @@ -283,6 +285,13 @@ GHC.CmmToAsm.Dwarf.Types GHC.CmmToAsm.Format GHC.CmmToAsm.Instr + GHC.CmmToAsm.LA64 + GHC.CmmToAsm.LA64.CodeGen + GHC.CmmToAsm.LA64.Cond + GHC.CmmToAsm.LA64.Instr + GHC.CmmToAsm.LA64.Ppr + GHC.CmmToAsm.LA64.RegInfo + GHC.CmmToAsm.LA64.Regs GHC.CmmToAsm.Monad GHC.CmmToAsm.PIC GHC.CmmToAsm.PPC @@ -307,6 +316,7 @@ GHC.CmmToAsm.Reg.Linear.Base GHC.CmmToAsm.Reg.Linear.FreeRegs GHC.CmmToAsm.Reg.Linear.JoinToTargets + GHC.CmmToAsm.Reg.Linear.LA64 GHC.CmmToAsm.Reg.Linear.PPC GHC.CmmToAsm.Reg.Linear.RV64 GHC.CmmToAsm.Reg.Linear.StackMap @@ -315,7 +325,6 @@ GHC.CmmToAsm.Reg.Linear.X86 GHC.CmmToAsm.Reg.Linear.X86_64 GHC.CmmToAsm.Reg.Liveness - GHC.CmmToAsm.Reg.Regs GHC.CmmToAsm.Reg.Target GHC.CmmToAsm.Reg.Utils GHC.CmmToAsm.RV64 @@ -415,6 +424,7 @@ GHC.CoreToIface GHC.CoreToStg GHC.CoreToStg.Prep + GHC.CoreToStg.AddImplicitBinds GHC.Core.TyCo.FVs GHC.Core.TyCo.Compare GHC.Core.TyCon @@ -446,13 +456,17 @@ GHC.Data.Graph.Color GHC.Data.Graph.Collapse GHC.Data.Graph.Directed + GHC.Data.Graph.Directed.Internal + GHC.Data.Graph.Directed.Reachability GHC.Data.Graph.Inductive.Graph GHC.Data.Graph.Inductive.PatriciaTree GHC.Data.Graph.Ops GHC.Data.Graph.Ppr GHC.Data.Graph.UnVar GHC.Data.IOEnv + GHC.Data.List GHC.Data.List.Infinite + GHC.Data.List.NonEmpty GHC.Data.List.SetOps GHC.Data.Maybe GHC.Data.OrdList @@ -508,6 +522,8 @@ GHC.Driver.Config.Tidy GHC.Driver.Config.StgToJS GHC.Driver.DynFlags + GHC.Driver.IncludeSpecs + GHC.Driver.Downsweep GHC.Driver.Env GHC.Driver.Env.KnotVars GHC.Driver.Env.Types @@ -521,6 +537,8 @@ GHC.Driver.MakeSem GHC.Driver.Main GHC.Driver.Make + GHC.Driver.Messager + GHC.Driver.MakeAction GHC.Driver.MakeFile GHC.Driver.Monad GHC.Driver.Phases @@ -533,6 +551,8 @@ GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session + GHC.Driver.Session.Inspect + GHC.Driver.Session.Units GHC.Hs GHC.Hs.Basic GHC.Hs.Binds @@ -603,8 +623,10 @@ GHC.Iface.Recomp GHC.Iface.Recomp.Binary GHC.Iface.Recomp.Flags + GHC.Iface.Recomp.Types GHC.Iface.Rename GHC.Iface.Syntax + GHC.Iface.Flags GHC.Iface.Tidy GHC.Iface.Tidy.StaticPtrTable GHC.Iface.Warnings @@ -657,7 +679,7 @@ GHC.Platform.ARM GHC.Platform.AArch64 GHC.Platform.Constants - GHC.Platform.LoongArch64 + GHC.Platform.LA64 GHC.Platform.NoRegs GHC.Platform.PPC GHC.Platform.Profile @@ -690,14 +712,17 @@ GHC.Rename.Utils GHC.Runtime.Context GHC.Runtime.Debugger + GHC.Runtime.Debugger.Breakpoints GHC.Runtime.Eval GHC.Runtime.Eval.Types + GHC.Runtime.Eval.Utils GHC.Runtime.Heap.Inspect GHC.Runtime.Heap.Layout GHC.Runtime.Interpreter GHC.Runtime.Interpreter.JS GHC.Runtime.Interpreter.Process GHC.Runtime.Interpreter.Types + GHC.Runtime.Interpreter.Types.SymbolCache GHC.Runtime.Interpreter.Wasm GHC.Runtime.Loader GHC.Runtime.Utils @@ -708,6 +733,10 @@ GHC.Stg.BcPrep GHC.Stg.CSE GHC.Stg.Debug + GHC.Stg.EnforceEpt + GHC.Stg.EnforceEpt.Rewrite + GHC.Stg.EnforceEpt.TagSig + GHC.Stg.EnforceEpt.Types GHC.Stg.FVs GHC.Stg.Lift GHC.Stg.Lift.Analysis @@ -715,10 +744,6 @@ GHC.Stg.Lift.Monad GHC.Stg.Lift.Types GHC.Stg.Lint - GHC.Stg.InferTags - GHC.Stg.InferTags.Rewrite - GHC.Stg.InferTags.TagSig - GHC.Stg.InferTags.Types GHC.Stg.Make GHC.Stg.Pipeline GHC.Stg.Stats @@ -770,7 +795,9 @@ GHC.StgToJS.Regs GHC.StgToJS.Rts.Types GHC.StgToJS.Rts.Rts - GHC.StgToJS.Sinker + GHC.StgToJS.Sinker.Collect + GHC.StgToJS.Sinker.StringsUnfloat + GHC.StgToJS.Sinker.Sinker GHC.StgToJS.Stack GHC.StgToJS.StaticPtr GHC.StgToJS.Symbols @@ -815,7 +842,6 @@ GHC.Tc.Gen.HsType GHC.Tc.Gen.Match GHC.Tc.Gen.Pat - GHC.Tc.Gen.Rule GHC.Tc.Gen.Sig GHC.Tc.Gen.Splice GHC.Tc.Instance.Class @@ -825,6 +851,7 @@ GHC.Tc.Module GHC.Tc.Plugin GHC.Tc.Solver + GHC.Tc.Solver.Default GHC.Tc.Solver.Rewrite GHC.Tc.Solver.InertSet GHC.Tc.Solver.Solve @@ -842,7 +869,6 @@ GHC.Tc.Types GHC.Tc.Types.Constraint GHC.Tc.Types.Evidence - GHC.Tc.Types.EvTerm GHC.Tc.Types.Origin GHC.Tc.Types.Rank GHC.Tc.Types.CtLoc @@ -868,7 +894,6 @@ GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic - GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State @@ -888,6 +913,7 @@ GHC.Types.HpcInfo GHC.Types.Id GHC.Types.IPE + GHC.Types.ThLevelIndex GHC.Types.Id.Info GHC.Types.Id.Make GHC.Types.Literal @@ -933,12 +959,16 @@ GHC.Unit.Finder GHC.Unit.Finder.Types GHC.Unit.Home + GHC.Unit.Home.Graph GHC.Unit.Home.ModInfo + GHC.Unit.Home.PackageTable GHC.Unit.Info GHC.Unit.Module GHC.Unit.Module.Deps GHC.Unit.Module.Env GHC.Unit.Module.Graph + GHC.Unit.Module.ModNodeKey + GHC.Unit.Module.Stage GHC.Unit.Module.Imported GHC.Unit.Module.Location GHC.Unit.Module.ModDetails @@ -994,10 +1024,12 @@ Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds + Language.Haskell.Syntax.BooleanFormula Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension Language.Haskell.Syntax.ImpExp + Language.Haskell.Syntax.ImpExp.IsBoot Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Module.Name Language.Haskell.Syntax.Pat